XProfan

 $H Windows.ph
 $H Messages.ph
#############################
Messagebox-Konstanten
DEF &IDOK         1
DEF &IDCANCEL     2
DEF &IDABORT      3
DEF &IDRETRY      4
DEF &IDIGNORE     5
DEF &IDYES        6
DEF &IDNO         7
DEF &IDICON      20
DEF &IDPROMPT $FFFF
DEF &IDSTATIC $CAFE
#############################
Struct CWPSTRUCT = lParam&,wParam&,message&,hwnd&
Struct Rect = left&,top&,right&,bottom&
Struct PAINTSTRUCT = hdc&,fErase&,rcPaint!Rect,fRestore&,fIncUpdate&,rgbReserved#(32)

Proc Disablexptheme

    Var Ux& = ImportDll("UxTheme.dll","")
    Parameters Wnd&
    Declare Word#
    Dim Word#,2

    If UX&

        Setwindowtheme(Wnd&, Word#, Word#)

    Endif

    Dispose Word#
    FreeDll UX&

Endproc

Proc ShadowProc

    Parameters wnd&,lparam&

    If (~GetDlgCtrlID(wnd&) >= &IDOK) AND (~GetDlgCtrlID(wnd&) <= &IDNO)

        Disablexptheme(wnd&)
        Declare x&,y&,w&,h&,Brush&,Pen&,OldBrush&,OldPen&
        Var Rect# = New(Rect)
        Brush& = ~GetStockObject(~BLACK_BRUSH)
        Pen&   = ~GetStockObject(~NULL_PEN)
        ~GetClientRect(wnd&,Rect#)
        ~MapWindowpoints(wnd&,~GetParent(wnd&),Rect#,2)
        x& = Rect#.left&+6
        y& = Rect#.top&+6
        w& = x&+(Rect#.right&-Rect#.left&)
        h& = y&+(Rect#.bottom&-Rect#.top&)
        OldBrush& = ~SelectObject(lParam&,Brush&)
        OldPen&   = ~SelectObject(lParam&,Pen&)
        ~Rectangle(lParam&,x&,y&,w&,h&)
        ~SelectObject(lParam&,OldBrush&)
        ~SelectObject(lParam&,OldPen&)
        ~DeleteObject(Brush&)
        ~DeleteObject(Pen&)

    EndIf

    Return 1

EndProc

Proc MB

    Parameters wnd&,msg&,wparam&,lparam&
    Declare Result&,W&,H&

    select msg&

        Caseof ~WM_INITDIALOG

        Var DC& = ~GetDC(wnd&)
        Var Rect# = New(Rect)
        Var icon& = SendMessage(~GetDlgItem(wnd&,&IDICON),~STM_GETICON,0,0)
        ~GetWindowRect(wnd&,Rect#)
        Dialog vergrössern und zentrieren
        W& = Rect#.right& - Rect#.left& + 20
        H& = Rect#.bottom& -Rect#.top& + 30
        ~Movewindow(wnd&,((%maxx/2)-(W&/2)),((%maxy/2)-(H&/2)),W&,H&,1)
        Static-Control, auf dem die Buttons liegen, anpassen
        ~GetClientRect(~GetDlgItem(wnd&,&IDSTATIC),Rect#)
        ~MapWindowpoints(~GetDlgItem(wnd&,&IDSTATIC),wnd&,Rect#,2)
        ~Movewindow(~GetDlgItem(wnd&,&IDSTATIC),Rect#.left&,Rect#.top&,w&,44,1)
        Dispose Rect#
        Bitmap für Hintergrund anlegen
        Pic& = Create("hNewPic",w&,h&,$FFFFFF)
        Farbverlauf ins Bitmap
        Startpaint Pic&
        GradientRect(%hdc,0,0,w&,h&,$8000,$FF,0)
        ~DrawiconEx(%hdc,20,20,Icon&,32,32,0,0,$3)

        If D&

            TextColor $FFFF,$FF
            Drawtext width(wnd&)-24,Height(wnd&)-20,Format$("%3.0f",D&)

        Endif

        EndPaint
        Brush& = ~CreatePatternBrush(Pic&)
        Bitmap für Static anlegen
        ein Static-Control ist erst ab Vista vorhanden !
        Pic1& = Create("hNewPic",w&,44,$0)
        Farbverlauf ins Bitmap
        Startpaint Pic1&
        GradientRect(%hdc,0,0,w&/2,44,$FF,$8000,0)
        GradientRect(%hdc,w&/2,0,w&,44,$8000,$FF,0)
        EndPaint
        Brush1& = ~CreatePatternBrush(Pic1&)
        B& = Create("CheckBox",wnd&,"Diese Meldung nicht wieder anzeigen",0,height(wnd&)-20,width(wnd&),18)
        Disablexptheme(B&)
        SendMessage(B&,~WM_SETFONT,~GetStockObject(~ANSI_VAR_FONT),1)
        ShowWindow(~GetDlgItem(wnd&,&IDICON),0)
        Result& = 1

        Caseof ~WM_PAINT

        Var ps# = New(PAINTSTRUCT)
        ~BeginPaint(wnd&,ps#)
        ~EnumChildWindows(wnd&,ProcAddr("ShadowProc",2),ps#.hdc&)
        ~EndPaint(wnd&,ps#)
        Dispose ps#

        Caseof ~WM_CTLCOLORSTATIC

        If lParam& = ~GetDlgItem(wnd&,&IDSTATIC)

            Return Brush1&

        else

            ~SetTextColor(wParam&,$FFFF)
            ~SetBkMode(wparam&,~Transparent)
            Return ~GetStockObject(~NULL_BRUSH)

        Endif

        Caseof ~WM_CTLCOLORDLG

        ~SetBkMode(wparam&,~Transparent)
        Return Brush&

        Caseof ~WM_CTLCOLORBTN

        ~SetBkMode(wparam&,~Transparent)
        Return ~GetStockObject(~NULL_BRUSH)

        Caseof ~WM_TIMER

        Dec D&
        Startpaint wnd&
        TextColor $FFFF,$FF
        Drawtext width(wnd&)-24,Height(wnd&)-20,Space$(10)
        Drawtext width(wnd&)-24,Height(wnd&)-20,Format$("%3.0f",D&)
        Endpaint

        If D& = 0

            sendmessage(wnd&,~wm_close,0,0)

        endif

        Return 0

        Caseof ~WM_COMMAND

        If lparam& = b&

            If Getcheck(B&)

                B1& = 1

            Endif

        Endif

        Result& = 1

        Caseof ~WM_NCDESTROY

        ~Killtimer(wnd&,1)
        ~DeleteObject(Brush&)
        ~DeleteObject(Pic&)
        ~DeleteObject(Brush1&)
        ~DeleteObject(Pic1&)
        ~UnhookWindowsHookEx(Hook&)
        Result& = 1

    Endselect

    Result& = ~CallWindowProc(OldProc&,wnd&,msg&,wparam&,lparam&)
    Return Result&

Endproc

Proc SetHook

    Parameters nCode&, wParam&, lParam&

    Select nCode&

        Caseof ~HC_ACTION

        Var pw# = New(CWPSTRUCT)
        pw# = lparam&

        If pw#.message& = ~WM_INITDIALOG

            If D& : ~Settimer(pw#.hwnd&,1,1000,0):Endif

                OldProc& = ~SetWindowlong(pw#.hwnd&,~GWL_WNDPROC,ProcAddr("MB",4))
                Dispose pw#

            Endif

        EndSelect

        Return ~CallNextHookEx(Hook&, nCode&, wParam&, lParam&)

    EndProc

    Proc PRF_Messagebox

        Set("Fastmode",1)
        Parameters  body$, title$, flags&
        Declare Result&
        Flags& = Flags& | ~MB_ICONQUESTION
        Hook& = ~SetWindowsHookEx(~WH_CALLWNDPROC, ProcAddr("SetHook",3), 0,~GetCurrentThreadId())
        Result& = MessageBox(title$,body$, flags&)
        Set("Fastmode",0)
        Return Result&

    EndProc

    Proc GradientRect

        Parameters DC&,x%,y%,w%,h%,Color1&,Color2&,HV&
        Declare GradRect#,Trivertex#
        Dim GradRect#,8
        Dim Trivertex#,32
        Long Gradrect#,0 = 0,1
        Long Trivertex#,0 =x%,y%
        word Trivertex#,8=GETRVALUE(Color1&) << 8,GETGVALUE(Color1&) << 8,GETBVALUE(Color1&) << 8,0
        Long Trivertex#,16=w%,h%
        word Trivertex#,24=GETRVALUE(Color2&) << 8,GETGVALUE(Color2&) << 8,GETBVALUE(Color2&) << 8,0
        External("Msimg32.dll","GradientFill",DC&,Trivertex#,2,Gradrect#,1,HV&)
        Dispose Trivertex#
        Dispose Gradrect#

    EndProc

    Hier gehts los
    Declare Hook&,OldProc&
    Declare B&,B1&
    Declare X&,T&,Brush&,Pic&,Brush1&,Pic1&
    Declare D&
    TIMER auf 15 Sekunden setzen
    D& = 15
    Wenn D& = 0, dann kein Timer
    Nach 15 Sekunden verschwindet die Box automatisch
    cls
    Print PRF_Messagebox("Eine Frage...","Wirklich löschen ?",~MB_YESNOCANCEL | ~MB_ICONQUESTION)
    Print IF(B1&=1,"Nicht wieder anzeigen","wieder anzeigen")
    Waitinput