unit mainform; {NOTE DEVELOP VARIABLE FOR WORKING OUT OUTLINES} interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, ImgList, StdCtrls; type Tmain = class(TForm) focustimer: TTimer; procedure FormCreate(Sender: TObject); procedure cvMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure cvMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure cvMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure FormDestroy(Sender: TObject); procedure focustimerTimer(Sender: TObject); procedure FormActivate(Sender: TObject); procedure FormPaint(Sender: TObject); private { Private declarations } function AppHook(var message : Tmessage) : boolean; procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE; public { Public declarations } protected end; type tkey = record lowercase : string; uppercase : string; height : integer; width : single; picture : string; key : string; end; type trows = record key : array of tkey; count : integer; end; type tscangrid = record tr : trect; keyref : pointer; end; var main: Tmain; rows : array [1..6] of trows; scangrid : array of tscangrid; scangridcount : integer =0; keyheight : integer; keywidth : integer; bu,bd,e1,e2,s1,s2,blank : tbitmap; engageuptracker : integer; ent1,ent2 : tscangrid; shift1,shift2 : tscangrid; caps1 : tscangrid; curcase : boolean; shiftkey : boolean; capskey : boolean; window : hwnd; mshand : thandle; dosmode : boolean = false; function drawkey(x,y : integer;pos : byte) : tkey; procedure sendkey(key : string); const WS_EX_NOACTIVATE = 00000; DEVELOP = FALSE; implementation {$R *.DFM} {$R emposkgraphics.res} procedure setoutline; var rs : tresourcestream; sngs : tstringlist; n : integer; ori : string; key : integer; pt : array[0..50] of tagPoint; rgn : hrgn; begin if paramstr(4)<>'d' then if paramstr(4)='' then rs:=tresourcestream.Create(HInstance,'OUTLINE',RT_RCDATA) else rs:=tresourcestream.Create(HInstance,'ALPHAOUTLINE',RT_RCDATA) else begin rs:=tresourcestream.Create(HInstance,'OUTLINE',RT_RCDATA); dosmode:=true; end; sngs:=tstringlist.create; sngs.LoadFromStream(rs); n:=0; while (n<sngs.Count) do begin ori:=copy(sngs.Strings[n],1,2); key:=strtoint(copy(sngs.Strings[n],3,2)); if ori='TL' then begin pt[n].x:=scangrid[key].tr.left; pt[n].y:=scangrid[key].tr.top; end; if ori='TR' then begin pt[n].x:=scangrid[key].tr.right; pt[n].y:=scangrid[key].tr.top; end; if ori='BR' then begin pt[n].x:=scangrid[key].tr.right; pt[n].y:=scangrid[key].tr.bottom; end; if ori='BL' then begin pt[n].x:=scangrid[key].tr.left; pt[n].y:=scangrid[key].tr.bottom; end; inc(n); end; rgn:=CreatePolygonRgn(pt,n,WINDING); setwindowrgn(main.handle,rgn,true); rs.free; sngs.free; end; procedure initmailslot; begin //MAILSLOT_WAIT_FOREVER mshand:=createmailslot('\.\mailslot\LSOSK1',0, 200000,nil); if mshand=INVALID_HANDLE_VALUE then halt; end; function readmailslot : string; var messz : cardinal; mescnt,rd : dword; res : array [0..255] of char; readtimeout : dword; begin readtimeout:=2000; messz:=0; getmailslotinfo(mshand,nil,messz,@mescnt,nil); sleep(10); result:=''; if (messz<>0) and (mescnt<>0) then begin readfile(mshand,res,messz,rd,nil); result:=res; end; end; procedure Tmain.WMMouseActivate(var Message: TWMMouseActivate); begin Message.result := MA_NOACTIVATE; if window<>0 then setforegroundwindow(window); end; function tmain.AppHook(var message : Tmessage) : boolean; begin if (message.Msg=WM_QUIT) or (message.Msg=WM_CLOSE) then begin halt; end; result:=false; end; procedure drawlabel(scan : tscangrid;size : integer); var x,y : integer; s : string; begin with main do begin canvas.Brush.Style:=bsClear; canvas.font.color:=clwhite; if size=1 then canvas.font.size:=12; if size=2 then canvas.font.size:=10; s:=tkey(scan.keyref^).lowercase; if capskey=true then begin if (ord(s[1])>96) and (ord(s[1])<123) then s:=tkey(scan.keyref^).uppercase; end; if (shiftkey=true) then s:=tkey(scan.keyref^).uppercase; if tkey(scan.keyref^).lowercase[1]='|' then s:='Enter'; x:=scan.tr.left+ ((scan.tr.right-scan.tr.left) div 2) - ((canvas.textwidth(s) div 2)); y:=scan.tr.Top + ((scan.tr.bottom-scan.tr.top) div 2) - ((canvas.textheight(s) div 2)); {relabel shift key} if tkey(scan.keyref^).lowercase[2]='H' then s:='SHIFT'; if tkey(scan.keyref^).lowercase[2]='P' then s:=' '; if tkey(scan.keyref^).lowercase='NULL' then s:=''; canvas.textout(x,y,s); tkey(scan.keyref^).key:=s; end; end; procedure drawkeys; var x,lastx,xx,y,lasty : integer; tr : trect; begin scangridcount:=0; setlength(scangrid,0); with main do begin for y:=1 to 5 do begin lastx:=0; x:=0; lasty:=(y*keyheight)-keyheight; for xx:=1 to rows[y].count do begin x:=x+round(keywidth*rows[y].key[xx].width); if rows[y].key[xx].lowercase<>'NUL' then begin //canvas.rectangle(lastx,lasty,x,lasty+(keyheight*rows[y].key[xx].height)); tr.left:=lastx; tr.top:=lasty; tr.right:=x; tr.bottom:=lasty+(keyheight*rows[y].key[xx].height); inc(scangridcount); setlength(scangrid,scangridcount+1); scangrid[scangridcount].tr:=tr; scangrid[scangridcount].keyref:=@rows[y].key[xx]; //canvas.stretchdraw(tr,bu); if rows[y].key[xx].lowercase='|1' then ent1:=scangrid[scangridcount]; if rows[y].key[xx].lowercase='|2' then ent2:=scangrid[scangridcount]; if rows[y].key[xx].lowercase='SHIFTL' then shift1:=scangrid[scangridcount]; if rows[y].key[xx].lowercase='SHIFTR' then begin; shift2:=scangrid[scangridcount]; end; if rows[y].key[xx].lowercase='Caps Lock' then caps1:=scangrid[scangridcount]; //if (rows[y].key[xx].lowercase[1]<>'|') then drawlabel(scangrid[scangridcount],1); end; lastx:=x; end; end; end; for x := 0 to scangridcount do begin drawkey(scangrid[x].tr.Left+1,scangrid[x].tr.top+1,1); end; end; procedure getkeyinfo; var k : tkey; ln : string; rowcount : integer; n : integer; sngs : tstringlist; rs : tresourcestream; x : integer; function getparam : string; var p : integer; begin p:=pos(',',ln); if p<>0 then begin result:=copy(ln,1,p-1); ln:=copy(ln,p+1,length(ln)-p); end else begin result:=ln; ln:=''; end; end; function getline : tkey; begin result.lowercase:=getparam; if result.lowercase='COMMA' then result.lowercase:=','; if result.lowercase='APOST' then result.lowercase:=''''; result.uppercase:=getparam; if result.uppercase='QUOTE' then result.uppercase:='"'; result.width:=strtofloat(getparam); result.height:=strtoint(getparam); result.picture:=getparam; end; begin window:=getforegroundwindow; if paramstr(4)='' then rs:=tresourcestream.Create(HInstance,'LAYOUT',RT_RCDATA) else rs:=tresourcestream.Create(HInstance,'ALPHA',RT_RCDATA); sngs:=tstringlist.create; sngs.LoadFromStream(rs); rowcount:=1; x:=0; while (x<sngs.Count) do begin ln:=sngs.Strings[x]; inc(x); k:=getline; inc(rows[rowcount].count); setlength(rows[rowcount].key,rows[rowcount].count+1); rows[rowcount].key[rows[rowcount].count]:=k; if k.lowercase='ROW' then begin dec(rows[rowcount].count); setlength(rows[rowcount].key,rows[rowcount].count+1); inc(rowcount); end; end; for n:=0 to (rows[1].count) do begin keywidth:=round(keywidth+rows[1].key[n].width); end; keywidth:=round(main.width / keywidth); keyheight:=main.height div 5; end; procedure Tmain.FormCreate(Sender: TObject); var a,scrap : integer; begin initmailslot; application.HookMainWindow(AppHook); bu := tbitmap.create; bu.LoadFromResourceName(HInstance,'KU'); bd := tbitmap.create; bd.LoadFromResourceName(HInstance,'KD'); e1 := tbitmap.create; e1.LoadFromResourceName(HInstance,'E2U'); e2 := tbitmap.create; e2.LoadFromResourceName(HInstance,'E2D'); s1 := tbitmap.create; s1.LoadFromResourceName(HInstance,'SPACEUP'); s2 := tbitmap.create; s2.LoadFromResourceName(HInstance,'SPACEDOWN'); blank := tbitmap.create; blank.LoadFromResourceName(HInstance,'BLANK'); val(paramstr(1),a,scrap); if a=0 then a:=screen.Height div 2; Main.height:=a; top:=screen.height-main.height; main.left:=0; val(paramstr(2),a,scrap); if a=0 then main.width:=screen.width else main.width:=screen.width-a; main.left:=(screen.width div 2)-(main.width div 2); val(paramstr(3),a,scrap); if a<>0 then main.top:=main.top-a; getkeyinfo; main.doublebuffered:=true; end; function iskey (key : tscangrid;x,y : integer) : boolean; begin result:=false; if (x>=key.tr.left) and (x<=key.tr.right) and (y>=key.tr.top) and (y<=key.tr.bottom) then begin result:=true; end; end; function drawkey(x,y : integer;pos : byte) : tkey; var n : integer; keymap : tbitmap; p:boolean; begin keymap:=tbitmap.create; for n:=1 to scangridcount do begin if iskey(scangrid[n],x,y) then begin if pos=0 then begin keymap.assign(bd); if (tkey(scangrid[n].keyref^).lowercase[1]='|') then begin main.canvas.stretchdraw(ent1.tr,e2); main.canvas.stretchdraw(ent2.tr,e2); if (tkey(scangrid[n].keyref^).lowercase[2]='2') then drawlabel(ent2,1); engageuptracker:=n; break; end; if (tkey(scangrid[n].keyref^).lowercase='NULL') then keymap.assign(BLANK); if (tkey(scangrid[n].keyref^).lowercase='SPACE') then begin keymap.assign(s2); end; if (tkey(scangrid[n].keyref^).lowercase='SHIFTL') or (tkey(scangrid[n].keyref^).lowercase='SPACER') then begin if shiftkey=true then keymap.assign(s1) else keymap.assign(s2); end; if (tkey(scangrid[n].keyref^).lowercase='Backspace') then keymap.assign(s2); if (tkey(scangrid[n].keyref^).lowercase='Caps Lock') then begin if capskey=true then keymap.assign(s1) else keymap.assign(s2); end; main.canvas.stretchdraw(scangrid[n].tr,keymap); drawlabel(scangrid[n],2); engageuptracker:=n; end; if pos=1 then begin keymap.assign(bu); if (tkey(scangrid[n].keyref^).lowercase[1]='|') then begin main.canvas.stretchdraw(ent1.tr,e1); main.canvas.stretchdraw(ent2.tr,e1); if (tkey(scangrid[n].keyref^).lowercase[2]='2') then drawlabel(ent2,1); engageuptracker:=n; break; end; if (tkey(scangrid[n].keyref^).lowercase='NULL') then keymap.assign(BLANK); if (tkey(scangrid[n].keyref^).lowercase='SPACE') then keymap.assign(s1); if (tkey(scangrid[n].keyref^).lowercase='SHIFTL') or (tkey(scangrid[n].keyref^).lowercase='SHIFTR')then begin if shiftkey=true then keymap.assign(s2) else keymap.assign(s1); end; if (tkey(scangrid[n].keyref^).lowercase='Backspace') then keymap.assign(s1); if (tkey(scangrid[n].keyref^).lowercase='Caps Lock') then begin if capskey=true then keymap.assign(s2) else keymap.assign(s1); end; if (tkey(scangrid[n].keyref^).lowercase<>'NULL') then main.canvas.stretchdraw(scangrid[n].tr,keymap); drawlabel(scangrid[n],1); engageuptracker:=-1; end; break; end; end; keymap.free; result:=tkey(scangrid[n].keyref^); end; procedure Tmain.cvMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Var k : tkey; n : integer; begin if DEVELOP=true then begin for n:=0 to scangridcount do begin if iskey(scangrid[n],x,y) then begin messagedlg('Key no: '+inttostr(n)+' - '+inttostr(scangrid[n].tr.Top)+':'+inttostr(scangrid[n].tr.Left)+':'+inttostr(scangrid[n].tr.Right)+':'+inttostr(scangrid[n].tr.Bottom)+':' ,mtconfirmation,[mbOk],0); break; end; end; end; if iskey(shift1,x,y) or iskey(shift2,x,y) then begin if shiftkey=true then shiftkey:=false else shiftkey:=true; curcase:=shiftkey; drawkeys; exit; end; if iskey(caps1,x,y) then begin if capskey=true then capskey:=false else capskey:=true; keybd_event(VK_CAPITAL,0,0,0); keybd_event(VK_CAPITAL,0,KEYEVENTF_KEYUP,0); curcase:=capskey; shiftkey:=false; drawkeys; exit; end; k:=drawkey(x,y,0); sendkey(k.key); if shiftkey=true then begin;curcase:=false;shiftkey:=false;drawkeys;end; end; procedure Tmain.FormClose(Sender: TObject; var Action: TCloseAction); begin bu.free; end; procedure Tmain.cvMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var k : tkey; begin drawkey(x,y,1); end; procedure Tmain.cvMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if engageuptracker<>-1 then begin if (x<=scangrid[engageuptracker].tr.left) or (x>=scangrid[engageuptracker].tr.right) or (y<=scangrid[engageuptracker].tr.top) or (y>=scangrid[engageuptracker].tr.bottom) then begin drawkeys; engageuptracker:=-1; end; end; end; procedure Tmain.FormDestroy(Sender: TObject); begin Application.UnHookMainWindow(AppHook); end; procedure sendkey(key : string); var c : shortint; begin if length(key)=1 then c:=vkkeyscan(key[1]) else begin if uppercase(key)='SPACE' then c:=vkkeyscan(key[1]); if uppercase(key)='ENTER' then c:=vk_Return; if uppercase(key)='TAB' then c:=vk_Tab; if uppercase(key)='BACKSPACE' then c:=vk_back; end; if shiftkey=true then keybd_event(VK_SHIFT,0,0,0); keybd_event(c,0,0,0); keybd_event(c,0,KEYEVENTF_KEYUP,0); if shiftkey=true then keybd_event(VK_SHIFT,0,KEYEVENTF_KEYUP,0); end; procedure Tmain.focustimerTimer(Sender: TObject); var w : hwnd; begin w:=getforegroundwindow; if (w<>application.Handle) and (w<>main.handle) then window:=w; end; procedure Tmain.FormActivate(Sender: TObject); begin setforegroundwindow(window); drawkeys; setoutline; while(readmailslot='') do begin application.ProcessMessages; end; application.terminate; end; procedure Tmain.FormPaint(Sender: TObject); begin drawkeys; end; end.