delphi怎么调用wordVba的openclipboard函数？或者，怎么才能防止剪贴板数据被覆盖

Question

数据delphivbaword

Answer 1

Uses
  WinAPI.Windows;//将粘贴板内容复制到本地内存中,返回一个数据指针,该指针用于释放本地内存
function PushClipBoard : Pointer;//将前期复制到本地内存中粘贴板数据恢复到粘贴板上,并释放本地内存
function PopClipBoard(var pushClip : Pointer) : Boolean;//清空粘贴板
function DoEmptyClipBoard : Boolean;//释放前期复制的粘贴板内存
procedure FreePushClipData(pushClip : Pointer);implementationtype
  TClipDataItem = record
    Data    : Pointer;
    Size    : DWORD;
    Format  : Word;
  end;
  TClipPushList = array of TClipDataItem;
  PClipPushList = ^TClipPushList;var
  UtilWindowClass: TWndClass = (
    style: 0;
    lpfnWndProc: @DefWindowProc;
    cbClsExtra: 0;
    cbWndExtra: 0;
    hInstance: 0;
    hIcon: 0;
    hCursor: 0;
    hbrBackground: 0;
    lpszMenuName: nil;
    lpszClassName: 'TPUtilWindow_Clip');function CreateClipHandle : HWND;
var
  TempClass: TWndClass;
  ClassRegistered: Boolean;
begin
  UtilWindowClass.hInstance := HInstance;
  ClassRegistered := GetClassInfo(HInstance, UtilWindowClass.lpszClassName, TempClass);
  if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then begin
    if ClassRegistered then Winapi.Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance);
    Winapi.Windows.RegisterClass(UtilWindowClass);
  end;
  Result := CreateWindowEx(WS_EX_TOOLWINDOW, UtilWindowClass.lpszClassName,
    '', WS_POPUP {+ 0}, 0, 0, 0, 0, 0, 0, HInstance, nil);
end;procedure CloseClipHandle(hClip : HWND);
begin
  if hClip<>0 then DestroyWindow(hClip);
  Winapi.Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance);
end;function DoEmptyClipBoard : Boolean;
var
  hClip : HWND;
begin
  Result := False;
  hClip := CreateClipHandle();
  if hClip<>0 then begin
    if Winapi.Windows.OpenClipboard(hClip) then begin
      Result := Winapi.Windows.EmptyClipboard();
      Winapi.Windows.CloseClipboard();
    end;
    CloseClipHandle(hClip);
  end;
end;procedure FreePushClipData(pushClip : Pointer);
var
  List : PClipPushList;
  i : integer;
begin
  if pushClip<>NIL then begin
    List := pushClip;
    for i := 0 to High(List^) do
      if List^[i].Data<>NIL then
        SysFreeMem(List^[i].Data);
    SetLength(List^ , 0);
    Dispose(List);
  end;
end;function PushClipBoard : Pointer;
var
  hClip : HWND;
  List : PClipPushList;
  Count : integer;
  dwFormat : Word;
  hMem : THandle;
begin
  Result := NIL;
  hClip := CreateClipHandle();
  if hClip=0 then exit;
  if Winapi.Windows.OpenClipboard(hClip) then begin
    dwFormat := EnumClipboardFormats(0);
    if dwFormat<>0 then begin
      New(List);
      Count := 0;
      SetLength(List^ , 100);
      while dwFormat<>0 do begin
        dwFormat := dwFormat;
        hMem  := GetClipboardData(dwFormat);
        if hMem<>0 then begin
          try
            List^[Count].Size := GlobalSize(hMem);
            if List^[Count].Size>0 then begin
              List^[Count].Data := SysGetMem(List^[Count].Size);
              Move(GlobalLock(hMem)^ , List^[Count].Data^ , List^[Count].Size);
              List^[Count].Format := dwFormat;
              inc(Count);
              if Count>=Length(List^) then begin
                Setlength(List^ , Length(List^) + 100);
              end;
            end;
          except
            if List^[Count].Data<>NIL then begin
              SysFreeMem(List^[Count].Data);
              List^[Count].Data := NIL;
            end;
          end;
          GlobalUnlock(hMem);
        end;
        dwFormat := EnumClipboardFormats(dwFormat);
      end;
      SetLength(List^ , Count);
      Result := List;
    end;
    Winapi.Windows.CloseClipboard();
  end;
  CloseClipHandle(hClip);
end;function PopClipBoard(var pushClip : Pointer) : Boolean;
var
  hClip : HWND;
  List : PClipPushList;
  i : integer;
  hMem : THandle;
  DataPtr : Pointer;
begin
  Result := False;
  if pushClip=NIL then exit;
  hClip := CreateClipHandle();
  if hClip=0 then exit;
  if Winapi.Windows.OpenClipboard(hClip) then begin
    Winapi.Windows.EmptyClipboard();
    List := pushClip;
    for i := 0 to High(List^) do if List^[i].Data<>NIL then begin
      hMem := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, List^[i].Size);
      DataPtr := GlobalLock(hMem);
      Move(List^[i].Data^ , DataPtr^ , List^[i].Size);
      try
        SetClipboardData(List^[i].Format , hMem);
      finally
      end;
      GlobalUnlock(hMem);
      GlobalFree(hMem);
    end;
    Winapi.Windows.CloseClipboard();
  end;
  CloseClipHandle(hClip);
  FreePushClipData(pushClip);
  pushClip := NIL;
  Result := True;
end;end.

Answer 2

当你的程序执行复制操作后，马上调用PushClipBoard()，当你要粘贴刚才复制的数据前，执行PopClipBoard，然后控制粘贴就行了。

Answer 3

先谢谢kiboisme，我先测试一下，要是有个完整的调用代码就好了：）

Answer 4

先谢谢kiboisme，我先测试一下，要是有个完整的调用代码就好了：） 

Answer 5

测试了
PopClipBoard应该怎么调用？

Answer 6

kiboisme 老大，回来看看呀

Answer 7

var
  pClip : Pointer;
...........控制复制的代码
  pClip := PushClipBoard();
.........其他事情,
  PopClipBoard(pClip);
........控制粘贴的代码,