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

[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