Größenänderung von TDBGrid, TPanel, TGroupBox während der La

[eddy]

Hallo Leute,

ich möchte immer mal wieder die Möglichkeit nutzen, während der Laufzeit die standardmäßig vorgegebenen Größe von DBGrid's, Panelen, Memos usw. zu ändern.

D.h. ich gehe mit dem Mauscursor an die untere Kante einer GroupBox, dort soll sich dann der Cursor von crDefault auf crVSplit ändern und bei gedrückter Maustaste ändere ich die Größe. Nach dem Loslassen der Maus ist die neue Einstellung gültig.

Die Änderungen speichern und wieder herstellen ist dann kein Problem.

Wer hat einen passenden Link, ein oder mehrer Beispiele oder den passenden Suchbegriff?

mfg
eddy

[Christian Seehase]

Moin Eddy,

mal ein Beispiel:

Delphi-Quellcode:

procedure TfrmMAIN.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  fMBLeftDown := Button = mbLeft;
end;

procedure TfrmMAIN.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if (y > (Memo1.Top+Memo1.Height-5)) and (y < (Memo1.Top+Memo1.Height+5)) then
  begin
    self.Cursor := crVSplit;
  end
  else
  begin
    self.Cursor := crDefault;
  end;
  if fMBLeftDown then
  begin
    Memo1.Height := y-Memo1.Top;
  end;
end;

procedure TfrmMAIN.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  fMBLeftDown := not (Button = mbLeft);
end;

fMBLeftDown ist hier eine globale Variable vom Typ Boolean, die mit false initialisiert wurde.

[eddy]

Hallo Christian,

vielen Dank für Deine Unterstützung. Ich habe den von Dir gelieferten Code noch ein wenig verändert.

Funktioniert in Objekten ohne Scrollbar wie gewünscht, d.h. an der linken und rechten Kante kann Width, an der unteren Kante Heigth und in der unteren rechten Ecke beide Werte geändert werden. Verschieben läßt sich an der oberen Kante durchführen.

Wenn ein Scrollbar vorhanden ist, z.B. in einem Memo, dann klappt es nicht. Legt man das Memo auf ein Panel und setzt das Memo auf Align = alClient, dann ist das Problem gelöst.

Interssanter Nebeneffekt: bei sich überlappenden Objekten wird das zuletzt geänderte auf dem Bildschirm nach oben gelegt.

Zur Anwendung muß man nur noch die drei Prozeduren in OnMouseMove, OnMouseDown und OnMouseUp einbinden.


Bei mir stehen die Prozeduren in einer Unit namens "AllgUP2".

Code:

const
  {Konstante, die für das Verschieben von Objecten benötigt wird}
  SC_DragMove = $F012;
  // für UP's zur Veränderung der Größe von TControl
  fMBLeftDown : boolean = false;
  fTyp        : short = 0;
  fLstTyp     : short = 0;

uses
  Math;

//-------------- Größenänderung von Objecten -----------------------------------
{
  Anwendung in den Objekt-Ereignissen OnMouseMove, OnMouseDown und OnMouseUp:
  FAllgUP2.ChgSizeMMove(Sender, Shift, X,Y);
  FAllgUP2.ChgSizeMDown(Sender, Button);
  FAllgUP2.ChgSizeMUp(Sender, Button);
}
procedure TFAllgUP2.ChgSizeMUp(Sender: TObject; Button: TMouseButton);
begin
  fMBLeftDown := not (Button = mbLeft);
end;

procedure TFAllgUP2.ChgSizeMDown(Sender: TObject; Button: TMouseButton);
begin
  fMBLeftDown := Button = mbLeft;
  fLstTyp := fTyp;
end;

procedure TFAllgUP2.ChgSizeMMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
const
  MinHeight = 50;   //damit das Objekt nicht vom Bildschirm verschwinden kann
  MinWidth = 50;
var
  cleft, cwidth,
  ctop, cheight : integer;
begin
  ctop := (Sender as TControl).Top;
  cheight := (Sender as TControl).Height;
  cleft := (Sender as TControl).Left;
  cwidth := (Sender as TControl).Width;

  if (y > cheight - 15) and (y < cHeight + 15) then begin
    fTyp := 2;
    if (x > cwidth - 15) and (x < cwidth) then fTyp := 5;
  end
  else if y < 15 then fTyp := 1
  else if x < 15 then fTyp := 3
  else if (x > cwidth - 15) and (x < cwidth) then fTyp := 4
  else fTyp := 0;

  case fTyp of
    1 : (Sender as TControl).Cursor := crSizeAll;
    2 : (Sender as TControl).Cursor := crVSplit;
    3,
    4 : (Sender as TControl).Cursor := crHSplit;
    5 : (Sender as TControl).Cursor := crSizeNWSE;
  else (Sender as TControl).Cursor := crDefault;
  end; // of case

  if fMBLeftDown then begin
    case fLstTyp of
      1 : begin
            ReleaseCapture;
            (Sender as TControl).perform(WM_SysCommand,SC_DragMove,0);
          end;
      2 : (Sender as TControl).Height := Max(y, MinHeight);
      3 : begin
            (Sender as TControl).Width := Max(cwidth - x, MinWidth);
            (Sender as TControl).Left := cleft + x;
          end;
      4 : (Sender as TControl).Width := Max(x, MinWidth);
      5 : begin
            (Sender as TControl).Height := Max(y, MinHeight);
            (Sender as TControl).Width := Max(x, MinWidth);
          end;
    end; // of case
  end;
end;
//-------------- end of Größenänderung von Objecten ----------------------------

Und verwendet werden die drei Prozeduren wie im nachfolgenen Beispiel mit einem Memo gezeigt:

Code:

procedure TFKasse.Memo1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  FAllgUP2.ChgSizeMMove(Sender, Shift, X,Y);
end;

procedure TFKasse.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FAllgUP2.ChgSizeMDown(Sender, Button);
end;

procedure TFKasse.Memo1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FAllgUP2.ChgSizeMUp(Sender, Button);
end;

Das ganze müßte mit allen Objekten vom Typ TWinControl und deren Nachfahren funktionieren.


mfg
eddy