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

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 !