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
|
{
This file is part of the Free Pascal run time library.
Copyright (c) 2003 by the Free Pascal development team
Image Canvas - canvas which draws on an image.
See the file COPYING.FPC, 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.
**********************************************************************}
{$mode objfpc}{$h+}
unit FPImgCanv;
interface
uses FPPixlCanv, FPImage, classes;
type
TFPImageCanvas = class (TFPPixelCanvas)
protected
FImage : TFPCustomImage;
procedure SetColor (x,y:integer; const AValue:TFPColor); override;
function GetColor (x,y:integer) : TFPColor; override;
procedure SetHeight (AValue : integer); override;
function GetHeight : integer; override;
procedure SetWidth (AValue : integer); override;
function GetWidth : integer; override;
public
constructor create (AnImage : TFPCustomImage);
destructor destroy; override;
property Image : TFPCustomImage read FImage write FImage;
end;
implementation
uses clipping;
constructor TFPImageCanvas.create (AnImage : TFPCustomImage);
begin
inherited Create;
FImage := AnImage;
end;
destructor TFPImageCanvas.destroy;
begin
inherited destroy;
end;
procedure TFPImageCanvas.SetColor (x,y:integer; const AValue:TFPColor);
begin
if (x >= 0) and (x < width) and (y >= 0) and (y < height) then
if not clipping or PointInside (x,y, ClipRect) then
FImage.Colors[x,y] := AValue;
end;
function TFPImageCanvas.GetColor (x,y:integer) : TFPColor;
begin
if (x >= 0) and (x < width) and (y >= 0) and (y < height) then
result := FImage.Colors[x,y]
else
result := colTransparent;
end;
procedure TFPImageCanvas.SetHeight (AValue : integer);
begin
FImage.Height := AValue;
end;
function TFPImageCanvas.GetHeight : integer;
begin
result := FImage.Height;
end;
procedure TFPImageCanvas.SetWidth (AValue : integer);
begin
FImage.Width := AValue;
end;
function TFPImageCanvas.GetWidth : integer;
begin
result := FImage.Width;
end;
end.
|
