DLL hält Programm auf

[Luckie]

Ich habe eine DLL, die mir eine SplashScreen beim Programm start anzeigt. Diese DLL erzeugt einfach nur ein Fenster mit dem Bitmap:

Delphi-Quellcode:

library SplashScreen;

{$R 'Resource.res' 'Resource.rc'}

// [..]

function WndProc(hWnd, uMsg, wParam, lParam: DWORD): LRESULT; stdcall;
var
  ps           : TPaintStruct;
  dc           : HDC;
  // [..]
  DlgRect      : TRect;
  DesktopRect  : TRect;
begin
  Result := 0;
  case uMsg of
    WM_DESTROY:
      begin
        if hBitMap <> 0 then
          DeleteObject(hBitMap);
        PostQuitMessage(0);
      end;
    WM_CREATE:
      begin
        GetWindowRect(hWnd, DlgRect);
        GetWindowRect(GetDesktopWindow, DesktopRect);
        DlgWidth := DlgRect.right - DlgRect.left;
        DlgHeight := DlgRect.bottom - DlgRect.top;
        MoveWindow(hWnd, (DesktopRect.right - DlgWidth) div 2,
          (DesktopRect.bottom - DlgHeight) div 2, DlgWidth, DlgHeight, False);
        hBitMap := LoadBitmap(HInstance, BitmapName);
      end;
    WM_PAINT:
      begin
        dc := BeginPaint(hWnd, ps);
        hMemoryDC := CreateCompatibleDC(dc);
        hOldBmp := SelectObject(hMemoryDC, hBitMap);
        GetObject(hBitMap, SizeOf(TBitmap), @bitmap);
        StretchBlt(dc, 0, 0, WndWidth, WndHeight, hMemoryDC, 0, 0, bitmap.bmWidth,
          bitmap.bmHeight, SRCCOPY);
        SelectObject(hMemoryDC, hOldBmp);
        DeleteDC(hMemoryDC);
        EndPaint(hWnd, ps);
      end;
    WM_CLOSE:
      DestroyWindow(hWnd);
    WM_LBUTTONDOWN:
      DestroyWindow(hWnd);
  else
    Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
  end;
end;

procedure ShowBitMap;
var
  wc           : TWndClassEx;
  msg          : TMsg;
begin
  wc.cbSize := SizeOf(TWndClassEx);
  wc.style := CS_HREDRAW or CS_VREDRAW;
  // [..]
  wc.hIconSm := 0;
  RegisterClassEx(wc);
  wnd := CreateWindowEx(0, ClassName, nil, WS_POPUP, Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT), WndWidth, WndHeight, 0, 0, HInstance, nil);
  ShowWindow(wnd, SW_SHOWNORMAL);
  while True do
  begin
    if not GetMessage(msg, 0, 0, 0) then
      Break;
    TranslateMessage(msg);
    DispatchMessage(msg);
  end;
  ExitCode := msg.wParam;
end;

procedure CloseSplashScreen;
begin
  DestroyWindow(wnd);
end;

procedure DllEntry(reason: DWORD);
begin
  if reason = DLL_PROCESS_ATTACH then // When the dll is loaded
    ShowBitMap;
end;

exports
  CloseSplashScreen;

begin
  DllProc := @DllEntry;
  DllEntry(DLL_PROCESS_ATTACH);
end.

Dann habe ich im Programm:

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
const
  Libname = 'SplashScreen.dll';
var
  MyIcon       : TIcon;
  hImgSm       : HIMAGELIST;
  hImgBig      : HIMAGELIST;
  fi           : TSHFileInfo;
  i            : Integer;
  LibHandle: THandle;
  CloseSplashScreen: TCloseSplashScreen;
begin
  LibHandle := LoadLibrary(Libname);

  // ganz viel Code
    
  if LibHandle <> 0 then
  begin
    @CloseSplashScreen := GetProcAddress(LibHandle, 'CloseSplashScreen');
    if Assigned(CloseSplashScreen) then
      CloseSplashScreen;
    FreeLibrary(LibHandle);
  end;
end;

Wie man sieht kann man die SplashScreen auch schließen, wenn man draufklickt. Jetzt verhält es sich so: Die DLL wird geladen und das Fenster aus der DLL auch angezeigt. Jetzt dachte ich, mein Programm macht im Code weiter. Tut es aber nicht. Wenn ich einen Haltepunkt auf die Zeile

Delphi-Quellcode:

if LibHandle <> 0 then

setzte, dann macht er erst da weiter, wenn ich auf die SplashScreen geklickt habe. Was mache ich falsch oder wo ist mein Denkfehler.? Eigentlich sollte es so laufen, dass wenn er fertig ist, die Proztedur aus der DLL aufruft, was auch klappt, und dann die DLL wieder entläd.

[supermuckl]

ich würde da mal mit breakpoints durch die DLL gehen und schauen wo er nimmer weiter macht.. ich denke er bleibt schon in der dll stecken

//edit
kann es mit diesem WM_POPUP evtl zusammen hängen, das dies als "modal" geöffnet wird?

[Luckie]

In der DLL gibt es nichts zum Stecken bleiben:

Delphi-Quellcode:

