Redimensionner une Form par la gauche. [Résolu]

Messages postés
2684
Date d'inscription
jeudi 15 janvier 2004
Statut
Membre
Dernière intervention
26 juillet 2018
- - Dernière réponse : fbalien
Messages postés
265
Date d'inscription
dimanche 7 décembre 2003
Statut
Membre
Dernière intervention
11 novembre 2016
- 20 août 2010 à 22:48
Bonjour à tous,

Une fiche avec un TImage et le code ci-dessous.

Je voudrais que, lorsqu'on redimensionne la fiche, le Bitmap qui se trouve dans le TImage soit aussi redimensionné. Mais d'une façon un peu particulière qui n'est pas celle par défaut.
Il faudrait que lorsqu'on agrandit la fiche par le haut ou par la gauche, le Bitmap s'agrandisse ausi vers le haut ou vers la gauche (un comportement "naturel", somme toute).

Le code ci dessous y parvient très bien dans toutes les directions de redimensionnement, sauf une !
Il a un comportement non attendu lorsqu'on diminue la taille de la fiche par la gauche. Par contre, quand on agrandit par la gauche, ça fonctionne bien. Et par le haut et les autres directions, aucun problème !

Je ne comprends pas le pourquoi de ce bug bizarre.

Voici le code de mon appli que j'ai simplifiée au maximum et que vous pouvez copier/coller :

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormCanResize(Sender: TObject; var NewWidth,
              NewHeight: Integer; var Resize: Boolean);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var	gMonPoint : TPoint;

procedure Draw;
begin
{On efface tout.}
Form1.Image1.Picture.Bitmap.Canvas.Brush.Color := clGreen;
Form1.Image1.Picture.Bitmap.Canvas.FillRect(Form1.Image1.Picture.Bitmap.Canvas.ClipRect);
{On dessine un carré jaune aux coordonnées de gMonPoint.}
Form1.Image1.Picture.Bitmap.Canvas.Brush.Color := clYellow;
Form1.Image1.Picture.Bitmap.Canvas.Rectangle(gMonPoint.X-10,gMonPoint.Y-10,gMonPoint.X+10,gMonPoint.Y+10);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
DoubleBuffered  := true;
with Image1.Picture.Bitmap.Create do begin
  Width         := Image1.Width;
  Height        := Image1.Height;
  PixelFormat   := pf24bit;
end;
Image1.AutoSize := true;
gMonPoint := Point(Image1.Width div 2, Image1.Height div 2);
Draw;
Image1.Refresh;
end;

procedure TForm1.FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean);
   var
          DeltaX : Integer;
          DeltaY : Integer;
          Pt     : TPoint ;
          Lft,Tp : Boolean;
