unit DCbMonMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Tocsg.Clipboard, hyieutils, iexBitmaps,
  hyiedefs, iesettings, iexLayers, iexRulers, Vcl.OleCtrls, SHDocVw, ieview,
  imageenview, imageen, Vcl.StdCtrls, Vcl.WinXPanels, Vcl.ExtCtrls, VirtualTrees,
  Vcl.Menus, Tocsg.Trace;

type
  TCbKind = (ckText, ckHtml, ckImage, ckDirFile);
  PCbEnt = ^TCbEnt;
  TCbEnt = record
    Kind: TCbKind;
    dtReg: TDateTime;
    sData,
    sPName,
    sWndCap: String;
  end;

  TDlgCbMonMain = class(TForm)
    pnTop: TPanel;
    btnCbMon: TButton;
    vtList: TVirtualStringTree;
    SP1: TSplitter;
    cpMain: TCardPanel;
    cdText: TCard;
    cdHtml: TCard;
    cdImage: TCard;
    mmText: TMemo;
    imgEn: TImageEn;
    web: TWebBrowser;
    popFun: TPopupMenu;
    miClear: TMenuItem;
    popIFun: TPopupMenu;
    miSetFit: TMenuItem;
    miSetOrgSize: TMenuItem;
    procedure vtListGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle;
      var HintText: string);
    procedure vtListGetNodeDataSize(Sender: TBaseVirtualTree;
      var NodeDataSize: Integer);
    procedure vtListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
    procedure vtListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
    procedure vtListFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex);
    procedure popFunPopup(Sender: TObject);
    procedure miClearClick(Sender: TObject);
    procedure btnCbMonClick(Sender: TObject);
    procedure imgEnMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure miSetFitClick(Sender: TObject);
    procedure miSetOrgSizeClick(Sender: TObject);
  private
    { Private declarations }
    CbMon_: TDrawClipboard;
    pRecentNode_: PVirtualNode;
    Trace_: TTgTrace;
    procedure OnClipboardNotify(Sender: TDrawClipboard);
    procedure AddCbEnt(aKind: TCbKind; sPName, sWndCap, sData: String);
    procedure SetImageFit(bVal: Boolean);
  public
    { Public declarations }
    Constructor Create(aOwner: TComponent); override;
    Destructor Destroy; override;
  end;

var
  DlgCbMonMain: TDlgCbMonMain;

implementation

uses
  Tocsg.Exception, Vcl.Imaging.jpeg, Tocsg.Process, Tocsg.Safe,
  Tocsg.Strings, Winapi.ShellAPI, Tocsg.VTUtil, Soap.EncdDecd, Winapi.ActiveX,
  Vcl.Clipbrd, Tocsg.WndUtil, Tocsg.Path;

{$R *.dfm}

Constructor TDlgCbMonMain.Create(aOwner: TComponent);
begin
  Inherited Create(aOwner);
  CbMon_ := nil;
  cpMain.ActiveCardIndex := 0;
  pRecentNode_ := nil;
  Trace_ := TTgTrace.Create(GetRunExePathDir, CutFileExt(ExtractFileName(GetRunExePath)) + '.log');
end;

Destructor TDlgCbMonMain.Destroy;
begin
  if CbMon_ <> nil then
    FreeAndNil(CbMon_);
  FreeAndNil(Trace_);
  Inherited;
end;

procedure TDlgCbMonMain.imgEnMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  if imgEn.AutoFit then
  begin
    imgEn.AutoFit := false;
    miSetFit.Checked := false;
  end else
  if miSetOrgSize.Checked then
    miSetOrgSize.Checked := false;
end;

