Mesurer la largeur et la hauteur d?un objet sur le bureau [Résolu]

Question

Mesurer la largeur et la hauteur d?un objet sur le bureau [Résolu]

Signaler

cs_mohammed2020

Messages postés: 17
Date d'inscription: dimanche 11 mai 2008
Statut: Membre
Dernière intervention: 10 février 2015

- 4 sept. 2010 à 01:52
cs_mohammed2020

Messages postés: 17
Date d'inscription: dimanche 11 mai 2008
Statut: Membre
Dernière intervention: 10 février 2015

- 8 sept. 2010 à 20:32

Salut, je suis un débutant et je voudrais mesurer la largeur et la hauteur d'un objet sur le bureau (par exemple la largeur et la hauteur d'une image ou d'une fenêtre?) en utilisant le bouton gauche de la sourie enfoncé et en le relâchent on doit capturer la valeur de la largeur et de la hauteur de c'objet.
Merci d'avance.

A voir également:

12 réponses

Réponse 2 / 12

cs_rt15

Messages postés: 3874
Date d'inscription: mardi 8 mars 2005
Statut: Modérateur
Dernière intervention: 7 novembre 2014

13
7 sept. 2010 à 16:09

Et deuxième form...

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls;

type
  TForm2 = class(TForm)
    Image1: TImage;
    StatusBar1: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    nLeft: Integer;
    nTop: Integer;
    nRight: Integer;
    nBottom: Integer;
    bMouseDown: Boolean;
  public
    { Déclarations publiques }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
  Self.BorderStyle:= bsNone;
  Self.WindowState:= wsMaximized;
  StatusBar1.SimplePanel:= True;
  bMouseDown:= False;
end;

procedure TForm2.FormShow(Sender: TObject);
var
  hDesktopDC: HDC;
  hDesktop: THandle;
begin
  Image1.Picture.Bitmap.Width:= Screen.Width;
  Image1.Picture.Bitmap.Height:= Screen.Height;
  Image1.Width:= Screen.Width;
  Image1.Height:= Screen.Height;
  Image1.Top:= 0;
  image1.Left:= 0;
  hDesktop:= GetDesktopWindow;
  hDesktopDC:= GetDC(hDesktop);
  try
    BitBlt(Image1.Picture.Bitmap.Canvas.Handle,
           0, 0, Screen.Width, Screen.Height,
           hDesktopDC, 0, 0, SrcCopy);
  finally
    ReleaseDC(hDesktop, hDesktopDC);
  end;
end;

procedure TForm2.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if bMouseDown then
  begin
    Canvas.Pen.Mode:= pmNot;
    Canvas.Pen.Width:= 1;
    Canvas.Brush.Style:= bsClear;
    Canvas.Rectangle(nLeft, nTop, nRight, nBottom);
    nRight:= X;
    nBottom:= Y;
    Canvas.Rectangle(nLeft, nTop, nRight, nBottom);
    StatusBar1.SimpleText:= IntToStr(Abs(nRight - nLeft)) + ' ' + IntToStr(Abs(nBottom - nTop));
  end;
end;

procedure TForm2.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  nLeft:= X;
  nTop:= Y;
  nRight:= X;
  nBottom:= Y;
  bMouseDown:= True;
end;

procedure TForm2.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if bMouseDown then
  begin
    bMouseDown:= False;
    Canvas.Pen.Mode:= pmNot;
    Canvas.Brush.Style:= bsClear;
    Canvas.Rectangle(nLeft, nTop, nRight, nBottom);
  end;
end;

end.

Réponse 3 / 12

Caribensila

Messages postés: 2527
Date d'inscription: jeudi 15 janvier 2004
Statut: Membre
Dernière intervention: 16 octobre 2019

16
7 sept. 2010 à 18:52

Autre méthode moins spectaculaire mais aussi efficace

Quand on presse le bouton gauche, la taille des fenêtres survolées par le curseur est affichée dans l'Edit.

-Une Fiche
-Un Edit
-Un Timer ( Timer1.Interval := 50 )

procedure TForm1.Timer1Timer(Sender: TObject);
  var
  	  ScreenPt : TPoint;
          H        : THandle;
          WinRect  : TRect;
begin
  if GetKeyState(VK_LBUTTON) < 0 then begin
  GetCursorPos(ScreenPt);         //On récupère la position du curseur à l'écran.
  H := WindowFromPoint(ScreenPt);//On récupère le handle de la fenêtre survolée.
  GetWindowRect(H, WinRect);    //On récupère la taille de cette fenêtre.
  Edit1.Text := 'Larg= ' +IntToStr(WinRect.Right-WinRect.Left) +
                ' Haut= '+IntToStr(WinRect.Bottom-WinRect.Top);
  end
  else Edit1.Text := '';
