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
|
{
fpGUI - Free Pascal GUI Toolkit
Copyright (C) 2006 - 2008 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.
Description:
A simple hello world application that only uses canvas painting.
}
program HelloWorld;
{$mode objfpc}{$H+}
uses
Classes,
fpg_base,
fpg_main;
const
HelloWorldString: String = 'Hello, world!';
type
TMainWindow = class(TfpgWindow)
private
procedure MsgPaint(var msg: TfpgMessageRec); message FPGM_PAINT;
procedure MsgClose(var msg: TfpgMessageRec); message FPGM_CLOSE;
procedure MsgResize(var msg: TfpgMessageRec); message FPGM_RESIZE;
public
constructor Create(AOwner: TComponent); override;
procedure Show;
end;
constructor TMainWindow.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FWidth := 350;
FHeight := 200;
WindowAttributes := [waSizeable, waScreenCenterPos];
end;
procedure TMainWindow.Show;
begin
AllocateWindowHandle;
DoSetWindowVisible(True);
// We can't set a title if we don't have a window handle. So we do that here
// and not in the constructor.
SetWindowTitle('fpGFX Hello World');
end;
procedure TMainWindow.MsgPaint(var msg: TfpgMessageRec);
var
Color: TfpgColor;
r: TfpgRect;
i: Integer;
begin
Canvas.BeginDraw; // begin double buffering
Color := 0;
r.SetRect(0, 0, Width, 1);
for i := 0 to FHeight-1 do
begin
Color := $ff - (i * $ff) div FHeight; // shades of Blue
Canvas.SetColor(Color);
r.Top := i;
Canvas.DrawRectangle(r);
end;
Canvas.Font := fpgGetFont('Arial-30');
Canvas.SetTextColor(clBlack);
Canvas.DrawString((Width - Canvas.Font.TextWidth(HelloWorldString)) div 2 + 1,
(Height - Canvas.Font.Height) div 2 + 1, HelloWorldString);
Canvas.SetTextColor(clWhite);
Canvas.DrawString((Width - Canvas.Font.TextWidth(HelloWorldString)) div 2 - 1,
(Height - Canvas.Font.Height) div 2 - 1, HelloWorldString);
Canvas.EndDraw;
end;
procedure TMainWindow.MsgClose(var msg: TfpgMessageRec);
begin
ReleaseWindowHandle;
Halt(0);
end;
procedure TMainWindow.MsgResize(var msg: TfpgMessageRec);
begin
FWidth := msg.Params.rect.Width;
FHeight := msg.Params.rect.Height;
end;
var
MainWindow: TMainWindow;
begin
fpgApplication.Initialize;
MainWindow := TMainWindow.Create(nil);
MainWindow.Show;
fpgApplication.Run;
MainWindow.Free;
end.
|
