unit main;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;

type
 TForm1 = class(TForm)
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
 private
   FOldDialogWindowProc: TWndMethod;
   procedure DialogWindowProc (var Message: TMessage);
 end;

var
 Form1: TForm1;

implementation
uses
 GraphUtil;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
 AForm: TForm;
begin
 AForm := CreateMessageDialog('Transparent dialog', mtInformation, [mbOk]);
 with AForm.FindComponent('Message') as TLabel do
   Transparent := true;
 FOldDialogWindowProc := AForm.WindowProc;
 AForm.WindowProc := DialogWindowProc;
 AForm.ShowModal;
end;

procedure TForm1.DialogWindowProc(var Message: TMessage);
var
 Wnd: HWND;
 ARect: TRect;
 Canvas: TCanvas;
begin
 if Message.Msg = WM_ERASEBKGND then
   with TWmEraseBkGnd(Message) do
   begin
     Canvas := TCanvas.Create;
     try
       Canvas.Handle := DC;
       Wnd := WindowFromDC(DC);
       Windows.GetClientRect(Wnd, ARect);
       GradientFillCanvas(Canvas, clYellow, clRed, ARect, gdHorizontal);
     finally
       Canvas.Free;
     end;
   end
 else
   FOldDialogWindowProc(Message);
end;

end.