492 lines
12 KiB
Plaintext
492 lines
12 KiB
Plaintext
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('Ŭ<><C5AC><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'),
|
||
PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then exit;
|
||
|
||
FreeAndNil(CbMon_)
|
||
end;
|
||
|
||
if CbMon_ = nil then
|
||
btnCbMon.Caption := 'Ŭ<><C5AC><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>'
|
||
else
|
||
btnCbMon.Caption := 'Ŭ<><C5AC><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>';
|
||
|
||
Application.ProcessMessages;
|
||
end;
|
||
|
||
procedure TDlgCbMonMain.miClearClick(Sender: TObject);
|
||
begin
|
||
if MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ʱ<EFBFBD>ȭ <20>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'),
|
||
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('<27><><EFBFBD><EFBFBD>/<2F><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> :');
|
||
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 := '<27>ؽ<EFBFBD>Ʈ';
|
||
ckHtml : CellText := 'HTML';
|
||
ckImage : CellText := '<27>̹<EFBFBD><CCB9><EFBFBD>';
|
||
ckDirFile : CellText := '<27><><EFBFBD><EFBFBD>/<2F><><EFBFBD><EFBFBD>';
|
||
end;
|
||
end;
|
||
5 :
|
||
begin
|
||
case pData.Kind of
|
||
ckText : CellText := pData.sData;
|
||
ckHtml : CellText := '(HTML <20>ؽ<EFBFBD>Ʈ<EFBFBD><C6AE> Ȯ<><C8AE> <20>Ϸ<EFBFBD><CFB7><EFBFBD> Ŭ<><C5AC> <20><><EFBFBD>ּ<EFBFBD><D6BC><EFBFBD>.)';
|
||
ckImage : CellText := '(<28>̹<EFBFBD><CCB9><EFBFBD><EFBFBD><EFBFBD> Ȯ<><C8AE> <20>Ϸ<EFBFBD><CFB7><EFBFBD> Ŭ<><C5AC> <20><><EFBFBD>ּ<EFBFBD><D6BC><EFBFBD>.)';
|
||
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.
|