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