function WndProc(hWnd, uMsg, wParam, lParam: DWORD): LRESULT; stdcall;
var
  ps           : TPaintStruct;
  dc           : HDC;
  hMemoryDC    : HDC;
  hOldBmp      : DWORD;
  bitmap       : TBitmap;
  DlgHeight    : Integer;
  DlgWidth     : Integer;
  DlgRect      : TRect;
  DesktopRect  : TRect;
begin
  Result := 0;
  case uMsg of
    WM_DESTROY:
      begin
        if hBitMap <> 0 then
          DeleteObject(hBitMap);
        PostQuitMessage(0);
      end;
    WM_CREATE:
      begin
        GetWindowRect(hWnd, DlgRect);
        GetWindowRect(GetDesktopWindow, DesktopRect);
        DlgWidth := DlgRect.right - DlgRect.left;
        DlgHeight := DlgRect.bottom - DlgRect.top;
        MoveWindow(hWnd, (DesktopRect.right - DlgWidth) div 2,
          (DesktopRect.bottom - DlgHeight) div 2, DlgWidth, DlgHeight, False);
        hBitMap := LoadBitmap(HInstance, BitmapName);
      end;
    WM_PAINT:
      begin
        dc := BeginPaint(hWnd, ps);
        hMemoryDC := CreateCompatibleDC(dc);
        hOldBmp := SelectObject(hMemoryDC, hBitMap);
        GetObject(hBitMap, SizeOf(TBitmap), @bitmap);
        StretchBlt(dc, 0, 0, WndWidth, WndHeight, hMemoryDC, 0, 0, bitmap.bmWidth,
          bitmap.bmHeight, SRCCOPY);
        SelectObject(hMemoryDC, hOldBmp);
        DeleteDC(hMemoryDC);
        EndPaint(hWnd, ps);
      end;
    WM_CLOSE:
      DestroyWindow(hWnd);
    WM_LBUTTONDOWN:
      DestroyWindow(hWnd);
  else
    Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
  end;
end;

procedure ShowBitMap;
var
  wc           : TWndClassEx;
  msg          : TMsg;
begin
  wc.cbSize := SizeOf(TWndClassEx);
  wc.style := CS_HREDRAW or CS_VREDRAW;
  wc.lpfnWndProc := @WndProc;
  wc.cbClsExtra := 0;
  wc.cbWndExtra := 0;
  wc.hInstance := HInstance;
  wc.hbrBackground := COLOR_WINDOW + 1;
  wc.lpszMenuName := nil;
  wc.lpszClassName := ClassName;
  wc.hIcon := LoadIcon(0, IDI_APPLICATION);
  wc.hCursor := LoadCursor(0, IDC_ARROW);
  wc.hIconSm := 0;
  RegisterClassEx(wc);
  wnd := CreateWindowEx(WS_EX_TOOLWINDOW, ClassName, 0, WS_POPUP, Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT), WndWidth, WndHeight, 0, 0, HInstance, nil);
  ShowWindow(wnd, SW_SHOWNORMAL);
  while True do
  begin
    if not GetMessage(msg, 0, 0, 0) then
      Break;
    TranslateMessage(msg);
    DispatchMessage(msg);
  end;
  ExitCode := msg.wParam;
end;

An dem WS_POPUP hat es auch nicht gelegen.

[supermuckl]

if not GetMessage(msg, 0, 0, 0) then
Break;

kann es sein, das du da nicht breakst ?
wenn das direkt nach dem dll laden ausgeführt wird, könnte ja dein delphi-dll-lade-code solange warten, bis du hier aus der schleife raus bist oder nicht ?!

also du loadest ja die dll, dann wird dein bitmap gezeichnet, weil die procedur im entry point der dll aufgerufen wird..
evtl wartet da die lade funktion, bis die dll geladen hat ( und da tust du ja in der schleife warten bis ne message kommt oder? )

ich würde die dll ausladen lassen, ohne das bmp zu zeichnen und ohne schleife, dann anzeigen (extra exportierte procedur), dann nach deinem fetten codestück wieder closen lassen

ansonsten, als nicht "nonvcl" coder blick ich da auch nix ;)

[Luckie]

Hat sich eigentlich erledigt. Ich benutze jetzt die Splashscreen Methode von sakura aus der Tutorialsparte.

[w3seek]

wie supermuckl bereits geschrieben hat, ist dein Problem die Message-Loop. GetMessage() liefert naemlich nur dann FALSE zurueck, wenn eine WM_QUIT message fuer den Thread geposted wurde. Der exe loader von windows laedt dein Programm, stellt fest dass es von gewissen DLLs abhaengt, laedt diese DLLs und ruft dort die DllMain() Funktion auf. Das OS waert so lange bis die DllMain() fertig ist und laedt dann die naechste DLL, bis es letztendlich die WinMain() Funktion deiner Applikation aufruft. Wenn du jetzt in einer DllMain() endlos code ausfuehrst, wird das Programm nie fertig geladen werden. Deshalb bietet es sich an, in der DllMain() lediglich einen Splash Thread zu erzeugen der dann so lange laeuft bis das Programm komplett geladen und initialisiert wurde. Dann einfach diesen Thread killen oder im Thread regelmaessig den Zustand des Programms abfragen und jeweils darauf reagieren.

Nur so als Anregung...

[Luckie]

Ja, das habe ich mir heute nacht im bett auch so ähnlich zusammen gereimt. Danke noch mal für den Hinweis.