Minipaint - Kreis von Mittelpunkt aufziehen

[hanselmansel]

HiHo Markus,

du kannst den von mir hier irgendwo im Thread geposteten Ansatz nehmen, und musst nur Canvas.Ellipse durch Canvas.Rectangle und den Pytagoras durch eine >-Abfrage ersetzten.

MfG,

hanselmansel

[jamma-markus]

Aufgabe: Beim Klicken auf eine Image-Komponente sollen die Klickkoordinaten (xa, ya) gespeichert werden. Beim Bewegen der Maus über das Formular sollen nun "Gummilinien" gezeichent werden, für die folgendes gilt: gestrichelt und hellgrau. außerdem gilt:

• wenn die maus links über xa|ya, dann soll das quadrat so gezeichnet werden, dass xa|ya die rechte untere ecke des quadrats ist.
• wenn die maus links unter xa|ya, dann soll das quadrat so gezeichnet werden, dass xa|ya die rechte obere ecke des quadrats ist.
• wenn die maus rechts über xa|ya, dann soll das quadrat so gezeichnet werden, dass xa|ya die linke untere ecke des quadrats ist.
• wenn die maus links unter xa|ya, dann soll das quadrat so gezeichnet werden, dass xa|ya die linke obere ecke des quadrats ist.

beim loslassen der Maus soll nun das Quadrat mit den eigenschafte pssolig, bssolid, pen.color clblack und brush.color clwhite gezeichnet werden.

Ich hoffe jetzt ist das ganze verständlicher

[hanselmansel]

Und wie ist dein bisheriger Lösungsansatz?

[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;

[hanselmansel]

Und was funktioniert innerhalb dieser 134 Zeilen Quellcode nicht?

[jamma-markus]

der zechnet die quadrate alle außer nach unten rechts falsch

[DGL-luke]

canvas.rectangle(OldMouse.X,OldMouse.Y,Mouse.Cursorpos.X,Mouse.Cursorpos.Y); //es sollte absolut egal sein, mehr fällt mir zum "Gummirechteck" nicht ein, ausser dass man in jedem "Frame" das alte Rechteck clearen muss bzw. komplett refreshen.

Zitat:

wenn die maus links unter xa|ya, dann soll das quadrat so gezeichnet werden, dass xa|ya die linke obere ecke des quadrats ist.

Kann ich mir jetzt nur als Tippfehler erklären, im Anhang eine kleine Illustration dazu....

[jamma-markus]

Zitat von DGL-luke:

Zitat:

wenn die maus links unter xa|ya, dann soll das quadrat so gezeichnet werden, dass xa|ya die linke obere ecke des quadrats ist.

Kann ich mir jetzt nur als Tippfehler erklären, im Anhang eine kleine Illustration dazu....

stimmt schon wie es da steht. mit diesen beiden punkten ist ein quadrat festgelegt.

Die folgenden 4ecke stellen jeweils ein quadrat dar: dabei ist x die position an der nie maus geklick wurde und M die Position an der die Maus sich beim MouseMove bzw. MouseUp befindet. die - und | geben einfach nur die linien des quadrates an

Code:

+---x
|   |
M---+

Code:

x---+
|   |
+---M

Code:

+---M
|   |
x---+

Code:

M---+
|   |
+---x

[DGL-luke]

ach so... ein Quadrat.... kein Rechteck?

ok. dann musst du dich entscheiden, ob du es vertikal oder horizontal aufziehst.
Sprich: ob dein Mauszeiger immer auf einer vertikalen oder auf einer horizontalen Seite des Quadrats liegt.

angenommen du machst es so, dass der Mauszeiger immer horizontal draufliegt, dann sollte

Delphi-Quellcode:

s := MousePos.X - OldMouse.X; //S = Seitenlänge
p1 := point(OldMouse.X,OldMouse.Y);
p2 := point(OldMouse.X + s, OldMouse.Y + s);
canvas.Rectangle(rect(p1,p2)); //hoffe, die überladung gibts....

zum Ziel führen. Werde das gleich mal persönlich überprüfen.

EDIT: funktioniert, beispielprojekt im Anhang.
EDIT2: Bedienung: einfach in der form ein rechteck aufziehen
EDIT3: mir fällt gerade auf, dass das doch nciht so funzt wie es sollte.
EDIT4: Neue Version im Anhang, verhält sich richtig, Bedienung wie 2.

[1ceman]

Anfang:

Delphi-Quellcode:

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var SeiteA,SeiteB,Seite1:integer;
    H:TPoint;
    StartPunkt:Boolean;
begin
If StartPunkt=True
then begin

Quadrat:

Delphi-Quellcode:

SeiteA:=Abs(SP.X-X);
SeiteB:=Abs(SP.Y-Y);
if (SeiteA>SeiteB) and (X<>SP.X) and (Y<>SP.Y)
then Seite1:=SeiteB
else Seite1:=SeiteA;
if X<SP.X
then H.X:=Sp.X-Seite1
else H.X:=SP.X;
if Y<SP.Y
then H.Y:=SP.Y-Seite1
else H.Y:=SP.Y;                           
paintbox.Canvas.Rectangle(H.X,H.Y,H.X+Seite1,H.Y+Seite1);
StartPunkt:=False;
end

Rechteck:

Delphi-Quellcode:

if X<SP.X
then begin
SeiteA:=SP.X-X;
H.X:=X;
end
else begin
SeiteA:=X-SP.X;
H.X:=SP.X;
end;
if Y<SP.Y
then begin
SeiteB:=SP.Y-Y;
H.Y:=Y;
end
else begin
SeiteB:=Y-SP.Y;
H.Y:=SP.Y;
end;
paintbox.Canvas.Rectangle(H.X,H.Y,H.X+SeiteA,H.Y+SeiteB);
StartPunkt:=False;
end

Ende:

Delphi-Quellcode:

else
SP.X:=X;
SP.Y:=Y;
StartPunkt:=True;

jetzt musst du nur noch unter Private die Variable SP als TPoint deklarieren und dann sollte es gehen.