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

Messages postés
17
Date d'inscription
dimanche 11 mai 2008
Statut
Membre
Dernière intervention
10 février 2015
- - Dernière réponse : cs_mohammed2020
Messages postés
17
Date d'inscription
dimanche 11 mai 2008
Statut
Membre
Dernière intervention
10 février 2015
- 24 nov. 2009 à 18:50
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.
Afficher la suite 

7 réponses

Messages postés
2527
Date d'inscription
jeudi 15 janvier 2004
Statut
Membre
Dernière intervention
16 octobre 2019
13
0
Merci
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.
Commenter la réponse de Caribensila
Messages postés
17
Date d'inscription
dimanche 11 mai 2008
Statut
Membre
Dernière intervention
10 février 2015
0
Merci
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.
Commenter la réponse de cs_mohammed2020
Messages postés
2527
Date d'inscription
jeudi 15 janvier 2004
Statut
Membre
Dernière intervention
16 octobre 2019
13
0
Merci
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.
Commenter la réponse de Caribensila
Messages postés
637
Date d'inscription
dimanche 13 août 2006
Statut
Membre
Dernière intervention
13 décembre 2018
2
0
Merci
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
Commenter la réponse de cs_Jean_Jean
Messages postés
17
Date d'inscription
dimanche 11 mai 2008
Statut
Membre
Dernière intervention
10 février 2015
0
Merci
Salut caribensila,
Je viens de recevoir ton message et je suis très heureux de votre réponse, et merci beaucoup.
Commenter la réponse de cs_mohammed2020
Messages postés
637
Date d'inscription
dimanche 13 août 2006
Statut
Membre
Dernière intervention
13 décembre 2018
2
0
Merci
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
Commenter la réponse de cs_Jean_Jean
Messages postés
17
Date d'inscription
dimanche 11 mai 2008
Statut
Membre
Dernière intervention
10 février 2015
0
Merci
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.
Commenter la réponse de cs_mohammed2020