clp.pas

支持库类 / 模块控件 / 支持库类 eLIB++支持库 源代码 Delphi

unit Clp;

interface
uses elibTypes,windows{$IFDEF __DEBUG},SysUtils{$ELSE}{$ENDIF};

procedure GetClpData(pRetData:pMDATA_INF; nArgCount:Integer; pArgInf:pMDATA_INF); cdecl;
procedure SetClpData(pRetData:pMDATA_INF; nArgCount:Integer; pArgInf:pMDATA_INF); cdecl;
procedure GetClpFormats(pRetData:pMDATA_INF; nArgCount:Integer; pArgInf:pMDATA_INF); cdecl;
procedure RegClpFormat(pRetData:pMDATA_INF; nArgCount:Integer; pArgInf:pMDATA_INF); cdecl;
procedure GetClpFormatName(pRetData:pMDATA_INF; nArgCount:Integer; pArgInf:pMDATA_INF); cdecl;
procedure WatchClp(pRetData:pMDATA_INF; nArgCount:Integer; pArgInf:pMDATA_INF); cdecl;
procedure UnWatchClp(pRetData:pMDATA_INF; nArgCount:Integer; pArgInf:pMDATA_INF); cdecl;
//---------Tool function--------------
function CallBackChangeCBChin(wHwnd:Hwnd;wMsg:integer;wParam,lParam:integer):integer;stdcall;
function CallBackDestroy(wHwnd:Hwnd;wMsg:integer;wParam,lParam:integer):integer;stdcall;
function CallBackDrawClp(wHwnd:Hwnd;wMsg:integer;wParam,lParam:integer):integer;stdcall;

implementation

const
  {$IFDEF __DEBUG}
  ClpViewerCount=3;
  {$ELSE}
  ClpViewerCount=50;
  {$ENDIF}
type
  ClpViewerInf=record
    hViewer:HWND;
    hNext:HWND;
  end;
var
  ClpViewerInfAry:array[0..ClpViewerCount-1]of ClpViewerInf;

{$IFDEF __DEBUG}
procedure PrintDebug();
var
  debugMsg:string;
  m:integer;
begin
  debugMsg:=debugMsg+'--------ClpViewerInfAry Debug--------'+#13;
  for m:=0 to high(ClpViewerInfAry)do
    with ClpViewerInfAry[m]do
    begin
      debugMsg:=debugMsg+'ClpViewerInfAry['+inttostr(m)+'].hwnd='+inttostr(hwnd)+#13;
      debugMsg:=debugMsg+'ClpViewerInfAry['+inttostr(m)+'].hNext='+inttostr(hNext)+#13+#13;
    end;//with for
    MessageBox(0,PChar(debugMsg),'ClpViewerInfAry Debug',MB_OK);
end;
{$ELSE}

{$ENDIF}
procedure GetClpData(pRetData:pMDATA_INF; nArgCount:Integer; pArgInf:pMDATA_INF); cdecl;
var
  clpFmt:Cardinal;
  hData:Cardinal;
  pData:PByte;
  DataSize:Cardinal;
  lbR:LongBool;
begin
  hData:=0;
  pRetData.m_Value.m_pBin:=nil;
  clpFmt:=ArgArray(pArgInf)[0].m_Value.m_int;
  try
    lbR:=OpenClipBoard(0);//Remembar to CloseClipBoard
    if lbR=false then
    begin
      MessageBox(0,'打开剪辑板失败！','eLIB++',MB_OK+MB_ICONERROR);
      exit;
    end;
    hData:=GetClipboardData(clpFmt);
    //MessageBox(0,PChar(inttostr(hData)),'hData',mb_ok);
    DataSize:=GlobalSize(hData);
    //MessageBox(0,PChar(inttostr(DataSize)),'Size',mb_ok);
    pData:=GlobalLock(hData);//Remember to ClobalUnLock
    if pData=nil then exit;
    pRetData.m_Value.m_pBin:=CloneBinData(pData,DataSize);

  finally
    GlobalUnLock(hData);
    CloseClipBoard();
  end;//try
end;//procedure GetClpData
procedure SetClpData(pRetData:pMDATA_INF; nArgCount:Integer; pArgInf:pMDATA_INF); cdecl;
var
  pBin:PByte;
  clpFmt:Cardinal;
  pBinData:PByte;
  pData:PByte;
  pDataSize:^integer;
  hData:Cardinal;
begin
  hData:=0;
  pRetData.m_Value.m_bool:=false;

  //Get E format Bin data pointer
  pBin:=ArgArray(pArgInf)[0].m_Value.m_pBin;
  clpFmt:=ArgArray(pArgInf)[1].m_Value.m_Int;

  //Get Bin Size
  pDataSize:=Pointer(pBin);
  inc(pDataSize);

  //Get Real data pointer
  pBinData:=Pointer(pDataSize);
  inc(pBinData,SizeOf(integer));
  try
    OpenClipBoard(0);
    hData:=GlobalAlloc(GMEM_MOVEABLE,pDataSize^);//GlobalFree
    pData:=GlobalLock(hData);//GlobalUnLock
    if pData=nil then exit;

    CopyMemory(pData,pBinData,pDataSize^);
    EmptyClipBoard();
    if SetClipBoardData(clpFmt,hData)<>0 then pRetData.m_Value.m_bool:=true;
  finally
    GlobalUnLock(hData);
    CloseClipBoard();
    //GlobalFree(hData);
    //After SetClipboardData is called, the system owns the object identified by the hMem parameter.
    //The application can read the data,but must not free the handle or leave it locked
  end;//try
end;//procedure SetClpData

procedure GetClpFormats(pRetData:pMDATA_INF; nArgCount:Integer; pArgInf:pMDATA_INF); cdecl;
var
  FmtCount:integer;
  Fmt:integer;
  ppIntArray:PPointer;
  nR:integer;
  i:integer;
  pTmpInt,pTmpData:^integer;
begin
  pRetData.m_Value.m_int:=0;
  ppIntArray:=ArgArray(pArgInf)[0].m_Value.m_ppAryData;
  Fmt:=0;
  try
    OpenClipboard(0);//CloseClipboard
    FmtCount:=CountClipboardFormats();
    //Free the original E int array
    nR:=NotifySys(NRS_FREE_ARY,SDT_INT,Cardinal(ppIntArray^));
    //if nR=0 then exit;
    //Rebuild E int array
    pTmpData:=MMALLOC(SizeOf(integer)*(FmtCount+2));
    pTmpInt:=pTmpData;
    pTmpInt^:=1;  //维数
    inc(pTmpInt); //各维成员数
    pTmpInt^:=FmtCount;
    //设置真正的成员数据
    for i:=0 to FmtCount-1 do
    begin
      Fmt:=EnumClipboardFormats(Fmt);
      inc(pTmpInt);
      pTmpInt^:=Fmt;
    end;//for
    ppIntArray^:=pTmpData;//Write Back
    //Get the fist member of E array
    Dec(pTmpInt,FmtCount-1);
    pRetData.m_Value.m_int:=pTmpInt^;
  finally
    CloseClipBoard();
  end;//try
  if nR=0 then exit;
end;//procedure GetClpFormats

procedure RegClpFormat(pRetData:pMDATA_INF; nArgCount:Integer; pArgInf:pMDATA_INF); cdecl;
begin
  pRetData.m_Value.m_int:=RegisterClipboardFormat(pArgInf.m_Value.m_pText);
end;//procedure RegClpFormat

procedure GetClpFormatName(pRetData:pMDATA_INF; nArgCount:Integer; pArgInf:pMDATA_INF); cdecl;
var
  FmtName:array[0..256] of Char;
  nCopy:integer;
begin
  FmtName:='';
  nCopy:=GetClipboardFormatName(pArgInf.m_Value.m_int,@FmtName,255);
  if nCopy<>0 then pRetData.m_Value.m_pText:=CloneTextData(PChar(@FmtName),nCopy);
end;//procedure GetClpFormatName

procedure WatchClp(pRetData:pMDATA_INF; nArgCount:Integer; pArgInf:pMDATA_INF); cdecl;
var
  ArgHwnd:HWND;
  pRet:^LongBool;
  m:integer;
