25 - LOUPE

Le petit coin du web de Nono40

http://nono40.developpez.com

SOURCES

25 - LOUPE

PRÉSENTATION : Petite fenêtre effectuant un zoom d'une partie de l'écran.

ZIP : Téléchargez le zip

APERÇUS : -1.jpg-

NOTES : C'est en cherchant autour du source précédent ( obtenir la couleur d'un point de l'écran ) que j'ai vu la fonction API StretchBlt. Je me suis dit qu'en une ligne on pouvait copier et agrandir une partie de l'écran : donc faire une loupe toute simple !

Utilisation :
La loupe se place par défaut en haut à droite de l'écran. Pour la déplacer il suffit de cliquer dessus et de la faire glisser là ou vous voulez. Pour fermer la loupe il faut faire un clic droit dessus. La loupe reste active même quand vous travaillez sur une autre application.

CODE :

Unit Unit1;

Interface

Uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus;

Type
  TForm1 = Class(TForm)
    Timer1: TTimer;
    Panel1: TPanel;
    PaintBox1: TPaintBox;
    Procedure Timer1Timer(Sender: TObject);
    Procedure FormCreate(Sender: TObject);
    Procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    Procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  Private
    { Déclarations privées }
  Public
    { Déclarations publiques }
  End;

Var
  Form1: TForm1;

Implementation

{$R *.dfm}

// Valeur de zoom de la loupe
Const Zoom=3;

Procedure TForm1.Timer1Timer(Sender: TObject);
Var Dc : HDC;
    x,y: Integer;
Begin
  // Création d'un contexte d'affichage non lié à une fenêtre
  // donc permet d'accéder à l'écran entier
  DC := CreateDC('DISPLAY',Nil,Nil,Nil);
  With PaintBox1 Do Try
    // prise du point de référence de la souris
    x:=Mouse.CursorPos.X;
    y:=Mouse.CursorPos.Y;
    // limitations de la zone pour ne pas sortir de l'écran
    If x>=(Screen.Width -ClientWidth  Div Zoom) Then x:=(Screen.Width -ClientWidth  Div Zoom)-1;
    If y>=(Screen.Height-ClientHeight Div Zoom) Then y:=(Screen.Height-ClientHeight Div Zoom)-1;
    // Copie d'une partie de l'écran dans la boite à peindre
    StretchBlt(paintbox1.canvas.Handle // Copie vers le canevas de la boite
               ,0                      //       vers X=0
               ,0                      //       et   Y=0
               ,(ClientWidth *zoom)-1  // en multipliant par Zoom la largeur
               ,(ClientHeight*zoom)-1  // en multipliant par Zoom la hauteur
               ,DC                     // Copie à partir du canevas global
               ,x                      //       de la position de la souris
               ,y                      //       ...
               ,ClientWidth            //       sur la taille de la boite
               ,ClientHeight           //
               ,SRCCOPY);              // Simple copie sans autre effet.
  Finally
    // ne pas ouvbier de libérer le contexte, c'est une ressource rare.
    DeleteDc(DC);
  End;
  // Mettre la fenêtre au premier plan
  Show;
End;

Procedure TForm1.FormCreate(Sender: TObject);
Begin
  // Par défaut la loupe est en haut à droite
  Top  :=20;
  Left :=Screen.Width-Width-20;

  Application.Title:='Loupe';
End;

Procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
Begin
  // Astuce pour déplacer facilement un WinControl ou descendant
  // ( Merci à DelphiProg qui l'a donnée dans le forum il y a un bout de temps...)
  If Button=mbLeft
  Then Begin
    ReleaseCapture;
    perform(WM_SYSCOMMAND, $F012, 0);
  End;
End;

Procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
Begin
  // Femeture de la fenêtre sur un click droit.
  If Button=mbRight Then Close;
End;

End.

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2003 Bruno Guérangé. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.