Discussion :

[Papy214]

J'ai testé avec un champ calculé mais ça ne s'applique pas à un champ de ce type.
C'est pour ça que je préconise le pré chargement.

[Papy214]

voilà une solution toute simple qui fonctionne et qui ne nécessite pas de contrôle TImage ou autre :

Code :

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

1
2
3
4
5
6
7
8
9
10
 
procedure TForm4.DBCtrlGrid1PaintPanel(DBCtrlGrid: TDBCtrlGrid; Index: Integer);
var
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  Bmp.LoadFromFile(DBCtrlGrid.DataSource.DataSet.FieldByName('nom').AsString);
  DBCtrlGrid.Canvas.Draw(600, 20, Bmp);
  Bmp.Free;
end;

La seule "difficulté" est de définir l'emplacement du dessin.

[ShaiLeTroll]

la Technique du Draw est celle que j'ai proposé depuis le debut
Merci Papy214 de l'avoir testé, je n'ai rien sous la main pour le faire !
Etant en Congés, je n'ai pas Delphi, j'aurais sinon fourni un code complet, ce genre de petit jeu trivial m'amuse toujours ... en fait, je vais lancer l'ordi pro, je reviens quand j'ai fini


En plus, tu as aussi proposer la variante TClientDataSet que j'avais aussi proposé, la plus simple à mon avis si l'on ne maitrise par le Canvas
On peut s'en servir comme tampon de vignette sous forme Blob qui remplace très bien le TObjectList de TBitmap de la version Canvas

Juste

Je l'ai fait avec 3 record d'où le copier-coller mais dans votre cas, il faut boucler sur les toutes les lignes pour faire le pré-chargement des images.

En fait, tu peux aussi utiliser un Lazy Load, si le champs Blob est Null ou Unassigned, tu charges l'image, juste au moment utile, si tu as 1000 images, et que la grille n'en affiche que 40, autant ne charger que l'essentiel


Pour la version Canvas :
Calculer la position ?
Non inutile, l'evènement concerne le Panel et non TDBCtrlGrid entier !

Utilisez la propriété Canvas pour dessiner le volet. Le point (0,0) du canevas correspond au coin supérieur gauche et le point (PanelWidth, PanelHeight) au coin inférieur droit.

Donc la zone "dessinable" est :

Code :

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

LRect := Rect(0, 0, DBCtrlGrid.PanelWidth, DBCtrlGrid.PanelHeight);

Et comme je l'évoquais mieux vaut se construire son TObjectList de TBitmap contenant l'image à dessiner (idéalement la version à la taille adaptée, évitant de calculer un Stretch à chaque fois)
Un LoadFromFile a chaque Paint étant assez peu performant, c'est bien pour commencer et voir que c'est possible mais un professionnel ne peut pas déployer cela !

Rappel, cela dessine le fond du Panel, donc l'image sera toujours derrière les contrôles.

[Papy214]

J'avais survolé mais tout lu, je ne voulais pas te faire concurrence

Pour la version Canvas :
Calculer la position ?
Non inutile, l'evènement concerne le Panel et non TDBCtrlGrid entier !

Oui si on dessine sur le panel entier mais dans mon exemple, je le dessine à droite pour laisser la place à d'autres composants.
D'où la nécessité "éventuelle" de calculer la position du dessin.

Pour le chargement depuis une liste, je suis d'accord avec toi mais tout dépend de la quantité de lignes concernées. C'est un paramètre inconnu dans le cas évoqué.
Je ne sais pas à partir de combien ça vaut le coup de rajouter une liste d'images pré-chargées. A tester sans doute.

[ShaiLeTroll]

J'avais survolé mais tout lu, je ne voulais pas te faire concurrence

Bien au contraire, je suis ravi que tu aies pu proposer une illustration

Je me suis inspiré de ton idée d'utiliser les images de Delphi comme source de données

Oui si on dessine sur le panel entier mais dans mon exemple, je le dessine à droite pour laisser la place à d'autres composants.
D'où la nécessité "éventuelle" de calculer la position du dessin.

