PureBoard

Verfasst: **24.01.2006 18:52**

Nimm mal

InitDesktopPreferences()

;Your Functions

DeInitDesktopPreferences()

aus der include Datei heraus und setze ersteres an den anfang des Source und letzteres ans Ende

Verfasst: **24.01.2006 19:01**

Ich habe es doch so gemacht...

Code: Alles auswählen

InitDesktopPreferences()

;Your Functions

DeInitDesktopPreferences()

Wenn ich noch "SystemParametersInfo_(#SPI_SETDESKWALLPAPER, 0, Neu.s, #SPIF_UPDATEINIFILE)" Setze dann werden zwar die User system einstellung geändert und als Hintergrund wird die Hintergrund Farbe gesetzt anstad das bild..

Verfasst: **24.01.2006 19:17**

Also ...
dort wo

Code: Alles auswählen

;Your Functions

steht, da muß Dein gesamter Code rein
Am besten so, wie ich eben schon mal geschrieben hab

Verfasst: **24.01.2006 19:28**

okay jetzt habe ich verstanden was du meintest.....

nur es passiert genau das selbe (hatte ich schon im gefühn)

Verfasst: **25.01.2006 16:25**

Ich habe einiges durchsucht aber nichts gefunden

ich bin noch am verzweifeln

Verfasst: **26.01.2006 22:24**

Okay ich habe meinen Code noch einmal komplet über arbeiet. Jetzt stell ich mich seit ein paar stunden die frage: "Warum wird das aktuelle Wallpaper neu gesetzt?

Hier der code:

Code: Alles auswählen

Procedure.s GetExePath()
  Prg.s = Space(#MAX_PATH)
  GetModuleFileName_(GetModuleHandle_(0), @Prg, #MAX_PATH)
  Prg = GetPathPart(Prg)
  If (FindString(prg,"\PureBasic\Compilers\", 1))
    Prg.s = Space(#MAX_PATH)
    GetCurrentDirectory_(#MAX_PATH,@Prg)
  EndIf
If Right(Prg, 1) <> "\" : Prg + "\" : EndIf
  ProcedureReturn Prg
  teste$ = Prg.s
EndProcedure
#WPSTYLE_CENTER = 0
#WPSTYLE_TILE = 1
#WPSTYLE_STRETCH = 2
#WPSTYLE_MAX = 3

#AD_APPLY_SAVE = 1
#AD_APPLY_HTMLGEN = 2
#AD_APPLY_REFRESH = 4
#AD_APPLY_FORCE = 8
#AD_APPLY_ALL = #AD_APPLY_SAVE | #AD_APPLY_HTMLGEN | #AD_APPLY_REFRESH

Structure myWALLPAPEROPT
  dwSize.l
  dwStyle.l
EndStructure

wallpaperOptions.myWALLPAPEROPT
wallpaperOptions\dwSize = SizeOf(myWALLPAPEROPT)

CoInitialize_(0)

If CoCreateInstance_(?CLSID_ActiveDesktop,0,1,?IID_IActiveDesktop,@deskObj.IActiveDesktop) <> #S_OK
  MessageRequester("Error", "Could not create object")
  quit = #True
EndIf

Global wallpaperOptions, deskObj

Procedure doWallpaper(myWallpaper$)
  ; get option selection
  ;If GetGadgetState(2)
  ;  wallpaperOptions\dwStyle = #WPSTYLE_TILE
 ; ElseIf GetGadgetState(3)
    wallpaperOptions\dwStyle = #WPSTYLE_STRETCH
 ; Else
 ;   wallpaperOptions\dwStyle = #WPSTYLE_CENTER
;  EndIf
 
  ; allocate for wStr filename
  filenameWide = AllocateMemory(Len(myWallpaper$)*2+2)
  MultiByteToWideChar_(#CP_ACP, 0, @myWallpaper$, -1, filenameWide, Len(myWallpaper$)*2+2)               
   
    If deskObj\SetWallpaper(filenameWide, 0) = #S_OK
   
      If deskObj\SetWallpaperOptions(@wallpaperOptions, 0) =#S_OK
     
        If deskObj\ApplyChanges(#AD_APPLY_SAVE) <> #S_OK
          MessageRequester("Error", "Unable to apply changes to Wallpaper.")
        EndIf
     
      EndIf
     
    EndIf
  FreeMemory(filenameWide)
 
ProcedureReturn 0
EndProcedure
If OpenFile(0, GetExePath() + "Setting.conf")
  IMG$ = ReadString()
  Random$ = ReadString()
  RandomTest$ = ReadString()
  CloseFile(0)
Else
  MessageRequester("Information","Keine Configuration voranden!",#PB_MessageRequester_Ok)
  RunProgram(Run$,"","",0)
  End
EndIf
If Random$ = RandomTest$
  ExamineDirectory(50, IMG$, "*.jpg")
  Debug NextDirectoryEntry()
  While NextDirectoryEntry() = 1
    Anzahl.l + 1
    z = Random(10)
    Debug Anzahl.l
    Debug DirectoryEntryName()
    If y <> 1
      If z = 0
        doWallpaper(DirectoryEntryName())
        y = 1
      EndIf
    EndIf
  Wend
  CreateFile(0,GetExePath() + "Setting.conf")
  WriteStringN(IMG$)
  WriteStringN(Random$)
  WriteStringN("1")
  CloseFile(0)
Else
  Debug RandomTest$
  Debug Val(RandomTest$)
  Radndom.l = Val(RandomTest$)
  Radndom.l + 1
  RandomNeu$ = Str(Radndom.l)
  Debug RandomNeu$
  CreateFile(0,GetExePath() + "Setting.conf")
  WriteStringN(IMG$)
  WriteStringN(Random$)
  WriteStringN(RandomNeu$)
  CloseFile(0)
EndIf
quit = #True
End
If deskObj
  deskObj\release()
EndIf

CoUninitialize_()

End

DataSection
CLSID_ActiveDesktop:
Data.l $75048700
Data.w $EF1F,$11D0
Data.b $98,$88,$00,$60,$97,$DE,$AC,$F9

IID_IActiveDesktop:
Data.l $F490EB00
Data.w $1240,$11D1
Data.b $98,$88,$00,$60,$97,$DE,$AC,$F9
EndDataSection

PureBoard

Walpaper >>>-Code überarbeitet-<<<