mesurer la largeur et la hauteur d'une sélection

Question

Salut,je veux mesurer la langueur et la hauteur d'une sélection d'un rectangle crée par le déplacement de la sourie sur le bureau, et ca mesure doit être afficher sur deux labels sur une fenêtre(Form) par exemple:
Longueur : ...
Largeur  : ... 
Qu'il est le code de cette fonction s'il veut plait
Merci d'avance.

Caribensila · Answer

Enfin...    Un poète !
Je prends ma lyre, je revêts ma jolie tunique et ma petite jupette blanches (Hiiii! 'fait pas chaud la-dessous ! Hu-hu-hu) et je réponds prestement :

[i]Quelle est cette langueur
Qui pénètre mon coeur ?
[ ]
C'est bien la pire peine
De ne savoir pourquoi
Sans amour et sans haine
Mon coeur a tant de peine !/i

PS: [GROSSE VOIX] Par respect pour toi-même et pour ceux qui te lisent, donne-toi la peine de te relire avant de poster ! Ca évitera les conneries.

cs_mohammed2020 · Answer

slt,je m'excuse d'erreur qui est posté sur mon message(mohammed2020) je veut dire la largeur et pas la langueur c'est un simple erreur pour un débutant et merci.
Message corrigé:
Je veux mesurer la largeur(Width) et la hauteur(Height) d'une sélection d'un rectangle crée par le déplacement de la sourie sur le bureau, et ça mesure doit être afficher sur deux labels sur une fenêtre(Form) par exemple:
Longueur : ...
Largeur  : ... 
Qu'il est le code de cette fonction s'il veut plait
Merci d'avance.

Caribensila · Answer

Je te propose deux méthodes, avec et sans API.
Leur comportement est un peu différent. A toi de découvrir et de choisir celle qui te convient le mieux.

Pour tester, une Form avec 2 TImage et 2 TLabel et ce code :

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    Label1: TLabel;
    Label2: TLabel;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  end;

var
  Form1     : TForm1;
  PtDepart  : TPoint;
  PtArrivee : TPoint;

implementation
{$R *.dfm}


////// Sélection avec API Windows sur Image1///////

Procedure DessineRectangleAPI;
  var     HandleDCForm : HDC;
  begin
  HandleDCForm := GetDC(Form1.Handle);
  DrawFocusRect(HandleDCForm, rect(PtDepart.X,PtDepart.Y,PtArrivee.x,PtArrivee.Y));
  ReleaseDC(Form1.Handle,HandleDCForm);
  Form1.Label1.Caption := 'Largeur := ' + IntToStr(Abs(PtArrivee.x - PtDepart.X));
  Form1.Label2.Caption := 'Hauteur := ' + IntToStr(Abs(PtArrivee.Y - PtDepart.Y));
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
 begin
  if Button=mbLeft then begin
    PtDepart:=Form1.ScreenToClient(Image1.ClientToScreen(Point(X,Y)));
    PtArrivee:=PtDepart;
    DessineRectangleAPI;
  end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
  begin
  if (ssLeft in Shift)  then begin
    DessineRectangleAPI;
    PtArrivee:=Form1.ScreenToClient(Image1.ClientToScreen(Point(X,Y)));
    DessineRectangleAPI;
  end;
end;


////// Sélection sans API Windows sur Image2///////

Procedure DessineRectangle;
  begin
    Form1.Image2.canvas.Pen.Width  := 1;
    Form1.Image2.canvas.Pen.Style  :=psSolid;
    Form1.Image2.canvas.Pen.Color  :=clBlue;
    Form1.Image2.canvas.Pen.Mode   := pmNotXor;
    Form1.Image2.canvas.Pen.Style  :=psDot;
    Form1.Image2.canvas.Brush.Style:=bsCross;
    Form1.Image2.canvas.Rectangle(PtDepart.x,PtDepart.y,PtArrivee.x,PtArrivee.y);
    Form1.Label1.Caption := 'Largeur := ' + IntToStr(Abs(PtArrivee.x - PtDepart.x));
    Form1.Label2.Caption := 'Hauteur := ' + IntToStr(Abs(PtArrivee.y - PtDepart.y));
end;

procedure TForm1.Image2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  begin
  if Button=mbLeft then begin
    PtDepart:=Point(X,Y);
    PtArrivee:=PtDepart;
  end;
end;

procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
  begin
  if (ssLeft in Shift)  then begin
    DessineRectangle;
    PtArrivee:=Point(X,Y);
    DessineRectangle;
  end;
end;

END.

cs_Jean_Jean · Answer

Salut cari,
  je tombe sur ton message en rapport sans rapport avec la poésie, mais bien avec le sujet qui semblait préoccuper mohammed2020.

Est-il parti aux caraibes sans nous dire au revoir? 
Bon en tout cas, je te dit merci pour lui et moi, car ton code répond bien à mon besoin et des besoins pédagogiques toujours précieux aux poetes comme moi qui ont souvent la tête dans les étoiles neuroniques.

Bien à toi
Jean_Jean

cs_mohammed2020 · Answer

Salut caribensila,
Je viens de recevoir ton message et je suis très heureux de votre réponse, et merci beaucoup.

cs_Jean_Jean · Answer

Bj Mohammed!

Bah, t'es nouveau sur ce forum!
En général, on obtient assez rapidement des éclairages, surtout quand il y a des retours!
Quand une réponse te convient, tu peux valider sur le carré de gauche "valider votre réponse".
Beaucoup d'utilisateurs ne le font pas, mais ça aide pourtant la communauté des Delphistes.
En effet lors de recherches par mots clés, on peut ainsi se limiter à consulter des questions qui ont trouvé une réponse satisfaisante.
Bienvenu!
Jean_Jean

cs_mohammed2020 · Answer

Salut Cari,
J'ai reçu ton message et je suis très content de votre réponse, mais ce que je veux c'est de mesurer la largeur et la hauteur d'une sélection qui soit crée directement sur le bureau par déplacement de la sourie et non sur une image, et
la sélection doit être disparaître après le relâchement du bouton(gauche) de la sourie, le but c'est seulement de capturer la largeur et la hauteur d'une sélection sur le bureau et rien d'autre.
Merci pour votre aide.

Mesurer la largeur et la hauteur d'une sélection

7 réponses

Votre réponse

Discussions similaires