Developpez.com - Delphi
X

Choisissez d'abord la catégorieensuite la rubrique :

Nono40.developpez.com
Le petit coin du web de Nono40
SOURCES TESTS DELPHI WIN32 AUTOMATISMES DELPHI .NET QUICK-REPORT
Retour à l'accueil
47 - SUPPRIMER LE SCINTILLEMENT AVEC DOUBLEBUFFERED

PRÉSENTATION : Supprimer le scintillement des rafraichissements d'un fenêtre.
ZIP : Téléchargez le zip APERÇUS : -1.jpg-

NOTES : C'est un truc tout simple, et je ne sais plus ou je l'ai vu la première fois...
Ce source est aussi un exemple d'utilisation de la propriété ScanLine du TBitMap pour effectuer un dessin très rapide. Pour soucis de rapidité, le dessin du BitMap est réalisé en assembleur, c'est un des moments ou l'assembleur est le plus utile.
Le code présenté ici montre une fenêtre de sélection de couleur un peu comme celle de Windows. Activez ou non le double-buffer et déplacez rapidement le curseur de sélection de la couleur. Vour verez ainsi la différence de mise à jour.

CODE :
Unit Unit1;
//
// Sujets : Supprimer le scintillement avec la fonction DoubleBuffered
//          Utilisation de TBitMap.ScanLine pour un dessin rapide
//          Intégration de l'assembleur dans un programme Delphi.
//
// Par Nono40 : http://nono40.developpez.com   http://nono40.fr.st
//              mailTo:nono40@fr.st
//
// Le 23/03/2003
//


Interface

Uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls;

Type
  TForm1 = Class(TForm)
    Image1: TImage;
    Image2: TImage;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Panel1: TPanel;
    Curseur2D: TImage;
    Curseur2G: TImage;
    Curseur1D: TImage;
    Curseur1B: TImage;
    Curseur1G: TImage;
    Curseur1H: TImage;
    lRouge: TLabel;
    lVert: TLabel;
    lBleu: TLabel;
    CheckBox1: TCheckBox;
    Viseur: TImage;
    Procedure FormCreate(Sender: TObject);
    Procedure FormDestroy(Sender: TObject);
    Procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    Procedure Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    Procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    Procedure Image2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    Procedure CheckBox1Click(Sender: TObject);
  Private
    { Déclarations privées }
    // Contient l'image principale de sélection de la couleur de bas
    Image:TBitMap;
    // Contient l'image de la bande de sélection de la luminosité.
    Bande:TBitMap;
  Public
    { Déclarations publiques }
    Procedure MAJBande(Couleur:TColor);
    Procedure MAJPanneau;
  End;

Var
  Form1: TForm1;

Implementation

{$R *.dfm}

Procedure TForm1.FormCreate(Sender: TObject);
Const
// Le tableau points contients les points de couleurs qui seront dégradés
// dans l'image de base ( Rouge - Jaune - Vert - Cyan - Bleu - Violet - Rouge )
  Points:Array[0..6]Of Array[1..3]Of Integer=
      (($00,$00,$FF),($00,$FF,$FF),($00,$FF,$00),($FF,$FF,$00),
       ($FF,$00,$00),($FF,$00,$FF),($00,$00,$FF));
Var P : Pointer;
Begin
  // Création du bit map principal
  Image:=TBitMap.Create;
  Image.Width       := 64*6;
  Image.Height      := 256+1;
  Image.PixelFormat := pf32Bit;
  P                 := Image.ScanLine[0];
  Asm
    // Il faut par principe sauvegarder ces trois registres
    // car ils sont utilisés par Delphi
    PUSH EBX
    PUSH EDI
    PUSH ESI

    // EDI va pointer dans le bit map
    MOV  EDI,P
    // ESI va poointer dans le tableau Points
    XOR  ESI,ESI

      // Début de la boucle principale qui sera effectuée trois fois
      // un fois pour le bleu puis le vert en enfin le rouge
@LD:  PUSH EDI
      PUSH ESI

@L2:    XOR  ECX,ECX

@L1:      // On calcul d'abord dans EBX la valeur du haut de l'image
          // pour la couleur en court ( B V ou R ). C'est une moyenne
          // pondérée entre les deux points du tableau Points.
          MOV  EBX,DWord ptr Points[ESI+12]
          SUB  EBX,DWord ptr Points[ESI]
          IMUL EBX,ECX
          SHR  EBX,6
          ADD  EBX,DWord ptr Points[ESI]

          // On prépare ensuite le calcul des points situés en dessous
          PUSH EDI
          XOR  EDX,EDX

@LA:        // Les points en dessous sont une moyenne pondérée entre le
            // point du haut et le gris moyen ( 128 , 128 , 128 )
            MOV  EAX,128
            SUB  EAX,EBX
            IMUL EAX,EDX
            SHR  EAX,8
            ADD  EAX,EBX

            // Le point est stocké dans le BitMap
            MOV  BYTE PTR [EDI],AL
            // Pour passer au point en dessous il faut diminuer EDI
            // car les lignes d'un BitMap sont stockées à l'envers
            SUB  EDI,64*6*4

            // On continue pour la hauteur de l'image
            INC  EDX
            CMP  EDX,256
            JBE  @LA

          // EDI est remis en haut de l'image
          POP  EDI
          // puis sur le point juste à gauche
          ADD  EDI,4
          // Il faut refaire le calcul pour les 64 points de dégradés
          // répartis entre deux points du tableau Points
          INC  ECX
          CMP  ECX,64
          JB   @L1

        // Ensuite il faut passer sur le point suivant du tableau Points
        ADD  ESI,12
        CMP  ESI,72
        JB   @L2

      // Enfin il faut revenir au début de l'image pour effectuer
      // les autres couleurs primaires
      POP  ESI
      POP  EDI
      INC  EDI
      ADD  ESI,4
      CMP  ESI,12
      JB   @LD

    // Il faut rendre à Delphi ce qui appartient à Delphi
    POP  ESI
    POP  EDI
    POP  EBX
  
