[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