Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi Immer diese Sanduhr ... (https://www.delphipraxis.net/55491-immer-diese-sanduhr.html)

Rastaman 21. Okt 2005 19:34


Immer diese Sanduhr ...
 
Nabend.

Ich hab ein Fenster erstellt, so, das soll jetzt nicht den Style WS_DLGFRAME haben, weil ich die 3D Kanten nicht brauchen kann.
Allerdings ist der Mauszeiger über meinem Programm immer eine Sanduhr, und die geht auch nicht weg, egal wie lange ich warte.
Muss man da vielleicht noch n anderen Style als Ersatz oder so einsetzen?

Delphi-Quellcode:
  style := GetWindowLong(hwnd, GWL_STYLE);
  SetWindowLong(hwnd, GWL_STYLE, style and (not WS_BORDER)
    and (not WS_DLGFRAME));
Thx schonma :bounce2:

jim_raynor 22. Okt 2005 18:00

Re: Immer diese Sanduhr ...
 
Reagiert denn das Formular? Hast vielleicht die Cursor ausversehen gesetzt?

Rastaman 22. Okt 2005 19:30

Re: Immer diese Sanduhr ...
 
Ne, reagiert, der Cursor is IDC_ARROW :?
Und auch so: Immer am Anfang die Sanduhr, das is bei VCL nich, das nervt langsam :wall:
BTW: Der Hintergrund is ne 300 kb Bitmap und es hat abgerundete Ecken!

alzaimar 22. Okt 2005 19:38

Re: Immer diese Sanduhr ...
 
Grenz den Fehler doch mal ein, irgendwo hast Du den Wurm drin. Ich hab schon krumme Fenster gemacht ohne Frame und nix da mit 'nem Cursor...

Rastaman 22. Okt 2005 19:48

Re: Immer diese Sanduhr ...
 
Hier mal WM_CREATE

Delphi-Quellcode:
        // Fenster zentrieren
        wnd := FindWindow('Progman', nil);
        CenterWindow(wnd, hwnd, HWND_TOP);
        // Fenster style richtig einstellen
        style := GetWindowLong(hwnd, GWL_STYLE);
        SetWindowLong(hwnd, GWL_STYLE, style and (not WS_BORDER));
        // Static für den Hintergrund erstellen
        CreateWindow('STATIC', nil, WS_VISIBLE or WS_CHILD or SS_BITMAP,
          0, 0, width, 55, hwnd, 100, hInstance, nil);
        // Hintergrund laden
        hBmp := LoadImage(hInstance, 'BG\BG.bmp', IMAGE_BITMAP,
          width, height, LR_LOADFROMFILE);
        SendMessage(GetDlgItem(hwnd, 100), STM_SETIMAGE, IMAGE_BITMAP, hBmp);
        // Rund ecken rulez :D
        rgn := CreateRoundRectRgn(0, 0, width, height, 20, 20);
        SetWindowRgn(hwnd, rgn, True);

Luckie 23. Okt 2005 19:20

Re: Immer diese Sanduhr ...
 
Die Nachrichtenschleife wäre wohl der interessantere Code.

Rastaman 23. Okt 2005 19:32

Re: Immer diese Sanduhr ...
 
Hier is ma alles, wird eh Open Source und bin ja auch noch nich so weit.

Delphi-Quellcode:
program SongTickerProf;

{$APPTYPE GUI}

uses
  Windows,
  Messages,
  ShellApi;

{$R Resource\icon.res}
{$INCLUDE Include\nonVCL.pas}

const
  WM_TRAY             = 66672;
  ClassName           = 'ST_Root_Wnd_Class';
  width               = 400;
  height              = 300;

var
  WndClassMain: TWndClassEx;
  msg: TMSG;

  rgnConfig,
  rgnTray,
  rgnExit: hRgn;

  trayIco: TNotifyIconData;

////////////////////////////////////////////////////////////////////////////////
// Funktion : AddTrayIcon
// Kommentar : Trayicon erstellen

function AddTrayIcon(wnd: HWND): Bool;
begin
  Result := False;
  // Iconinformationen setzen
  trayIco.cbSize := SizeOf(TNotifyIconData);
  trayIco.Wnd := wnd;
  trayIco.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
  trayIco.uCallbackMessage := WM_TRAY;
  trayIco.hIcon := LoadIcon(hInstance, MakeIntResource(1));
  trayIco.szTip := 'Song Ticker Beta for WinAmp';
  // Icon setzen
  if Shell_NotifyIcon(NIM_ADD, @trayIco) then
    Result := True;

end;

////////////////////////////////////////////////////////////////////////////////
// Funktion : RemoveTrayIcon
// Kommentar : Trayicon entfernen

function RemoveTrayIcon(wnd: HWND): Bool;
begin
  Result := False;
  // Iconinformationen setzen
  trayIco.cbSize := SizeOf(TNotifyIconData);
  trayIco.Wnd := wnd;
  // Icon entfernen
  if Shell_NotifyIcon(NIM_DELETE, @trayIco) then
    Result := True;
end;

////////////////////////////////////////////////////////////////////////////////
// Funktion : WndFunc
// Kommentar : Nachrichtenschleife des Hauptfensters

function WndFunc(hwnd: HWND; uMsg: UINT; wParam: WPARAM;
  lParam: LPARAM): LResult; stdcall;
var
  wnd    : THandle;
  rec    : TRect;
  rgn    : hRgn;
  hBmp   : hBitmap;
  style  : Cardinal;
  p      : TPoint;
begin
  case uMsg of
    WM_CREATE:
      begin
        // Fenster zentrieren
        wnd := FindWindow('Progman', nil);
        CenterWindow(wnd, hwnd, HWND_TOP);
        // Fenster style richtig einstellen
        style := GetWindowLong(hwnd, GWL_STYLE);
        SetWindowLong(hwnd, GWL_STYLE, style
          and (not WS_BORDER) and (not WS_DLGFRAME));
        // Static für den Hintergrund erstellen
        CreateWindow('STATIC', nil, WS_VISIBLE or WS_CHILD or SS_BITMAP,
          0, 0, width, 55, hwnd, 100, hInstance, nil);
        // Hintergrund laden
        hBmp := LoadImage(hInstance, 'BG\BG.bmp', IMAGE_BITMAP,
          width, height, LR_LOADFROMFILE);
        SendMessage(GetDlgItem(hwnd, 100), STM_SETIMAGE, IMAGE_BITMAP, hBmp);
        // Rund ecken rulez :D
        rgn := CreateRoundRectRgn(0, 0, width, height, 20, 20);
        SetWindowRgn(hwnd, rgn, True);

        // Regionen für "Controls" erstellen
        rgnConfig := CreateRectRgn(6, 272, 76, 289);
        rgnTray := CreateRectRgn(93, 272, 163, 289);
        rgnExit := CreateRectRgn(286, 274, 357, 391);
      end;
    WM_LBUTTONUP:
      begin
        // Klick auf "Controls" abfangen
        GetWindowRect(hwnd, rec);
        GetCursorPos(p);
        p.X := p.X - rec.Left - 5;
        p.Y := p.Y - rec.Top - 5;
        // Config Button
        if PtInRegion(rgnConfig, p.X, p.Y) then
          MessageBox(hwnd, 'CONFIG', nil, MB_OK);
          // TODO: Configuration !!! <----
        // Tray Button
        if PtInRegion(rgnTray, p.X, p.Y) then
        begin
          ShowWindow(hwnd, SW_HIDE);
          AnimateToTray(hwnd);
          AddTrayIcon(hwnd);
        end;
        // Exit Button
        if PtInRegion(rgnExit, p.X, p.Y) then
          SendMessage(hwnd, WM_CLOSE, 0, 0);
      end;
    WM_MOUSEMOVE:
      begin
        ReleaseCapture;
        SendMessage(hwnd, WM_SYSCOMMAND, $F012, 0);
      end;
    WM_TRAY:
      begin
        if lParam = WM_LBUTTONDBLCLK then
        begin
          ShowWindow(hwnd, SW_SHOW);
          RemoveTrayIcon(hwnd);
        end;
      end;
    WM_CLOSE:
      begin
        RemoveTrayIcon(hwnd);
        PostQuitMessage(0);
      end;
  else
    Result := DefWindowProc(hwnd, uMsg, wParam, lParam);
  end;
end;

begin
  RegisterWindowClass(WndClassMain, @WndFunc, ClassName,
    IDC_ARROW, LoadIcon(hInstance, MakeIntResource(1)), COLOR_WINDOW);

  CreateWindow(ClassName, 'SongTicker', WS_VISIBLE or WS_SYSMENU,
    0, 0, width, height, 0, 0, hInstance, nil);

  MessageLoop(msg);
end.
MessageLoop(msg) is halt ne externe Prozedur die halt das while True ... ersetzt.
Ausserdem ist immer am Anfang die Maus ne Sanduhr, ne ganze Zeit lang. Wenn ich das (not WS_DLGFRAME) drin lasse dann geht se überhaupt nich mehr weg :?

//Edit: Folgendes:
Die Sanduhr ist wie immer da und will nicht weggehn (ohne WS_BORDER und WS_DLGFRAME also nur schön Flach das Fenster), so jetzt klick ich in der Taskbar rechts auf das Fenster und das Systemmenü kommt. Jetz is der Cursor keine Sanduhr mehr über dem Fenster, irgendwas stimmt da doch nicht :wall:

Luckie 23. Okt 2005 20:01

Re: Immer diese Sanduhr ...
 
Zitat:

Zitat von Rastaman
);MessageLoop(msg) is halt ne externe Prozedur die halt das while True ... ersetzt.

Und genau die will ich sehen.

Rastaman 23. Okt 2005 20:08

Re: Immer diese Sanduhr ...
 
Delphi-Quellcode:
procedure MessageLoop(msg: TMSG);
begin
  while True do
  begin
    if not GetMessage(msg, 0, 0, 0) then
      break;
    TranslateMessage(msg);
    DispatchMessage(msg);
  end;
end;

Rastaman 24. Okt 2005 14:11

Re: Immer diese Sanduhr ...
 
Liste der Anhänge anzeigen (Anzahl: 1)
Ich häng das mal als exe an, damit man sich auch so mal n Bild davon machen kann mit dieser Sanduhr :?


Alle Zeitangaben in WEZ +1. Es ist jetzt 06:00 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz