MessageBoxCheck (abstellbare MessageBox)

[ts-soft]

' http://msdn.microsoft.com/en-us/library/bb773836%28v=VS.85%29.aspx

Def SHMessageBoxCheck(6) !"Shlwapi.dll", "SHMessageBoxCheckA"

Proc MessageBoxCheck
  Parameters Text$, Titel$, Flags&, Default&, RegVal$
  Select %PCount
    CaseOf 4
      RegVal$ = "NervNicht"
    CaseOf 3
      Default& = -1
  EndSelect
  Return SHMessageBoxCheck(%hWnd, Addr(Text$), Addr(Titel$), Flags&, Default&, Addr(RegVal$))
EndProc

Var Default& = 4711
Select MessageBoxCheck("Du bist zu blöd zum Mäuse melken", "Fehler:", 20, Default& , "{9937FEAC-4F3B-44F0-9D96-20D8F1784479}")
  CaseOf 6
    Print "Siehst es ja wenigstens ein"
  CaseOf 7
    Print "Na dann melk mal"
  CaseOf Default&
    Print "Ach, haste mich abgeschaltet ;)"
EndSelect

WaitKey

Sollte weitgehend selbsterklärend sein. RegVal sollte ein einmaliger String sein, also am besten ein GUIDSTRING, wie im Beispiel.

Um die Box wieder einzuschalten ist der Schlüssel mit RegVal in der Registry zu löschen:

"HKEY_1", "Software\Microsoft\Windows\CurrentVersion\Explorer\DontShowMeThisDialogAgain"

Gruß
Thomas

[Frabbing]

Ein weiteres Goldstück aus der ShlWapi!

[THFR]

Aber alles eine Frage der Shlwapi.dll (Version 6.00.2900.2995) , denn unter XP SP2 bekomme ich die Fehlermeldung:
Die Funktion ist nicht vorhanden!

[ts-soft]

Shlwapi.dll (version 5.0 or later)
Ab Windows 2000 immer vorhanden! Lediglich der Registry-Eintrag könnte
unter älteren Systemen leicht woanders sein.

[Frabbing]

Ja, sollte laut MSDN ab Version 5.0 der Dll laufen.

[Andreas Miethe]

Hallo Roland,

im Zusammenhang mit dieser DLL ist mir ein Fehler? aufgefallen.
Passiert nur unter Win7

siehe Bild.


Die Funktion ist definitiv in der Dll enthalten.

Vielleicht kannst Du das mal prüfen ?

[Jac de Lad]

Ohne mich unbeliebt machen zu wollen, weil ich hier was anderes anpreise: Ich liebe die TaskDialoge von Windows 6+. Mit der XTaskDialog.dll gehen die schon ab Windows 98 und funktionieren super (benutze ich jetzt in fast jedem Programm).

[Frabbing]

Das sind ja nicht so viele... *duck*

[ts-soft]

Was ist Windows 6+
Ist XTaskDialog.dll eine API, oder muss ich die mitliefern

[Jac de Lad]

Die DLL musst du runterladen.
Ist von hier: XTaskDialog v1.12


Ich habe mal ein Paket gemacht, ist aber noch nicht vollständig.

[ts-soft]

Danke!
Den Zusammenhang zwischen meiner API MessageBox und der DLL sehe
ich zwar nicht, aber egal, sieht ganz nützlich aus.
Habe mir mal das Original-Paket geladen, da ich die 64-Bit Version ja auch
nutzen kann.

Vielleicht arbeitest Du mal an Deinem Stil, die Inc ist einfach schrecklich
unübersichtlich . Sowas hab ich ja seit den 80-ger Jahren nicht mehr gesehen.

Gruß
Thomas

[Jac de Lad]

Die Inc war auch nicht für die Öffentlichkeit gedacht. Die DLL nutze ich in zahlreichen Projekten, weil die Dialoge gut aussehen.

Den Zusammenhang sehe ich darin, dass du eine abschaltbare Messagebox wolltest, was der TaskDialog auch kann (Checkbox).

[Andreas Miethe]

Zitat von Jac de Lad

Den Zusammenhang sehe ich darin, dass du eine abschaltbare Messagebox wolltest, was der TaskDialog auch kann (Checkbox).

Geht das auch mit einem Timer, der den Dialog automatisch schließt ?

Im Ernst, sowas kannst Du auch mit Xprofan machen.

'##############################################
'# Autor           : ampsoft (Andreas Miethe) #
'# Datum           : 15.01.2011               #
'# Thema           : Hook                     #
'##############################################

