[delphi] wallpaper changer

[JTW]

Ik ben een beetje een programmeer-newbie, ik heb er niet echt veel talent voor en ook niet echt veel tijd.
Nu wil ik een wallpaper changer maken, ik heb alles al maar nog niet dat het programma de windows achtergrond echt kan veranderen. het moet dus iets worden als:

code:

blablabla
timer1 blablabla
begin
  windows.wallpaper := image1.picture;
end;

maar dan iets ingewikkelder

of iets van

code:

blablabla
timer1 blablabla
begin
  setwindowswallpaper('c:\blablabla\blablabla');
end;

ik heb de search gebruikt,
google/groups en
de delphi help, maar ik kom er niet uit
bvd

edit
oeps specs vergeten, ik draai w2k
en ik gebruik delhi5

[Verwijderd]

Zal wel een APi functie voorzijn, even op google kijken of msdn

[Verwijderd]

SystemParametersInfo(SPI_SETDESKWALLPAPER,nil,pchar('bestand'),SPIF_SENDCHANGE)

Zou moeten werken (niet uitgeprobeerd)

Als je de api's wilt doornemen, zijn trouwens meegeïnstaleerd, klik help -> Windows SDK

[Varienaja]

Dit is wel *heel* gemakkelijk natuurlijk, maar:

WPS.dpr:

code:

program WPS;

uses
  Windows,
  Messages,
  ExtCtrls,
  INIFiles,
  ShellAPI,
  SysUtils;

{$D-,L-,O+,Y-}
{$R *.res}
const
  AppName = 'Henk';
  ToolTipText = 'Wallpaper swapper';

var
  tid: TNotifyIconData;
  Max,Index:integer;

type
TSwapper = class(TObject)
private
   Timer:TTimer;
   INI:TINIFile;
public
   constructor Create;
   procedure TimerEvent(Sender:TObject);
   destructor Close;
   procedure ShowConfig;
end;

var S:TSwapper;
{--------------------------------------------------------------}
{                   Things to actually do...                   }
{--------------------------------------------------------------}
procedure ConfigOpen(Wnd: hWnd);
begin
//   ShellExecute(Wnd,nil,'notepad.exe',nil,nil,0);
//  PostMessage(Wnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
//   MessageBox (0, 'Edit WPS.ini...','Config', mb_ok);
   S.ShowConfig;
end;

{--------------------------------------------------------------}
{                        The Popup Menu                        }
{--------------------------------------------------------------}
procedure DoPopupMenu(Wnd: hWnd);
var
  pm: HMenu;
  pt: TPoint;
begin
  GetCursorPos (pt);
  pm := CreatePopupMenu;

  { define the popup menu items (& their commands) here }
  AppendMenu (pm, 0, Ord ('A'), '&About...');
  AppendMenu (pm, 0, Ord ('C'), '&Configuration...');
  AppendMenu (pm, 0, Ord ('N'), 'Swap &Now');
  AppendMenu (pm, mf_Separator, 0, Nil);
  AppendMenu (pm, 0, Ord ('E'), 'E&xit');

  SetForegroundWindow (Wnd);
  if TrackPopupMenu (pm,tpm_BottomAlign or tpm_RightAlign,pt.x,pt.y,0,Wnd,Nil)
    then SetForegroundWindow (Wnd);
  DestroyMenu (pm)
end;  { DoPopupMenu }

