Komponenten zur Laufzeit verschieben, Größe verändern

[eddy]

Hallo Helmi,

ich nutze folgende UP's dafür:

Code:

// Größenänderung von Objecten während der Laufzeit:
// Maus-Cursor wird verändert

var
  // für UP's zur Veränderung der Größe von TControl
  fMBLeftDown : boolean = false;
  fSizeChg    : boolean = false;
  fTyp        : short = 0;
  fLstTyp     : short = 0;

//-------------- Größenänderung von Objecten -----------------------------------
{
  Anwendung in den Objekt-Ereignissen OnMouseMove, OnMouseDown und OnMouseUp:
  FAllgUP3.ChgSizeMMove(Sender, Shift, X,Y);
  FAllgUP3.ChgSizeMDown(Sender, Button);
  FAllgUP3.ChgSizeMUp(Sender, Button);
}

function TFAllgUP3.ChgSizeMUp(Sender: TObject; Button: TMouseButton):Boolean;
begin
  fMBLeftDown := false; //not (Button = mbLeft);
  fLstTyp := fTyp;
  Result := fSizeChg;
end;

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

procedure TFAllgUP3.ChgSizeMMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
const
  ChgCursor = 7;
  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 - ChgCursor) and (y < cHeight + ChgCursor) then begin
    fTyp := 2;
    if (x > cwidth - ChgCursor) and (x < cwidth) then fTyp := 5;
  end
  else if y < ChgCursor then fTyp := 1
  else if x < ChgCursor then fTyp := 3
  else if (x > cwidth - ChgCursor) 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    // oben
            if (ssShift in Shift) then begin
              (Sender as TControl).Align := alClient;
              (Sender as TControl).Align := alNone;
              fSizeChg := true;
            end
            else begin
              ReleaseCapture;
              (Sender as TControl).perform(WM_SysCommand,SC_DragMove,0);
            end;
          end;

      2 : begin   // unten
            (Sender as TControl).Height := Max(y, MinHeight);
              fSizeChg := true;
          end;
      3 : begin   // links
            (Sender as TControl).Width := Max(cwidth - x, MinWidth);
            (Sender as TControl).Left := cleft + x;
              fSizeChg := true;
          end;
      4 : begin   // rechts
            (Sender as TControl).Width := Max(x, MinWidth);
              fSizeChg := true;
          end;
      5 : begin   // untere rechte Ecke
            (Sender as TControl).Height := Max(y, MinHeight);
            (Sender as TControl).Width := Max(x, MinWidth);
              fSizeChg := true;
          end;
    end; // of case
  end;
end;
//-------------- end of Größenänderung von Objecten ----------------------------


Verwendung:

procedure TFInfoFinder.gbProgMouseDown(Sender: TObject;          // gb = GroupBox
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FAllgUP3.ChgSizeMDown(Sender, Button);
end;

procedure TFInfoFinder.gbProgMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  FAllgUP3.ChgSizeMMove(Sender, Shift, X,Y);
end;

procedure TFInfoFinder.gbProgMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FAllgUP3.ChgSizeMUp(Sender, Button);
  // geänderte Daten in INI-Datei speichern
  FAllgUP3.WrObjPos(DataPath + fnAPIni, gbProg);
end;

// Pos-Werte aus INI lesen
FAllgUP3.RdObjPos(DataPath + fnAPIni, gbProg);

Mußt Du natürlich auf Deine Bedürfnisse anpassen.

Funktioniert nicht unbedingt perfekt, aber für meine Anwendungen ausreichend. Z.B. gibt's wohl ein Problem, wenn rechts ein Scrollbar verläuft. Deshalb habe ich die Teile, die ich in der Größe änderbar zulasse, in eine GroupBox gelegt.

Verbesserungsvorschläge werden gern entgegen genommen.

mfg
eddy