begin
  ArgHwnd:=pArgInf.m_Value.m_int;
  pRet:=@pRetData.m_Value.m_bool;

  {$IFDEF __DEBUG}
  PrintDebug;
  {$ELSE}{$ENDIF}

  pRet^:=false;
  for m:=0 to high(ClpViewerInfAry)do
    with ClpViewerInfAry[m]do
    begin
      if ArgHwnd=hViewer then
      begin
      //二次调用，直接返回假，退出
        {$IFDEF __DEBUG}
        MessageBox(0,'Second!','',mb_ok);
        {$ELSE}

        {$ENDIF}
        exit;
      end//if
    end;//with for

  for m:=0 to high(ClpViewerInfAry)do
    with ClpViewerInfAry[m]do
    begin
      if hViewer=0 then
      //找到空位
      begin
        hViewer:=ArgHwnd;
        hNext:=SetClipboardViewer(hViewer);
        if GetLastError=0 then pRet^:=true;

        {$IFDEF __DEBUG}
        PrintDebug;
        {$ELSE}{$ENDIF}
        
        exit;
      end;//if

    end//with for

end;//procedure WatchClp

procedure UnWatchClp(pRetData:pMDATA_INF; nArgCount:Integer; pArgInf:pMDATA_INF); cdecl;
var
  m:integer;
  wHwnd:HWND;
begin
  wHwnd:=pArgInf.m_Value.m_int;
  pRetData.m_Value.m_bool:=false;

  for m:=0 to high(ClpViewerInfAry)do
    with ClpViewerInfAry[m]do
    begin
      if wHwnd=hViewer then
      //处理
      begin
        ChangeClipboardChain(hViewer,hNext);
        hViewer:=0;
        hNext:=0;
        pRetData.m_Value.m_bool:=true;
      end;//if
    end;//with for
end;//procedure UnWatchClp
//剪辑板监视链被改变
function CallBackChangeCBChin(wHwnd:Hwnd;wMsg:integer;wParam,lParam:integer):integer;stdcall;
var
  m:integer;
begin
  for m:=0 to high(ClpViewerInfAry)do
    with ClpViewerInfAry[m]do
    begin
      if wHwnd=hViewer then
      //处理
      begin
        if hNext=Cardinal(wParam) then
        //Next window is the window to be removed!
          hNext:=Cardinal(lParam)
        else
        //Pass msg to next window
          SendMessage(hNext,wMsg,wParam,lParam);
      end;//if
    end;//with for
    Result:=0;//If an application processes this message, it should return zero. --MSDN
end;//function CallBackChangeCBChin

function CallBackDestroy(wHwnd:Hwnd;wMsg:integer;wParam,lParam:integer):integer;stdcall;
var
  m:integer;
begin
  for m:=0 to high(ClpViewerInfAry)do
    with ClpViewerInfAry[m]do
    begin
      if wHwnd=hViewer then
      //处理
      begin
      //Remove itself from Clp Chain

        {$IFDEF __DEBUG}
        MessageBox(0,'Auto Remove Clp Chain!','Auot Remove',MB_OK);
        PrintDebug;
        {$ELSE}{$ENDIF}

        ChangeClipboardChain(hViewer,hNext);
        hViewer:=0;
        hNext:=0;
      end;//if
    end;//with for
  Result:=1;

    {$IFDEF __DEBUG}
    MessageBox(0,PChar('Destroy '+inttostr(wHwnd)),'Auot Remove',mb_ok);
    PrintDebug;
    {$ELSE}{$ENDIF}
    
end;//function CallBackDestroy

procedure InitClpViewerInf();
var
  m:integer;
begin
 for m:=0 to high(ClpViewerInfAry)do
 begin
  with ClpViewerInfAry[m]do
  begin
    hViewer:=0;
    hNext:=0;
  end;//with
 end;//for
end;//procedure IniClpViewInf()

function CallBackDrawClp(wHwnd:Hwnd;wMsg:integer;wParam,lParam:integer):integer;stdcall;
var
  m:integer;
begin
  for m:=0 to high(ClpViewerInfAry)do
    with ClpViewerInfAry[m]do
    begin
      if wHwnd=hViewer then
        //Notify next viewer
        SendMessage(hNext,wMsg,wParam,lParam);
    end;//with for
    Result:=1;
end;//function CallBackDrawClp

initialization
  InitClpViewerInf();
end.