Compiliertes Programm läuft nicht auf XP

[Natcree]

es er scheint ein Fenster wie oben schon genannt. Also in dieser Anwendung wird doch nur ein video abgespielt ich kann ja mal den kompletten Code einstellen. Habe das XP system auch schon mit dem aktuellen Codecs versorgt....

Hier mal der Code

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,gifimage, ExtCtrls,shellapi, MPlayer, StdCtrls, colorbutton,
  LMDPNGImage,midaslib;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    MediaPlayer1: TMediaPlayer;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure MediaPlayer1Notify(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}
procedure Delay(Milliseconds: Integer);
var
  Tick: DWord;
  Event: THandle;
begin
  Event := CreateEvent(nil, False, False, nil);
  try
    Tick := GetTickCount + DWord(Milliseconds);
    while (Milliseconds > 0) and
          (MsgWaitForMultipleObjects(1, Event, False, Milliseconds, QS_ALLINPUT) <> WAIT_TIMEOUT) do
    begin
      Application.ProcessMessages;
      if Application.Terminated then Exit;
      Milliseconds := Tick - GetTickcount;
    end;
  finally
    CloseHandle(Event);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
form1.DoubleBuffered:=true;
mediaplayer1.Play;
panel1.Align:=alclient;
borderstyle:=bsnone;
end;

procedure TForm1.MediaPlayer1Notify(Sender: TObject);
begin
  if mediaplayer1.NotifyValue = nvSuccessful then begin
    mediaplayer1.Play;
  end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
form2.Show;
timer1.Enabled:=false;
end;

end.

Und hier die unit 2

Delphi-Quellcode:

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, LMDPNGImage, ExtCtrls, StdCtrls, colorbutton,shellapi;

type
  TForm2 = class(TForm)
    Label1: TLabel;
    Image1: TImage;
    Timer1: TTimer;
    Timer2: TTimer;
    Label2: TLabel;
    Timer3: TTimer;
    function SetWndRegionFromImg(Bmp: TBitmap; TransparentColor: TColor): Boolean;
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

uses Unit1;

{$R *.dfm}

function TForm2.SetWndRegionFromImg(Bmp: TBitmap; TransparentColor: TColor): Boolean;
type
  TTransColState = (trsOn, trsOff);

  TRGBQuadArray = array[WORD] of Cardinal;
  pRGBQuadArray = ^TRGBQuadArray;
var
  TransColState: TTransColState;
  x, y: Integer;
  line: Integer;
  count: Integer;
  rgn, nrgn: THandle;
  pPixelArray: pRGBQuadArray;
