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.
