mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-30 20:02:42 +02:00
1586 lines
51 KiB
PHP
1586 lines
51 KiB
PHP
{******************************************************************************
|
||
TCANVAS
|
||
******************************************************************************
|
||
|
||
*****************************************************************************
|
||
* *
|
||
* This file is part of the Lazarus Component Library (LCL) *
|
||
* *
|
||
* See the file COPYING.LCL, 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.BrushCopy --}
|
||
{-----------------------------------------------}
|
||
Procedure TCanvas.BrushCopy(Dest: TRect; InternalImages: TBitmap; Src: TRect;
|
||
TransparentColor :TColor);
|
||
Begin
|
||
//TODO:TCANVAS.BRUSHCOPY
|
||
end;
|
||
|
||
{-----------------------------------------------}
|
||
{-- TCanvas.Draw --}
|
||
{-----------------------------------------------}
|
||
Procedure TCanvas.Draw(X,Y : Integer; Graphic : TGraphic);
|
||
begin
|
||
If Assigned(Graphic) then
|
||
StretchDraw(Rect(X, Y, Graphic.Width + X,Graphic.Height + Y), Graphic);
|
||
end;
|
||
|
||
{-----------------------------------------------}
|
||
{-- TCanvas.StretchDraw --}
|
||
{-----------------------------------------------}
|
||
procedure TCanvas.StretchDraw(const ARect: TRect; Graphic: TGraphic);
|
||
begin
|
||
if Assigned(Graphic) then
|
||
begin
|
||
RequiredState([csHandleValid, csPenValid]);
|
||
Graphic.Draw(Self, ARect);
|
||
end;
|
||
end;
|
||
|
||
{-----------------------------------------------}
|
||
{-- TCanvas.GetCanvasClipRect --}
|
||
{-----------------------------------------------}
|
||
function TCanvas.GetCanvasClipRect: 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
|
||
//this SHOULD stretch the image to the new canvas, but it doesn't yet.....
|
||
Assert(False, Format('Trace:==> [TCanvas.CopyRect] ', []));
|
||
if SrcCanvas<> nil then begin
|
||
SrcCanvas.RequiredState([csHandleValid, csBrushValid]);
|
||
RequiredState([csHandleValid, csBrushValid]);
|
||
|
||
SH := Source.Bottom - Source.Top;
|
||
SW := Source.Right - Source.Left;
|
||
if (SH=0) and (SW=0) then exit;
|
||
DH := Dest.Bottom - Dest.Top;
|
||
DW := Dest.Right - Dest.Left;
|
||
if (Dh=0) and (DW=0) then exit;
|
||
//writeln('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);
|
||
end;
|
||
|
||
Assert(False, Format('Trace:<== [TCanvas.CopyRect] ', []));
|
||
end;
|
||
{-----------------------------------------------}
|
||
{-- TCanvas.GetPixel --}
|
||
{-----------------------------------------------}
|
||
Function TCanvas.GetPixel(X,Y : Integer) : TColor;
|
||
var
|
||
Msg : TLMSetGetPixel;
|
||
{TLMSetGetPixel = record
|
||
X,Y : Integer;
|
||
PixColor : TColor;
|
||
end;
|
||
}
|
||
Begin
|
||
msg.X := x;
|
||
msg.Y := Y;
|
||
SendIntfMessage(LM_GetPixel, Self, @msg);
|
||
Result := msg.PixColor;
|
||
end;
|
||
|
||
{-----------------------------------------------}
|
||
{-- TCanvas.SetPixel --}
|
||
{-----------------------------------------------}
|
||
Procedure TCanvas.SetPixel(X,Y: Integer; Value : TColor);
|
||
var
|
||
Msg : TLMSetGetPixel;
|
||
Begin
|
||
Msg.X := X;
|
||
msg.Y := Y;
|
||
MSg.PixColor := Value;
|
||
SendIntfMessage(LM_SetPixel, Self, @msg);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TCanvas.CreateBrush
|
||
Params: None
|
||
Returns: Nothing
|
||
|
||
------------------------------------------------------------------------------}
|
||
procedure TCanvas.CreateBrush;
|
||
var OldHandle: HBRUSH;
|
||
begin
|
||
//writeln('[TCanvas.CreateBrush] ',Classname,' Self=',HexStr(Cardinal(Pointer(Self)),8)
|
||
// ,' Brush=',HexStr(Cardinal(Pointer(Brush)),8));
|
||
OldHandle:=SelectObject(FHandle, Brush.Handle);
|
||
if (OldHandle<>Brush.Handle) and (FSavedBrushHandle=0) then
|
||
FSavedBrushHandle:=OldHandle;
|
||
Include(FState, csBrushValid);
|
||
SetBkColor(FHandle, Brush.Color);
|
||
SetBkMode(FHandle, TRANSPARENT);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TCanvas.CreatePen
|
||
Params: None
|
||
Returns: Nothing
|
||
|
||
------------------------------------------------------------------------------}
|
||
procedure TCanvas.CreatePen;
|
||
var OldHandle: HPEN;
|
||
begin
|
||
//writeln('[TCanvas.CreatePen] ',Classname,' Self=',HexStr(Cardinal(Pointer(Self)),8)
|
||
// ,' Pen=',HexStr(Cardinal(Pointer(Pen)),8));
|
||
OldHandle:=SelectObject(FHandle, Pen.Handle);
|
||
if (OldHandle<>Pen.Handle) and (FSavedPenHandle=0) then
|
||
FSavedPenHandle:=OldHandle;
|
||
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;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TCanvas.GetPenPos
|
||
Params: None
|
||
Returns: PenPos
|
||
|
||
------------------------------------------------------------------------------}
|
||
function TCanvas.GetPenPos: TPoint;
|
||
begin
|
||
Result := FPenPos;
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TCanvas.SetAutoReDraw
|
||
Params: Value
|
||
Returns: Nothing
|
||
|
||
------------------------------------------------------------------------------}
|
||
procedure TCanvas.SetAutoReDraw(Value : Boolean);
|
||
begin
|
||
FAutoRedraw := Value;
|
||
If FAutoReDraw then
|
||
SendIntfMessage(LM_ReDraw, Self, nil);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TCanvas.SetPenPos
|
||
Params: Value
|
||
Returns: Nothing
|
||
|
||
------------------------------------------------------------------------------}
|
||
procedure TCanvas.SetPenPos(Value : TPoint);
|
||
begin
|
||
MoveTo(Value.X, Value.Y);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TCanvas.SetBrush
|
||
Params: Value
|
||
Returns: Nothing
|
||
|
||
------------------------------------------------------------------------------}
|
||
procedure TCanvas.SetBrush(Value : TBrush);
|
||
begin
|
||
FBrush.Assign(Value);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TCanvas.SetFont
|
||
Params: Value
|
||
Returns: Nothing
|
||
|
||
------------------------------------------------------------------------------}
|
||
procedure TCanvas.SetFont(Value : TFont);
|
||
begin
|
||
FFont.Assign(Value);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TCanvas.SetPen
|
||
Params: Value
|
||
Returns: Nothing
|
||
|
||
------------------------------------------------------------------------------}
|
||
procedure TCanvas.SetPen(Value : TPen);
|
||
begin
|
||
FPen.Assign(Value);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TCanvas.SetRegion
|
||
Params: Value
|
||
Returns: Nothing
|
||
|
||
------------------------------------------------------------------------------}
|
||
Procedure TCanvas.SetRegion(value : TRegion);
|
||
begin
|
||
FRegion.Assign(Value);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TCanvas.Arc
|
||
Params: x,y,width,height,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(x,y,width,height,angle1,angle2 : Integer);
|
||
begin
|
||
Changing;
|
||
RequiredState([csHandleValid, csPenValid]);
|
||
LCLIntf.Arc(FHandle,x,y,width,height,angle1,angle2);
|
||
Changed;
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TCanvas.Arc
|
||
Params: DC,x,y,width,height,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(x,y,width,height,sx,sy,ex,ey : Integer);
|
||
begin
|
||
Changing;
|
||
RequiredState([csHandleValid, csBrushValid, csPenValid]);
|
||
LCLIntf.RadialArc(FHandle,x,y,width,height,sx,sy,ex,ey);
|
||
Changed;
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TCanvas.RadialPie
|
||
Params: x,y,width,height,angle1,angle2
|
||
Returns: Nothing
|
||
|
||
Use Pie to draw a filled pie-shaped wedge 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.RadialPie(x,y,width,height,angle1,angle2 : Integer);
|
||
begin
|
||
Changing;
|
||
RequiredState([csHandleValid, csBrushValid, csPenValid]);
|
||
LCLIntf.RadialPieWithAngles(FHandle,x,y,width,height,angle1,angle2);
|
||
Changed;
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TCanvas.RadialPie
|
||
Params: x,y,width,height,sx,sy,ex,ey
|
||
Returns: Nothing
|
||
|
||
Use Pie to draw a filled Pie-shaped wedge on the canvas. The values sx,sy,
|
||
and ex,ey represent the starting and ending radial-points between which
|
||
the Bounding-Arc is drawn.
|
||
|
||
------------------------------------------------------------------------------}
|
||
procedure TCanvas.RadialPie(x,y,width,height,sx,sy,ex,ey: Integer);
|
||
begin
|
||
Changing;
|
||
RequiredState([csHandleValid, csBrushValid, csPenValid]);
|
||
LCLIntf.RadialPie(FHandle,x,y,width,height,sx,sy,ex,ey);
|
||
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{$IFNDEF VER1_0} = False{$ENDIF};
|
||
Continuous: boolean{$IFNDEF VER1_0} = False{$ENDIF});
|
||
var NPoints, i: integer;
|
||
PointArray: ^TPoint;
|
||
begin
|
||
Changing;
|
||
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);
|
||
Changed;
|
||
end;
|
||
|
||
procedure TCanvas.PolyBezier(Points: PPoint; NumPts: Integer;
|
||
Filled: boolean{$IFNDEF VER1_0} = False{$ENDIF};
|
||
Continuous: boolean{$IFNDEF VER1_0} = False{$ENDIF});
|
||
begin
|
||
Changing;
|
||
RequiredState([csHandleValid, csBrushValid, csPenValid]);
|
||
LCLIntf.PolyBezier(FHandle,Points,NumPts,Filled, Continuous);
|
||
Changed;
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TCanvas.PolyBezier
|
||
Params: Points
|
||
Returns: Nothing
|
||
|
||
------------------------------------------------------------------------------}
|
||
procedure TCanvas.PolyBezier(const Points: array of TPoint);
|
||
begin
|
||
PolyBezier(Points, False, True);
|
||
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{$IFNDEF VER1_0} = False{$ENDIF});
|
||
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: Nothing
|
||
|
||
------------------------------------------------------------------------------}
|
||
procedure TCanvas.Frame3d(var ARect: TRect; const FrameWidth : integer;
|
||
const Style : TGraphicsBevelCut);
|
||
begin
|
||
Changing;
|
||
RequiredState([csHandleValid]);
|
||
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 Rect: TRect);
|
||
begin
|
||
Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.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(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;
|
||
begin
|
||
Changing;
|
||
ARect.Left := ARect.Left + X;
|
||
ARect.Top := ARect.Top + Y;
|
||
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]);
|
||
|
||
fRect := ARect;
|
||
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) div 2
|
||
- (fRect.Bottom - fRect.Top) div 2);
|
||
tlBottom : OffsetRect(fRect, 0, ARect.Bottom - fRect.Bottom);
|
||
end;
|
||
If Style.Opaque then begin
|
||
RequiredState([csHandleValid, csBrushValid]);
|
||
FillRect(fRect);
|
||
end;
|
||
If Style.SystemFont then
|
||
SetTextColor(Self.Handle, Font.Color);
|
||
DrawText(Self.Handle, pChar(Text), Length(Text), fRect, Options);
|
||
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;
|
||
ExtTextOut(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 FPenPos:= Point(X1, Y1);
|
||
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 FPenPos:= 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;
|
||
|
||
|
||
{------------------------------------------------------------------------------
|
||
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);
|
||
//TODO: Select stock object;
|
||
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;
|
||
inherited Create;
|
||
FFont := TFont.Create;
|
||
FFont.OnChange := @FontChanged;
|
||
FSavedFontHandle := 0;
|
||
FPen := TPen.Create;
|
||
FPen.OnChanging := @PenChanging;
|
||
FPen.OnChange := @PenChanged;
|
||
FSavedPenHandle := 0;
|
||
FBrush := TBrush.Create;
|
||
FBrush.OnChange := @BrushChanged;
|
||
FSavedBrushHandle := 0;
|
||
FRegion := TRegion.Create;
|
||
FRegion.OnChange := @RegionChanged;
|
||
FSavedRegionHandle := 0;
|
||
FCopyMode := cmSrcCopy;
|
||
FPenPos := Point(0, 0);
|
||
FLockCount := 0;
|
||
InitializeCriticalSection(FLock);
|
||
With FTextStyle do begin
|
||
Alignment := taLeftJustify;
|
||
Layout := tlTop;
|
||
WordBreak := True;
|
||
SingleLine := False;
|
||
Clipping := True;
|
||
ShowPrefix := True;
|
||
Opaque := False;
|
||
end;
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TCanvas.Chord
|
||
Params: x,y,width,height,angle1,angle2
|
||
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(x,y,width,height,angle1,angle2 : Integer);
|
||
begin
|
||
Changing;
|
||
RequiredState([csHandleValid, csBrushValid, csPenValid]);
|
||
LCLIntf.AngleChord(FHandle,x,y,width,height,angle1,angle2);
|
||
Changed;
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TCanvas.Chord
|
||
Params: x,y,width,height,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(x,y,width,height,sx,sy,ex,ey : Integer);
|
||
begin
|
||
Changing;
|
||
RequiredState([csHandleValid, csBrushValid, csPenValid]);
|
||
LCLIntf.RadialChord(FHandle,x,y,width,height,sx,sy,ex,ey);
|
||
Changed;
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TCanvas.Destroy
|
||
Params: None
|
||
Returns: Nothing
|
||
|
||
Destructor for the class.
|
||
------------------------------------------------------------------------------}
|
||
destructor TCanvas.Destroy;
|
||
begin
|
||
//writeln('[TCanvas.Destroy] ',ClassName,' Self=',HexStr(Cardinal(Pointer(Self)),8));
|
||
Handle := 0;
|
||
FreeThenNil(FFont);
|
||
FreeThenNil(FPen);
|
||
FreeThenNil(FBrush);
|
||
FreeThenNil(FRegion);
|
||
if FLock <> 0 then
|
||
DeleteCriticalSection(FLock);
|
||
inherited Destroy;
|
||
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
|
||
//writeln('[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
|
||
//writeln('[TCanvas.SetHandle] Old=',HexStr(FHandle,8),' New=',HexStr(NewHandle,8));
|
||
if FHandle <> 0 then
|
||
begin
|
||
DeselectHandles;
|
||
FPenPos := GetPenPos;
|
||
FHandle := 0;
|
||
Exclude(FState, csHandleValid);
|
||
end;
|
||
if NewHandle <> 0 then
|
||
begin
|
||
Include(FState, csHandleValid);
|
||
FHandle := NewHandle;
|
||
SetPenPos(FPenPos);
|
||
end;
|
||
//writeln('[TCanvas.SetHandle] END Handle=',HexStr(FHandle,8));
|
||
end;
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Method: TCanvas.DeselectHandles
|
||
Params: none
|
||
Returns: nothing
|
||
|
||
Deselect all subhandles in the current device context
|
||
------------------------------------------------------------------------------}
|
||
procedure TCanvas.DeselectHandles;
|
||
begin
|
||
if (FHandle<>0)
|
||
and (FState * [csPenValid, csBrushValid, csFontValid] <> []) 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;
|
||
|
||
{------------------------------------------------------------------------------
|
||
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;
|
||
//writeln('[TCanvas.RequiredState] ',ClassName,' ',csHandleValid in ReqState,' ',csHandleValid in FState,' Needed=',Needed<>[]);
|
||
if Needed <> [] then
|
||
begin
|
||
//writeln('[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;
|
||
Changing;
|
||
RequiredState([csHandleValid, csFontValid]);
|
||
GetTextExtentPoint(FHandle, PChar(Text), Length(Text), Result);
|
||
Changed;
|
||
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
|
||
EnterCriticalSection(FLock);
|
||
Inc(FLockCount);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TCanvas.Unlock
|
||
Params: none
|
||
Returns: nothing
|
||
------------------------------------------------------------------------------}
|
||
procedure TCanvas.Unlock;
|
||
begin
|
||
LeaveCriticalSection(FLock);
|
||
Dec(FLockCount);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
procedure TCanvas.Refresh;
|
||
------------------------------------------------------------------------------}
|
||
procedure TCanvas.Refresh;
|
||
begin
|
||
DeselectHandles;
|
||
end;
|
||
|
||
{ =============================================================================
|
||
|
||
$Log$
|
||
Revision 1.61 2004/01/05 01:18:15 mattias
|
||
implemented Double Buffering for synedit and deactivated multi buffering in TGTKObject.ExtTextOut
|
||
|
||
Revision 1.60 2004/01/03 23:14:59 mattias
|
||
default font can now change height and fixed gtk crash
|
||
|
||
Revision 1.59 2003/12/30 22:24:47 micha
|
||
fix number of points in polygon (form vincent)
|
||
|
||
Revision 1.58 2003/12/26 10:16:54 mattias
|
||
changed TColorRef from longword to longint
|
||
|
||
Revision 1.57 2003/12/23 11:16:41 mattias
|
||
started key combinations, fixed some range check errors
|
||
|
||
Revision 1.56 2003/12/02 12:25:17 micha
|
||
try: gdi memory leak fix for pen
|
||
|
||
Revision 1.55 2003/11/22 17:22:15 mattias
|
||
moved TBevelCut to controls.pp
|
||
|
||
Revision 1.54 2003/11/03 16:57:47 peter
|
||
* change $ifdef ver1_1 to $ifndef ver1_0 so it works also with
|
||
fpc 1.9.x
|
||
|
||
Revision 1.53 2003/09/18 09:21:03 mattias
|
||
renamed LCLLinux to LCLIntf
|
||
|
||
Revision 1.52 2003/08/27 08:14:37 mattias
|
||
fixed system fonts for win32 intf
|
||
|
||
Revision 1.51 2003/08/18 19:24:18 mattias
|
||
fixed TCanvas.Pie
|
||
|
||
Revision 1.50 2003/07/04 08:54:53 mattias
|
||
implemented 16bit rawimages for gtk
|
||
|
||
Revision 1.49 2003/06/30 10:09:46 mattias
|
||
fixed Get/SetPixel for DC without widget
|
||
|
||
Revision 1.48 2003/06/25 10:38:28 mattias
|
||
implemented saving original stream of TBitmap
|
||
|
||
Revision 1.47 2002/08/18 16:50:09 mattias
|
||
fixes for debugging
|
||
|
||
Revision 1.46 2002/08/18 04:57:01 mattias
|
||
fixed csDashDot
|
||
|
||
Revision 1.45 2003/06/13 21:08:53 mattias
|
||
moved TColorButton to dialogs.pp
|
||
|
||
Revision 1.44 2003/06/13 10:37:20 mattias
|
||
fixed AV on StretchDraw 0x0
|
||
|
||
Revision 1.43 2003/04/02 13:23:23 mattias
|
||
fixed default font
|
||
|
||
Revision 1.42 2003/03/12 14:39:29 mattias
|
||
fixed clipping origin in stretchblt
|
||
|
||
Revision 1.41 2003/03/11 07:46:43 mattias
|
||
more localization for gtk- and win32-interface and lcl
|
||
|
||
Revision 1.40 2003/02/26 12:44:52 mattias
|
||
readonly flag is now only saved if user set
|
||
|
||
Revision 1.39 2003/02/06 06:39:02 mattias
|
||
implemented TCanvas.Refresh
|
||
|
||
Revision 1.38 2003/01/28 17:04:34 mattias
|
||
renamed one Rect
|
||
|
||
Revision 1.37 2003/01/27 13:49:16 mattias
|
||
reduced speedbutton invalidates, added TCanvas.Frame
|
||
|
||
Revision 1.36 2002/12/01 22:00:34 mattias
|
||
fixed DeleteCriticalSection
|
||
|
||
Revision 1.35 2002/11/29 15:14:47 mattias
|
||
replaced many invalidates by invalidaterect
|
||
|
||
Revision 1.34 2002/10/31 17:31:10 lazarus
|
||
MG: fixed return polygon point
|
||
|
||
Revision 1.33 2002/10/27 11:51:35 lazarus
|
||
MG: fixed memleaks
|
||
|
||
Revision 1.32 2002/10/25 10:42:08 lazarus
|
||
MG: broke minor circles
|
||
|
||
Revision 1.31 2002/10/14 14:29:50 lazarus
|
||
AJ: Improvements to TUpDown; Added TStaticText & GNOME DrawText
|
||
|
||
Revision 1.30 2002/10/04 14:24:14 lazarus
|
||
MG: added DrawItem to TComboBox/TListBox
|
||
|
||
Revision 1.29 2002/09/27 20:52:22 lazarus
|
||
MWE: Applied patch from "Andrew Johnson" <aj_genius@hotmail.com>
|
||
|
||
Here is the run down of what it includes -
|
||
|
||
-Vasily Volchenko's Updated Russian Localizations
|
||
|
||
-improvements to GTK Styles/SysColors
|
||
-initial GTK Palette code - (untested, and for now useless)
|
||
|
||
-Hint Windows and Modal dialogs now try to stay transient to
|
||
the main program form, aka they stay on top of the main form
|
||
and usually minimize/maximize with it.
|
||
|
||
-fixes to Form BorderStyle code(tool windows needed a border)
|
||
|
||
-fixes DrawFrameControl DFCS_BUTTONPUSH to match Win32 better
|
||
when flat
|
||
|
||
-fixes DrawFrameControl DFCS_BUTTONCHECK to match Win32 better
|
||
and to match GTK theme better. It works most of the time now,
|
||
but some themes, noteably Default, don't work.
|
||
|
||
-fixes bug in Bitmap code which broke compiling in NoGDKPixbuf
|
||
mode.
|
||
|
||
-misc other cleanups/ fixes in gtk interface
|
||
|
||
-speedbutton's should now draw correctly when flat in Win32
|
||
|
||
-I have included an experimental new CheckBox(disabled by
|
||
default) which has initial support for cbGrayed(Tri-State),
|
||
and WordWrap, and misc other improvements. It is not done, it
|
||
is mostly a quick hack to test DrawFrameControl
|
||
DFCS_BUTTONCHECK, however it offers many improvements which
|
||
can be seen in cbsCheck/cbsCrissCross (aka non-themed) state.
|
||
|
||
-fixes Message Dialogs to more accurately determine
|
||
button Spacing/Size, and Label Spacing/Size based on current
|
||
System font.
|
||
-fixes MessageDlgPos, & ShowMessagePos in Dialogs
|
||
-adds InputQuery & InputBox to Dialogs
|
||
|
||
-re-arranges & somewhat re-designs Control Tabbing, it now
|
||
partially works - wrapping around doesn't work, and
|
||
subcontrols(Panels & Children, etc) don't work. TabOrder now
|
||
works to an extent. I am not sure what is wrong with my code,
|
||
based on my other tests at least wrapping and TabOrder SHOULD
|
||
work properly, but.. Anyone want to try and fix?
|
||
|
||
-SynEdit(Code Editor) now changes mouse cursor to match
|
||
position(aka over scrollbar/gutter vs over text edit)
|
||
|
||
-adds a TRegion property to Graphics.pp, and Canvas. Once I
|
||
figure out how to handle complex regions(aka polygons) data
|
||
properly I will add Region functions to the canvas itself
|
||
(SetClipRect, intersectClipRect etc.)
|
||
|
||
-BitBtn now has a Stored flag on Glyph so it doesn't store to
|
||
lfm/lrs if Glyph is Empty, or if Glyph is not bkCustom(aka
|
||
bkOk, bkCancel, etc.) This should fix most crashes with older
|
||
GDKPixbuf libs.
|
||
|
||
Revision 1.28 2002/09/19 19:56:14 lazarus
|
||
MG: accelerated designer drawings
|
||
|
||
Revision 1.27 2002/09/18 17:07:24 lazarus
|
||
MG: added patch from Andrew
|
||
|
||
Revision 1.26 2002/09/12 15:35:57 lazarus
|
||
MG: small bugfixes
|
||
|
||
Revision 1.25 2002/09/03 08:07:19 lazarus
|
||
MG: image support, TScrollBox, and many other things from Andrew
|
||
|
||
Revision 1.24 2002/08/30 13:43:37 lazarus
|
||
MG: fixed drawing of non visual components in designer
|
||
|
||
Revision 1.23 2002/08/19 20:34:47 lazarus
|
||
MG: improved Clipping, TextOut, Polygon functions
|
||
|
||
Revision 1.22 2002/08/15 15:46:48 lazarus
|
||
MG: added changes from Andrew (Clipping)
|
||
|
||
Revision 1.21 2002/08/13 07:08:24 lazarus
|
||
MG: added gdkpixbuf.pp and changes from Andrew Johnson
|
||
|
||
Revision 1.20 2002/08/08 18:05:46 lazarus
|
||
MG: added graphics extensions from Andrew Johnson
|
||
|
||
Revision 1.19 2002/06/04 15:17:22 lazarus
|
||
MG: improved TFont for XLFD font names
|
||
|
||
Revision 1.18 2002/05/10 06:05:51 lazarus
|
||
MG: changed license to LGPL
|
||
|
||
Revision 1.17 2002/03/14 23:25:51 lazarus
|
||
MG: fixed TBevel.Create and TListView.Destroy
|
||
|
||
Revision 1.16 2002/03/08 16:16:55 lazarus
|
||
MG: fixed parser of end blocks in initialization section added label sections
|
||
|
||
Revision 1.15 2002/02/03 00:24:01 lazarus
|
||
TPanel implemented.
|
||
Basic graphic primitives split into GraphType package, so that we can
|
||
reference it from interface (GTK, Win32) units.
|
||
New Frame3d canvas method that uses native (themed) drawing (GTK only).
|
||
New overloaded Canvas.TextRect method.
|
||
LCLIntf and Graphics was split, so a bunch of files had to be modified.
|
||
|
||
Revision 1.14 2002/01/02 15:24:58 lazarus
|
||
MG: added TCanvas.Polygon and TCanvas.Polyline
|
||
|
||
Revision 1.13 2001/12/28 11:41:51 lazarus
|
||
MG: added TCanvas.Ellipse, TCanvas.Pie
|
||
|
||
Revision 1.12 2001/12/27 16:31:28 lazarus
|
||
MG: implemented TCanvas.Arc
|
||
|
||
Revision 1.11 2001/11/09 19:14:23 lazarus
|
||
HintWindow changes
|
||
Shane
|
||
|
||
Revision 1.10 2001/10/07 07:28:33 lazarus
|
||
MG: fixed setpixel and TCustomForm.OnResize event
|
||
|
||
Revision 1.9 2001/09/30 08:34:49 lazarus
|
||
MG: fixed mem leaks and fixed range check errors
|
||
|
||
Revision 1.8 2001/03/24 18:05:58 lazarus
|
||
MG: canvas size enlarged
|
||
|
||
Revision 1.4 2001/03/19 14:00:50 lazarus
|
||
MG: fixed many unreleased DC and GDIObj bugs
|
||
|
||
Revision 1.3 2001/02/04 18:24:41 lazarus
|
||
Code cleanup
|
||
Shane
|
||
|
||
Revision 1.2 2000/08/10 18:56:24 lazarus
|
||
Added some winapi calls.
|
||
Most don't have code yet.
|
||
SetTextCharacterExtra
|
||
CharLowerBuff
|
||
IsCharAlphaNumeric
|
||
Shane
|
||
|
||
Revision 1.1 2000/07/13 10:28:24 michael
|
||
+ Initial import
|
||
|
||
Revision 1.6 2000/07/09 20:18:56 lazarus
|
||
MWE:
|
||
+ added new controlselection
|
||
+ some fixes
|
||
~ some cleanup
|
||
|
||
Revision 1.5 2000/05/10 22:52:57 lazarus
|
||
MWE:
|
||
= Moved some global api stuf to gtkobject
|
||
|
||
Revision 1.4 2000/05/09 02:07:40 lazarus
|
||
Replaced writelns with Asserts. CAW
|
||
|
||
Revision 1.3 2000/05/08 15:56:58 lazarus
|
||
MWE:
|
||
+ Added support for mwedit92 in Makefiles
|
||
* Fixed bug # and #5 (Fillrect)
|
||
* Fixed labelsize in ApiWizz
|
||
+ Added a call to the resize event in WMWindowPosChanged
|
||
|
||
Revision 1.2 2000/05/08 12:54:19 lazarus
|
||
Removed some writeln's
|
||
Added alignment for the TLabel. Isn't working quite right.
|
||
Added the shell code for WindowFromPoint and GetParent.
|
||
Added FindLCLWindow
|
||
Shane
|
||
|
||
Revision 1.1 2000/04/02 20:49:55 lazarus
|
||
MWE:
|
||
Moved lazarus/lcl/*.inc files to lazarus/lcl/include
|
||
|
||
Revision 1.27 2000/03/30 18:07:53 lazarus
|
||
Added some drag and drop code
|
||
Added code to change the unit name when it's saved as a different name. Not perfect yet because if you are in a comment it fails.
|
||
|
||
Shane
|
||
|
||
Revision 1.26 2000/03/21 18:53:28 lazarus
|
||
Added code for TBitBtn. Not finished but looks like mostly working.
|
||
Shane
|
||
|
||
Revision 1.25 2000/03/06 00:05:05 lazarus
|
||
MWE: Added changes from Peter Dyson <peter@skel.demon.co.uk> for a new
|
||
release of mwEdit (0.92)
|
||
|
||
Revision 1.24 2000/01/26 19:16:24 lazarus
|
||
Implemented TPen.Style properly for GTK. Done SelectObject for pen objects.
|
||
Misc bug fixes.
|
||
Corrected GDK declaration for gdk_gc_set_slashes.
|
||
|
||
Revision 1.23 2000/01/18 21:47:00 lazarus
|
||
Added OffSetRec
|
||
|
||
Revision 1.22 1999/12/21 00:07:06 lazarus
|
||
MWE:
|
||
Some fixes
|
||
Completed a bit of DraWEdge
|
||
|
||
Revision 1.21 1999/12/07 01:19:25 lazarus
|
||
MWE:
|
||
Removed some double events
|
||
Changed location of SetCallBack
|
||
Added call to remove signals
|
||
Restructured somethings
|
||
Started to add default handlers in TWinControl
|
||
Made some parts of TControl and TWinControl more delphi compatible
|
||
... and lots more ...
|
||
|
||
Revision 1.20 1999/12/06 16:56:30 lazarus
|
||
Modifications made to help me debug the error during SETTEXT.
|
||
Shane
|
||
|
||
Revision 1.19 1999/12/02 19:00:59 lazarus
|
||
MWE:
|
||
Added (GDI)Pen
|
||
Changed (GDI)Brush
|
||
Changed (GDI)Font (color)
|
||
Changed Canvas to use/create pen/brush/font
|
||
Hacked mwedit to allow setting the number of chars (till it get a WM/LM_SIZE event)
|
||
The editor shows a line !
|
||
|
||
|
||
}
|