Formular auf Desktop zeichnen...

[E307]

Delphi-Quellcode:

unit test;

interface

uses
  Windows, Classes, SysUtils, Messages, Graphics, Forms, Controls, ActiveX, DirectShow9,
  DirectDraw, DSUtil, ComCtrls, MMSystem, OverlayUnit, ExtCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    D3DWidth, D3DHeight: Integer;
    FOldColor, OverlayColor: COLORREF;
   // Löschen und Wiederherstellen der Desktopfarbe und des Hintergrundbildes
    procedure SetDesktopColor(clr:DWord);
    procedure RestoreDesktop;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  XD: TDDOverlay;

implementation

{$R *.dfm}
{$R vres.res}

// Diese beiden Proceduren sind nahezu 1zu1 aus dem Beispiel übersetzt
procedure TForm1.RestoreDesktop;
var
  colorID:Integer;
begin
   // Restore the original desktop wallpaper
   SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, NIL, 0);

   if FOldColor<>CLR_INVALID then begin
      colorID:=COLOR_BACKGROUND;
      SetSysColors(1,colorID,FOldColor);
  end;
end;

procedure TForm1.SetDesktopColor(clr:DWord);
var
  colorID:Integer;
  color:COLORREF;
begin
   // Remember current background color
  if FOldColor=CLR_INVALID then
    FOldColor:=GetSysColor(COLOR_BACKGROUND);

   // Set the desktop background color to the wanted one
  colorID:=COLOR_BACKGROUND;
  color:=clr;
  SetSysColors(1,colorID,color);

   // Remove the desktop wallpaper, without updating the registry
  SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, PChar(''), 0);
end;

procedure TForm1.FormCreate(Sender:TObject);
begin
  // Brauch mer nachher beim Timer (für dieses Beispiel)
  Randomize;

  D3DWidth:=640;
  D3DHeight:=480;

  FOldColor:=CLR_INVALID;

  // Die Overlayfarbe setzen
  OverlayColor:=RGB(8,0,16);

   // Set the desktop background to the color of the dest color key
   SetDesktopColor(OverlayColor);


  // Die TDDOverlay Klasse erstllen
   // Initialize the overlay surface
  try
    XD:=TDDOverlay.Create(D3DWidth,D3DHeight,OverlayColor);
  except
    Application.Terminate;
    Exit;
  end;

  // Stell beim Timer im ObjektInspektor am besten Enabled auf False
  Timer1.Enabled := True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Timer1.Enabled := False;

   // Restore the desktop background
    RestoreDesktop;

   // Remove the overlay
  FreeAndNIL(XD);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  try
    Bitmap.Width := D3DWidth;
    Bitmap.Height := D3DHeight;

    // Da der Hintergrund des Bitmaps weiß ist...
    Bitmap.Canvas.Pen.Color := clBlack;

    Bitmap.Canvas.MoveTo(Random(D3DWidth), Random(D3DHeight));
    Bitmap.Canvas.LineTo(Random(D3DWidth), Random(D3DHeight));

    // Overlay aktualisieren
    XD.Update(Bitmap.Canvas.Handle);
  finally
    FreeAndNIL(Bitmap);
  end;
end;

Code:

Creation of flippable overlay surface failed

Code:

Failed to create overlay surface

Das ist der Code und die (leider) zugehörigen Fehlermeldungen. Hat jemand eine Idee woran das liegt? Ich habe die OverlayUnit schon tausendmal überprüft, aber absolut nichts gefunden!