Redimensionner une Form par la gauche.Résolu

Question

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

Cirec · Accepted Answer

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]

fbalien · Answer

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+

Cirec · Answer

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]

Caribensila · Answer

@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.

Caribensila · Answer

... 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;

fbalien · Answer

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+

Redimensionner une Form par la gauche.

6 réponses

Votre réponse

Discussions similaires