Komponente im Raster verschieben

[oki]

Hi Leute!

Ich habe eine eigene Klasse mit dem Vorfahren TCustomControl. Im MouseDown-Ereignis reagiere ich wie folgt:

Delphi-Quellcode:

      ReleaseCapture;
      case CurPosState of
        cps_none:
          TWinControl(self).Perform(WM_SYSCOMMAND, $F012, 0);
        cps_LeftTop:
          TWinControl(self).Perform(WM_SYSCOMMAND, $F004, 0);
        cps_RightTop:
          TWinControl(self).Perform(WM_SYSCOMMAND, $F005, 0);
        cps_LeftBottom:
          TWinControl(self).Perform(WM_SYSCOMMAND, $F007, 0);
        cps_RightBottom:
          TWinControl(self).Perform(WM_SYSCOMMAND, $F008, 0);
        cps_Left:
          TWinControl(self).Perform(WM_SYSCOMMAND, $F001, 0);
        cps_Top:
          TWinControl(self).Perform(WM_SYSCOMMAND, $F003, 0);
        cps_Right:
          TWinControl(self).Perform(WM_SYSCOMMAND, $F002, 0);
        cps_Bottom:
          TWinControl(self).Perform(WM_SYSCOMMAND, $F006, 0);
      end;

CurPosState ist ein eigener Typ, der mir sagt ob und auf welchem Ziehpunkt der Cursor steht. So kann ich zur Laufzeit die Größe des Controls per Maus ändern. Mein cps_none bedeutet kein Ziehpunkt -> also gesamtes Control verschieben.
Jetzt möchte ich aber ein "Gitter" mit einer festgelegten Rasterweite einschalten (im Hauptprogramm). Als beispiel soll ein Raster von 10 Pixel gelten.
wenn ich nun die Kompo zur Laufzeit verschiebe oder in der Größe ändere, dann soll das in 10-er Schritten erfolgen. Das erspart dem Anwender ein nachträgliches mühsames Ausrichten. Leider hab ich nun keinen Film, wie ich das machen kann.

Ich hatte mir gedacht, dass nachträglich im MouseUp zu machen, find ich aber nicht so elegant.

Wenn einer 'ne Idee hat, würd mich freuen.

Gruß oki

[Nikolas]

Da hilft dir die freundliche Funktion DIV.
Was du brauchst ist ganz klar die GanzZahlDivision. Wenn du deine Maus um 55px bewegst, bist du 55 div 10 = 5 Kästchen weit gekommen.
Die neue Koordinate deines WasAuchImmers liegt also bei (55 div 10)*10, wenn es davor richtig lag .

[oki]

Hi,

schon mal dank für die antwort. Aber die Trifft es nicht. Die Mathematik ist mir schon klar. Wenn ich die Mausereignisse aber mittels ReleaseCapture abfange und mit Perform die Änderungen ausführen lasse, dann kann ich halt die korrigierten Koordinaten nicht mit übergeben. Oder ich weis halt nicht wie und wo.

Gruß oki

[oki]

*push* :roll:

[Hawkeye219]

Hallo oki,

die Konstante GRIDINTERVAL habe ich (auch) für dich in dieses Beispiel eingebaut.

Gruß Hawkeye

[oki]

Hi Hawkeye219,

jooop, aber mit Move über X, Y. Nun ist es aber so, dass ich die im ersten Post dargestellte Variante verwende. Dabei werden die Mausereignisse ja abgefangen und bis zum MouseUp umgeleitet (Perform).
Mit der von mir verwendeten Methode (hab ich aber auch dem Forum an anderer Stelle entnommen) geht das alles etwas flüssiger mit dem Bewegen des Controls (subjektiv?). Zu dem ist der Code natürlich sehr schmal und übersichtlich bei gleicher Funktionalität.
Kehrseite; wie bekomme ich das mit dem Raster hin?

Gruß oki

[SirThornberry]

Nachteil deiner Methode mit Release ist dass, das Control wohl ein Handle haben muss. Wenn es ein Handle hat solltest du die Messages wm_sizing und wm_moving abfangen können.

[oki]

Hi sirThornberry,

das werd ich mal testen. Ich habe mich bis jetzt mit folgendem Trick beholfen:
- Move und Size wie erläutert,
- in Paint SetBounts mit korrogierten Positions- und Größenwerten aufgerufen.

