Comment redimensionner une image ?

**thibouille** · 03/12/2007, 22h21

en gardant les rapports largeur/longueur et en spécifiant un nombre de pixel max (sue ce soit en largeur ou longueur).

Quelqu'un a déjà fait ça ?

**Clorish** · 03/12/2007, 23h47

oui.
Faut calculer le ratio entre le newWidth et le OriginalWidth (R = OriginalWidth/NewWidth)
et calculer le New Height a partir du ratio (R) et du OriginalHeight.
(Desolé pour les formules faut toujours que je les recalcules ...

)

Apres pour retailler, une fois les nouvelles dimentions calculées propotionellement, suffit d'utiliser les fonctions de copie Windows ou delphi(TCanvas) : bitblt, stretchdraw, etc ...
Ou utiliser l'excelente librairie ALGraphics qui applique en plus un lissage a partir de plusieurs algos au choix : Lanczos3, Mitchel ....

[Edit] pour gerer le nombre de pixel max, faut d'abort tester si c'est le width ou le height qui les le plus grand (ie protrait ou paysage) afin de savoir quel valeur du width ou du height servira au calcul du ratio. Car ll'une des 2 dimention sera forcement egale au Max ....
Tu t'en tireras avec une bonne serie de if mais ca passe bien

**thibouille** · 04/12/2007, 08h00

Je vais essayer ça merci

**Gilbert Geyer** · 04/12/2007, 11h01

Bonjour,

Tiens voiçi le code d'une unité où je fais du redimensionnement d'images testé avec formats '*.BMP.DIB.GIF.ICO.JIF.JPG.WMF.EMF':

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
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
unit uTrImages;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, FileCtrl, Buttons, ExtDlgs, StdCtrls, uComm, uFlotte2,
  jpeg, GifImage,
  axCtrls; // TOleGraphic

type
  TfrmTrImages = class(TForm)
     ....
  private
    { Déclarations privées }
    procedure AffPanelVignette(const nomFichier: string; X,Y : integer);
    procedure VignetteMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
  public
    { Déclarations publiques }
  end;

var
  frmTrImages: TfrmTrImages;

  const    cls = #13#10;
  var      LargSrc, HautSrc : Integer; // Largeur et hauteur image Source
           largeurMax  : integer;      // Réductions
           nbVignettes : integer;
           info        : string;

  //--- ------------------------------------------ ----------------------------

   procedure ReDimImageEtFichierJPEG(FileName: string; largeurMax: Integer);
  // Remplace le fichier d'origine par un fichier redimensionné
  // Appelle SmoothResize , LoadJPEGPictureFile , SaveJPEGPictureFile

  function ReDimImageSR(const nomFichier: string; LargeurMax: Integer) : tBitMap;
  // Pour *.BMP, *.JPG et *.WMF avec SmoothResize

  //--- Récup des BitMap à partir de fichiers-image ----------------------------

  function BMPdeBMP(const nomFichierBMP : string) : TBitmap;

  function BMPdeJPEG(const nomFichierJPEG : string): TBitmap;
  // Renvoie le Bmp d'un fichier JPG

  function BMPdeWMF_EMF(const nomFichierWMFEMF : string) : TBitmap;
  // Renvoie le Bmp d'un fichier WMF

  function BMPdeICO(const nomFichierICO : string) : TBitmap;
  // Renvoie le Bmp d'un fichier ICO

  function JPEGdeBMP(var BMP : tBitMap) : TJPEGImage;

  function  ReDimImageSD(const nomFichier: string; LargeurMax: Integer) : tBitMap;
  // Renvoie le Bmp de taille réduite d'un fichier *.BMP, *.JPG ou *.WMF avec StretchDraw
  // si taille > LargeurMax sinon renvoie Bmp en taille réelle

  //--- via OleGraphic ---------------------------------------------------------
  // Formats Supportes = '.BMP.DIB.GIF.ICO.JIF.JPG.WMF.EMF';

  procedure AffFicherImg(const nomFichierImg : string; var Dans : tImage);
  function  BMPdeIMG(const nomFichierImg : string) : tBitMap;
  function  ReDimImageSD2(const nomFichierImg: string; LargeurMax: Integer) : tBitMap;
  function  ReDimImageSD3(const nomFichierImg: string; LargeurMax: Integer) : tBitMap;
  function  ReDimImageSD4(const nomFichierImg: string; LargeurMax: Integer) : TJPEGImage;

implementation

{$R *.DFM}

// ---------------------------------------------------------------------------
// Smoothly Resize un JPEG et JPEGDimensions : Auteur: Andrew Jameson

type    TRGBArray = array[Word] of TRGBTriple;
        pRGBArray = ^TRGBArray;

procedure SmoothResize(var Src, Dst: TBitmap); // variante de StretchDraw
var       x, y: Integer;
          xP, yP: Integer;
          xP2, yP2: Integer;
          SrcLine1, SrcLine2: pRGBArray;
          t3: Integer;
          z, z2, iz2: Integer;
          DstLine: pRGBArray;
          DstGap: Integer;
          w1, w2, w3, w4: Integer;
