Centrer verticalement une image dans un TStringGrid

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

Existe t-il un moyen de centrer verticalement les images dans une stringgrid ? Si oui je n'ai pas trouvé le truc et les images sont collées en haut ( Voir image jointe ).
Si c'est impossible par programmation une alternative consisterai à les entourer d'un cadre au dimensions des cellules mais je ne sais comment faire.
Ci-dessous le code utilisé:

Code:

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
 
{ ---- Creation de vignette ---- }
Procedure TForm1.CreateThumb(Filename:String; NbTh, NbCur:Integer);
Var
  Img_Picture: TPicture;
  Thumbnail: TJPEGImage;
  H_Max, W_Max:Integer;
  Scale:Double;
  Dir_Thumbs, Th_Name:String;
begin
  Img_Picture := TPicture.Create;
  Thumbnail := TJPEGImage.Create;
  W_Max:=100;
  H_Max:=100;
  Scale:=1;
  Th_Name:=Set_ThName(Filename);
  Dir_Thumbs:=ExtractFilePath(Filename)+'/thumbs';
 
  If not FileExists(Dir_Thumbs) then mkdir(Dir_Thumbs);
  If FileExists(Th_Name) then exit;
  L_Thumb.Caption:='génération de la vignette: '+IntToStr(NbCur)+' / '+IntToStr(NbTh);
  Application.ProcessMessages;
  try
    Img_Picture.LoadFromFile(Filename);
    Thumbnail.Assign(Img_Picture.Graphic);
 
    If Thumbnail.Width>Thumbnail.Height then begin
      If ThumbNail.Width>W_Max then begin
        Scale:=Thumbnail.Width/W_Max;
      end;
    end
    else begin
      if Thumbnail.Height>H_Max then begin
        Scale:=Thumbnail.Height/H_Max;
      end;
    end;
    Thumbnail.Width:=Thumbnail.Width div round(Scale);
    Thumbnail.Height:=Thumbnail.Height div round(Scale);
    ThumbNail.Canvas.StretchDraw(Rect(0, 0, Thumbnail.Width, Thumbnail.Height), Img_Picture.Graphic);
    Thumbnail.SaveToFile(Th_Name);
  finally
    Img_Picture.Free;
    Thumbnail.Free;
  end;
End;

Code:

1
2
3
4
5
6
7
8
9
10
11
12
 
{ ---- Remplir les cellules de la grille avec les images ----}
procedure TForm1.G_Img_ListDrawCell(Sender: TObject; aCol, aRow: Integer;
  aRect: TRect; aState: TGridDrawState);
Var
  CurrImg:TImage;
begin
  if (sender as Tstringgrid).Objects[Acol,Arow] = nil then Exit;
  CurrImg := TImage((sender as Tstringgrid).Objects[Acol,Arow]);
//  (sender as Tstringgrid).Canvas.StretchDraw( aRect, CurrImg.Picture.Graphic);
  (sender as Tstringgrid).Canvas.Draw( aRect.Left,aRect.Top, CurrImg.Picture.Graphic);
end;

PS: J'ai viré stretchdraw. Ca remplit bien les cellules mais déforme l'image de manière déplaisante.

Merci.

Bonjour.

Dans ton code de création de vignette, ta formule n'est pas bonne :
Code:

1 2 Thumbnail.Width:=Thumbnail.Width div round(Scale); Thumbnail.Height:=Thumbnail.Height div round(Scale);
Si l'image d'origine fait 250 pix/125pix :
Scale = 2,5
Width du thumbnail : 250/3 = 83 !!! (au lieu de 100)
Height du thumbnail : 125/3 = 42 (au lieu de 50)
Et ton rapport image n'est plus parfaitement de 2 sur 1.

Il faut évidemment arrondir après avoir fait la division :
Thumbnail.Width:= Round(Thumbnail.Width / Scale);

Quant-au positionnement dans une cellule du stringgrid, il faut voir si tu vas permettre de modifier la taille des colonnes et/ou des lignes (et que l'image s'adapte automatiquement).
Si ton Stringgrid est "fixe" : pas de problème, l'objet TPicture associé à une cellule est mis directement à la bonne taille (pour ne plus faire de stretch par après).
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 procedure TForm1.StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState); var L, T: integer; begin with StringGrid1 do if Objects[aCol, aRow] is TPicture then begin L:= (aRect.Right - aRect.Left - (Objects[aCol,aRow] as TPicture).Width) div 2; T:= (aRect.Bottom - aRect.Top - (Objects[aCol,aRow] as TPicture).Height) div 2; Canvas.Draw(aRect.left + L, aRect.top + T, (Objects[aCol,aRow] as TPicture).Graphic); end; end;
Avec ce code, le graphique reste toujours centré, même si tu modifies la taille colonne ou ligne.
Si tu veux que le graphique s'adapte automatiquement pour "remplir" la cellule, tu dois dans l'événement OnDrawCell afficher l'objet TPicture avec un stretch proportionnel.

Cordialement
Thierry

27/04/2016, 16h16
mm_71

Merci.

Exactement ce que je voulais. En dehors du round maintenant rectifié j'avais fait une autre gaffe en chargeant les cellules avec un TImage complet au lieu du seul TPicture.

Bonjour,

Citation:

Envoyé par mm_71

PS: J'ai viré stretchdraw. Ca remplit bien les cellules mais déforme l'image de manière déplaisante.

Il faut recalculer le rectangle de dessin et sa position dans la cellule et la redessiner en l'adapatant (stretchdraw).
A la louche cela donne :

Code:

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
const
  ImgMargin = 5;
// ...
procedure TForm2.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState);
var
  CurrImg: TImage;
  WImg, HImg: Integer;
  WCell, HCell: Integer;
begin
  if Sender <> StringGrid1 then
    Exit;
  if (StringGrid1.Objects[ACol, ARow] = nil) or (not (StringGrid1.Objects[ACol, ARow] is TImage)) then
    Exit;
  //
  CurrImg := TImage(StringGrid1.Objects[ACol, ARow]);
  // Taille de la cellule
  WCell := ARect.Width;
  HCell := ARect.Height;
  // Taille de l'image
  WImg := CurrImg.Width;
  HImg := CurrImg.Height;
  // Recalcul du rectangle de dessin et sa position
  if (WImg / HImg) >= (WCell / HCell) then
  begin
    ARect.Width := (WCell - 2 * ImgMargin);
    ARect.Height := ARect.Width * HImg div WImg;
    ARect.Left := ARect.Left + ImgMargin;
    ARect.Top := Arect.Top + (HCell - ARect.Height) div 2
  end
  else
  begin
    ARect.Height := (HCell - 2 * ImgMargin);
    ARect.Width := ARect.Height * WImg div HImg;
    ARect.Top := ARect.Top + ImgMargin;
    ARect.Left := Arect.Left + (WCell - ARect.Width) div 2
  end;
  // redessin
  StringGrid1.Canvas.StretchDraw(aRect, CurrImg.Picture.Graphic);
end;

27/04/2016, 18h11
mm_71

Citation:

Il faut recalculer le rectangle de dessin et sa position dans la cellule et la redessiner en l'adapatant (stretchdraw).
A la louche cela donne :

Ca m'intéresse aussi pour étudier le principe mais comment fais-tu aRect.Widht et aRect.Height ?? Ces propriétés ne sont pas accessibles.

bouq_thumb_ren.pas(497,11) Error: identifier idents no member "Height"

On a : top, left, right, bottom:Integer et TopLeft, BottomRight:Tpoint Rien d'autre. Il me semble que ton code soit pour delphi sinon quelque chose m'échappe vraiment.

( Ma version lazarus: SVN 1.7 compilée le mois dernier sous linux mint 17.2 )

Citation:

Envoyé par mm_71

Ca m'intéresse aussi pour étudier le principe mais comment fais-tu aRect.Widht et aRect.Height ?? Ces propriétés ne sont pas accessibles.

bouq_thumb_ren.pas(497,11) Error: identifier idents no member "Height"

On a : top, left, right, bottom:Integer et TopLeft, BottomRight:Tpoint Rien d'autre. Il me semble que ton code soit pour delphi sinon quelque chose m'échappe vraiment.

J'ai bien dit "à la louche" et au temps pour moi, j'ai pris la louche de Delphi :lol:.
Vérification faite avec Delphi XE2+, ça fonctionne.
Ceci dit, ce n'est pas bien compliqué à reprendre et adapter.
Vérification faite avec Lazarus 1.6, cela donne : :zoubi:

Code:

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
const
  ImgMargin = 5;
// ...
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState);
var
  CurrImg: TImage;
  WImg, HImg: Integer;
  WCell, HCell: Integer;
  RectWidth, RectHeight: Integer;
begin
  if Sender <> StringGrid1 then
    Exit;
  if (StringGrid1.Objects[ACol, ARow] = nil) or (not (StringGrid1.Objects[ACol, ARow] is TImage)) then
    Exit;
  //
  CurrImg := TImage(StringGrid1.Objects[ACol, ARow]);
  // Taille de la cellule
  RectWidth := ARect.Right - ARect.Left;
  RectHeight := ARect.Bottom - ARect.Top;
  WCell := RectWidth;
  HCell := RectHeight;
  // Taille de l'image
  WImg := CurrImg.Width;
  HImg := CurrImg.Height;
  // Recalcul du rectangle de dessin et sa position
  if (WImg / HImg) >= (WCell / HCell) then
  begin
    // Taille
    RectWidth := (WCell - 2 * ImgMargin);
    RectHeight := RectWidth * HImg div WImg;
    // Rectangle de dessin
    ARect.Left := ARect.Left + ImgMargin;
    ARect.Right := ARect.Left + RectWidth;
    ARect.Top := ARect.Top + (HCell - RectHeight) div 2;
    ARect.Bottom := ARect.Top + RectHeight;
  end
  else
  begin
    // Taille
    RectHeight := (HCell - 2 * ImgMargin);
    RectWidth := RectHeight * WImg div HImg;
    // Rectangle de dessin
    ARect.Top := ARect.Top + ImgMargin;
    ARect.Bottom := ARect.Top + RectHeight;
    ARect.Left := ARect.Left + (WCell - RectWidth) div 2;
    ARect.Right := ARect.Left + RectWidth;
  end;
  // redessin
  StringGrid1.Canvas.StretchDraw(aRect, CurrImg.Picture.Graphic);
end;

28/04/2016, 15h55
mm_71
Genial ! Exactement ce qu'il fallait pour un nul en calcul comme moi. Un dernier truc à rectifier pour que l'image reste proportionnée:
Code:

1 2 3 WImg := CurrImg.Width; HImg := CurrImg.Height;
Doit devenir:
Code:

1 2 3 WImg := CurrImg.Picture.Width; HImg := CurrImg.Picture.Height;
Sinon l'image reste carrée quelque soient les proportions de la cellule.