BSOne.SFC/Tocsg.Lib/VCL/Tocsg.Clipboard.pas

{*******************************************************}
{                                                       }
{       Tocsg.Clipboard                                 }
{                                                       }
{       Copyright (C) 2019 kku                          }
{                                                       }
{*******************************************************}
unit Tocsg.Clipboard;

// 잠깐 만들던건.. 여기 Tocsg.Clipboard_Old
interface

uses
  System.SysUtils, Vcl.Clipbrd, Winapi.Windows, Winapi.Messages, System.Classes;

//const
//  arrCbImgFormat: array [0..26] of DWORD = (
//        CF_DIB, CF_DIBV5, CF_BITMAP,
//      // 윈도우 기본 캡쳐 시 사용되는 이미지 포맷 25_0306 16:31:21 kku
//        491661, 49350, 50384, 50209, 48171,
//      // 엑셀 셀 복사 시 사용하는 이미지 포맷
//        16,
//      // 엑셀, 파워포인트에서 사용하는 이미지 포맷
//        49718,
//      // 파워포인트에서 사용하는 이미지 포맷
//        50706, 49350, 49523, 49161, 50707, 49348,
//        49171, 49431, 50703, 49436, 50152, 49166,
//        49349, 49935, 49360, 49298, 14
//        );

// 클립보드 수행시 뜨는 포맷 목록들
//Text
//Debug Output: OnDrawClipboard() - FormatCount : 4 Process kku Assister.exe (4708)
//Debug Output: OnDrawClipboard() - Format(0) : 13 Process kku Assister.exe (4708)
//Debug Output: OnDrawClipboard() - Format(1) : 16 Process kku Assister.exe (4708)
//Debug Output: OnDrawClipboard() - Format(2) : 1 Process kku Assister.exe (4708)
//Debug Output: OnDrawClipboard() - Format(3) : 7 Process kku Assister.exe (4708)
//Capture
//Debug Output: OnDrawClipboard() - FormatCount : 3 Process kku Assister.exe (4708)
//Debug Output: OnDrawClipboard() - Format(0) : 2 Process kku Assister.exe (4708)
//Debug Output: OnDrawClipboard() - Format(1) : 8 Process kku Assister.exe (4708)
//Debug Output: OnDrawClipboard() - Format(2) : 17 Process kku Assister.exe (4708)
//File
//Debug Output: OnDrawClipboard() - FormatCount : 11 Process kku Assister.exe (4708)
//Debug Output: OnDrawClipboard() - Format(0) : 49161 Process kku Assister.exe (4708)
//Debug Output: OnDrawClipboard() - Format(1) : 49359 Process kku Assister.exe (4708)
//Debug Output: OnDrawClipboard() - Format(2) : 50043 Process kku Assister.exe (4708)
//Debug Output: OnDrawClipboard() - Format(3) : 50044 Process kku Assister.exe (4708)
//Debug Output: OnDrawClipboard() - Format(4) : 49439 Process kku Assister.exe (4708)
//Debug Output: OnDrawClipboard() - Format(5) : 49414 Process kku Assister.exe (4708)
//Debug Output: OnDrawClipboard() - Format(6) : 49463 Process kku Assister.exe (4708)
//Debug Output: OnDrawClipboard() - Format(7) : 15 Process kku Assister.exe (4708)
//Debug Output: OnDrawClipboard() - Format(8) : 49158 Process kku Assister.exe (4708)
//Debug Output: OnDrawClipboard() - Format(9) : 49159 Process kku Assister.exe (4708)
//Debug Output: OnDrawClipboard() - Format(10) : 49171 Process kku Assister.exe (4708)
type
// AllocateHWnd사용으로 thread에서 사용주의
  TDrawClipboard = class;
  TNotifyClipboard = procedure(Sender: TDrawClipboard) of object;
  TDrawClipboard = class(TClipboard)
  private
    hWnd_: HWND;
    hNextCBWnd_,
    hAllocHWND_: HWND;
    bReseting_: Boolean;
    procedure WndProc(var msg: TMessage); override;
  protected
    evDrawCB_: TNotifyClipboard;
    procedure SetDrawCBEvent(evDrawCB: TNotifyClipboard);
    procedure process_WM_CHANGECBCHAIN(var msg: TMessage);
    procedure process_WM_DRAWCLIPBOARD(var msg: TMessage);