begin
          Src.PixelFormat := pf24Bit;
          Dst.PixelFormat := pf24Bit;

          if (Src.Width = Dst.Width) and (Src.Height = Dst.Height)
          then Dst.Assign(Src)
          else begin
                  DstLine := Dst.ScanLine[0];
                  DstGap := Integer(Dst.ScanLine[1]) - Integer(DstLine);

                  xP2 := MulDiv(pred(Src.Width), $10000, Dst.Width);
                  yP2 := MulDiv(pred(Src.Height), $10000, Dst.Height);
                  yP := 0;

                  for y := 0 to pred(Dst.Height) do
                  begin
                     xP := 0;

                     SrcLine1 := Src.ScanLine[yP shr 16];

                     if (yP shr 16 < pred(Src.Height))
                     then SrcLine2 := Src.ScanLine[succ(yP shr 16)]
                     else SrcLine2 := Src.ScanLine[yP shr 16];

                     z2 := succ(yP and $FFFF);
                     iz2 := succ((not yp) and $FFFF);
                     for x := 0 to pred(Dst.Width) do
                     begin
                        t3 := xP shr 16;
                        z := xP and $FFFF;
                        w2 := MulDiv(z, iz2, $10000);
                        w1 := iz2 - w2;
                        w4 := MulDiv(z, z2, $10000);
                        w3 := z2 - w4;
                        DstLine[x].rgbtRed := (SrcLine1[t3].rgbtRed * w1 +
                                              SrcLine1[t3 + 1].rgbtRed * w2 +
                                              SrcLine2[t3].rgbtRed * w3 + SrcLine2[t3 + 1].rgbtRed * w4) shr 16;
                        DstLine[x].rgbtGreen := (SrcLine1[t3].rgbtGreen * w1 + SrcLine1[t3 + 1].rgbtGreen * w2 +
                                                SrcLine2[t3].rgbtGreen * w3 + SrcLine2[t3 + 1].rgbtGreen * w4) shr 16;
                        DstLine[x].rgbtBlue := (SrcLine1[t3].rgbtBlue * w1 +
                                               SrcLine1[t3 + 1].rgbtBlue * w2 +
                                               SrcLine2[t3].rgbtBlue * w3 +
                                               SrcLine2[t3 + 1].rgbtBlue * w4) shr 16;
                        Inc(xP, xP2);
                     end; //for
                     Inc(yP, yP2);
                     DstLine := pRGBArray(Integer(DstLine) + DstGap);
                  end; //for
          end; //if
end; //SmoothResize

function LoadJPEGPictureFile(var Bitmap: TBitmap; FilePath, FileName: string): Boolean;
var      JPEGImage: TJPEGImage;
begin    if (FileName = '') then begin Result := False; EXIT; end;
         try // try except
             JPEGImage := TJPEGImage.Create;
             try // test de chargement
               JPEGImage.LoadFromFile(FilePath + FileName);
               // peut faillir avec une Exception
               Bitmap.Assign(JPEGImage);
             finally
               JPEGImage.Free; Result := True;
             end; //try
         except
             Result := False;
         end; //try
end; //LoadJPEGPictureFile

function SaveJPEGPictureFile( Bitmap: TBitmap; FilePath, FileName: string;
                              Quality: Integer): Boolean;
begin    Result := True;
         try
           if ForceDirectories(FilePath) then
           begin
              with TJPegImage.Create do
              begin
                 try
                    Assign(Bitmap);
                    CompressionQuality := Quality;
                    SaveToFile(FilePath + FileName);
                 finally
                    Free;
                 end; //try
              end; //with
           end; //if
         except
           raise;
           Result := False;
         end; //try
end; //SaveJPEGPictureFile

procedure ReDimImageEtFichierJPEG(FileName: string; largeurMax: Integer);
//        Appelle SmoothResize , LoadJPEGPictureFile , SaveJPEGPictureFile
var       OldBitmap: TBitmap;
          NewBitmap: TBitmap;
begin     OldBitmap := TBitmap.Create;
          try
             if LoadJPEGPictureFile(OldBitmap, ExtractFilePath(FileName),
                ExtractFileName(FileName))
             then
                begin
                   if (OldBitmap.Width > largeurMax) then
                   begin
                      NewBitmap := TBitmap.Create;
                      try
                         NewBitmap.Width := largeurMax;
                         NewBitmap.Height := MulDiv(largeurMax, OldBitmap.Height, OldBitmap.Width);                         SmoothResize(OldBitmap, NewBitmap);
                         frmTrImages.Image1.Picture.Bitmap:=NewBitmap;
                         RenameFile(FileName, ChangeFileExt(FileName, '.$$$'));
                         if SaveJPEGPictureFile( NewBitmap, ExtractFilePath(FileName),
                                                 ExtractFileName(FileName), 75)
                         then DeleteFile(ChangeFileExt(FileName, '.$$$'))
                         else RenameFile(ChangeFileExt(FileName, '.$$$'), FileName);
                      finally
                         NewBitmap.Free;
                      end; //try
                   end; //if
                end; //if
             finally
                OldBitmap.Free;
             end; //try
end; // ReDimImageEtFichierJPEG

//---------------------------------------------------------------------------

function BMPdeBMP(const nomFichierBMP : string) : TBitmap;
begin    Result := Nil;
         if (nomFichierBMP = '') then EXIT;
         Result:= TBitmap.Create;
         Result.PixelFormat := pf24Bit;
         try // test de chargement
             Result.LoadFromFile(nomFichierBMP);
         except
             Result.Free; Result:= Nil;
             Result.Palette
         end;
end; // BMPdeBMP


function BMPdeJPEG(const nomFichierJPEG : string): TBitmap;
var      JPEGImage: TJPEGImage;
begin    Result := Nil;
         if (nomFichierJPEG = '') then EXIT;
         try
             JPEGImage := TJPEGImage.Create;
             Result := TBitmap.Create;
             Result.PixelFormat := pf24Bit;
             try // test de chargement
               JPEGImage.LoadFromFile(nomFichierJPEG);
               JPEGImage.DIBNeeded;
               //JPEGImage.JPEGNeeded;
               Result.Assign(JPEGImage);
             finally
               JPEGImage.Free;
             end;
         except
             Result := Nil;
         end;
end; // BMPdeJPEG

