Panel déplaçable et redimensionnable

Soyez le premier à donner votre avis sur cette source.

Vue 5 191 fois - Téléchargée 435 fois

Description

Panel déplaçable et redimensionnable.

J'ai fait ce composant car il va me servir pour un autre composant. C'est donc un étape mais ça peut intéresser des gens alors je poste le composant.

Source / Exemple :


mponent of WinEssential project (http://php4php.free.fr/winessential/)
 *

  • This program is free software; you can redistribute it and/or modify it under
  • the terms of the GNU General Public License as published by the Free Software
  • Foundation; either version 2 of the License, or (at your option) any later
  • version.
*
  • This program is distributed in the hope that it will be useful, but WITHOUT
  • ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  • FOR A PARTICULAR PURPOSE.See the GNU LESSER GENERAL PUBLIC LICENSE for more
  • details.
*
  • You should have received a copy of the GNU LESSER GENERAL PUBLIC LICENSE along
  • with this program; if not, write to the Free Software Foundation, Inc., 59
  • Temple Place, Suite 330, Boston, MA 02111-1307 USA.
*
  • Version 1.0 by MARTINEAU Emeric (php4php.free.fr) - 20/01/2008
                                                                                                                                                            • }
interface uses Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, Forms; type TMovableAndResisablePanel = class(TPanel) private { Déclarations privées } protected { Déclarations protégées } { Taille en pixel pour faire apparaitre le curseur de redimensionnement oblique } FSizeBorderOfObliqueArrow : Integer ; { Indique si la hauteur peut être redimenssionnée } FHeightResizable : Boolean ; { Indique si la largeur peur être redimensionnée } FWidthResizable : Boolean ; { Mémorise le curseur d'origine } FOriginalCursor : TCursor ; { Indique si le composant est déplaçable } FMovable : Boolean ; { Indique le hauteur minimum } FMinimumHeight : Integer ; { Indique le hauteur minimum } FMinimumWidth : Integer ; { Indique où est le curseur } Nord, Sud, Est, West : boolean ; NordEst, NordWest, SudEst, SudWest : boolean ; procedure GetCursorPosition(X, Y : Integer; var Nord, Sud, Est, West, NordEst, NordWest, SudEst, SudWest : boolean) ; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure SetDefaultCursor(NewCursor : TCursor) ; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override ; procedure SetMovable(value : boolean) ; public constructor Create(Owner:TComponent); override; destructor Destroy; override; property DockManager; published property Align; property Alignment; property Anchors; property AutoSize; property BevelInner; property BevelOuter; property BevelWidth; property BiDiMode; property BorderWidth; property BorderStyle; property Caption; property Color; property Constraints; property Ctl3D; property UseDockManager default True; property DockSite; property DragCursor; property DragKind; property DragMode; property Enabled; property FullRepaint; property Font; property Locked; property ParentBiDiMode; property ParentColor; property ParentCtl3D; property ParentFont; property ParentShowHint; property PopupMenu; property ShowHint; property TabOrder; property TabStop; property Visible; property OnCanResize; property OnClick; property OnConstrainedResize; property OnContextPopup; property OnDockDrop; property OnDockOver; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEndDock; property OnEndDrag; property OnEnter; property OnExit; property OnGetSiteInfo; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnResize; property OnStartDock; property OnStartDrag; property OnUnDock; // property SizeBorderOfObliqueArrow : Integer read FSizeBorderOfObliqueArrow write FSizeBorderOfObliqueArrow default 5 ; property HeightResizable : Boolean read FHeightResizable write FHeightResizable default true ; property WidthResizable : Boolean read FWidthResizable write FWidthResizable default true ; property Cursor : TCursor read FOriginalCursor write SetDefaultCursor default crDefault ; property Movable : Boolean read FMovable write SetMovable default true ; property MinimumHeight : Integer read FMinimumHeight write FMinimumHeight default 2 ; property MinimumWidth : Integer read FMinimumWidth write FMinimumWidth default 2 ; end; procedure Register; implementation {*******************************************************************************
  • Constructeur
                                                                                                                                                            • }
constructor TMovableAndResisablePanel.Create(Owner:TComponent); begin inherited ; FSizeBorderOfObliqueArrow := 5 ; FHeightResizable := True ; FWidthResizable := True ; FOriginalCursor := crDefault ; FMinimumWidth := 2 ; FMinimumHeight := 2 ; FMovable := True ; end ; {*******************************************************************************
  • Destructeur
                                                                                                                                                            • }
destructor TMovableAndResisablePanel.Destroy; begin // instruction avant inherited; end; {*******************************************************************************
  • Définit le curseur par défaut
                                                                                                                                                            • }
procedure TMovableAndResisablePanel.SetDefaultCursor(NewCursor : TCursor) ; begin FOriginalCursor := NewCursor ; inherited Cursor := NewCursor ; end ; {*******************************************************************************
  • procedure qui indique la position du cursor sur la bordure
                                                                                                                                                            • }