//    procedure process_WM_CLIPBOARDUPDATE(var msg: TMessage);
  public
    Constructor Create(h: HWND = 0);
    Destructor Destroy; override;
    procedure Stop;
    procedure Reset;

    property OnDrawClipboard: TNotifyClipboard read evDrawCB_ write SetDrawCBEvent;
    property NextCBWnd: HWND read hNextCBWnd_ write hNextCBWnd_;
  end;

  TClipboardHelper = class helper for TClipboard
  public
    function GetSize: Integer;
  end;


function CopyToClipboard(const S: String; bDoClear: Boolean): Boolean;
function ClearClipboard(bImageOnly: Boolean = false): Boolean;
function OpenCloseClipboardTest: Boolean;
function IsClipboardEmpty: Boolean;
function GetClipboardSize: Integer;
function GetClipboardHandles: String;

var
  CF_HTML: DWORD;
  CF_BS1Empty: DWORD;
{
Clipboard has 8 Formats.
49161 = DataObject
49268 = Shell IDList Array
15 = CF_hDrop
49158 = FileName
49159 = FileNameW
49389 = Preferred DropEffect
49380 = Shell Object Offsets
49171 = Ole Private Data
}
implementation
uses
  Vcl.Forms, Tocsg.Exception, Tocsg.Trace, Tocsg.Safe, Vcl.Graphics,
  System.Generics.Collections, Tocsg.Strings;

{ TDrawClipboard }

Constructor TDrawClipboard.Create(h: HWND = 0);
begin
  Inherited Create;
  hWnd_ := h;
  bReseting_ := false;

  hAllocHWND_ := 0;
  Reset;
//  hAllocHWND_ := AllocateHWnd(WndProc);
//  ASSERT(AddClipboardFormatListener(hAllocHWND_) = true);
end;

Destructor TDrawClipboard.Destroy;
begin
  Stop;
//  RemoveClipboardFormatListener(hAllocHWND_);
//  DeallocateHWnd(hAllocHWND_);
//  hAllocHWND_ := 0;
  Inherited;
end;

procedure TDrawClipboard.Stop;
begin
  if hAllocHWND_ <> 0 then
  begin
    if hNextCBWnd_ <> 0 then
    begin
      ChangeClipboardChain(hAllocHWND_, hNextCBWnd_);
      hNextCBWnd_ := 0;
    end;
    DeallocateHWnd(hAllocHWND_);
    hAllocHWND_ := 0;
  end else
  if hWnd_ <> 0 then
  begin
    if hNextCBWnd_ <> 0 then
    begin
      ChangeClipboardChain(hWnd_, hNextCBWnd_);
      hNextCBWnd_ := 0;
    end;
  end;
end;

procedure TDrawClipboard.Reset;
begin
//  bReseting_ := true; // 초기화 할때 재감지 되도록 다시 롤백 24_0716 18:06:45 kku
  try
    Stop;
    if hWnd_ <> 0 then
    begin
      hNextCBWnd_ := SetClipboardViewer(hWnd_);
    end else begin
      hAllocHWND_ := AllocateHWnd(WndProc);
      hNextCBWnd_ := SetClipboardViewer(hAllocHWND_);
    end;
  finally
    bReseting_ := false;
  end;
end;

procedure TDrawClipboard.SetDrawCBEvent(evDrawCB: TNotifyClipboard);
begin
  if @evDrawCB_ <> @evDrawCB then
    evDrawCB_ := evDrawCB;
end;

procedure TDrawClipboard.WndProc(var msg: TMessage);
begin
  case msg.Msg of
    WM_CHANGECBCHAIN : process_WM_CHANGECBCHAIN(msg);
    WM_DRAWCLIPBOARD : process_WM_DRAWCLIPBOARD(msg);
//    WM_CLIPBOARDUPDATE : process_WM_CLIPBOARDUPDATE(msg);
    else
      msg.Result := DefWindowProc(hAllocHWND_, msg.Msg, msg.WParam, msg.LParam);
  end;
end;

