Minipaint - Kreis von Mittelpunkt aufziehen

[jamma-markus]

Delphi-Quellcode:

  private
    { Private-Deklarationen }
    mausgedrueckt : boolean;
    x_start, y_start, x_alt, y_alt,
      radius, radius_alt,
      breite, hoehe, breite_alt, hoehe_alt,
      quadrat_x, quadrat_y,
      max, laenge_alt : integer;
    bg_color, fg_color, fill_color : TColor;
    deckend : TBrushStyle;
    function vorzeichen(a : integer): integer;

function TMain.vorzeichen(a : integer): integer;
begin
  if a < 0
  then Result := -1
  else Result := +1;
end;

procedure TMain.im_pictureMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  mausgedrueckt := true;
  with im_picture.Canvas do
    begin
      case Main.Tag of
        8 : begin
              x_start := x;
              y_start := y;
              x_alt := x;
              y_alt := y;

              breite := x - X_start;
              hoehe := y - y_start;

              if breite > hoehe
              then
                begin
                  quadrat_x := x_start + breite;
                  quadrat_y := y_start + breite * vorzeichen(hoehe);
                end
              else
                begin
                  quadrat_x := x_start + hoehe * vorzeichen(breite);
                  quadrat_y := y_start + hoehe;
                end;
           end;
      end;
    end;
end;

procedure TMain.im_pictureMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  with im_picture.Canvas do
    begin
      if mausgedrueckt
      then
        case Main.Tag of
          8 : begin
              pen.Color := clSilver;
              Pen.Style := psDot;
              Brush.Style := bsClear;

              Pen.Mode := pmNotXor;

              Rectangle(x_start, y_start, quadrat_x, quadrat_y);

              breite := x - X_start;
              hoehe := y - y_start;

              if breite > hoehe
              then
                begin
                  quadrat_x := x_start + breite;
                  quadrat_y := y_start + breite * vorzeichen(hoehe);
                end
              else
                begin
                  quadrat_x := x_start + hoehe * vorzeichen(breite);
                  quadrat_y := y_start + hoehe;
                end;

              Rectangle(x_start, y_start, quadrat_x, quadrat_y);

              pen.Style := psSolid;
              pen.Color := fg_color;

            end;
        end;
    end;
end;

procedure TMain.im_pictureMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  with im_picture.Canvas do
    begin
      if not bt_hand.Enabled
      then mausgedrueckt := false;
      if mausgedrueckt
      then
        begin
          case Main.Tag of
            8 : begin
                  pen.Mode := pmCopy;
                  pen.Style := psSolid;
                  pen.Color := fg_color;
                  Brush.Color := bg_color;
                  Brush.Style := deckend;

                  breite := x - X_start;
                  hoehe := y - y_start;

                  if breite > hoehe
                  then
                    begin
                      quadrat_x := x_start + breite;
                      quadrat_y := y_start + breite * vorzeichen(hoehe);
                    end
                  else
                    begin
                      quadrat_x := x_start + hoehe * vorzeichen(breite);
                      quadrat_y := y_start + hoehe;
                    end;

                  Rectangle(x_start, y_start, quadrat_x, quadrat_y);

                end;
          end;
        end;
    end;
  mausgedrueckt := false;
end;