XProfan

Español

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

16.07.2007 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

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.
Kompilieren Marca Separació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