end;

Réponse 4 / 12

cs_mohammed2020

Messages postés: 17
Date d'inscription: dimanche 11 mai 2008
Statut: Membre
Dernière intervention: 10 février 2015

5 sept. 2010 à 01:11

Merci de ta réponse mais je veux s'il veut plait la méthode qui est demander dans mon premier message.

Réponse 5 / 12

Caribensila

Messages postés: 2527
Date d'inscription: jeudi 15 janvier 2004
Statut: Membre
Dernière intervention: 16 octobre 2019

16
7 sept. 2010 à 00:47

Salut,

La méthode de ton premier message ne peut pas
mesurer un objet sur le bureau.

Réponse 6 / 12

cs_mohammed2020

Messages postés: 17
Date d'inscription: dimanche 11 mai 2008
Statut: Membre
Dernière intervention: 10 février 2015

7 sept. 2010 à 01:52

Tout simplement je voudrais mesurer la largeur et la hauteur d'une fenêtre sur l'écran
En traçant un rectangle par la sourie(en utilisant le bouton gauche enfoncé) sur les bords de la fenêtre que je voudrais capturée sa largeur et sa hauteur.
Merci

Réponse 7 / 12

cs_rt15

Messages postés: 3874
Date d'inscription: mardi 8 mars 2005
Statut: Modérateur
Dernière intervention: 7 novembre 2014

13
7 sept. 2010 à 12:51

Salut,

Pourquoi pas un hook de souris + GetCursorPos ?

Réponse 8 / 12

Caribensila

Messages postés: 2527
Date d'inscription: jeudi 15 janvier 2004
Statut: Membre
Dernière intervention: 16 octobre 2019

16
7 sept. 2010 à 14:26

« Tout simplement je voudrais mesurer la largeur et la hauteur d'une fenêtre sur l'écran »

A titre d'essai préalable, essaie d'effectuer un click gauche sur le coin supérieur gauche d'une fenêtre quelconque, et de garder le bouton enfoncé jusqu'au coin inférieur droit.

Puis tu reviens nous parler de la hauteur et de la largeur de cette fenêtre...

Réponse 9 / 12

cs_rt15

Messages postés: 3874
Date d'inscription: mardi 8 mars 2005
Statut: Modérateur
Dernière intervention: 7 novembre 2014

13
7 sept. 2010 à 14:30

Ah oui je n'y avais pas penser...

Comme workaround, tu peux faire une impression d'écran et l'afficher sur une form prenant tout l'écran. (Fait dans pas mal de logiciel, y compris probablement dans windows quand il passe l'écran en noir et blanc quand on va l'éteindre)

Réponse 10 / 12

cs_rt15

Messages postés: 3874
Date d'inscription: mardi 8 mars 2005
Statut: Modérateur
Dernière intervention: 7 novembre 2014

13
7 sept. 2010 à 14:31

(Du coup le hook souris n'est plus nécessaire)

Réponse 11 / 12

Caribensila

Messages postés: 2527
Date d'inscription: jeudi 15 janvier 2004
Statut: Membre
Dernière intervention: 16 octobre 2019

16
7 sept. 2010 à 14:37

... Oui.

Ou les APIs qui permettent d'obtenir le handle de fenêtre sous le curseur, et avec ce handle la taille de la fenêtre, etc...

Mais est-ce bien pour un débutant ?

Réponse 12 / 12

cs_mohammed2020

Messages postés: 17
Date d'inscription: dimanche 11 mai 2008
Statut: Membre
Dernière intervention: 10 février 2015

8 sept. 2010 à 20:32

Merci a (rt15) c'est cette méthode que je veux et je remercier aussi tous qui ont répondu a mes messages surtout (Caribensila) a sa méthode qui est aussi pratique et efficace que je peux l'utilisé dans mes applications.

Répondre Posez votre question

cs_rt15 · Accepted Answer · 2010-09-07T16:08:23+0200

2 forms.
Sur la deuxième, une TImage et une TStatusBar.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, Unit2;

type
  TForm1 = class(TForm)
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    procedure WMHotkey(var msg: TWMHotkey); message WM_HOTKEY;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMHotkey(var msg: TWMHotkey);
begin
  Unit2.Form2.Show;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnregisterHotKey(Self.Handle, 1);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  If not RegisterHotkey(Self.Handle, 1, MOD_CONTROL, VK_F1) then
  begin
     ShowMessage('Impossible de créer la hotkey sur ctrl + espace');
     Application.Terminate;
  end;
end;

end.

Votre réponse