onMove Event ?

Janus · Beiträge: 33

Haben Formulare nicht sowas wie einen onMove Event ?
Ich habe ein Hauptformular und möchte, dass ein weiteres Toolbox Formular vom Hauptformular wie magnetisch angezogen wird, hat jemand eine Idee, wie ich sowas bewerkstelligen könnte ?

Gruss Janus

_________________
Don't give in the hate, that leaves to the dark side of the force !!!

Ehemaliges Mitglied Erhaltene Danke: 1

Die WndProc überschreiben und WM_MOVING abfangen oder extra für WM_MOVING eine Prozedur schreiben, die die Nachricht abfängt und darauf reagiert.

Janus · Beiträge: 33

Also das hört sich ja reichlich kompliziert an, gibt es denn da keinen einfacheren Weg ?
Für was sind denn die Event onDragDrop usw ???

_________________
Don't give in the hate, that leaves to the dark side of the force !!!

Ehemaliges Mitglied Erhaltene Danke: 1

OnDragDrop ist, denke ich, etwas anderes.

wulfskin · Verfasst: Do 13.03.03 21:28

Hallo Janus!

In meinem neusten Programm (zu finden in der Sparte "Freeware Projekte") kann man auch das Vorschauformular an das Hauptformular andocken. Ich habe das ganze per Hand programmiert und deshalb ist der Code auch recht lange und vielleicht auch zu kompliziert.

Hier erstmal der Quelltext:

KONSTANTEN UND FUNKTIONEN

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:

const
  doTopTop       = 1;
  doTopBottom    = 2;
  doLeftLeft     = 4;
  doLeftRight    = 8;
  doBottomBottom = 16;
  doBottomTop    = 32;
  doRightRight   = 64;
  doRightLeft    = 128;

function RectAtRect(const Rect1, Rect2: TRect): Boolean;
// Überprüft, ob die 2 Vierecke sich "fast" berühren, also -+5 px 
// voneinander entfernt sind
begin
  Result := (((Rect1.Right + 10) > Rect2.Left)  and
            (((Rect1.Top - 10) < Rect2.Bottom)  or
            ((Rect1.Bottom + 10) > Rect2.Top))) and
            (((Rect1.Left - 10) < Rect2.Right)  and
            (((Rect1.Top - 10) < Rect2.Bottom)  or
            ((Rect1.Bottom + 10) > Rect2.Top))) and
            (((Rect1.Top - 10) < Rect2.Bottom)  and
            (((Rect1.Right + 10) > Rect2.Left)  or
            ((Rect1.Left - 10) < Rect2.Right))) and
            (((Rect1.Bottom + 10) > Rect2.Top)  and
            (((Rect1.Right + 10) > Rect2.Left)  or
            ((Rect1.Left - 10) < Rect2.Right)));
end;

INS HAUPTFORMULAR, AN DAS ANGEDOCKT WERDEN KANN

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:

procedure FormMove(var Msg: TMessage); message WM_MOVE;

procedure TMainForm.FormMove(var Msg: TMessage);
// Verändert die Position des Andockformulars beim Bewegen des
// Hauptformulars, damit es wieder angedockt ist!
// Sollte auch bei OnResize des Hauptformulars ausgeführt werden!
var
  R1, R2: TRect;
begin
  if GetWindowRect(Handle, R1) then begin
    with FSettings do begin
      if  (CanDock)  //OB überhaupt angedockt werden soll
      and (GetWindowRect(PreviewForm.Handle, R2)) then begin
        with PreviewForm do begin  //Vorschauformular...
          if (Docked AND doLeftLeft) > 0 then begin
            R2.Left := R1.Left - Width;
            R2.Right := R1.Left;
          end
          else
          if (Docked AND doLeftRight) > 0 then begin
            R2.Left := R1.Left;
            R2.Right := R2.Left + Width;
          end;
          if (Docked AND doRightLeft) > 0 then begin
            R2.Left := R1.Right;
            R2.Right := R2.Left + Width;
          end
          else
          if (Docked AND doRightRight) > 0 then begin
            R2.Left := R1.Right - Width;
            R2.Right := R1.Right;
          end;
          if (Docked AND doTopTop) > 0 then begin
            R2.Top := R1.Top;
            R2.Bottom := R2.Top + Height;
          end
          else
          if (Docked AND doTopBottom) > 0 then begin
            R2.Top := R1.Top - Height;
            R2.Bottom := R1.Top;
          end;
          if (Docked AND doBottomTop) > 0 then begin
            R2.Top := R1.Bottom;
            R2.Bottom := R2.Top + Height;
          end
          else
          if (Docked AND doBottomBottom) > 0 then begin
            R2.Top := R1.Bottom - Height;
            R2.Bottom := R1.Bottom;
          end;
        end;
        PreviewForm.Top := R2.Top;
        PreviewForm.Left := R2.Left;
      end;
    end;
  end;
end;

INS ANDOCKFORMULAR

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:

procedure FormMoving(var Msg: TMessage); message WM_MOVING;

procedure TPreviewForm.FormMoving(var Msg: TMessage);
// Ermöglich andocken, wenn in "Reichweite"

  function IsNear(const AI, BI: Integer): Boolean;
  begin
    Result := (AI > (BI - 10)) AND (AI < (BI + 10));
  end;

var
  R: TRect;
  P: PRect;