procedure TDlgCbMonMain.btnCbMonClick(Sender: TObject);
begin
  if CbMon_ = nil then
  begin
    CbMon_ := TDrawClipboard.Create;
    CbMon_.OnDrawClipboard := OnClipboardNotify;
  end else begin
    if MessageBox(Handle, PChar('Ŭ¸³º¸µå ¼öÁýÀ» ÁßÁöÇϽðڽÀ´Ï±î?'),
        PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then exit;

    FreeAndNil(CbMon_)
  end;

  if CbMon_ = nil then
    btnCbMon.Caption := 'Ŭ¸³º¸µå ¼öÁý ½ÃÀÛ'
  else
    btnCbMon.Caption := 'Ŭ¸³º¸µå ¼öÁý ÁßÁö';

  Application.ProcessMessages;
end;

procedure TDlgCbMonMain.miClearClick(Sender: TObject);
begin
  if MessageBox(Handle, PChar('¸ñ·ÏÀ» ÃʱâÈ­ ÇϽðڽÀ´Ï±î?'),
      PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then exit;

  pRecentNode_ := nil;
  mmText.Clear;
  cpMain.ActiveCardIndex := 0;
  VT_Clear(vtList);
end;

procedure TDlgCbMonMain.miSetFitClick(Sender: TObject);
begin
  SetImageFit(true);
end;

procedure TDlgCbMonMain.miSetOrgSizeClick(Sender: TObject);
begin
  SetImageFit(false);
end;

procedure TDlgCbMonMain.AddCbEnt(aKind: TCbKind; sPName, sWndCap, sData: String);
var
  pData: PCbEnt;
  pNode: PVirtualNode;
begin
  vtList.BeginUpdate;
  try
    pData := VT_AddChildDataN(vtList, pNode);
    pData.Kind := aKind;
    pData.dtReg := Now;
    pData.sData := sData;
    pData.sPName := sPName;
    pData.sWndCap := sWndCap;

    vtList.ScrollIntoView(pNode, true)
  finally
    vtList.EndUpdate;
  end;
end;

procedure TDlgCbMonMain.OnClipboardNotify(Sender: TDrawClipboard);
var
  sPName, sTemp: String;
  i, nLen, nHLen, nTry: Integer;
  hCb: THandle;
  hW: HWND;
  bmp: TBitmap;
  jpg: TJPEGImage;
  pBuf: Pointer;
  bFail,
  bIsExcel: Boolean;
  ms: TMemoryStream;
  arrFName: array [0..MAX_PATH-1] of WideChar;
Label
  LB_TryReadCB;
begin
//  TTgTrace.T('OnClipboardNotify()');
  nTry := 0;

  hW := GetForegroundWindow;
  sPName := GetProcessNameFromWndHandle(hW);
  if sPName = '' then
  begin
    sPName := 'Unknown';
    bIsExcel := false;
  end else
    bIsExcel := CompareText(sPName, 'excel.exe') = 0;

LB_TryReadCB :
  bFail := false;
  try
    if not bIsExcel and Sender.HasFormat(CF_HTML) then
    begin
      hCb := Sender.GetAsHandle(CF_HTML);
      if hCb <> 0 then
      begin
        pBuf := GlobalLock(hCb);
        try
          if pBuf = nil then
            exit;

//          nHLen := Length(PChar(pBuf)) * 2;
//          nLen := MultiByteToWideChar(CP_UTF8, 0, pBuf, nHLen, nil, 0);
//          SetLength(sTemp, nLen);
//          MultiByteToWideChar(CP_UTF8, 0, pBuf, nHLen, PChar(sTemp), nLen);

          sTemp := UTF8String(PUTF8Char(pBuf));
//          sTemp := AnsiString(PAnsiChar(pBuf));
//            TTgTrace.T('OnClipboardNotify() .. CF_HTML = %s', [sTemp]);

          if sTemp <> '' then
          begin
            sTemp := StringReplace(sTemp, '<html>', '<html><head><meta charset=utf-8></head>', [rfReplaceAll]);
            AddCbEnt(ckHtml, sPName, GetWindowCaption(hW), sTemp);
          end;
        finally
          GlobalUnlock(hCb);
        end;
      end;
    end else
    if Sender.HasFormat(CF_BITMAP) then
    begin
      hCb := Sender.GetAsHandle(CF_BITMAP);
      if hCb <> 0 then
      begin
        GlobalLock(hCb);
        try
          try
            Guard(bmp, TBitmap.Create);
            bmp.LoadFromClipboardFormat(CF_BITMAP, hCb, Sender.GetAsHandle(CF_PALETTE));

            Guard(jpg, TJPEGImage.Create);
            jpg.Assign(bmp);

            Guard(ms, TMemoryStream.Create);
            jpg.SaveToStream(ms);

            if ms.Size > 0 then
              AddCbEnt(ckImage, sPName, GetWindowCaption(hW), EncodeBase64(ms.Memory, ms.Size));
          except
            on E: Exception do
              ETgException.TraceException(Self, E, 'Fail .. OnClipboardNotify() .. make image');
          end;

            sTemp := UTF8String(PUTF8Char(pBuf));
//            TTgTrace.T('OnClipboardNotify() .. CF_HTML = %s', [sTemp]);
//          nLen := Length(
        finally
          GlobalUnlock(hCb);
        end;
      end;
    end else
    if Sender.HasFormat(CF_UNICODETEXT) then
    begin
      sTemp := Trim(Sender.AsText);

      if bIsExcel then
      begin
        nLen := Length(sTemp);
        if nLen > 1000000 then
        begin
          SetLength(sTemp, 30000);
          sTemp := sTemp + Format(' ... (OrgSize=%d)', [InsertPointComma(nLen, 3)]);
        end;
      end;

      if sTemp <> '' then
        AddCbEnt(ckText, sPName, GetWindowCaption(hW), sTemp);
    end else
    if Sender.HasFormat(CF_HDROP) then
    begin
      sTemp := '';
      hCb := Sender.GetAsHandle(CF_HDROP);
      if hCb <> 0 then
      begin
        GlobalLock(hCb);
        try
          nLen := DragQueryFile(hCb, DWORD(-1), '', 0);
          for i := 0 to nLen - 1 do
          begin
            if DragQueryFile(hCb, i, arrFName, MAX_PATH) <> 0 then
              SumString(sTemp, arrFName, '|');
          end;
        finally
          GlobalUnlock(hCb);
        end;
      end;

      if sTemp <> '' then
        AddCbEnt(ckDirFile, sPName, GetWindowCaption(hW), sTemp);
    end;


//    for i := 0 to Sender.FormatCount - 1 do
//    begin
//      try
//        TTgTrace.T('OnClipboardNotify() .. Format = %d', [Sender.Formats[i]]);
//      except
//      // ..
//      end;
//    end;

//    Sender.Reset;
  except
    on E: EClipboardException do
      bFail := true;

    on E: Exception do
      ETgException.TraceException(Self, E, 'Fail .. OnClipboardNotify()');
  end;

  if bFail then
  begin
    if nTry < 5 then
    begin
      Inc(nTry);
      Sleep(500);
      goto LB_TryReadCB;
    end;
  end;
end;

procedure TDlgCbMonMain.popFunPopup(Sender: TObject);
begin
  miClear.Visible := vtList.RootNodeCount > 0;
end;

procedure TDlgCbMonMain.vtListFocusChanged(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex);
var
  pData: PCbEnt;
begin
  if Node = nil then
    exit;

  if Node = pRecentNode_ then
    exit;
  pRecentNode_ := Node;

  pData := vtList.GetNodeData(Node);
  case pData.Kind of
    ckText    :
    begin
      mmText.Text := pData.sData;
      cpMain.ActiveCard := cdText;
    end;
    ckHtml    :
    begin
      try
        web.Navigate('about:blank');
        while web.ReadyState < READYSTATE_INTERACTIVE do
         Application.ProcessMessages;

        if Assigned(web.Document) then
        begin
          var ss: TStringStream;
          Guard(ss, TStringStream.Create(pData.sData, TEncoding.UTF8));
//          var sl: TStringList;
//          Guard(sl, TStringList.Create);
//          sl.Text := pData.sData;
//          var ms: TMemoryStream;
//          Guard(ms, TMemoryStream.Create);
//          sl.SaveToStream(ms);
//          ms.Position := 0;
          (web.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ss));

//          var Doc: Variant := web.Document;
//          Doc.Clear;
//          Doc.Write(pData.sData);

        end;
        cpMain.ActiveCard := cdHtml;
      except
      // ..
      end;
    end;
    ckImage   :
    begin
      var pBuf: TBytes := DecodeBase64(pData.sData);
      var ms: TMemoryStream;
      Guard(ms, TMemoryStream.Create);
      ms.Write(pBuf[0], Length(pBuf));
      ms.Position := 0;
      imgEn.IO.LoadFromStreamJpeg(ms);
      cpMain.ActiveCard := cdImage;
    end;
    ckDirFile :
    begin
      var i: Integer;
      mmText.Clear;
      var StrList: TStringList;
      Guard(StrList, TStringList.Create);
      SplitString(pData.sData, '|', StrList);

      mmText.Lines.Add('ÆÄÀÏ/Æú´õ ¸ñ·Ï :');
      mmText.Lines.Add('');
      for i := 0 to StrList.Count - 1 do
        mmText.Lines.Add(StrList[i]);

      cpMain.ActiveCard := cdText;
    end;
  end;
end;

procedure TDlgCbMonMain.vtListFreeNode(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
var
  pData: PCbEnt;
begin
  pData := Sender.GetNodeData(Node);
  Finalize(pData^);
end;

procedure TDlgCbMonMain.vtListGetHint(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex;
  var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string);
begin
  HintText := vtList.Text[Node, Column];
end;

procedure TDlgCbMonMain.vtListGetNodeDataSize(Sender: TBaseVirtualTree;
  var NodeDataSize: Integer);
begin
  NodeDataSize := SizeOf(TCbEnt);
end;

procedure TDlgCbMonMain.vtListGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: string);
var
  pData: PCbEnt;
begin
  pData := Sender.GetNodeData(Node);

  case Column of
    0 : CellText := IntToStr(Node.Index + 1);
    1 : CellText := DateTimeToStr(pData.dtReg);
    2 : CellText := pData.sPName;
    3 : CellText := pData.sWndCap;
    4 :
    begin
      case pData.Kind of
        ckText    : CellText := 'ÅؽºÆ®';
        ckHtml    : CellText := 'HTML';
        ckImage   : CellText := 'À̹ÌÁö';
        ckDirFile : CellText := 'ÆÄÀÏ/Æú´õ';
      end;
    end;
    5 :
    begin
      case pData.Kind of
        ckText    : CellText := pData.sData;
        ckHtml    : CellText := '(HTML ÅؽºÆ®¸¦ È®ÀÎ ÇÏ·Á¸é Ŭ¸¯ ÇØÁÖ¼¼¿ä.)';
        ckImage   : CellText := '(À̹ÌÁö¸¦ È®ÀÎ ÇÏ·Á¸é Ŭ¸¯ ÇØÁÖ¼¼¿ä.)';
        ckDirFile : CellText := StringReplace(pData.sData, '|', ', ', [rfReplaceAll]);
      end;
    end;
  end;
end;

procedure TDlgCbMonMain.SetImageFit(bVal: Boolean);
begin
  begin
    imgEn.AutoFit := bVal;

    if bVal then
      imgEn.Fit
    else
      imgEn.Zoom := 100;

    imgEn.Update;

    miSetFit.Checked := bVal;
    miSetOrgSize.Checked := not bVal;
  end;
end;

end.