English
Source / code snippets

Bildschirmauflösungen lists only Temporär Change

 

CompileMarkSeparation
Source 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
 
07/16/07  
 




GDL
Hi,
Codeschnippsel goes by me unfortunately not.
it'll The Color Depth not at me correctly. read.
by me becomes in the proc getcurrentsettings for c$ the worth 255 outputted.
CompileMarkSeparation
 $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

Hello
Georg
 
Windows7 Xprofan 8,9,10 [...]  [...] 
09/13/07  
 



Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

4.859 Views

Untitledvor 0 min.
Sven Bader07/28/21
iF10/30/20
Tommy02/11/19
Torben Nissen03/05/17

Themeninformationen

this Topic has 2 subscriber:

GDL (1x)
unbekannt (1x)


Admins  |  AGB  |  Applications  |  Authors  |  Chat  |  Privacy Policy  |  Download  |  Entrance  |  Help  |  Merchantportal  |  Imprint  |  Mart  |  Interfaces  |  SDK  |  Services  |  Games  |  Search  |  Support

One proposition all XProfan, The there's!


My XProfan
Private Messages
Own Storage Forum
Topics-Remember-List
Own Posts
Own Topics
Clipboard
Log off
 Deutsch English Français Español Italia
Translations

Privacy Policy


we use Cookies only as Session-Cookies because of the technical necessity and with us there no Cookies of Drittanbietern.

If you here on our Website click or navigate, stimmst You ours registration of Information in our Cookies on XProfan.Net To.

further Information To our Cookies and moreover, How You The control above keep, find You in ours nachfolgenden Datenschutzerklärung.


all rightDatenschutzerklärung
i want none Cookie