XProfan

//Erst ab XProfan 9!
//Mit Res 1024 auf 1024x768 setzen, Zurücksetzen einfach mit res 0.
//Frequenz, Bitspixel etc. bleiben erhalten.
//Res kennt nur einen Parameter.
declare __res_devmode#,__res_odevmode#
dim __res_devmode#,148
dim __res_odevmode#,148
clear __res_devmode#
clear __res_odevmode#

Proc res

    Parameters x%
    declare y%

    if (x%==0)

        external("user32","ChangeDisplaySettingsA",__res_odevmode#,0)

    else

        y%=mul(3,div(X%,4))

        ifnot long(__res_devmode#,0)

            external("user32","EnumDisplaySettingsA",0,-1,__res_devmode#)
            __res_odevmode#:=__res_devmode#

        endif

        long __res_devmode#,108=x%
        long __res_devmode#,112=y%
        external("user32","ChangeDisplaySettingsA",__res_devmode#,0)

    endif

endproc

proc res.close

    dispose __res_devmode#
    dispose __res_odevmode#

endproc

 $H windows.ph
 $H structs.ph
 $H messages.ph
 $H commctrl.ph
 $H shellapi.ph
Declare BBPSettings$,HSettings$,WSettings$,X&
Declare Dev#,Static&,CB&,Dummy$,OK&,Change&,Ende&,GC&,F$

Proc GetCurrentSettings

    Declare RetString$,c$,whx$,why$,co$
    c$   = Str $(~GetDeviceCaps(~GetDC(0),~BITSPIXEL))
    whx$ = Str $(~GetDeviceCaps(~GetDC(0),~HORZRES))
    why$ = Str $(~GetDeviceCaps(~GetDC(0),~VERTRES))

    If c$ = "4"

        co$ = "16 Farben"

    ElseIf c$ = "8"

        co$ = "256 Farben"

    ElseIf c$ = "16"

        co$ = "HightColor"

    ElseIf c$ = "32"

        co$ = "TrueColor"

    EndIf

    Retstring$ = whx$ + " * " + why$ + "  -  " + co$
    Return Retstring$

ENDPROC

Proc EnumDisplay

    Declare F$,DD$

    While ~EnumDisplaySettings(0,X&,Dev#)

        If Long(Dev#,104) = 4

            F$ = "16 Farben"

        ElseIf Long(Dev#,104) = 8

            F$ = "256 Farben"

        ElseIf Long(Dev#,104) = 16

            F$ = "HightColor"

        ElseIf Long(Dev#,104) = 32

            F$ = "TrueColor"

        EndIf

        BBPSettings$ = BBPSettings$ + Str $(Long(Dev#,104))+"|"
        HSettings$ = HSettings$ + Str $(Long(Dev#,108))+"|"
        WSettings$ = WSettings$ + Str $(Long(Dev#,112))+"|"
        DD$ = Str $(Long(Dev#,108)) + " * " + Str $(Long(Dev#,112)) + "  -  " + F$
        AddChoice(CB&,DD$)
        Inc X&

    Wend

ENDPROC

Window Style 20
Window Title "Display-Changer"
Window 10,10-250,150
cls ~GetSysColor(~COLOR_BTNFACE)
SetDialogFont ~GetStockObject(~DEFAULT_GUI_FONT)
Dummy$ = GetCurrentSettings()
Static& = Create("TEXT",%hwnd,"Current Settings : "+Dummy$,10,10,300,24)
CB& = ~CreateWindowEx($200,"COMBOBOX","",~WS_CHILD | ~WS_VISIBLE | ~CBS_DROPDOWN | ~WS_VSCROLL ,10,40,220,300,%hwnd,100,%hInstance,0)
SendMessage(CB&,~WM_SETFONT,~GetStockObject(~DEFAULT_GUI_FONT),1)
OK& = Create("BUTTON",%hwnd,"Ende",10,70,80,24)
Change& = Create("BUTTON",%hwnd,"Change",150,70,80,24)
Dim Dev#,156
EnumDisplay()
SendMessage(CB&,~CB_SETCURSEL,SendMessage(CB&,~CB_FINDSTRING,0,ADDR(Dummy$)),0)

WhileNot Ende&

    Waitinput

    If GetFocus(Change&)

        SetFocus(%hwnd)
        GC& = SendMessage(CB&,~CB_GETCURSEL,0,0)
        Long Dev#,40 = ~DM_PELSHEIGHT | ~DM_PELSWIDTH | ~DM_BITSPERPEL
        Long Dev#,104 = Val(Substr$(BBPSettings$,GC&+1,"|"))
        Long Dev#,108 = Val(Substr$(HSettings$,GC&+1,"|"))
        Long dev#,112 = Val(Substr$(WSettings$,GC&+1,"|"))

        If GetText$(CB&) <> Mid$(GetText$(Static&),20,100)

            If ~ChangeDisplaySettings(Dev#,~CDS_UPDATEREGISTRY) = ~DISP_CHANGE_RESTART

                If Long(Dev#,104) = 4

                    F$ = "16 Farben"

                ElseIf Long(Dev#,104) = 8

                    F$ = "256 Farben"

                ElseIf Long(Dev#,104) = 16

                    F$ = "HightColor"

                ElseIf Long(Dev#,104) = 32

                    F$ = "TrueColor"

                EndIf

                SetText Static&,"Current Settings : " + Str $(Long(Dev#,108)) + " * " + Str $(Long(Dev#,112)) + "  -  " + F$
                External("setupapi.dll","SetupPromptReboot",0,0,0)

            Else

                SetText Static&,"Current Settings : "+GetCurrentSettings()

            Endif

        Else

            MessageBox("Auflösung must not changed werden","Meldung",0)

        Endif

    ElseIf GetFocus(OK&)

        Dispose Dev#
        Ende& = 1

    Endif

EndWhile

End