Il faut utiliser Top, Left, Width, Height des controles autour, c'est eux qui donne la limite


Je suis parti sur DEUX DataSet pour la simplicité d'adaptation

CDSMaster correspond à Query des Produits
CDSImage c'est juste les Blobs

Et un troisième pour le mode DBImage qui est la fusion des deux

La version Canvas, il faut dessiner soit même c'est plus délicat à gérer mais on gagne le LazyLoading par rapport à la version DBImage

Le code est pour D10, je pense que le TRect de D7 était bien plus chiant, le calcul de Width Height sera moins évident mais c'est faisable

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
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
unit DBCtrlGridWithImage_MainForm;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  Data.DB, Datasnap.DBClient,
  MidasLib (* MidasLib évite la DLL *),
  Data.DBConsts,
  Vcl.DBCGrids, Vcl.Grids, Vcl.DBGrids, Vcl.DBCtrls;
 
type
  TForm1 = class(TForm)
    edImageDirectory: TEdit;
    btnBuildCDSMaster: TButton;
    DBGridFiles: TDBGrid;
    DBCtrlGridFiles: TDBCtrlGrid;
    DSFiles: TDataSource;
    DBCtrlGridFilesByControl: TDBCtrlGrid;
    DBTextFileName: TDBText;
    DBTextFileNameByControl: TDBText;
    DBImageOfFile: TDBImage;
    DSFileBlobs: TDataSource;
    DSFilesWithBlob: TDataSource;
    btnBuildCDSImages: TButton;
    btnBuildCDSMasterWithImages: TButton;
    procedure btnBuildCDSMasterClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnBuildCDSImagesClick(Sender: TObject);
    procedure DBGridFilesDrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure DBCtrlGridFilesByControlPaintPanel(DBCtrlGrid: TDBCtrlGrid;
      Index: Integer);
    procedure btnBuildCDSMasterWithImagesClick(Sender: TObject);
    procedure DBCtrlGridFilesPaintPanel(DBCtrlGrid: TDBCtrlGrid;
      Index: Integer);
  private
    { Déclarations privées }
    FCDSMaster: TClientDataSet;
    FCDSImages: TClientDataSet;
    FCDSMasterWithImages: TClientDataSet;
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
uses System.Math;
 
type
  TBiz = class
    class procedure FillMasterDataSet(ADataSet: TDataSet; const AImageDirectory: string);
  end;
 
 
 
 
 
 
{$R *.dfm}
 
procedure TForm1.btnBuildCDSMasterClick(Sender: TObject);
begin
  DSFiles.DataSet := nil;
  FreeAndNil(FCDSMaster);
 
  FCDSMaster := TClientDataSet.Create(nil); // on pourrait mettre Self et se passer des FreeAndNil
  FCDSMaster.FieldDefs.Add('Reference', ftString, 8);
  FCDSMaster.FieldDefs.Add('FileName', ftString, 255);
  FCDSMaster.FieldDefs.Add('Path', ftString, 255);
  FCDSMaster.CreateDataSet();
 
  TBiz.FillMasterDataSet(FCDSMaster, edImageDirectory.Text); // Ici c'est l'appel à la Query de Produits
 
  FCDSMaster.First();
 
  DSFiles.DataSet := FCDSMaster;
end;
 
 
procedure TForm1.btnBuildCDSImagesClick(Sender: TObject);
begin
  DSFileBlobs.DataSet := nil;
  FreeAndNil(FCDSImages);
 
  FCDSImages := TClientDataSet.Create(nil); // on pourrait mettre Self et se passer des FreeAndNil
  FCDSImages.FieldDefs.Add('Reference', ftString, 8);
  FCDSImages.FieldDefs.Add('Blobbie', ftBlob);
  FCDSImages.CreateDataSet();
 
  DSFileBlobs.DataSet := FCDSImages;
 
  DBGridFiles.Invalidate();
  DBCtrlGridFiles.Invalidate();
end;
 
 
procedure TForm1.btnBuildCDSMasterWithImagesClick(Sender: TObject);
var
  iField: Integer;
