Форум: "Начинающим";
Текущий архив: 2010.08.27;
Скачать: [xml.tar.bz2];

Вниз

panel + statusbar(SizeGrip)   Найти похожие ветки 

← →
Mishka   (2010-05-29 21:24) [0]

Добрый вечер.

На форме расположен TPanel на нём TStatusBar. Как можно заставить TStatusBar менять размер панели, как это происходит с формой если на неё поместить TStatusBar?

---

← →
Leonid Troyanovsky ©   (2010-05-30 07:50) [1]

> Mishka   (29.05.10 21:24)  


> How to make TPanel like component that can be resized by grip in lower right
> corner (just the grip the TStatusBar has)? Thanks for any points.
>

Try this one. It may need some refinement in painting the grip.

unit SizeablePanel;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 ExtCtrls;

type
 TSizeablePanel = class(TPanel)
 private
   FDragging: Boolean;
   FLastPos: TPoint;
 protected
   Procedure Paint; override;
   Procedure MouseDown( Button: TMouseButton; Shift: TShiftState;
                        X, Y: Integer ); override;
   Procedure MouseMove( Shift: TShiftState; X, Y: Integer ); override;
   Procedure MouseUp( Button: TMouseButton; Shift: TShiftState;
                      X, Y: Integer ); override;
 public
   { Public declarations }
 published
   { Published declarations }
 end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents("PBGoodies", [TSizeablePanel]);
end;

procedure TSizeablePanel.MouseDown(Button: TMouseButton; Shift: TShiftState;
X,
 Y: Integer);
begin
 If (Button = mbLeft) and
    ((Width - x ) < 10) and
    ((Height - y ) < 10)
 Then Begin
   FDragging := TRue;
   FLastPos := Point( x, y );
   MouseCapture := true;
   Screen.cursor := crSizeNWSE;
 End
 Else
   inherited;
end;

procedure TSizeablePanel.MouseMove(Shift: TShiftState; X, Y: Integer);
var
 r: TRect;
begin
 If FDragging Then Begin
   r:= BoundsRect;
   SetBounds( r.left, r.top,
              r.right - r.left + X - FlastPos.X,
              r.bottom - r.top + Y - Flastpos.Y );
   FLastPos := Point( x, y );
 End
 Else Begin
   inherited;
   If ((Width - x ) < 10) and ((Height - y ) < 10) Then
     Cursor := crSizeNWSE
   Else
     Cursor := crDefault;  

 End;
end;

procedure TSizeablePanel.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
 Y: Integer);
begin
 If FDragging Then Begin
   FDragging := False;
   MouseCapture := false;
   Screen.Cursor := crDefault;
 End
 Else
   inherited;
end;

procedure TSizeablePanel.Paint;
var
 x, y: Integer;
begin
 inherited;
 Canvas.Font.Name := "Marlett";
 Canvas.Font.Size := 10;
 Canvas.Brush.Style := bsClear;
 x:= clientwidth - canvas.textwidth("o");
 y:= clientheight - canvas.textheight("o");
 canvas.textout( x, y, "o" );
end;

end.

Peter Below (TeamB)  100113.1101@compuserve.com)

--
Regards, LVT.

---

← →
Mishka   (2010-05-30 09:56) [2]

Leonid Troyanovsky, спасибо

---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2010.08.27;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.45 MB
Время: 0.058 c