AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Rechteck verschieben

Ein Thema von delphicoder123 · begonnen am 15. Jun 2019 · letzter Beitrag vom 17. Jun 2019
Antwort Antwort
delphicoder123

Registriert seit: 14. Feb 2019
102 Beiträge
 
#1

AW: Rechteck verschieben

  Alt 17. Jun 2019, 08:04
Bei mir wird beim onmouseDown Event folgender Code ausgeführt:
"formular" ist eine private Variable.
Warm bekomme ich immer noch die falschen koordinaten wenn ich innerhalb vom Rechteck bin?
Delphi-Quellcode:
function TRechteck.rechteckGetroffen(): Boolean;
var
  pt: TPoint;
begin
    pt:= Mouse.CursorPos;
    {if (formular.ScreenToClient(Mouse.CursorPos).X >= x1) AND (formular.ScreenToClient(Mouse.CursorPos).x <= x2) AND
      (formular.ScreenToClient(Mouse.CursorPos).Y >= y1) AND (formular.ScreenToClient(Mouse.CursorPos).Y <= y2) then
      result:=true
    else
      result:=false;   }


    pt := formular.screenToClient(pt);
    if (pt.X >= x1) AND (pt.x <= x2) AND
      (pt.Y >= y1) AND (pt.Y <= y2) then
      result:=true
    else
      result:=false;

end;
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beiträge
 
#2

AW: Rechteck verschieben

  Alt 17. Jun 2019, 08:07
Bei mir wird beim onmouseDown Event folgender Code ausgeführt:
"formular" ist eine private Variable.
Warm bekomme ich immer noch die falschen koordinaten wenn ich innerhalb vom Rechteck bin?
Delphi-Quellcode:
function TRechteck.rechteckGetroffen(): Boolean;
var
  pt: TPoint;
begin
    pt:= Mouse.CursorPos;
    {if (formular.ScreenToClient(Mouse.CursorPos).X >= x1) AND (formular.ScreenToClient(Mouse.CursorPos).x <= x2) AND
      (formular.ScreenToClient(Mouse.CursorPos).Y >= y1) AND (formular.ScreenToClient(Mouse.CursorPos).Y <= y2) then
      result:=true
    else
      result:=false;   }


    pt := formular.screenToClient(pt);
    if (pt.X >= x1) AND (pt.x <= x2) AND
      (pt.Y >= y1) AND (pt.Y <= y2) then
      result:=true
    else
      result:=false;

end;
Du brauchst keine private Formular Definition du befindest dich darin.

ps:
Zitat:
Bei mir wird beim onmouseDown Event folgender Code ausgeführt:
Zeig mal das Event die Funktion davon.

gruss

Geändert von EWeiss (17. Jun 2019 um 08:10 Uhr)
  Mit Zitat antworten Zitat
delphicoder123

Registriert seit: 14. Feb 2019
102 Beiträge
 
#3

AW: Rechteck verschieben

  Alt 17. Jun 2019, 08:37
Delphi-Quellcode:
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  rechteck1.anfassen;
end;
Delphi-Quellcode:
procedure TRechteck.anfassen;
begin
   if rechteckGetroffen then
    z:=1;
end;
Delphi-Quellcode:
function TRechteck.rechteckGetroffen(): Boolean;
var
  pt: TPoint;
begin
    pt:= Mouse.CursorPos;
    {if (formular.ScreenToClient(Mouse.CursorPos).X >= x1) AND (formular.ScreenToClient(Mouse.CursorPos).x <= x2) AND
      (formular.ScreenToClient(Mouse.CursorPos).Y >= y1) AND (formular.ScreenToClient(Mouse.CursorPos).Y <= y2) then
      result:=true
    else
      result:=false;   }


    pt := formular.screenToClient(pt);
    if (pt.X >= x1) AND (pt.x <= x2) AND
       (pt.Y >= y1) AND (pt.Y <= y2) then
        result:=true
      else
        result:=false;

end;
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beiträge
 
#4

AW: Rechteck verschieben

  Alt 17. Jun 2019, 08:46
So ein ganz einfaches verständliches Sample..
Es macht nicht anderes als deine Class TRechteck zu erstellen..
Danach kannst du wenn du mit der Maus über den Button fährst sehen wie ich die Koordinaten einlese bzw. übergebe.

Siehe dazu
procedure OnMouseMove(x, y: Integer);
gruss

Geändert von EWeiss ( 9. Jul 2019 um 08:31 Uhr)
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beiträge
 
#5

AW: Rechteck verschieben

  Alt 17. Jun 2019, 09:42
Noch ne Spielerei..

Kopiere das vollständig in deine Unit1 dann kannst du sogar deinen Button auf der Form verschieben.
Delphi-Quellcode:
nit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TRechteck = class(TObject)
  private
    z: Integer;
    x1, x2, y1, y2: Integer;
    clr: TColor;
    cvs: TCanvas;
    procedure anfassen;
    procedure OnMouseMove(x, y: Integer);
    function rechteckGetroffen(var Getroffen: BOOL): Boolean;
  end;

  TForm1 = class(TForm)
    btnRechteck: TButton;
    lblXPosition: TLabel;
    lblYPosition: TLabel;
    lblXValue: TLabel;
    lblYValue: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure btnRechteckMouseMove(Sender: TObject; Shift: TShiftState;
      x, y: Integer);
    procedure btnRechteckMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; x, y: Integer);
    procedure btnRechteckMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; x, y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; x, y: Integer);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  RechtEck: TRechteck;
  DragFlag: BOOL;
  MemX, MemY: Integer;

