paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-28 08:42:55 +02:00
Code Issues Packages Projects Releases Wiki Activity
b6593d0a09
lazarus/lcl/include/canvas.inc

1586 lines
51 KiB
PHP
Raw Blame History

{******************************************************************************
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 !
}
Reference in New Issue View Git Blame Copy Permalink