Mega Code Archive
MoveableSizable TPanel with standard or color SizeGrip
<![CDATA[
Title: Moveable/Sizable TPanel with standard or color SizeGrip
Question: How can I move/resize a TPanel at runtime. Also can I place a sizegrip on the panel and make it a different color then Grey?
Answer:
Many times an application may need to move or resize items on a form. The custom panel presented here provides the ability to move the panel by holding down the left mouse button and dragging the panel to a new location. The size can be adjusted by holding the left mouse button down in the lower right hand corner of the panel as done when resizing a form. There is a property to show/hide the SizeGrip and even change the style of the SizeGrip so that the color can be changed in the event the panel needs to be different then battleship grey. There is two unusual properties FreezeTopAt and FreezeTop which allow you to restrict how far the top can be moved on the parent form. It has been tested with D5 but not D6, see comments inside concerning D6.
unit SizeGripPanel;
{
Description:
This component, a decendent of TPanel provides methods to size and move
the panel by using the mouse. The only restriction for sizing the panel
is that is must be done using the SizeGrip located at the bottom right
part of the panel.
There are two additional events, OnMove and OnSize. Yes you guessed
correct, the are hooked into when a user moves or resizes the panel.
ColoredGrip when True allows the grip to be colored unlike the default
style grip.
Author:
Kevin S. Gallagher
gallaghe@teleport.com
Version
1.0.2
Copyrights:
This is a freeware component. Use at your own risk. You may not sell
or distruibute the component for profit.
Notes:
Originally created in D4, ported to D5.
I am not sure what all needs to change for D6 since I don't have it yet.
It will work as reported from one programmer by hacking some code i.e.
Changing the USES clause and removing the "About" code. There should be
away to make the "About" code work, will fix it once I get D6.
Limitations:
The Grip as is can not assume the color of the panel, for a quick
solution I added the property . For myself it doesn't matter
since I am always using drab grey. If anyone wants to change this, feel
free, just email me the changes.
IF YOU GET THIS TO WORK UNDER D6 SEND ME THE CHANGES PLEASE SO I CAN POST
THE CHANGES.
Revisions
KSG 02.08.01
Added the property "FreezeTop" which when set will not allow vertical
movement of the panel. "FreezeTopAt" control the topmost point the
panel can move too.
KSG 09.10.01
Found flaw in code to set Grip visible, fixed.
Attempted to make work under D6 w/o D6 available.
}
interface
{$IFDEF VER140}
uses
Windows, Messages, Classes, ExtCtrls, Controls, ToolsAPI, DesignIntf,
DesignEditors ;
{$ELSE}
uses
Windows, Messages, Classes, ExtCtrls, Controls, DsgnIntf,Commctrl ;
{$ENDIF}
type
TAbout = class(TPropertyEditor)
public
procedure Edit; override ;
function GetAttributes: TPropertyAttributes; override ;
function GetValue: string; override ;
end;
TSizeGripPanel = class(TPanel)
private
FAbout : TAbout ;
FUseGrip : Boolean ;
FMoving : Boolean ;
FSizing : Boolean ;
FColorGrip: Boolean ;
FOnMove : TNotifyEvent ;
FOnSize : TNotifyEvent ;
FTop : Integer ; { to prevent vertical movement KSG 02.08.01 }
FFreeze : Boolean ;
function GetGripRect: TRect ;
procedure WMExitSizeMove(var Msg: TMessage) ; message WM_EXITSIZEMOVE ;
procedure SetGripColorStyle(Value:Boolean) ;
procedure SetGripVisability(Value:Boolean) ; { KSG 09.10.2001 }
protected
procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST ;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override ;
procedure WMMove(var Message: TWMMove); message WM_MOVE ;
procedure WMSize(var Message: TWMSize); message WM_SIZE ;
procedure Paint; override ;
public
constructor Create(AOwner: TComponent) ; override ;
published
property About : TAbout read FAbout write FAbout ;
property FreezeTopAt: Integer read FTop write FTop ;
property FreezeTop : boolean read FFreeze write FFreeze ;
property ShowGrip : Boolean read FUseGrip write SetGripVisability ;
property ColoredGrip: Boolean read FColorGrip write SetGripColorStyle ;
property OnMove : TNotifyEvent read FOnMove write FOnMove ;
property OnSize : TNotifyEvent read FOnSize write FOnSize ;
end ;
procedure Register;
implementation
uses Dialogs, SysUtils, Graphics ;
procedure TAbout.Edit ;
begin
MessageDlg('SizeMovePanel component v1.0.2'#13'by Kevin S. Gallagher',
mtInformation, [mbOK], 0);
end ;
function TAbout.GetAttributes: TPropertyAttributes ;
begin
Result:= [paMultiSelect, paDialog, paReadOnly] ;
end ;
function TAbout.GetValue: string ;
begin
Result:= '(about)' ;
end ;
constructor TSizeGripPanel.Create(AOwner: TComponent) ;
begin
inherited Create( AOwner ) ;
{ Don't care for a caption at all }
ControlStyle := ControlStyle - [csSetCaption] ;
ShowGrip := True ;
FreezeTop := False ;
FColorGrip := False ;
end ;
procedure TSizeGripPanel.WMExitSizeMove(var Msg: TMessage) ;
begin
inherited ;
if FreezeTop then
Top := FTop ;
Msg.Result := 0 ;
end ;
procedure TSizeGripPanel.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer) ;
const
SC_DRAGMOVE : Longint = $F012 ;
begin
{ Might also want to check for Client alignment too. }
if (Align = alNone) then
begin
FMoving := True ;
ReleaseCapture ;
SendMessage(Handle, WM_SYSCOMMAND, SC_DRAGMOVE, 0) ;
end else
inherited MouseDown(Button, Shift, X, Y) ;
end;
procedure TSizeGripPanel.WMMove(var Message: TWMMove) ;
begin
inherited ;
if FMoving then
begin
FMoving := False ;
Parent.Realign ;
if Assigned(FOnMove) then
FOnMove(Self) ;
end ;
end ;
procedure TSizeGripPanel.WMSize(var Message: TWMSize);
begin
inherited ;
if FSizing then
begin
FSizing := False ;
Parent.Realign ;
if Assigned(FOnSize) then FOnSize(Self) ;
end ;
end ;
function TSizeGripPanel.GetGripRect: TRect;
var
GripWidth: integer ;
GripHeight: integer ;
begin
GripWidth := GetSystemMetrics(SM_CXHSCROLL) ;
GripHeight := GetSystemMetrics(SM_CYVSCROLL) ;
Result := GetClientRect() ;
Result.Left := Result.Right - GripWidth ;
Result.Top := Result.Bottom - GripHeight ;
end;
procedure TSizeGripPanel.WMNCHitTest(var Msg: TWMNCHitTest) ;
var
ScreenPt : TPoint ;
begin
inherited ;
if not (csDesigning in ComponentState) and (Msg.Result = HTCLIENT) then
begin
ScreenPt := ScreenToClient(Point(Msg.Xpos, Msg.Ypos)) ;
if (ScreenPt.x = GetGripRect.Left) and (ScreenPt.y = GetGripRect.Top) then
Msg.Result := HTBOTTOMRIGHT ;
{ Used to trigger OnSize }
with Msg do
if Result in [Windows.HTLEFT..Windows.HTBOTTOMRIGHT] then FSizing := True ;
end;
end;
procedure TSizeGripPanel.Paint ;
var
Rect: TRect ;
begin
inherited Paint ;
if not FUseGrip then
exit ;
Rect := GetGripRect ;
if not FColorGrip then
DrawFrameControl(Canvas.Handle, Rect, DFC_SCROLL, DFCS_SCROLLSIZEGRIP)
else
with Self.Canvas do
begin
Brush.Style := bsClear ;
Font.Name := 'Marlett' ;
Font.Size := 8 ;
Font.Color := clGray ;
TextOut(rect.left, rect.top, 'o') ;
Font.Color := clWhite ;
TextOut(rect.left, rect.top, 'p') ;
end ;
end;
procedure TSizeGripPanel.SetGripColorStyle(Value: Boolean);
begin
if Value FColorGrip then
begin
FColorGrip := Value ;
Repaint ;
end ;
end;
procedure TSizeGripPanel.SetGripVisability(Value: Boolean);
begin
if Value FUseGrip then
begin
FUsegrip := Value ;
Repaint ;
end ;
end;
procedure Register;
begin
RegisterComponents('Samples', [TSizeGripPanel] ) ;
RegisterPropertyEditor(TypeInfo(TAbout), TSizeGripPanel, 'ABOUT', TAbout) ;
end;
end.
]]>