summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--examples/gfx/subwindow/subwindow.pas2
-rw-r--r--prototypes/multihandle/gui2Base.pas120
-rw-r--r--prototypes/multihandle/test.lpi5
-rw-r--r--prototypes/multihandle/test.lpr11
4 files changed, 41 insertions, 97 deletions
diff --git a/examples/gfx/subwindow/subwindow.pas b/examples/gfx/subwindow/subwindow.pas
index 79547e9c..d7d46640 100644
--- a/examples/gfx/subwindow/subwindow.pas
+++ b/examples/gfx/subwindow/subwindow.pas
@@ -47,7 +47,7 @@ type
constructor TBoxWindow.Create(AParent: TFCustomWindow);
begin
- inherited Create(AParent, []);
+ inherited Create(AParent, [woChildWindow]);
OnMouseReleased := @MouseReleased;
OnPaint := @Paint;
diff --git a/prototypes/multihandle/gui2Base.pas b/prototypes/multihandle/gui2Base.pas
index e9f4dad8..214a8183 100644
--- a/prototypes/multihandle/gui2Base.pas
+++ b/prototypes/multihandle/gui2Base.pas
@@ -36,40 +36,26 @@ type
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property Color: TGfxColor read FColor write SetColor;
public
+ constructor Create(AParent: TFCustomWindow; AWindowOptions: TFWindowOptions); override;
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; virtual;
- property OnPainting: TNotifyEvent read FOnPainting write FOnPainting;
- property Color: TGfxColor read FColor write SetColor;
+
+ TForm = class(TWidget)
public
constructor Create(AParent: TFCustomWindow; AWindowOptions: TFWindowOptions); override;
- constructor Create; virtual;
- property OnClick: TNotifyEvent read FOnClick write FOnClick;
+ constructor Create; virtual; reintroduce;
+ property Color;
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: TFWindowOptions); override;
constructor Create; override;
end;
-
+
{ TButton }
TButton = class(TWidget)
@@ -80,7 +66,7 @@ type
protected
procedure Paint; override;
public
- constructor Create(AParent: TFCustomWindow; APosition: TPoint); overload;
+ constructor Create(AParent: TFCustomWindow; APosition: TPoint); overload; reintroduce;
property Caption: string read FCaption write SetCaption;
published
property OnClick;
@@ -95,11 +81,10 @@ type
protected
procedure Paint; override;
public
- constructor Create(AParent: TFCustomWindow; APosition: TPoint); overload;
+ constructor Create(AParent: TFCustomWindow; APosition: TPoint); overload; reintroduce;
property Caption: string read FCaption write SetCaption;
end;
-
-
+
{ TCustomEdit }
TCustomEdit = class(TWidget)
@@ -109,9 +94,11 @@ type
protected
procedure Paint; override;
public
- constructor Create(AParent: TFCustomWindow; APosition: TPoint); overload;
+ constructor Create(AParent: TFCustomWindow; APosition: TPoint); overload; reintroduce;
property Text: string read FText write SetText;
end;
+
+ { TEdit }
TEdit = class(TCustomEdit)
public
@@ -202,67 +189,34 @@ begin
Canvas.FillRect(r);
end;
-constructor TWidget.Create(AParent: TFCustomWindow);
+constructor TWidget.Create(AParent: TFCustomWindow;
+ AWindowOptions: TFWindowOptions);
begin
- inherited Create(AParent, []);
+ inherited Create(AParent, AWindowOptions);
FColor := colLtGray;
OnPaint := @EvOnPaint;
OnMouseReleased := @EvOnMousePress;
+ Title := ClassName;
end;
-{ TForm }
-
-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);
+constructor TWidget.Create(AParent: TFCustomWindow);
begin
- if FColor = AValue then exit;
- FColor := AValue;
- Paint;
+ Create(AParent, [woChildWindow]);
end;
-procedure TForm.Paint;
-var
- r: TRect;
-begin
- {$IFDEF DEBUG} Writeln(ClassName + '.Paint'); {$ENDIF}
- Canvas.SetColor(FColor);
- r.Left := 0;
- r.Top := 0;
- r.Right := Width;
- r.Bottom := Height;
- Canvas.FillRect(r);
-end;
+{ TForm }
-constructor TForm.Create(AParent: TFCustomWindow; AWindowOptions: TFWindowOptions);
+constructor TForm.Create(AParent: TFCustomWindow;
+ AWindowOptions: TFWindowOptions);
begin
inherited Create(AParent, AWindowOptions);
- FColor := colLtGray;
- OnPaint := @EvOnPaint;
end;
constructor TForm.Create;
begin
- Create(nil, [woWindow]);
+ inherited Create(nil, [woWindow]);
end;
-
{ TButton }
procedure TButton.EvOnPaint(Sender: TObject; const Rect: TRect);
@@ -306,7 +260,7 @@ var
begin
if FCaption=AValue then exit;
FCaption := AValue;
- Title := FCaption;
+
w := Canvas.TextWidth(FCaption) + 6;
h := Canvas.FontCellHeight + 4;
SetClientSize(Size(w, h));
@@ -332,30 +286,10 @@ 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: TFWindowOptions);
-begin
- inherited Create(AParent, AWindowOptions);
-// SetPosition();
- OnClick :=@PopupWindowClick;
-end;
-
constructor TPopupWindow.Create;
begin
-// Create(nil, [woPopup]);
- Create(nil, [woWindow]);
+// inherited Create(nil, [woPopup]);
+ inherited Create(nil, [woWindow]);
end;
{ TCustomEdit }
diff --git a/prototypes/multihandle/test.lpi b/prototypes/multihandle/test.lpi
index af9f5e1e..69e18f12 100644
--- a/prototypes/multihandle/test.lpi
+++ b/prototypes/multihandle/test.lpi
@@ -44,6 +44,11 @@
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
+ <Linking>
+ <Debugging>
+ <UseHeaptrc Value="True"/>
+ </Debugging>
+ </Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
diff --git a/prototypes/multihandle/test.lpr b/prototypes/multihandle/test.lpr
index 35651a5e..ca717ea1 100644
--- a/prototypes/multihandle/test.lpr
+++ b/prototypes/multihandle/test.lpr
@@ -42,13 +42,18 @@ type
public
constructor Create; override;
end;
+
+const
+ clBlue: TGfxColor = (Red: $0000; Green: $0000; Blue: $FF00; Alpha: 0);
+ clLightSteelBlue: TGfxColor = (Red: $B000; Green: $C400; Blue: $DE00; Alpha: 0);
{ TMyPopup }
constructor TMyPopup.Create;
begin
inherited Create;
- SetClientSize(Size(150, 320));
+ Title := 'My Popup';
+ SetClientSize(Size(180, 320));
end;
{ TMainWindow }
@@ -69,11 +74,10 @@ var
frm: TMyPopup;
begin
frm := TMyPopup.Create;
- frm.FParent := self;
GFApplication.AddWindow(frm);
+// frm.SetPosition(Point(0, btnPopup.Height));
frm.Show;
- frm.SetPosition(Point(0, btnPopup.Height));
end;
constructor TMainWindow.Create;
@@ -81,6 +85,7 @@ begin
inherited Create;
Title := 'fpGUI multi-handle example';
SetClientSize(Size(320, 200));
+ Color := clLightSteelBlue;
btnClose := TButton.Create(self, Point(20, 150));
btnClose.Caption := 'Close';
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-10-17 10:23:19 +0000