Tutoriel pour afficher une image dans le fond d'une application MDI

Tous ceux qui à présent ont fait des applications MDI se sont rendu compte de la difficulté de mettre une image dans le fond.

Première précision, ce code est la traduction en Delphi d'une adaptation d'un code de Damon Chandler que j'ai trouvé pour C++Builder. J'ai réorienté le code original pour qu'il s'inscrive plus dans une visée « objet », notamment en implémentant les méthodes dans la classe de fenêtre et non plus en fonctions globales, comme à l'origine. C'est donc cette adaptation que j'ai traduit « mot pour mot » pour Delphi.

Merci à Reynald PIEPZSYK pour l'erreur sur le message WM_PAINT.

Article lu   fois.

L'auteur

Liens sociaux

Viadeo Twitter Facebook Share on Google+   

I. Afficher une image dans le fond d'une application MDI

La stratégie est la suivante : nous allons détourner la méthode originale qui gère la zone client de la fenêtre MDI pour la remplacer par une méthode de substitution qui mettra en place une mosaïque d'image.

Dans le code qui va suivre, j'ai appelé ma Form principale « Main ». Bien sur sa propriété FormStyle est à fsMDIForm;

On en profite pour placer l'image de fond dans un TImage que l'on appelle Background.( attention, il est impératif que l'image placée dans le fond soit un Bitmap que l'on place dans la propriété : Picture.Bitmap du TImage).

Premièrement on va définir deux pointeurs de fonctions que l'on va utiliser pour le traitement des procédures de fenêtres : NewClientWP etOldClientWP ;

On va aussi définir la méthode de dessin qui permet d'afficher une mosaïque à partir de l'image :

 
Sélectionnez
procedure TileBlt( HDestDC :HDC, DestWidth,int DestHeight,HDC HSourceDC,int SourceWidth,int SourceHeight);

Et enfin la nouvelle procédure de fenêtre :

 
Sélectionnez
MDIClientWndProc(var Msg:TMessage );

Soit :

 
Sélectionnez
type
TMain = class(TForm)
Background: TImage;
procedure FormDestroy(Sender: TObject);
private
{ Déclarations privées }
    NewClientWP : FARPROC;
    OldClientWP : FARPROC ;
    procedure TileBlt(HDestDC : HDC; DestWidth : integer; DestHeight : integer;
            HSourceDC : HDC; SourceWidth : integer; SourceHeight:integer);
    procedure MDIClientWndProc(var Msg :TMessage);
public
{ Déclarations publiques }
    constructor Create(AOwner : TComponent);override;
end;

Ensuite dans le constructeur de la Form on va initialiser les pointeurs de fonctions :

 
Sélectionnez
constructor TMain.Create(AOwner : TComponent);
begin
inherited;

   // D'abord pour la nouvelle procédure de fenêtre on crée une instance  
NewClientWP := FARPROC(MakeObjectInstance(MDIClientWndProc));

  // On fait pointer le deuxième pointeur sur l'ancienne WindowProc et on établit la permutation des 
  // WindowProc avec la fonction API SetWindowLong.
  // On remarque que l'on passe en argument le Handle de la zone Client et pas celui de la fenêtre au complet
OldClientWP := FARPROC(SetWindowLong(ClientHandle, GWL_WNDPROC,LONGint(NewClientWP)));

end;

Ensuite on va implémenter la nouvelle méthode qui gère la procédure de fenêtre de la zone client

 
Sélectionnez
procedure TMain.MDIClientWndProc(var Msg :TMessage);
var ThisHdc : HDC ;
begin
    case (Msg.Msg) of //traitement classique du message
        WM_ERASEBKGND: // message "efface le fond"
            begin
                ThisHdc := HDC(Msg.WParam); // récupère le HDC de la fenêtre
                SelectPalette(ThisHdc, Background.Picture.Bitmap.Palette, true);
                {récupère la palette de l'image que l'on a choisi pour fond}
                RealizePalette(ThisHdc); // applique la palette
                TileBlt(ThisHdc, Width, Height,
                Background.Canvas.Handle,
                Background.Picture.Bitmap.Width,
                Background.Picture.Bitmap.Height); // appelle la fonction "Mosaique de l'image"
                Msg.Result := 0;// renvoie un message nul pour pas que l'ancienne WindowProc "intervienne"
              end;// fin case WM_ERASEBKGND 


    WM_QUERYNEWPALETTE :
        begin
            ThisHdc := GetDC(ClientHandle); // récupère le HDC de la fenêtre
            SelectPalette(ThisHdc, Background.Picture.Bitmap.Palette,true);
             {récupère la palette de l'image que l'on a choisi pour fond}
            RealizePalette(ThisHdc);// applique la palette
            InvalidateRect(ClientHandle, nil, true); // provoque le rafraichissement de la zone client
            ReleaseDC(ClientHandle, ThisHdc); // relache le Handle
            Msg.Result := 0;// renvoie un message nul pour pas que l'ancienne WindowProc "intervienne"
        end;
    
   WM_PALETTECHANGED: // message palette changée
    begin
        if  HWND(Msg.WParam) <> ClientHandle then { si le Handle transmis par le message est différent du 
        Handle de la zone client}
            begin
                 ThisHdc := GetDC(ClientHandle); // récupére le Handle de la zone client 
                SelectPalette(ThisHdc, Background.Picture.Bitmap.Palette, true); {récupère la palette de l'image 
                choisie pour fond}
                RealizePalette(ThisHdc); // applique la palette
                UpdateColors(ThisHdc); // raffraichit les couleurs
                ReleaseDC(ClientHandle, ThisHdc); // relache le Handle de la zone client
            end ;
            Msg.Result := 0; // renvoie un message nul pour pas que l'ancienne WindowProc "intervienne"
        end;

    WM_HSCROLL:
        begin
            InvalidateRect(ClientHandle, nil, true); // provoque le rafraichissement de la zone client
        end;

    WM_VSCROLL:// message scroll vertical
        begin
            InvalidateRect(ClientHandle, nil, true); // provoque le rafraichissement de la zone client
        end;

  
    WM_SIZE :
        begin
            InvalidateRect(ClientHandle, nil, true); // provoque le rafraichissement de la zone client
        end

    else
        begin
             // Si le message ne rentre dans aucun des cas suivant, on appelle l'ancienne procédure pour 
             // le traitement "classique" des messages
            Msg.Result := CallWindowProc(OldClientWP, ClientHandle, Msg.Msg,
            Msg.WParam, Msg.LParam);
        end;
    end;
end;

Dans l'événement OnDestroy on libère la procédure de substitution

 
Sélectionnez
procedure TMain.FormDestroy(Sender: TObject);
begin
    SetWindowLong(ClientHandle, GWL_WNDPROC, LONGINT(OldClientWP));
    // remise en place de l'ancienne WindowProc

    FreeObjectInstance(NewClientWP);
    // relachement de la WindowProc de "remplacement" 
    end;

Enfin nous allons implémenter la fonction qui affiche la mosaïque.

 
Sélectionnez
procedure TMain.TileBlt(HDestDC : HDC;DestWidth : integer;DestHeight : integer;
            HSourceDC : HDC;SourceWidth : integer;SourceHeight:integer);
var x,y :integer;
    RelativeX,RelativeY:integer;

begin
    RelativeX:=0;
    RelativeY:=0;

    for y := 0 to (DestHeight div SourceHeight) do
     begin
        for x:= 0 to (DestWidth div SourceWidth) do
         begin
             BitBlt(HDestDC,RelativeX, RelativeY, SourceWidth, SourceHeight, HSourceDC, 0, 0, SRCCOPY);
              // Copie l'image  sur  le "fond" de la zone client
            inc(RelativeX, SourceWidth );
         end;
        inc(RelativeY, SourceHeight );
        RelativeX:=0;
    end;
end;

Voilà tout est là. Pour ceux qui ne veulent pas d'une mosaïque mais une image étirée (voir n'importe quoi d'autre…)

Il faut bien sûr modifier MDIClientWndProc en conséquence.

Par exemple pour l'image étirée voici la partie de code à modifier :

 
Sélectionnez
WM_ERASEBKGND : // message "efface le fond"
    begin
        Hdc: = (HDC)Msg.WParam;         // Récupère le HDC du message 
        SelectPalette(Hdc, Background.Picture.Bitmap.Palette, true);
         // Récupère la palette de l'image que l'on a choisi pour fond 
        RealizePalette(Hdc); // applique la palette
        StretchBlt(Hdc, 0, 0, Width, Height, Background.Canvas.Handle, 0, 0,
        Background.Picture.Bitmap.Width,Background.Picture.Bitmap.Height, SRCCOPY);
         // appelle la fonction "copie en étirant une image" 
         Msg.Result = 0;// renvoie un message nul pour pas que l'ancienne WindowProc "intervienne"
        end;

Bon courage !

Laurent BERNE

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants : Viadeo Twitter Facebook Share on Google+   

  

Copyright © 2001 Laurent BERNE. 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.