[lazarus] TCanvas.Ellipse
Tony Maro
tonym at nlisc.com
Tue Oct 8 17:11:11 EDT 2002
I don't know how to do patches, so here's an updated Ellipse routine for
GTK that properly draws the ellipse in all of my tests. This goes in
gtkwinapi.inc
function TgtkObject.Ellipse(DC: HDC;
x1,y1,x2,y2: Integer): Boolean;
var
x,y,width,height: integer;
DCOrigin: TPoint;
begin
Result := IsValidDC(DC);
if Result
then with TDeviceContext(DC) do
begin
if GC = nil
then begin
WriteLn('WARNING: [TgtkObject.Ellipse] Uninitialized GC');
Result := False;
end
else begin
x := x1; // added by Tony
y := y1; // added by Tony
//x:=(x1+x2) shr 1; // removed by Tony
//y:=(y1+y2) shr 1; // removed by Tony
width:=(x2-x1) shl 1;
if width<0 then width:=-width;
width:=width shr 1; // Changed by Tony
height:=(y2-y1) shl 1; // changed by Tony
if height<0 then height:=-height;
height:=height shr 1;
// first draw interior in brush color
SelectGDKBrushProps(DC);
DCOrigin:=GetDCOffset(TDeviceContext(DC));
gdk_draw_arc(Drawable, GC, 1, x+DCOrigin.X, y+DCOrigin.Y, Width,
Height,
0, 360 shl 6);
// Draw outline
SelectGDKPenProps(DC);
If not IsValidGDIObject(hPen(CurrentPen)) then
exit;//cowardly refuse to continue
If CurrentPen^.IsNullPen then begin
Result := True;//not an error
Exit;//Skip out.
end;
gdk_draw_arc(Drawable, GC, 0, x+DCOrigin.X, y+DCOrigin.Y, Width,
Height,
0, 360 shl 6);
Result := True;
end;
end;
end;
More information about the Lazarus
mailing list