begin
  Result := TRUE;

  if Bmp.PixelFormat <> pf32Bit then
    Bmp.PixelFormat := pf32Bit;

  count := 0;
  line := 0;

  rgn := CreateRectRGN(0, 0, 0, 0); // First Init Region
  nrgn := rgn;

  for y := 0 to Bmp.Height - 1 do
  begin
    pPixelArray := Bmp.Scanline[y];
    TransColState := trsOff;
    for x := 0 to Bmp.Width - 1 do
    begin
      if pPixelArray[x] <> COLORREF(TransparentColor) then
      begin
        if TransColState = trsOff then
        begin
          TransColState := trsOn;
          line := x - 1;
          inc(line);
        end;
      end else
      begin
        if TransColState = trsOn then
        begin
          TransColState := trsOff;
          if count < 4096 then
          begin
            nrgn := CreateRectRgn(line, y, x, y + 1);
            {$IFDEF DEBUGMODE}
              bmp.Canvas.Brush.Color := clGreen;
              bmp.Canvas.FillRect(RECT(line, y, x, y + 1));
              sleep(25);
              application.ProcessMessages;
            {$ENDIF DEBUGMODE}
            CombineRgn(Rgn, Rgn, nRgn, RGN_OR);
            inc(Count);
          end else
          begin
            ShowMessage('Debuginfo: To many Regions. Count of Rgn: '#9 + IntToStr(Count));
            Application.Terminate;
          end;
        end;
      end;
      {$IFDEF DEBUGMODE}
         pPixelArray[x] := RGB(random(256), random(256), random(256));
      {$ENDIF DEBUGMODE}
    end;
  end;
  SetWindowRgn(Handle, Rgn, TRUE);
  DeleteObject(Rgn);
  DeleteObject(nRgn);
end;

procedure TForm2.FormCreate(Sender: TObject);
const
  LWA_COLORKEY = 1; // Use crKey as the transparency color.
  LWA_ALPHA = 2; // Use bAlpha to determine the opacity of the layered window..
  WS_EX_LAYERED = $80000;
  USER32DLL = 'user32.dll';
var
  _SetLayeredWindowAttributes: function(hWnd: THandle; TRansparentColor: COLORREF;
    AlphaValue: Byte; Flags: Cardinal): BOOL; stdcall;
var
  hLib: THandle;
begin
  Self.Color := clblack;
  Self.BorderStyle := bsNone;

  if not (Image1.Picture.Graphic is TBitmap) then
  begin
    ShowMessage('Fehler: Image muss ein Bitmap sein !');
    Application.Terminate;
  end;

  {$IFDEF DEBUGMODE}
   // zum sichtbar machen der Form für den DebugMode
   Self.Show;

  {$ENDIF DEBUGMODE}

  hLib := LoadLibrary(USER32DLL);
  @_SetLayeredWindowAttributes := GetProcAddress(hLib, 'SetLayeredWindowAttributes');
  if @_SetLayeredWindowAttributes <> nil then
  begin
    SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
    _SetLayeredWindowAttributes(Self.Handle, COLORREF(clblack), 200, LWA_COLORKEY or LWA_ALPHA);

  end
  else
  begin
    // alternative, im falle das es SetLayeredWindowAttributes nicht gibt
    SetWndRegionFromImg(Image1.Picture.Bitmap, clblack);

  end;
  FreeLibrary(hLib);

  end;

procedure TForm2.Timer1Timer(Sender: TObject);
begin
Label2.Caption:=inttostr(Timer1.tag)+' %';
timer1.Enabled:=false;
timer1.Tag:=timer1.Tag+1;
timer1.Enabled:=true;
if Label2.Caption='0 %' then label1.caption:='Lade Programmbibliotheken ...';
if Label2.Caption='0 %' then timer1.Interval:= 200;
if Label2.Caption='11 %' then label1.caption:='Lade Umgebungsvariablen ...';
if Label2.Caption='11 %' then timer1.interval:= 110;
if Label2.Caption='27 %' then label1.caption:='Lade Laufzeitumgebungen ...';
if Label2.Caption='27 %' then timer1.Interval:= 150;
if Label2.Caption='50 %' then label1.caption:='Lade Umgebungsmatrix ...';
if Label2.Caption='50 %' then timer1.Interval:=300;
if Label2.Caption='78 %' then label1.caption:='Lade Datenbanksystem ...';
if Label2.Caption='78 %' then timer1.Interval:=50;
if Label2.Caption='92 %' then label1.caption:='Lade Vereine ...';
if Label2.Caption='92 %' then timer1.Interval:=20;
if Label2.Caption='100 %' then timer1.Enabled:=false;
if Label2.Caption='100 %' then timer2.enabled:=true;
end;

procedure TForm2.Timer2Timer(Sender: TObject);
begin
Label2.Caption:=inttostr(Timer2.tag)+' %';
if timer2.Tag = 0 then label1.caption:='Lade Spielsystem ...';
if Label2.Caption='0 %' then timer2.Interval:=200;
timer2.Enabled:=false;
timer2.Tag:=timer2.Tag+1;
timer2.Enabled:=true;
if Label2.Caption='21 %' then Label1.Caption:='Spielerdaten werden gelesen ...';
if Label2.Caption='21 %' then timer2.Interval:=20;
if Label2.Caption='50 %' then Label1.Caption:='Spielresourcen werden freigegeben ...';
if Label2.Caption='50 %' then timer2.interval:=100;
if Label2.Caption='76 %' then Label1.Caption:='SpielDatenbank wird geoeffnet ...';
if Label2.Caption='76 %' then timer2.interval:=35;
if Label2.Caption='86 %' then label1.Caption:='Viel Glueck und Gut Holz !!!';
if Label2.Caption='86 %' then timer2.Interval:=1000;
if Label2.Caption='97 %' then label1.caption:= 'Programm wird gestartet !!!';
if Label2.Caption='100 %' then timer2.Enabled:=false;
if Label2.Caption='100 %' then Label2.visible:=false;
if Label2.Caption='100 %' then label1.Visible:=false;
if Label2.Caption='100 %' then image1.Visible:=false;
if Label2.Caption='100 %' then
ShellExecute(Application.Handle,'open',PChar('Billiard.exe'),nil,nil,sw_ShowNormal);
if Label2.Caption='100 %' then close;
end;
procedure TForm2.FormShow(Sender: TObject);
begin
timer3.enabled:=true;
Label1.Caption:='Lade Programmbibliotheken ...';
Label2.Caption:=inttostr(Timer1.tag)+' %';
end;

procedure TForm2.Timer3Timer(Sender: TObject);
begin
timer1.Enabled:=true;
timer3.Enabled:=false;
end;

end.