Vraag & Antwoord

Programmeren

een programma minimmaliseren naar de system tray

11 antwoorden
  • Ik wil dat als ik mijn programam minimaliseer het niet op de start balk komt maar als icoontje op de startbalk net zoals msn en de taakplannet enzo. Hoe doe ik dit?
  • Download het programmatje TrayMin.
  • dit is bij mij niet van toepassing omdat ik een eigen programma in vb heb gemaakt ik wil gewoon de code weten waar het programma gebruik van heeft gemaakt
  • Je zult eens moeten spieken in de volgende code:[code:1:ce22d51ede]program WallPaper; {$R *.RES} uses Windows, Messages, ShellAPI; type TImageList = class private FFileName: string; FMenu_ID: DWORD; FName: string; FNext: TImageList; protected public constructor Create(const AName: string; Previous: TImageList); destructor Destroy; override; property FileName: string read FFileName; property Menu_ID: DWORD read FMenu_ID; property Name: string read FName; property Next: TImageList read FNext; end; { TImageList } const UWM_TRAYICON = WM_USER + 10; MENUITEM_ROTATE = 101; MENUITEM_EXIT = 102; ID_TRAYICON = 1; ExStyle = WS_EX_TOOLWINDOW; Style = WS_CAPTION or WS_SYSMENU or WS_MINIMIZEBOX; StopApp: Boolean = False; sWallPaperWndClass = 'WallPaper TrayIcon'; WallPaperWndClass: TWndClass = ( style: CS_CLASSDC or CS_PARENTDC; lpfnWndProc: nil; cbClsExtra: 0; cbWndExtra: 0; hInstance: 0; hIcon: 0; hCursor: 0; hbrBackground: color_btnface + 1; lpszMenuName: nil; lpszClassName: sWallPaperWndClass); DefaultNotify: TNotifyIconData = ( cbSize: SizeOf(TNotifyIconData); Wnd: 0; uID: ID_TRAYICON; uFlags: NIF_MESSAGE or NIF_ICON or NIF_TIP; uCallBackMessage: UWM_TRAYICON; hIcon: 0; szTip: 'Wallpaper selector'; ); function AddTrayIcon(AHandle: THandle): Boolean; var NotifyIconData: TNotifyIconData; begin NotifyIconData := DefaultNotify; NotifyIconData.Wnd := AHandle; NotifyIconData.hIcon := LoadIcon(hInstance, 'MAINICON'); Result := Shell_NotifyIcon(NIM_ADD, @NotifyIconData); end; function DeleteTrayIcon(AHandle: THandle): Boolean; var NotifyIconData: TNotifyIconData; begin NotifyIconData := DefaultNotify; NotifyIconData.Wnd := AHandle; Result := Shell_NotifyIcon(NIM_DELETE, @NotifyIconData); end; constructor TImageList.Create(const AName: string; Previous: TImageList); const Counter: DWORD = MENUITEM_EXIT + 1; var I, J: Integer; begin FFileName := AName; FName := AName; I := Length(FFileName); while (I > 0) and not (FFileName[I] in ['.', '\']) do Dec(I); if (I > 0) then begin J := I; Dec(I); while (I > 0) and not (FFileName[I] in ['.', '\']) do Dec(I); if (I > 0) then begin Inc(I); FName := Copy(FFileName, I, J - I); end; end; FMenu_ID := Counter; Inc(Counter); FNext := nil; if (Previous <> nil) then Previous.FNext := Self; end; destructor TImageList.Destroy; begin try if (Next <> nil) then Next.Free; finally inherited; end; end; var AFileName: string; AFile: TextFile; ALine: string; ImageList: TImageList = nil; Loop: TImageList = nil; AHandle: THandle; AMsg: TMsg; Rotate: Boolean = False; RotateItem: TImageList = nil; MutexHandle: THandle; procedure SetWallPaper(AName: string); var TempKey: HKey; begin if (RegOpenKeyEx(HKEY_CURRENT_USER, 'Control Panel\Desktop', 0, KEY_ALL_ACCESS, TempKey) = ERROR_SUCCESS) then begin RegSetValueEx(TempKey, 'Wallpaper', 0, REG_SZ, PChar(AName), Length(AName)); RegCloseKey(TempKey); end; SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE); end; function WindowProc(hWnd, uMsg, wParam, lParam: Integer): Integer; stdcall; const FirstCall: Boolean = True; OldRunning: Boolean = True; var Menu: HMENU; Pt: TPoint; begin Result := DefWindowProc(hWnd, uMsg, wParam, lParam); if (uMsg = WM_CONTEXTMENU) then begin GetCursorPos(Pt); Menu := CreatePopupMenu; Loop := ImageList; while (Loop <> nil) do begin AppendMenu(Menu, MFT_STRING, Loop.Menu_ID, PChar(Loop.Name)); Loop := Loop.Next; end; AppendMenu(Menu, MFT_SEPARATOR, WM_NULL, '-'); if Rotate then begin AppendMenu(Menu, MFT_STRING or MFS_CHECKED, MENUITEM_ROTATE, '&Rotate'); end else begin AppendMenu(Menu, MFT_STRING, MENUITEM_ROTATE, '&Rotate'); end; AppendMenu(Menu, MFT_STRING, MENUITEM_EXIT, 'E&xit'); TrackPopupMenu(Menu, TPM_RIGHTBUTTON or TPM_TOPALIGN or TPM_LEFTALIGN, Pt.x, Pt.y, 0, hWnd, nil); DestroyMenu(Menu); end else if (uMsg = UWM_TRAYICON) then begin if (lParam = WM_LBUTTONDOWN) or (lParam = WM_RBUTTONDOWN) then begin PostMessage(hWnd, WM_CONTEXTMENU, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN)); end; end else if (uMsg = WM_TIMER) then begin if (RotateItem <> nil) then RotateItem := RotateItem.Next; if (RotateItem = nil) then RotateItem := ImageList; if (RotateItem <> nil) then SetWallPaper(RotateItem.FileName); end else if (uMsg = WM_MENUSELECT) then begin Loop := ImageList; while (Loop <> nil) and (Loop.Menu_ID <> LOWORD(wParam)) do Loop := Loop.Next; if (Loop <> nil) then SetWallPaper(Loop.FileName); end else if (uMsg = WM_COMMAND) then begin if (LOWORD(wParam) = MENUITEM_EXIT) then begin PostQuitMessage(0); end else if (LOWORD(wParam) = MENUITEM_ROTATE) then begin if Rotate then begin KillTimer(AHandle, 1); end else begin SetTimer(AHandle, 1, 10000, nil); end; Rotate := not Rotate; end else begin Loop := ImageList; while (Loop <> nil) and (Loop.Menu_ID <> LOWORD(wParam)) do Loop := Loop.Next; if (Loop <> nil) then SetWallPaper(Loop.FileName); end; end else if (uMsg = WM_DESTROY) then begin StopApp := True; end; end; begin MutexHandle := CreateMutex(nil, True, sWallPaperWndClass); if (GetLastError = ERROR_ALREADY_EXISTS) then begin CloseHandle(MutexHandle); end else begin try AFileName := Copy(ParamStr(0), 1, Length(ParamStr(0)) - 3) + 'Lst'; AssignFile(AFile, AFileName); Reset(AFile); if (IOResult = 0) then begin while not Eof(AFile) do begin ReadLn(AFile, ALine); if (Loop = nil) then begin Loop := TImageList.Create(ALine, Loop); ImageList := Loop; end else begin Loop := TImageList.Create(ALine, Loop); end; end end; CloseFile(AFile); if (ImageList <> nil) then begin WallpaperWndClass.lpfnWndProc := @WindowProc; RegisterClass(WallpaperWndClass); AHandle := CreateWindowEx(ExStyle, sWallPaperWndClass, nil, Style, 0, 0, 10, 10, GetDesktopWindow, 0, hInstance, nil); AddTrayIcon(AHandle); UpdateWindow(AHandle); while (GetMessage(aMsg, AHandle, 0, 0)) and not StopApp do begin TranslateMessage(aMsg); DispatchMessage(aMsg); end; if Rotate then KillTimer(AHandle, 1); DeleteTrayIcon(AHandle); end; finally ReleaseMutex(MutexHandle) end; end; end.[/code:1:ce22d51ede] Dit tooltje dat ik ooit schreef is een trayicon applicatie die het mogelijk maakt om je desktop wallpaper te wijzigen. Wat het verder nodig heeft is een bestandje met een lijst van bestandsnamen. (Bitmaps) Het werkt wel aardig en is -eenmaal gecompileerd- rond de 24 KB groot. Okay, okay... Het geheim zit hem in de functies AddTrayIcon en DeleteTrayIcon die beiden dezelfde Windows API aanroepen: Shell_NotifyIcon. Kijk verder ook eens op de [url=http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/functions/shell_notifyicon.asp]MSDN site[/url] van Micro$oft.
  • Of google ff naar een '[url=http://www.google.com/search?q=tray+ocx&sourceid=opera&num=0&ie=utf-8&oe=utf-8]tray ocx[/url]'
  • [quote:b5fe8220f6="Workshop Alex"]Je zult eens moeten spieken in de volgende code:[code:1:b5fe8220f6]program WallPaper; {$R *.RES} uses Windows, Messages, ShellAPI; type TImageList = class private FFileName: string; FMenu_ID: DWORD; FName: string; FNext: TImageList; protected public constructor Create(const AName: string; Previous: TImageList); destructor Destroy; override; property FileName: string read FFileName; property Menu_ID: DWORD read FMenu_ID; property Name: string read FName; property Next: TImageList read FNext; end; { TImageList } const UWM_TRAYICON = WM_USER + 10; MENUITEM_ROTATE = 101; MENUITEM_EXIT = 102; ID_TRAYICON = 1; ExStyle = WS_EX_TOOLWINDOW; Style = WS_CAPTION or WS_SYSMENU or WS_MINIMIZEBOX; StopApp: Boolean = False; sWallPaperWndClass = 'WallPaper TrayIcon'; WallPaperWndClass: TWndClass = ( style: CS_CLASSDC or CS_PARENTDC; lpfnWndProc: nil; cbClsExtra: 0; cbWndExtra: 0; hInstance: 0; hIcon: 0; hCursor: 0; hbrBackground: color_btnface + 1; lpszMenuName: nil; lpszClassName: sWallPaperWndClass); DefaultNotify: TNotifyIconData = ( cbSize: SizeOf(TNotifyIconData); Wnd: 0; uID: ID_TRAYICON; uFlags: NIF_MESSAGE or NIF_ICON or NIF_TIP; uCallBackMessage: UWM_TRAYICON; hIcon: 0; szTip: 'Wallpaper selector'; ); function AddTrayIcon(AHandle: THandle): Boolean; var NotifyIconData: TNotifyIconData; begin NotifyIconData := DefaultNotify; NotifyIconData.Wnd := AHandle; NotifyIconData.hIcon := LoadIcon(hInstance, 'MAINICON'); Result := Shell_NotifyIcon(NIM_ADD, @NotifyIconData); end; function DeleteTrayIcon(AHandle: THandle): Boolean; var NotifyIconData: TNotifyIconData; begin NotifyIconData := DefaultNotify; NotifyIconData.Wnd := AHandle; Result := Shell_NotifyIcon(NIM_DELETE, @NotifyIconData); end; constructor TImageList.Create(const AName: string; Previous: TImageList); const Counter: DWORD = MENUITEM_EXIT + 1; var I, J: Integer; begin FFileName := AName; FName := AName; I := Length(FFileName); while (I > 0) and not (FFileName[I] in ['.', '\']) do Dec(I); if (I > 0) then begin J := I; Dec(I); while (I > 0) and not (FFileName[I] in ['.', '\']) do Dec(I); if (I > 0) then begin Inc(I); FName := Copy(FFileName, I, J - I); end; end; FMenu_ID := Counter; Inc(Counter); FNext := nil; if (Previous <> nil) then Previous.FNext := Self; end; destructor TImageList.Destroy; begin try if (Next <> nil) then Next.Free; finally inherited; end; end; var AFileName: string; AFile: TextFile; ALine: string; ImageList: TImageList = nil; Loop: TImageList = nil; AHandle: THandle; AMsg: TMsg; Rotate: Boolean = False; RotateItem: TImageList = nil; MutexHandle: THandle; procedure SetWallPaper(AName: string); var TempKey: HKey; begin if (RegOpenKeyEx(HKEY_CURRENT_USER, 'Control Panel\Desktop', 0, KEY_ALL_ACCESS, TempKey) = ERROR_SUCCESS) then begin RegSetValueEx(TempKey, 'Wallpaper', 0, REG_SZ, PChar(AName), Length(AName)); RegCloseKey(TempKey); end; SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE); end; function WindowProc(hWnd, uMsg, wParam, lParam: Integer): Integer; stdcall; const FirstCall: Boolean = True; OldRunning: Boolean = True; var Menu: HMENU; Pt: TPoint; begin Result := DefWindowProc(hWnd, uMsg, wParam, lParam); if (uMsg = WM_CONTEXTMENU) then begin GetCursorPos(Pt); Menu := CreatePopupMenu; Loop := ImageList; while (Loop <> nil) do begin AppendMenu(Menu, MFT_STRING, Loop.Menu_ID, PChar(Loop.Name)); Loop := Loop.Next; end; AppendMenu(Menu, MFT_SEPARATOR, WM_NULL, '-'); if Rotate then begin AppendMenu(Menu, MFT_STRING or MFS_CHECKED, MENUITEM_ROTATE, '&Rotate'); end else begin AppendMenu(Menu, MFT_STRING, MENUITEM_ROTATE, '&Rotate'); end; AppendMenu(Menu, MFT_STRING, MENUITEM_EXIT, 'E&xit'); TrackPopupMenu(Menu, TPM_RIGHTBUTTON or TPM_TOPALIGN or TPM_LEFTALIGN, Pt.x, Pt.y, 0, hWnd, nil); DestroyMenu(Menu); end else if (uMsg = UWM_TRAYICON) then begin if (lParam = WM_LBUTTONDOWN) or (lParam = WM_RBUTTONDOWN) then begin PostMessage(hWnd, WM_CONTEXTMENU, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN)); end; end else if (uMsg = WM_TIMER) then begin if (RotateItem <> nil) then RotateItem := RotateItem.Next; if (RotateItem = nil) then RotateItem := ImageList; if (RotateItem <> nil) then SetWallPaper(RotateItem.FileName); end else if (uMsg = WM_MENUSELECT) then begin Loop := ImageList; while (Loop <> nil) and (Loop.Menu_ID <> LOWORD(wParam)) do Loop := Loop.Next; if (Loop <> nil) then SetWallPaper(Loop.FileName); end else if (uMsg = WM_COMMAND) then begin if (LOWORD(wParam) = MENUITEM_EXIT) then begin PostQuitMessage(0); end else if (LOWORD(wParam) = MENUITEM_ROTATE) then begin if Rotate then begin KillTimer(AHandle, 1); end else begin SetTimer(AHandle, 1, 10000, nil); end; Rotate := not Rotate; end else begin Loop := ImageList; while (Loop <> nil) and (Loop.Menu_ID <> LOWORD(wParam)) do Loop := Loop.Next; if (Loop <> nil) then SetWallPaper(Loop.FileName); end; end else if (uMsg = WM_DESTROY) then begin StopApp := True; end; end; begin MutexHandle := CreateMutex(nil, True, sWallPaperWndClass); if (GetLastError = ERROR_ALREADY_EXISTS) then begin CloseHandle(MutexHandle); end else begin try AFileName := Copy(ParamStr(0), 1, Length(ParamStr(0)) - 3) + 'Lst'; AssignFile(AFile, AFileName); Reset(AFile); if (IOResult = 0) then begin while not Eof(AFile) do begin ReadLn(AFile, ALine); if (Loop = nil) then begin Loop := TImageList.Create(ALine, Loop); ImageList := Loop; end else begin Loop := TImageList.Create(ALine, Loop); end; end end; CloseFile(AFile); if (ImageList <> nil) then begin WallpaperWndClass.lpfnWndProc := @WindowProc; RegisterClass(WallpaperWndClass); AHandle := CreateWindowEx(ExStyle, sWallPaperWndClass, nil, Style, 0, 0, 10, 10, GetDesktopWindow, 0, hInstance, nil); AddTrayIcon(AHandle); UpdateWindow(AHandle); while (GetMessage(aMsg, AHandle, 0, 0)) and not StopApp do begin TranslateMessage(aMsg); DispatchMessage(aMsg); end; if Rotate then KillTimer(AHandle, 1); DeleteTrayIcon(AHandle); end; finally ReleaseMutex(MutexHandle) end; end; end.[/code:1:b5fe8220f6] [/quote:b5fe8220f6] Allemachtig. :o :o Kent Delphi geen commentaar?
  • Ik heb gemerkt dat de code gee vb is renminste gene vb er waren immers nogal wat dingen rood en zoials ik het ken worden variablelen anders ingesteld. Maar toch bedankt voor je reactie
  • [quote:5dd2841b4d="Laurens"] Allemachtig. :o :o Kent Delphi geen commentaar?[/quote:5dd2841b4d] [code:1:5dd2841b4d]//jawel dit is commentaar[/code:1:5dd2841b4d]
  • ik denk dat dat sarcastisch was bedoeld :wink:
  • [quote:04dcd21b03="sdk"]ik denk dat dat sarcastisch was bedoeld :wink:[/quote:04dcd21b03] Neu, niet sarcastisch, meer beetje plagerig. Was wat verbaasd over de bulk aan toch niet echt self-documenting code waar geen open regel en geen letter commentaar in te ontdekken was.
  • Ach, commentaar? Wie heeft dat nu nodig? ;) Ik heb echter gezegd waar meer informatie terug te vinden is, namelijk op de MSDN site en de functies AddTrayIcon en DeleteTrayIcon. En als je deze functies bekijkt zie je dat deze ook niet veel documentatie nodig hebben. TrayIcon applicaties zijn vrij eenvoudig in gebruik. Er is maar 1 API functie die je hoeft te gebruiken. En deze is vrij multi-functioneel. De code is inderdaad Delphi en geen VB maar aangezien ik me beperkt heb tot de standaard Windows API zou iedereen die een beetje met de API bekend zijn de code moeten kunnen volgen. Voor wie dat niet kan valt er nog veel te leren. :P Okay, wat doet het tooltje? Eerst en vooral gebruikt het een Mutex om te voorkomen dat het twee keer gestart wordt. Als dit lukt wordt een onzichtbaar Window gemaakt waar de TrayIcon aan wordt gekoppeld. Vervolgens wordt de messageloop gestart waarin op diverse messages wordt gewacht. Deze messageloop roept dus WindowsProc aan per message. Deze messages worden geanalyseerd en op bepaalde messages volgt een actie. Mogelijke acties is een klik op de icon zelf, waarop een menu getoond words. Een andere actie is dus dat zo'n menuactie wordt aangeklikt. Een timer kan eventueel ook gebruikt worden om regelmatig de wallpaper te veranderen. En verder zijn er een paar andere messages die afgehandeld worden. Een leuk stukje code maar het gaat alleen maar om de API call: Shell_NotifyIcon().

Beantwoord deze vraag

Weet jij het antwoord op deze vraag? Registreer of meld je aan met je account

Dit is een gearchiveerde pagina. Antwoorden is niet meer mogelijk.