Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2004.08.15;
Скачать: [xml.tar.bz2];

Вниз

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

 
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 вся ветка

Форум: "WinAPI";
Текущий архив: 2004.08.15;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.029 c
3-1089877633
just
2004-07-15 11:47
2004.08.15
MS SQL + ADO


14-1090471679
syte_ser78
2004-07-22 08:47
2004.08.15
Как уговорить "звукозапись" писать больше одной минуты?


3-1090388844
RavenD
2004-07-21 09:47
2004.08.15
Блокирует ли FireBird записи?


1-1091023975
race1
2004-07-28 18:12
2004.08.15
хитрый массив


6-1087146782
Apocalepse
2004-06-13 21:13
2004.08.15
Socket!!! глючит что то с сокетом





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский