Procedure clickng(w:THandle);
begin
SendMessage(w, WM_LButtonDown, 1, 1);
SendMessage(w, WM_LButtonUP, 1, 1);
end;
SendMessage(w, WM_LBUTTONDOWN, MK_LBUTTON, MakeLong(xPos, yPos));не проще читается?
Procedure clickng(w:THandle);
var r,r2:TRect;
p:TPoint;
begin
getwindowrect(w,r);
p:=r.TopLeft;
SendMessage(w, WM_LBUTTONDOWN, MK_LBUTTON, MakeLong(p.x, p.y));
SendMessage(w, WM_LBUTTONUP, MK_LBUTTON, MakeLong(p.x,p.y));
end;
p:=r.TopLeft;Теперь нажимается?
ScreenToClient(w, p); // Я ж 2 раза написал - что относительно клиентской области КНОПКИ
SendMessage(w, WM_LBUTTONDOWN, MK_LBUTTON, MakeLong(p.x, p.y));
const kname='PrivatCom';
var kh,but1h:THandle;
Procedure clickng(w:THandle);
var r:TRect;
p:TPoint;
begin
getwindowrect(w,r);
p:=r.TopLeft;
ScreenToClient(w, p);
sendMessage(w, WM_LBUTTONDOWN, MK_LBUTTON, MakeLong(p.x, p.y));
sendMessage(w, WM_LBUTTONUP, MK_LBUTTON, MakeLong(p.x, p.y));
end;
function GetText(wnd:THandle):string;stdcall;
var p:array [0..pred(MAX_PATH)] of char;
begin
GetWindowText(wnd,p,max_path);
result:=strpas(p);
end;
var res:THandle;
fn:string;
function ChildTree(Han:THandle; Info: lparam):BOOL;stdcall;
var sp:string;
begin
sp:=ansiuppercase(gettext(han));
if pos(fn,sp)>0 then begin
res:=han;
result:=false;
end else result:=true;
end;
function findbut(h:THandle;fnk:string):THandle; //ищет дочерние окна h, в именах которых есть fnk
begin
res:=0;fn:=fnk;
enumChildWindows(h,@ChildTree, 0);
result:=res;
end;
function findnewk(k:THandle):THandle; //может быть несколько окон с одним caption-ом, ищет новое,
var d:integer; //если его нет, ждет пока оно появится 50 с.
begin
d:=0;result:=0;
repeat
result:=findbut(0,kname);
sleep(1);inc(d);
until ((result<>k) and (result<>0)) or (d=50000);
end;
Procedure kdown;
var k:THandle;
begin
kh:=findnewk(0);
sleep(3000); //надо ли?
if kh<>0 then but1h:=findbut(kh,'ПОДКЛЮЧЕНИЕ') else exit;
clickng(but1h);
end;
if pos(fn,sp)>0 then begin // Ищем заголовок, если учесть, что в fn находится заголовок, НЕ приведенный к верхнему регистру, то программа даже теоретически не может отработать. Никогда (поскольку 'PrivatCom' и 'PRIVATCOM' - это очень уж разные вещи для компьютера). Либо ты показываешь не тот код, который работает, либо выдаешь желаемое за действительное...
Procedure clickng(w:THandle);
begin
postmessage(winh,WM_COMMAND,MAKEWPARAM(GetDlgCtrlID(w),BN_CLICKED),winh);
end;
if Pos(WideUpperCase(WideString(sCaptionToFind)), WideUpperCase(WideString(GetText(h)))) > 0 then, и это работает, если исходник сохранен в UTF8 (я вообще взял себе за привычку все исходники сохранять в UTF8, а не в ANSI, не только дельфийские)
// ...
Function upppercase(s:string):string;
var i:integer;
begin
for i:=1 to length(s) do begin
if (s[i] in ['a'..'z']) or (s[i] in ['à'..'ÿ']) then s[i]:=chr(ord(s[i])-32);
end;
result:=s;
end;