paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 10:39:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Implement missing abstract methods DoDraw, DoCopyRect

Browse Source 
git-svn-id: trunk@36403 -
This commit is contained in:
michael 2017-06-03 05:13:45 +00:00
parent 0fe12f2087
commit f6dde8b4b0
1 changed files with 31 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
packages/fcl-image/src/fppixlcanv.pp
View File

@ -28,14 +28,18 @@ type
PixelCanvasException = class (TFPCanvasException); PixelCanvasException = class (TFPCanvasException);
{ TFPPixelCanvas }
TFPPixelCanvas = class (TFPCustomCanvas) TFPPixelCanvas = class (TFPCustomCanvas)
private private
FHashWidth : word; FHashWidth : word;
FRelativeBI : boolean; FRelativeBI : boolean;
protected protected
procedure DoCopyRect(x, y: integer; canvas: TFPCustomCanvas; const SourceRect: TRect); override;
function DoCreateDefaultFont : TFPCustomFont; override; function DoCreateDefaultFont : TFPCustomFont; override;
function DoCreateDefaultPen : TFPCustomPen; override; function DoCreateDefaultPen : TFPCustomPen; override;
function DoCreateDefaultBrush : TFPCustomBrush; override; function DoCreateDefaultBrush : TFPCustomBrush; override;
procedure DoDraw(x, y: integer; const image: TFPCustomImage); override;
procedure DoTextOut (x,y:integer;text:string); override; procedure DoTextOut (x,y:integer;text:string); override;
procedure DoGetTextSize (text:string; var w,h:integer); override; procedure DoGetTextSize (text:string; var w,h:integer); override;
function DoGetTextHeight (text:string) : integer; override; function DoGetTextHeight (text:string) : integer; override;
@ -73,12 +77,26 @@ begin
raise PixelCanvasException.Create(sErrNotAvailable); raise PixelCanvasException.Create(sErrNotAvailable);
end; end;
constructor TFPPixelCanvas.Create; constructor TFPPixelCanvas.create;
begin begin
inherited; inherited;
FHashWidth := DefaultHashWidth; FHashWidth := DefaultHashWidth;
end; end;
procedure TFPPixelCanvas.DoCopyRect(x, y: integer; canvas: TFPCustomCanvas; const SourceRect: TRect);
Var
W,H,XS1,XS2,YS1,YS2 : Integer;
begin
XS1:=SourceRect.Left;
XS2:=SourceRect.Right;
YS1:=SourceRect.Top;
YS2:=SourceRect.Bottom;
For H:=0 to YS2-YS1 do
For W:=0 to XS2-XS1 do
Colors[x+h,y+h]:=Canvas.Colors[XS1+W,YS1+H];
end;
function TFPPixelCanvas.DoCreateDefaultFont : TFPCustomFont; function TFPPixelCanvas.DoCreateDefaultFont : TFPCustomFont;
begin begin
result := TFPEmptyFont.Create; result := TFPEmptyFont.Create;
@ -108,6 +126,17 @@ begin
result.Style := bsSolid; result.Style := bsSolid;
end; end;
procedure TFPPixelCanvas.DoDraw(x, y: integer; const image: TFPCustomImage);
Var
W,h : Integer;
begin
For H:=0 to Image.Height-1 do
For W:=0 to Image.Width-1 do
Colors[x+w,y+h]:=Image.Colors[W,H];
end;
procedure TFPPixelCanvas.DoTextOut (x,y:integer;text:string); procedure TFPPixelCanvas.DoTextOut (x,y:integer;text:string);
begin begin
NotImplemented; NotImplemented;
@ -365,4 +394,5 @@ begin
end; end;
end; end;
end. end.