procedure TDrawClipboard.process_WM_CHANGECBCHAIN(var msg: TMessage);
begin
  with TWMChangeCBChain(msg) do
  begin
    if (Remove = hNextCBWnd_) then
      hNextCBWnd_ := Next
    else if hNextCBWnd_ <> 0 then
      SendMessage(hNextCBWnd_, WM_CHANGECBCHAIN, Remove, Next);
  end;
end;

procedure TDrawClipboard.process_WM_DRAWCLIPBOARD(var msg: TMessage);
begin
  if bReseting_ then
    exit;

// msg as TWMDrawClipboard
  if Assigned(evDrawCB_) then
    evDrawCB_(Self);
  if hNextCBWnd_ <> 0 then
    SendMessage(hNextCBWnd_, msg.Msg, msg.WParam, msg.LParam);
//    SendMessage(hNextCBWnd_, WM_DRAWCLIPBOARD, 0, 0);
end;

//procedure TDrawClipboard.process_WM_CLIPBOARDUPDATE(var msg: TMessage);
//begin
//  if Assigned(evDrawCB_) then
//    evDrawCB_(Self);
//end;

{
// 클립보드에 CF_HTML 형태로 입력
// _____________________________________________________________________________
procedure SetClipBoardHTML(s: String);
const
  START_FRAGMENT='<!--StartFragment-->';
  END_FRAGMENT  ='<!--EndFragment-->';
var
  gMem: HGLOBAL;
  pBytes: PByteArray;
  i: Integer;
  tmpStr: String;
  LBuffer: TBytes;
begin
  // HTML Format에 맞게 세팅
  tmpStr:='Version:1.0'+#13#10;
  tmpStr:=tmpStr+'StartHTML:~~~~~~~~'+#13#10;
  tmpStr:=tmpStr+'EndHTML:########'+#13#10;
  tmpStr:=tmpStr+'StartFragment:~~~~~~~~'+#13#10;
  tmpStr:=tmpStr+'EndFragment:########'+#13#10;
  tmpStr:=tmpStr+'<html><body>'+#13#10;
  tmpStr:=tmpStr+'<!--StartFragment-->'+s+'<!--EndFragment-->'+#13#10;
  tmpStr:=StringReplace(tmpStr, '~~~~~~~~', Format('%.08d', [Pos('<html', tmpStr)-1]), [rfReplaceAll]);
  tmpStr:=StringReplace(tmpStr, '########', Format('%.08d', [Pos(END_FRAGMENT, tmpStr)+Length(END_FRAGMENT)]), [rfReplaceAll]);
  // 버퍼에 복사
  SetLength(LBuffer, Length(tmpStr)+1);
  for i:=0 to Length(tmpStr) do LBuffer[i]:=Byte(tmpStr[i+1]);
  // 클립보드용 버퍼에 복사
  gMem:=GlobalAlloc(GHND, Length(LBuffer)*2);
  pBytes:=GlobalLock(gMem);
  try
    for i:=0 to Length(LBuffer)+1 do pBytes[i]:=LBuffer[i];
  finally
    GlobalUnlock(gMem);
  end;
  // 클립보드에 쓰기
  OpenClipBoard(0);
  EmptyClipBoard;
  SetClipBoardData(RegisterClipBoardFormat('HTML Format'), gMem);
  CloseClipBoard;
end;
// 클립보드의 CF_HTML 포맷데이터 가져오기
// _____________________________________________________________________________
function GetClipBoardHTML: String;
var
  gMem: HGLOBAL;
  pBytes: PByteArray;
  lenBuffer: DWORD;
  i: Integer;
  CF_HTML: UINT;
begin
  Result:='';
  // CF_HTML 등록
  CF_HTML:=RegisterClipboardFormat('HTML Format');
  // 클립보드를 열어 CF_HTML 데이터가 있으면 읽어와서 반환
  OpenClipBoard(0);
  if ClipBoard.HasFormat(CF_HTML) then begin
    gMem:=GetClipboardData(CF_HTML);
    pBytes:=GlobalLock(gMem);
    try
      lenBuffer:=Length(PChar(pBytes))*2;
      SetLength(Result, lenBuffer);
      for i:=0 to lenBuffer do Result[i+1]:=Chr(pBytes[i]);
      Result:=TEncoding.UTF8.GetString(TBytes(pBytes), 0, lenBuffer);
    finally
      GlobalUnlock(gMem);
    end;
  end;
  CloseClipBoard;
end;
}

