Größe lässt sich bei selber geschriebener GUI Klasse nicht ändern. Warum?

Für Fragen zur Programmiersprache auf welcher Lazarus aufbaut
Antworten
thosch
Beiträge: 324
Registriert: Mo 10. Jul 2017, 20:32

Größe lässt sich bei selber geschriebener GUI Klasse nicht ändern. Warum?

Beitrag von thosch »

Hallo,


ich habe folgenden Ansatz dazu:

Code: Alles auswählen

procedure TGUIControl.MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
var R: TRect;
begin
  if MouseL then
  begin
    if ContainsMouse(X,Y) then
    begin
      FMouseMoved := true;
      FDeltaX := X - FStartX;
      FDeltaY := Y - FStartY;
      OutTextXY(MouseX,MouseY+20,'DELTAX = '+IntToStr(FDeltaX)+'  DELTAY = '+IntToStr(FDeltaY));
      If FCanResizeControl then
      begin
        R := Canvas.ClipRect;
        FRight := FRight - FStartX + X;
        FBottom := FBottom - FStartY + Y;
        R.Right := FRight;
        R.Bottom := FBottom;
        Canvas.ClipRect := R;
        FWidth := FRight - FLeft;
        FHeight := FBottom - FTop;
      end
      else
      if FCanMoveControl then
      begin
        FLeft := FLeft - FStartX + X;
        FTop  := FTop - FStartY + Y;
      end;
    end;
  end;
end;

procedure TGUIControl.MouseDown(Sender: TObject; Button: TMouseButtons; Shift: TShiftState; X,Y: Integer);
begin
  if (Button = MouseBtnLeft) {and ContainsMouse(X,Y)} then
  begin
    ButtonDown := true;
    ButtonUp := false;
    if not StartPosValid then
    begin
      FStartX := X;
      FStartY := Y;
      StartPosValid := true;
    end;
  end;
end;

procedure TGUIControl.MouseUp(Sender: TObject; Button: TMouseButtons; Shift: TShiftState; X,Y: Integer);
begin
  if not MouseL then
  begin
    ButtonUp := true;
    ButtonDown := false;
    StartPosValid := false;
    FStartX := -1; FStartY := -1;
    FDeltaX :=  0; FDeltaY :=  0;
  end;
end;

procedure TGUIControl.Paint;
begin
  Canvas.Rectangle(Left,Top,Right,Bottom);


end;

procedure TGUIControl.PaintXY(x, y: Integer);
var R: TRect;
begin
  R := Canvas.ClipRect;
  if FCanMoveControl                      //Wenn CanMoveControl -> true dann 
     then ...					//CanResizeControl -> false und umhekehrt
  else
    if FCanResizeControl then
    begin

      R.Right := R.Right + x;
      R.Bottom := R.Bottom + y;
      Canvas.ClipRect := R;
      Canvas.Rectangle(R.Left,R.Top,R.Right+x,R.Bottom+y);

    end;
end;


Verschieben funktioniert, aber Größe ändern nicht.

Was mache ich falsch?

wp_xyz
Beiträge: 4869
Registriert: Fr 8. Apr 2011, 09:01

Re: Größe lässt sich bei selber geschriebener GUI Klasse nicht ändern. Warum?

Beitrag von wp_xyz »

Warum steht da Canvas.ClipRect? Das ist nicht unbedingt das Rechteck, das das Control umgibt. Nimm doch gleich SetBounds mit entsprechend angepasster Breite und Höhe:

Code: Alles auswählen

      If FCanResizeControl then
        SetBounds(FLeft, FTop, FRight - FLeft + DeltaX, FBottom - FTop + DeltaY)
      else
        ...
[/code}

thosch
Beiträge: 324
Registriert: Mo 10. Jul 2017, 20:32

Re: Größe lässt sich bei selber geschriebener GUI Klasse nicht ändern. Warum?

Beitrag von thosch »

Hey, danke zuerst für den Tipp. So kann ich das bei Lazarus Klassen sicher machen, wenn ich mal in diese Verlegenheit komme.

Hier aber ist das schwierig, weil ich das Canvas Objekt aud FCLImage verwende.

Gibt es daher noch einen anderen Weg der auch da functioniert?

In welcher Unit ist eigentlich diese SetBounds Methode definiert, die Du vorsclägst? Vielleicht kann ich dort die Implementierung abgucken?

wp_xyz
Beiträge: 4869
Registriert: Fr 8. Apr 2011, 09:01

Re: Größe lässt sich bei selber geschriebener GUI Klasse nicht ändern. Warum?

Beitrag von wp_xyz »

SetBounds wird in TControl eingeführt, also ziemlich weit am Anfang der Hierarchie.

Code: Alles auswählen

type
  TControl = class(TLCLComponent)
  public
      procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); virtual;

Antworten