function BMPdeWMF_EMF(const nomFichierWMFEMF : string) : TBitmap;
var      MetaFile: TMetafile;
begin    Result := Nil;
         Metafile := TMetaFile.Create;
         if (nomFichierWMFEMF = '') then EXIT;
         try Result := TBitmap.Create;
             Result.PixelFormat := pf24Bit;
             MetaFile.LoadFromFile(nomFichierWMFEMF);
             // Dessine le metafile dans le canvas du Bitmap
             Result.Height := Metafile.Height;
             Result.Width  := Metafile.Width;
             Result.Canvas.Draw(0, 0, MetaFile);
         finally
             MetaFile.Free;
         end;
end;

function BMPdeGIF(const nomFichierGIF : string) : TBitmap;
var      GIFImage :  TGIFImage;
begin    Result := Nil;
         if (nomFichierGIF = '') then EXIT;
         GIFImage := TGIFImage.Create;
         try
            GIFImage.LoadFromFile(nomFichierGIF);
            Result:= TBitmap.Create;
            Result.PixelFormat := pf24bit;
            Result.Assign(GIFImage);
         finally
            GIFImage.Free;
         end;
end;

function BMPdeICO(const nomFichierICO : string) : TBitmap;
var      Icon: TIcon;
begin    Result:= Nil;
         Icon  := TIcon.Create;
         if (nomFichierICO = '') then EXIT;
         try
            Icon.LoadFromFile(nomFichierICO);
            Result:= TBitmap.Create;
            Result.PixelFormat := pf24Bit;
            try // Conversion
               Result.Height:= Icon.Height;
               Result.Width := Icon.Width;
               Result.Canvas.Draw(0, 0, Icon);
            except
               Result.Free; Result:=nil;
            end;
         finally
            Icon.Free;
         end;
end;

function JPEGdeBMP(var BMP : tBitMap) : TJPEGImage;
begin    Result:=TJPEGImage.Create;
         try
            with Result do
            begin PixelFormat := jf24Bit;
                  Grayscale   := False;
                  CompressionQuality := 80;
                  Scale := jsFullSize;
                  Assign(BMP);
                  JpegNeeded;
                  Compress;
            end;
            BMP.Dormant;             // Libère les ressources GDI
            BMP.FreeImage;           // Libère la mémoire.
         except
            on EInvalidGraphic do
            begin Result.Free; Result := nil; end;
         end;
         Application.ProcessMessages;
         BMP.Free;
end;

function  ReDimImageSR(const nomFichier: string; LargeurMax: Integer) : tBitMap;
//        Pour BMP, JPG et  WMF
//        Appelle SmoothResize , LoadJPEGPictureFile, LoadBMPPictureFile
var       OldBitmap: TBitmap; ext : string; ok : boolean;
begin     OldBitmap := TBitmap.Create; ok := false;
          OldBitmap.PixelFormat := pf24Bit;
          try
             ext:=UpperCase(ExtractFileExt(nomFichier));
             if (ext='.JPG') then
             begin OldBitmap:=BMPdeJPEG(nomFichier);
                   ok:=true
             end else
             if (ext='.BMP') then
             begin OldBitmap:=BMPdeBMP(nomFichier);
                   ok:=true
             end else
             if (ext='.WMF') then
             begin OldBitmap:=BMPdeWMF_EMF(nomFichier);
                   ok:=true
             end else sms(ext+' = Format non supporté par ReDimImage');
             if ok then
             begin
                   if (OldBitmap.Width > LargeurMax) then
                   begin
                      Result := TBitmap.Create;
                      try
                         Result.Width := LargeurMax;
                         Result.Height := MulDiv(LargeurMax, OldBitmap.Height, OldBitmap.Width);                         SmoothResize(OldBitmap, Result);
                      finally
                         //NewBitmap.Free; : à libérer ailleurs
                      end; //try
                   end; //if
                end; //if
             finally
                OldBitmap.Free;
             end; //try
end; // ReDimImageSR

function  TailleImage(const nomFichier: string; var Larg,Haut : Integer) : boolean;
const     FormatsSupportes = '.BMP.DIB.GIF.JIF.JPG.WMF.EMF';
var       ext : string; BmpSource : tBitMap;
begin     ext:=UpperCase(ExtractFileExt(nomFichier)); Result:=false;
          if (ext='') or (pos(ext,FormatsSupportes)=0) then
          begin Larg:=-1; Haut:=-1;
                sms(ext+' = Format non supporté par TailleImage');
                EXIT;
          end;
          BmpSource := TBitmap.Create;
          BmpSource.PixelFormat := pf24Bit;
          try
             if (ext='.BMP') or (ext='.DIB') then BmpSource:=BMPdeBMP(nomFichier) else
             if (ext='.JPG') or (ext='.JIF') then BmpSource:=BMPdeJPEG(nomFichier) else
             if (ext='.WMF') or (ext='.EMF') then BmpSource:=BMPdeWMF_EMF(nomFichier) else
             if (ext='.GIF') then BmpSource:=BMPdeGIF(nomFichier);

             Larg:=BmpSource.width; Haut:=BmpSource.height;
             Result:=true;
          finally
             BmpSource.Free;
          end;
end; //TailleImage

function  ReDimImageSD(const nomFichier: string; LargeurMax: Integer) : tBitMap;
//        avec StretchDraw
const     FormatsSupportes = '.BMP.DIB.GIF.JIF.JPG.WMF.EMF';
var       BmpSource: TBitmap; ext : string;
begin     ext:=UpperCase(ExtractFileExt(nomFichier));
          if (ext='') or (pos(ext,FormatsSupportes)=0) then
          begin Result:=nil;
                sms(ext+' = Format non supporté par ReDimImageSD');
                EXIT;
          end;
          BmpSource := TBitmap.Create;
          BmpSource.PixelFormat := pf24Bit;
          Result := TBitmap.Create;
          Result.PixelFormat := pf24Bit;
          try
             if (ext='.BMP') or (ext='.DIB') then BmpSource:=BMPdeBMP(nomFichier) else
             if (ext='.JPG') or (ext='.JIF') then BmpSource:=BMPdeJPEG(nomFichier) else
             if (ext='.WMF') or (ext='.EMF') then BmpSource:=BMPdeWMF_EMF(nomFichier) else
             if (ext='.GIF') then BmpSource:=BMPdeGIF(nomFichier);

             if (BmpSource.Width > LargeurMax) then // Réduction taille
             begin with Result do
                   begin Width := LargeurMax;
                         Height:= MulDiv(LargeurMax, BmpSource.Height, BmpSource.Width);                         Canvas.StretchDraw(Rect(0,0,Result.Width,Result.Height), BmpSource);
                   end;
             end else Result.Assign(BmpSource);    // Restit Taille réelle
          finally
             BmpSource.Free;
          end;
end; //ReDimImageSD

// --- Avec OleGraphic --------------------------------------------------------

procedure AffFicherImg(const nomFichierImg : string; var Dans : tImage);
const     FormatsSupportes = '.BMP.DIB.GIF.ICO.JIF.JPG.WMF.EMF';
var       OleGraphic: TOleGraphic; FS: TFileStream; ext : string;
begin     ext:=UpperCase(ExtractFileExt(nomFichierImg));
          if (ext='') or (pos(ext,FormatsSupportes)=0) then
          begin sms(ext+' = Format non supporté par AffFicherImg');
                EXIT;
          end;
          OleGraphic := TOleGraphic.Create;
          FS := TFileStream.Create(nomFichierImg, fmOpenRead or fmSharedenyNone);
          try
             OleGraphic.LoadFromStream(FS);
             Dans.Picture.Assign(OleGraphic);
             LargSrc:=Dans.Picture.width; HautSrc:=Dans.Picture.Height;
          finally
             FS.Free;
             OleGraphic.Free;
          end;
end;

function  BMPdeIMG(const nomFichierImg : string) : tBitMap;
const     FormatsSupportes = '.BMP.DIB.GIF.ICO.JIF.JPG.WMF.EMF';
var       OleGraphic: TOleGraphic; FS: TFileStream; ext : string; img : tImage;
begin     ext:=UpperCase(ExtractFileExt(nomFichierImg));
          if (ext='') or (pos(ext,FormatsSupportes)=0) then
          begin sms(ext+' = Format non supporté par BMPdeIMG');
                Result:=nil; EXIT;
          end;
          OleGraphic := TOleGraphic.Create;
          FS := TFileStream.Create(nomFichierImg, fmOpenRead or fmSharedenyNone);
          img:= tImage.Create(frmTrImages);
          try
             OleGraphic.LoadFromStream(FS);
             img.Picture.Assign(OleGraphic);
             Result :=tBitmap.create;
             with Result do
             begin PixelFormat:=pf24Bit;
                   Width :=img.Picture.Width;
                   Height:=img.Picture.Height;
                   Canvas.Draw(0, 0, img.Picture.Graphic);
                   LargSrc:=width; HautSrc:=Height;
             end;
             //frmTrImages.Image1.Picture.Assign(Result);
          finally
             fs.Free;
             img.free;
             OleGraphic.Free;
          end;
end; // BMPdeIMG

function  ReDimImageSD2(const nomFichierImg: string; LargeurMax: Integer) : tBitMap;
//        avec StretchDraw
const     FormatsSupportes = '.BMP.DIB.GIF.JIF.JPG.WMF.EMF';
var       BmpSource: TBitmap; ext : string;
begin     ext:=UpperCase(ExtractFileExt(nomFichierImg));
          if (ext='') or (pos(ext,FormatsSupportes)=0) then
          begin Result:=nil;
                sms(ext+' = Format non supporté par ReDimImageSD2');
                EXIT;
          end;
          BmpSource := TBitmap.Create;
          BmpSource.PixelFormat := pf24Bit;
          Result := TBitmap.Create;
          Result.PixelFormat := pf24Bit;
          try
             BmpSource:=BMPdeIMG(nomFichierImg); // << avec Ole <<<
             //frmTrImages.Image1.Picture.Bitmap.Assign(BmpSource);

             if (BmpSource.Width > LargeurMax) then // Réduction taille
             begin with Result do
                   begin Width := LargeurMax;
                         Height:= MulDiv(LargeurMax, BmpSource.Height, BmpSource.Width);
                         Canvas.StretchDraw(Rect(0,0,Result.Width,Result.Height), BmpSource);
                   end;
             end else Result.Assign(BmpSource);    // Restit Taille réelle
          finally
             BmpSource.Free;
          end;
end; //ReDimImageSD2

function  ReDimImageSD3(const nomFichierImg: string; LargeurMax: Integer) : tBitMap;
//        avec StretchDraw et TOleGraphic : limité à un format d'environ 1228x989x16Millions de couleurs
//        qq soit le format Bmp, Jpg ... du fichier
const     FormatsSupportes = '.BMP.DIB.GIF.ICO.JIF.JPG.WMF.EMF';
var       ext : string; FS : TFileStream; OleGraphic: TOleGraphic;
          img : TImage; BmpSource: TBitmap;
begin     ext:=UpperCase(ExtractFileExt(nomFichierImg));
          if (ext='') or (pos(ext,FormatsSupportes)=0) then
          begin sms(ext+' = Format non supporté par ReDimImageSD3');
                Result:=nil; EXIT;
          end;
          // Etape 1 : récup du BmpSource
          OleGraphic := TOleGraphic.Create;
          FS := TFileStream.Create(nomFichierImg, fmOpenRead or fmSharedenyNone);
          img:= tImage.Create(frmTrImages);
          BmpSource := TBitmap.Create;
          try
             OleGraphic.LoadFromStream(FS);
             img.Picture.Assign(OleGraphic);
             with BmpSource do
             begin PixelFormat:=pf24Bit;
                   Width:=img.Picture.Width;
                   Height:=img.Picture.Height;
                   Canvas.Draw(0, 0, img.Picture.Graphic);
                   LargSrc:=width; HautSrc:=Height;
             end;
             Application.ProcessMessages;
          finally
             fs.Free;
             img.free;
             OleGraphic.Free;
          end;
          // Etape 2 : Redimensionnement conditionnel
          Result := TBitmap.Create;
          Result.PixelFormat := pf24Bit;
          try
             if (BmpSource.Width > LargeurMax) then // Réduction taille
             begin with Result do
                   begin Width := LargeurMax;
                         Height:= MulDiv(LargeurMax, BmpSource.Height, BmpSource.Width);
                         Canvas.StretchDraw(Rect(0,0,Result.Width,Result.Height), BmpSource);
                   end;
             end else Result.Assign(BmpSource);    // Sinon Restit Taille réelle
             Application.ProcessMessages;
          finally
             BmpSource.Free;
          end;
end; //ReDimImageSD3

function  ReDimImageSD4(const nomFichierImg: string; LargeurMax: Integer) : TJPEGImage;
var       Bmp : TBitmap;
begin     Bmp:=ReDimImageSD3(nomFichierImg,LargeurMax);
          Result:=JPEGdeBMP(BMP);
end;

//---------------------------------------------------------------------------

var       BmpFondForm : tBitMap;

procedure TfrmTrImages.bNomFichierSourceClick(Sender: TObject);
const     filtre='fichiers (*.bmp;*.jpg;*.jif;*.wmf;*.emf;*.gif;*.dib;*.ico|*.bmp;*.jpg;*.jif;*.wmf;*.emf;*.gif;*.dib;*.ico|tous (*.*)|*.*';
begin     with OpenPictureDialog1 do
          begin Filter:=Filtre;
                if Execute then
                begin EdNomFichier.text:= FileName;
                      bTailleClick(Sender);
                      AffFicherImg(FileName,Image2);
                      //sms(info);
                end;
          end;
end;

procedure TfrmTrImages.bTailleClick(Sender: TObject);
var       ext : string;
begin     ext:=UpperCase(ExtractFileExt(EdNomFichier.text));
          if (ext='.JPG') and (JPEGDimensions(EdNomFichier.text, LargSrc, HautSrc))
          then labDimSource.caption:=intToStr(LargSrc)+'x'+intToStr(HautSrc)
          else if TailleImage(EdNomFichier.text, LargSrc, HautSrc)
               then labDimSource.caption:=intToStr(LargSrc)+'x'+intToStr(HautSrc);
end;

procedure TfrmTrImages.edLargeurMaxChange(Sender: TObject);
begin     panel1.width:=StrToInt(edLargeurMax.text); // réglette pour visu largeur
          LargeurMax:=StrToInt(edLargeurMax.text);
end;

procedure TfrmTrImages.bRedimImageETFichierClick(Sender: TObject);
begin     ReDimImageEtFichierJPEG(EdNomFichier.text, LargeurMax); end;

procedure TfrmTrImages.AffPanelVignette(const nomFichier: string; X,Y : integer);
var       plVi : tPanel; img : tImage;
begin     inc(nbVignettes);
          plVi:=tPanel.create(frmTrImages);
          with plVi do
          begin parent:=frmTrImages;
                DoubleBuffered := true;
                tag:=nbVignettes;
                visible:=false;
                left:=X; top:=Y;
                align:=alNone;
                caption:=nomFichier;
                autoSize:=false;
          end;
          img:=tImage.create(plVi);
          with img do
          begin parent:=plVi; align:=alNone; autosize:=true; // Taille réelle
                left:=0; top:=0; tag:=nbVignettes;
                picture.LoadFromFile(nomFichier);
                onMouseMove:=VignetteMouseMove; // Pour déplacer les vignettes à la souris
          end;
          with plVi do
          begin width:=img.picture.Width;
                height:=img.picture.Height;
                visible:=true;
          end;
end;

procedure TfrmTrImages.VignetteMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
//        Déplacement vignettes
const     SCDragMove = $F014;
var       pa : TControl;
begin     if (ssLeft in Shift) then
          begin ReleaseCapture;
                pa:=(sender as tImage).parent;
                pa.Perform(WM_SysCommand, SCDragMove, 0);
          end;
end;

var       Chemin,nomFi : string; // du Bmp-Réduit
procedure TfrmTrImages.bRedimensionnerClick(Sender: TObject);
var       Bmp : tBitMap;
begin     // Reduction de la taille :
          Bmp:=ReDimImageSD(EdNomFichier.text, LargeurMax);
          // Sauvegarde vers disque :
          Chemin:=extractFilePath(EdNomFichier.text);
          nomFi:=extractFileName(EdNomFichier.text);
          nomFi:='Reduc_'+ChangeFileExt(nomFi,'.bmp');
          bmp.SaveToFile(Chemin+nomFi);
          AFlotte(Chemin+nomFi+' : sauvé',15,clWhite);
          // Affichage dans vignette :
          AffPanelVignette(Chemin+nomFi, 230,40);
          //image1.visible:=true;
          image1.picture.Graphic.Assign(BmpFondForm);
end;

procedure TfrmTrImages.bViaOleBMPClick(Sender: TObject);
var       Bmp : tBitMap;
begin     // Reduction de la taille :
          Bmp:=ReDimImageSD2(EdNomFichier.text, LargeurMax);
          //Bmp:=ReDimImageSD3(EdNomFichier.text, LargeurMax);
          // Sauvegarde vers disque :
          Chemin:=extractFilePath(EdNomFichier.text);
          nomFi:=extractFileName(EdNomFichier.text);
          nomFi:='Reduc_'+ChangeFileExt(nomFi,'.bmp');
          bmp.SaveToFile(Chemin+nomFi);
          AFlotte(Chemin+nomFi+' : sauvé',15,clWhite);
          // Affichage dans vignette :
          AffPanelVignette(Chemin+nomFi, 230,40);
          //image1.visible:=true;
          //image1.picture.Graphic.Assign(BmpFondForm);
end;

procedure TfrmTrImages.bRedimViaOleJPGClick(Sender: TObject);
var       JPG : TJPEGImage;
begin     // Reduction de la taille :
          JPG:=ReDimImageSD4(EdNomFichier.text, LargeurMax);
          // Sauvegarde vers disque :
          Chemin:=extractFilePath(EdNomFichier.text);
          nomFi:=extractFileName(EdNomFichier.text);
          nomFi:='Reduc_'+ChangeFileExt(nomFi,'.jpg');
          JPG.SaveToFile(Chemin+nomFi);
          AFlotte(Chemin+nomFi+' : sauvé',15,clWhite);
          // Affichage dans vignette :
          AffPanelVignette(Chemin+nomFi, 230,40);
          //image1.visible:=true;
          image1.picture.Graphic.Assign(BmpFondForm);
end;

procedure TfrmTrImages.bRedimImgJpgBmpWmfClick(Sender: TObject);
var       Bmp : tBitMap; // avec Smooth
begin     LargeurMax:=StrToInt(edLargeurMax.text);
          Bmp:=ReDimImageSR(EdNomFichier.text, LargeurMax);
          Chemin:=extractFilePath(EdNomFichier.text);
          nomFi:=extractFileName(EdNomFichier.text);
          nomFi:='reduc'+ChangeFileExt(nomFi,'.bmp');
          bmp.SaveToFile(Chemin+nomFi);
          sms(Chemin+nomFi);
          AffPanelVignette(Chemin+nomFi, 220,30);
end;

procedure TfrmTrImages.FormPaint(Sender: TObject);
begin    // paintbox1.Canvas.draw(0,0,image1.Picture.Bitmap);
         // paintbox1.Canvas.draw(0,0,image1.Picture.Graphic);
         // paintbox1.Canvas.draw(0,0,BmpFondForm );

end;

procedure TfrmTrImages.FormShow(Sender: TObject);
begin     edLargeurMax.text:='100';
          nbVignettes:=0;
end;

procedure TfrmTrImages.FormCreate(Sender: TObject);
begin     BmpFondForm:=image1.Picture.Bitmap;

end;

END.

... toutes les paires de lignes du type :

Code :

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

1
2
3
 
       Width := LargeurMax;
       Height:= MulDiv(LargeurMax, BmpSource.Height, BmpSource.Width);

concernent le redimensionnement et la règle de trois pour conserver les proportions de l'image.

A+

**TicTacToe** · 04/12/2007, 15h43

Une autre de fonction que j'ai utilisée (que j'utilise toujours?), ce n'est que le calcul, il n'yaucun traitement d'image ou de recopie d'image.
La fonction te renvoies la position et dimension d'un cadre pour qu'une image source soit affichée et centrée dans un rectangle quelconque sans déformation (en utilisant quand même un stretchdraw derriere...)

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
procedure BitmapPosition( DimCanvas, DimSource : TPoint; var Position, Vide1, Vide2 : TRect );
var
   RSource : Extended;
   RCanvas : Extended;
   DimDest, PosDest : TPoint;
begin
     // rapport du canvas et de l'image sources
     if DimSource.y <> 0
       then RSource := DimSource.x / DimSource.y
       else RSource := 1;
     if DimCanvas.y <> 0
       then RCanvas := DimCanvas.x / DimCanvas.y
       else RCanvas := 1;
     // calcul
     if RCanvas >= RSource then
       begin // l'image est plaquée en vertical
       DimDest.y := DimCanvas.y;
       DimDest.x := Round( DimDest.y * RSource );
       PosDest.x := ( DimCanvas.x - DimDest.x ) div 2;
       PosDest.y := 0;
       // rectangles vides
       if PosDest.x > 0 then
         begin
         Vide1.Left := 0;
         Vide1.Right := PosDest.x;
         Vide1.Top := 0;
         Vide1.Bottom := DimCanvas.y;
         end
       else
         Vide1 := Rect( 0, 0, 0, 0);
       if PosDest.x + DimDest.x < DimCanvas.x then
         begin
         Vide2.Left := PosDest.x + DimDest.x;
         Vide2.Right := DimCanvas.x;
         Vide2.Top := 0;
         Vide2.Bottom := DimCanvas.y;
         end
       else
         Vide2 := Rect( 0, 0, 0, 0);
       end
     else
       begin // l'image est plaquée en horizontal
       DimDest.x := DimCanvas.x;
       DimDest.y := Round( DimDest.x / RSource );
       PosDest.y := ( DimCanvas.y - DimDest.y ) div 2;
       PosDest.x := 0;
       // rectangles vide
       if PosDest.y > 0 then
         begin
         Vide1.Left := 0;
         Vide1.Right := DimCanvas.x;
         Vide1.Top := 0;
         Vide1.Bottom := PosDest.y;
         end
       else
         Vide1 := Rect( 0, 0, 0, 0);
       if PosDest.y + DimDest.y < DimCanvas.y then
         begin
         Vide2.Left := 0;
         Vide2.Right := DimCanvas.x;
         Vide2.Top := PosDest.y + DimDest.y;
         Vide2.Bottom := DimCanvas.y;
         end
       else
         Vide2 := Rect( 0, 0, 0, 0);
       end;
     // retour
     Position := Rect( PosDest.x, PosDest.y,
                       PosDest.x + DimDest.x, PosDest.y + DimDest.y );
end;

De souvenir:
DimCanvas -> taille du canvas destination dans laquelle tu veux afficher ton image
DimSource -> taille de ton image source
Position (en retour) -> position de l'image dans le canvas destination
Pos1 et Pos2 (en retour) -> positions des rectangles éventuellement inutilisé dans le canvas destination.

**Lusso** · 04/12/2007, 16h14

Et où peut-on télécharger cette librairie ALGraphics ( je n'ai pas trouvé sur le net mais j'suis un peu neuneu ) ?

**Clorish** · 04/12/2007, 17h26

Elle fait partie de a librairie aLCinoe que k'ai trouve sur torry.net a l'epoque.

Si tu ne la trouves pas je tacherais de te l'envoyer

La je ne l'ai pas sous la main

**thibouille** · 04/12/2007, 17h47

Gilbert, Delphi ne trouve pas certaines unités: uComm, uFlotte2, GifImage.

Apparemment GifImage est facilement trouvable mais les deux autres par contre je n'ai pas trouvé ...

**Gilbert Geyer** · 05/12/2007, 12h16

Salut,

A Thibouille :

...Delphi ne trouve pas certaines unités: uComm, uFlotte2, GifImage.

Apparemment GifImage est facilement trouvable mais les deux autres par contre je n'ai pas trouvé ...

1) uComm : c'est une caisse-à-outils dans laquelle l'unité uTrImages n'utilise que la procedure "sms" abréviation de ShowMessage:

Code :

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

1
2
3
 
procedure SMS(s : string);
 begin     clipboard.AsText:=s; Showmessage(s); end;

2) uFlotte2 : c'est unité dans laquelle il y a des variantes de ShowMessage qui s'éffacent automatiquement au bout de quelques secondes et tu peux remplacer dans l'unité uTrImages les instruction du type AFlotte(Chemin+nomFi+' : sauvé',15,clWhite); par ShowMessage(Chemin+nomFi); mais voiçi quand même cette unité :

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
 
unit uFlotte2;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls;
 
type
  TfrmFlotte2 = class(TForm)
    plSupport: TPanel;
    labTitre: TLabel;
    red: TRichEdit;
    Timer1: TTimer;
    procedure labTitreMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure labTitreDblClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure redMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure redSelectionChange(Sender: TObject);
    procedure labTitreClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Déclarations privées }
    duree : Word;
    ad    : tPoint;
  public
    { Déclarations publiques }
    ignoreTempo : boolean;
  end;
 
var
  frmFlotte2: TfrmFlotte2;
 
  procedure AFlotte(msg : string; iduree : Word; icFond : tColor);
            // messages d'une ligne
  procedure RFlotte(msg : string; iduree : Word; icFond : tColor);
  procedure LRFlotte(msg : string; iduree : Word; icFondL,icFondR : tColor);
            // message-liste
  {procedure LFlotte(msg : string; iduree : Word; icFond : tColor);}
  procedure RFlotteBP(msg : string; iduree : Word; icFond : tColor; coteBP : tControl);
 
implementation
 
{$R *.DFM}
 
{ ---------------------------------------------------------------- Durées : - }
 
var       t0,t1 : tDateTime;  Heure,  Min,  Sec,  MSec  : Word;
                              dHeure, dMin, dSec, dMSec : Word;
 
procedure TopC;
begin     t0:=Time; DecodeTime(Now, Heure, Min, Sec, MSec); end;
 
function  fSec : Word;  { renvoie durée en secondes depuis Top }
begin     t1:=time; t1:=t1-t0; DecodeTime(t1,dHeure,dMin,dSec,dMSec);
          fSec:=dSec;
end;
 
{ --------------------------------------------------------- Relance tempo : - }
var       coulFonteTitre : tColor;
procedure TfrmFlotte2.labTitreClick(Sender: TObject);
begin     TopC; labTitre.Font.color:=coulFonteTitre; end;
 
{ --------------------------------------------------------- Ouverture Frm : - }
 
procedure TfrmFlotte2.FormShow(Sender: TObject);
begin     if height>screen.Height
          then red.ScrollBars:=ssVertical else red.ScrollBars:=ssNone;
          coulFonteTitre:=clBlack;
          red.wordWrap:=false;
          if ignoreTempo=false then TopC;
end;
 
{ ------------------------------------------------------- Déplacement Frm : - }
 
procedure TfrmFlotte2.labTitreMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
const     SC_DragMove = $F014;
begin     if (ssLeft in Shift) then
          begin ReleaseCapture;
                TControl(frmFlotte2).Perform(WM_SysCommand, SC_DragMove, 0);
          end;
end;
 
{ -------------------------------------------------------------- Femeture : - }
 
procedure TfrmFlotte2.labTitreDblClick(Sender: TObject);
begin     screen.cursor:=crDefault;
          labTitre.Font.color:=coulFonteTitre; close; end;
 
procedure TfrmFlotte2.Timer1Timer(Sender: TObject);
begin     if ignoreTempo then EXIT;
          if fSec>duree-4 then
          begin if labTitre.color<>clTeal
                then labTitre.Font.color:=clTeal
                else labTitre.Font.color:=clBlack;
 
          end;
          if fSec>duree then labTitreDblClick(Sender); end;
 
{ ------------------------------------------------------------ Affichages : - }
 
procedure AFlotte(msg : string; iduree : Word; icFond : tColor);
var       w,h : integer;
begin     with frmFlotte2 do
          begin labTitre.visible:=true; labTitre.align:=alNone;
                labTitre.font.color:=coulFonteTitre;
                labTitre.caption:=msg; red.visible:=false;
                w:=canvas.textWidth(msg);
                h:=canvas.textHeight(msg);
                labTitre.left:=1; labTitre.top:=1;
                labTitre.width:=w+30;
                labTitre.height:=h+2;
                labTitre.color:=icFond;
                plSupport.width:=labTitre.width+3;
                plSupport.height:=labTitre.height+3;
                plSupport.color:=clBlack;
                clientWidth:=plSupport.width-1;
                clientHeight:=plSupport.height-1;
                if position<>poScreenCenter then position:=poScreenCenter;
                visible:=true;
                duree:=iduree;
                topC;
                refresh;
          end;
end;
 
procedure RFlotte(msg : string; iduree : Word; icFond : tColor);
var       w,h,i,c,lg : integer;
begin     if msg='' then EXIT;
          with frmFlotte2 do
          begin red.visible:=true;
                red.clear; red.paragraph.FirstIndent:=10;
                red.wordWrap:=true;
                red.lines.add(msg);
                {h:=canvas.textHeight(msg);}
                labTitre.visible:=false;
                red.left:=1; red.top:=1;
                c:=red.lines.count; w:=0; h:=0;
                for i:=0 to c-1 do
                begin lg:=canvas.textWidth(red.lines[i]);
                      h:=h+canvas.textHeight(red.lines[i]);
                      if lg>w then w:=lg;
                end;
                red.width:=w+30;
                red.paragraph.FirstIndent:=10;
                {red.height:=h*c+2;}
                red.height:=h+2;
                red.color:=icFond;
                red.selStart:=0;
                plSupport.width:=red.width+3;
                plSupport.height:=red.height+3;
                {plSupport.color:=clBlack;}
                clientWidth:=plSupport.width-1;
                clientHeight:=plSupport.height-1;
                if position<>poScreenCenter then position:=poScreenCenter;
                visible:=true;
                duree:=iduree;
                topC;
          end;
end;
 
procedure LRFlotte(msg : string; iduree : Word; icFondL,icFondR : tColor); //***
var       w,h,i,c,lg,p,wred,hred : integer;
begin     if msg='' then EXIT;
          with frmFlotte2 do
          begin red.visible:=true; labTitre.visible:=true; labTitre.align:=alTop;
                red.clear;        plSupport.caption:='';
                with labTitre do
                begin p:=pos(#13#10,msg);
                      if p>0
                      then begin caption:=copy(msg,1,p); delete(msg,1,p+1); end
                      else caption:=msg;
                      left:=1; top:=1; height:=canvas.textHeight(caption)+1;
                      w:=canvas.textWidth(caption);
                      color:=icFondL;
                end;
                red.paragraph.FirstIndent:=6;
                red.paragraph.RightIndent:=6;
                red.lines.add(msg);
                red.selStart:=0;
                c:=red.lines.count;
                h:=0;
                {red.lines.delete(0);}
                for i:=0 to c-1 do
                begin lg:=canvas.textWidth(red.lines[i]);
                      h:=h+canvas.textHeight(red.lines[i]);
                      if lg>w then w:=lg;
                end;
                wred:=w+5+((12*4) div 3);
                hred:=h+1;
                clientWidth:=wred+2;
                clientHeight:=labTitre.top+labTitre.height+hred+2;
                plSupport.width:=clientWidth;
                plSupport.height:=clientHeight;
                {plSupport.color:=labTitre.color;}
                plSupport.color:=clBlack;
                with red do
                begin left:=1;
                      top:=labTitre.height+2;
                      width:=wred;
                      height:=hred;
                      color:=icFondR;
                end;
                position:=poScreenCenter;
                show;
                duree:=iduree;
                refresh;
                {sms('LRFlotte');}
                topC;
          end;
end; { LRFlotte }
 
procedure RFlotteBP(msg : string; iduree : Word; icFond : tColor; coteBP : tControl);
var       w,h,i,c,lg : integer;
begin     if msg='' then EXIT;
          with frmFlotte2 do
          begin red.visible:=true;
                red.clear; red.paragraph.FirstIndent:=10;
                red.lines.add(msg);
                labTitre.visible:=false;
                red.left:=1; red.top:=1;
                c:=red.lines.count; w:=0; h:=0;
                for i:=0 to c-1 do
                begin lg:=canvas.textWidth(red.lines[i]);
                      h:=h+canvas.textHeight(red.lines[i]);
                      if lg>w then w:=lg;
                end;
                red.width:=w+30;
                red.paragraph.FirstIndent:=10;
                red.height:=h;
                red.color:=icFond;
                red.selStart:=0;
                plSupport.width:=red.width+3;
                plSupport.height:=red.height+3;
                plSupport.color:=clBlack;
                clientWidth:=plSupport.width-1;
                clientHeight:=plSupport.height-1;
                with coteBP do begin ad.x:=left+width+5; ad.y:=0; end;
                ad:=coteBP.clientToScreen(ad);
                left:=ad.x; top:=ad.y;
                visible:=true;
                duree:=iduree;
                topC;
          end;
end; { RFlotteBP }
 
procedure TfrmFlotte2.redMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin     topC; labTitre.Font.color:=coulFonteTitre; end; { : prolongation }
 
procedure TfrmFlotte2.redSelectionChange(Sender: TObject);
begin     red.CopyToClipboard; end;
 
procedure TfrmFlotte2.FormCreate(Sender: TObject);
begin     ignoreTempo:=false; end;
 
END.

... pour utiliser uFlotte2 il faut une Form sur laquelle il faut 1 TTimer, et 1 TPanel (plSupport) et sur ce panel-support tu mets :
- 1 TLabel (labTitre)
- et 1 TRichedit (red) : pour des messages multilignes du style msg := 'tagada' +#13#10 +'ligne2' +#13#10+'ligne3' etc.

3) GifImage : comme tu dis que "GifImage est facilement trouvable" cela m'arrange car cette unité fait 12450 lignes et mon quota de *.ZIP's est saturé.
Par contre si tu rencontres des difficultés passe moi ton e-mail et je t'enverrai le ZIP de la version qui a marché chez moi.

A+

Comment redimensionner une image ?

Langage Delphi

Discussions similaires

Partager

Partager