{ TClipboardHelper }

const
{$IF DEFINED(UNICODE)}
  CTextFormat = CF_UNICODETEXT;
{$ELSE}
  CTextFormat = CF_TEXT;
{$ENDIF}

function TClipboardHelper.GetSize: Integer;
var
  Data: THandle;
begin
  Result := 0;
  try
    Open;
    Data := GetClipboardData(CTextFormat);
    try
      if Data <> 0 then
        Result := GlobalSize(Data);
    finally
      if Data <> 0 then
        GlobalUnlock(Data);
      Close;
    end;
  except
    on E: Exception do
      ETgException.TraceException(Self, E, 'Fail .. GetSize()');
  end;
end;

{ Function }

function OpenAndClearClipboard: Boolean;
begin
  Result := OpenClipboard(0);
  if Result then
    EmptyClipboard;
end;

function CopyToClipboard(const S: String; bDoClear: Boolean): Boolean;
var
  nDataSize, nBufferSize: Integer;
  hData: HGLOBAL;
  pData: Pointer;
begin
  nDataSize := Length(S) * 2;
  if nDataSize > 0 then
  begin
    if bDoClear then
    begin
      if not OpenAndClearClipboard then
      begin
        Result := false;
        exit;
      end;
    end;
    nBufferSize := nDataSize + 2;
    hData := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, nBufferSize);
    if hData <> 0 then
    begin
      pData := GlobalLock(hData);
      if pData <> nil then
      begin
        Move(S[1], pData^, nBufferSize);
        GlobalUnlock(hData);
        SetClipboardData(CF_UNICODETEXT, hData);
      end;
    end;
    if bDoClear then
      CloseClipboard;
  end;
  Result := True;
end;

procedure RemoveClipboardImageFormat;
type
  PCbEnt = ^TCbEnt;
  TCbEnt = record
    uType: UINT;
    pData: Pointer;
    nSize: Integer;
  end;
var
  uFormat: UINT;
  CbTxtFmtList: TList<PCbEnt>; // 해제 필요
  pEnt: PCbEnt;
  hData: THandle;
  hCopy: THandle;
  pData: Pointer;
  i: Integer;
begin
  CbTxtFmtList := TList<PCbEnt>.Create;
  try
    uFormat := EnumClipboardFormats(0);
    while uFormat <> 0 do
    begin
      case uFormat of
        CF_TEXT,
        CF_OEMTEXT,
        CF_UNICODETEXT : ;
        else begin
          if uFormat <> CF_HTML then
          begin
            uFormat := EnumClipboardFormats(uFormat);
            continue;
          end;
        end;
      end;

      if (uFormat <> CF_HTML) and (uFormat > 16) then
      begin
        uFormat := EnumClipboardFormats(uFormat);
        continue;
      end;

      New(pEnt);
      ZeroMemory(pEnt, SizeOf(TCbEnt));
      pEnt.uType := uFormat;
      CbTxtFmtList.Add(pEnt);
      uFormat := EnumClipboardFormats(uFormat);
    end;

    for pEnt in CbTxtFmtList do
    begin
      hData := GetClipboardData(pEnt.uType);
      if hData <> 0 then
      begin
        try
          pEnt.nSize := GlobalSize(hData);
        except
        // 사이즈 가져올때 오류 발생 가능성
          continue;
        end;

        if pEnt.nSize > 0 then
        begin
          pEnt.pData := AllocMem(pEnt.nSize);
          pData := GlobalLock(hData);
          try
            Move(pData^, pEnt.pData^, pEnt.nSize);
          finally
            GlobalUnlock(hData);
          end;
        end;
      end;
    end;

  // 클립보드 비우기
    EmptyClipboard;

  // 기존 클립보드 데이터를 복원
    for pEnt in CbTxtFmtList do
    begin
      hData := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, pEnt.nSize);
      if hData <> 0 then
      begin
        try
          pData := GlobalLock(hData);
          try
            CopyMemory(pData, pEnt.pData, pEnt.nSize);
          finally
            GlobalUnlock(hData);
          end;
          SetClipboardData(pEnt.uType, hData);
        except
          GlobalFree(hData);
        end;
      end;

      if pEnt.pData <> nil then
      begin
        FreeMem(pEnt.pData);
        pEnt.pData := nil;
      end;
    end;
  finally
    FreeAndNil(CbTxtFmtList);
  end;
