Форум: "Начинающим";
Текущий архив: 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.082 c