End;
  Image1.Picture.Assign(Image);

  // Création de l'image servant au dessin de la bande
  Bande:=TBitMap.Create;
  Bande.Width       := 16;
  Bande.Height      := 256+1;
  Bande.PixelFormat := pf32Bit;

  // Mise à jour de la Bande et mise en place des curseurs
  Image1MouseMove(Nil,[ssLeft],128,128);
  Image2MouseMove(Nil,[ssLeft],0  ,128);
  CheckBox1Click(Nil);
End;

Procedure TForm1.FormDestroy(Sender: TObject);
Begin
  // Ne pas oublier de libérer les composants non visuels
  Image.Free;
  Bande.Free;
End;

Procedure TForm1.MAJBande(Couleur: TColor);
Var
  P : Pointer;
Begin
  P := Bande.ScanLine[0];

  // Mise à jour du BitMap de la bande
  // Le principe est le même que le dessin de base
  Asm
    PUSH EBX
    PUSH EDI
    PUSH ESI

    MOV  EDI,P
    MOV  EDX,3

@L2:  PUSH EDI
      XOR  ECX,ECX
@L1:    XOR  EAX,EAX
        MOV  AL,Byte Ptr Couleur+2
        SUB  EAX,255
        IMUL EAX,ECX
        SHR  EAX,7
        ADD  EAX,255

        XOR  EBX,EBX
        MOV  BL,Byte Ptr Couleur+2
        NEG  EBX
        IMUL EBX,ECX
        SHR  EBX,7
        ADD  BL,Byte Ptr Couleur+2

        MOV  ESI,16
@LL:    DEC  ESI
        MOV  BYTE PTR [EDI+ESI*4],AL
        MOV  BYTE PTR [EDI+ESI*4-128*16*4],BL
        JNZ  @LL

        SUB  EDI,16*4
        INC  ECX
        CMP  ECX,128
        JBE  @L1

      POP  EDI
      INC  EDI
      SHL  COULEUR,8
      DEC  EDX
      JNZ  @L2

    POP  ESI
    POP  EDI
    POP  EBX
  
End;
  Image2.Picture.Assign(Bande);
  MAJPanneau;
End;

Procedure TForm1.MAJPanneau;
Var Couleur:TColor;
Begin
  // Mise à jour de la couleur choisie
  Couleur      := Image2.Canvas.Pixels[0,Curseur2D.Top - Image2.Top + Curseur2D.Height Div 2];
  Panel1.Color := Couleur;
  // Elle est décomposée en ses trois couleurs de base
  lRouge.Caption := IntToStr((Couleur And $0000FF)      );
  lVert .Caption := IntToStr((Couleur And $00FF00)Shr 8 );
  lBleu .Caption := IntToStr((Couleur And $FF0000)Shr 16);
End;

Procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
Begin
  If   (ssLeft In Shift) Then
  Begin
    // Mise en place des petites images servant de curseur
    // Rien de bien compliqué
    If X<0 Then X:=0;
    If X>=Image1.Width Then X:=Image1.Width-1;
    If Y<0 Then Y:=0;
    If Y>=Image1.Height Then Y:=Image1.Height-1;
    MAJBande(Image1.Canvas.Pixels[x,y]);
    Curseur1D.Top  := Image1.Top  - Curseur1D.Height Div 2 +Y;
    Curseur1G.Top  := Curseur1D.Top + 1;
    Curseur1H.Left := Image1.Left - Curseur1H.Width  Div 2 +X;
    Curseur1B.Left := Curseur1H.Left;
    Viseur.Top     := Curseur1D.Top  - 6;
    Viseur.Left    := Curseur1H.Left - 7;
  End;
End;

Procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
Begin
  If (ssLeft In Shift)Then
  Begin
    // Mise en place des petites images servant de curseur
    // Rien de bien compliqué
    If Y<0 Then Y:=0;
    If Y>=Image2.Height Then Y:=Image2.Height-1;
    Curseur2D.Top := Image2.Top - Curseur2D.Height Div 2 + Y;
    Curseur2G.Top := Curseur2D.Top + 1;
    MAJPanneau;
  End;
End;

Procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
Begin
  // Sur le OnMouseDown la même chose est faire que le OnMouseMove
  Image1MouseMove(Sender,Shift,x,y);
End;

Procedure TForm1.Image2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
Begin
  // Sur le OnMouseDown la même chose est faire que le OnMouseMove
  Image2MouseMove(Sender,Shift,x,y);
End;

Procedure TForm1.CheckBox1Click(Sender: TObject);
Begin
  DoubleBuffered:=CheckBox1.Checked;
End;

End.

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2003 Bruno Guérangé. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.

Responsables bénévoles de la rubrique Delphi : Gilles Vasseur - Alcatîz -