Hallo!
Ich hab für mein Programm eine Möglichkeit gesucht, wie ich den Desktop-Hintergrund setzen kann.
Ich bin sehr schnell auch SystemParametersInfo und SetWallpaper gestoßen. Leider gibts da Probleme, wenn ich was anderes als Bitmaps nehme.
Nach längerer Suche im Platform-SDK habe ich dann eine Möglichkeit gefunden, sogar animierte GIFs zu benutzen und bei einem nicht unterstützten Dateityp einfach False zurückzubekommen. Diese Möglichkeit möchte ich hier vorstellen.
1. Den aktuellen Desktop-Hintergrund bekommen:
Delphi-Quelltext
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19:
| uses ShlApi;
function TfrmMain.GetDesktopBackground: String; var DesktopObj: IActiveDesktop; Wallpaper: PWideChar; begin Result := ''; if SUCCEEDED(CoCreateInstance(CLSID_ActiveDesktop, nil, CLSCTX_INPROC_SERVER, IID_IActiveDesktop, DesktopObj)) then begin GetMem(Wallpaper, MAX_PATH*2); DesktopObj.GetWallpaper(Wallpaper, MAX_PATH*2, 0); Result := Wallpaper; if Result = '' then Result := 'none'; FreeMem(Wallpaper, MAX_PATH*2); end; end; |
2. Den Desktop-Hintergrund ändern:
Delphi-Quelltext
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27:
| uses ShlApi;
function TfrmMain.SetDesktopBackground(uFile: String): Boolean; var DesktopObj: IActiveDesktop; Wallpaper: PWideChar; begin Result := False; if uFile = 'none' then uFile := ''; if SUCCEEDED(CoCreateInstance(CLSID_ActiveDesktop, nil, CLSCTX_INPROC_SERVER, IID_IActiveDesktop, DesktopObj)) then begin GetMem(Wallpaper, MAX_PATH*2); StringToWideChar(uFile, Wallpaper, MAX_PATH*2); Result := DesktopObj.SetWallpaper(Wallpaper, 0) = S_OK; if Result then DesktopObj.ApplyChanges(AD_APPLY_ALL); FreeMem(Wallpaper, MAX_PATH*2); end; end; |
Ein Beispiel zur Benutzung:
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35:
| var frmMain: TfrmMain; Self.fLastDesktopBackground: String = '';
procedure TfrmMain.actFileSendToDesktopBackgroundExecute(Sender: TObject); begin if (Self.MDIChildCount = 0) or (TfrmChild(Self.ActiveMDIChild).Filename = '') then Exit; Self.fLastDesktopBackground := Self.GetDesktopBackground; if not Self.SetDesktopBackground(TfrmChild(Self.ActiveMDIChild).Filename) then Application.MessageBox(PChar('Konnte Datei "' + TfrmChild(Self.ActiveMDIChild).Filename + '"' + #13 + 'nicht als Desktop-Hintergrund setzen!' + IfThen(ExtractFileExt(TfrmChild(Self.ActiveMDIChild).Filename) = '.gif', #13 + #13 + 'Handelt es sich vielleicht um eine GIF-Animation?' + #13 + 'Manchmal scheinen diese nicht zu funktionieren!')), 'Scriba: Fehler', mb_IconStop + mb_Ok); end;
procedure TfrmMain.actUndoSetDesktopBackgroundExecute(Sender: TObject); begin if Self.fLastDesktopBackground = '' then Exit; if Self.SetDesktopBackground(Self.fLastDesktopBackground) then Self.fLastDesktopBackground := '' else Application.MessageBox(PChar('Konnte Datei "' + Self.fLastDesktopBackground + '"' + #13 + 'nicht als Desktop-Hintergrund setzen!' + IfThen(ExtractFileExt(Self.fLastDesktopBackground) = '.gif', #13 + #13 + 'Handelt es sich vielleicht um eine GIF-Animation?' + #13 + 'Manchmal scheinen diese nicht zu funktionieren!')), 'Scriba: Fehler', mb_IconStop + mb_Ok); end; |
Das Beispiel stammt direkt aus meinem Programm, bei mir haben die Kíndfenster
die Eigenschaft Filename, das ist natürlich sonst nicht so.
Etwas kurz und ohne weitere Erklärung, aber ich hoffe, das ist verständlich.
Sebastian