Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2004.08.15;
Скачать: CL | DM;

Вниз

Как нажать кнопку и получить текст. Пример   Найти похожие ветки 

 
Cara ©   (2004-07-01 11:00) [0]

Добрый день.
Как в чужой программе нажать на определённую кнопку.
Желательно пример.
Например в стандартном Windows калькуляторе нажать на 2 + 2 = (c моей программы)а результат вывести в ShowMessage.


 
ZrenBy ©   (2004-07-01 12:13) [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(hCalc<>0)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.



Страницы: 1 вся ветка

Текущий архив: 2004.08.15;
Скачать: CL | DM;

Наверх




Память: 0.46 MB
Время: 0.023 c
6-1085680133
Delpher_Gray
2004-05-27 21:48
2004.08.15
Тормоза TIdHTTP


8-1085705549
MicroMozg
2004-05-28 04:52
2004.08.15
Плагины от Winamp а.


4-1088666904
Wistler
2004-07-01 11:28
2004.08.15
Работа с пользователями в домени WinNT


4-1088605120
Paulik
2004-06-30 18:18
2004.08.15
Странность в работе с DLL под Delphi и Visual Basic


3-1090308165
yuray
2004-07-20 11:22
2004.08.15
IB6 SS на Linux (RH9)-сервер





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский