Mega Code Archive
Stop and wait for a key
<![CDATA[
Maybe I've invented the wheel once again, but I couldn't find anything that did what I wanted to do so...
I was writing a program and wanted to stop execution from code, and then continue executing when pressing a key. My solution is creating a form and making it invisible by setting Width and Height to zero. When I want the program to stop, I do a ShowModal on the Form and look for the OnKeyPress-Event.
If you want the component it's here.
unit wkey;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, FileCtrl, ComCtrls;
type
TKeyIn = (AnyKey,a,b,c,d,e,f,g,h,i,j,k,l,m,n,&l
t;/
FONT>o,p,q,r,s,t,u,v,w,x,y,z);
TWKey = class(TComponent)
private
DForm: TForm;
DLabel: TLabel;
FKey: TKeyIn;
PKey: string;
FShow: Boolean;
FPosition: TPosition;
FColor: TColor;
procedure SetKey(Value: TKeyIn);
procedure KeyPressed(Sender: TObject; var Key: char);
procedure SetShowMessage(Value: Boolean);
procedure SetMessagePosition(Value: TPosition);
procedure SetMessageColor(Value: TColor);
{ Private declarations }
protected
{ Protected declarations }
public
procedure Wait;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
{ Public declarations }
published
property KeyToPress: TKeyIn read FKey write SetKey;
property ShowMessage: Boolean read FShow write SetShowMessage;
property MessagePosition: TPosition read FPosition write SetMessagePosition;
property MessageColor: TColor read FColor write SetMessageColor;
{ Published declarations }
end;
implementation
constructor TWKey.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
DForm:= TForm.Create(Self);
DLabel:= TLabel.Create(Self);
DLabel.Parent:= DForm;
DForm.Color:= clYellow;
DForm.Position:= poScreenCenter;
DForm.Borderstyle:= bsNone;
DLabel.Top:= 5;
DLabel.Left:= 5;
DForm.OnKeyPress:= KeyPressed;
FKey:= AnyKey;
FShow:= true;
FColor:= clYellow;
FPosition:= poMainFormCenter;
FCop:= '2000 (C), MASoft';
end;
procedure TWKey.KeyPressed(Sender: TObject; var Key: char);
var OK: Boolean;
begin
OK:= false;
case FKey of
AnyKey: OK:= true;
a: if Key = 'a' then OK:= true;
b: if Key = 'b' then OK:= true;
c: if Key = 'c' then OK:= true;
d: if Key = 'd' then OK:= true;
E: if Key = 'e' then OK:= true;
F: if Key = 'f' then OK:= true;
g: if Key = 'g' then OK:= true;
h: if Key = 'h' then OK:= true;
i: if Key = 'i' then OK:= true;
j: if Key = 'j' then OK:= true;
k: if Key = 'k' then OK:= true;
l: if Key = 'l' then OK:= true;
m: if Key = 'm' then OK:= true;
n: if Key = 'n' then OK:= true;
o: if Key = 'o' then OK:= true;
p: if Key = 'p' then OK:= true;
q: if Key = 'q' then OK:= true;
r: if Key = 'r' then OK:= true;
S: if Key = 's' then OK:= true;
t: if Key = 't' then OK:= true;
u: if Key = 'u' then OK:= true;
v: if Key = 'v' then OK:= true;
w: if Key = 'w' then OK:= true;
x: if Key = 'x' then OK:= true;
y: if Key = 'y' then OK:= true;
z: if Key = 'z' then OK:= true;
end;
if OK then DForm.ModalResult:= mrOK;
end;
destructor TWKey.Destroy;
begin
DLabel.Free;
DForm.Free;
inherited Destroy;
end;
procedure TWKey.Wait;
begin
if FShow then
begin
DForm.Width:= 125;
DForm.Height:= 24;
if FKey = AnyKey then DLabel.Caption:= 'Press a key to continue.' else
DLabel.Caption:= 'Press ' + PKey + ' to continue.';
end
else
begin
DForm.Width:= 0;
DForm.Height:= 0;
end;
if DForm.ShowModal = mrOK then
end;
procedure TWKey.SetKey(Value: TKeyIn);
begin
FKey:= Value;
case FKey of
AnyKey: PKey:= 'a key';
a: PKey:= '<a>';
b: PKey:= '<b>';
c: PKey:= '<c>';
d: PKey:= '<d>';
E: PKey:= '<e>';
F: PKey:= '<f>';
g: PKey:= '<g>';
h: PKey:= '<h>';
i: PKey:= '<i>';
j: PKey:= '<j>';
k: PKey:= '<k>';
l: PKey:= '<l>';
m: PKey:= '<m>';
n: PKey:= '<n>';
o: PKey:= '<o>';
p: PKey:= '<p>';
q: PKey:= '<q>';
r: PKey:= '<r>';
S: PKey:= '<s>';
t: PKey:= '<t>';
u: PKey:= '<u>';
v: PKey:= '<v>';
w: PKey:= '<w>';
x: PKey:= '<x>';
y: PKey:= '<y>';
z: PKey:= '<z>';
end;
end;
procedure TWKey.SetShowMessage(Value: Boolean);
begin
FShow:= Value;
end;
procedure TWKey.SetMessagePosition(Value: TPosition);
begin
FPosition:= Value;
DForm.Position:= FPosition;
end;
procedure TWKey.SetMessageColor(Value: TColor);
begin
FColor:= Value;
DForm.Color:= FColor;
end;
end.
]]>