begin
  DSFilesWithBlob.DataSet := nil;
  FreeAndNil(FCDSMasterWithImages);
 
  FCDSMasterWithImages := TClientDataSet.Create(nil); // on pourrait mettre Self et se passer des FreeAndNil
  FCDSMasterWithImages.FieldDefs.Add('Reference', ftString, 8);
  FCDSMasterWithImages.FieldDefs.Add('FileName', ftString, 255);
  FCDSMasterWithImages.FieldDefs.Add('Path', ftString, 255);
  FCDSMasterWithImages.FieldDefs.Add('Blobbie', ftBlob);
  FCDSMasterWithImages.CreateDataSet();
 
 
  FCDSMaster.DisableControls();
  try
    FCDSMaster.First();
    while not FCDSMaster.Eof do
    begin
      FCDSMasterWithImages.Append();
 
      for iField := 0 to FCDSMaster.FieldCount - 1 do
        FCDSMasterWithImages.Fields[iField].AsVariant := FCDSMaster.Fields[iField].AsVariant;
 
      (FCDSMasterWithImages.FieldByName('Blobbie') as TBlobField).LoadFromFile(FCDSMaster.FieldByName('Path').AsString + FCDSMaster.FieldByName('FileName').AsString);
 
      FCDSMasterWithImages.Post();
      FCDSMaster.Next();
    end;
  finally
    FCDSMaster.EnableControls();
  end;
 
  FCDSMasterWithImages.First();
  DSFilesWithBlob.DataSet := FCDSMasterWithImages;
 
  DBCtrlGridFilesByControl.Invalidate();
end;
 
 
 
 
procedure TForm1.DBCtrlGridFilesByControlPaintPanel(DBCtrlGrid: TDBCtrlGrid; Index: Integer);
var
  LRect: TRect;
  Brush: HBrush;
begin
  if Odd(DBCtrlGrid.DataSource.DataSet.RecNo) then
  begin
    Brush := CreateSolidBrush(ColorToRGB(clMoneyGreen));
    try
      LRect := Rect(0, 0, DBCtrlGrid.PanelWidth, DBCtrlGrid.PanelHeight);
      FillRect(DBCtrlGrid.Canvas.Handle, LRect, Brush);
    finally
      DeleteObject(Brush);
    end;
  end;
end;
 
procedure TForm1.DBCtrlGridFilesPaintPanel(DBCtrlGrid: TDBCtrlGrid; Index: Integer);
var
  LRect: TRect;
  Brush: HBrush;
  MS: TMemoryStream;
  Bmp: TBitmap;
begin
  if Odd(DBCtrlGrid.DataSource.DataSet.RecNo) then
  begin
    Brush := CreateSolidBrush(ColorToRGB(clMoneyGreen));
    try
      LRect := Rect(0, 0, DBCtrlGrid.PanelWidth, DBCtrlGrid.PanelHeight);
      FillRect(DBCtrlGrid.Canvas.Handle, LRect, Brush);
 
      if not Assigned(FCDSImages) then
        Exit;
 
 
      with DBCtrlGrid.DataSource do
      begin
        if not FCDSImages.Locate('Reference', DataSet.FieldByName('Reference').AsString, []) then
        begin
          FCDSImages.Append();
          FCDSImages.FieldByName('Reference').AsString := DataSet.FieldByName('Reference').AsString;
          (FCDSImages.FieldByName('Blobbie') as TBlobField).LoadFromFile(DataSet.FieldByName('Path').AsString + DataSet.FieldByName('FileName').AsString);
          FCDSImages.Post();
        end;
 
        MS := TMemoryStream.Create();
        try
          Bmp := TBitmap.Create();
          try
            (FCDSImages.FieldByName('Blobbie') as TBlobField).SaveToStream(MS);
            MS.Seek(0, soBeginning);
            Bmp.LoadFromStream(MS);
 
            LRect := Rect(DBTextFileName.Left, DBTextFileName.Top + DBTextFileName.Height, DBCtrlGrid.PanelWidth, DBCtrlGrid.PanelHeight);
            if Bmp.Width < DBCtrlGrid.PanelWidth then
            begin
              LRect.Left := (DBCtrlGrid.PanelWidth - Bmp.Width) div 2;
              LRect.Width := Bmp.Width;
            end;
            if Bmp.Height < DBCtrlGrid.PanelHeight then
            begin
              LRect.Top := (DBCtrlGrid.PanelHeight - Bmp.Height) div 2;
              LRect.Height := Bmp.Height;
            end;
            DBCtrlGrid.Canvas.StretchDraw(LRect, Bmp);
          finally
            Bmp.Free();
          end;
        finally
          MS.Free();
        end;
      end;
    finally
      DeleteObject(Brush);
    end;
  end;
