Auflösung und Farbtiefe ändern

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%=3*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$,Frequenz$,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))+"|"
Frequenz$ = Frequenz$ + Str$(Long(Dev#,120))+"|"
DD$ = Str$(Long(Dev#,108)) + " * " + Str$(Long(Dev#,112)) + " - " + F$+" - "+Str$(Long(Dev#,120))+"Hz"
AddString(CB&,DD$)
Inc X&
Wend
EndProc


WindowStyle 20
WindowTitle "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 | ~DM_DISPLAYFREQUENCY
Long Dev#,104 = Val(Substr$(BBPSettings$,GC&+1,"|"))
Long Dev#,108 = Val(Substr$(HSettings$,GC&+1,"|"))
Long dev#,112 = Val(Substr$(WSettings$,GC&+1,"|"))
Long dev#,120 = Val(Substr$(Frequenz$,GC&+1,"|"))
If GetText$(CB&) <> Mid$(GetText$(Static&),20,100)
If ~ChangeDisplaySettings(Dev#,0) = ~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 muss nicht geändert werden","Meldung",0)
Endif
ElseIf GetFocus(OK&)
Dispose Dev#
Ende& = 1
Endif
EndWhile
End