Logo Search packages:      
Sourcecode: lazarus version File versions

canvas.inc

{%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
  OldHandle:=SelectObject(FHandle, 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
      LCLIntf.MoveToEx(FHandle, ARect.Left+I, ARect.Top, nil);
      LCLIntf.LineTo(FHandle, ARect.Left+I, ARect.Bottom);
    end
    else begin
      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,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, MaskHnd: HBitmap;
begin
  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
  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é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é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;
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
  else
    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.SystemFont then begin
    Options := Options or DT_INTERNAL;
    RequiredState([csHandleValid]);
    SelectObject(Self.Handle, GetStockObject(DEFAULT_GUI_FONT));
  end
  else
    RequiredState([csHandleValid, csFontValid]);

  // 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(Self.Handle,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
    DCIndex := SaveDC(Self.Handle);
    IntersectRect(ARect, ARect, fRect);
    with ARect do
      InterSectClipRect(Self.Handle, Left, Top, Right, Bottom);
    Options := Options or DT_NOCLIP; // no clipping as we are handling it here
  end;

  if Style.Opaque then begin
    RequiredState([csHandleValid, csBrushValid]);
    FillRect(fRect);
  end else begin
    SetBkMode(FHandle, TRANSPARENT);
  end;
  
  if Style.SystemFont then
    SetTextColor(Self.Handle, Font.Color);
  //debugln('TCanvas.TextRect DRAW Text="',Text,'" ',dbgs(fRect));
  DrawText(Self.Handle, pChar(Text), Length(Text), fRect, Options);
  
  if Style.Opaque and (csBrushValid in FState) then begin
    if Brush.Style=bsSolid then
      // restore BKMode
      SetBkMode(FHandle, OPAQUE)
  end;

  if Style.Clipping then begin
    if DCIndex <> -1 then
      RestoreDC(Self.Handle, DCIndex);
  end;

  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;


{------------------------------------------------------------------------------
  Function: TCanvas.GetColor
  Params:   None
  Returns:

 ------------------------------------------------------------------------------}
function TCanvas.GetColor:TColor;
begin
  Result:=Brush.Color;
end;


{------------------------------------------------------------------------------
  Method:   TCanvas.SetColor
  Params:   None
  Returns:  Nothing

 ------------------------------------------------------------------------------}
procedure TCanvas.SetColor(c:TColor);
begin
  Brush.Color:=c;
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;

{------------------------------------------------------------------------------
  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.OnChange := @FontChanged;
  FSavedFontHandle := 0;
  FPen.OnChanging := @PenChanging;
  FPen.OnChange := @PenChanged;
  FSavedPenHandle := 0;
  FBrush.OnChange := @BrushChanged;
  FSavedBrushHandle := 0;
  FRegion := TRegion.Create;
  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 := False;
    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);
  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 begin
    //DebugLn('[TCanvas.SetHandle] Self=',DbgS(Self),' Old=',DbgS(FHandle,8),' New=',DbgS(NewHandle,8));
    if FHandle <> 0 then
    begin
      DeselectHandles;
      FHandle := 0;
      Exclude(FState, csHandleValid);
    end;
    if NewHandle <> 0 then
    begin
      Include(FState, csHandleValid);
      FHandle := NewHandle;
    end;
    //DebugLn('[TCanvas.SetHandle] END Self=',DbgS(Self),' Handle=',DbgS(FHandle,8));
  end;
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 begin
      SelectObject(FHandle,FSavedBrushHandle);
      FSavedBrushHandle:=0;
    end;
    if FSavedPenHandle<>0 then begin
      SelectObject(FHandle,FSavedPenHandle);
      FSavedPenHandle:=0;
    end;
    if FSavedFontHandle<>0 then begin
      SelectObject(FHandle,FSavedFontHandle);
      FSavedFontHandle:=0;
    end;
    FState := FState - [csPenValid, csBrushValid, csFontValid];
  end;
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.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;

Generated by  Doxygen 1.6.0   Back to index