summaryrefslogtreecommitdiff
path: root/prototypes
diff options
context:
space:
mode:
Diffstat (limited to 'prototypes')
-rw-r--r--prototypes/multihandle/gui2Base.pas105
-rw-r--r--prototypes/multihandle/test.lpi7
-rw-r--r--prototypes/multihandle/test.lpr34
3 files changed, 130 insertions, 16 deletions
diff --git a/prototypes/multihandle/gui2Base.pas b/prototypes/multihandle/gui2Base.pas
index 4b294e2c..bb7fae0b 100644
--- a/prototypes/multihandle/gui2Base.pas
+++ b/prototypes/multihandle/gui2Base.pas
@@ -36,16 +36,38 @@ type
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property Color: TGfxColor read FColor write SetColor;
public
- constructor Create(AParent: TFCustomWindow);
+ constructor Create(AParent: TFCustomWindow); overload;
end;
{ TForm }
-
+ {$Note Can we get TForm descending from TWidget? Here is too much duplication. }
TForm = class(TFWindow)
+ private
+ FColor: TGfxColor;
+ FOnClick: TNotifyEvent;
+ FOnPainting: TNotifyEvent;
+ procedure EvOnPaint(Sender: TObject; const Rect: TRect); virtual;
+ procedure EvOnMousePress(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
+ procedure SetColor(const AValue: TGfxColor);
protected
- procedure Paint(Sender: TObject; const Rect: TRect);
+ procedure Paint; virtual;
+ property OnPainting: TNotifyEvent read FOnPainting write FOnPainting;
+ property Color: TGfxColor read FColor write SetColor;
public
+ constructor Create(AParent: TFCustomWindow; AWindowOptions: TGfxWindowOptions); override;
constructor Create; virtual;
+ property OnClick: TNotifyEvent read FOnClick write FOnClick;
+ end;
+
+ { TPopupWindow }
+ {$Note TPopupWindow is still work in progess. }
+ TPopupWindow = class(TForm)
+ protected
+ procedure PopupWindowClick(Sender: TObject);
+ procedure Paint; override;
+ public
+ constructor Create(AParent: TFCustomWindow; AWindowOptions: TGfxWindowOptions); override;
+ constructor Create; override;
end;
{ TButton }
@@ -58,7 +80,7 @@ type
protected
procedure Paint; override;
public
- constructor Create(AParent: TFCustomWindow; APosition: TPoint);
+ constructor Create(AParent: TFCustomWindow; APosition: TPoint); overload;
property Caption: string read FCaption write SetCaption;
published
property OnClick;
@@ -73,7 +95,7 @@ type
protected
procedure Paint; override;
public
- constructor Create(AParent: TFCustomWindow; APosition: TPoint);
+ constructor Create(AParent: TFCustomWindow; APosition: TPoint); overload;
property Caption: string read FCaption write SetCaption;
end;
@@ -102,8 +124,8 @@ end;
procedure TWidget.SetColor(const AValue: TGfxColor);
begin
- if FColor=AValue then exit;
- FColor:=AValue;
+ if FColor = AValue then exit;
+ FColor := AValue;
Paint;
end;
@@ -130,12 +152,37 @@ end;
{ TForm }
-procedure TForm.Paint(Sender: TObject; const Rect: TRect);
+procedure TForm.EvOnPaint(Sender: TObject; const Rect: TRect);
+begin
+ {$IFDEF DEBUG} Writeln(ClassName + '.Paint'); {$ENDIF}
+ if Assigned(OnPainting) then
+ OnPainting(self);
+ Paint;
+end;
+
+procedure TForm.EvOnMousePress(Sender: TObject; AButton: TMouseButton;
+ AShift: TShiftState; const AMousePos: TPoint);
+begin
+ if AButton = mbLeft then
+ begin
+ if Assigned(OnClick) then
+ OnClick(self);
+ end;
+end;
+
+procedure TForm.SetColor(const AValue: TGfxColor);
+begin
+ if FColor = AValue then exit;
+ FColor := AValue;
+ Paint;
+end;
+
+procedure TForm.Paint;
var
r: TRect;
begin
{$IFDEF DEBUG} Writeln(ClassName + '.Paint'); {$ENDIF}
- Canvas.SetColor(colWhite);
+ Canvas.SetColor(FColor);
r.Left := 0;
r.Top := 0;
r.Right := Width;
@@ -143,10 +190,17 @@ begin
Canvas.FillRect(r);
end;
+constructor TForm.Create(AParent: TFCustomWindow;
+ AWindowOptions: TGfxWindowOptions);
+begin
+ inherited Create(AParent, AWindowOptions);
+ FColor := colWhite;
+ OnPaint := @EvOnPaint;
+end;
+
constructor TForm.Create;
begin
- inherited Create(nil, [woWindow]);
- OnPaint := @Paint;
+ Create(nil, [woWindow]);
end;
{ TButton }
@@ -216,5 +270,34 @@ begin
SetClientSize(Size(75, 22));
end;
+{ TPopupWindow }
+
+procedure TPopupWindow.PopupWindowClick(Sender: TObject);
+begin
+ Writeln(ClassName + '.HandleOnClick');
+// GFApplication.Forms.Remove(self);
+// Free;
+
+end;
+
+procedure TPopupWindow.Paint;
+begin
+ inherited Paint;
+end;
+
+constructor TPopupWindow.Create(AParent: TFCustomWindow;
+ AWindowOptions: TGfxWindowOptions);
+begin
+ inherited Create(AParent, AWindowOptions);
+// SetPosition();
+ OnClick :=@PopupWindowClick;
+end;
+
+constructor TPopupWindow.Create;
+begin
+// Create(nil, [woPopup]);
+ Create(nil, [woWindow]);
+end;
+
end.
diff --git a/prototypes/multihandle/test.lpi b/prototypes/multihandle/test.lpi
index 9934c06d..af9f5e1e 100644
--- a/prototypes/multihandle/test.lpi
+++ b/prototypes/multihandle/test.lpi
@@ -1,7 +1,7 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
- <PathDelim Value="\"/>
+ <PathDelim Value="/"/>
<Version Value="5"/>
<General>
<Flags>
@@ -17,15 +17,13 @@
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
- <DestinationDirectory Value="$(TestDir)\publishedproject\"/>
- <IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
- <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+ <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
@@ -43,7 +41,6 @@
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
- <PathDelim Value="\"/>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
diff --git a/prototypes/multihandle/test.lpr b/prototypes/multihandle/test.lpr
index 9239179f..4da7f9e7 100644
--- a/prototypes/multihandle/test.lpr
+++ b/prototypes/multihandle/test.lpr
@@ -25,14 +25,30 @@ type
TMainWindow = class(TForm)
procedure btnCancelClick(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
+ procedure btnPopupClick(Sender: TObject);
private
btnClose: TButton;
btnCancel: TButton;
+ btnPopup: TButton;
lblWelcome: TLabel;
public
constructor Create; override;
destructor Destroy; override;
end;
+
+
+ TMyPopup = class(TPopupWindow)
+ public
+ constructor Create; override;
+ end;
+
+{ TMyPopup }
+
+constructor TMyPopup.Create;
+begin
+ inherited Create;
+ SetClientSize(Size(150, 320));
+end;
{ TMainWindow }
@@ -47,6 +63,18 @@ begin
GFApplication.Quit;
end;
+procedure TMainWindow.btnPopupClick(Sender: TObject);
+var
+ frm: TMyPopup;
+begin
+ frm := TMyPopup.Create;
+ frm.FParent := self;
+
+ GFApplication.AddWindow(frm);
+ frm.Show;
+ frm.SetPosition(Point(0, btnPopup.Height));
+end;
+
constructor TMainWindow.Create;
begin
inherited Create;
@@ -61,6 +89,10 @@ begin
btnCancel.Caption := 'Cancel';
btnCancel.OnClick := @btnCancelClick;
+ btnPopup := TButton.Create(self, Point(80, 80));
+ btnPopup.Caption := 'Popup';
+ btnPopup.OnClick := @btnPopupClick;
+
lblWelcome := TLabel.Create(self, Point(10, 10));
lblWelcome.Caption := 'So what do you think?';
end;
@@ -69,6 +101,8 @@ destructor TMainWindow.Destroy;
begin
btnClose.Free;
btnCancel.Free;
+ btnPopup.Free;
+ lblWelcome.Free;
inherited Destroy;
end;
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-10-17 06:33:45 +0000