Fiche magnétique

Télécharger le projet
Commenter

Description

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.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (Steckerman)