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

+ Some changes for Mattias Gaertner, to use canvas in Lazarus

Browse Source
This commit is contained in:
michael 2004-12-22 07:46:53 +00:00
parent 7abb28ded4
commit 2691c08656
3 changed files with 11 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
fcl/image/fpcanvas.pp
View File

@ -32,7 +32,7 @@ type
TFPCustomCanvas = class; TFPCustomCanvas = class;
TFPCanvasHelper = class TFPCanvasHelper = class(TPersistent)
private private
FColor : TFPColor; FColor : TFPColor;
FAllocated, FAllocated,
@ -98,26 +98,26 @@ type
TFPCustomPen = class (TFPCanvasHelper) TFPCustomPen = class (TFPCanvasHelper)
private private
FStyle : TFPPenStyle; FStyle : TFPPenStyle;
FWidth : byte; FWidth : Integer;
FMode : TFPPenMode; FMode : TFPPenMode;
FPattern : longword; FPattern : longword;
protected protected
procedure DoCopyProps (From:TFPCanvasHelper); override; procedure DoCopyProps (From:TFPCanvasHelper); override;
procedure SetMode (AValue : TFPPenMode); virtual; procedure SetMode (AValue : TFPPenMode); virtual;
procedure SetWidth (AValue : byte); virtual; procedure SetWidth (AValue : Integer); virtual;
procedure SetStyle (AValue : TFPPenStyle); virtual; procedure SetStyle (AValue : TFPPenStyle); virtual;
procedure SetPattern (AValue : longword); virtual; procedure SetPattern (AValue : longword); virtual;
public public
function CopyPen : TFPCustomPen; function CopyPen : TFPCustomPen;
// Creates a copy of the pen with all properties the same, but not allocated // Creates a copy of the pen with all properties the same, but not allocated
property Style : TFPPenStyle read FStyle write SetStyle; property Style : TFPPenStyle read FStyle write SetStyle;
property Width : byte read FWidth write SetWidth; property Width : Integer read FWidth write SetWidth;
property Mode : TFPPenMode read FMode write SetMode; property Mode : TFPPenMode read FMode write SetMode;
property Pattern : longword read FPattern write SetPattern; property Pattern : longword read FPattern write SetPattern;
end; end;
TFPCustomPenClass = class of TFPCustomPen; TFPCustomPenClass = class of TFPCustomPen;
TFPBrushStyle = (bsClear, bsSolid, bsDiagonal, bsFDiagonal, bsCross, bsDiagCross, TFPBrushStyle = (bsClear, bsSolid, bsBDiagonal, bsFDiagonal, bsCross, bsDiagCross,
bsHorizontal, bsVertical, bsImage, bsPattern); bsHorizontal, bsVertical, bsImage, bsPattern);
TBrushPattern = array[0..PatternBitCount-1] of TPenPattern; TBrushPattern = array[0..PatternBitCount-1] of TPenPattern;
PBrushPattern = ^TBrushPattern; PBrushPattern = ^TBrushPattern;
@ -199,8 +199,8 @@ type
procedure DoMoveTo (x,y:integer); virtual; procedure DoMoveTo (x,y:integer); virtual;
procedure DoLineTo (x,y:integer); virtual; procedure DoLineTo (x,y:integer); virtual;
procedure DoLine (x1,y1,x2,y2:integer); virtual; abstract; procedure DoLine (x1,y1,x2,y2:integer); virtual; abstract;
procedure DoCopyRect (x,y:integer; canvas:TFPCustomCanvas; SourceRect:TRect); virtual; abstract; procedure DoCopyRect (x,y:integer; canvas:TFPCustomCanvas; Const SourceRect:TRect); virtual; abstract;
procedure DoDraw (x,y:integer; image:TFPCustomImage); virtual; abstract; procedure DoDraw (x,y:integer; Const image:TFPCustomImage); virtual; abstract;
procedure CheckHelper (AHelper:TFPCanvasHelper); virtual; procedure CheckHelper (AHelper:TFPCanvasHelper); virtual;
procedure AddHelper (AHelper:TFPCanvasHelper); procedure AddHelper (AHelper:TFPCanvasHelper);
public public

2
fcl/image/fppen.inc
View File

@ -20,7 +20,7 @@ begin
FMode := AValue; FMode := AValue;
end; end;
procedure TFPCustomPen.SetWidth (AValue : byte); procedure TFPCustomPen.SetWidth (AValue : Integer);
begin begin
if AValue < 1 then if AValue < 1 then
FWidth := 1 FWidth := 1

6
fcl/image/fppixlcanv.pp
View File

@ -205,7 +205,7 @@ begin
FillRectangleImage (self, left,top, right,bottom, brush.image) FillRectangleImage (self, left,top, right,bottom, brush.image)
else else
raise PixelCanvasException.Create (sErrNoImage); raise PixelCanvasException.Create (sErrNoImage);
bsDiagonal : FillRectangleHashDiagonal (self, b, FHashWidth); bsBDiagonal : FillRectangleHashDiagonal (self, b, FHashWidth);
bsFDiagonal : FillRectangleHashBackDiagonal (self, b, FHashWidth); bsFDiagonal : FillRectangleHashBackDiagonal (self, b, FHashWidth);
bsCross : bsCross :
begin begin
@ -235,7 +235,7 @@ begin
FillEllipseImage (self, Bounds, brush.image) FillEllipseImage (self, Bounds, brush.image)
else else
raise PixelCanvasException.Create (sErrNoImage); raise PixelCanvasException.Create (sErrNoImage);
bsDiagonal : FillEllipseHashDiagonal (self, Bounds, FHashWidth, brush.color); bsBDiagonal : FillEllipseHashDiagonal (self, Bounds, FHashWidth, brush.color);
bsFDiagonal : FillEllipseHashBackDiagonal (self, Bounds, FHashWidth, brush.color); bsFDiagonal : FillEllipseHashBackDiagonal (self, Bounds, FHashWidth, brush.color);
bsCross : FillEllipseHashCross (self, Bounds, FHashWidth, brush.color); bsCross : FillEllipseHashCross (self, Bounds, FHashWidth, brush.color);
bsDiagCross : FillEllipseHashDiagCross (self, Bounds, FHashWidth, brush.color); bsDiagCross : FillEllipseHashDiagCross (self, Bounds, FHashWidth, brush.color);
@ -277,7 +277,7 @@ begin
FillFloodImage (self, x,y, brush.image) FillFloodImage (self, x,y, brush.image)
else else
raise PixelCanvasException.Create (sErrNoImage); raise PixelCanvasException.Create (sErrNoImage);
bsDiagonal : FillFloodHashDiagonal (self, x,y, FHashWidth); bsBDiagonal : FillFloodHashDiagonal (self, x,y, FHashWidth);
bsFDiagonal : FillFloodHashBackDiagonal (self, x,y, FHashWidth); bsFDiagonal : FillFloodHashBackDiagonal (self, x,y, FHashWidth);
bsCross : FillFloodHashCross (self, x,y, FHashWidth); bsCross : FillFloodHashCross (self, x,y, FHashWidth);
bsDiagCross : FillFloodHashDiagCross (self, x,y, FHashWidth); bsDiagCross : FillFloodHashDiagCross (self, x,y, FHashWidth);