Mega Code Archive
Sendkeys ile diger uygulamalara tuş basımı yollamak
<![CDATA[
{***********************************************************************}
{Send Keys e kolay ve güzel bir ornek.. ----- VB versiyonu alttadır.
{Murat Cem Yalın
{muratcem54@hotmail.com
{hakkı makkı yoktur...(c)}
{***********************************************************************}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Memo2: TMemo;
Timer1: TTimer;
procedure Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
i:integer;
begin
memo2.Lines.add(inttostr(key));//memo2 ye key kodlarını atıyor...
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
timer1.Enabled:=true;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
winhand:Hwnd;
i,x:integer;
begin
//Herhangi bir pencereyi aktif yapabilmek için timera yazdım ve 3 sn yeye ayarladım...
timer1.Enabled:=false;
WinHand := GetActiveWindow; //aktif pencereyi alıyor...
SetForegroundWindow(WinHand);
for i:=0 to memo2.Lines.Count-1 do //harfleri yazması için döngü...
begin
keybd_event(strtoint(memo2.Lines[i]), 0, 0, 0); //memo2 den karakterleri alıp yolluyor...
keybd_event(strtoint(memo2.Lines[i]), 0, KEYEVENTF_KEYUP, 0);
end;
end;
end.
------------------- Visual Basic versiyonu------------------------
Private Sub Command1_Click()
npad = Shell("notepad.exe", vbNormalFocus)
AppActivate npad
SendKeys ("Hesap makinesinde bir hesap yapılıp, ")
SendKeys ("sonuç buraya kopyalanacaktır:" & Chr$(13)), True
clc = Shell("calc.exe", vbNormalFocus)
AppActivate clc
SendKeys Text1 & "-" & Text2 & "=", True 'True ile tuş yollama bitene kadar bekleme yapılır
SendKeys "^C", True '^ simgesi CTRL tuşudur
If Check1 Then SendKeys "%{F4}", True '% ile ALT tuşu taklit ediliyor
AppActivate npad
SendKeys ("Sonuç=" & "^v"), True
End Sub
]]>