end;
 
 
procedure TForm1.DBGridFilesDrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
  LRect: TRect;
  Brush: HBrush;
  MS: TMemoryStream;
  Bmp: TBitmap;
begin
  if Sender is TDBGrid then
  begin
    if Column.FieldName = 'Blobbie' then
    begin
      if Odd(TDBGrid(Sender).DataSource.DataSet.RecNo) then
      begin
        Brush := CreateSolidBrush(ColorToRGB(clMoneyGreen));
        try
          LRect := Rect;
          FillRect(TDBGrid(Sender).Canvas.Handle, LRect, Brush);
 
          if not Assigned(FCDSImages) then
            Exit;
 
          with TDBGrid(Sender).DataSource do
          begin
            if not FCDSImages.Locate('Reference', DataSet.FieldByName('Reference').AsString, []) then
            begin
              FCDSImages.Append();
              FCDSImages.FieldByName('Reference').AsString := DataSet.FieldByName('Reference').AsString;
              (FCDSImages.FieldByName('Blobbie') as TBlobField).LoadFromFile(DataSet.FieldByName('Path').AsString + DataSet.FieldByName('FileName').AsString);
              FCDSImages.Post();
            end;
 
            MS := TMemoryStream.Create();
            try
              Bmp := TBitmap.Create();
              try
                (FCDSImages.FieldByName('Blobbie') as TBlobField).SaveToStream(MS);
                MS.Seek(0, soBeginning);
                Bmp.LoadFromStream(MS);
 
 
                if Bmp.Width < LRect.Width then
                begin
                  LRect.Left := LRect.Left + (LRect.Width - Bmp.Width) div 2;
                  LRect.Width := Bmp.Width;
                end;
                if Bmp.Height < LRect.Height then
                begin
                  LRect.Top := LRect.Top + (LRect.Height - Bmp.Height) div 2;
                  LRect.Height := Bmp.Height;
                end;
 
                TDBGrid(Sender).Canvas.StretchDraw(LRect, Bmp);
              finally
                Bmp.Free();
              end;
            finally
              MS.Free();
            end;
          end;
 
        finally
          DeleteObject(Brush);
        end;
      end;
    end;
  end;
end;
 
 
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  DSFilesWithBlob.DataSet := nil;
  FreeAndNil(FCDSMasterWithImages);
 
  DSFileBlobs.DataSet := nil;
  FreeAndNil(FCDSImages);
 
  DSFiles.DataSet := nil;
  FreeAndNil(FCDSMaster);
end;
 
{ TBiz }
 
class procedure TBiz.FillMasterDataSet(ADataSet: TDataSet; const AImageDirectory: string);
var
  SR: TSearchRec;
  Path: string;
begin
  Path := IncludeTrailingPathDelimiter(AImageDirectory);
  if FindFirst(Path + '*', faAnyFile, SR) = 0 then
  try
    repeat
      if SR.Attr and faDirectory = faDirectory then
      begin
        if (SR.Name <> '.') and (SR.Name <> '..') then
          FillMasterDataSet(ADataSet, Path + SR.Name);
      end
      else
      begin
        if SameText(ExtractFileExt(SR.Name), '.bmp') then
        begin
          ADataSet.Append();
          ADataSet.FieldByName('FileName').AsString := SR.Name;
          ADataSet.FieldByName('Path').AsString := Path;
          ADataSet.Post();
          ADataSet.Edit();
          ADataSet.FieldByName('Reference').AsString := IntToHex(ADataSet.RecNo, 8);
          ADataSet.Post();
        end;
      end;
    until FindNext(SR) <> 0;
  finally
    FindClose(SR);
  end;