$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 &IDHELP       9
DEF &IDTRYAGAIN  10
DEF &IDCONTINUE  11
DEF &IDICON      20
DEF &IDPROMPT $FFFF
DEF &IDSTATIC $CAFE
'#############################

Struct CWPSTRUCT = lParam&,wParam&,message&,hwnd&
Struct POINT = cx&,cy&
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&) <= &IDCONTINUE)
    '    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
    Var p# = new(POINT)
    Var oo& = 0
    oo& = ~SelectObject(DC&,~GetStockObject(~ANSI_VAR_FONT))
    ~GetTextExtentPoint32(DC&,"Diese Meldung nicht wieder anzeigen",35,p#)
    If w& < (p#.cx&+60) : W& = p#.cx&+60 : Endif
    ~DeleteObject(~SelectObject(DC&,oo&))
    ~Movewindow(wnd&,Int(((%maxx/2) - (w&/2))),Int(((%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&
        ~SetBkMode(%hdc,~Transparent)
        ~SetTextColor(%hdc,$FFFF)
        Drawtext width(wnd&)-24,Height(wnd&)-20,Format$("%3.0f",D&)
      Endif
    EndPaint
    Brush& = ~CreatePatternBrush(Pic&)

    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)
    ShowWindow(~GetDlgItem(wnd&,&IDSTATIC),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#
    Return 0

    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
      ~SetWindowPos(pw#.hwnd&,0,100,100,0,0,~SWP_SHOWWINDOW | ~SWP_NOSIZE)
      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 geht's 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 ?\na\nb\nc\nd",~MB_YESNOCANCEL | ~MB_DEFBUTTON2 | ~MB_ICONQUESTION)
Print IF(B1&=1,"Nicht wieder anzeigen","wieder anzeigen")
Waitinput

[Frabbing]

Schön bunt, aber funktioniert 1a!
War mir irgendwie durch die Lappen gegangen, der Thread. Jetzt erst entdeckt...

[horsthorn]

@Jac

Geht das auch mit einem Timer, der den Dialog automatisch schließt ?

Habe mal vor ein paar Jahren sowas geschrieben und Dietmar Horn hat das in seine Code-Sammlung übernpmmen (Danke Dietmar)

'Alle Message-Fenster in PROFAN² müssen immer über einen Button geschlossen werden.
'Es gibt aber auch Meldungen, die nach einer bestimmten Zeit von selbst schliessen.
'Hier ist eine Procedur, die das auch macht. Sollte in jeder Version funktionieren.
'(C) Horst Horn

PROC ZEIT_FENSTER
   DECLARE text_lang%,m_X%,m_txt%,meldung&,m_font&
   PARAMETERS m_titel$,icon$,text_B%,m_text$,m_text1$,m_text2$,zeit%,m_back%
   '1. Titeltext
   '2. Profan-Icon
   '3. Fontbreite
   '4. Textzeile 1
   '5. Textzeile 2
   '6. Textzeile 3
   '7. Anzeigezeit
   '8. Fensterhandle
   m_font&=CREATE("FONT","ARIAL",(text_B%*2),text_B%,0,0,0)'Font wird über die Breite erstellt
   text_lang%=LEN(m_text$)
   m_X%=((text_lang%*text_B%/2)+50)'die Breite des Fensters   
   WindowStyle 48'muss nicht sein...
   meldung& = CREATE("WINDOW",%HWnd,m_titel$,((%MaxX/2)-m_X%),((%MaxY/2)-60),(m_X%*2),130)
   CREATE("ICON",meldung&,icon$,10,15)'Alle PROFAN²-Icons sind möglich
   m_txt%=CREATE("TEXT",meldung&,m_text$,65,20,(m_X%*2),20)
   SetFont m_txt%,m_font&
   m_txt%=CREATE("TEXT",meldung&,m_text1$,65,40,(m_X%*2),20)'die 2. und 3. Textzeile sollten
   SetFont m_txt%,m_font&
   m_txt%=CREATE("TEXT",meldung&,m_text2$,65,60,(m_X%*2),20)'nicht länger wie die 1. sein
   SetFont m_txt%,m_font&
   '-------------------------
   SLEEP zeit%'Anzeigedauer
   '-------------------------
   DeleteObject m_font&
   DesTroyWindow(meldung&)
   SetFocus(%hwnd)'Der Focus wird auf das Hauptfenster gesetzt
ENDPROC

'Beispiel
CLS
zeit_fenster "Fenster schliesst automatisch","DRUCKER",8,"Der 7. Parameter gibt die Anzeigedauer an",\
"Danach wird das Fenster gelöscht...","Probieren ist angesagt ;o)",5000,%HWnd
waitinput
end