Italia
Include

reso.inc

 

Andreas
Miethe


Da fehlte leider noch etwas in Devmode-Struktur ( Field-Member) darum noch mal der geänderte Code
KompilierenMarkierenSeparieren
 $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
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

    Endif

ss=s4 href='./../../function-references/xprofan/endwhile/'>EndWhile End
 
Gruss
Andreas
________ ________ ________ ________ _
Profan 3.3 - XProfanX2
Win 95,98,ME,2000,XP,Vista - Win 7 32 / 64 Bit
ASUS X93S - Intel Core I7-NVIDIA GForce 540M 8GB Arbeitsspeicher
Homepage :  [...] 
26.04.2004  
 



Funktioniert perfekt.
 
26.04.2004  
 



Answer


Topictitle, max. 100 characters.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Topic-Options

4.765 Views

Untitledvor 0 min.
Gast.081521.08.2024
Member 862464112.05.2024
iF30.10.2020
AndreasS06.12.2018
Di più...

Themeninformationen

Dieses Thema hat 2 subscriber:

unbekannt (1x)
Andreas Miethe (1x)


Admins  |  AGB  |  Applications  |  Autori  |  Chat  |  Informativa sulla privacy  |  Download  |  Entrance  |  Aiuto  |  Merchantportal  |  Impronta  |  Mart  |  Interfaces  |  SDK  |  Services  |  Giochi  |  Cerca  |  Support

Ein Projekt aller XProfaner, die es gibt!


Il mio XProfan
Private Notizie
Eigenes Ablageforum
Argomenti-Merkliste
Eigene Beiträge
Eigene Argomenti
Zwischenablage
Annullare
 Deutsch English Français Español Italia
Traduzioni

Informativa sulla privacy


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.


einverstandenDatenschutzerklärung
Ich möchte keinen Cookie