end;
 
end.

la DFM

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
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
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 650
  ClientWidth = 1023
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnDestroy = FormDestroy
  DesignSize = (
    1023
    650)
  PixelsPerInch = 96
  TextHeight = 13
  object edImageDirectory: TEdit
    Left = 8
    Top = 8
    Width = 1007
    Height = 21
    Anchors = [akLeft, akTop, akRight]
    TabOrder = 0
    Text = 'C:\Program Files (x86)\Embarcadero\Studio\17.0\Images'
    ExplicitWidth = 619
  end
  object btnBuildCDSMaster: TButton
    Left = 8
    Top = 35
    Width = 121
    Height = 25
    Caption = ' Build CDS Master'
    TabOrder = 1
    OnClick = btnBuildCDSMasterClick
  end
  object DBGridFiles: TDBGrid
    Left = 8
    Top = 66
    Width = 313
    Height = 576
    Anchors = [akLeft, akTop, akBottom]
    DataSource = DSFiles
    TabOrder = 2
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'Tahoma'
    TitleFont.Style = []
    OnDrawColumnCell = DBGridFilesDrawColumnCell
    Columns = <
      item
        Expanded = False
        FieldName = 'Reference'
        Width = 60
        Visible = True
      end
      item
        Expanded = False
        FieldName = 'FileName'
        Width = 120
        Visible = True
      end
      item
        Expanded = False
        FieldName = 'Blobbie'
        Visible = True
      end
      item
        Expanded = False
        FieldName = 'Path'
        Visible = True
      end>
  end
  object DBCtrlGridFiles: TDBCtrlGrid
    Left = 336
    Top = 66
    Width = 329
    Height = 576
    Anchors = [akLeft, akTop, akBottom]
    ColCount = 3
    DataSource = DSFiles
    PanelHeight = 192
    PanelWidth = 104
    TabOrder = 3
    OnPaintPanel = DBCtrlGridFilesPaintPanel
    object DBTextFileName: TDBText
      Left = 0
      Top = 0
      Width = 104
      Height = 17
      Align = alTop
      DataField = 'FileName'
      DataSource = DSFiles
      ExplicitTop = 16
      ExplicitWidth = 97
    end
  end
  object DBCtrlGridFilesByControl: TDBCtrlGrid
    Left = 686
    Top = 66
    Width = 329
    Height = 576
    Anchors = [akLeft, akTop, akRight, akBottom]
    ColCount = 3
    DataSource = DSFilesWithBlob
    PanelHeight = 192
    PanelWidth = 104
    TabOrder = 4
    OnPaintPanel = DBCtrlGridFilesByControlPaintPanel
    object DBTextFileNameByControl: TDBText
      Left = 0
      Top = 0
      Width = 104
      Height = 17
      Align = alTop
      DataField = 'FileName'
      DataSource = DSFilesWithBlob
      ExplicitLeft = 8
      ExplicitTop = 16
      ExplicitWidth = 65
    end
    object DBImageOfFile: TDBImage
      Left = 0
      Top = 17
      Width = 104
      Height = 175
      Align = alClient
      DataField = 'Blobbie'
      DataSource = DSFilesWithBlob
      TabOrder = 0
      ExplicitLeft = 8
      ExplicitTop = 39
      ExplicitWidth = 89
      ExplicitHeight = 138
    end
  end
  object btnBuildCDSImages: TButton
    Left = 128
    Top = 35
    Width = 121
    Height = 25
    Caption = ' Build CDS Images'
    TabOrder = 5
    OnClick = btnBuildCDSImagesClick
  end
  object btnBuildCDSMasterWithImages: TButton
    Left = 248
    Top = 35
    Width = 161
    Height = 25
    Caption = ' Build CDS Master with Images'
    TabOrder = 6
    OnClick = btnBuildCDSMasterWithImagesClick
  end
  object DSFiles: TDataSource
    Left = 152
    Top = 272
  end
  object DSFileBlobs: TDataSource
    Left = 744
    Top = 296
  end
  object DSFilesWithBlob: TDataSource
    Left = 744
    Top = 352
  end
end

[SergioMaster]

voilà une solution toute simple qui fonctionne et qui ne nécessite pas de contrôle TImage

Hum, pas si sûr c'est la solution que j'avais proposé avec un loadfromfile mais il semblerait que l'essai de LandGreen n'ait pas pu fonctionner, restant sur la première image.
J'ai eu la flemme de contrôler son assertion.

[ShaiLeTroll]

Peut-être que F_DM.AQ_PR n'était pas le DataSet du DataSource du DBCtrlGrid

C'est le problème d'utiliser les objets ainsi, on peut vite se perdre et Papy214 utilise DBCtrlGrid.DataSource.DataSet ce qui ne laisse aucun doute que c'est le bon dataset en cours de défilement.


Après, D7 c'est vieux, peut-être que TDBCtrlGrid ne gère pas bien son Scroll avant le OnPaintPanel et qu'il soit nécessaire d'utiliser le paramètre Index en corrélation avec le RecNo (infâme évidemment)
Cela peut être un vieux bug, cela est tout à fait possible !
On ne peut donc pas apporter de solution à base de Lazy Loading mais la version TClientDataSet contenant la fusion des données et les images en blob chargées à la volée résoud ce problème avec un simple TDBImage, avec 2500 images, il y a un petit temps de latence mais rien de méchant si l'on ajoute une petite barre de progression

Et le TImage le problème c'est il a une seule image, lui-même à son propre Paint, l'image 1 ne serait-elle pas écrasé par la 2 puis la 3 à chaque OnPanelPaint, est-il codé de la même façon en D7 et D10 par exemple ?
En D7, le TImage et TDBCtrlGrid sont-ils vraiment compatibles ?

C'est très différent d'utiliser le Canvas, on dessine directement sans risque d'un Paint asynchrone qui viendrait chercher la mauvaise image mais pour cela le OnPanelPaint doit scroller, dans le cas contraire, cet évènement est inutilisable, il était correct en XE2, ça c'est certain !

En tout cas en D10, par Canvas ou par TDBImage, cela fonctionne, je n'ai pas essayé le TImage.

[Andnotor]

On ne peut donc pas apporter de solution à base de Lazy Loading

Tu devrais arriver à tes fins en gérant OnDataChange du DataSource.

[LandGreen]

voilà une solution toute simple qui fonctionne et qui ne nécessite pas de contrôle TImage ou autre :

Code :

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

1
2
3
4
5
6
7
8
9
10
 
procedure TForm4.DBCtrlGrid1PaintPanel(DBCtrlGrid: TDBCtrlGrid; Index: Integer);
var
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  Bmp.LoadFromFile(DBCtrlGrid.DataSource.DataSet.FieldByName('nom').AsString);
  DBCtrlGrid.Canvas.Draw(600, 20, Bmp);
  Bmp.Free;
end;

La seule "difficulté" est de définir l'emplacement du dessin.

l'emplacement de l'image est dans la colonne N_inv1 de la table produits dont chaque image est nommé : C_pr.jpeg
donc en gros j'ai une colonne qui contient le code du produit C_PR et l'autre le chemin de l'image
comment faire dans ce cas ?

[LandGreen]

voilà une solution toute simple qui fonctionne et qui ne nécessite pas de contrôle TImage ou autre :

Code :

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

1
2
3
4
5
6
7
8
9
10
 
procedure TForm4.DBCtrlGrid1PaintPanel(DBCtrlGrid: TDBCtrlGrid; Index: Integer);
var
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  Bmp.LoadFromFile(DBCtrlGrid.DataSource.DataSet.FieldByName('nom').AsString);
  DBCtrlGrid.Canvas.Draw(600, 20, Bmp);
  Bmp.Free;
end;

La seule "difficulté" est de définir l'emplacement du dessin.

J'ai ajouté un bouton pour afficher le chemin retourné. Cependant, même si le chemin semble correct, un message d'erreur apparaît immédiatement après. Vous pouvez voir le détail en pièce jointe. Voici le code que j'ai utilisé.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
procedure TF_venterapide002.BitBtn1Click(Sender: TObject);
var   Bmp: TBitmap;
  CheminImage, NomImageComplet: string;
begin
CheminImage := DBCtrlGrid1.DataSource.DataSet.FieldByName('N_inv1').AsString;
NomImageComplet := 'C:\LOGIWELL\IMG\'+CheminImage + DBCtrlGrid1.DataSource.DataSet.FieldByName('C_pr').AsString + '.jpg';
 
showmessage(NomImageComplet);
  Bmp := TBitmap.Create;
  Bmp.LoadFromFile(DBCtrlGrid1.DataSource.DataSet.FieldByName('N_inv1').AsString);
  Bmp.LoadFromFile(NomImageComplet);
  DBCtrlGrid1.Canvas.Draw(600, 20, Bmp);
  Bmp.Free;
end;

[der§en]

Ton pb est pas dans la même commande avec une string différente entre la ligne 10 et la 11 (Bmp.LoadFromFile) ?

[LandGreen]

Ton pb est pas dans la même commande avec une string différente entre la ligne 10 et la 11 (Bmp.LoadFromFile) ?

Effectivement, en supprimant la ligne 10 et retestant j'obtiens ce message :

[LandGreen]

Effectivement, en supprimant la ligne 10 et retestant j'obtiens ce message :

et avec ce code :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
procedure TF_venterapide002.BitBtn1Click(Sender: TObject);
var   Bmp: TBitmap;
  CheminImage, NomImageComplet: string;
begin
CheminImage := DBCtrlGrid1.DataSource.DataSet.FieldByName('N_inv1').AsString;
NomImageComplet := CheminImage +'\IMG\'+ DBCtrlGrid1.DataSource.DataSet.FieldByName('C_pr').AsString + '.JPG';
 
showmessage(NomImageComplet);
  Bmp := TBitmap.Create;
  Bmp.LoadFromFile(NomImageComplet);
  DBCtrlGrid1.Canvas.Draw(600, 20, Bmp);
  Bmp.Free;
end;

j'obtiens :

[der§en]

Autre problème, simple à résoudre, c’est que tu veux charger un JPG dans un Bitmap, avec la VCL, ce n’est pas possible directement, il te faut pas passer par un TJPEGImage.

Tu peux regarder un exemple ici: https://www.developpez.net/forums/d1...-jpeg-jpg-png/

Si tu as une potentielle erreur d’existence du fichier, tu devrais tester avec un FileExists avant de vouloir charger l’image.

[Papy214]

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
procedure LoadJpegFromBitmap(Bmp: TBitmap; Fichier: string);
var
  Jpg: TJPEGImage;
begin
  if not FileExists(Fichier) then
    raise Exception.CreateFmt('Le fichier %s est introuvable', [Fichier]);
 
  Jpg := TJPEGImage.Create;
  try
    try
      Jpg.LoadFromFile(Fichier);
      Bmp.Assign(Jpg);
    except
      on E: Exception do
        ShowMessage(Format('Impossible de charger le fichier %s !%s%s', [Fichier, sLineBreak, E.Message]));
    end;
  finally
    FreeAndNil(Jpg);
  end;
end;

[LandGreen]

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
procedure LoadJpegFromBitmap(Bmp: TBitmap; Fichier: string);
var
  Jpg: TJPEGImage;
begin
  if not FileExists(Fichier) then
    raise Exception.CreateFmt('Le fichier %s est introuvable', [Fichier]);
 
  Jpg := TJPEGImage.Create;
  try
    try
      Jpg.LoadFromFile(Fichier);
      Bmp.Assign(Jpg);
    except
      on E: Exception do
        ShowMessage(Format('Impossible de charger le fichier %s !%s%s', [Fichier, sLineBreak, E.Message]));
    end;
  finally
    FreeAndNil(Jpg);
  end;
end;

