mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-16 06:09:29 +02:00
implemented the fpCanvas support for the LCL - Compile with -dUseFPCanvas
git-svn-id: trunk@6535 -
This commit is contained in:
mattias
parent
eb7cf06c6b
commit
04863229c8
@ -641,7 +641,7 @@ type
|
||||
FStyle: TBrushStyle;
|
||||
{$ENDIF}
|
||||
procedure FreeHandle;
|
||||
Procedure DoChange(var Msg); message LM_CHANGED;
|
||||
procedure DoChange(var Msg); message LM_CHANGED;
|
||||
protected
|
||||
{$IFDEF UseFPCanvas}
|
||||
procedure DoAllocateResources; override;
|
||||
@ -676,7 +676,6 @@ type
|
||||
TRegionData = record
|
||||
Handle: HRgn;
|
||||
Rect: TRect;
|
||||
|
||||
{Polygon Region Info - not used yet}
|
||||
Polygon: PPoint;//Polygon Points
|
||||
NumPoints: Longint;//Number of Points
|
||||
@ -951,12 +950,6 @@ type
|
||||
function DoCreateDefaultFont: TFPCustomFont; override;
|
||||
function DoCreateDefaultPen: TFPCustomPen; override;
|
||||
function DoCreateDefaultBrush: TFPCustomBrush; override;
|
||||
procedure SetFont(AValue: TFPCustomFont); override;
|
||||
procedure SetBrush(AValue: TFPCustomBrush); override;
|
||||
procedure SetPen(AValue: TFPCustomPen); override;
|
||||
function DoAllowFont(AFont: TFPCustomFont): boolean; override;
|
||||
function DoAllowPen(APen: TFPCustomPen): boolean; override;
|
||||
function DoAllowBrush(ABrush: TFPCustomBrush): boolean; override;
|
||||
procedure SetColor(x, y: integer; const Value: TFPColor); override;
|
||||
function GetColor(x, y: integer): TFPColor; override;
|
||||
procedure SetHeight(AValue: integer); override;
|
||||
@ -984,14 +977,14 @@ type
|
||||
procedure DoMoveTo(x, y: integer); override;
|
||||
procedure DoLineTo(x, y: integer); override;
|
||||
procedure DoLine(x1, y1, x2, y2: integer); override;
|
||||
procedure DoCopyRect(x, y: integer; Canvas: TFPCustomCanvas;
|
||||
procedure DoCopyRect(x, y: integer; SrcCanvas: TFPCustomCanvas;
|
||||
const SourceRect: TRect); override;
|
||||
procedure DoDraw(x, y: integer; const Image: TFPCustomImage); override;
|
||||
procedure CheckHelper(AHelper: TFPCanvasHelper); override;
|
||||
{$ELSE}
|
||||
{$ENDIF}
|
||||
protected
|
||||
function GetCanvasClipRect: TRect; virtual;
|
||||
function GetClipRect: TRect; {$IFDEF UseFPCanvas}override;{$ELSE}virtual;{$ENDIF}
|
||||
Function GetPixel(X,Y: Integer): TColor; virtual;
|
||||
procedure CreateBrush; virtual;
|
||||
procedure CreateFont; virtual;
|
||||
@ -1014,6 +1007,7 @@ type
|
||||
procedure Changing; virtual;
|
||||
procedure Changed; virtual;
|
||||
|
||||
// extra drawing methods (there are more in the ancestor TFPCustomCanvas)
|
||||
procedure Arc(x, y, AWidth, AHeight, angle1, angle2: Integer); virtual;
|
||||
procedure Arc(x, y, AWidth, AHeight, SX, SY, EX, EY: Integer); virtual;
|
||||
Procedure BrushCopy(Dest: TRect; InternalImages: TBitmap; Src: TRect;
|
||||
@ -1025,8 +1019,8 @@ type
|
||||
const Source: TRect); virtual;
|
||||
Procedure Draw(X,Y: Integer; SrcGraphic: TGraphic); virtual;
|
||||
procedure StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); virtual;
|
||||
procedure Ellipse(const ARect: TRect);
|
||||
procedure Ellipse(x1, y1, x2, y2: Integer); virtual;
|
||||
procedure Ellipse(const ARect: TRect); // already in fpcanvas
|
||||
procedure Ellipse(x1, y1, x2, y2: Integer); virtual; // already in fpcanvas
|
||||
Procedure FillRect(const ARect: TRect); virtual;
|
||||
Procedure FillRect(X1,Y1,X2,Y2: Integer);
|
||||
procedure FloodFill(X, Y: Integer; FillColor: TColor;
|
||||
@ -1037,9 +1031,9 @@ type
|
||||
procedure Frame(X1,Y1,X2,Y2: Integer); // border using pen
|
||||
procedure FrameRect(const ARect: TRect); virtual; // border using brush
|
||||
procedure FrameRect(X1,Y1,X2,Y2: Integer); // border using brush
|
||||
Procedure Line(X1,Y1,X2,Y2: Integer); virtual; // short for MoveTo();LineTo();
|
||||
Procedure LineTo(X1,Y1: Integer); virtual;
|
||||
Procedure MoveTo(X1,Y1: Integer); virtual;
|
||||
Procedure Line(X1,Y1,X2,Y2: Integer); virtual; // short for MoveTo();LineTo(); // already in fpcanvas
|
||||
Procedure LineTo(X1,Y1: Integer); virtual; // already in fpcanvas
|
||||
Procedure MoveTo(X1,Y1: Integer); virtual; // already in fpcanvas
|
||||
procedure RadialPie(x,y,AWidth, AHeight,
|
||||
StartAngle16Deg, EndAngle16Deg: Integer); virtual;
|
||||
procedure RadialPie(x, y, AWidth, AHeight, sx, sy, ex, ey: Integer); virtual;
|
||||
@ -1060,17 +1054,17 @@ type
|
||||
NumPts: Integer {$IFNDEF VER1_0} = -1{$ENDIF});
|
||||
procedure Polygon(Points: PPoint; NumPts: Integer;
|
||||
Winding: boolean{$IFNDEF VER1_0} = False{$ENDIF}); virtual;
|
||||
Procedure Polygon(const Points: array of TPoint);
|
||||
Procedure Polygon(const Points: array of TPoint); // already in fpcanvas
|
||||
procedure Polyline(const Points: array of TPoint;
|
||||
StartIndex: Integer;
|
||||
NumPts: Integer {$IFNDEF VER1_0} = -1{$ENDIF});
|
||||
procedure Polyline(Points: PPoint; NumPts: Integer); virtual;
|
||||
procedure Polyline(const Points: array of TPoint);
|
||||
Procedure Rectangle(X1,Y1,X2,Y2: Integer); virtual;
|
||||
Procedure Rectangle(const Rect: TRect);
|
||||
procedure Polyline(const Points: array of TPoint); // already in fpcanvas
|
||||
Procedure Rectangle(X1,Y1,X2,Y2: Integer); virtual; // already in fpcanvas
|
||||
Procedure Rectangle(const ARect: TRect); // already in fpcanvas
|
||||
Procedure RoundRect(X1, Y1, X2, Y2: Integer; RX,RY: Integer); virtual;
|
||||
Procedure RoundRect(const Rect: TRect; RX,RY: Integer);
|
||||
procedure TextOut(X,Y: Integer; const Text: String); virtual;
|
||||
procedure TextOut(X,Y: Integer; const Text: String); virtual; // already in fpcanvas
|
||||
procedure TextRect(const ARect: TRect; X, Y: integer; const Text: string);
|
||||
procedure TextRect(ARect: TRect; X, Y: integer; const Text: string;
|
||||
const Style: TTextStyle); virtual;
|
||||
@ -1080,8 +1074,8 @@ type
|
||||
function HandleAllocated: boolean; virtual;
|
||||
function GetUpdatedHandle(ReqState: TCanvasState): HDC; virtual;
|
||||
public
|
||||
property ClipRect: TRect read GetCanvasClipRect;
|
||||
{$IFNDEF UseFPCanvas}
|
||||
property ClipRect: TRect read GetClipRect;
|
||||
property PenPos: TPoint read FPenPos write SetPenPos;
|
||||
{$ENDIF}
|
||||
property Pixels[X, Y: Integer]: TColor read GetPixel write SetPixel;
|
||||
@ -1952,6 +1946,9 @@ end.
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.171 2005/01/10 18:44:44 mattias
|
||||
implemented the fpCanvas support for the LCL - Compile with -dUseFPCanvas
|
||||
|
||||
Revision 1.170 2005/01/08 15:06:06 mattias
|
||||
fixed TabOrder dialog for new TabOrder
|
||||
|
||||
|
||||
@ -105,6 +105,7 @@ begin
|
||||
FHandle := 0;
|
||||
FColor := clWhite;
|
||||
{$IFDEF UseFPCanvas}
|
||||
DelayAllocate:=true;
|
||||
inherited SetStyle(bsSolid);
|
||||
{$ELSE}
|
||||
FStyle := bsSolid;
|
||||
@ -281,6 +282,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.16 2005/01/10 18:44:44 mattias
|
||||
implemented the fpCanvas support for the LCL - Compile with -dUseFPCanvas
|
||||
|
||||
Revision 1.15 2005/01/08 15:06:06 mattias
|
||||
fixed TabOrder dialog for new TabOrder
|
||||
|
||||
|
||||
@ -54,9 +54,9 @@ begin
|
||||
end;
|
||||
|
||||
{-----------------------------------------------}
|
||||
{-- TCanvas.GetCanvasClipRect --}
|
||||
{-- TCanvas.GetClipRect --}
|
||||
{-----------------------------------------------}
|
||||
function TCanvas.GetCanvasClipRect: TRect;
|
||||
function TCanvas.GetClipRect: TRect;
|
||||
begin
|
||||
If GetClipBox(FHandle, @Result) = ERROR then
|
||||
Result := Rect(0,0,2000,2000);{Just in Case}
|
||||
@ -231,6 +231,7 @@ end;
|
||||
procedure TCanvas.SetPenPos(const AValue: TPoint);
|
||||
begin
|
||||
MoveTo(AValue.X,AValue.Y);
|
||||
// fpcanvas TODO
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -282,124 +283,124 @@ begin
|
||||
Result:=TBrush.Create;
|
||||
end;
|
||||
|
||||
procedure TCanvas.SetFont(AValue: TFPCustomFont);
|
||||
begin
|
||||
inherited SetFont(AValue);
|
||||
end;
|
||||
|
||||
procedure TCanvas.SetBrush(AValue: TFPCustomBrush);
|
||||
begin
|
||||
inherited SetBrush(AValue);
|
||||
end;
|
||||
|
||||
procedure TCanvas.SetPen(AValue: TFPCustomPen);
|
||||
begin
|
||||
inherited SetPen(AValue);
|
||||
end;
|
||||
|
||||
function TCanvas.DoAllowFont(AFont: TFPCustomFont): boolean;
|
||||
begin
|
||||
Result:=inherited DoAllowFont(AFont);
|
||||
end;
|
||||
|
||||
function TCanvas.DoAllowPen(APen: TFPCustomPen): boolean;
|
||||
begin
|
||||
Result:=inherited DoAllowPen(APen);
|
||||
end;
|
||||
|
||||
function TCanvas.DoAllowBrush(ABrush: TFPCustomBrush): boolean;
|
||||
begin
|
||||
Result:=inherited DoAllowBrush(ABrush);
|
||||
end;
|
||||
|
||||
procedure TCanvas.SetColor(x, y: integer; const Value: TFPColor);
|
||||
begin
|
||||
inherited SetColor(x, y, Value);
|
||||
Pixels[x,y]:=FPColorToTColor(Value);
|
||||
end;
|
||||
|
||||
function TCanvas.GetColor(x, y: integer): TFPColor;
|
||||
begin
|
||||
Result:=inherited GetColor(x, y);
|
||||
Result:=TColorToFPColor(Pixels[x,y]);
|
||||
end;
|
||||
|
||||
procedure TCanvas.SetHeight(AValue: integer);
|
||||
begin
|
||||
inherited SetHeight(AValue);
|
||||
RaiseGDBException('TCanvas.SetHeight not allowed for LCL canvas');
|
||||
end;
|
||||
|
||||
function TCanvas.GetHeight: integer;
|
||||
var
|
||||
w: Integer;
|
||||
begin
|
||||
Result:=inherited GetHeight;
|
||||
if HandleAllocated then
|
||||
GetWindowSize(Handle,w,Result)
|
||||
else
|
||||
Result:=0;
|
||||
end;
|
||||
|
||||
procedure TCanvas.SetWidth(AValue: integer);
|
||||
begin
|
||||
inherited SetWidth(AValue);
|
||||
RaiseGDBException('TCanvas.SetWidth not allowed for LCL canvas');
|
||||
end;
|
||||
|
||||
function TCanvas.GetWidth: integer;
|
||||
var
|
||||
h: Integer;
|
||||
begin
|
||||
Result:=inherited GetWidth;
|
||||
end;
|
||||
|
||||
procedure TCanvas.SetPenPos(const AValue: TPoint);
|
||||
begin
|
||||
inherited SetPenPos(AValue);
|
||||
if HandleAllocated then
|
||||
GetWindowSize(Handle,Result,h)
|
||||
else
|
||||
Result:=0;
|
||||
end;
|
||||
|
||||
procedure TCanvas.DoLockCanvas;
|
||||
begin
|
||||
if FLock=0 then InitializeCriticalSection(FLock);
|
||||
EnterCriticalSection(FLock);
|
||||
inherited DoLockCanvas;
|
||||
end;
|
||||
|
||||
procedure TCanvas.DoUnlockCanvas;
|
||||
begin
|
||||
LeaveCriticalSection(FLock);
|
||||
inherited DoUnlockCanvas;
|
||||
end;
|
||||
|
||||
procedure TCanvas.DoTextOut(x, y: integer; Text: string);
|
||||
begin
|
||||
inherited DoTextOut(x, y, Text);
|
||||
TextOut(X,Y,Text);
|
||||
end;
|
||||
|
||||
procedure TCanvas.DoGetTextSize(Text: string; var w, h: integer);
|
||||
var
|
||||
TxtSize: tagSIZE;
|
||||
begin
|
||||
inherited DoGetTextSize(Text, w, h);
|
||||
TxtSize:=TextExtent(Text);
|
||||
w:=TxtSize.cx;
|
||||
h:=TxtSize.cy;
|
||||
end;
|
||||
|
||||
function TCanvas.DoGetTextHeight(Text: string): integer;
|
||||
begin
|
||||
Result:=inherited DoGetTextHeight(Text);
|
||||
Result:=TextHeight(Text);
|
||||
end;
|
||||
|
||||
function TCanvas.DoGetTextWidth(Text: string): integer;
|
||||
begin
|
||||
Result:=inherited DoGetTextWidth(Text);
|
||||
Result:=TextWidth(Text);
|
||||
end;
|
||||
|
||||
procedure TCanvas.DoRectangle(const Bounds: TRect);
|
||||
begin
|
||||
inherited DoRectangle(Bounds);
|
||||
Frame(Bounds);
|
||||
end;
|
||||
|
||||
procedure TCanvas.DoRectangleFill(const Bounds: TRect);
|
||||
begin
|
||||
inherited DoRectangleFill(Bounds);
|
||||
FillRect(Bounds);
|
||||
end;
|
||||
|
||||
procedure TCanvas.DoRectangleAndFill(const Bounds: TRect);
|
||||
begin
|
||||
inherited DoRectangleAndFill(Bounds);
|
||||
Rectangle(Bounds);
|
||||
end;
|
||||
|
||||
procedure TCanvas.DoEllipse(const Bounds: TRect);
|
||||
var
|
||||
x: Integer;
|
||||
y: Integer;
|
||||
w: Integer;
|
||||
h: Integer;
|
||||
begin
|
||||
inherited DoEllipse(Bounds);
|
||||
x:=(Bounds.Left+Bounds.Right) div 2;
|
||||
y:=(Bounds.Top+Bounds.Bottom) div 2;
|
||||
w:=Abs(Bounds.Right-Bounds.Left) div 2;
|
||||
h:=Abs(Bounds.Bottom-Bounds.Top) div 2;
|
||||
Arc(x,y,w,h,0,360*16);
|
||||
end;
|
||||
|
||||
procedure TCanvas.DoEllipseFill(const Bounds: TRect);
|
||||
var
|
||||
x: Integer;
|
||||
y: Integer;
|
||||
w: Integer;
|
||||
h: Integer;
|
||||
begin
|
||||
inherited DoEllipseFill(Bounds);
|
||||
x:=(Bounds.Left+Bounds.Right) div 2;
|
||||
y:=(Bounds.Top+Bounds.Bottom) div 2;
|
||||
w:=Abs(Bounds.Right-Bounds.Left) div 2;
|
||||
h:=Abs(Bounds.Bottom-Bounds.Top) div 2;
|
||||
Chord(x,y,w,h,0,360*16);
|
||||
end;
|
||||
|
||||
procedure TCanvas.DoEllipseAndFill(const Bounds: TRect);
|
||||
@ -409,12 +410,12 @@ end;
|
||||
|
||||
procedure TCanvas.DoPolygon(const Points: array of TPoint);
|
||||
begin
|
||||
inherited DoPolygon(Points);
|
||||
Polyline(Points);
|
||||
end;
|
||||
|
||||
procedure TCanvas.DoPolygonFill(const Points: array of TPoint);
|
||||
begin
|
||||
inherited DoPolygonFill(Points);
|
||||
Polygon(Points);
|
||||
end;
|
||||
|
||||
procedure TCanvas.DoPolygonAndFill(const Points: array of TPoint);
|
||||
@ -424,43 +425,86 @@ end;
|
||||
|
||||
procedure TCanvas.DoPolyline(const Points: array of TPoint);
|
||||
begin
|
||||
inherited DoPolyline(Points);
|
||||
Polyline(Points);
|
||||
end;
|
||||
|
||||
procedure TCanvas.DoFloodFill(x, y: integer);
|
||||
begin
|
||||
inherited DoFloodFill(x, y);
|
||||
FloodFill(x,y,Color,fsSurface);
|
||||
end;
|
||||
|
||||
procedure TCanvas.DoMoveTo(x, y: integer);
|
||||
begin
|
||||
inherited DoMoveTo(x, y);
|
||||
MoveTo(X,Y);
|
||||
end;
|
||||
|
||||
procedure TCanvas.DoLineTo(x, y: integer);
|
||||
begin
|
||||
inherited DoLineTo(x, y);
|
||||
LineTo(X,Y);
|
||||
end;
|
||||
|
||||
procedure TCanvas.DoLine(x1, y1, x2, y2: integer);
|
||||
begin
|
||||
inherited DoLine(x1, y1, x2, y2);
|
||||
Line(x1,y1,x2,y2);
|
||||
end;
|
||||
|
||||
procedure TCanvas.DoCopyRect(x, y: integer; Canvas: TFPCustomCanvas;
|
||||
procedure TCanvas.DoCopyRect(x, y: integer; SrcCanvas: TFPCustomCanvas;
|
||||
const SourceRect: TRect);
|
||||
begin
|
||||
inherited DoCopyRect(x, y, Canvas, SourceRect);
|
||||
|
||||
Procedure WarnNotSupported;
|
||||
begin
|
||||
debugln('WARNING: TCanvas.DoCopyRect from ',DbgSName(SrcCanvas));
|
||||
end;
|
||||
|
||||
var
|
||||
SH: Integer;
|
||||
SW: Integer;
|
||||
Begin
|
||||
if SrcCanvas=nil then exit;
|
||||
if SrcCanvas is TCanvas then begin
|
||||
SW := SourceRect.Right - SourceRect.Left;
|
||||
SH := SourceRect.Bottom - SourceRect.Top;
|
||||
if (SH=0) or (SW=0) then exit;
|
||||
CopyRect(Rect(x,y,x+SW,y+SH),TCanvas(SrcCanvas),SourceRect);
|
||||
end else begin
|
||||
WarnNotSupported;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCanvas.DoDraw(x, y: integer; const Image: TFPCustomImage);
|
||||
var
|
||||
LazImg: TLazIntfImage;
|
||||
BitmapHnd, MaskHnd: HBitmap;
|
||||
begin
|
||||
inherited DoDraw(x, y, Image);
|
||||
if Image=nil then exit;
|
||||
LazImg:=TLazIntfImage(Image);
|
||||
BitmapHnd:=0;
|
||||
MaskHnd:=0;
|
||||
try
|
||||
if not (LazImg is TLazIntfImage) then begin
|
||||
LazImg:=TLazIntfImage.Create(0,0);
|
||||
RequiredState([csHandleValid]);
|
||||
LazImg.GetDescriptionFromDevice(Handle);
|
||||
LazImg.Assign(Image);
|
||||
end;
|
||||
LazImg.CreateBitmap(BitmapHnd,MaskHnd,false);
|
||||
if BitmapHnd=0 then exit;
|
||||
|
||||
Changing;
|
||||
RequiredState([csHandleValid]);
|
||||
StretchBlt(FHandle,x,y,LazImg.Width,LazImg.Height,
|
||||
BitmapHnd, 0,0,LazImg.Width,LazImg.Height, CopyMode);
|
||||
Changed;
|
||||
finally
|
||||
if Image<>LazImg then LazImg.Free;
|
||||
if BitmapHnd<>0 then DeleteDC(BitmapHnd);
|
||||
if MaskHnd<>0 then DeleteDC(MaskHnd);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCanvas.CheckHelper(AHelper: TFPCanvasHelper);
|
||||
begin
|
||||
inherited CheckHelper(AHelper);
|
||||
debugln('TCanvas.CheckHelper ignored for ',DbgSName(AHelper));
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
@ -874,9 +918,9 @@ end;
|
||||
Returns: Nothing
|
||||
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCanvas.Rectangle(const Rect: TRect);
|
||||
procedure TCanvas.Rectangle(const ARect: TRect);
|
||||
begin
|
||||
Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
|
||||
Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -1178,25 +1222,32 @@ end;
|
||||
constructor TCanvas.Create;
|
||||
begin
|
||||
FHandle := 0;
|
||||
{$IFDEF UseFPCanvas}
|
||||
ManageResources := true;
|
||||
{$ENDIF}
|
||||
inherited Create;
|
||||
{$IFDEF UseFPCanvas}
|
||||
FFont := TFont(inherited Font);
|
||||
FPen := TPen(inherited Pen);
|
||||
FBrush := TBrush(inherited Brush);
|
||||
{$ELSE}
|
||||
FFont := TFont.Create;
|
||||
FPen := TPen.Create;
|
||||
FBrush := TBrush.Create;
|
||||
FPenPos := Point(0, 0);
|
||||
FLockCount := 0;
|
||||
{$ENDIF}
|
||||
FFont.OnChange := @FontChanged;
|
||||
FSavedFontHandle := 0;
|
||||
FPen := TPen.Create;
|
||||
FPen.OnChanging := @PenChanging;
|
||||
FPen.OnChange := @PenChanged;
|
||||
FSavedPenHandle := 0;
|
||||
FBrush := TBrush.Create;
|
||||
FBrush.OnChange := @BrushChanged;
|
||||
FSavedBrushHandle := 0;
|
||||
FRegion := TRegion.Create;
|
||||
FRegion.OnChange := @RegionChanged;
|
||||
FSavedRegionHandle := 0;
|
||||
FCopyMode := cmSrcCopy;
|
||||
{$IFNDEF UseFPCanvas}
|
||||
FPenPos := Point(0, 0);
|
||||
FLockCount := 0;
|
||||
{$ENDIF}
|
||||
// FLock will be initialized on demand, because most canvas don't use it
|
||||
With FTextStyle do begin
|
||||
Alignment := taLeftJustify;
|
||||
@ -1258,13 +1309,21 @@ destructor TCanvas.Destroy;
|
||||
begin
|
||||
//DebugLn('[TCanvas.Destroy] ',ClassName,' Self=',HexStr(Cardinal(Pointer(Self)),8));
|
||||
Handle := 0;
|
||||
{$IFNDEF UseFPCanvas}
|
||||
FreeThenNil(FFont);
|
||||
FreeThenNil(FPen);
|
||||
FreeThenNil(FBrush);
|
||||
{$ENDIF}
|
||||
FreeThenNil(FRegion);
|
||||
if FLock <> 0 then
|
||||
DeleteCriticalSection(FLock);
|
||||
inherited Destroy;
|
||||
{$IFDEF UseFPCanvas}
|
||||
// set resources to nil, so that dangling pointers are spotted early
|
||||
FFont:=nil;
|
||||
FPen:=nil;
|
||||
FBrush:=nil;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -1276,7 +1335,7 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
function TCanvas.GetHandle : HDC;
|
||||
begin
|
||||
//DebugLn('[TCanvas.GetHandle] ',ClassName);
|
||||
//DebugLn('[TCanvas.GetHandle] ',ClassName);
|
||||
RequiredState(csAllValid);
|
||||
Result := FHandle;
|
||||
end;
|
||||
@ -1473,6 +1532,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.88 2005/01/10 18:44:44 mattias
|
||||
implemented the fpCanvas support for the LCL - Compile with -dUseFPCanvas
|
||||
|
||||
Revision 1.87 2005/01/08 15:06:06 mattias
|
||||
fixed TabOrder dialog for new TabOrder
|
||||
|
||||
|
||||
@ -534,6 +534,7 @@ begin
|
||||
FPitch:=DefFontData.Pitch;
|
||||
FCharSet:=DefFontData.CharSet;
|
||||
{$IFDEF UseFPCanvas}
|
||||
DelayAllocate:=true;
|
||||
inherited SetName(DefFontData.Name);
|
||||
inherited SetFPColor(colBlack);
|
||||
{$ELSE}
|
||||
@ -1099,6 +1100,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.28 2005/01/10 18:44:44 mattias
|
||||
implemented the fpCanvas support for the LCL - Compile with -dUseFPCanvas
|
||||
|
||||
Revision 1.27 2005/01/08 15:06:06 mattias
|
||||
fixed TabOrder dialog for new TabOrder
|
||||
|
||||
|
||||
@ -130,6 +130,7 @@ begin
|
||||
inherited Create;
|
||||
FHandle := 0;
|
||||
{$IFDEF UseFPCanvas}
|
||||
DelayAllocate:=true;
|
||||
inherited SetWidth(1);
|
||||
inherited SetStyle(psSolid);
|
||||
inherited SetMode(pmCopy);
|
||||
@ -303,6 +304,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.19 2005/01/10 18:44:44 mattias
|
||||
implemented the fpCanvas support for the LCL - Compile with -dUseFPCanvas
|
||||
|
||||
Revision 1.18 2005/01/08 15:06:06 mattias
|
||||
fixed TabOrder dialog for new TabOrder
|
||||
|
||||
|
||||
@ -126,9 +126,9 @@ Type
|
||||
Winding: boolean{$IFNDEF VER1_0}=False{$ENDIF}); override;
|
||||
|
||||
procedure Ellipse(x1, y1, x2, y2: Integer); override;
|
||||
procedure Arc(x,y,width,height,angle1,angle2: Integer); override;
|
||||
procedure RadialPie(x,y,width,height,angle1,angle2: Integer); override;
|
||||
procedure Chord(x, y, width, height, angle1, angle2: Integer); override;
|
||||
procedure Arc(x,y,AWidth,AHeight,angle1,angle2: Integer); override;
|
||||
procedure RadialPie(x,y,AWidth,AHeight,angle1,angle2: Integer); override;
|
||||
procedure Chord(x, y, AWidth, AHeight, angle1, angle2: Integer); override;
|
||||
|
||||
procedure TextOut(X,Y: Integer; const Text: String); override;
|
||||
function TextExtent(const Text: string): TSize; override;
|
||||
@ -144,11 +144,11 @@ Type
|
||||
TransparentColor: TColor); override;
|
||||
|
||||
//** Methods not implemented
|
||||
procedure Arc(x,y,width,height,SX,SY,EX,EY: Integer); override;
|
||||
procedure Chord(x, y, width, height, SX, SY, EX, EY: Integer); override;
|
||||
procedure Arc(x,y,AWidth,AHeight,SX,SY,EX,EY: Integer); override;
|
||||
procedure Chord(x, y, AWidth, AHeight, SX, SY, EX, EY: Integer); override;
|
||||
procedure Frame3d(var ARect: TRect; const FrameWidth: integer;
|
||||
const Style: TGraphicsBevelCut); override;
|
||||
procedure RadialPie(x,y,width,height,sx,sy,ex,ey: Integer); override;
|
||||
procedure RadialPie(x,y,AWidth,AHeight,sx,sy,ex,ey: Integer); override;
|
||||
procedure Pie(EllipseX1,EllipseY1,EllipseX2,EllipseY2,
|
||||
StartX,StartY,EndX,EndY: Integer); override;
|
||||
procedure TextRect(ARect: TRect; X, Y: integer; const Text: string;
|
||||
@ -1591,7 +1591,7 @@ begin
|
||||
end;
|
||||
|
||||
//Draw an Arc
|
||||
procedure TPostscriptPrinterCanvas.Arc(x, y, width, height, angle1,
|
||||
procedure TPostscriptPrinterCanvas.Arc(x, y, AWidth, AHeight, angle1,
|
||||
angle2: Integer);
|
||||
var xScale : Real;
|
||||
yScale : Real;
|
||||
@ -1603,14 +1603,14 @@ begin
|
||||
Changing;
|
||||
RequiredState([csHandleValid, csBrushValid, csPenValid]);
|
||||
|
||||
writecomment(Format('Arc(%d,%d,%d,%d,%d,%d)',[x,y,Width,Height,Angle1,Angle2]));
|
||||
writecomment(Format('Arc(%d,%d,%d,%d,%d,%d)',[x,y,AWidth,AHeight,Angle1,Angle2]));
|
||||
TranslateCoord(X,Y);
|
||||
|
||||
//calculate centre of ellipse
|
||||
cx:=x;
|
||||
cy:=y;
|
||||
rx:=Width;
|
||||
ry:=Height;
|
||||
rx:=AWidth;
|
||||
ry:=AHeight;
|
||||
|
||||
if Angle2>=0 then
|
||||
Ang:='arc'
|
||||
@ -1642,7 +1642,7 @@ begin
|
||||
Changed;
|
||||
end;
|
||||
|
||||
procedure TPostscriptPrinterCanvas.RadialPie(x, y, width, height, angle1,
|
||||
procedure TPostscriptPrinterCanvas.RadialPie(x, y, AWidth, AHeight, angle1,
|
||||
angle2: Integer);
|
||||
var xScale : Real;
|
||||
yScale : Real;
|
||||
@ -1654,14 +1654,14 @@ begin
|
||||
Changing;
|
||||
RequiredState([csHandleValid, csBrushValid, csPenValid]);
|
||||
|
||||
writecomment(Format('RadialPie(%d,%d,%d,%d,%d,%d)',[x,y,Width,Height,Angle1,Angle2]));
|
||||
writecomment(Format('RadialPie(%d,%d,%d,%d,%d,%d)',[x,y,AWidth,AHeight,Angle1,Angle2]));
|
||||
TranslateCoord(X,Y);
|
||||
|
||||
//calculate centre of ellipse
|
||||
cx:=x;
|
||||
cy:=y;
|
||||
rx:=Width;
|
||||
ry:=Height;
|
||||
rx:=AWidth;
|
||||
ry:=AHeight;
|
||||
|
||||
if Angle2>=0 then
|
||||
Ang:='arc'
|
||||
@ -1824,13 +1824,13 @@ begin
|
||||
Changed;
|
||||
end;
|
||||
|
||||
procedure TPostscriptPrinterCanvas.Arc(x, y, width, height, SX, SY, EX,
|
||||
procedure TPostscriptPrinterCanvas.Arc(x, y, AWidth, AHeight, SX, SY, EX,
|
||||
EY: Integer);
|
||||
begin
|
||||
//Not implemented
|
||||
end;
|
||||
|
||||
procedure TPostscriptPrinterCanvas.Chord(x, y, width, height, angle1,angle2: Integer);
|
||||
procedure TPostscriptPrinterCanvas.Chord(x, y, AWidth, AHeight, angle1,angle2: Integer);
|
||||
var xScale : Real;
|
||||
yScale : Real;
|
||||
cX, cY : Real;
|
||||
@ -1841,14 +1841,14 @@ begin
|
||||
Changing;
|
||||
RequiredState([csHandleValid, csBrushValid, csPenValid]);
|
||||
|
||||
writecomment(Format('Chord(%d,%d,%d,%d,%d,%d)',[x,y,Width,Height,Angle1,Angle2]));
|
||||
writecomment(Format('Chord(%d,%d,%d,%d,%d,%d)',[x,y,AWidth,AHeight,Angle1,Angle2]));
|
||||
TranslateCoord(X,Y);
|
||||
|
||||
//calculate centre of ellipse
|
||||
cx:=x;
|
||||
cy:=y;
|
||||
rx:=Width;
|
||||
ry:=Height;
|
||||
rx:=AWidth;
|
||||
ry:=AHeight;
|
||||
|
||||
if Angle2>=0 then
|
||||
Ang:='arc'
|
||||
@ -1875,7 +1875,7 @@ begin
|
||||
Changed;
|
||||
end;
|
||||
|
||||
procedure TPostscriptPrinterCanvas.Chord(x, y, width, height, SX, SY, EX, EY: Integer);
|
||||
procedure TPostscriptPrinterCanvas.Chord(x, y, AWidth, AHeight, SX, SY, EX, EY: Integer);
|
||||
begin
|
||||
//Not implemented
|
||||
end;
|
||||
@ -1886,7 +1886,7 @@ begin
|
||||
//Not implemented
|
||||
end;
|
||||
|
||||
procedure TPostscriptPrinterCanvas.RadialPie(x, y, width, height, sx, sy, ex,
|
||||
procedure TPostscriptPrinterCanvas.RadialPie(x, y, AWidth, AHeight, sx, sy, ex,
|
||||
ey: Integer);
|
||||
begin
|
||||
//Not implemented
|
||||
|
||||
@ -50,8 +50,8 @@ type
|
||||
private
|
||||
fPrinter : TPrinter;
|
||||
fTitle : String;
|
||||
fHeight : Integer;
|
||||
fWidth : Integer;
|
||||
fPageHeight : Integer;
|
||||
fPageWidth : Integer;
|
||||
fPageNum : Integer;
|
||||
fTopMarging : Integer;
|
||||
fLeftMarging : Integer;
|
||||
@ -739,28 +739,28 @@ end;
|
||||
|
||||
function TPrinterCanvas.GetPageHeight: Integer;
|
||||
begin
|
||||
if Assigned(fPrinter) and (fHeight=0) then
|
||||
if Assigned(fPrinter) and (fPageHeight=0) then
|
||||
Result:=fPrinter.PageHeight
|
||||
else
|
||||
Result:=fHeight;
|
||||
Result:=fPageHeight;
|
||||
end;
|
||||
|
||||
function TPrinterCanvas.GetPageWidth: Integer;
|
||||
begin
|
||||
if Assigned(fPrinter) and (fWidth=0) then
|
||||
if Assigned(fPrinter) and (fPageWidth=0) then
|
||||
Result:=fPrinter.PageWidth
|
||||
else
|
||||
Result:=fWidth;
|
||||
Result:=fPageWidth;
|
||||
end;
|
||||
|
||||
procedure TPrinterCanvas.SetPageHeight(const AValue: Integer);
|
||||
begin
|
||||
fHeight:=aValue;
|
||||
fPageHeight:=aValue;
|
||||
end;
|
||||
|
||||
procedure TPrinterCanvas.SetPageWidth(const AValue: Integer);
|
||||
begin
|
||||
fWidth:=aValue;
|
||||
fPageWidth:=aValue;
|
||||
end;
|
||||
|
||||
procedure TPrinterCanvas.SetTitle(const AValue: string);
|
||||
@ -774,8 +774,8 @@ end;
|
||||
constructor TPrinterCanvas.Create(APrinter: TPrinter);
|
||||
begin
|
||||
Inherited Create;
|
||||
fWidth :=0;
|
||||
fHeight :=0;
|
||||
fPageWidth :=0;
|
||||
fPageHeight :=0;
|
||||
fTopMarging :=0;
|
||||
fLeftMarging:=0;
|
||||
fPrinter:=aPrinter;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user