Permet de 'magnétiser' la fiche par rapport au bords de l'écran. Quan celle ci s'en rapproche et s'y colle automatiquement comme dans les logiciel du genre winamp.
Evite également que le bord opposé à celui qui est magnétisé ne s'éloigne quan on redimmensionne la fiche et qu'on l'approche d'un bord de l'écran.
Source / Exemple :
unit MagnetForm;
interface
uses
SysUtils, Classes, Forms, Messages, Windows;
type
TMagnetMode = (mmMoving, mmSizing);
TMagnetForm = class(TComponent)
private
{ Déclarations privées }
Form: TForm;
FDeltaMagnet: Integer;
// Ancienne procédure de traitement des messages windows
FOldWindowProc: TWndMethod;
// Nouvelle
procedure WindowProc(var Msg: TMessage);
protected
{ Déclarations protégées }
public
{ Déclarations publiques }
MagnetMode: TMagnetMode;
WorkArea: TRect;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Déclarations publiées }
property DeltaMagnet: Integer read FDeltaMagnet write FDeltaMagnet default 10;
end;
procedure Register;
implementation
constructor TMagnetForm.Create;
begin
inherited Create(AOwner);
FDeltaMagnet := 10;
if csDesigning in ComponentState then exit;
// Obtient la zone de travail
SystemParametersInfo(SPI_GETWORKAREA, 0, @WorkArea, 0);
// Récupère la form à magnétiser
if not(AOwner is TForm) then exit;
Form := AOwner as TForm;
// Change sa fonction de réception des messages
FOldWindowProc := Form.WindowProc;
Form.WindowProc := WindowProc;
end;
destructor TMagnetForm.Destroy;
begin
// Restore l'ancienne procédure de gestion des messages
if not (csDesigning in ComponentState) then
Form.WindowProc := FOldWindowProc;
inherited Destroy;
end;
procedure TMagnetForm.WindowProc;
var
OldPos: WindowPos;
begin
case Msg.Msg of
// Sélectionne le mode déplacement
WM_MOVING: MagnetMode := mmMoving;
// Sélectionne le mode redimmensionnement
WM_SIZING: MagnetMode := mmSizing;
// Colle la fenêtre
WM_WINDOWPOSCHANGING:
begin
// Sauvegarde l'ancienne position
OldPos := PWindowPos(Msg.LParam)^;
with PWindowPos(Msg.LParam)^ do
begin
// Si on est proche de bord gauche
if x <= WorkArea.Left + FDeltaMagnet then
begin
// Colle la fenêtre au bord gauche
x := WorkArea.Left;
// Si on est en redimmensionnement,
// s'assure que le bord droit ne bouge pas
if (MagnetMode = mmSizing) and (x + cx <> OldPos.x + OldPos.cx) then
cx := OldPos.x + OldPos.cx - x;
end;
// Pareil avec les autres bord
if x+cx >= WorkArea.Right - FDeltaMagnet then
begin
if (MagnetMode = mmMoving) then
x := WorkArea.Right - cx
else
cx := WorkArea.Right - x;
end;
if y <= WorkArea.Top + FDeltaMagnet then
begin
y := WorkArea.Top;
if (MagnetMode = mmSizing) and (y + cy <> OldPos.y + OldPos.cy) then
cy := OldPos.y + OldPos.cy - y;
end;
if y+cy >= WorkArea.Bottom - FDeltaMagnet then
begin
if (MagnetMode = mmMoving) then
y := WorkArea.Bottom - cy
else
cy := WorkArea.Bottom - y;
end;
end;
end;
end;
FOldWindowProc(Msg);
end;
procedure Register;
begin
RegisterComponents('Mes Composants', [TMagnetForm]);
end;
end.
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.