{--------------------------------------------------------------}
{                     Menu Item responses                      }
{--------------------------------------------------------------}
procedure HandleCommand (Wnd: hWnd; Cmd: Word);
begin
  { Respond to popup menu commands here }
  case Cmd of
    Ord ('A'){about}: MessageBox (0, 'Wallpaper swapper v2.0, (C)Copyright by A.J.V.'+#10+'All rights reserved.','About Wallpaper swapper', mb_ok);
    Ord ('E'){exit} : begin S.Close; PostMessage (Wnd, wm_Close, 0, 0); end;
    Ord ('C'){config}: ConfigOpen(Wnd);
    Ord ('N'){swap} : S.TimerEvent(nil);
  end;
end;

{--------------------------------------------------------------}
{                        Mouse events                          }
{--------------------------------------------------------------}
procedure RightButtonUp(Wnd: hWnd);
begin
  DoPopupmenu(Wnd);
end;

{--------------------------------------------------------------}
{  WindowProc - to intercept the messages for our application  }
{--------------------------------------------------------------}
function DummyWindowProc (Wnd: hWnd; Msg, wParam: Word; lParam: LongInt): LongInt; stdcall;
begin
  DummyWindowProc := 0;
  case Msg of
    wm_Create:      // Program initialisation - just set up a tray icon
    begin
      tid.cbSize           := sizeof (tid);
      tid.Wnd              := Wnd;
      tid.uID              := 1;
      tid.uFlags           := nif_Message or nif_Icon or nif_Tip;
      tid.uCallBackMessage := wm_User;
      tid.hIcon            := LoadIcon (hInstance, 'MAINICON');
      lstrcpy (tid.szTip,ToolTipText);
      Shell_NotifyIcon (nim_Add, @tid);
      { Initialisation code can go here }
    end;
    wm_Destroy:
    begin
      Shell_NotifyIcon (nim_Delete, @tid);
      PostQuitMessage (0);
      { Any other cleaning up does here }
    end;
    wm_Command:     // Command notification
    begin
      HandleCommand (Wnd, LoWord (wParam));
      Exit;
    end;
    wm_User:        // Had a tray notification - see what to do
    begin
      if (lParam = wm_RButtonUp)     then RightButtonUp(Wnd);
    end;
  end;  { case of Msg }

  DummyWindowProc := DefWindowProc (Wnd, Msg, wParam, lParam);
end;

{--------------------------------------------------------------}
{  WinMain - to setup the application and handle the messages  }
{--------------------------------------------------------------}
procedure WinMain;
var
  Wnd: hWnd;
  Msg: TMsg;
  cls: TWndClass;
begin
  { Register the window class }
  FillChar(cls, sizeof (cls), 0);
  cls.lpfnWndProc:=@DummyWindowProc;
  cls.hInstance:=hInstance;
  cls.lpszClassName:=AppName;
  RegisterClass(cls);

  { Now create the dummy window }
  Wnd:=CreateWindow(AppName, AppName, ws_OverlappedWindow,
                      cw_UseDefault, cw_UseDefault, cw_UseDefault, cw_UseDefault,
                      0, 0, hInstance, Nil);
  if Wnd<>0 then begin
    ShowWindow(Wnd, sw_Hide);
    while GetMessage(Msg, 0, 0, 0) do begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
  end;
end;  { WinMain }


{--------------------------------------------------------------}
{  The Program                                                 }
{         - test for command line parameters,                  }
{         - check if another instance of the app is running    }
{         - run "WinMain", to actually run the program         }
{--------------------------------------------------------------}

constructor TSwapper.Create;
begin
   inherited Create;
   Randomize;
   INI:=TINIFile.Create(GetCurrentDir+'\WPS.ini');
   Timer:=TTimer.Create(nil);
   Timer.OnTimer:=TimerEvent;
   Timer.Interval:=INI.ReadInteger('Settings','Interval',60000);
   Max:=INI.ReadInteger('BackGrounds','Count',0);
   Index:=1;
end;

procedure TSwapper.TimerEvent(Sender:TObject);
var FN:string;
    FN2:array[0..255] of char;
begin
   inc(Index);
   if Index>Max then Index:=1;
   FN:=INI.ReadString('BackGrounds','FN'+IntToStr(Index),'');
   StrPCopy(FN2,FN);
   SystemParametersInfo(SPI_SETDESKWALLPAPER,0,@FN2,0);
end;

procedure TSwapper.ShowConfig;
var Msg:string;
    Uit:array[0..1023] of char;
    i:integer;
begin
   Msg:='Interval: '+IntToStr(INI.ReadInteger('Settings','Interval',60000) div 1000)+#10;
   Msg:=Msg+'Backgrounds:'+#10;
   for i:=1 to INI.ReadInteger('BackGrounds','Count',0) do begin
      Msg:=Msg+INI.ReadString('BackGrounds','FN'+IntToStr(i),'')+#10;
   end;
   StrPCopy(Uit,Msg);
   MessageBox(0,Uit,'Configuration',0);
end;

destructor TSwapper.Close;
begin
   Timer.Destroy;
   INI.Destroy;
   inherited Destroy;
end;

begin
  { If app is already running then start screen saver and exit immediately }
//  if FindWindow(AppName, Nil) <> 0 then begin DoSomething(FindWindow(AppName, Nil)); exit; end;

  { Run the main program.... }
  S:=TSwapper.Create;
  WinMain;
end.

[JTW]

Verwijderd schreef op 07 september 2002 @ 17:45:
SystemParametersInfo(SPI_SETDESKWALLPAPER,nil,pchar('bestand'),SPIF_SENDCHANGE)

Zou moeten werken (niet uitgeprobeerd)

Als je de api's wilt doornemen, zijn trouwens meegeïnstaleerd, klik help -> Windows SDK

code:

Incompatible types 'cardinal' and 'pointer'

wat moet ik dan gegruiken?
ik heb het al, maar nu moet de wallpaper nog echt zichtbaar veranderen, niet alleen voor het registry.

[tfk__66]

Het niet zichtbaar veranderen gebeurd waarschijnlijk niet omdat je de active desktop op enabled hebt staan. Het volgende stukkie code heb ik ooit van www.delphi3000.com geplukt en verhelpt dit probleempje. Let wel, het is niet mijn code, courtesy www.delphi3000.com .

You may have noticed that using SystemParametersInfo
to change the wallpaper when ActiveDesktop is turned on
doesn't work. The reason is because you need to use
the IActiveDesktop COM interface. Using SystemParametersInfo
still works, but it doesn't update the wallpaper.

Note that the IActiveDesktop interface requires a
Shell32.dll version >= 4.71. The document titled
"Get a File Version" demonstrates how to check the
file version and uses the shell32.dll as an example.

Here is an example of using IActiveDesktop to work with
the wallpaper. It assumes that you have 3 labels on a form
and two buttons with the default names.

uses
ComObj, // For CreateComObject and Initialization/Finalization of COM
ShlObj; // For IActiveDesktop

{ The CLASS ID for ActiveDesktop is not defined in
ShlObj, while the IID is so we define it here. }
const
CLSID_ActiveDesktop: TGUID = '{75048700-EF1F-11D0-9888-006097DEACF9}';

{ Demonstrate getting the Wallpaper }
procedure TForm1.Button1Click(Sender: TObject);
var
ActiveDesktop: IActiveDesktop;
CurrentWallpaper: string;
CurrentPattern: string;
WallpaperOptions: TWallpaperOpt;
tmpBuffer: PWideChar;
begin
// Create the ActiveDesktop COM Object
ActiveDesktop := CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;

// We now need to allocate some memory to get the current Wallpaper.
// However, tmpBuffer is a PWideChar which means 2 bytes make
// up one Char. In order to compenstate for the WideChar, we
// allocate enough memory for MAX_PATH*2
tmpBuffer := AllocMem(MAX_PATH*2);
try
ActiveDesktop.GetWallpaper(tmpBuffer, MAX_PATH*2, 0);
CurrentWallpaper := tmpBuffer;
finally
FreeMem(tmpBuffer);
end;
if CurrentWallpaper <> '' then
Label1.Caption := 'Current Wallpaper: ' + CurrentWallpaper
else
Label1.Caption := 'No Wallpaper set';

// Now get the current Wallpaper options.
// The second parameter is reserved and must be 0.
WallpaperOptions.dwSize := SizeOf(WallpaperOptions);
ActiveDesktop.GetWallpaperOptions(WallpaperOptions, 0);
case WallpaperOptions.dwStyle of
WPSTYLE_CENTER: Label2.Caption := 'Centered';
WPSTYLE_TILE: Label2.Caption := 'Tiled';
WPSTYLE_STRETCH: Label2.Caption := 'Stretched';
WPSTYLE_MAX: Label2.Caption := 'Maxed';
end;

// Now get the desktop pattern.
// The pattern is a string of decimals whose bit pattern
// represents a picture. Each decimal represents the on/off state
// of the 8 pixels in that row.
tmpBuffer := AllocMem(256);
try
ActiveDesktop.GetPattern(tmpBuffer, 256, 0);
CurrentPattern := tmpBuffer;
finally
FreeMem(tmpBuffer);
end;
if CurrentPattern <> '' then
Label3.Caption := CurrentPattern
else
Label3.Caption := 'No Pattern set';
end;

{ Demonstrate setting the wallpaper }

procedure TForm1.Button2Click(Sender: TObject);
var
ActiveDesktop: IActiveDesktop;
begin
ActiveDesktop := CreateComObject(CLSID_ActiveDesktop)
as IActiveDesktop;
ActiveDesktop.SetWallpaper('c:\downloads\images\test.bmp', 0);
ActiveDesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);
end;

[JTW]

hm, nu doet hij het niet omdat het een .jpg is
blaat, ik heb nog niet alles gedaan wat er stond alleen het onderste, eerst nog maar ff goed doorlezen

[Verwijderd]

HEBBES !!!

werkt wel alleen met bmp bestanden ....

code:

SystemParametersInfo(SPI_SETDESKWALLPAPER,0,PChar(bestand),SPI
F_UPDATEINIFILE);
  PostMessage(HWND_BROADCAST,WM_SETTINGCHANGE,0,0);

maar hé je kan wel bitmaps maken van jpeg bestanden met het TJPegImage component

[LordLarry]

Voor jpeg en andere bestandsformaten heb je ActiveDesktop nodig

[tfk__66]

Je kan inderdaad bitmaps maken. Gaat ongeveer zo:

uses jpeg;

var theJpeg: TJPegImage;
var theBMP: TBitmap;

theJpeg := TJPegImage.Create;
theBMP := TBitmap.Create;
try
theJpeg.LoadFromFile('c:\tralilalila\eenjpegje.jpg');
theBMP.assign(theJpeg);
theBMP.SaveToFile('c:\tralilalila\eenbmptje.bmp');
finaly
theBMP.Free;
theJpeg.Free;
end;

Dit moet het zo ongeveer zijn...foutjes voorbehouden want ik doe dit ook maar uit mijn blote kop.