Pouvez-vous préciser où exactement placer cette procédure dans le code, s'il vous plaît ? Votre réponse semble un peu ambiguë et je souhaite clarifier.

[Papy214]

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
 
 
procedure TF_venterapide002.BitBtn1Click(Sender: TObject);
var   Bmp: TBitmap;
  CheminImage, NomImageComplet: string;
begin
CheminImage := DBCtrlGrid1.DataSource.DataSet.FieldByName('N_inv1').AsString;
NomImageComplet := CheminImage +'\IMG\'+ DBCtrlGrid1.DataSource.DataSet.FieldByName('C_pr').AsString + '.JPG';
 
showmessage(NomImageComplet);
  Bmp := TBitmap.Create;
 
  LoadJpegFromBitmap(Bmp, NomImageComplet);   // <<<<<<<<<<<<<<<<<<<<<<<<<<<
 
  DBCtrlGrid1.Canvas.Draw(600, 20, Bmp);
  Bmp.Free;
end;

[LandGreen]

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
 
 
procedure TF_venterapide002.BitBtn1Click(Sender: TObject);
var   Bmp: TBitmap;
  CheminImage, NomImageComplet: string;
begin
CheminImage := DBCtrlGrid1.DataSource.DataSet.FieldByName('N_inv1').AsString;
NomImageComplet := CheminImage +'\IMG\'+ DBCtrlGrid1.DataSource.DataSet.FieldByName('C_pr').AsString + '.JPG';
 
showmessage(NomImageComplet);
  Bmp := TBitmap.Create;
 
  LoadJpegFromBitmap(Bmp, NomImageComplet);   // <<<<<<<<<<<<<<<<<<<<<<<<<<<
 
  DBCtrlGrid1.Canvas.Draw(600, 20, Bmp);
  Bmp.Free;
end;

Merci pour votre réponse rapide et votre assistance précieuse. Cependant, après avoir suivi vos instructions, je rencontre désormais le message suivant :

[LandGreen]

Merci pour votre réponse rapide et votre assistance précieuse. Cependant, après avoir suivi vos instructions, je rencontre désormais le message suivant :

même en remplaçanat par :

Code :

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

  Image5.Canvas.Draw(600, 20, Bmp);

Je rencontre actuellement un problème où une image blanche est affichée uniquement dans une cellule, alors que mon objectif est d'afficher les images dans toutes les cellules, et non pas uniquement dans la première.

[Invité]

ajouter l'unité Jpeg dans les uses pour la prise en charge des images Jpg

Code :

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

uses jpeg;

et ajouter ce code dans l'évenement OnPaintPanel de DBCtrlGrid1 donc si vos chemins sont correctes ça devrait fonctionner

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
 
procedure TForm1.DBCtrlGrid1PaintPanel(DBCtrlGrid: TDBCtrlGrid;
  Index: Integer);
var
  LRect: TRect;
  Pic: TPicture;
  CheminImage, NomImageComplet: string;
begin
  if Odd(Index div DBCtrlGrid.ColCount) xor Odd(Index mod DBCtrlGrid.ColCount) then
    DBCtrlGrid.Canvas.Brush.Color := clMoneyGreen
  else
    DBCtrlGrid.Canvas.Brush.Color := DBCtrlGrid.Color;
 
  LRect := Rect(0, 0, DBCtrlGrid.PanelWidth, DBCtrlGrid.PanelHeight);
  DBCtrlGrid.Canvas.FillRect(LRect);
  try
    CheminImage := DBCtrlGrid.DataSource.DataSet.FieldByName('N_inv1').AsString;
    NomImageComplet := CheminImage +'\IMG\'+ DBCtrlGrid.DataSource.DataSet.FieldByName('C_pr').AsString + '.JPG';
 
    Pic := TPicture.Create;
    try
      Pic.LoadFromFile(NomImageComplet);
      DBCtrlGrid.Canvas.Draw(0,0, Pic.Graphic);
    finally
      Pic.Free();
    end;
  except
     DBCtrlGrid.Canvas.TextOut(0,0, 'erreur ..');
  end
end;