summaryrefslogtreecommitdiff
path: root/src/corelib
diff options
context:
space:
mode:
Diffstat (limited to 'src/corelib')
-rw-r--r--src/corelib/fpgfx.pas125
-rw-r--r--src/corelib/gdi/gfx_gdi.pas65
-rw-r--r--src/corelib/gfxbase.pas62
-rw-r--r--src/corelib/x11/gfx_x11.pas122
4 files changed, 221 insertions, 153 deletions
diff --git a/src/corelib/fpgfx.pas b/src/corelib/fpgfx.pas
index 8ffcc02e..826a45f3 100644
--- a/src/corelib/fpgfx.pas
+++ b/src/corelib/fpgfx.pas
@@ -153,7 +153,7 @@ type
MenuDisabledFont: TfpgFont;
public
constructor Create; virtual;
- procedure DrawButtonFace(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; AFlags: TFButtonFlags); virtual;
+ procedure DrawButtonFace(ACanvas: TfpgCanvas; x1, y1, x2, y2: TfpgCoord; AFlags: TFButtonFlags); virtual;
procedure DrawControlFrame(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord); virtual;
procedure DrawDirectionArrow(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; direction: integer); virtual;
procedure DrawString(ACanvas: TfpgCanvas; x, y: TfpgCoord; AText: string; AEnabled: boolean = True); virtual;
@@ -260,6 +260,11 @@ procedure fpgInitTimers;
procedure fpgCheckTimers;
function fpgClosestTimer(ctime: TDateTime; amaxtime: integer): integer;
+// Rectangle routines
+function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
+function OffsetRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
+function CenterPoint(const Rect: TRect): TPoint;
+
implementation
@@ -341,6 +346,51 @@ begin
Result := -1;
end;
+function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
+begin
+ if Assigned(@Rect) then
+ begin
+ with Rect do
+ begin
+ dec(Left, dx);
+ dec(Top, dy);
+ inc(Right, dx);
+ inc(Bottom, dy);
+ end;
+ Result := True;
+ end
+ else
+ Result := False;
+end;
+
+function OffsetRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
+begin
+ if Assigned(@Rect) then
+ begin
+ with Rect do
+ begin
+ inc(Left, dx);
+ inc(Top, dy);
+ inc(Right, dx);
+ inc(Bottom, dy);
+ end;
+ OffsetRect := True;
+ end
+ else
+ OffsetRect := False;
+end;
+
+function CenterPoint(const Rect: TRect): TPoint;
+begin
+ with Rect do
+ begin
+ Result.X := (Left+Right) div 2;
+ Result.Y := (Top+Bottom) div 2;
+ end;
+end;
+
+{ TfpgTimer }
+
procedure TfpgTimer.SetEnabled(const AValue: boolean);
begin
if not FEnabled and AValue then
@@ -655,7 +705,7 @@ end;
procedure TfpgCanvas.DrawButtonFace(x, y, w, h: TfpgCoord; AFlags: TFButtonFlags);
begin
- fpgStyle.DrawButtonFace(self, x, y, w, h, AFlags);
+ fpgStyle.DrawButtonFace(self, x, y, x+w-1, y+h-1, AFlags);
end;
procedure TfpgCanvas.DrawControlFrame(x, y, w, h: TfpgCoord);
@@ -765,11 +815,25 @@ begin
MenuDisabledFont := fpgGetFont(fpgGetNamedFontDesc('MenuDisabled'));
end;
-procedure TfpgStyle.DrawButtonFace(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; AFlags: TFButtonFlags);
+procedure TfpgStyle.DrawButtonFace(ACanvas: TfpgCanvas; x1, y1, x2, y2: TfpgCoord; AFlags: TFButtonFlags);
+var
+ r: TRect;
begin
+ if btnIsDefault in AFlags then
+ begin
+ r := Rect(x1, y1, x2, y2);
+ ACanvas.SetColor(clBlack);
+ ACanvas.SetLineStyle(1, lsSolid);
+ ACanvas.DrawRectangle(r);
+ InflateRect(r, -1, -1);
+ Exclude(AFlags, btnIsDefault);
+ fpgStyle.DrawButtonFace(ACanvas, r.Left, r.Top, r.Right, r.Bottom, AFlags);
+ Exit; //==>
+ end;
+
ACanvas.SetColor(clButtonFace);
ACanvas.SetLineStyle(1, lsSolid);
- ACanvas.FillRectangle(x, y, w, h);
+ ACanvas.FillRectangle(x1, y1, x2, y2);
// Left and Top (outer)
if (btnIsPressed in AFlags) then
@@ -781,8 +845,8 @@ begin
end
else
ACanvas.SetColor(clHilite1);
- ACanvas.DrawLine(x, y+h-1, x, y); // left
- ACanvas.DrawLine(x, y, x+w, y); // top
+ ACanvas.DrawLine(x1, y2-1, x1, y1); // left
+ ACanvas.DrawLine(x1, y1, x2-1, y1); // top
// Left and Top (inner)
//if btnIsPressed in AFlags then
@@ -801,14 +865,9 @@ begin
ACanvas.SetColor(clShadow2);
end
else
- begin
- if (btnIsDefault in AFlags) then
- ACanvas.SetColor(clBlack)
- else
- ACanvas.SetColor(clShadow2);
- end;
- ACanvas.DrawLine(x+w-1, y, x+w-1, y+h-1); // right
- ACanvas.DrawLine(x, y+h-1, x+w, y+h-1); // bottom
+ ACanvas.SetColor(clShadow2);
+ ACanvas.DrawLine(x2, y1, x2, y2); // right
+ ACanvas.DrawLine(x2, y2, x1, y2); // bottom
// Right and Bottom (inner)
if btnIsPressed in AFlags then
@@ -819,33 +878,35 @@ begin
ACanvas.SetColor(clHilite1);
end
else
- begin
- if (btnIsDefault in AFlags) then
- ACanvas.SetColor(clShadow2)
- else
- ACanvas.SetColor(clShadow1);
- end;
- ACanvas.DrawLine(x+w-2, y+1, x+w-2, y+h-2); // right
- ACanvas.DrawLine(x+1, y+h-2, x+w-1, y+h-2); // bottom
+ ACanvas.SetColor(clShadow1);
+ ACanvas.DrawLine(x2-1, y1+1, x2-1, y2-1); // right
+ ACanvas.DrawLine(x2-1, y2-1, x1+1, y2-1); // bottom
end;
procedure TfpgStyle.DrawControlFrame(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord);
+var
+ x2: TfpgCoord;
+ y2: TfpgCoord;
begin
+ // outer bottom right coordinates
+ x2 := x+w-1;
+ y2 := y+h-1;
+
ACanvas.SetColor(clShadow1);
- ACanvas.DrawLine(x, y, x + w - 1, y); // top (outer)
- ACanvas.DrawLine(x, y + h - 1, x, y); // left (outer)
+ ACanvas.DrawLine(x, y2, x, y); // left (outer)
+ ACanvas.DrawLine(x, y, x2-1, y); // top (outer)
ACanvas.SetColor(clShadow2);
- ACanvas.DrawLine(x + 1, y + 1, x + w - 2, y + 1); // top (inner)
- ACanvas.DrawLine(x + 1, y + h - 2, x + 1, y + 1); // left (inner)
-
- ACanvas.SetColor(clHilite2);
- ACanvas.DrawLine(x + 1, y + h - 1, x + w, y + h - 1); // bottom (outer)
- ACanvas.DrawLine(x + w - 1, y, x + w - 1, y + h); // right (outer)
+ ACanvas.DrawLine(x+1, y+1, x2-1, y+1); // top (inner)
+ ACanvas.DrawLine(x+1, y2-1, x+1, y+1); // left (inner)
ACanvas.SetColor(clHilite1);
- ACanvas.DrawLine(x + 2, y + h - 2, x + w - 2, y + h - 2); // bottom (inner)
- ACanvas.DrawLine(x + w - 2, y + 1, x + w - 2, y + h - 1); // right (inner)
+ ACanvas.DrawLine(x+2, y2-1, x2-1, y2-1); // bottom (inner)
+ ACanvas.DrawLine(x2-1, y+1, x2-1, y2-1); // right (inner)
+
+ ACanvas.SetColor(clHilite2);
+ ACanvas.DrawLine(x+1, y2, x2, y2); // bottom (outer)
+ ACanvas.DrawLine(x2, y, x2, y2); // right (outer)
end;
procedure TfpgStyle.DrawDirectionArrow(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; direction: integer);
diff --git a/src/corelib/gdi/gfx_gdi.pas b/src/corelib/gdi/gfx_gdi.pas
index c4eaa161..aad8429e 100644
--- a/src/corelib/gdi/gfx_gdi.pas
+++ b/src/corelib/gdi/gfx_gdi.pas
@@ -78,7 +78,7 @@ type
FWinGC: TfpgGContext;
FBackgroundColor: TfpgColor;
FCurFontRes: TfpgFontResourceImpl;
- FClipRect: TfpgRect;
+ FClipRect: TRect;
FClipRectSet: Boolean;
FWindowsColor: longword;
FBrush: HBRUSH;
@@ -91,16 +91,16 @@ type
procedure DoSetColor(cl: TfpgColor); override;
procedure DoSetLineStyle(awidth: integer; astyle: TfpgLineStyle); override;
procedure DoGetWinRect(var r: TfpgRect); override;
- procedure DoFillRectangle(x, y, w, h: TfpgCoord); override;
+ procedure DoFillRectangle(x1, y1, x2, y2: TfpgCoord); override;
procedure DoXORFillRectangle(col: TfpgColor; x, y, w, h: TfpgCoord); override;
procedure DoFillTriangle(x1, y1, x2, y2, x3, y3: TfpgCoord); override;
- procedure DoDrawRectangle(x, y, w, h: TfpgCoord); override;
+ procedure DoDrawRectangle(x1, y1, x2, y2: TfpgCoord); override;
procedure DoDrawLine(x1, y1, x2, y2: TfpgCoord); override;
procedure DoDrawImagePart(x, y: TfpgCoord; img: TfpgImageBase; xi, yi, w, h: integer); override;
procedure DoDrawString(x, y: TfpgCoord; const txt: string); override;
- procedure DoSetClipRect(const rect: TfpgRect); override;
- function DoGetClipRect: TfpgRect; override;
- procedure DoAddClipRect(const rect: TfpgRect); override;
+ procedure DoSetClipRect(const ARect: TRect); override;
+ function DoGetClipRect: TRect; override;
+ procedure DoAddClipRect(const ARect: TRect); override;
procedure DoClearClipRect; override;
procedure DoBeginDraw(awin: TfpgWindowBase; buffered: boolean); override;
procedure DoPutBufferToScreen(x, y, w, h: TfpgCoord); override;
@@ -1111,7 +1111,7 @@ begin
Fgc := FWinGC;
end;
- SetTextAlign(Fgc, TA_TOP); //TA_BASELINE);
+ SetTextAlign(Fgc, TA_TOP);
SetBkMode(Fgc, TRANSPARENT);
FBrush := CreateSolidBrush(0);
@@ -1120,7 +1120,7 @@ begin
FColor := fpgColorToWin(clText1);
FLineStyle := lsSolid;
- FLineWidth := 0;
+ FLineWidth := 1;
FBackgroundColor := fpgColorToWin(clBoxColor);
end;
@@ -1190,12 +1190,12 @@ begin
BitBlt(FWinGC, x, y, w, h, Fgc, x, y, SRCCOPY);
end;
-procedure TfpgCanvasImpl.DoAddClipRect(const rect: TfpgRect);
+procedure TfpgCanvasImpl.DoAddClipRect(const ARect: TRect);
var
rg: HRGN;
begin
- rg := CreateRectRgn(rect.left, rect.top, rect.left + rect.Width, rect.top + rect.Height);
- FClipRect := Rect;
+ rg := CreateRectRgn(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
+ FClipRect := ARect;
FClipRectSet := True;
CombineRgn(FClipRegion, rg, FClipRegion, RGN_AND);
SelectClipRgn(Fgc, FClipRegion);
@@ -1209,18 +1209,26 @@ begin
end;
procedure TfpgCanvasImpl.DoDrawLine(x1, y1, x2, y2: TfpgCoord);
+var
+ pts: array[1..2] of TPoint;
begin
- Windows.MoveToEx(Fgc, x1, y1, nil);
- Windows.LineTo(Fgc, x2, y2);
+ pts[1].X := x1;
+ pts[1].Y := y1;
+ pts[2].X := x2;
+ pts[2].Y := y2;
+ Windows.Polygon(Fgc, pts, 2);
end;
-procedure TfpgCanvasImpl.DoDrawRectangle(x, y, w, h: TfpgCoord);
+procedure TfpgCanvasImpl.DoDrawRectangle(x1, y1, x2, y2: TfpgCoord);
+var
+ pts: array[1..5] of TPoint;
begin
- Windows.MoveToEx(Fgc, x, y, nil);
- Windows.LineTo(Fgc, x+w-1, y);
- Windows.LineTo(Fgc, x+w-1, y+h-1);
- Windows.LineTo(Fgc, x, y+h-1);
- Windows.LineTo(Fgc, x, y);
+ pts[1].X := x1; pts[1].Y := y1;
+ pts[2].X := x2; pts[2].Y := y1;
+ pts[3].X := x2; pts[3].Y := y2;
+ pts[4].X := x1; pts[4].Y := y2;
+ pts[5].X := x1; pts[5].Y := y1;
+ Windows.Polyline(Fgc, pts, 5);
end;
procedure TfpgCanvasImpl.DoDrawString(x, y: TfpgCoord; const txt: string);
@@ -1238,15 +1246,12 @@ begin
{$endif}
end;
-procedure TfpgCanvasImpl.DoFillRectangle(x, y, w, h: TfpgCoord);
+procedure TfpgCanvasImpl.DoFillRectangle(x1, y1, x2, y2: TfpgCoord);
var
- wr: Windows.TRect;
+ r: TRect;
begin
- wr.Left := x;
- wr.Top := y;
- wr.Right := x + w;
- wr.Bottom := y + h;
- Windows.FillRect(Fgc, wr, FBrush);
+ r := Rect(x1, y1, x2, y2);
+ Windows.FillRect(Fgc, r, FBrush);
end;
procedure TfpgCanvasImpl.DoFillTriangle(x1, y1, x2, y2, x3, y3: TfpgCoord);
@@ -1262,7 +1267,7 @@ begin
Windows.Polygon(Fgc, pts, 3);
end;
-function TfpgCanvasImpl.DoGetClipRect: TfpgRect;
+function TfpgCanvasImpl.DoGetClipRect: TRect;
begin
Result := FClipRect;
end;
@@ -1278,12 +1283,12 @@ begin
r.Height := wr.Bottom - wr.Top + 1;
end;
-procedure TfpgCanvasImpl.DoSetClipRect(const rect: TfpgRect);
+procedure TfpgCanvasImpl.DoSetClipRect(const ARect: TRect);
begin
FClipRectSet := True;
- FClipRect := rect;
+ FClipRect := ARect;
DeleteObject(FClipRegion);
- FClipRegion := CreateRectRgn(rect.left, rect.top, rect.left + rect.Width, rect.top + rect.Height);
+ FClipRegion := CreateRectRgn(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
SelectClipRgn(Fgc, FClipRegion);
end;
diff --git a/src/corelib/gfxbase.pas b/src/corelib/gfxbase.pas
index 28149f8f..684391f5 100644
--- a/src/corelib/gfxbase.pas
+++ b/src/corelib/gfxbase.pas
@@ -107,7 +107,7 @@ type
PfpgMessageRec = ^TfpgMessageRec;
- TfpgLineStyle = (lsSolid, lsDash, lsDot);
+ TfpgLineStyle = (lsSolid, lsDash, lsDot, lsDashDot, lsDashDotDot);
// forward declaration
@@ -232,17 +232,17 @@ type
procedure DoSetTextColor(cl: TfpgColor); virtual; abstract;
procedure DoSetColor(cl: TfpgColor); virtual; abstract;
procedure DoSetLineStyle(awidth: integer; astyle: TfpgLineStyle); virtual; abstract;
- procedure DoGetWinRect(var r: TfpgRect); virtual; abstract;
- procedure DoFillRectangle(x, y, w, h: TfpgCoord); virtual; abstract;
+ procedure DoGetWinRect(out r: TRect); virtual; abstract;
+ procedure DoFillRectangle(x1, y1, x2, y2: TfpgCoord); virtual; abstract;
procedure DoXORFillRectangle(col: TfpgColor; x, y, w, h: TfpgCoord); virtual; abstract;
procedure DoFillTriangle(x1, y1, x2, y2, x3, y3: TfpgCoord); virtual; abstract;
- procedure DoDrawRectangle(x, y, w, h: TfpgCoord); virtual; abstract;
+ procedure DoDrawRectangle(x1, y1, x2, y2: TfpgCoord); virtual; abstract;
procedure DoDrawLine(x1, y1, x2, y2: TfpgCoord); virtual; abstract;
procedure DoDrawImagePart(x, y: TfpgCoord; img: TfpgImageBase; xi, yi, w, h: integer); virtual; abstract;
procedure DoDrawString(x, y: TfpgCoord; const txt: string); virtual; abstract;
- procedure DoSetClipRect(const rect: TfpgRect); virtual; abstract;
- function DoGetClipRect: TfpgRect; virtual; abstract;
- procedure DoAddClipRect(const rect: TfpgRect); virtual; abstract;
+ procedure DoSetClipRect(const ARect: TRect); virtual; abstract;
+ function DoGetClipRect: TRect; virtual; abstract;
+ procedure DoAddClipRect(const ARect: TRect); virtual; abstract;
procedure DoClearClipRect; virtual; abstract;
procedure DoBeginDraw(awin: TfpgWindowBase; buffered: boolean); virtual; abstract;
procedure DoPutBufferToScreen(x, y, w, h: TfpgCoord); virtual; abstract;
@@ -254,8 +254,8 @@ type
public
constructor Create; virtual;
destructor Destroy; override;
- procedure DrawRectangle(x, y, w, h: TfpgCoord); overload;
- procedure DrawRectangle(r: TfpgRect); overload;
+ procedure DrawRectangle(x1, y1, x2, y2: TfpgCoord); overload;
+ procedure DrawRectangle(r: TRect); overload;
procedure DrawLine(x1, y1, x2, y2: TfpgCoord);
procedure DrawImage(x, y: TfpgCoord; img: TfpgImageBase);
procedure DrawImagePart(x, y: TfpgCoord; img: TfpgImageBase; xi, yi, w, h: integer);
@@ -263,18 +263,18 @@ type
procedure StretchDraw (x, y, w, h: TfpgCoord; ASource: TfpgImageBase);
procedure CopyRect(x, y: TfpgCoord; ACanvas: TfpgCanvasBase; var SourceRect: TRect);
procedure DrawString(x, y: TfpgCoord; const txt: string);
- procedure FillRectangle(x, y, w, h: TfpgCoord); overload;
- procedure FillRectangle(r: TfpgRect); overload;
+ procedure FillRectangle(x1, y1, x2, y2: TfpgCoord); overload;
+ procedure FillRectangle(r: TRect); overload;
procedure FillTriangle(x1, y1, x2, y2, x3, y3: TfpgCoord);
procedure FillArc(x, y, w, h: TfpgCoord; a1, a2: double);
procedure XORFillRectangle(col: TfpgColor; x, y, w, h: TfpgCoord); overload;
procedure XORFillRectangle(col: TfpgColor; r: TfpgRect); overload;
- procedure SetClipRect(const rect: TfpgRect);
- function GetClipRect: TfpgRect;
- procedure AddClipRect(const rect: TfpgRect);
+ procedure SetClipRect(const ARect: TRect);
+ function GetClipRect: TRect;
+ procedure AddClipRect(const ARect: TRect);
procedure ClearClipRect;
procedure Clear(AColor: TfpgColor);
- procedure GetWinRect(var r: TfpgRect);
+ procedure GetWinRect(out r: TRect);
procedure SetColor(AColor: TfpgColor);
procedure SetTextColor(AColor: TfpgColor);
procedure SetLineStyle(AWidth: integer; AStyle: TfpgLineStyle);
@@ -726,14 +726,14 @@ begin
inherited Destroy;
end;
-procedure TfpgCanvasBase.DrawRectangle(x, y, w, h: TfpgCoord);
+procedure TfpgCanvasBase.DrawRectangle(x1, y1, x2, y2: TfpgCoord);
begin
- DoDrawRectangle(x, y, w, h);
+ DoDrawRectangle(x1, y1, x2, y2);
end;
-procedure TfpgCanvasBase.DrawRectangle(r: TfpgRect);
+procedure TfpgCanvasBase.DrawRectangle(r: TRect);
begin
- DoDrawRectangle(r.Left, r.Top, r.Width, r.Height);
+ DoDrawRectangle(r.Left, r.Top, r.Right, r.Bottom);
end;
procedure TfpgCanvasBase.DrawLine(x1, y1, x2, y2: TfpgCoord);
@@ -818,14 +818,14 @@ begin
end;
end;
-procedure TfpgCanvasBase.FillRectangle(x, y, w, h: TfpgCoord);
+procedure TfpgCanvasBase.FillRectangle(x1, y1, x2, y2: TfpgCoord);
begin
- DoFillRectangle(x, y, w, h);
+ DoFillRectangle(x1, y1, x2, y2);
end;
-procedure TfpgCanvasBase.FillRectangle(r: TfpgRect);
+procedure TfpgCanvasBase.FillRectangle(r: TRect);
begin
- DoFillRectangle(r.Left, r.Top, r.Width, r.Height);
+ DoFillRectangle(r.Left, r.Top, r.Right, r.Bottom);
end;
procedure TfpgCanvasBase.FillTriangle(x1, y1, x2, y2, x3, y3: TfpgCoord);
@@ -848,19 +848,19 @@ begin
DoXORFillRectangle(col, r.Left, r.Top, r.Width, r.Height);
end;
-procedure TfpgCanvasBase.SetClipRect(const rect: TfpgRect);
+procedure TfpgCanvasBase.SetClipRect(const ARect: TRect);
begin
- DoSetClipRect(rect);
+ DoSetClipRect(ARect);
end;
-function TfpgCanvasBase.GetClipRect: TfpgRect;
+function TfpgCanvasBase.GetClipRect: TRect;
begin
Result := DoGetClipRect;
end;
-procedure TfpgCanvasBase.AddClipRect(const rect: TfpgRect);
+procedure TfpgCanvasBase.AddClipRect(const ARect: TRect);
begin
- DoAddClipRect(rect);
+ DoAddClipRect(ARect);
end;
procedure TfpgCanvasBase.ClearClipRect;
@@ -871,16 +871,16 @@ end;
procedure TfpgCanvasBase.Clear(AColor: TfpgColor);
var
lCol: TfpgColor;
- lWinRect: TfpgRect;
+ lWinRect: TRect;
begin
lCol := FColor;
DoSetColor(AColor);
DoGetWinRect(lWinRect);
- DoFillRectangle(0, 0, lWinRect.Width, lWinRect.Height);
+ DoFillRectangle(0, 0, lWinRect.Right, lWinRect.Bottom);
DoSetColor(lCol);
end;
-procedure TfpgCanvasBase.GetWinRect(var r: TfpgRect);
+procedure TfpgCanvasBase.GetWinRect(out r: TRect);
begin
DoGetWinRect(r);
end;
diff --git a/src/corelib/x11/gfx_x11.pas b/src/corelib/x11/gfx_x11.pas
index 35564db6..ce63fdfd 100644
--- a/src/corelib/x11/gfx_x11.pas
+++ b/src/corelib/x11/gfx_x11.pas
@@ -47,7 +47,7 @@ type
TXWindowStateFlags = set of TXWindowStateFlag;
TfpgWindowImpl = class;
-
+
TfpgFontResourceImpl = class(TfpgFontResourceBase)
private
@@ -88,7 +88,7 @@ type
FDrawHandle: TXID;
Fgc: TfpgGContext;
FCurFontRes: TfpgFontResourceImpl;
- FClipRect: TfpgRect;
+ FClipRect: TRect;
FClipRectSet: boolean;
FXftDraw: PXftDraw;
FXftDrawBuffer: PXftDraw;
@@ -99,17 +99,17 @@ type
procedure DoSetTextColor(cl: TfpgColor); override;
procedure DoSetColor(cl: TfpgColor); override;
procedure DoSetLineStyle(awidth: integer; astyle: TfpgLineStyle); override;
- procedure DoGetWinRect(var r: TfpgRect); override;
- procedure DoFillRectangle(x, y, w, h: TfpgCoord); override;
+ procedure DoGetWinRect(out r: TRect); override;
+ procedure DoFillRectangle(x1, y1, x2, y2: TfpgCoord); override;
procedure DoXORFillRectangle(col: TfpgColor; x, y, w, h: TfpgCoord); override;
procedure DoFillTriangle(x1, y1, x2, y2, x3, y3: TfpgCoord); override;
- procedure DoDrawRectangle(x, y, w, h: TfpgCoord); override;
+ procedure DoDrawRectangle(x1, y1, x2, y2: TfpgCoord); override;
procedure DoDrawLine(x1, y1, x2, y2: TfpgCoord); override;
procedure DoDrawImagePart(x, y: TfpgCoord; img: TfpgImageBase; xi, yi, w, h: integer); override;
procedure DoDrawString(x, y: TfpgCoord; const txt: string); override;
- procedure DoSetClipRect(const rect: TfpgRect); override;
- function DoGetClipRect: TfpgRect; override;
- procedure DoAddClipRect(const rect: TfpgRect); override;
+ procedure DoSetClipRect(const ARect: TRect); override;
+ function DoGetClipRect: TRect; override;
+ procedure DoAddClipRect(const ARect: TRect); override;
procedure DoClearClipRect; override;
procedure DoBeginDraw(awin: TfpgWindowBase; buffered: boolean); override;
procedure DoPutBufferToScreen(x, y, w, h: TfpgCoord); override;
@@ -1305,9 +1305,8 @@ var
begin
oldColor := Color;
SetColor(AValue);
- DrawLine(X, Y, X+1, Y+1);
+ XDrawPoint(xapplication.display, FDrawHandle, Fgc, X, Y);
SetColor(oldColor);
- {$Note We must still implement DrawPoint}
end;
procedure TfpgCanvasImpl.DoDrawArc(x, y, w, h: TfpgCoord; a1, a2: Extended);
@@ -1340,42 +1339,41 @@ begin
end;
procedure TfpgCanvasImpl.DoSetLineStyle(awidth: integer; astyle: TfpgLineStyle);
-//const
-// DotDashes: array[0..1] of Char = #1#1;
-// DotDashes: array[0..1] of Char = #4#2;
- { It was #1#1 which gives 1 pixel dots. Now it gives a 4 pixel line and a
- 2 pixel space. }
-var
- ls: integer;
- DotDashes: array[0..6] of Char;
- len: integer;
+const
+ cDot: array[0..1] of Char = #1#1;
+ cDash: array[0..1] of Char = #4#2;
+ cDashDot: array[0..3] of Char = #4#1#1#1;
+ cDashDotDot: array[0..5] of Char = #4#1#1#1#1#1;
begin
- {$Note Extend this and the GDI code some more to support more Line Styles}
- // This design can be improved on. It smells!
- len := 0;
case AStyle of
lsDot:
begin
- ls := LineOnOffDash;
- len := 2;
- DotDashes[0] := Char(#1);
- DotDashes[1] := Char(#1);
+ XSetLineAttributes(xapplication.display, Fgc, 0,
+ LineOnOffDash, CapButt, JoinMiter);
+ XSetDashes(xapplication.display, Fgc, 0, cDot, 2);
end;
lsDash:
begin
- ls := LineOnOffDash;
- len := 2;
- DotDashes[0] := Char(#4);
- DotDashes[1] := Char(#2);
+ XSetLineAttributes(xapplication.display, Fgc, 0,
+ LineOnOffDash, CapButt, JoinMiter);
+ XSetDashes(xapplication.display, Fgc, 0, cDash, 2);
end;
- lsSolid:
- ls := LineSolid;
- else
- ls := LineSolid;
- end;
- XSetLineAttributes(xapplication.display, Fgc, awidth, ls, CapButt, JoinMiter);
- if ls = LineOnOffDash then
- XSetDashes(xapplication.display, Fgc, 0, DotDashes, len);
+ lsDashDot:
+ begin
+ XSetLineAttributes(xapplication.display, Fgc, 0,
+ LineOnOffDash, CapButt, JoinMiter);
+ XSetDashes(xapplication.display, Fgc, 0, cDashDot, 4);
+ end;
+ lsDashDotDot:
+ begin
+ XSetLineAttributes(xapplication.display, Fgc, 0,
+ LineOnOffDash, CapButt, JoinMiter);
+ XSetDashes(xapplication.display, Fgc, 0, cDashDotDot, 6);
+ end;
+ else // which includes lsSolid
+ XSetLineAttributes(xapplication.display, Fgc, 0,
+ LineSolid, CapButt, JoinMiter);
+ end; { case }
end;
procedure TfpgCanvasImpl.DoDrawString(x, y: TfpgCoord; const txt: string);
@@ -1387,28 +1385,32 @@ begin
y + FCurFontRes.GetAscent, PChar(txt), Length(txt));
end;
-procedure TfpgCanvasImpl.DoGetWinRect(var r: TfpgRect);
+procedure TfpgCanvasImpl.DoGetWinRect(out r: TRect);
var
rw: TfpgWinHandle;
x: integer;
y: integer;
bw: longword;
d: longword;
+ w: Cardinal;
+ h: Cardinal;
begin
- r.left := 0;
- r.Top := 0;
XGetGeometry(xapplication.display, FDrawWindow.FWinHandle, @rw, @x, @y,
- @(r.Width), @(r.Height), @bw, @d);
+ @w, @h, @bw, @d);
+ r.Left := 0;
+ r.Top := 0;
+ r.Right := w;
+ r.Bottom := h;
end;
-procedure TfpgCanvasImpl.DoFillRectangle(x, y, w, h: TfpgCoord);
+procedure TfpgCanvasImpl.DoFillRectangle(x1, y1, x2, y2: TfpgCoord);
begin
// Remember this for when we add Canvas.Pen support!
{ Note: By default XFillRectangle doesn't paint the same size rectangle that
XDrawRectangle does - given the same coordinates! In this case we enlarge
the Width and Height to paint consistant rectangle sizes, even thought it
might repaint the same (only a few) pixels twice. }
- XFillRectangle(xapplication.display, FDrawHandle, Fgc, x, y, w{+1}, h{+1});
+ XFillRectangle(xapplication.display, FDrawHandle, Fgc, x1, y1, x2-x1, y2-y1);
end;
procedure TfpgCanvasImpl.DoXORFillRectangle(col: TfpgColor; x, y, w, h: TfpgCoord);
@@ -1434,9 +1436,9 @@ begin
XFillPolygon(xapplication.display, FDrawHandle, Fgc, @pts, 3, 0, 0);
end;
-procedure TfpgCanvasImpl.DoDrawRectangle(x, y, w, h: TfpgCoord);
+procedure TfpgCanvasImpl.DoDrawRectangle(x1, y1, x2, y2: TfpgCoord);
begin
- XDrawRectangle(xapplication.display, FDrawHandle, Fgc, x, y, w-1, h-1);
+ XDrawRectangle(xapplication.display, FDrawHandle, Fgc, x1, y1, x2-x1, y2-y1);
end;
procedure TfpgCanvasImpl.DoDrawLine(x1, y1, x2, y2: TfpgCoord);
@@ -1444,15 +1446,15 @@ begin
XDrawLine(xapplication.display, FDrawHandle, Fgc, x1, y1, x2, y2);
end;
-procedure TfpgCanvasImpl.DoSetClipRect(const rect: TfpgRect);
+procedure TfpgCanvasImpl.DoSetClipRect(const ARect: TRect);
var
r: TXRectangle;
rg: TRegion;
begin
- r.x := rect.left;
- r.y := rect.top;
- r.Width := rect.Width;
- r.Height := rect.Height;
+ r.x := ARect.Left;
+ r.y := ARect.Top;
+ r.Width := ARect.Right - ARect.Left + 1;
+ r.Height := ARect.Bottom - ARect.Top + 1;
rg := XCreateRegion;
@@ -1460,32 +1462,32 @@ begin
XSetRegion(xapplication.display, Fgc, FClipRegion);
XftDrawSetClip(FXftDraw, FClipRegion);
- FClipRect := rect;
+ FClipRect := ARect;
FClipRectSet := True;
XDestroyRegion(rg);
end;
-function TfpgCanvasImpl.DoGetClipRect: TfpgRect;
+function TfpgCanvasImpl.DoGetClipRect: TRect;
begin
Result := FClipRect;
end;
-procedure TfpgCanvasImpl.DoAddClipRect(const rect: TfpgRect);
+procedure TfpgCanvasImpl.DoAddClipRect(const ARect: TRect);
var
r: TXRectangle;
rg: TRegion;
begin
- r.x := rect.left;
- r.y := rect.top;
- r.Width := rect.Width;
- r.Height := rect.Height;
+ r.x := ARect.Left;
+ r.y := ARect.Top;
+ r.Width := ARect.Right - ARect.Left + 1;
+ r.Height := ARect.Bottom - ARect.Top + 1;
rg := XCreateRegion;
XUnionRectWithRegion(@r, rg, rg);
XIntersectRegion(FClipRegion, rg, FClipRegion);
XSetRegion(xapplication.display, Fgc, FClipRegion);
- FClipRect := Rect;
+ FClipRect := ARect; // Double check this, it might be wrong!!
FClipRectSet := True;
XftDrawSetClip(FXftDraw, FClipRegion);
@@ -1494,7 +1496,7 @@ end;
procedure TfpgCanvasImpl.DoClearClipRect;
var
- r: TfpgRect;
+ r: TRect;
begin
DoGetWinRect(r);
DoSetClipRect(r);
generated by cgit v1.2.3-70-g09d2 (git 2.48.0) at 2025-01-16 21:45:51 +0000