I'm making a procedure that I can call like showmessage to produce a popup that mimics a current text based application. I have it to the point where I can assign the onkeypress from the created form to a procedure in the same code but I don't seem to be receiving the key press. Here is the code for the procedure:
unit Popups;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,Dialogs,Forms,Variables,Controls,StdCtrls,Graphics,ExtCtrls,LCLType;
procedure ShowWarning(DisplayText:string);
procedure ShowWarningFormPaint(ASelf:TForm;Sender :TObject);
Procedure SetColors(Sender:Tform);
procedure OnTimer(ASelf:TForm;Sender :TObject);
procedure WarningKeypress(Sender: TObject; var Key: Word; Shift: TShiftState);
implementation
Procedure SetColors(Sender:Tform);
var
I:integer;
Begin
i := Sender.ControlCount;
for i := 0 to Sender.ControlCount - 1 do
begin
if Sender.Controls is TLabel then
begin Sender.Controls.Font.Color := BoldTextColor end;
if Sender.Controls is TLabel then
begin Sender.Controls.Color := BoldTextBackColor end;
if Sender.Controls is TEdit then
begin Sender.Controls.Font.Color := UnderLineTextColor end;
if Sender.Controls is TEdit then
begin Sender.Controls.Color := UnderLineTextBackColor end;
if Sender.Controls is TShape then
begin (Sender.Controls as TShape).Brush.Color := NormalTextColor end;
if Sender.Controls is TStaticText then
begin Sender.Controls.Font.Color := BoldTextColor end;
if Sender.Controls is TStaticText then
begin Sender.Controls.Color := BoldTextColor end;
end;
Sender.Color := NormalTextBackColor;
end;
procedure ShowWarning(DisplayText:string);
var
Dlg : TForm;
MyMethod:TMethod;
TimerMethod:TMethod;
WarningMethod:TMethod;
OkBtn: TButton;
Title : TLabel;
WarningTxt: TLabel;
WarningOK: TLabel;
Timer1:TTimer;
loop,txtwidth,txtheight:integer;
begin
Dlg := TForm.Create(application);
Title := TLabel.Create(Dlg);
WarningTxt := TLabel.Create(Dlg);
WarningOK := TLabel.Create(Dlg);
Timer1 := TTimer.Create(Dlg);
MyMethod.Code :=@ShowWarningFormPaint;
MyMethod.Data := Dlg;
WarningMethod.Code := @WarningKeypress;
WarningMethod.Data := Dlg;
TimerMethod.Code :=@OnTimer;
TimerMethod.Data := Dlg;
with Dlg do
begin
OnPaint :=TNotifyEvent(MyMethod);
OnKeyDown := TKeyEvent(WarningMethod);
Position := poScreenCenter;
Caption := '';
//width := 425;
width := (dlg.Canvas.TextWidth(DisplayText))*2;
height := 150;
Color := NormalTextBackColor;
Font.Color := NormalTextColor;
Font.Height:= 17;
BorderStyle := bsnone;
Canvas.Refresh ;
end;
with Timer1 do
begin
OnTimer :=TNotifyEvent(TimerMethod);
end;
with Title do
begin
Parent := Dlg;
txtwidth := Canvas.TextWidth(' ERROR ');
top := TForm(Owner).Top;
Left := TForm(Owner).Left + round((dlg.Width / 2)- (txtwidth / 2));
Caption := ' Error ';
WordWrap := false;
Width:= 60;
height := 40;
Visible := true;
end;
with WarningTxt do
begin
Parent := Dlg;
txtwidth := Canvas.TextWidth(DisplayText);
top := TForm(Owner).Top+50;
Left := TForm(Owner).Left + round((dlg.Width / 2)- (txtwidth / 2));
Caption := DisplayText;
WordWrap := false;
//Width:= 50;
height := 40;
Visible := true;
end;
with WarningOK do
begin
Parent := Dlg;
txtwidth := Canvas.TextWidth('OK');
top := TForm(Owner).Top+100;
Left := TForm(Owner).Left + round((dlg.Width / 2)- (txtwidth / 2));
Caption := 'OK';
WordWrap := false;
//Width:= 50;
height := 40;
Visible := true;
Name:='WarningOK';
end;
SetColors(Dlg);
Dlg.ShowModal;
Dlg.Free;
Title.Free;
WarningTxt.Free ;
WarningOK.Free;
end;
procedure ShowWarningFormPaint(ASelf:TForm;Sender :TObject);
var
BoxHeight,BoxWidth,MenuHeight,MenuWidth,Margin,FrameOffset : integer;
begin
Margin := 10;
FrameOffset := 2;
BoxHeight := ASelf.Height - Margin;
BoxWidth := ASelf.Width - Margin;
ASelf.Canvas.Pen.Color := clwhite;
ASelf.Canvas.Pen.Width :=1;
ASelf.Canvas.Line(Margin + FrameOffset,Margin + FrameOffset,BoxWidth-FrameOffset,Margin+FrameOffset);
ASelf.Canvas.Pen.Color := cldkgray;
ASelf.Canvas.LineTo(BoxWidth-FrameOffset,BoxHeight-FrameOffset);
ASelf.Canvas.LineTo(Margin+FrameOffset,BoxHeight-FrameOffset);
ASelf.Canvas.Pen.Color := clwhite;
ASelf.Canvas.LineTo(Margin + FrameOffset,Margin + FrameOffset);
ASelf.Canvas.Pen.Color := cldkgray;
ASelf.Canvas.Line(Margin ,Margin,BoxWidth,Margin);
ASelf.Canvas.Pen.Color := clwhite;
ASelf.Canvas.LineTo(BoxWidth,BoxHeight);
ASelf.Canvas.LineTo(Margin,BoxHeight);
ASelf.Canvas.Pen.Color := cldkgray;
ASelf.Canvas.LineTo(Margin,Margin);
end;
procedure OnTimer(ASelf:TForm;Sender :TObject);
begin
if (aself.FindComponent('WarningOK') as TLabel).Visible then
begin;
(aself.FindComponent('WarningOK') as TLabel).Visible := false;
end
else
begin
(aself.FindComponent('WarningOK') as TLabel).Visible := true;
end;
end;
procedure WarningKeypress(Sender: TObject; var Key: Word; Shift: TShiftState);
var
MyMessage:String;
begin
if key = VK_END then showmessage('END Pressed');
showmessage('Got Here!');
end;
end.
---------------------------------------------------------------------------------------------
I get the onkeydown event but the key variable does not seem to be the same as a normal onkeydown event. I pulled the entire onkeydown header off a form to make sure I was using the variables in the same order in case that was messing things up but while I get a 'key' that is a word It doesn't seem to correspond to things like VK_END that I need to compare it against.
Ideas???
Recent
