English
Includes

reso.inc

 

Andreas
Miethe


there fehlte unfortunately yet something in Devmode-structure ( Field-Member) therefore once more the geänderte code
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

    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 :  [...] 
04/26/04  
 



functions perfect.
 
04/26/04  
 



Answer


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

4.758 Views

Untitledvor 0 min.
Gast.081508/21/24
Member 862464105/12/24
iF10/30/20
AndreasS12/06/18
More...

Themeninformationen

this Topic has 2 subscriber:

unbekannt (1x)
Andreas Miethe (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