Visit our Sponsor   Visit our Sponsor
delphi3000.com - the free delphi knowledge platform
delphi3000.com - the free delphi knowledge platform
500 Users Online NOW
Have a look at your member-status

connecting people's knowledge


  - Recent ArticlesRSS feed for Recent Articles on delphi3000.com
  - List of All Articles
  - Top Viewed Articles
  - Articles (+Attachem.)
  - Articles Of Interest
  - Categories
  - Top Uploader
  - Search
  - Index

  - My Home
  - Submit an Article
  - My Articles
  - My Personal Data
  - My Bookmarks
  - Activities
  - Login/Logout

  - Sign Up
  - Why Sign Up
  - Newsletter

  - Press
  - Advertise

  - Contact
  - Feedback





Community
Borland
ClubeDelphi
Dr. Bob
UK-BUG
Delphi Meetings
Planeta Delphi



Loremo - the 1.5 liter car coming in 2009




Startblatt.de






Share this article with friendsShare this article with friends
Rate this articleRate this article - to keep the quality of delphi3000.com !
Comment this article or read through previous comments (0)


Moveable/Sizable TPanel with standard or color SizeGripFormat this article printer-friendly!Bookmark function is only available for registered users!
Product:
Delphi 4.x (or higher)
Category:
GUI
Skill Level:
Scoring:
Last Update:
09/26/2001
Search Keys:
delphi delphi3000 article borland vcl code-snippet Panel sizeable drag sizegrip
Times Scored:
6
Visits:
3642
Uploader: Kevin Gallagher
Company:
Reference: N/A
 
Question/Problem/Abstract:
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.





Please rate this article!
Skill level:
BeginnerExpert

Useful:
No!Very!

Overall rating:
PoorExcellent



Comments to this article
Write a new comment













 
Sign up to consume product discounts for Bronze memberships !

read more


  Visit our Sponsor

 

  Community Ad of
L. Rosenstein
 
   














 







     
  Copyright © 2000 - 2007 delphi3000.com - All rights reserved. Terms of use. || Privacy
delphi3000.com is a service by bluestep.com IT-Services GmbH (Vienna)