implementation

{$R *.dfm}

procedure TRechteck.anfassen;
var
  FGetroffen: BOOL;
  z: Integer;
begin
  rechteckGetroffen(FGetroffen);
  if FGetroffen then
    Form1.btnRechteck.Caption := 'true';
end;

procedure TForm1.btnRechteckMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; x, y: Integer);
begin

  DragFlag := True;
  MemX := x;
  MemY := y;
end;

procedure TForm1.btnRechteckMouseMove(Sender: TObject; Shift: TShiftState;
  x, y: Integer);
begin

  RechtEck.OnMouseMove(x, y);
  RechtEck.anfassen;

  if not DragFlag then
    exit;

  btnRechteck.Left := btnRechteck.Left + (x - MemX);
  btnRechteck.Top := btnRechteck.Top + (y - MemY);
end;

procedure TForm1.btnRechteckMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; x, y: Integer);
begin

  DragFlag := False;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  RechtEck := TRechteck.Create;

end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState;
  x, y: Integer);
begin
  Form1.btnRechteck.Caption := 'false';
end;

function TRechteck.rechteckGetroffen(var Getroffen: BOOL): Boolean;
var
  pt: TPoint;

begin

  pt := Form1.btnRechteck.ScreenToClient(Mouse.CursorPos);
  if PtInRect(Form1.btnRechteck.ClientRect, pt) then
  begin
    Result := True;
  end;

end;

{ TRechteck }

procedure TRechteck.OnMouseMove(x, y: Integer);
begin

  Form1.lblXValue.Caption := IntToStr(x);
  Form1.lblYValue.Caption := IntToStr(y);
end;

end.
Das war es jetzt von mir..
Sollte funktionieren.

gruss

Geändert von EWeiss (17. Jun 2019 um 10:59 Uhr)
  Mit Zitat antworten Zitat
delphicoder123

Registriert seit: 14. Feb 2019
102 Beiträge
 
#6

AW: Rechteck verschieben

  Alt 17. Jun 2019, 10:58
Ich kann jetzt EIN Rechteck verschieben.
Sobald es mehrere Rechtecke sind, funktioniert es nicht mehr.
Wie schaffe ich es, dass man auch mehrere Rechtecke verschieben kann?

Delphi-Quellcode:
unit unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, rechteck;

type
  TForm1 = class(TForm)
    Button1: TButton;
    editx1: TEdit;
    edity1: TEdit;
    editx2: TEdit;
    edity2: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormActivate(Sender: TObject);
  private
    { Private-Deklarationen }
    x1,x2,y1,y2,
    breite,hoehe,zustand:Integer; // Zustand (0,1)
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.Button1Click(Sender: TObject);
var
  TheRect: TRect;
begin
  x1:=strtoint(editx1.text);
  y1:=strtoint(edity1.text);
  x2:=strtoint(editx2.text);
  y2:=strtoint(edity2.text);
  breite:=x2-x1;
  hoehe:=y2-y1;
  Canvas.Rectangle(x1, y1, x2, y2);
  {Canvas.Rectangle(10, 10, 100, 100);
  Canvas.Rectangle(150, 150, 200, 200);
  Canvas.Rectangle(350, 350, 300, 300); }

end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  form1.Color:=clwhite;
  {x1:=10;
  x2:=100;
  y1:=10;
  y2:=100;
  breite:=x2-x1;
  hoehe:=y2-y1; }

end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if (X >= x1) AND (x <= x2) AND
       (y >= y1) AND (y <= y2) then
           begin
            zustand:=1;
           end
      else
        zustand:=0;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if zustand=1 then
    begin
      form1.canvas.pen.Color:=clwhite;
      form1.Canvas.Rectangle(x1,y1,x2,y2);
      form1.canvas.pen.Color:=clblack;
      x1:=x;
      y1:=y;
      x2:=x+breite;
      y2:=y+hoehe;
      form1.Canvas.Rectangle(x1, y1, x2, y2);

    end;
end;

end.
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beiträge
 
#7

AW: Rechteck verschieben

  Alt 17. Jun 2019, 11:07
Ok letzter Post..
Ich weis nicht was du da Rumdokterst ein einfaches PtInRect reicht siehe mein Beispiel oben.

Delphi-Quellcode:
function TRechteck.rechteckGetroffen(var Getroffen: BOOL): Boolean;
var
   pt: TPoint;

begin

   pt := Form1.btnRechteck.ScreenToClient(Mouse.CursorPos);
   if PtInRect(Form1.btnRechteck.ClientRect, pt) then
   begin
     Result := True;
   end;

end;
Wenn du jetzt 10 Rechtecke hast dann musst du nur bei allen prüfen ob sich deine Maus im RECT desjeweiligen Controls (Rechteck befindet)
Wie mein For.. Next verwendet sollte dir doch klar sein oder?

ganze 2 Zeilen und fertig!

gruss
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 03:42 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz