Discussion: Redimensionner et afficher une image [Lazarus]

  1. #1
    Expert éminent
    Avatar de Jipété
    Profil pro
    Inscrit en
    juillet 2006
    Messages
    5 987
    Détails du profil
    Informations personnelles :
    Localisation : France, Hérault (Languedoc Roussillon)

    Informations forums :
    Inscription : juillet 2006
    Messages : 5 987
    Points : 8 183
    Points
    8 183

    Par défaut Redimensionner et afficher une image

    Bonsoir,

    yes, it's me again.

    Quelqu'un en 2011 a posté un truc léger (j'aime !) que j'ai voulu tester, et mal m'en a pris, ça va encore me (nous !) faire perdre un temps considérable, je crois.

    Parce que, autant le code est court (9e post de cette page, auteur gyts) :
    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
    var
      Form1: TForm1;
      i, r: TRect;
      x, y, xx, yy: integer;
     
    implementation
     
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      {$IFDEF LINUX}
      Image.Picture.LoadFromFile ('/chemin/Programmation/bmp4test.jpg');
      {$ELSE}
      Image.Picture.LoadFromFile ('\\chemin\Programmation\bmp4test.jpg');
      {$ENDIF}
      y := 0;
      x := 0;
      xx := Bckg.Width;
      yy := Bckg.Height;
      r.Top := y; r.Left := x; r.Right := xx; r.Bottom := yy;
      i.Top := 0;
      i.Left := 0;
      i.Right := Image.Width;
      i.Bottom := Image.Height;
      Bckg.Canvas.CopyRect(r, Image.Picture.Bitmap.Canvas, i);
    end;
     
    procedure TForm1.TBChange(Sender: TObject);
    begin
      r.Top    := trunc(y  * TB.Position / 100);
      r.Left   := trunc(x  * TB.Position / 100);
      r.Right  := trunc(xx * TB.Position / 100);
      r.Bottom := trunc(yy * TB.Position / 100);
      Bckg.Canvas.CopyRect(r, Image.Picture.Bitmap.Canvas, i);
    end;
    autant les résultats sont rocambolesques !

    Sous XP, en jouant avec le curseur :
    Nom : resizing_xp.png
Affichages : 92
Taille : 318,9 Ko

    Sous Linux, pas besoin de mettre une image, il n'y a aucun changement de taille en manipulant le curseur.

    Est-ce que vous pensez que chez l'OP ce code a fonctionné ?
    Si oui, que faire pour qu'il fonctionne en 2017 ?
    Il a à vivre sa vie comme ça et il est mûr sur ce mur se creusant la tête : peutêtre qu'il peut être sûr, etc.
    Oui, je milite pour l'orthographe et le respect du trait d'union à l'impératif.
    Après avoir posté, relisez-vous ! Et en cas d'erreur ou d'oubli, il existe un bouton « Modifier », à utiliser sans modération
    On a des lois pour protéger les remboursements aux faiseurs d’argent. On n’en a pas pour empêcher un être humain de mourir de misère.
    Mes 2 cts,
    --
    jp

  2. #2
    Rédacteur/Modérateur
    Avatar de Andnotor
    Profil pro
    Inscrit en
    septembre 2008
    Messages
    4 405
    Détails du profil
    Informations personnelles :
    Localisation : Suisse

    Informations forums :
    Inscription : septembre 2008
    Messages : 4 405
    Points : 8 963
    Points
    8 963

    Par défaut

    Il n'y a pas de reset du fond, normal que l'ancienne image subsiste. Et si tu minimises/maximises la fiche, elle sera vide !

    CopyRect dans OnCreate ne sert à rien, la fiche sera invalidée à l'affichage.

    Il faut invalider le PaintBox dans TBChange et ensuite laisser faire la nature (WM_ERASEBKGND, WM_PAINT)

    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 TForm1.TBChange(Sender: TObject);
    begin
      r.Top    := trunc(y  * TB.Position / 100);
      r.Left   := trunc(x  * TB.Position / 100);
      r.Right  := trunc(xx * TB.Position / 100);
      r.Bottom := trunc(yy * TB.Position / 100);
     
      Bckg.Invalidate;
    end;
     
    procedure TForm1.BckgPaint(Sender: TObject);
    begin
      Bckg.Canvas.CopyRect(r, Image.Picture.Bitmap.Canvas, i);
    end;
    Mais ça entraînera un léger scintillement.
    Pour palier à cela, tu peux aussi te charger de l'effacement des zones "mortes" mais dans tous les cas, OnPaint doit subsister (traitement des rafraîchissements demandés par l'OS).

    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
    procedure TForm1.TBChange(Sender: TObject);
    var
      Rx :TRect;
    begin
      r.Top    := trunc(y  * TB.Position / 100);
      r.Left   := trunc(x  * TB.Position / 100);
      r.Right  := trunc(xx * TB.Position / 100);
      r.Bottom := trunc(yy * TB.Position / 100);
     
      Bckg.Canvas.CopyRect(r, Image1.Picture.Bitmap.Canvas, i);
     
      Bckg.Canvas.Brush.Color := Color;
     
      Rx := i;
      Rx.Left := r.Right;
      Bckg.Canvas.FillRect(Rx);
     
      Rx := i;
      Rx.Top := r.Bottom;
      Bckg.Canvas.FillRect(Rx);
     
      //Bckg.Invalidate;
    end;
     
    procedure TForm1.BckgPaint(Sender: TObject);
    begin
      Bckg.Canvas.CopyRect(r, Image.Picture.Bitmap.Canvas, i);
    end;

  3. #3
    Expert éminent
    Avatar de Jipété
    Profil pro
    Inscrit en
    juillet 2006
    Messages
    5 987
    Détails du profil
    Informations personnelles :
    Localisation : France, Hérault (Languedoc Roussillon)

    Informations forums :
    Inscription : juillet 2006
    Messages : 5 987
    Points : 8 183
    Points
    8 183

    Par défaut

    Citation Envoyé par Andnotor Voir le message
    Il n'y a pas de reset du fond, normal que l'ancienne image subsiste. Et si tu minimises/maximises la fiche, elle sera vide !

    CopyRect dans OnCreate ne sert à rien, la fiche sera invalidée à l'affichage.

    Il faut invalider le PaintBox dans TBChange et ensuite laisser faire la nature (WM_ERASEBKGND, WM_PAINT)
    OMG que de corrections et commentaires ! C'est fou que j'ai pu trouver ce post en ligne sans que personne ne s'en plaigne...

    Le bon code c'est celui-ci :
    Citation Envoyé par Andnotor Voir le message
    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
    procedure TForm1.TBChange(Sender: TObject);
    var
      Rx :TRect;
    begin
      r.Top    := trunc(y  * TB.Position / 100);
      r.Left   := trunc(x  * TB.Position / 100);
      r.Right  := trunc(xx * TB.Position / 100);
      r.Bottom := trunc(yy * TB.Position / 100);
     
      Bckg.Canvas.CopyRect(r, Image1.Picture.Bitmap.Canvas, i);
     
      Bckg.Canvas.Brush.Color := Color;
     
      Rx := i;
      Rx.Left := r.Right;
      Bckg.Canvas.FillRect(Rx);
     
      Rx := i;
      Rx.Top := r.Bottom;
      Bckg.Canvas.FillRect(Rx);
     
      //Bckg.Invalidate;
    end;
     
    procedure TForm1.BckgPaint(Sender: TObject);
    begin
      Bckg.Canvas.CopyRect(r, Image.Picture.Bitmap.Canvas, i);
    end;
    Bien joué !


    Question subsidiaire, relative au code que tu fournis. Si je fais :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
      Rx := i;
      Rx.Left := r.Right;
    //  Bckg.Canvas.FillRect(Rx);
     
    //  Rx := i;
      Rx.Top := r.Bottom;
      Bckg.Canvas.FillRect(Rx);
    je gagne cette horreur en déplaçant le curseur :
    Nom : mieux.jpg