end;

function ClearClipboard(bImageOnly: Boolean = false): Boolean;
var
  i: Integer;
  hData: THandle;
  pData: Pointer;
begin
  Result := false;
  try
//    Guard(CB, TClipboard.Create);
//    CB.AsText := '';
//    Result := CB.AsText = '';
//    CB.Clear

//bImageOnly := true;
    if not OpenClipboard(0) then
    begin
    // todo : 실패하면 재시도 할지... 25_0310 10:12:10 kku
    {$IFDEF DEBUG}
      TTgTrace.T('ClearClipboard() .. Fail .. OpenClipboard()');
    {$ENDIF}
      exit;
    end;

    try
      if bImageOnly then
      begin
//        TTgTrace.T('ClearClipboard() .. Image');
        RemoveClipboardImageFormat;
      end else begin
        EmptyClipboard;
      end;

    {$IFDEF _HE_}
      hData := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, 1);
      if hData <> 0 then
      begin
        try
          pData := GlobalLock(hData);
          try
            CopyMemory(pData, PAnsiChar(#0), 1);
            SetClipboardData(CF_BS1Empty, hData);
          finally
            GlobalUnlock(hData);
          end;
        except
          GlobalFree(hData);
        end;
      end;
    {$ENDIF}

      Result := true;
    finally
      CloseClipboard;
    end;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. ClearClipboard()');
  end;
end;

function OpenCloseClipboardTest: Boolean;
begin
  Result := false;
  try
    if not OpenClipboard(0) then
      exit;
    CloseClipboard;
    Result := true;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. OpenCloseClipboardTest()');
  end;
end;

function IsClipboardEmpty: Boolean;
var
  uFormat: UINT;
  i, nCnt: Integer;
begin
// 사용하지 않음. 나중에 지워도 됨 25_0310 10:11:31 kku
  Result := false;

  if not OpenClipboard(0) then
    exit;

  try
    nCnt := 0;
    while uFormat <> 0 do
    begin
      Inc(nCnt);
      uFormat := EnumClipboardFormats(uFormat);
    end;
    Result := nCnt > 0;
  finally
    CloseClipboard;
  end;
end;

function GetClipboardSize: Integer;
var
  uFormat: UINT;
  hData: THandle;
begin
// 사용하지 않음. 나중에 지워도 됨 25_0310 10:11:31 kku
  Result := 0;
  if not OpenClipboard(0) then
    exit;
  try
    uFormat := EnumClipboardFormats(0);
    while uFormat <> 0 do
    begin
      hData := GetClipboardData(uFormat);
      try
        if hData <> 0 then
          Inc(Result, GlobalSize(hData));
      except
      {$IFDEF DEBUG}
        TTgTrace.T('Fail .. GetClipboardSize() .. GlobalSize() .. hData = %d', [hData]);
      {$ENDIF}
      end;
      uFormat := EnumClipboardFormats(uFormat);
    end;
  finally
    CloseClipboard;
  end;
end;

function GetClipboardHandles: String;
var
  uFormat: UINT;
  hData: THandle;
begin
// 사용하지 않음. 나중에 지워도 됨 25_0310 10:11:31 kku
  Result := '';
  if not OpenClipboard(0) then
  begin
    TTgTrace.T('Fail .. GetClipboardHandles() .. 1, Error=%d', [GetLastError]);
    exit;
  end;
  try
    uFormat := EnumClipboardFormats(0);
    if uFormat = 0 then
      TTgTrace.T('Fail .. GetClipboardHandles() .. 2');
    while uFormat <> 0 do
    begin
      hData := GetClipboardData(uFormat);
      SumString(Result, IntToStr(hData), '|');
      uFormat := EnumClipboardFormats(uFormat);
    end;
  finally
    CloseClipboard;
  end;
end;

Initialization
  CF_HTML := RegisterClipboardFormat('HTML Format');
  CF_BS1Empty := RegisterClipboardFormat('BSOne CB Empty'); { Do not localize }

end.