?? unit1.pas
字號:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls, CommCtrl, WinSkinData;
type
TFRM = class(TForm)
Button1: TButton;
Edit1: TEdit;
Lv: TListView;
Button2: TButton;
ComboBox1: TComboBox;
Button3: TButton;
Edit2: TEdit;
Button4: TButton;
Timer: TTimer;
Label1: TLabel;
Button5: TButton;
Edit3: TEdit;
CB: TCheckBox;
DateTimePicker1: TDateTimePicker;
Button6: TButton;
Edit4: TEdit;
Button7: TButton;
CBB: TCheckBox;
SkinData1: TSkinData;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure LvClick(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button7Click(Sender: TObject);
private
HotkeyID:Integer;
procedure ShorCut(var Msg:TMessage); Message WM_HOTKEY;
{ Private declarations }
public
{ Public declarations }
end;
function EnumChildWndProc(AhWnd:LongInt;AlParam:lParam):boolean;stdcall;
function GetText(IHwnd:LongInt):String;
procedure Delay(const uDelay: DWORD);
procedure SendDBCSString(hFocus: HWND; const sSend: string);
procedure sendpaste(Hwnd:THandle);
var
FRM: TFRM;
implementation
{$R *.dfm}
//枚舉控件句柄過程
function EnumChildWndProc(AHWnd:LongInt;ALParam:LParam):boolean;stdcall;
var
WndClassName:Array [0..254] of Char;
Li:TListItem;
begin
GetClassName(AHWnd,wndClassName,255);
with FRM do
begin
Li:=Lv.Items.Add;
Li.Caption:=String(wndClassName);
Li.SubItems.Add(GetText(AHWnd));
Li.SubItems.Add(inttostr(AHWnd));
end;
result:=true;
end;
//獲取控件文本
function GetText(IHwnd:LongInt):String;
var
TextLen:LongInt;
TextStr:Array [0..254] of Char;
begin
TextLen:=SendMessage(IHwnd, WM_GETTEXTLENGTH, 0, 0);
if TextLen=0 Then
begin
Result:='>No Text<';
Exit;
end;
SendMessage(IHwnd, WM_GETTEXT, 255, Integer(@TextStr));
Result:=StrPas(@TextStr);
end;
procedure TFRM.Button1Click(Sender: TObject);
var
HD:LongInt;
begin
Lv.Clear;
HD:=FindWindow(nil,pchar(Edit1.Text));
if HD<>0 then
begin
EnumChildWindows(HD,@EnumChildWndProc,0);
end
else
MessageBox(Self.Handle,'沒找到該窗口句柄','提示',0);
end;
procedure TFRM.Button2Click(Sender: TObject);
var
HD:THandle;
i:Integer;
PStr:Array [0..254] of Char;
begin
if Lv.ItemIndex>=0 then
begin
HD:=StrToInt(Lv.Selected.SubItems.Strings[1]);
for i:=0 to SendMessage(HD,CB_GETCOUNT,0,0)-1 do begin
SendMessage(HD,CB_GETLBTEXT,i,Integer(@PStr));
if Edit1.Text=string(PStr) then
SendMessage(HD,CB_SETCURSEL,i,0);
end;
end
else
Showmessage('沒有選擇句柄!');
end;
procedure TFRM.Button3Click(Sender: TObject);
var
HD:THandle;
str:string;
i:integer;
begin
if Lv.ItemIndex>=0 then
begin
HD:=StrToInt(Lv.Selected.SubItems.Strings[1]);
str:=edit2.Text;
SendMessage(HD,WM_SETTEXT,255,integer(pchar('')));
for i:=1 to length(str) do
if i mod 2>0 then
begin
SendDBCSString(HD,copy(str,i,2));
end;
SendMessage(HD,WM_CHAR,13,0);
end
else
Showmessage('沒有選擇句柄!');
end;
procedure TFRM.Button4Click(Sender: TObject);
begin
Timer.Enabled:=Not Timer.Enabled;
end;
procedure TFRM.TimerTimer(Sender: TObject);
var
Point:TPoint;
HD:THandle;
WndClassName:Array [0..254] of Char;
Li:TListItem;
begin
GetCursorPos(Point);
HD:=WindowFromPoint(point);
Lv.Clear;
if HD>0 then
begin
GetClassName(HD,wndClassName,255);
Label1.Caption:='類名:'+ string(wndClassName)+' '+
'名稱:'+ GetText(HD)+' '+
'句柄:'+ inttostr(HD);
if CBB.Checked then
begin
Li:=Lv.Items.Add;
Li.Caption:=String(wndClassName);
Li.SubItems.Add(GetText(HD));
Li.SubItems.Add(inttostr(HD));
end
else
EnumChildWindows(HD,@EnumChildWndProc,0);
end;
if cb.Checked then SendMessage(HD,WM_NEXTDLGCTL,0,0);
end;
procedure Delay(const uDelay: DWORD);
var
n: DWORD;
begin
n := GetTickCount;
while ((GetTickCount - n) <= uDelay) do
Application.ProcessMessages;
end;
procedure TFRM.Button5Click(Sender: TObject);
var
HD:THandle;
begin
if Lv.ItemIndex>=0 then
begin
HD:=StrToInt(Lv.Selected.SubItems.Strings[1]);
SendMessage(HD, WM_SETFOCUS, 0, 0);
sendpaste(HD);
end
else
Showmessage('沒有選擇句柄!');
end;
procedure SendDBCSString(hFocus: HWND; const sSend: string);
var
i : integer;
ch : byte;
begin
i := 1;
while i <= Length(sSend) do begin
ch := byte(sSend[i]);
if Windows.IsDBCSLeadByte(ch) then
begin
Inc(i);
SendMessage(hFocus, WM_IME_CHAR, MakeWord(byte(sSend[i]), ch), 0);
end
else
SendMessage(hFocus, WM_IME_CHAR, word(ch), 0);
Inc(i);
end;
end;
procedure sendpaste(Hwnd:THandle);
begin
keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), 0, 0);
SendMessage(Hwnd,WM_KEYDOWN, 37, 0);
keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), KEYEVENTF_KEYUP, 0);
end;
procedure TFRM.LvClick(Sender: TObject);
begin
if Lv.ItemIndex>=0 then
Edit3.Text:=Lv.Selected.SubItems.Strings[0];
end;
procedure TFRM.Button6Click(Sender: TObject);
var
HD:THandle;
ST:TSystemTime;
begin
if Lv.ItemIndex>=0 then
begin
HD:=StrToInt(Lv.Selected.SubItems.Strings[1]);
DateTimetoSystemTime(StrtoDateTime(Edit4.Text),ST);
SendMessage(HD, DTM_SETSYSTEMTIME, 0, Integer(@ST));
end
else
Showmessage('沒有選擇句柄!');
end;
procedure TFRM.ShorCut(var Msg:TMessage);
begin
Msg.Result:=1; //表示消息已經用過!
Application.BringToFront;
Timer.Enabled:=False;
end;
procedure TFRM.FormCreate(Sender: TObject);
begin
HotkeyID:=GlobalAddATom('FRMKey');
RegisterHotkey(Handle,HotkeyID,Mod_Win,$53);
end;
procedure TFRM.FormDestroy(Sender: TObject);
begin
UnregisterHotKey(Handle,HotkeyID);
end;
procedure TFRM.Button7Click(Sender: TObject);
begin
Close;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -