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
|
{
$Id: disp_bmp.pp,v 1.6 2001/02/14 23:08:59 sg Exp $
fpImg - Free Pascal Imaging Library
Copyright (C) 2000 - 2001 by
Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org
Example: Display BMP file
See the file COPYING, included in this distribution,
for details about the copyright.
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 Disp_BMP;
uses Classes, GFXBase, GFXImpl, fpImg, BMPReader;
type
TMainWindow = class
procedure Paint(Sender: TObject; const Rect: TRect);
private
Display: TDefDisplay;
Window: TGfxWindow;
Image: TGfxImage;
public
constructor Create(ADisplay: TDefDisplay);
destructor Destroy; override;
end;
constructor TMainWindow.Create(ADisplay: TDefDisplay);
begin
inherited Create;
Display := ADisplay;
Image := CreateImageFromFile(Display.DefaultScreen, TBMPReader, ParamStr(1));
Window := ADisplay.DefaultScreen.CreateWindow;
Window.Title := 'fpImg Bitmap Test';
Window.OnPaint := @Paint;
Window.SetFixedClientSize(Size(Image.Width, Image.Height));
Window.Show;
end;
destructor TMainWindow.Destroy;
begin
Image.Free;
inherited Destroy;
end;
procedure TMainWindow.Paint(Sender: TObject; const Rect: TRect);
begin
Window.Canvas.SetColor(colRed);
Window.Canvas.FillRect(Rect);
Window.Canvas.SetColor(colYellow);
Window.Canvas.DrawImage(Image, Point(0, 0));
end;
var
Display: TDefDisplay;
MainWindow: TMainWindow;
begin
if ParamCount <> 1 then
begin
WriteLn(StdErr, 'Please give the name of a BMP file as argument');
Halt(2);
end;
Display := TDefDisplay.Create;
MainWindow := TMainWindow.Create(Display);
Display.Run;
MainWindow.Free;
Display.Free;
end.
{
$Log: disp_bmp.pp,v $
Revision 1.6 2001/02/14 23:08:59 sg
* Adapted to changes in fpGFX interface
Revision 1.5 2001/02/09 20:49:03 sg
* Adapted to recent improvements in fpGFX interfaces
Revision 1.4 2001/01/11 23:21:53 sg
*** empty log message ***
}
|
