XProfan

Italia

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Windows-Hintergrundbild auswechseln
Lauffähig ab Profan-Version 5.0
PRFellow - Vorlage
Autor: Thomas Hölzer
Hintergrundbitmap per Desktop laden/einstellen/löschen
Beispiel per Verwendung von SystemParametersInfo
Parameter 1: muß 20 sein per die BMP-Funktion
Parameter 2: muß 0 sein
Parameter 3: Pointer auf String, der den Namen der BMP enthält
Parameter 4: $0003: Eintrag wird gespeichert und entspr. Nachricht gesendet
Rückgabe   : Ungleich 0 bei Erfolg
Declare pointer#
Def SetWallPaper(4) !USER32,SystemParametersInfoA
Bild und Anzeigemodus setzen

Proc SetWPBmp

    Parameters file$,tiled%
    Dim pointer#,256
    String pointer#,0=file$
    SetWallPaper(20,0,pointer#,$0003)
    Dispose pointer#
    WriteIni HKEY_1,Control Paneldesktop,WallPaper = file$
    So gehts zwar auch, aber SystemParametersInfo ist der bessere Weg,
    zumal man es per SPI_SETWININICHANGE eh braucht
    WriteIni HKEY_1,Control Paneldesktop,TileWallpaper = Str$(tiled%)
    SetWallPaper(20,0,0,2) SPI_SENDWININICHANGE

EndProc

Hintergrundbild stretchen

Proc SetWPStyle

    Parameters style%
    WriteIni HKEY_1,Control Paneldesktop,WallPaperStyle = Str$(style%)
    SetWallPaper(20,0,0,2)

EndProc

Beispiel
Declare bmp$,ende%
WindowTitle Hintergrundbild setzen
Window 100,100-250,250
Popup &Hintergrundbild
AppendMenu 1, &BMP als Desktophintergrund (zentriert)
AppendMenu 2, B&MP als Desktophintergrund (gekachelt)
Separator
AppendMenu 3, Hintergrundbild auf &volle Bildschirmgröße stretchen
AppendMenu 4, &Standardgröße
Separator
AppendMenu 5,&Hintergrundbmp entfernen
Separator
AppendMenu 6,&Beenden

WhileNot ende%

    IF Len(bmp$)

        LoadSizedBmp bmp$,0,0-250,250;0

    ENDIF

    WaitInput

    If MenuItem(1)

        Let bmp$=LoadFile$(Hintergrundbmp per Desktop,*.bmp)
        SetWPBmp bmp$,0

    ElseIf MenuItem(2)

        Let bmp$=Loadfile$(Hintergrundbmp per Desktop,*.bmp)
        SetWPBmp bmp$,1

    ElseIf MenuItem(3)

        SetWPStyle 2

    ElseIf MenuItem(4)

        SetWPStyle 0

    ElseIf MenuItem(5)

        SetWPBmp ,0
        Let bmp$=
        Cls

    Elseif MenuItem(6)

        Let ende%=1

    Elseif MenuItem(254)

        MessageBox(Autor: Thomas Hölzer,PRFellow-Vorlage,64)

    EndIf

Wend

End