XProfan

Deutsch

'######################
'Header-Dateien
'######################
 $H Windows.ph
 $H Messages.ph
'######################
Windowstyle 543
 $H Windows.ph
Declare Ende&,Ende1&,Win02&
CLS ~GetSysColor(~Color_BTNFACE)
'Der Brush wird von Windows benutzt um den Dialoghintergrund zu zeichnen
Var Dialogpinsel& = ~Createsolidbrush($FFFF80)
Var Button& = CREATE("BUTTON",%hwnd,"Dialog öffnen",10,10,150,25)
WindowTitle "Test..."

Whilenot Ende&

    Waitinput

    If Clicked(Button&)

        win02&=CREATE("Dialog",%hwnd,"Dialog",(%MaxX/2-300),(%MaxY/2-250),600,500)
        'einmal die Farbe geben
        Startpaint win02&
        cls $FFFF80
        Endpaint
        'Subclassing einschalten
        SubClass win02&,1

        Whilenot Ende1&

            WAITINPUT

            If %Key = 2

                Ende1& = 1

            endif

        Endwhile

        DestroyWindow(win02&)

    ElseIf %Key = 2

        Ende& = 1

    Endif

Endwhile

DeleteObject Dialogpinsel&
End

SubClassProc

    If SubClassMessage(win02&,~WM_CTLCOLORDLG)

        Set("WinProc", 0)
        '~WM_CTLCOLORDLG erwartet als Rückgabewert einen Brush für den Hintergrund
        Return Dialogpinsel&

    EndIf

EndProc

Native Variante der Idee von Andreas Miethe, bei dieser Variante ist der FastMode nicht notwendig aber xpse:
Kompilieren Markieren Separieren

Declare Brush&
cls
var hDlg&=createDialog(%hWnd,"Hallo Welt",300,300,500,400)
Brush&=CreateSolidBrush($6CB6FF)
setWindowLong(hDlg&,gwl_wndProc,procAddr(myDlgProc,4))
redrawWindow(hDlg&,NULL, NULL, RDW_INVALIDATE | RDW_ERASE )

While 1

    WaitInput

EndWhile

nProc myDlgProc

    Parameters Wnd&,Msg&,WParam&,LParam&
    Global Brush&
    case Msg& = wm_ctlColorDlg : return Brush&
    Return DefDlgProc(Wnd&,Msg&,WParam&,LParam&)

EndProc