begin
  FSettings.Docked := 0;
  if GetWindowRect(MainForm.Handle, R) then begin
    P := PRect(Msg.LParam);
    if not RectAtRect(R, P^) then
      Exit;
    with FSettings do begin
      if IsNear(P^.Right, R.Left) then begin
        P^.Left := R.Left - Width;
        P^.Right := R.Left;
        Msg.LParam := DWord(P);
        Msg.Result := DWord(True);
        Docked := Docked + doLeftLeft;
      end
      else
      if IsNear(P^.Left, R.Left) then begin
        P^.Left := R.Left;
        P^.Right := R.Left + Width;
        Msg.LParam := DWord(P);
        Msg.Result := DWord(True);
        Docked := Docked + doLeftRight;
      end;
      if IsNear(P^.Left, R.Right) then begin
        P^.Left := R.Right;
        P^.Right := R.Right + Width;
        Msg.LParam := Integer(P);
        Msg.Result := DWord(True);
        Docked := Docked + doRightLeft;
      end
      else
      if IsNear(P^.Right, R.Right) then begin
        P^.Left := R.Right - Width;
        P^.Right := R.Right;
        Msg.LParam := Integer(P);
        Msg.Result := DWord(True);
        Docked := Docked + doRightRight;
      end;
      if IsNear(P^.Bottom, R.Top) then begin
        P^.Top := R.Top - Height;
        P^.Bottom := R.Top;
        Msg.LParam := Integer(P);
        Msg.Result := DWord(True);
        Docked := Docked + doTopBottom;
      end
      else
      if IsNear(P^.Top, R.Top) then begin
        P^.Top := R.Top;
        P^.Bottom := R.Top + Height;
        Msg.LParam := Integer(P);
        Msg.Result := DWord(True);
        Docked := Docked + doTopTop;
      end;
      if IsNear(P^.Top, R.Bottom) then begin
        P^.Top := R.Bottom;
        P^.Bottom := R.Bottom + Height;
        Msg.LParam := Integer(P);
        Msg.Result := DWord(True);
        Docked := Docked + doBottomTop;
      end
      else
      if IsNear(P^.Bottom, R.Bottom) then begin
        P^.Top := R.Bottom - Height;
        P^.Bottom := R.Bottom;
        Msg.LParam := Integer(P);
        Msg.Result := DWord(True);
        Docked := Docked + doBottomBottom;
      end;
    end;
  end;
end;

So, wie du siehst, ein sehr langer Code und vielleicht auch umständlich. Zumindest funktioniert es bei mir ganz gut, vorrausgesetzt man bewegt das AnDock-Formular schnell genug, damit man es auch "wegbekommt"!

Du willst es einfacher haben? Ich empfehle dir dann eine Komponente!

Wenn du Fragen hast: Kein Problem, frag ruhig!

Gruß wulfskin!

Moderiert von Tino: Sourcecode aufgeteilt.

_________________
Manche antworten um ihren Beitragszähler zu erhöhen, andere um zu Helfen.

Ehemaliges Mitglied Erhaltene Danke: 1

Ich weiß ja nicht, was dein Monster-Code noch so alles macht, aber wenn nur Form2 an Form1 drankleben soll, dann reicht das vollkommen:

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Unit2;

type
  TForm1 = class(TForm)
    procedure FormShow(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure WMMove(var Msg: TMessage); message WM_MOVE;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  bShow : Boolean = FALSE;
implementation

{$R *.dfm}

procedure TForm1.WMMove(var msg: TMessage);
begin
  if bShow then
    MoveWindow(Form2.Handle, Form1.Left+Form1.Width, Form1.Top, Form2.Width, Form2.Height, TRUE);
  inherited;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  if bShow = FALSE then
  begin
    Form2.Show;
    Form2.Left := Form1.Left+Form1.Width;
    Form2.Top  := Form1.Top;
    bShow := TRUE;
  end;
end;

end.

Janus · Beiträge: 33

Das sieht ja toll aus, aber wann werden diese Funktionen aufgerufen ?

_________________
Don't give in the hate, that leaves to the dark side of the force !!!

Ehemaliges Mitglied Erhaltene Danke: 1

OnShow wird aufgerufen, wenn das fenster angezeigt wird und WMMOVE wird aufgerufen, wann immer dein Fenster die Nachticht WM_MOVE von Windows bekommt.

Janus · Beiträge: 33

Ja das war mir schon klar, meine Frage war mehr, ob dies Standardmässig so ist, oder ob ich da sonst noch irgendwo Code einfügen muss ! So einen Event habe ich nämlich nirgens gesehen, desshalb habe ich ja auch in diesem Forum gefragt ... :-)

_________________
Don't give in the hate, that leaves to the dark side of the force !!!

Ehemaliges Mitglied Erhaltene Danke: 1

Nö. Aber wie wäre es, wenn du es einfach mal ausprobieren würdest? :roll:

wulfskin · Verfasst: Fr 14.03.03 16:13

Hallo Janus!

Wenn du im Unitkopf, also zum Beispiel unter private diese beiden Prozedureköpfe einträgst, dann werden die beide Prozeduren immer dann aufgerufen, wenn du entsprechende Nachricht an das Formular geschickt wird:

markieren

Quelltext

1:
2:

procedure FormMove(var Msg: TMessage); message WM_MOVE;
procedure FormMoving(var Msg: TMessage); message WM_MOVING;

Versuch es einfach mal, du wirst es dann schon merken!

Gruß Hans-Peter!

P.S.: Vielen Dank für's formatieren!

_________________
Manche antworten um ihren Beitragszähler zu erhöhen, andere um zu Helfen.

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme