Как нажать кнопку и получить текст. Пример [D7, WinXP]
Cara © (2004-07-01 11:00:00)
Добрый день.
Как в чужой программе нажать на определённую кнопку.
Желательно пример.
Например в стандартном Windows калькуляторе нажать на 2 + 2 =
(c моей программы)а результат вывести в ShowMessage.
ZrenBy (2004-07-01 12:13:00) [1]
unit Main;
//Нажимаем кнопки и меню в чужом приложении
//Игрушки с калькулятором
//!!! Работает только с русским калькулятором
interface
uses
Windows,Messages,Classes,Forms,Controls,StdCtrls,SysUtils,PSAPI;
type TfMain = class(TForm)
Button1 : TButton;
procedure FormCreate (Sender: TObject);
procedure FormShow (Sender:
TObject);
procedure FormClose (Sender: TObject;
var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
private
hCalc : HWND;
hEdit : HWND;
slCommand : TStringList;
public
end;
function U_ECWProc (hW:HWND;
lP:LPARAM):Boolean;stdcall;
procedure U_ViewMenu (hM:HMENU;lP:LPARAM);
var fMain: TfMain;
implementation
{$R *.dfm}
procedure TfMain.FormCreate(Sender: TObject);
begin
hCalc := 0;
hEdit := 0;
slCommand := TStringList.Create;
end;
procedure TfMain.FormClose(Sender: TObject; var Action:
TCloseAction);
begin
slCommand.Clear; slCommand.Free;
if(hCalc0)then PostMessage(hCalc,WM_QUIT,0,0);
end;
procedure TfMain.FormShow(Sender: TObject);
begin
slCommand.Clear;
WinExec('calc.exe',SW_SHOWNORMAL);
Sleep(100);
hCalc := FindWindow(nil,LPSTR('Калькулятор'));
if(hCalc=0)then raise Exception.Create('...');
U_ViewMenu(GetMenu(hCalc),LPARAM(slCommand));
//Переводим в инженерный вид
SendMessage(hCalc,WM_COMMAND,StrToInt(slCommand.Values['Инженерный']),0);
//Если вид меняется, надо перебрать по-новой
hCalc := FindWindow(nil,LPSTR('Калькулятор'));
if(hCalc=0)then raise Exception.Create('...');
slCommand.Clear;
U_ViewMenu(GetMenu(hCalc),LPARAM(slCommand));
EnumChildWindows(hCalc,@U_ECWProc,LPARAM(slCommand));
end;
procedure U_ViewMenu(hM:HMENU;lP:LPARAM);
var i,j,k:Integer; S:String; wID:WORD;
begin
if(hM=0)then Exit;
k := GetMenuItemCount(hM);
for i:=0 to(k-1)do begin
SetLength(S,255);
GetMenuString(hM,i,LPTSTR(S),254,MF_BYPOSITION);
S := PChar(S);
try
wID := GetMenuItemID(hM,i);
while True do begin
j := Pos('&',S); if(j=0)then
Break;
Delete(S,j,1);
end;
TStringList(lP).Add(S+'='+IntToStr(wID));
except end;
U_ViewMenu(GetSubMenu(hM,i),lP);
end;
end;
function U_ECWProc(hW:HWND;lP:LPARAM):Boolean;stdcall;
var S1,S2:String; wID:WORD;
begin
SetLength(S1,SendMessage(hW,WM_GETTEXTLENGTH,0,0)+1);
SetLength(S1,SendMessage(hW,WM_GETTEXT,Length(S1),LPARAM(S1)));
SetLength(S2,255); GetClassName(hW,LPTSTR(S2),254); S2
:= PChar(S2);
wID := LOWORD(GetWindowLong(hW,GWL_ID));
if((S1'')and(S2='Button'))then begin
if(S1='=')then S1 := 'Enter';
TStringList(lP).Add(S1+'='+IntToStr(wID));
end;
if(S2='Edit')then begin
fMain.hEdit := hw;
end;
Result := True;
end;
procedure TfMain.Button1Click(Sender: TObject);
var S:String;
begin
SendMessage(hCalc,WM_COMMAND,StrToInt(slCommand.Values['2']),0);
SendMessage(hCalc,WM_COMMAND,StrToInt(slCommand.Values['+']),0);
SendMessage(hCalc,WM_COMMAND,StrToInt(slCommand.Values['3']),0);
SendMessage(hCalc,WM_COMMAND,StrToInt(slCommand.Values['Enter']),0);
SendMessage(hCalc,WM_COMMAND,StrToInt(slCommand.Values['*']),0);
SendMessage(hCalc,WM_COMMAND,StrToInt(slCommand.Values['1']),0);
SendMessage(hCalc,WM_COMMAND,StrToInt(slCommand.Values['2']),0);
SendMessage(hCalc,WM_COMMAND,StrToInt(slCommand.Values['3']),0);
SendMessage(hCalc,WM_COMMAND,StrToInt(slCommand.Values['Enter']),0);
//Это не совсем правильно, но работает
SetLength(S,SendMessage(hEdit,WM_GETTEXTLENGTH,0,0)+1);
SetLength(S,SendMessage(hEdit,WM_GETTEXT,Length(S),LPARAM(S)));
Application.MessageBox(PChar(S),'Результат',0);
end;
end.
Наверх 
ЧАТ |
Орешник |
|