begin
{Lors d'un simple déplacement de la fiche, on quitte.}
if (NewWidth=Form1.Width) and (NewHeight=Form1.Height) then Exit;
{On mesure la variation de taille de la fiche.}
DeltaX := (NewWidth  - Form1.Width );
DeltaY := (NewHeight - Form1.Height);
{On détermine si le redimensionnement se fait par la gauche ou par le haut.}
GetCursorPos(Pt);
if ScreenToClient(Pt).X<0 then Lft := true else Lft := false;
if ScreenToClient(Pt).Y<0 then Tp  := true else Tp  := false;
{On redimensionne le Bitmap.}
Image1.Picture.Bitmap.Width  := Image1.Picture.Bitmap.Width  + DeltaX;
Image1.Picture.Bitmap.Height := Image1.Picture.Bitmap.Height + DeltaY;
{On change ma position du carré.}
if Lft then gMonPoint.X := gMonPoint.X + DeltaX;
if Tp  then gMonPoint.Y := gMonPoint.Y + DeltaY;
{On redessine tout.}
Draw;
end;

END.


Merci à tous ceux qui se pencheront sur le patient.

Cari
Afficher la suite 

6 réponses

Meilleure réponse
Messages postés
4229
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
3 août 2018
32
3
Merci
Salut,


regarde si ça te convient :
[hr]unit Unit1;


[b]interface

uses
  /bWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

[b]type
  /bTForm1 =   class (TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormCanResize(Sender: TObject; var NewWidth,
      NewHeight: Integer; var Resize: Boolean);
  [b]private
    /b { Déclarations privées }
// Ajouté
    procedure WMNCHitTest(var Msg: TWMNCHitTest);
      message wm_NCHitTest;
  [b]public
    /b{ Déclarations publiques }
  end;

[b]var
  /bForm1: TForm1;

[b]implementation

/b{$R *.dfm}

[b]var
  /bgMonPoint: TPoint;
// Ajouté
  aHTLeft : Boolean  = False;
// Ajouté
  aHTTop: Boolean =  False;
procedure  Draw;
[b]begin
  /b {On efface tout.}
  Form1.Image1.Picture.Bitmap.Canvas.Brush.Color : = clGreen;
  Form1.Image1.Picture.Bitmap.Canvas.FillRect(Form1.Image1.Picture.Bitmap.Canvas.ClipRect);
  {On dessine un carré jaune aux coordonnées de gMonPoint.}
  Form1.Image1.Picture.Bitmap.Canvas.Brush.Color :=  clYellow;
  Form1.Image1.Picture.Bitmap.Canvas.Rectangle(gMonPoint.X - 10, gMonPoint.Y -
    10, gMonPoint.X + 10, gMonPoint.Y + 10);
end ;

procedure TForm1.FormCreate(Sender: TObject);
[b]begin
  /bDoubleBuffered : = true;
  with Image1.Picture.Bitmap.Create [b]do
  begin
    /bWidth :=  Image1.Width;
    Height := Image1.Height;
    PixelFormat := pf24bit;
   end ;
  Image1.AutoSize : = true;
  gMonPoint :=  Point(Image1.Width  div  2, Image1.Height div 2);
  Draw;
  Image1.Refresh;
end;

procedure TForm1.FormCanResize(Sender: TObject; var NewWidth, NewHeight:
  Integer; var Resize: Boolean);
[b]var
  /bDeltaX: Integer;
  DeltaY: Integer;
  Pt: TPoint;
  Lft, Tp: Boolean;
[b]begin
  /b[i]{Lors d'un simple déplacement de la fiche, on quitte.}
  /iif (NewWidth  = Form1.Width) and (NewHeight =  Form1.Height) [b]then
    /bExit;
   {On mesure la variation de taille de la fiche.}
  DeltaX : = (NewWidth - Form1.Width);
  DeltaY :=  (NewHeight - Form1.Height);
   {On détermine si le redimensionnement se fait par la gauche ou par le haut.}
  GetCursorPos(Pt);
  //  Modifié
  Lft : = ScreenToClient(Pt).X < 0;
  //  Modifié
  Tp :=  ScreenToClient(Pt).Y < 0;

   {On redimensionne le Bitmap.}
  Image1.Picture.Bitmap.Width : = Image1.Picture.Bitmap.Width + DeltaX;
  Image1.Picture.Bitmap.Height :=  Image1.Picture.Bitmap.Height + DeltaY;
   {On change ma position du carré.}
  //  Modifié
   if  Lft or aHTLeft [b]then
    /bgMonPoint.X : = gMonPoint.X + DeltaX;

  //  Modifié
  if Tp or aHTTop [b]then
    /bgMonPoint.Y :=  gMonPoint.Y + DeltaY;
   {On redessine tout.}
  Draw;
end ;

// Ajouté
procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
[b]begin
  inherited/b;
  aHTTop : = Msg.Result = HTTOP;
  aHTLeft := Msg.Result = HTLEFT;
end;

end.
[hr]

j'avais aussi le même bug en Top quand on redimensionnait très vite


[hr]@+Cirec
[hr]

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 135 internautes nous ont dit merci ce mois-ci

Commenter la réponse de Cirec
Messages postés
4229
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
3 août 2018
32
3
Merci
et pour que ça fonctionne aussi avec les angles "TopLeft & BottomLeft" il faut modifier comme ceci:

[hr]// Ajouté & Modifié


procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
[b]begin
  inherited/b;
  aHTTop :=  (Msg.Result = HTTOP)  or  (Msg.Result  = HTTOPLEFT);
  aHTLeft :=  (Msg.Result = HTLEFT)  or  (Msg.Result  = HTTOPLEFT) or (Msg.Result =
    HTBOTTOMLEFT);
end;
[hr]

voilà ... maintenant tout devrait fonctionner (Normalement )

[hr]@+Cirec
[hr]

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 135 internautes nous ont dit merci ce mois-ci

Commenter la réponse de Cirec
Messages postés
2684
Date d'inscription
jeudi 15 janvier 2004
Statut
Membre
Dernière intervention
26 juillet 2018
11
3
Merci
... On peut même supprimer mes variables "Lft, Tp: Boolean;", devenues inutiles :

//  Modifié
if aHTLeft then gMonPoint.X := gMonPoint.X + DeltaX;
if aHTTop  then gMonPoint.Y := gMonPoint.Y + DeltaY;

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 135 internautes nous ont dit merci ce mois-ci

Commenter la réponse de Caribensila
Messages postés
265
Date d'inscription
dimanche 7 décembre 2003
Statut
Membre
Dernière intervention
11 novembre 2016
0
Merci
Bonjour

J'ai le même comportement avec le haut et le gauche de mon côté
si j'ai pas bien compris ton pb tu veux que le carré jaune reste à la même place que l'on bouge le haut ou le gauche ?

a+
Commenter la réponse de fbalien
Messages postés
2684
Date d'inscription
jeudi 15 janvier 2004
Statut
Membre
Dernière intervention
26 juillet 2018
11
0
Merci
@Cirec
C'est nickel chromé !

Effectivement, après vérification j'avais le même bug en Top. Mais je ne l'avais pas vu car il fallait aller vraiment très très vite chez moi.
Si je l'avais vu, j'aurais été moins perplexe... Mais j'suis pas sûr du tout que j'aurais trouvé la solution.
Un grand merci !

@fbalien
A présent, avec le code de Cirec, tu comprends mieux ce que je voulais faire ?

Merci à tous les deux.
Commenter la réponse de Caribensila
Messages postés
265
Date d'inscription
dimanche 7 décembre 2003
Statut
Membre
Dernière intervention
11 novembre 2016
0
Merci
bonjour

ce qui m'a perturbé c'est que chez moi cela bugué pour le top et le left contrairement a toi
bien vue Cirec

A+
Commenter la réponse de fbalien