Delphi-Quellcode:

procedure TBaseCustomControl.Paint;
begin
  inherited;
  Canvas.Font.Assign(self.Font);
  RastControl;
end;

procedure TBaseCustomControl.RastControl;
var Rest : Extended;
    ALeft, ATop, AHeight, AWidth  : Integer;
begin
  if not FGrid then
    Exit;
  ALeft := ((Left Div FGridWidth) * FGridWidth) + (Round(Frac(Left/FGridWidth))*FGridWidth);
  ATop := ((Top Div FGridWidth) * FGridWidth) + (Round(Frac(Top/FGridWidth))*FGridWidth);
  AWidth := ((Width Div FGridWidth) * FGridWidth) + (Round(Frac(Width/FGridWidth))*FGridWidth);
  AHeight := ((Height Div FGridWidth) * FGridWidth) + (Round(Frac(Height/FGridWidth))*FGridWidth);
  SetBounds(ALeft, ATop, AWidth, AHeight);
end;

FGrid ist ein boolsches Property (Raster an aus) und FGridWidth ist natürlich die Gitterweite.
Erstaunlicher weise passiert jetzt folgendes. Bei Move wird während der Bewegung nicht gerastert, aber beim Ablegen auf das Raster korrigiert. Das hab ich auch so erwartet, wollte ich aber nicht haben.
Bei Größenänderung springt die gezogene Seite in Rasterschritten während des ziehens auf die neue Größe. Das wollte ich so haben, hab ich aber mit diesem Code nicht erwartet. :gruebel:

Na, ich probiers mal weiter.

Gruß oki

[Hawkeye219]

Hallo oki,

Angus Johnson bietet auf seiner Seite mit TSizeControl eine Komponente an, die dein (Programmierer-)Leben etwas vereinfachen könnte.

Gruß Hawkeye

[_frank_]

die macht leider das snapToGrid erst, wenn das Control gedroppt wird.
evtl hat jemand eine Idee, wie man den Rahmen auch "snappen" kann.
Meine Versuche haben damals nicht funktioniert.

Gruß Frank

[oki]

Hallo Hawkeye219

auch wenn es jetzt blöd klingt, aber ich möchte (muss) meine eigene Collektion von Controls erstellen. Wird für mich im Nachgang einfacher, wenn alle meine Controls den gleichen Vorfahren haben. Das Moving/Sizing ist auch kein Problem. Hab ich schon alles zu meiner Zufriedenheit gelöst. Das Thema SnaptoGrid ist ja auch keine Gewalt. Hätte ich halt etwas schicker (wie beschrieben während der Bewegung). Somit stehe ich eigentlich nicht vor dem Problem der gesamten Lösung, sondern nur für ein "kleines Detail". ehrlich gesagt würde ich eher auf dieses Detail verzichten, als meine Kompo weg werfen und eine Fremdkompo verwenden.

Zitat:

Zitat von _frank_

die macht leider das snapToGrid erst, wenn das Control gedroppt wird.
evtl hat jemand eine Idee, wie man den Rahmen auch "snappen" kann.
Meine Versuche haben damals nicht funktioniert.

Gruß Frank

Und genau das ist im Moment mein Problem! Wie gesagt, mit meiner einfachen Lösung im Paint klappt das erstaunlicher weise mit der Größenänderung zur "Ziehzeit". Beim Moving halt erst beim Drop.

Ich habe das Gefühl, dass folgender Code nicht dazu führt, dass mein vererbtes Paint aufgerufen wird:

Delphi-Quellcode:

   ReleaseCapture;
   TWinControl(self).Perform(WM_SYSCOMMAND, $F012, 0);

Aber warum bei den anderen?

Delphi-Quellcode:

   ReleaseCapture;
      ...
        cps_LeftTop:
          TWinControl(self).Perform(WM_SYSCOMMAND, $F004, 0);
        cps_RightTop:
          TWinControl(self).Perform(WM_SYSCOMMAND, $F005, 0);
        cps_LeftBottom:
          TWinControl(self).Perform(WM_SYSCOMMAND, $F007, 0);
        cps_RightBottom:
          TWinControl(self).Perform(WM_SYSCOMMAND, $F008, 0);
        cps_Left:
          TWinControl(self).Perform(WM_SYSCOMMAND, $F001, 0);
        cps_Top:
          TWinControl(self).Perform(WM_SYSCOMMAND, $F003, 0);
        cps_Right:
          TWinControl(self).Perform(WM_SYSCOMMAND, $F002, 0);
        cps_Bottom:
          TWinControl(self).Perform(WM_SYSCOMMAND, $F006, 0);