Affichages : 67
Taille : 40,6 Ko

    Pourquoi ? Les lignes que j'ai commentées me semblent redondantes en première lecture
    Il a à vivre sa vie comme ça et il est mûr sur ce mur se creusant la tête : peutêtre qu'il peut être sûr, etc.
    Oui, je milite pour l'orthographe et le respect du trait d'union à l'impératif.
    Après avoir posté, relisez-vous ! Et en cas d'erreur ou d'oubli, il existe un bouton « Modifier », à utiliser sans modération
    On a des lois pour protéger les remboursements aux faiseurs d’argent. On n’en a pas pour empêcher un être humain de mourir de misère.
    Mes 2 cts,
    --
    jp

  4. #4
    Rédacteur/Modérateur
    Avatar de Andnotor
    Profil pro
    Inscrit en
    septembre 2008
    Messages
    4 405
    Détails du profil
    Informations personnelles :
    Localisation : Suisse

    Informations forums :
    Inscription : septembre 2008
    Messages : 4 405
    Points : 8 963
    Points
    8 963

    Par défaut

    Ben non, elles ne le sont pas (si ce n'est que le rectangle en bas à droite est rempli deux fois).

    Si tu fixes le TopLeft à effacer au BottomRight de l'image, les zones directement à sa droite et en dessous ne sont pas touchées.

    Il est possible de faire ça en une passe mais ça implique de travailler avec des régions :
    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.TBChange(Sender: TObject);
    var
      Rgn1, Rgn2 :hRgn;
    begin
      r.Top    := trunc(y  * TB.Position / 100);
      r.Left   := trunc(x  * TB.Position / 100);
      r.Right  := trunc(xx * TB.Position / 100);
      r.Bottom := trunc(yy * TB.Position / 100);
     
      Bckg.Canvas.CopyRect(r, Image1.Picture.Bitmap.Canvas, i);
     
      //Région PaintBox complet
      with i do Rgn1 := CreateRectRgn(Left, Top, Right, Bottom);
     
      //Région Image
      with r do Rgn2 := CreateRectRgn(Left, Top, Right, Bottom);
     
      //Supprime la région Image (Rgn2) de celle du PaintBox (Rgn1)
      //Le résultat est placé dans Rgn1. Rgn1 devient un polygone
      CombineRgn(Rgn1, Rgn1, Rgn2, RGN_XOR);
     
      FillRgn(Bckg.Canvas.Handle, Rgn1, Canvas.Brush.Handle);
     
      //Décommente ces deux ligne pour "voir" la région
    //  Bckg.Canvas.Brush.Color := clRed;
    //  FrameRgn(Bckg.Canvas.Handle, Rgn1, Bckg.Canvas.Brush.Handle, 1, 1);
     
      DeleteObject(Rgn1);
      DeleteObject(Rgn2);
    end;
    On pourrait aussi créer directement la région polygonale par CreatePolygonRegion.

  5. #5
    Expert éminent
    Avatar de Jipété
    Profil pro
    Inscrit en
    juillet 2006
    Messages
    5 987
    Détails du profil
    Informations personnelles :
    Localisation : France, Hérault (Languedoc Roussillon)

    Informations forums :
    Inscription : juillet 2006
    Messages : 5 987
    Points : 8 183
    Points
    8 183

    Par défaut

    Citation Envoyé par Andnotor Voir le message
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
      //Décommente ces deux lignes pour "voir" la région
      Bckg.Canvas.Brush.Color := clRed;
      FrameRgn(Bckg.Canvas.Handle, Rgn1, Bckg.Canvas.Brush.Handle, 1, 1);
    Ben je verrai rien du tout pour la bonne et simple raison que mon Lazarus ne connaît pas FrameRgn...

    Déjà qu'il lui a fallu 2 uses pour avoir droit aux régions : uses LCLIntf, LCLType; // 2 pour Region !...

    M'en suis sorti comme ça :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
      //Décommente ces deux lignes pour "voir" la région
      Bckg.Canvas.Brush.Color := clRed;
    //  FrameRgn(Bckg.Canvas.Handle, Rgn1, Bckg.Canvas.Brush.Handle, 1, 1);
      FillRgn(Bckg.Canvas.Handle, Rgn1, Bckg.Canvas.Brush.Handle);
    Ça donne ça, c'est bien, on comprend tout ! Y a un peu de flicker mais c'est pas bien grave.
    Nom : region_rouge.png
Affichages : 59
Taille : 80,9 Ko

    Citation Envoyé par Andnotor Voir le message
    On pourrait aussi créer directement la région polygonale par CreatePolygonRegion.
    Compliquons pas les choses, pas sûr que ça soit connu : quand je tape CreatePolygonRegion( l'EDI ne me propose pas la liste des paramètres...

    Merci pour ces précisions, merci pour ce dernier bout de code.
    Il a à vivre sa vie comme ça et il est mûr sur ce mur se creusant la tête : peutêtre qu'il peut être sûr, etc.
    Oui, je milite pour l'orthographe et le respect du trait d'union à l'impératif.
    Après avoir posté, relisez-vous ! Et en cas d'erreur ou d'oubli, il existe un bouton « Modifier », à utiliser sans modération
    On a des lois pour protéger les remboursements aux faiseurs d’argent. On n’en a pas pour empêcher un être humain de mourir de misère.
    Mes 2 cts,
    --
    jp

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 2
    Dernier message: 09/05/2016, 11h16
  2. différence entre deux dates : des résultats curieux
    Par Herode dans le forum JavaScript
    Réponses: 3
    Dernier message: 18/04/2007, 17h14
  3. Grouper et concatener des résultats
    Par Koo dans le forum Langage SQL
    Réponses: 3
    Dernier message: 07/07/2004, 10h09
  4. Select, union, éliminer des résultats.
    Par franculo_caoulene dans le forum MS SQL-Server
    Réponses: 4
    Dernier message: 10/06/2004, 09h42
  5. Réponses: 3
    Dernier message: 18/05/2003, 00h16

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo