Discussion :

[Gilbert Geyer]

Bonjour,

Basile : j'ai remarqué que l'on pouvait enregistrer son travail mais je n'ai pas compris comment!

Lorsque on clique sur "Enregister" dans SavePictureDialog1 ça passe le paramètre "Execute" ci-après à true :

Code :

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

1
2
3
if Execute then begin
      imgResized.Picture.Bitmap.SaveToFile(FileName);
    end;

et alors l'instruction imgResized.Picture.Bitmap.SaveToFile(FileName) enregistre le BitMap contenu dans le TImage "imgResized" sur le disque sous le nom de FileName.

Les lignes qui sont au début de la procedure TFrmDemoMain.btnSaveBitmapClick() :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
const nf = 'XBR_Redimensionné.bmp';
var nfc: string;
begin
    with SavePictureDialog1 do begin
    Filter := 'Fichier *.bmp|*.bmp)';
    if FN = '' then FileName := nf else
    begin
      nfc := extractFileName(FN);
      nfc := ChangeFileExt(nfc, '.bmp');
      FileName := 'Redimensionné_' + nfc;
    end;

ne sont rien d'autre qu'un tripatouillage pour fixer la valeur de FileName :
"FN" est le nom du fichier-source chargé, mais c'est une chaîne vide lorsqu'on n'a rien chargé et qu'on veut enregistrer l'agrandissement de l'image-source embarquée par conception et dans ce cas FileName prend la valeur de la constante nf = 'XBR_Redimensionné.bmp'
.... mais si on a chargé un fichier-image on récupère son nom, on change son extension en BMP et on lui colle le préfixe 'Redimensionné_' avant l'enregistrement.

et aussi, comment avez-vous réussi à faire progresser la ProgressBar ?

La routine d'agrandissement XBR est lancée avec l'instruction aBmp := StretchXBR(imgOriginal.Picture.Bitmap, ScaleValue, ProgressBar1.StepIt);

La fonction qui exécute est déclarée ainsi : function StretchXBR(const BmpS: tBitMap; ScaleFactor: Single; const ProgressCallBack: TObjectProc = nil): tBitMap;

Et dans la boucle principale de cette fonction un if Assigned(ProgressCallBack) then ProgressCallBack; actionne la méthode StepIt de la ProgressBar1 en avançant sa position de la valeur spécifiée par la propriété Step.

Et je n'ai pas trop compris la procédure sablier.

A chaque appel elle change la forme du Screen cursor :
- s'il vaut crDefault on le bascule à crHourGlass
- s'il vaut crHourGlass on le bascule à crDefault
Dans les temps anciens crHourGlass provoquait l'apparition d'un curseur en forme de Sablier mais actuellement ce sablier est remplacé par une petite couronne telle qu'une ProgressBar circulaire.
Pour des process qui ne durent pas trop longtemps ça remplace une ProgressBar et simplifie le code (on déclenche la procedure Sablier au début et à la fin du process en question) ... et si le process est instantané on n'a pas le temps de voir le changement.

A+.

EDIT du 30/05/2013 : Oups, ta question au sujet du fonctionnement de la progressBar m'a donné l'occase de repérer une imperfection : j'avais omis d'ajuster la progression à la taille du BitMap agrandi, mais il suffit d'ajouter les deux lignes en vert ci-dessous :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
procedure TFrmDemoMain.bStretchXBRClick(Sender: TObject);
begin
  edMis.text := ''; edMis.Update; //Sablier;
  ProgressBar1.Max:=trunc(imgOriginal.Picture.Bitmap.Height*ScaleValue);
  ProgressBar1.Step:=10;
  GTC := GetTickCount;
  aBmp := StretchXBR(imgOriginal.Picture.Bitmap, ScaleValue, ProgressBar1.StepIt);
  ... // suite  inchangée
  ...
  ...
end;

[Basile le disciple]

Merci pour les réponses, j'ai compris SaveToFile et la procédure sablier mais j'ai quand même un peu plus de mal pour la ProgressBar, je vais essayer de comprendre!

[Paul TOTH]

Merci pour les réponses, j'ai compris SaveToFile et la procédure sablier mais j'ai quand même un peu plus de mal pour la ProgressBar, je vais essayer de comprendre!

la progressbar a une particularité remarquable, un appel à StepIt force sonr réaffichage

ceci dit, la fiche reste figée normalement, avec avant(*) Windows 7 (ou Vista je sais pas) la fenêtre devenait blanche quand on passait une autre fenêtre devant, mais W7 garde une image de toutes les fenêtres et sait la réafficher sans invoquer son événement Paint...donc elle est toujours figée mais elle n'est plus blanche

EDIT: (* je deviens dyslexique du clavier moi)

[Basile le disciple]

Merci pour ces compléments !

[Jipété]

Bonjour,

Oui, je déterre (ça fera bientôt 6 ans), mais c'est pour la bonne cause :

(la version de 2012 est moins bonne en cas d'utilisation d'un fichier *.jpg)

Elle est même franchement mauvaise,
Exemples :

Code :

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

1
2
3
4
5
6
7
dims fic -> dims dans TImage et TLabel
 564x690 -> 890x838
 769x433 -> 814x489
 599x701 -> 634x791
 680x593 -> 720x669
 640x480 -> 677x542
 600x800 -> 635x903

Testé sous D7-PE, je n'ai donc pas les sources pour aller voir ce qui se passe en profondeur, alors j'ai suivi le conseil de GG et remplacé une fonction par l'autre, en corrigeant au passage ce détail :

Code :

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

1
2
3
4
  //img := tImage.Create(pl); //<- petit inconvénient : nécessite un AOwner
  // et on peut ignorer l'[Avertissement] ... La variable 'pl' n'est peut-être pas initialisée
  // ça marche quand-même.
  img := tImage.Create(Application); // jpt : ben yakà prendre la manière de l'ancienne proc

La fonction en question se trouve là (plus cool avec le lien).

Au passage, je vous passe une information : l'ouverture de bitmaps ne supporte pas les .bmp dont la version du header est supérieure à 1 (et le message d'erreur de Delphi n'est vraiment pas explicite : division par zéro en virgule flottante). Il faudrait faire un test sur la version du header, qui doit contenir 28 à l'adresse hexa 0E du fichier.bmp.


Et enfin, si Gilbert passe par là, j'ai une question, à propos d'une ligne trouvée dans le FormCreate :

Code :

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

1
2
3
4
5
6
procedure TFrmDemoMain.FormCreate(Sender: TObject);
begin
  aBmp := TBitmap.Create;
  imgResized.Picture.Bitmap := aBmp;
  TrackBar1Change(self);
  imgResized.Picture.Bitmap.Canvas.Pixels[0, 0] := imgResized.Picture.Bitmap.Canvas.Pixels[0, 0];

À quoi peut bien servir cette ligne 6 ?
Commentée ou pas, je ne vois pas de différence.

[tourlourou]

Bonjour Jean-pierre, je pense que ça sert après redimensionnement, donc éventuelle modification, à refixer la couleur du pixel pris comme définissant la couleur de transparence éventuelle à la valeur de l'image originale.

[Jipété]

Coucou, Yves,

Bonjour Jean-pierre, je pense que ça sert après redimensionnement, donc éventuelle modification, à refixer la couleur du pixel pris comme définissant la couleur de transparence éventuelle à la valeur de l'image originale.

dans le FormCreate ?