Fuente/ Codesnippets | | | | | KompilierenMarcaSeparaciónSource wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Bildschirmauflösungen listen und ändern (nicht nur temporär)
$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
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
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 muss nicht geändert werden,Meldung,0)
Endif
ElseIf GetFocus(OK&)
Dispose Dev#
Ende& = 1
Endifclass=s4 href='./../../function-references/XProfan/endwhile/'>EndWhile
End
|
| | | | |
| | GDL | ¡Hola, Codeschnippsel va en me por desgracia, no. Lo se el Farbtiefe no yo en el correcto ausgelesen. En me se en el proc getcurrentsettings para c$ el Valor 255 ausgegeben. KompilierenMarcaSeparación $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
locate 10,10
print co$+WWWWWWWWWWWWW+c$
Retstring$ = Whx$ + * + Why$ + - + Co$
Return Retstring$
Endproc
============================================================================
Proc Enumdisplay
füllt die Combobox mit den möglichen Einstellungen
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
================================================================================
Windowstyle 20
Windowtitle Display-Changer
Window 10,10-550,350
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 muss nicht geändert werden,Meldung,0)
Endif
Elseif Getfocus(Ok&)
Dispose Dev#
Ende& = 1
End
Endwhile
End
Servus Georg |
| | | | |
|
Zum QuelltextThemeninformationenDieses Thema ha 2 subscriber: |