procedure TMovableAndResisablePanel.GetCursorPosition(X, Y : Integer; var Nord, Sud, Est, West, NordEst, NordWest, SudEst, SudWest : boolean) ; begin Nord := (Y = 0) ; Sud := (Y = (Self.ClientHeight - 1)); Est := (X = (Self.ClientWidth - 1)) ; West := (X = 0) ; NordEst := (Nord and (X > (Self.ClientWidth - 1 - SizeBorderOfObliqueArrow)) or (Est and (Y < SizeBorderOfObliqueArrow))) ; NordWest := (Nord and (X < SizeBorderOfObliqueArrow)) or (West and (Y < SizeBorderOfObliqueArrow)) ; SudEst := (Est and ((Y > (Self.ClientHeight - 1 - SizeBorderOfObliqueArrow)))) or (Sud and (X > (Self.ClientWidth - 1 - SizeBorderOfObliqueArrow))) ; SudWest := (West and (Y > (Self.ClientHeight - 1 - SizeBorderOfObliqueArrow))) or (Sud and (X < SizeBorderOfObliqueArrow)) ; end ; {*******************************************************************************
  • Définit si le control est déplaçable
                                                                                                                                                            • }
procedure TMovableAndResisablePanel.SetMovable(value : boolean) ; begin FMovable := Value ; if Value then Self.Cursor := crSizeAll else Self.Cursor := FOriginalCursor ; end ; {*******************************************************************************
  • Procédure appelé lorsqu'on passe la souris sur le contrôle.
  • Se charge d'afficher les curseurs qui vont bien.
                                                                                                                                                            • }
procedure TMovableAndResisablePanel.MouseMove(Shift: TShiftState; X, Y: Integer); var P : Tpoint ; NewTop : Integer ; NewHeight : Integer ; NewLeft : Integer ; NewWidth : Integer ; begin GetCursorPos(P) ; inherited ; { On rafraicit la position du curseur que si on ne clique pas car sinon, si on clique et qu'on déplace on va être hors du panel et donc toutes les variable de direction seront à false } if not (ssLeft in Shift) then GetCursorPosition(X, Y, Nord, Sud, Est, West, NordEst, NordWest, SudEst, SudWest) ; { Désactive le curseur si on ne peut pas redimensionner la hauteur } if not FHeightResizable then begin Nord := False ; Sud := False ; end ; { Désactive le curseur si on ne peut pas redimensionner la largeur } if not FWidthResizable then begin Est := False ; West := False ; end ; { Désactive les cuseurs obliques si on ne peut pas redimenssionner en hauteur } if not (FHeightResizable and FWidthResizable) and (NordEst or NordWest or SudEst or SudWest) then begin NordEst := False ; NordWest := False ; SudEst := False ; SudWest := False ; end ; { Désactive les curseurs pour l'affichage des curseurs obliques } if NordEst or NordWest then begin Nord := False ; end ; if SudEst or SudWest then begin Sud := False ; end ; if NordEst or SudEst then begin Est := False ; end ; if SudWest or NordWest then begin West := False ; end ; NewTop := Self.Top ; NewHeight := Self.Height ; NewLeft := Self.Left ; NewWidth := Self.Width ; { -1 car le premier point est 0 et non 1 } if (Nord or Sud) then begin inherited Cursor := crSizeNS ; if ssLeft in Shift then begin if Nord then begin NewTop := Self.Top - (Self.ClientOrigin.Y - P.Y) ; if NewTop >= 0 then NewHeight := Self.Top - NewTop + Self.Height ; end else begin NewHeight := P.Y - Self.ClientOrigin.Y ; end ; end ; end else if (Est or West) then begin inherited Cursor := crSizeWE ; if ssLeft in Shift then begin if West then begin NewLeft := Self.Left - (Self.ClientOrigin.X - P.X) ; if P.X > (Parent.Left + ((Parent.Width - Parent.ClientWidth) div 2)) then NewWidth := Self.Width - (P.X - Self.ClientOrigin.X) ; end else begin NewWidth := P.X - Self.ClientOrigin.X ; end ; end ; end else if NordEst or SudWest then begin inherited Cursor := crSizeNESW ; if ssLeft in Shift then begin if NordEst then begin NewTop := Self.Top - (Self.ClientOrigin.Y - P.Y) ; if NewTop >= 0 then NewHeight := Self.Top - NewTop + Self.Height ; NewWidth := P.X - Self.ClientOrigin.X ; end else begin NewHeight := P.Y - Self.ClientOrigin.Y ; NewLeft := Self.Left - (Self.ClientOrigin.X - P.X) ; if P.X > (Parent.Left + ((Parent.Width - Parent.ClientWidth) div 2)) then NewWidth := Self.Width - (P.X - Self.ClientOrigin.X) ; end; end ; end else if NordWest or SudEst then begin inherited Cursor := crSizeNWSE ; if ssLeft in Shift then begin if NordWest then begin NewTop := Self.Top - (Self.ClientOrigin.Y - P.Y) ; if NewTop >= 0 then NewHeight := Self.Top - NewTop + Self.Height ; NewLeft := Self.Left - (Self.ClientOrigin.X - P.X) ; if P.X > (Parent.Left + ((Parent.Width - Parent.ClientWidth) div 2)) then NewWidth := Self.Width - (P.X - Self.ClientOrigin.X) ; end else begin NewHeight := P.Y - Self.ClientOrigin.Y ; NewWidth := P.X - Self.ClientOrigin.X ; end ; end ; end else begin if FMovable then Cursor := crSizeAll else inherited Cursor := FOriginalCursor ; end ; if (NewTop >= 0) and (NewTop <= Self.Top + Self.Height) and (NewTop < Self.Top + Self.Height - FMinimumHeight) then Self.Top := NewTop ; if Assigned(Parent) then if (Parent.ClientHeight >= NewHeight + Self.Top) and (NewHeight >= FMinimumHeight) then Self.Height := NewHeight ; if Assigned(Parent) then if (NewLeft > 0) and (NewLeft + Self.Width < Parent.ClientWidth) and (NewLeft < (Self.Left + Self.Width - FMinimumWidth)) then Self.Left := NewLeft ; if Assigned(Parent) then if (NewWidth <= Parent.ClientWidth - Self.Left) and (NewWidth >= FMinimumWidth) then Self.Width := NewWidth ; end; {*******************************************************************************
  • Procédure appelé lorsqu'on clique sur le contrôle.
                                                                                                                                                            • }
procedure TMovableAndResisablePanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var Action: Integer; Msg: TMessage; P : TPoint ; begin { Si on est sur la bordure et qu'on clique, cette fonction est appelée et le controle est déplacé alors qu'on veut qu'il soit redimensionné } if not (Nord or Sud or Est or West or NordEst or NordWest or SudEst or SudWest) then begin inherited; if FMovable then begin Action := HTCAPTION; Msg.Msg := WM_NCLBUTTONDOWN; Msg.WParam := Action; SetCaptureControl(nil); SendMessage(Self.Handle, Msg.Msg, Msg.wParam, Msg.lParam) ; end ; end ; end; procedure Register; begin RegisterComponents('WinEssential', [TMovableAndResisablePanel]); end; end.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Toya78
Messages postés
49
Date d'inscription
vendredi 1 septembre 2006
Statut
Membre
Dernière intervention
23 août 2008
-
Hello

Justement j'utilisais le composant cyResizer (source dispo sur delphiFR) mais le truc embetant c'est que pour déplacer le cyResizer ET le contrôle qu'il contient il fallait faire :

(exemple avec un TPanel)
cyResizer1.Control := nil;
Panel1.Left := Panel1.Left + 20;
cyResizer1.Control := Panel1;

Ton compo pourrait donc me satisfaire mais un petit détail m'embête un peu : quand on veut placer la souris sur les bords (pour le redimensionner) c'est pas facile : il n'y a qu'une épaisser de 1 pixel pour que le curseur de redimensionnement apparaisse. Une épaisseur de 5 pixels (1 pour la bordure, 2 à l'intérieur du composant, et 2 à l'extérieur) aurait été plus sympa :)

Et un peu détail supplémentaire (là je pousse un peu plus loin :p) aurait été de mettre des 'carrés' de sélection autour du composant (comme le cyResizer).

Sinon bon boulot, le composant se déplace et se redimensionne le plus simplement du monde :)
bubulemaster
Messages postés
22
Date d'inscription
jeudi 1 avril 2004
Statut
Membre
Dernière intervention
22 mars 2010
-
Bonjour,

pour le pixel de sélection, je sais c'est un "gros" défaut. Je n'ai pas trouvé de paliatif.

Pour ce qui est des carrés pour redimenssionner, j'ai fait un composant pour ça http://www.delphifr.com/codes/BOUTON-EVOLE-COMPOSANT-POUR-DEPLACER-REDIMENSSIONNER-IMPORTE-QUELS_44066.aspx

Bon codage.
cs_MAURICIO
Messages postés
2233
Date d'inscription
mardi 10 décembre 2002
Statut
Modérateur
Dernière intervention
15 décembre 2014
5 -
Bonjour,

je vous invite à faire le download de mon pack de compos gratuits V2.03 qui contient une nouvelle version de mon TcyResizer. Il existe une démo qui contient le source et l' exe pour pouvoir tester avant d' installer.

Il est désormais possible de contrôler plusieurs compos en même temps avec 3 lignes de code, très simple à utiliser!!!

Site:
https://sourceforge.net/projects/tcycomponents/

A+
Commenter la réponse de Toya78

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.