gruß oki

[oki]

Noch ein Nachtrag,

mein Control wird auch während des verschiebens immer sauber gezeichnet. Halt ohne einrasten.

Gruß oki

[SirThornberry]

es im Paint zu korrigieren halte ich für den falschen Weg, dann kannst du auch gleich einen Timer nehmen der korrigiert. Richtiger finde ich, das gleich zu verhindern durch eben behandeln der Messages wm_sizing und wm_moving.

[oki]

Zitat:

Zitat von SirThornberry

es im Paint zu korrigieren halte ich für den falschen Weg, dann kannst du auch gleich einen Timer nehmen der korrigiert. Richtiger finde ich, das gleich zu verhindern durch eben behandeln der Messages wm_sizing und wm_moving.

Joop, war auch erst mal nur eine Notlösung mit dem Korrogieren im Paint.
Teste heute noch das Message-Thema.

Gruß oki

[oki]

Habe jetzt das ganze mal in den Messages wmsizing und wmmoving getestet.

Delphi-Quellcode:

procedure TBaseCustomControl.WMMoving(var Message: TWMMove);
begin
  if Grid then
    RastControl;
end;

procedure TBaseCustomControl.WMSizing(var Message: TWMSize);
begin
  if Grid then
    RastControl;
end;

procedure TBaseCustomControl.RastControl;
var ALeft, ATop, AHeight, AWidth  : Integer;
begin
  if not Grid then
    Exit;
  ALeft := (Left Div FGridWidth) * FGridWidth;
  ATop := (Top Div FGridWidth) * FGridWidth;
  AWidth := (Width Div FGridWidth) * FGridWidth;
  AHeight := (Height Div FGridWidth) * FGridWidth;
  SetBounds(ALeft, ATop, AWidth, AHeight);
end;

Gute Nachricht: Er rastet jetzt auch während des Movens.
Schlechte Nachricht: Das Control "zappelt" am Mauszeiger. Dabei habe ich den Eindruck, dass das Control beim bewegen auf die neue "krumme" Koordinate verschoben und gezeichnet und dann wmmoving ausgeführt wird. Dort wird dann korrigiert und wieder neu an den Gitterkoordinaten gezeichnet (SetBounds siehe Code).

Ein Problem gelöst, nächste da. :wall:

Somit müsste vor dem Zeichnen korrigiert werden. Aber wie?

Gruß oki

[jim_raynor]

Rufe das RastControl mal nur in einer der beiden Messages aus. Vielleicht hilft das ja schon.

[oki]

Hab ich getestet. Zappeln bleibt, halt nur bei der entsprechenden aktion.

Gruß oki

[_frank_]

ich hab das mal in die SizeControl-Komponente von Angus Johnson integriert (da ich dieses Feature auch im DFM-Editor haben wollte):

Delphi-Quellcode:

  TTargetObj = class
  private
    ....
    procedure AlignToGrid(Ctrl: TControl; ProposedBoundsRect: TRect; GridSize: integer);
...
  TSizeCtrl = class(TComponent)
  private
...
    fSnapToGrid: boolean;
...
  published
...
    property SnapToGrid: boolean read fSnapToGrid write fSnapToGrid;
...
//changed global function AlignToGrid to method of TTargetObj
procedure TTargetObj.AlignToGrid(Ctrl: TControl; ProposedBoundsRect: TRect; GridSize: integer);
begin
  //AlignToGrid() assumes 'Control' is assigned.
  if (GridSize > 1) and (FSizeCtrl.SnapToGrid) then
  begin
...

procedure TTargetObj.MoveFocus(dx,dy: integer);
begin
  fFocusRect := fStartRec;
  if fSizeCtrl.SnapToGrid then
  begin
    dx:=dx div fsizectrl.GridSize * fsizectrl.GridSize;
    dy:=dy div fsizectrl.GridSize * fsizectrl.GridSize;
  end;
  offsetRect(fFocusRect, dx,dy);
