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
|
{
fpGUI - Free Pascal GUI Library
Image Test example
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 ImgTest;
{$ifdef fpc}
{$mode objfpc}{$H+}
{$endif}
uses
cmem,
Classes,
GFXBase,
fpGFX;
type
TMainWindow = class(TFWindow)
private
Bitmap: TFBitmap;
procedure Paint(Sender: TObject; const Rect: TRect);
public
constructor Create; overload;
destructor Destroy; override;
end;
constructor TMainWindow.Create;
var
Data: Pointer;
Stride: LongWord;
i, j: Integer;
begin
inherited Create(nil, [woWindow]);
Data := nil;
Stride := 0;
Title := 'fpGFX Bitmap Test';
OnPaint := @Paint;
SetClientSize(Size(256, 256));
SetMinMaxClientSize(Size(256, 256), Size(256, 256));
Bitmap := TFBitmap.Create(256, 256, PixelFormatRGB32);
Bitmap.Lock(Data, Stride);
for j := 0 to 255 do
for i := 0 to 255 do
PLongWord(Data)[j * 256 + i] := (i shl 16) or (j shl 8);
Bitmap.Unlock;
end;
destructor TMainWindow.Destroy;
begin
Bitmap.Free;
inherited Destroy;
end;
procedure TMainWindow.Paint(Sender: TObject; const Rect: TRect);
begin
Canvas.SetColor(colBlue);
Canvas.FillRect(Rect);
Canvas.DrawImage(Bitmap, Point(0, 0));
end;
var
MainWindow: TMainWindow;
begin
GFApplication.Initialize;
MainWindow := TMainWindow.Create;
GFApplication.AddWindow(MainWindow);
MainWindow.Show;
GFApplication.Run;
end.
|
