1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
{
fpGUI - Free Pascal GUI Library
SubWindow - Shows how to create a Sub-Window on GFX
Copyright (C) 2000 - 2006 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
for details about redistributing fpGUI.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
program subwindow;
uses
SysUtils, Classes,
fpGFX, GFXBase, fpgfxpackage;
{ Disable this to hide Paint event writeln's. Move another Application over
SubWindow application, to see when Paint event fires for TBoxWindow or
TMainWindow. }
{$Define DEBUG}
type
{ TBoxWindow }
TBoxWindow = class(TFWindow)
public
constructor Create(AParent: TFCustomWindow);
procedure Paint(Sender: TObject; const Rect: TRect);
procedure MouseReleased(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
end;
{ TMainWindow }
TMainWindow = class(TFWindow)
public
ABox: TBoxWindow;
constructor Create;
procedure Paint(Sender: TObject; const Rect: TRect);
procedure MouseReleased(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
end;
constructor TBoxWindow.Create(AParent: TFCustomWindow);
begin
inherited Create(AParent, [woChildWindow]);
OnMouseReleased := @MouseReleased;
OnPaint := @Paint;
SetClientSize(Size(125, 125));
SetMinMaxClientSize(Size(125, 125), Size(125, 125));
end;
procedure TBoxWindow.MouseReleased(Sender: TObject; AButton: TMouseButton;
AShift: TShiftState; const AMousePos: TPoint);
begin
WriteLn('Mouse released on child window');
end;
procedure TBoxWindow.Paint(Sender: TObject; const Rect: TRect);
var
r: TRect;
tw: integer;
begin
{$IFDEF DEBUG} Writeln(ClassName + '.Paint'); {$ENDIF}
Canvas.SetColor(colBlue);
r.Left := 0;
r.Top := 0;
r.Right := Width;
r.Bottom := Height;
Canvas.FillRect(r);
tw := Canvas.TextWidth('Window 2');
Canvas.SetColor(colWhite);
Canvas.TextOut(Point((Width div 2) - (tw div 2), Height - 20), 'Window 2');
end;
constructor TMainWindow.Create;
begin
inherited Create(nil, [woWindow]);
Title := 'fpGFX Sub-Window example';
SetClientSize(Size(256, 256));
SetMinMaxClientSize(Size(256, 256), Size(256, 256));
OnMouseReleased := @MouseReleased;
OnPaint := @Paint;
ABox := TBoxWindow.Create(Self);
ABox.Show;
end;
procedure TMainWindow.Paint(Sender: TObject; const Rect: TRect);
var
r: TRect;
tw: integer;
begin
{$IFDEF DEBUG} Writeln(ClassName + '.Paint'); {$ENDIF}
Canvas.SetColor(colLtGray);
r.Left := 0;
r.Top := 0;
r.Right := Width;
r.Bottom := Height;
Canvas.FillRect(r);
tw := Canvas.TextWidth('Window 1');
Canvas.SetColor(colBlack);
Canvas.TextOut(Point((Width div 2) - (tw div 2), ClientHeight - 20), 'Window 1');
end;
procedure TMainWindow.MouseReleased(Sender: TObject; AButton: TMouseButton;
AShift: TShiftState; const AMousePos: TPoint);
begin
WriteLn('Mouse released on main window');
end;
var
MainWindow: TMainWindow;
begin
GFApplication.Initialize;
MainWindow := TMainWindow.Create;
GFApplication.AddWindow(MainWindow);
MainWindow.Show;
GFApplication.Run;
end.
|
