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

Laurent BERNE

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 traduite « mot pour mot » pour Delphi.

Merci à Reynald PIEPZSYK de m'avoir signalé l'erreur sur le message WM_PAINT.

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

- Auteur : Laurent BERNE

- Parution : 7 avril 2001

- Mise à jour : 2 janvier 2020

- Licence : 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.

Sommaire

- I. 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'images.

Dans le code qui va suivre, j'ai appelé ma Form principale « Main ». Bien sûr 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 :

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

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

MDIClientWndProc(var Msg:TMessage );

Soit :

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 :

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

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 choisie 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 choisie pour fond}
RealizePalette(ThisHdc);// applique la palette
InvalidateRect(ClientHandle, nil, true); // provoque le rafraichissement de la zone client
ReleaseDC(ClientHandle, ThisHdc); // relâche le Handle
Msg.Result := 0;// renvoie un message nul pour ne 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); // rafraichit les couleurs
ReleaseDC(ClientHandle, ThisHdc); // relâche le Handle de la zone client
end ;
Msg.Result := 0; // renvoie un message nul pour ne 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 suivants, 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

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.

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 :

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 choisie 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 ne pas que l'ancienne WindowProc "intervienne"
end;

Bon courage !

Laurent BERNE