Discussion :

[cincap]

Bonjour à toutes et à tous,

J'ai un cadre de couleur rouge sur bitmap qui fonctionne correctement et serait t'il possible en gardant ce code de le modifier pour pouvoir régler la hauteur/largeur dès que le cadre est créé ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 
 
var
  MYBMP : TBitmap;
  Xi, Yi : integer;
  XPred, YPred : integer;
  //Zone rectangulaire de sélection
  MyRect : TRect;
  ZoneSelected : boolean = false;
  MoveZoneSelected : boolean = false;
 
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
//On mémorise les coordonnées du pixel sélectionné
Xi := X;
Yi := Y;
//Si une zone est sélectionnée et que le curseur se trouve à l'intérieur
IF (ZoneSelected) AND (X > MyRect.Left) AND (X < MyRect.Right) AND (Y > MyRect.Top) AND (Y < MyRect.Bottom) THEN begin
   //On prépare un déplacement de la zone sélectionnée
   MoveZoneSelected := true ;
   Benregistrer.Enabled := true
   end
ELSE
   //Sinon on efface la précédente zone sélectionnée pour une nouvelle sélection
   BEGIN
   Image1.Canvas.CopyRect(MyRect, MYBMP.Canvas, MyRect);
   Image1.canvas.Brush.Color:=clred;
   MoveZoneSelected := false;
   Benregistrer.Enabled := false;
   END;
end;

En vous remerciant, car j'essaye depuis un moment !

@+,

cincap

[ShaiLeTroll]

Ce n'est pas bien clair, là tu dessines, tu es donc libre de faire tout ce que tu veux
Faudrait voir si un TShape transparent, voir même un panel transparent (plus vicieux en D6 sans ParentBackground faut redéfinir Paint) ne ferait pas un meilleur système de cadre déplaçable, c'est le même principe que transformer un panel en splitter, j'ai même un code à ce sujet.

Par définition, ce genre de sélection c'est clic à un point, déplacement de la souris par l'utilisateur pour définir sa zone de sélection, j'imagine un truc comme paint, et comme tu bosses beaucoup sur la musique\vidéo, je suppose à un sélecteur d'un fragment d'un média.
A toi lors du OnMouseMove de changer le curseur déjà pour montrer le curseur permettant d'agrandir la sélection avec disons quelques pixels de tolérance (sauf quand la zone est toute petite) et lorsque le curseur est plutôt vers le centre, mettre un curseur main montrant que l'on peut faire un glisser.

[Paul TOTH]

quelque chose de cet ordre ?

http://tothpaul.free.fr/sources.php?dprgrp.metadraw

[cincap]

@ ShaiLeTroll, merci de ta suggestion, pour le moment avec mon code je charge un Bitmap et je dessine un cadre rouge que je peus déplacer et ensuite sauver la partie qui est dedans en .bmp ou .jpg.

@ Paul Toth, merci aussi pour ton exemple c'est bien cela qu'il me faudrait car le cadre est créé et ensuite on peut l'ajuster.

Je vais essayer de m'en inspirer en chargeant un bitmap, je vous tiendrai au courant.

Encore merci.

@+,

cincap

[ShaiLeTroll]

En même temps mes propositions ne sont pas en contradiction avec le Designer intégré que tu imaginais

Un logiciel de supervision avait un mode Design de Plan de bâtiment, à base de Shape et Image pour placer les détecteurs et contacts tel qu'ils sont placé et définir des zones, ainsi en mode surveillance cela affichait le plan, le colorait, faisait clignoter l'élément en évènement, le mode Design ressemblait ni plus ni mois à l'IDE Delphi simplifié qui utilise un TContainer pour rendre déplaçable les objets et TGrabHandle pour créer les poignées autour de l'objet.

Vite fait avec un Cursor, je l'ai écrit en D10 et rendu compatible D7 perso, si tu arrives à modifier pour gérer les diagonales, tu n'auras plus qu'à ajouter le dessin des poignées d'angle, rien de bien difficile

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
unit GrabHandleMainForm;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, ExtCtrls;
 
 
type
  TGrapSide = (gsNone, gsTop, gsLeft, gsBottom, gsRight);
  TGrab = class(TObject)
  private
    FRect: TRect;
    FDown: Boolean;
    FSide: TGrapSide;
  public
    constructor Create();
 
    function EstimateSide(const P: TPoint; E: Integer): TGrapSide;
 
    property SelectionRect: TRect read FRect;
    property SelectionTopLeft: TPoint read FRect.TopLeft write FRect.TopLeft;
    property SelectionBottomRight: TPoint read FRect.BottomRight write FRect.BottomRight;
    property SelectionLeft: Integer read FRect.Left write FRect.Left;
    property SelectionRight: Integer read FRect.Right write FRect.Right;
    property SelectionTop: Integer read FRect.Top write FRect.Top;
    property SelectionBottom: Integer read FRect.Bottom write FRect.Bottom;
    property Down: Boolean read FDown write FDown;
    property Side: TGrapSide read FSide write FSide;
  end;
 
type
  TForm1 = class(TForm)
    PaintBoxImage: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PaintBoxImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PaintBoxImageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PaintBoxImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure PaintBoxImagePaint(Sender: TObject);
  public
    { Déclarations publiques }
    FGrab: TGrab;
    FBitmap: TBitmap;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  FGrab := TGrab.Create();
 
  FBitmap := TBitmap.Create();
  FBitmap.LoadFromFile('SPAM.BMP');
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FBitmap);
  FreeAndNil(FGrab);
end;
 
procedure TForm1.PaintBoxImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (FGrab.SelectionTopLeft.X >= 0) and (FGrab.SelectionTopLeft.Y >= 0) then
  begin
    FGrab.Side := FGrab.EstimateSide(Point(X, Y), 1);
    PaintBoxImage.Cursor := crHandPoint;
  end
  else
  begin
    FGrab.Down := True;
    FGrab.SelectionTopLeft := Point(X, Y);
   end;
end;
 
procedure TForm1.PaintBoxImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if (FGrab.SelectionTopLeft.X >= 0) and (FGrab.SelectionTopLeft.Y >= 0) then
  begin
    if FGrab.Down then
    begin
      FGrab.SelectionBottomRight := Point(X, Y);
      PaintBoxImage.Invalidate;
    end
    else
    begin
      if FGrab.Side = gsNone then
      begin
        case FGrab.EstimateSide(Point(X, Y), 1) of
          gsTop, gsBottom: PaintBoxImage.Cursor := crSizeNS;
          gsLeft, gsRight: PaintBoxImage.Cursor := crSizeWE;
        else
          PaintBoxImage.Cursor := crDefault;
        end;
      end
      else
      begin
        case FGrab.Side of
          gsTop : if (Y < FGrab.SelectionBottom) and (Y > 0) then FGrab.SelectionTop := Y;
          gsBottom : if (Y > FGrab.SelectionTop) and (Y < PaintBoxImage.Height) then FGrab.SelectionBottom := Y;
          gsLeft : if (X < FGrab.SelectionRight) and (X > 0) then FGrab.SelectionLeft := X;
          gsRight : if (X > FGrab.SelectionLeft) and (X < PaintBoxImage.Width) then FGrab.SelectionRight := X;
        end;
        PaintBoxImage.Invalidate;
      end;
    end;
  end;
end;
 
procedure TForm1.PaintBoxImageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FGrab.Down := False;
  FGrab.Side := gsNone;
  PaintBoxImage.Cursor := crDefault;
end;
 
procedure TForm1.PaintBoxImagePaint(Sender: TObject);
begin
  PaintBoxImage.Canvas.Draw(0, 0, FBitmap);
 
  PaintBoxImage.Canvas.Brush.Color := clRed;
  PaintBoxImage.Canvas.FrameRect(FGrab.SelectionRect);
 
  PaintBoxImage.Canvas.Pen.Color := clBlue;
  PaintBoxImage.Canvas.Brush.Color := clBlue;
  PaintBoxImage.Canvas.Rectangle(Rect((FGrab.SelectionLeft + FGrab.SelectionRight) div 2 - 2, FGrab.SelectionTop - 2, (FGrab.SelectionLeft + FGrab.SelectionRight) div 2 + 2, FGrab.SelectionTop + 2));
  PaintBoxImage.Canvas.Rectangle(Rect((FGrab.SelectionLeft + FGrab.SelectionRight) div 2 - 2, FGrab.SelectionBottom - 2, (FGrab.SelectionLeft + FGrab.SelectionRight) div 2 + 2, FGrab.SelectionBottom + 2));
  PaintBoxImage.Canvas.Rectangle(Rect(FGrab.SelectionLeft - 2, (FGrab.SelectionTop + FGrab.SelectionBottom) div 2 - 2, FGrab.SelectionLeft + 2, (FGrab.SelectionTop + FGrab.SelectionBottom) div 2 + 2));
  PaintBoxImage.Canvas.Rectangle(Rect(FGrab.SelectionRight - 2, (FGrab.SelectionTop + FGrab.SelectionBottom) div 2 - 2, FGrab.SelectionRight + 2, (FGrab.SelectionTop + FGrab.SelectionBottom) div 2 + 2));
end;
 
{ TGrab }
 
constructor TGrab.Create;
begin
  FRect := Rect(-1, -1, -1, -1);
end;
 
function TGrab.EstimateSide(const P: TPoint; E: Integer): TGrapSide;
 
  function SameValue(const A, B: Integer; Epsilon: Integer): Boolean;
  begin
    if A > B then
      Result := (A - B) <= Epsilon
    else
      Result := (B - A) <= Epsilon;
  end;
 
var
  InLeft, InRight, InTop, InBottom: Boolean;
begin
  Result := gsNone;
  InLeft := SameValue(P.X, FRect.Left, E);
  InRight := not InLeft and SameValue(P.X, FRect.Right, E);
  if InLeft or InRight then
  begin
    if (P.Y >= FRect.Top - E) and (P.Y < FRect.Bottom + E) then
      if InLeft then
        Result := gsLeft
      else
        Result := gsRight;
  end
  else
  begin
    InTop := SameValue(P.Y, FRect.Top, E);
    InBottom := not InTop and SameValue(P.Y, FRect.Bottom, E);
    if InTop or InBottom then
    begin
      if (P.X >= FRect.Left - E) and (P.X < FRect.Right + E) then
      if InTop then
        Result := gsTop
      else
        Result := gsBottom;
    end;
  end
end;
 
end.

Code dfm :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
object Form1: TForm1
  Left = 0
  Top = 0
  Width = 1281
  Height = 685
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object PaintBoxImage: TPaintBox
    Left = 0
    Top = 0
    Width = 1265
    Height = 646
    Align = alClient
    OnMouseDown = PaintBoxImageMouseDown
    OnMouseMove = PaintBoxImageMouseMove
    OnMouseUp = PaintBoxImageMouseUp
    OnPaint = PaintBoxImagePaint
  end
end

[cincap]

Bonjour à toutes et à tous,

@ ShaiLeTroll, merci pour ton aide, je vais tester tout cela à tête reposée.

En attendant, j'ai créer une fiche pour la sélection (Form2) de la partie photo soit rectangulaire soit ellipse.

J'ai sur la fiche principale une photo en .bmp qui est aussi chargée lors de l'exécution de la fiche sélection.

Dès que j'ai fait une sélection dans la photo, le résultat se trouve bien dans le Timage2 de la fiche sélection (Form2) et de la fiche principale (Form1).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Form1.Image2.Picture.assign(bmp);

A ce stade tout est ok.

Mais je me dis facile il reste a sauver le contenu de Image2 qui contient bien la sélection en .bmp et le tour est joué.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
 Image2.Picture.Savetofile(Sd1.filename);

Mais la sauvegarde m'affiche un .bmp vide.

J'ai essayé plusieurs sauvegardes une fois le fichier est vide.

Je n'y comprends rien à mois que de sauver image2 en recréant un bitmap ?

@+,

cincap

[ShaiLeTroll]

D7, j'ai un peu oublié, faut vérifier entre le Picture, le Graphic et le Bitmap, surtout si c'est un PNG ou un JPEG à l'origine

Pour moi, il faut copier le rectangle dans un second bitmap, si ellipse, dessiner l'ellipse inversé en masque pour avoir un fond transparent, ou un truc du genre.

En ajoutant tout simplement Bitmap ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Image2.Picture.Bitmap.Savetofile(Sd1.filename);

[cincap]

Bonjour à toutes et à tous,

@ ShaiLeTroll, j'ai revu tout le code et même en ajoutant Bitmap cela ne fonctionnait pas.

Par contre si je fais la sauvegarde directement depuis la Fiche sélection (Form2) cela fonctionne correctement.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
procedure TFSelection.BsauverClick(Sender: TObject);
begin
 Form1.Benregistrer.Enabled := true;
 //form1.image2.Picture.bitmap.Assign(imagesource1.picture.bitmap);
 
Sd2.Filter := 'Fichier photo (*.bmp)|*.bmp|';   //Fichier photo (*.jpg;*.jpeg)|*.jpg;*.jpeg|' ;
 
if not Sd2.Execute then exit else begin
imagesource1.picture.bitmap.savetofile(sd2.filename);
close;
end;
 end;

C'est quand même étonnant que le fait d'assigner la sélection de l'image de Form2 à Form1 cela ne fonctionnait pas.

Je ferme le topic et merci encore aux as de ce site.

@+,

cincap

[exoseven]

si l'on regarde ton code tu ne fais pas exactement la même chose

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

imagesource1.picture.bitmap.savetofile(sd2.filename);

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Image2.Picture.Savetofile(Sd1.filename);

[cincap]

@ exoseven, merci pour ta réponse

si l'on regarde ton code tu ne fais pas exactement la même chose

Mais si, mon but était de faire une sélection dans un Bitmap qui est chargé dans Form1 et qui est copié dans Form2 pour capturer la sélection dans imagesource1 puis copié dans le Timage2 de Form1 et puis sauver.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
//form1.image2.Picture.bitmap.Assign(imagesource1.picture.bitmap);

Donc mon code était voir ma réponse de 12H56.

Il n'y a que le Tsavedialog qui est doublé sur Form1 'Sd1' et sur Form2 'Sd2'.

Comme tout fonctionne je vais tester plusieurs façons de sauvegarde pour comprendre la sauvegarde de la même image sur deux fiches différentes.

@+,

cincap