end;
//------------------------------------------------------------------------------

procedure TTargetObj.SizeFocus(dx,dy: integer; BtnPos: TBtnPos);
begin
  fFocusRect := fStartRec;
  if fSizeCtrl.SnapToGrid then
  begin
    dx:=dx div fsizectrl.GridSize * fsizectrl.GridSize;
    dy:=dy div fsizectrl.GridSize * fsizectrl.GridSize;
  end;
...

für die faulen unter euch ist die komplette Komponente im Anhang

Gruß Frank

[SirThornberry]

schau dir mal die Hilfe zu wm_sizing und wm_moving an!
Mit der Message kommt ein Pointer auf die neuen Koordinanten des Forms. Diese solltest du direkt korrigieren. Andernfalls änderst du eben die Korrdinanten durch deine Methode und beim rückkehren aus der Messageroutine wird nochmal korrigiert - daher auch das zappeln.

Schau dir zur Orientierung mal folgendes an:
http://www.delphipraxis.net/internal...=699256#699256

[oki]

Hallo SirThomberry,

erst mal herzlichen Dank für die Hilfe. Das klappt jetzt super für wm_Sizing. Alles ohne Zappeln und wie gewollt im Raster. Für wm_moving aber leider nicht.
Folgende Erscheinung. Bewege ich das Control mit der Maus nach rechts oben, macht er aus einem Pixel Move 10 Pixel. Somit wandert das Control mit 10-facher Geschwindigkeit von meiner Maus nach oben/rechts weg. Nach links/unten geht gar nichts. Das erscheint normal, wenn man davon ausgeht, das jedes neue moving von den aktuellen Controlposition + Mausoffset ausgeht. Das es dann nicht nach rechts/unten klappt ist logischerweise auf mein Div zurückzuführen. aber warum ist das nur beim Moving und nicht beim Sizing so? Sizing ist in alle Richtungen so wie ich es haben will.

Hier der veränderte Code:

Delphi-Quellcode:

Procedure TBaseCustomControl.GetRastControlRect(var ARect: PRect);
begin
  if not Grid then begin
    Exit;
  end;
  ARect.Left := (ARect.Left Div FGridWidth) * FGridWidth;
  ARect.Top := (ARect.Top Div FGridWidth) * FGridWidth;
  ARect.Right := (ARect.Right Div FGridWidth) * FGridWidth;
  ARect.Bottom := (ARect.Bottom Div FGridWidth) * FGridWidth;
end;

procedure TBaseCustomControl.WMMoving(var AMsg: TMessage);
var ARect : PRect;
begin
  if not Grid then
    Exit;
  ARect := PRect(AMsg.lParam);
  GetRastControlRect(ARect);
end;

procedure TBaseCustomControl.WMSizing(var AMsg: TMessage);
var ARect : PRect;
begin
  if not Grid then
    Exit;
  ARect := PRect(AMsg.lParam);
  GetRastControlRect(ARect);
end;

Herzlichen Dank für deine Gedult und Gruß oki

[oki]

*push* :oops:

[oki]

Hi Leute,

also das mit dem Verschieben zur Laufzeit hat mir einige Kopfschmerzen bereitet. Das lag zum einen daran, dass man erst mal verstehen muß was wann sich ändert und dann muss man es auch noch schaffen seine Gehirnwindungen zu entknoten und einen machbaren ansatz finden.

Hier jetzt mein Ergebnis. Wenn jemand Verbesserungsvorschläge hat, her damit.

noch mal die Aufgabenstellung zum Verständnis:
- Das Control soll zur Laufzeit in einem Raster der Weite X verschoben werden können.
- Das Verschieben erfolgt mittels:

Delphi-Quellcode:

  //Fängt alle Mausereignisse ab
  ReleaseCapture;
  // verschiebt das Control (hängt am Mauszeiger)
  TWinControl(self).Perform(WM_SYSCOMMAND, $F012, 0);

in der vererbten MouseDown Methode.
- Das Control soll nicht erst nach dem Droppen einrasten, sondern fortlaufend während des movens.

Umsetzung:

Delphi-Quellcode:

  TBaseCustomControl = class(TCustomControl)
  private
    FGrid: Boolean;                     // Gitter zum einrasten an
    FGridWidth: Integer;                // Pixelweite des Gitters
    FOldScreenRect : TRect;             // letzte Größe des ClientRect beim moven
    MoveOffsetX, MoveOffsetY : Integer; // komulierte X-, Y-Offsets beim moven
    procedure WMSizing(var AMsg: TMessage); message WM_SIZING;
    procedure WMMoving(var AMsg: TMessage); message WM_MOVING;
....
  public
    property Grid : Boolean read FGrid write FGrid;
    property GridWidth : Integer read FGridWidth write FGridWidth;
...

procedure TBaseCustomControl.WMMoving(var AMsg: TMessage);
var ARect : PRect;
begin
  // am Gitter ausrichten
  if Grid then begin
    ARect := PRect(AMsg.lParam);

    // Startwert für Left setzen und auf Raster korrigieren
    if (FOldScreenRect.Left = 0) or
      ((FOldScreenRect.Left mod FGridWidth) > 0) then
      FOldScreenRect.Left := ARect.Left div FGridWidth * FGridWidth;

    // Startwert für Right setzen und auf Raster korrigieren
    if (FOldScreenRect.Right = 0) or
      ((FOldScreenRect.Right mod FGridWidth) > 0) then
      FOldScreenRect.Right := ARect.Right div FGridWidth * FGridWidth;

    // Startwert für Top setzen und auf Raster korrigieren
    if (FOldScreenRect.Top = 0) or
      ((FOldScreenRect.Top mod FGridWidth) > 0) then
      FOldScreenRect.Top := ARect.Top div FGridWidth * FGridWidth;

    // Startwert für Bottom setzen und auf Raster korrigieren
    if (FOldScreenRect.Bottom = 0) or
      ((FOldScreenRect.Bottom mod FGridWidth) > 0) then
      FOldScreenRect.Bottom := ARect.Bottom div FGridWidth * FGridWidth;

    Dec(MoveOffsetX, (ARect.Left - FOldScreenRect.Left));
    Dec(MoveOffsetY, (ARect.Top - FOldScreenRect.Top));
    // in X-Richtung verschieben
    if Abs(MoveOffsetX) > FGridWidth then begin
      // über das Raster hinaus
      Dec(ARect.Left, (FGridWidth*MoveOffsetX div Abs(MoveOffsetX)));
      Dec(ARect.Right, (FGridWidth*MoveOffsetX div Abs(MoveOffsetX)));
      MoveOffsetX := 0;
    end else begin
      ARect.Left := FOldScreenRect.Left;
      ARect.Right := FOldScreenRect.Right;
    end;
    // in Y-Richtung verschieben
    if Abs(MoveOffsetY) > FGridWidth then begin
      // über das Raster hinaus
      Dec(ARect.Top, (FGridWidth*MoveOffsetY div Abs(MoveOffsetY)));
      Dec(ARect.Bottom, (FGridWidth*MoveOffsetY div Abs(MoveOffsetY)));
      MoveOffsetY := 0;
    end else begin
      ARect.Top := FOldScreenRect.Top;
      ARect.Bottom := FOldScreenRect.Bottom;
    end;
    FOldScreenRect := ARect^;
  end;
end;

Jo, so klappt es bei mir erst mal sauber.

Gruß oki

[torud]

Hier auch mal ein Tipp von mir an alle diejenigen, die sich nicht davor scheuen eine externe komponente zum Einsatz zu bringen...

Software von Greatis.com

Ich benutze die seit einigen Jahren und fahre ganz gut damit...

[oki]

Hi Torud,

danke für den Link. Mein basecustomControl ist aber nur die Basisklasse für mehrere spezielle Controls. Somit hilft mir da eine externe Komponente nicht weiter. Derzeit implementiere ich die Basiseigenschaften meiner Controls. Jede weitere abgeleitete Klasse wird dann seine eigene Funktionalität bekommen (PID-Regler, T1-Glied ...). Jedoch sollen alle diese Komponenten zur Laufzeit eine Menge Basiseigenschaften besitzen wie verschieben, Größe ändern, farbe ändern, Gates verknüpfen, selektieren ...

somit muss und will ich mir die Arbeit selber machen.

Dank und Gruß oki