paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-26 19:43:48 +02:00
Code Issues Packages Projects Releases Wiki Activity
146fe15441
lazarus/lcl/include/canvas.inc

1629 lines
49 KiB
PHP
Raw Blame History

{%MainUnit ../graphics.pp}
{******************************************************************************
TCANVAS
******************************************************************************
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.modifiedLGPL, 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. *
* *
*****************************************************************************
}
const
csAllValid = [csHandleValid..csBrushValid];
{-----------------------------------------------}
{-- TCanvas.Draw --}
{-----------------------------------------------}
Procedure TCanvas.Draw(X, Y: Integer; SrcGraphic: TGraphic);
var
ARect: TRect;
begin
if not Assigned(SrcGraphic) then exit;
ARect:=Bounds(X,Y,SrcGraphic.Width,SrcGraphic.Height);
StretchDraw(ARect,SrcGraphic);
end;
{-----------------------------------------------}
{-- TCanvas.DrawFocusRect --}
{-----------------------------------------------}
procedure TCanvas.DrawFocusRect(const ARect: TRect);
begin
Changing;
RequiredState([csHandleValid]);
LCLIntf.DrawFocusRect(FHandle, ARect);
Changed;
end;
{-----------------------------------------------}
{-- TCanvas.StretchDraw --}
{-----------------------------------------------}
procedure TCanvas.StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic);
begin
if not Assigned(SrcGraphic) then exit;
Changing;
RequiredState([csHandleValid]);
SrcGraphic.Draw(Self, DestRect);
Changed;
end;
{-----------------------------------------------}
{-- TCanvas.GetClipRect --}
{-----------------------------------------------}
function TCanvas.GetClipRect: TRect;
begin
If GetClipBox(FHandle, @Result) = ERROR then
Result := Rect(0,0,2000,2000);{Just in Case}
end;
{-----------------------------------------------}
{-- TCanvas.CopyRect --}
{-----------------------------------------------}
Procedure TCanvas.CopyRect(const Dest: TRect; SrcCanvas: TCanvas;
const Source: TRect);
var
SH, SW, DH, DW: Integer;
Begin
if SrcCanvas= nil then exit;
SH := Source.Bottom - Source.Top;
SW := Source.Right - Source.Left;
if (SH=0) or (SW=0) then exit;
DH := Dest.Bottom - Dest.Top;
DW := Dest.Right - Dest.Left;
if (Dh=0) or (DW=0) then exit;
SrcCanvas.RequiredState([csHandleValid]);
Changing;
RequiredState([csHandleValid]);
//DebugLn('TCanvas.CopyRect ',ClassName,' SrcCanvas=',SrcCanvas.ClassName,' ',
// ' Src=',Source.Left,',',Source.Top,',',SW,',',SH,
// ' Dest=',Dest.Left,',',Dest.Top,',',DW,',',DH);
StretchBlt(FHandle, Dest.Left, Dest.Top, DW, DH,
SrcCanvas.FHandle, Source.Left, Source.Top, SW, SH, CopyMode);
Changed;
end;
{-----------------------------------------------}
{-- TCanvas.GetPixel --}
{-----------------------------------------------}
function TCanvas.GetPixel(X, Y: Integer): TColor;
begin
Result := WidgetSet.DCGetPixel(Self.Handle, X, Y);
end;
{-----------------------------------------------}
{-- TCanvas.SetPixel --}
{-----------------------------------------------}
procedure TCanvas.SetPixel(X, Y: Integer; Value: TColor);
begin
WidgetSet.DCSetPixel(Self.Handle, X, Y, Value);
end;
{------------------------------------------------------------------------------
procedure TCanvas.RealizeAutoRedraw;
------------------------------------------------------------------------------}
procedure TCanvas.RealizeAutoRedraw;
begin
if FAutoRedraw and HandleAllocated then
WidgetSet.DCRedraw(Handle);
end;
{------------------------------------------------------------------------------
Method: TCanvas.CreateBrush
Params: None
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCanvas.CreateBrush;
var OldHandle: HBRUSH;
begin
//DebugLn('[TCanvas.CreateBrush] ',Classname,' Self=',DbgS(Self)
// ,' Brush=',DbgS(Brush));
OldHandle:=SelectObject(FHandle, Brush.Handle);
//debugln('TCanvas.CreateBrush ',ClassName,' Self=',DbgS(Self),' OldHandle=',DbgS(OldHandle),8),' NewHandle=',DbgS(Brush.Handle),' FSavedBrushHandle=',DbgS(Cardinal(FSavedBrushHandle));
if (OldHandle<>Brush.Handle) and (FSavedBrushHandle=0) then
FSavedBrushHandle:=OldHandle;
Include(FState, csBrushValid);
SetBkColor(FHandle, Brush.Color);
if Brush.Style=bsSolid then
SetBkMode(FHandle, OPAQUE)
else
SetBkMode(FHandle, TRANSPARENT);
end;
{------------------------------------------------------------------------------
Method: TCanvas.CreatePen
Params: None
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCanvas.CreatePen;
var OldHandle: HPEN;
const PenModes:Array[TPenMode] of Integer =
( R2_BLACK, R2_WHITE, R2_NOP, R2_NOT, R2_COPYPEN, R2_NOTCOPYPEN, R2_MERGEPENNOT,
R2_MASKPENNOT, R2_MERGENOTPEN, R2_MASKNOTPEN, R2_MERGEPEN, R2_NOTMERGEPEN,
R2_MASKPEN, R2_NOTMASKPEN, R2_XORPEN, R2_NOTXORPEN );
{
TPenMode = (pmBlack, pmWhite, pmNop, pmNot, pmCopy, pmNotCopy, pmMergePenNot,
pmMaskPenNot, pmMergeNotPen, pmMaskNotPen, pmMerge,pmNotMerge,
pmMask, pmNotMask, pmXor, pmNotXor
}
begin
//DebugLn('[TCanvas.CreatePen] ',Classname,' Self=',DbgS(Self)
// ,' Pen=',DbgS(Pen));
OldHandle:=SelectObject(FHandle, Pen.Handle);
if (OldHandle<>Pen.Handle) and (FSavedPenHandle=0) then
FSavedPenHandle:=OldHandle;
MoveTo(PenPos.X,PenPos.Y);
Include(FState, csPenValid);
SetROP2(FHandle, PenModes[Pen.Mode]);
end;
{------------------------------------------------------------------------------
Method: TCanvas.CreateFont
Params: None
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCanvas.CreateFont;
var OldHandle: HFONT;
begin
// The first time the font handle is selected, the default font handle
// is returned. Save this font handle to restore it later in DeselectHandles.
// The TFont will call DeleteObject itself, so we never need to call it.
OldHandle:=SelectObject(FHandle, Font.Handle);
//DebugLn(['TCanvas.CreateFont OldHandle=',dbghex(OldHandle),' Font.Handle=',dbghex(Font.Handle)]);
if (OldHandle<>Font.Handle) and (FSavedFontHandle=0) then
FSavedFontHandle:=OldHandle;
Include(FState, csFontValid);
SetTextColor(FHandle, Font.Color);
end;
{------------------------------------------------------------------------------
procedure TCanvas.CreateRegion;
------------------------------------------------------------------------------}
procedure TCanvas.CreateRegion;
var OldHandle: HRGN;
begin
OldHandle:=SelectObject(FHandle, Region.Handle);
if (OldHandle<>Region.Handle) and (FSavedRegionHandle=0) then
FSavedRegionHandle:=OldHandle;
Include(FState, csRegionValid);
end;
{------------------------------------------------------------------------------
Method: TCanvas.SetAutoReDraw
Params: Value
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCanvas.SetAutoRedraw(Value : Boolean);
begin
if FAutoRedraw=Value then exit;
FAutoRedraw := Value;
RealizeAutoRedraw;
end;
{------------------------------------------------------------------------------
procedure TCanvas.SetInternalPenPos(const Value: TPoint);
------------------------------------------------------------------------------}
procedure TCanvas.SetInternalPenPos(const Value: TPoint);
begin
inherited SetPenPos(Value);
end;
{------------------------------------------------------------------------------
Method: TCanvas.SetLazBrush
Params: Value
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCanvas.SetLazBrush(Value : TBrush);
begin
FBrush.Assign(Value);
end;
procedure TCanvas.SetPenPos(const AValue: TPoint);
begin
MoveTo(AValue.X,AValue.Y);
// fpcanvas TODO
end;
{------------------------------------------------------------------------------
Method: TCanvas.SetLazFont
Params: Value
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCanvas.SetLazFont(Value : TFont);
begin
FFont.Assign(Value);
end;
{------------------------------------------------------------------------------
Method: TCanvas.SetLazPen
Params: Value
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCanvas.SetLazPen(Value : TPen);
begin
FPen.Assign(Value);
end;
{------------------------------------------------------------------------------
Method: TCanvas.SetRegion
Params: Value
Returns: Nothing
------------------------------------------------------------------------------}
Procedure TCanvas.SetRegion(value : TRegion);
begin
FRegion.Assign(Value);
end;
function TCanvas.DoCreateDefaultFont: TFPCustomFont;
begin
Result:=TFont.Create;
end;
function TCanvas.DoCreateDefaultPen: TFPCustomPen;
begin
Result:=TPen.Create;
end;
function TCanvas.DoCreateDefaultBrush: TFPCustomBrush;
begin
Result:=TBrush.Create;
end;
procedure TCanvas.SetColor(x, y: integer; const Value: TFPColor);
begin
Pixels[x,y]:=FPColorToTColor(Value);
end;
function TCanvas.GetColor(x, y: integer): TFPColor;
begin
Result:=TColorToFPColor(Pixels[x,y]);
end;
procedure TCanvas.SetHeight(AValue: integer);
begin
RaiseGDBException('TCanvas.SetHeight not allowed for LCL canvas');
end;
function TCanvas.GetHeight: integer;
var
p: TPoint;
begin
if HandleAllocated then begin
GetDeviceSize(Handle,p);
Result:=p.y;
end else
Result:=0;
end;
procedure TCanvas.SetWidth(AValue: integer);
begin
RaiseGDBException('TCanvas.SetWidth not allowed for LCL canvas');
end;
function TCanvas.GetWidth: integer;
var
p: TPoint;
begin
if HandleAllocated then begin
GetDeviceSize(Handle,p);
Result:=p.x;
end else
Result:=0;
end;
procedure TCanvas.GradientFill(ARect: TRect; AStart, AStop: TColor;
ADirection: TGradientDirection);
var
RStart, RStop: Byte;
GStart, GStop: Byte;
BStart, BStop: Byte;
RDiff, GDiff, BDiff: Integer;
Count, I: Integer;
begin
RedGreenBlue(ColorToRGB(AStart), RStart, GStart, BStart);
RedGreenBlue(ColorToRGB(AStop), RStop, GStop, BStop);
if ADirection = gdVertical then Count := ARect.Bottom - ARect.Top
else Count := ARect.Right - ARect.Left;
RDiff := RStop - RStart;
GDiff := GStop - GStart;
BDiff := BStop - BStart;
Changing;
for I := 0 to Count do
begin
Pen.Color := RGBToColor(RStart + (i * RDiff) div Count,
GStart + (i * GDiff) div Count,
BStart + (i * BDiff) div Count);
RequiredState([csHandleValid, csPenValid]);
if ADirection = gdHorizontal
then begin
// draw top to bottom, because LineTo does not draw last pixel
LCLIntf.MoveToEx(FHandle, ARect.Left+I, ARect.Top, nil);
LCLIntf.LineTo(FHandle, ARect.Left+I, ARect.Bottom);
end
else begin
// draw left to right, because LineTo does not draw last pixel
LCLIntf.MoveToEx(FHandle, ARect.Left, ARect.Top+I, nil);
LCLIntf.LineTo(FHandle, ARect.Right, ARect.Top+I);
end;
end;
Changed;
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
TextOut(X,Y,Text);
end;
procedure TCanvas.DoGetTextSize(Text: string; var w, h: integer);
var
TxtSize: tagSIZE;
begin
TxtSize:=TextExtent(Text);
w:=TxtSize.cx;
h:=TxtSize.cy;
end;
function TCanvas.DoGetTextHeight(Text: string): integer;
begin
Result:=TextHeight(Text);
end;
function TCanvas.DoGetTextWidth(Text: string): integer;
begin
Result:=TextWidth(Text);
end;
procedure TCanvas.DoRectangle(const Bounds: TRect);
begin
Frame(Bounds);
end;
procedure TCanvas.DoRectangleFill(const Bounds: TRect);
begin
FillRect(Bounds);
end;
procedure TCanvas.DoRectangleAndFill(const Bounds: TRect);
begin
Rectangle(Bounds);
end;
procedure TCanvas.DoEllipse(const Bounds: TRect);
var
x1: Integer;
y1: Integer;
x2: Integer;
y2: Integer;
begin
if Bounds.Left < Bounds.Right then
begin
x1 := Bounds.Left;
x2 := Bounds.Right;
end else
begin
x1 := Bounds.Right;
x2 := Bounds.Left;
end;
if Bounds.Top < Bounds.Bottom then
begin
y1 := Bounds.Top;
y2 := Bounds.Bottom;
end else
begin
y1 := Bounds.Bottom;
y2 := Bounds.Top;
end;
Arc(x1, y1, x2, y2, 0, 360*16);
end;
procedure TCanvas.DoEllipseFill(const Bounds: TRect);
begin
Ellipse(Bounds);
end;
procedure TCanvas.DoEllipseAndFill(const Bounds: TRect);
begin
inherited DoEllipseAndFill(Bounds);
end;
procedure TCanvas.DoPolygon(const Points: array of TPoint);
begin
Polyline(Points);
end;
procedure TCanvas.DoPolygonFill(const Points: array of TPoint);
begin
Polygon(Points);
end;
procedure TCanvas.DoPolygonAndFill(const Points: array of TPoint);
begin
inherited DoPolygonAndFill(Points);
end;
procedure TCanvas.DoPolyline(const Points: array of TPoint);
begin
Polyline(Points);
end;
procedure TCanvas.DoFloodFill(x, y: integer);
begin
FloodFill(x, y, Brush.Color, fsSurface);
end;
procedure TCanvas.DoMoveTo(x, y: integer);
begin
MoveTo(X,Y);
end;
procedure TCanvas.DoLineTo(x, y: integer);
begin
LineTo(X,Y);
end;
procedure TCanvas.DoLine(x1, y1, x2, y2: integer);
begin
Line(x1,y1,x2,y2);
end;
procedure TCanvas.DoCopyRect(x, y: integer; SrcCanvas: TFPCustomCanvas;
const SourceRect: TRect);
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, DummyHnd: HBitmap;
begin
if Image=nil then exit;
BitmapHnd:=0;
try
if Image is TLazIntfImage
then begin
LazImg := TLazIntfImage(Image);
end
else begin
LazImg := TLazIntfImage.Create(0,0);
RequiredState([csHandleValid]);
LazImg.DataDescription := GetDescriptionFromDevice(Handle, 0, 0);
LazImg.Assign(Image);
end;
LazImg.CreateBitmaps(BitmapHnd, DummyHnd, True);
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 DeleteObject(BitmapHnd);
end;
end;
procedure TCanvas.CheckHelper(AHelper: TFPCanvasHelper);
begin
debugln('TCanvas.CheckHelper ignored for ',DbgSName(AHelper));
end;
{------------------------------------------------------------------------------
Method: TCanvas.Arc
Params: ALeft, ATop, ARight, ABottom, angle1, angle2
Returns: Nothing
Use Arc to draw an elliptically curved line with the current Pen.
The angles angle1 and angle2 are 1/16th of a degree. For example, a full
circle equals 5760 (16*360). Positive values of Angle and AngleLength mean
counter-clockwise while negative values mean clockwise direction.
Zero degrees is at the 3'o clock position.
------------------------------------------------------------------------------}
procedure TCanvas.Arc(ALeft, ATop, ARight, ABottom, angle1, angle2 : Integer);
begin
Changing;
RequiredState([csHandleValid, csPenValid]);
LCLIntf.Arc(FHandle, ALeft, ATop, ARight, ABottom, angle1, angle2);
Changed;
end;
{------------------------------------------------------------------------------
Method: TCanvas.Arc
Params: ALeft, ATop, ARight, ABottom, sx, sy, ex, ey
Returns: Nothing
Use Arc to draw an elliptically curved line with the current Pen. The
values sx,sy, and ex,ey represent the starting and ending radial-points
between which the Arc is drawn.
------------------------------------------------------------------------------}
procedure TCanvas.Arc(ALeft,ATop,ARight,ABottom,sx,sy,ex,ey : Integer);
begin
Changing;
RequiredState([csHandleValid, csBrushValid, csPenValid]);
LCLIntf.RadialArc(FHandle, ALeft, ATop, ARight, ABottom, sx, sy, ex, ey);
Changed;
end;
{------------------------------------------------------------------------------
Method: TCanvas.RadialPie
Params: x1, y1, x2, y2, StartAngle16Deg, EndAngle16Deg: Integer
Returns: Nothing
Use Pie to draw a filled pie-shaped wedge on the canvas.
The angles StartAngle16Deg and EndAngle16Deg are 1/16th of a degree.
For example, a full circle equals 5760 (16*360).
Positive values of Angle and AngleLength mean
counter-clockwise while negative values mean clockwise direction.
Zero degrees is at the 3'o clock position.
------------------------------------------------------------------------------}
procedure TCanvas.RadialPie(x1, y1, x2, y2,
StartAngle16Deg, EndAngle16Deg: Integer);
begin
Changing;
RequiredState([csHandleValid, csBrushValid, csPenValid]);
LCLIntf.RadialPie(FHandle, x1, y1, x2, y2, StartAngle16Deg,EndAngle16Deg);
Changed;
end;
{------------------------------------------------------------------------------
Method: TCanvas.Pie
Params: EllipseX1, EllipseY1, EllipseX2, EllipseY2,
StartX, StartY, EndX, EndY
Returns: Nothing
Use Pie to draw a filled Pie-shaped wedge on the canvas. The pie is part of
an ellipse between the points EllipseX1, EllipseY1, EllipseX2, EllipseY2.
The values StartX, StartY and EndX, EndY represent the starting and ending
radial-points between which the Bounding-Arc is drawn.
------------------------------------------------------------------------------}
procedure TCanvas.Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2,
StartX, StartY, EndX, EndY: Integer);
begin
Changing;
RequiredState([csHandleValid, csBrushValid, csPenValid]);
LCLIntf.Pie(FHandle,EllipseX1,EllipseY1,EllipseX2,EllipseY2,
StartX,StartY,EndX,EndY);
Changed;
end;
{------------------------------------------------------------------------------
Method: TCanvas.PolyBezier
Params: Points, Filled, Continous
Returns: Boolean
Use Polybezier to draw cubic B<EFBFBD>zier curves. The first curve is drawn from the
first point to the fourth point with the second and third points being the
control points. If the Continuous flag is TRUE then each subsequent curve
requires three more points, using the end-point of the previous Curve as its
starting point, the first and second points being used as its control points,
and the third point its end-point. If the continous flag is set to FALSE,
then each subsequent Curve requires 4 additional points, which are used
excatly as in the first curve. Any additonal points which do not add up to
a full bezier(4 for Continuous, 3 otherwise) are ingored. There must be at
least 4 points for an drawing to occur. If the Filled Flag is set to TRUE
then the resulting Poly-B<EFBFBD>zier will be drawn as a Polygon.
------------------------------------------------------------------------------}
procedure TCanvas.PolyBezier(const Points: array of TPoint;
Filled: boolean = False;
Continuous: boolean = False);
var NPoints, i: integer;
PointArray: ^TPoint;
begin
NPoints:=High(Points)-Low(Points)+1;
if NPoints<=0 then exit;
GetMem(PointArray,SizeOf(TPoint)*NPoints);
for i:=0 to NPoints-1 do
PointArray[i]:=Points[i+Low(Points)];
PolyBezier(PointArray, NPoints, Filled, Continuous);
FreeMem(PointArray);
end;
procedure TCanvas.PolyBezier(Points: PPoint; NumPts: Integer;
Filled: boolean = False;
Continuous: boolean = False);
begin
Changing;
RequiredState([csHandleValid, csBrushValid, csPenValid]);
LCLIntf.PolyBezier(FHandle,Points,NumPts,Filled, Continuous);
Changed;
end;
{------------------------------------------------------------------------------
Method: TCanvas.Polygon
Params: Points: array of TPoint; Winding: Boolean = False;
StartIndex: Integer = 0; NumPts: Integer = -1
Returns: Nothing
Use Polygon to draw a closed, many-sided shape on the canvas, using the value
of Pen. After drawing the complete shape, Polygon fills the shape using the
value of Brush.
The Points parameter is an array of points that give the vertices of the
polygon.
Winding determines how the polygon is filled. When Winding is True, Polygon
fills the shape using the Winding fill algorithm. When Winding is False,
Polygon uses the even-odd (alternative) fill algorithm.
StartIndex gives the index of the first point in the array to use. All points
before this are ignored.
NumPts indicates the number of points to use, starting at StartIndex.
If NumPts is -1 (the default), Polygon uses all points from StartIndex to the
end of the array.
The first point is always connected to the last point.
To draw a polygon on the canvas, without filling it, use the Polyline method,
specifying the first point a second time at the end.
}
procedure TCanvas.Polygon(const Points: array of TPoint; Winding: Boolean;
StartIndex: Integer; NumPts: Integer);
var
NPoints: integer;
begin
if NumPts<0 then
NPoints:=High(Points)-StartIndex+1
else
NPoints:=NumPts;
if NPoints<=0 then exit;
Polygon(@Points[StartIndex],NPoints,Winding);
end;
procedure TCanvas.Polygon(Points: PPoint; NumPts: Integer;
Winding: boolean = False);
begin
if NumPts<=0 then exit;
Changing;
RequiredState([csHandleValid, csBrushValid, csPenValid]);
LCLIntf.Polygon(FHandle,Points,NumPts,Winding);
Changed;
end;
{------------------------------------------------------------------------------
Method: TCanvas.Polygon
Params: Points
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCanvas.Polygon(const Points: array of TPoint);
begin
Polygon(Points, True, Low(Points), High(Points) - Low(Points) + 1);
end;
{------------------------------------------------------------------------------
Method: TCanvas.Polyline
Params: Points: array of TPoint;
StartIndex: Integer = 0; NumPts: Integer = -1
Returns: Nothing
Use Polyline to connect a set of points on the canvas. If you specify only two
points, Polyline draws a single line.
The Points parameter is an array of points to be connected.
StartIndex identifies the first point in the array to use.
NumPts indicates the number of points to use. If NumPts is -1 (the default),
PolyLine uses all the points from StartIndex to the end of the array.
Calling the MoveTo function with the value of the first point, and then
repeatedly calling LineTo with all subsequent points will draw the same image
on the canvas. However, unlike LineTo, Polyline does not change the value of
PenPos.
}
procedure TCanvas.Polyline(const Points: array of TPoint; StartIndex: Integer;
NumPts: Integer);
var
NPoints : integer;
begin
if NumPts<0 then
NPoints:=High(Points)-StartIndex+1
else
NPoints:=NumPts;
if NPoints<=0 then exit;
Polyline(@Points[StartIndex], NPoints);
end;
procedure TCanvas.Polyline(Points: PPoint; NumPts: Integer);
begin
Changing;
RequiredState([csHandleValid, csPenValid]);
LCLIntf.Polyline(FHandle,Points,NumPts);
Changed;
end;
{------------------------------------------------------------------------------
Method: TCanvas.Polyline
Params: Points
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCanvas.Polyline(const Points: array of TPoint);
begin
Polyline(Points, Low(Points), High(Points) - Low(Points) + 1);
end;
{------------------------------------------------------------------------------
Method: TCanvas.Ellipse
Params: X1, Y1, X2, Y2
Returns: Nothing
Use Ellipse to draw a filled circle or ellipse on the canvas.
------------------------------------------------------------------------------}
procedure TCanvas.Ellipse(x1, y1, x2, y2: Integer);
begin
Changing;
RequiredState([csHandleValid, csBrushValid, csPenValid]);
LCLIntf.Ellipse(FHandle,x1,y1,x2,y2);
Changed;
end;
{------------------------------------------------------------------------------
Method: TCanvas.Ellipse
Params: ARect: TRect
Returns: Nothing
Use Ellipse to draw a filled circle or ellipse on the canvas.
------------------------------------------------------------------------------}
procedure TCanvas.Ellipse(const ARect: TRect);
begin
Ellipse(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom);
end;
{------------------------------------------------------------------------------
Method: TCanvas.FillRect
Params: ARect
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCanvas.FillRect(const ARect : TRect);
begin
Changing;
RequiredState([csHandleValid, csBrushValid]);
LCLIntf.FillRect(FHandle, ARect, Brush.Handle);
Changed;
end;
{------------------------------------------------------------------------------
procedure TCanvas.FillRect(X1,Y1,X2,Y2 : Integer);
------------------------------------------------------------------------------}
procedure TCanvas.FillRect(X1,Y1,X2,Y2 : Integer);
begin
FillRect(Rect(X1,Y1,X2,Y2));
end;
{------------------------------------------------------------------------------
Method: TCanvas.FillRect
Params: X, Y: Integer; Color: TColor; FillStyle: TFillStyle
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCanvas.FloodFill(X, Y: Integer; FillColor: TColor;
FillStyle: TFillStyle);
begin
Changing;
RequiredState([csHandleValid, csBrushValid]);
LCLIntf.FloodFill(FHandle, X, Y, FillColor, FillStyle, Brush.Handle);
Changed;
end;
{------------------------------------------------------------------------------
Method: TCanvas.Frame3d
Params: Rect
Returns: the inflated rectangle (the inner rectangle without the frame)
------------------------------------------------------------------------------}
procedure TCanvas.Frame3d(var ARect: TRect; const FrameWidth : integer;
const Style : TGraphicsBevelCut);
begin
Changing;
RequiredState([csHandleValid,csBrushValid,csPenValid]);
LCLIntf.Frame3d(FHandle, ARect, FrameWidth, Style);
Changed;
end;
{------------------------------------------------------------------------------
procedure TCanvas.Frame(const ARect: TRect);
Drawing the border of a rectangle with the current pen
------------------------------------------------------------------------------}
procedure TCanvas.Frame(const ARect: TRect);
begin
Changing;
RequiredState([csHandleValid, csPenValid]);
LCLIntf.Frame(FHandle, ARect);
Changed;
end;
{------------------------------------------------------------------------------
procedure TCanvas.Frame(const ARect: TRect);
Drawing the border of a rectangle with the current pen
------------------------------------------------------------------------------}
procedure TCanvas.Frame(X1, Y1, X2, Y2: Integer);
begin
Frame(Rect(X1, Y1, X2, Y2));
end;
{------------------------------------------------------------------------------
procedure TCanvas.FrameRect(const ARect: TRect);
Drawing the border of a rectangle with the current brush
------------------------------------------------------------------------------}
procedure TCanvas.FrameRect(const ARect: TRect);
begin
Changing;
RequiredState([csHandleValid, csBrushValid]);
LCLIntf.FrameRect(FHandle, ARect, Brush.GetHandle);
Changed;
end;
{------------------------------------------------------------------------------
procedure TCanvas.FrameRect(const ARect: TRect);
Drawing the border of a rectangle with the current brush
------------------------------------------------------------------------------}
procedure TCanvas.FrameRect(X1, Y1, X2, Y2: Integer);
begin
FrameRect(Rect(X1, Y1, X2, Y2));
end;
{------------------------------------------------------------------------------
Method: TCanvas.Rectangle
Params: X1,Y1,X2,Y2
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCanvas.Rectangle(X1,Y1,X2,Y2 : Integer);
begin
Changing;
RequiredState([csHandleValid, csBrushValid, csPenValid]);
LCLIntf.Rectangle(FHandle, X1, Y1, X2, Y2);
Changed;
end;
{------------------------------------------------------------------------------
Method: TCanvas.Rectangle
Params: Rect
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCanvas.Rectangle(const ARect: TRect);
begin
Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
end;
{------------------------------------------------------------------------------
Method: TCanvas.RoundRect
Params: X1, Y1, X2, Y2, RX, RY
Returns: Nothing
------------------------------------------------------------------------------}
Procedure TCanvas.RoundRect(X1, Y1, X2, Y2: Integer; RX,RY : Integer);
begin
Changing;
RequiredState([csHandleValid, csBrushValid, csPenValid]);
LCLIntf.RoundRect(FHandle, X1, Y1, X2, Y2, RX, RY);
Changed;
end;
{------------------------------------------------------------------------------
Method: TCanvas.RoundRect
Params: Rect, RX, RY
Returns: Nothing
------------------------------------------------------------------------------}
Procedure TCanvas.RoundRect(const Rect : TRect; RX,RY : Integer);
begin
RoundRect(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, RX, RY);
end;
{------------------------------------------------------------------------------
Method: TCanvas.TextRect
Params: ARect, X, Y, Text
Returns: Nothing
------------------------------------------------------------------------------}
Procedure TCanvas.TextRect(const ARect: TRect; X,Y : Integer;
const Text : String);
begin
TextRect(ARect,X,Y,Text,TextStyle);
end;
{------------------------------------------------------------------------------
Method: TCanvas.TextRect
Params: ARect, X, Y, Text, Style
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCanvas.TextRect(ARect: TRect; X, Y : Integer; const Text : String;
const Style : TTextStyle);
var
Options : Longint;
fRect : TRect;
DCIndex: Integer;
DC: HDC;
ReqState: TCanvasState;
procedure SaveState;
begin
if DCIndex<>0 then exit;
DCIndex:=SaveDC(DC);
end;
procedure RestoreState;
begin
if DCIndex=0 then exit;
RestoreDC(DC,DCIndex);
end;
begin
//debugln(['TCanvas.TextRect ',DbgSName(Self),' Text="',Text,'" ',dbgs(ARect),' X=',X,',Y=',Y]);
Changing;
Options := 0;
case Style.Alignment of
taRightJustify : Options := DT_RIGHT;
taCenter : Options := DT_CENTER;
end;
case Style.Layout of
tlCenter : Options := Options or DT_VCENTER;
tlBottom : Options := Options or DT_BOTTOM;
end;
If Style.WordBreak then
Options := Options or DT_WORDBREAK;
If Style.SingleLine then
Options := Options or DT_SINGLELINE;
If not Style.Clipping then
Options := Options or DT_NOCLIP;
If not Style.ShowPrefix then
Options := Options or DT_NOPREFIX;
If Style.RightToLeft then
Options := Options or DT_RTLREADING;
ReqState:=[csHandleValid];
if not Style.SystemFont then
Include(ReqState,csFontValid);
if Style.Opaque then
Include(ReqState,csBrushValid);
DC:=GetUpdatedHandle(ReqState);
DCIndex:=0;
if Style.SystemFont or Style.Clipping or (not Style.Opaque) then
SaveState;
if Style.SystemFont then
begin
Options := Options or DT_INTERNAL;
SelectObject(DC, GetStockObject(DEFAULT_GUI_FONT));
end;
// calculate text rectangle
fRect := ARect;
if Style.Alignment = taLeftJustify then
fRect.Left := X;
if Style.Layout = tlTop then
fRect.Top := Y;
if (Style.Alignment in [taRightJustify,taCenter]) or
(Style.Layout in [tlCenter,tlBottom]) then
begin
DrawText(DC, pChar(Text), Length(Text), fRect, DT_CALCRECT or Options);
case Style.Alignment of
taRightJustify : OffsetRect(fRect, ARect.Right - fRect.Right, 0);
taCenter : OffsetRect(fRect, (ARect.Right - fRect.Right) div 2, 0);
end;
case Style.Layout of
tlCenter : OffsetRect(fRect, 0,
((ARect.Bottom - ARect.Top) - (fRect.Bottom - fRect.Top)) div 2);
tlBottom : OffsetRect(fRect, 0, ARect.Bottom - fRect.Bottom);
end;
end;
if Style.Clipping then
begin
IntersectRect(ARect, ARect, fRect);
with ARect do
InterSectClipRect(DC, Left, Top, Right, Bottom);
Options := Options or DT_NOCLIP; // no clipping as we are handling it here
end;
if Style.Opaque then
FillRect(fRect)
else
SetBkMode(DC, TRANSPARENT);
if Style.SystemFont then
SetTextColor(DC, Font.Color);
//debugln('TCanvas.TextRect DRAW Text="',Text,'" ',dbgs(fRect));
DrawText(DC, pChar(Text), Length(Text), fRect, Options);
if Style.Opaque and (csBrushValid in FState) then
begin
if Brush.Style=bsSolid then // restore BKMode
SetBkMode(DC, OPAQUE)
end;
RestoreState;
Changed;
end;
{------------------------------------------------------------------------------
Method: TCanvas.TextOut
Params: X,Y,Text
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCanvas.TextOut(X,Y: Integer; const Text: String);
var
Flags : Cardinal;
begin
Changing;
RequiredState([csHandleValid, csFontValid, csBrushValid]);
Flags := 0;
If TextStyle.Opaque then
Flags := ETO_Opaque;
ExtUTF8Out(FHandle, X, Y, Flags, nil, PChar(Text), Length(Text), nil);
MoveTo(X + TextWidth(Text), Y);
Changed;
end;
{------------------------------------------------------------------------------
function TCanvas.HandleAllocated: boolean;
------------------------------------------------------------------------------}
function TCanvas.HandleAllocated: boolean;
begin
Result:=(FHandle<>0);
end;
{------------------------------------------------------------------------------
function TCanvas.GetUpdatedHandle(ReqState: TCanvasState): HDC;
------------------------------------------------------------------------------}
function TCanvas.GetUpdatedHandle(ReqState: TCanvasState): HDC;
begin
RequiredState(ReqState+[csHandleValid]);
Result:=FHandle;
end;
{------------------------------------------------------------------------------
Method: TCanvas.MoveTo
Params: X1,Y1
Returns: Nothing
------------------------------------------------------------------------------}
Procedure TCanvas.MoveTo(X1, Y1: Integer);
begin
RequiredState([csHandleValid]);
if LCLIntf.MoveToEx(FHandle, X1, Y1, nil) then begin
SetInternalPenPos(Point(X1, Y1));
end;
End;
{------------------------------------------------------------------------------
Method: TCanvas.LineTo
Params: X1,Y1
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCanvas.LineTo(X1, Y1 : Integer);
begin
Changing;
RequiredState([csHandleValid, csPenValid]);
if LCLIntf.LineTo(FHandle, X1, Y1) then
SetInternalPenPos(Point(X1, Y1));
Changed;
end;
{------------------------------------------------------------------------------
Method: TCanvas.Line
Params: X1,Y1,X2,Y2
Returns: Nothing
------------------------------------------------------------------------------}
procedure TCanvas.Line(X1,Y1,X2,Y2 : Integer);
begin
MoveTo(X1, Y1);
LineTo(X2, Y2);
end;
procedure TCanvas.Line(const p1, p2: TPoint);
begin
Line(p1.x,p1.y,p2.x,p2.y);
end;
procedure TCanvas.Line(const Points: TRect);
begin
with Points do
Line(Left,Top,Right,Bottom);
end;
{------------------------------------------------------------------------------
Method: TCanvas.BrushChanged
Params: ABrush: The changed brush
Returns: Nothing
Notify proc for a brush change
------------------------------------------------------------------------------}
procedure TCanvas.BrushChanged(ABrush: TObject);
begin
if csBrushValid in FState then begin
Exclude(FState, csBrushValid);
end;
end;
{------------------------------------------------------------------------------
Method: TCanvas.FontChanged
Params: AFont: the changed font
Returns: Nothing
Notify proc for a font change
------------------------------------------------------------------------------}
procedure TCanvas.FontChanged(AFont: TObject);
begin
if csFontValid in FState then begin
Exclude(FState, csFontValid);
end;
end;
{------------------------------------------------------------------------------
Method: TCanvas.PenChanging
Params: APen: The changing pen
Returns: Nothing
Notify proc for a pen change
------------------------------------------------------------------------------}
procedure TCanvas.PenChanging(APen: TObject);
begin
if [csPenValid, csHandleValid] * FState = [csPenValid, csHandleValid] then
begin
Exclude(FState, csPenValid);
SelectObject(FHandle, FSavedPenHandle);
FSavedPenHandle := 0;
end;
end;
procedure TCanvas.FontChanging(APen: TObject);
begin
if [csFontValid, csHandleValid] * FState = [csFontValid, csHandleValid] then
begin
Exclude(FState, csFontValid);
SelectObject(FHandle, FSavedFontHandle);
FSavedFontHandle := 0;
end;
end;
procedure TCanvas.BrushChanging(APen: TObject);
begin
if [csBrushValid, csHandleValid] * FState = [csBrushValid, csHandleValid] then
begin
Exclude(FState, csBrushValid);
SelectObject(FHandle, FSavedBrushHandle);
FSavedBrushHandle := 0;
end;
end;
procedure TCanvas.RegionChanging(APen: TObject);
begin
if [csRegionValid, csHandleValid] * FState = [csRegionValid, csHandleValid] then
begin
Exclude(FState, csRegionValid);
SelectObject(FHandle, FSavedRegionHandle);
FSavedRegionHandle := 0;
end;
end;
{------------------------------------------------------------------------------
Method: TCanvas.PenChanged
Params: APen: The changed pen
Returns: Nothing
Notify proc for a pen change
------------------------------------------------------------------------------}
procedure TCanvas.PenChanged(APen: TObject);
begin
if csPenValid in FState
then begin
Exclude(FState, csPenValid);
end;
end;
{------------------------------------------------------------------------------
Method: TCanvas.RegionChanged
Params: ARegion: The changed Region
Returns: Nothing
Notify proc for a region change
------------------------------------------------------------------------------}
procedure TCanvas.RegionChanged(ARegion: TObject);
begin
if csRegionValid in FState
then begin
Exclude(FState, csRegionValid);
end;
end;
{------------------------------------------------------------------------------
Method: TCanvas.Create
Params: none
Returns: Nothing
Constructor for the class.
------------------------------------------------------------------------------}
constructor TCanvas.Create;
begin
FHandle := 0;
ManageResources := true;
inherited Create;
FFont := TFont(inherited Font);
FPen := TPen(inherited Pen);
FBrush := TBrush(inherited Brush);
FFont.OnChanging := @FontChanging;
FFont.OnChange := @FontChanged;
FSavedFontHandle := 0;
FPen.OnChanging := @PenChanging;
FPen.OnChange := @PenChanged;
FSavedPenHandle := 0;
FBrush.OnChanging := @BrushChanging;
FBrush.OnChange := @BrushChanged;
FSavedBrushHandle := 0;
FRegion := TRegion.Create;
FRegion.OnChanging := @RegionChanging;
FRegion.OnChange := @RegionChanged;
FSavedRegionHandle := 0;
FCopyMode := cmSrcCopy;
// FLock will be initialized on demand, because most canvas don't use it
With FTextStyle do begin
Alignment := taLeftJustify;
Layout := tlTop;
WordBreak := True;
SingleLine := True;
Clipping := True;
ShowPrefix := False;
Opaque := False;
end;
end;
{------------------------------------------------------------------------------
Method: TCanvas.Chord
Params: x1, y1, x2, y2, StartAngle16Deg, EndAngle16Deg
Returns: Nothing
Use Chord to draw a filled Chord-shape on the canvas. The angles angle1 and
angle2 are 1/16th of a degree. For example, a full circle equals 5760(16*360).
Positive values of Angle and AngleLength mean counter-clockwise while negative
values mean clockwise direction. Zero degrees is at the 3'o clock position.
------------------------------------------------------------------------------}
procedure TCanvas.Chord(x1, y1, x2, y2,
StartAngle16Deg, EndAngle16Deg: Integer);
begin
Changing;
RequiredState([csHandleValid, csBrushValid, csPenValid]);
LCLIntf.AngleChord(FHandle, x1, y1, x2, y2, StartAngle16Deg, EndAngle16Deg);
Changed;
end;
{------------------------------------------------------------------------------
Method: TCanvas.Chord
Params: x1, y1, x2, y2, sx, sy, ex, ey
Returns: Nothing
Use Chord to draw a filled Chord-shape on the canvas. The values sx,sy,
and ex,ey represent a starting and ending radial-points between which
the Arc is draw.
------------------------------------------------------------------------------}
procedure TCanvas.Chord(x1, y1, x2, y2, sx, sy, ex, ey : Integer);
begin
Changing;
RequiredState([csHandleValid, csBrushValid, csPenValid]);
LCLIntf.RadialChord(FHandle, x1, y1, x2, y2, sx, sy, ex, ey);
Changed;
end;
{------------------------------------------------------------------------------
Method: TCanvas.Destroy
Params: None
Returns: Nothing
Destructor for the class.
------------------------------------------------------------------------------}
destructor TCanvas.Destroy;
begin
//DebugLn('[TCanvas.Destroy] ',ClassName,' Self=',DbgS(Self));
Handle := 0;
FreeThenNil(FRegion);
FreeThenNil(FSavedHandleStates);
if FLock <> 0 then
DeleteCriticalSection(FLock);
inherited Destroy;
// set resources to nil, so that dangling pointers are spotted early
FFont:=nil;
FPen:=nil;
FBrush:=nil;
end;
{------------------------------------------------------------------------------
Function: TCanvas.GetHandle
Params: None
Returns: A handle to the GUI object
Checks if a handle is allocated, otherwise create it
------------------------------------------------------------------------------}
function TCanvas.GetHandle : HDC;
begin
//DebugLn('[TCanvas.GetHandle] ',ClassName);
RequiredState(csAllValid);
Result := FHandle;
end;
{------------------------------------------------------------------------------
Method: TCanvas.SetHandle
Params: NewHandle - the new device context
Returns: nothing
Deselect sub handles and sets the Handle
------------------------------------------------------------------------------}
procedure TCanvas.SetHandle(NewHandle: HDC);
begin
if FHandle = NewHandle then Exit;
//DebugLn('[TCanvas.SetHandle] Self=',DbgS(Self),' Old=',DbgS(FHandle,8),' New=',DbgS(NewHandle,8));
if FHandle <> 0 then
begin
DeselectHandles;
Exclude(FState, csHandleValid);
end;
FHandle := NewHandle;
if FHandle <> 0 then
begin
Include(FState, csHandleValid);
end;
//DebugLn('[TCanvas.SetHandle] END Self=',DbgS(Self),' Handle=',DbgS(FHandle,8));
end;
{------------------------------------------------------------------------------
Method: TCanvas.DeselectHandles
Params: none
Returns: nothing
Deselect all subhandles in the current device context
------------------------------------------------------------------------------}
procedure TCanvas.DeselectHandles;
begin
//debugln('TCanvas.DeselectHandles ',ClassName,' Self=',DbgS(Self),' Handle=',DbgS(FHandle),' FSavedBrushHandle=',DbgS(Cardinal(FSavedBrushHandle)));
if (FHandle<>0) then begin
// select default sub handles in the device context without deleting owns
if FSavedBrushHandle<>0 then
SelectObject(FHandle,FSavedBrushHandle);
if FSavedPenHandle<>0 then
SelectObject(FHandle,FSavedPenHandle);
if FSavedFontHandle<>0 then
SelectObject(FHandle,FSavedFontHandle);
FState := FState - [csPenValid, csBrushValid, csFontValid];
end;
FSavedBrushHandle:=0;
FSavedPenHandle:=0;
FSavedFontHandle:=0;
end;
{------------------------------------------------------------------------------
Method: TCanvas.CreateHandle
Params: None
Returns: Nothing
Creates the handle ( = object).
------------------------------------------------------------------------------}
procedure TCanvas.CreateHandle;
begin
// Plain canvas does nothing
end;
procedure TCanvas.FreeHandle;
begin
Handle:=0;
end;
{------------------------------------------------------------------------------
Method: TCanvas.RequiredState
Params: ReqState: The required state
Returns: Nothing
Ensures that all handles needed are valid;
------------------------------------------------------------------------------}
procedure TCanvas.RequiredState(ReqState: TCanvasState);
var
Needed: TCanvasState;
begin
Needed := ReqState - FState;
//DebugLn('[TCanvas.RequiredState] ',ClassName,' ',csHandleValid in ReqState,' ',csHandleValid in FState,' Needed=',Needed<>[]);
if Needed <> [] then
begin
//DebugLn('[TCanvas.RequiredState] B ',ClassName,' ',csHandleValid in Needed,',',csFontValid in Needed,',',csPenValid in Needed,',',csBrushValid in Needed);
if csHandleValid in Needed then
begin
CreateHandle;
if FHandle = 0 then
raise EInvalidOperation.Create(rsCanvasDoesNotAllowDrawing);
Include(FState, csHandleValid);
end;
if csFontValid in Needed then CreateFont;
if csPenValid in Needed then
begin
CreatePen;
if Pen.Style in [psDash, psDot, psDashDot, psDashDotDot]
then Include(Needed, csBrushValid);
end;
if csBrushValid in Needed then CreateBrush;
end;
end;
procedure TCanvas.Changed;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TCanvas.SaveHandleState;
var
DCIndex: LongInt;
begin
if FSavedHandleStates=nil then FSavedHandleStates:=TFPList.Create;
DeselectHandles;
RequiredState([csHandleValid]);
DCIndex:=SaveDC(Handle);
FSavedHandleStates.Add(Pointer(PtrInt(DCIndex)));
end;
procedure TCanvas.RestoreHandleState;
var
DCIndex: LongInt;
begin
DCIndex:=integer(PtrUInt(FSavedHandleStates[FSavedHandleStates.Count-1]));
FSavedHandleStates.Delete(FSavedHandleStates.Count-1);
DeselectHandles;
RestoreDC(Handle,DCIndex);
end;
procedure TCanvas.Changing;
begin
if Assigned(FOnChanging) then FOnChanging(Self);
end;
{------------------------------------------------------------------------------
Function: TCanvas.TextExtent
Params: Text: The text to measure
Returns: The size
Gets the width and height of a text
------------------------------------------------------------------------------}
function TCanvas.TextExtent(const Text: string): TSize;
begin
Result.cX := 0;
Result.cY := 0;
if Text='' then exit;
RequiredState([csHandleValid, csFontValid]);
GetTextExtentPoint(FHandle, PChar(Text), Length(Text), Result);
end;
{------------------------------------------------------------------------------
Function: TCanvas.TextWidth
Params: Text: The text to measure
Returns: The width
Gets the width of a text
------------------------------------------------------------------------------}
function TCanvas.TextWidth(const Text: string): Integer;
begin
Result := TextExtent(Text).cX;
end;
{------------------------------------------------------------------------------
Function: TCanvas.TextHeight
Params: Text: The text to measure
Returns: A handle to the GUI object
Gets the height of a text
------------------------------------------------------------------------------}
function TCanvas.TextHeight(const Text: string): Integer;
begin
Result := TextExtent(Text).cY;
end;
{------------------------------------------------------------------------------
Function: TCanvas.Lock
Params: none
Returns: nothing
------------------------------------------------------------------------------}
procedure TCanvas.Lock;
begin
LockCanvas;
end;
{------------------------------------------------------------------------------
Function: TCanvas.Unlock
Params: none
Returns: nothing
------------------------------------------------------------------------------}
procedure TCanvas.Unlock;
procedure RaiseTooManyUnlock;
begin
raise Exception.Create(
'TCanvas.Unlock '+DbgSName(Self)+': too many unlocks');
end;
begin
UnlockCanvas;
end;
{------------------------------------------------------------------------------
procedure TCanvas.Refresh;
------------------------------------------------------------------------------}
procedure TCanvas.Refresh;
begin
DeselectHandles;
end;
Reference in New Issue View Git Blame Copy Permalink