Messagebox mit anderem Font, Buttontext und Icon
Verfasst: 16.04.2020 18:10
Messagerequester ist schön einfach, aber uncool
Leider ist der Aufwand ihn zu verbessern nicht unerheblich
Hier eine Version Windows only ( gibts noch was anderes ?
) incl Beispiele
PS: Tool um Resourcennummern aus DLL zu holen folgt
Leider ist der Aufwand ihn zu verbessern nicht unerheblich
Hier eine Version Windows only ( gibts noch was anderes ?
) incl BeispieleCode: Alles auswählen
;MessageBox, V.1.3, ab PB 5.41 x86 Windows - Mrz.2020 by HJBremer
;da PB viele Konstanten nicht unterstützt, empfehle ich nur die Windows Konstanten zu benutzen.
;folgende ButtonIds gibt es, diese sind auch die Rückgabewerte
;1 IDOK Button OK #PB_MessageRequester_Ok=0, es wird aber 1 zurückgegeben
;2 IDCANCEL Abbrechen #PB_MessageRequester_Cancel
;3 IDABORT Abbrechen
;4 IDRETRY Wiederholen
;5 IDIGNORE Ignorieren
;6 IDYES Ja #PB_MessageRequester_Yes
;7 IDNO Nein #PB_MessageRequester_No
;8 - unbekannt
;9 - Hilfe es gibt keine ID-Konstante !! keinen Rückgabewert nur #WM_HELP
;10 IDTRYAGAIN Wiederholen
;11 IDCONTINUE Weiter
;20 ?? Icon ??
;$FFFF Textbox ID
;ButtonFlags
;#MB_OK buttons: OK = #PB_MessageRequester_Ok
;#MB_OKCANCEL buttons: OK + Abbrechen.
;#MB_YESNO buttons: Ja + Nein. = #PB_MessageRequester_YesNo
;#MB_YESNOCANCEL buttons: Ja + Nein + Abbrechen = #PB_MessageRequester_YesNoCancel
;#MB_RETRYCANCEL buttons: Wiederholen + Abbrechen.
;#MB_ABORTRETRYIGNORE buttons: Abbrechen + Wiederholen + Ignorieren.
;#MB_CANCELTRYCONTINUE = 6 buttons: Abbrechen + Wiederholen + Weiter. in PB nicht definiert
;#MB_HELP = $00004000 buttons: Help button siehe MSDN. in PB nicht definiert
;Icon | Button | DEFBUTTON
;#MB_ICONEXCLAMATION #MB_ICONWARNING ;gelbes Dreieck mit Ausrufezeichen
;#MB_ICONINFORMATION #MB_ICONASTERISK ;blauer Kreis mit einem i
;#MB_ICONQUESTION ;blauer Kreis mit einem ?
;#MB_ICONSTOP #MB_ICONERROR #MB_ICONHAND ;roter Kreis mit einem x
;Vorgabe aktiv
;#MB_DEFBUTTON1, #MB_DEFBUTTON2, #MB_DEFBUTTON3
;siehe auch https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-messagebox
DeclareModule MessageBox
Declare.i MessageBox(title$, text$, flags=#MB_OK, width=5, lf=1)
Declare.i MessageBoxFont(fontid)
Declare.i MessageBoxText(id, text$, width=70, align=0)
Declare.i MessageBoxIcon(file$, resnr, kill=0)
EndDeclareModule
Module MessageBox
EnableExplicit
Structure text
text.s
width.i
align.i
EndStructure
#buttonanz = 11
Global Dim button.text(#buttonanz)
Global fontid_text = FontID(LoadFont(#PB_Any, "Consolas", 11))
Global fontid_button = FontID(LoadFont(#PB_Any, "Tahoma", 10))
Global hookid, iconfile$, iconresnr, iconflag
Procedure.i MessageBoxIcon(file$, resnr, kill=0)
;file$ = Datei welche IconResourcen enthält. z.B. "shell32.dll"
;resnr = eine ResourcenNummer (kein Iconhandle bzw. Nummer)
;kill = 1 file$+resnr werden in MessageBox() gelöscht, Standard ist nix löschen
;#MB_USERICON muß bei Messagebox flags gesetzt sein, sonst kein anderes Icon
iconfile$ = file$
iconresnr = resnr
iconflag = kill
; wenn file$ = "" sind folgende Konstanten möglich, #MB_USERICON muß gesetzt sein
; diese Icons sehen unter Win10 besser aus
; #IDI_APPLICATION 32512 Standardanwendungssymbol. (Blatt Papier oder so)
; #IDI_ERROR 32513 roter Kreis mit X
; #IDI_HAND 32513 ""
; #IDI_QUESTION 32514 blauer Kreis mit ?
; #IDI_WARNING 32515 gelbes Dreieck mit !
; #IDI_EXCLAMATION 32515 ""
; #IDI_ASTERISK 32516 blauer Kreis mit i
; #IDI_INFORMATION 32516 ""
; IDI_WINLOGO 32517 Standardanwendungssymbol.
; #IDI_SHIELD 32518 Sicherheitsschild-Symbol.
EndProcedure
Procedure.i MessageBoxFont(fontid)
Protected old = fontid_text ;Text nur teilweise sichtbar dann bei Aufruf von
fontid_text = fontid ;MessageBox(title$, text$, flags=#MB_OK, width=5, lf=1)
ProcedureReturn old ; width und/oder lf vergrößern (width max 200, lf bis sichtbar)
EndProcedure
Procedure.i MessageBoxText(id, text$, width=70, align=0)
If id And id <= #buttonanz
button(id)\text = text$ ;nur wenn es Text gibt wird auch Font, Breite + Align geändert
button(id)\width = width ;neue Buttonbreite
button(id)\align = align ;#BS_LEFT #BS_RIGHT #BS_CENTER möglich, sonst Originalposition
EndIf
EndProcedure
Procedure.i MessageBoxProc(nCode, wParam, lParam)
;wparam ist das Messagebox Window Handle !!!
;lparam ist ein Zeiger auf die Structur CBTACTIVATESTRUCT = dort gleicher Wert wie wparam
Protected hwnd, id, rb.rect, rc.rect, rw.rect, x, y
If nCode = #HCBT_ACTIVATE
hwnd = GetDlgItem_(wparam, $FFFF) ;Textbox handle
SendMessage_(hwnd, #WM_SETFONT, fontid_text, 1) ;Textboxfont ändern
;Buttons
For id = 1 To #buttonanz ; id entspricht #IDOK, #IDNO, #IDYES = interne ButtonNr
hwnd = GetDlgItem_(wparam, id) ;Button handle
GetWindowRect_(wparam, rw) ;Rectangle Window Screen Coordinate
GetWindowRect_(hwnd, rb) ;Rectangle Button Screen Coordinate
GetClientRect_(hwnd, rc) ;Rectangle Button rc\right ist Breite
SendMessage_(hwnd, #WM_SETFONT, fontid_button, 1) ;neuer Font
SetWindowPos_(hwnd,0, 0, 0, rc\right, 25, #SWP_NOMOVE|#SWP_NOZORDER) ;Buttonhöhe ändern
If button(id)\text
SetDlgItemText_(wParam, id, button(id)\text) ;neuer Buttontext
MapWindowPoints_(0, wparam, rb, 2) ;ButtonScreenCoordinaten umwandeln in WindowWerte
y = rb\top - 0 ;button y Posi
Select button(id)\align ;button x Posi
Case #BS_LEFT : x = 10
Case #BS_RIGHT: x = rw\right - rw\left - button(id)\width - 16
Case #BS_CENTER: x = (rw\right - rw\left - button(id)\width) / 2 - 3
Default: x = rb\left ;Original Posi
EndSelect
SetWindowPos_(hwnd,0, x, y, button(id)\width, 25, #SWP_NOZORDER) ;ButtonPosi+Breite
EndIf
Next
UnhookWindowsHookEx_ (hookid)
EndIf
EndProcedure
Procedure.i MessageBox(title$, text$, flags=#MB_OK, width=5, lf=1)
;width: zusätzliche Zeichen um Fensterbreite zu vergrößern z.B. 100 (intern begrenzt)
;lf: zusätzliche Linefeeds um Fensterhöhe zu vergrößern z.B. 5
Protected result, msg.MSGBOXPARAMS
Protected handle = LoadLibraryEx_(@iconfile$, 0, #LOAD_LIBRARY_AS_DATAFILE) ;file$="" = handle=0
text$ + Space(width) + LSet("", lf, #LF$) ;Space + LF ändert Fenstergröße
With msg
\cbSize = SizeOf(msg)
\hwndOwner = 0 ;oder GetForegroundWindow_()
\hInstance = handle ;wenn 0 kein Icon, ausser #IDI_xxx als iconresnr
\lpszText = @text$
\lpszCaption = @title$
\dwStyle = flags ;alle Messagebox Flags
\lpszIcon = iconresnr ;ResourcenNr. #MB_USERICON muß bei flags gesetzt sein
EndWith
hookid = SetWindowsHookEx_(#WH_CBT, @MessageBoxProc(), #Null, GetCurrentThreadId_())
result = MessageBoxIndirect_(@msg)
FreeLibrary_(handle)
If iconflag: iconfile$="": iconresnr=0: EndIf ;iconflag global, siehe MessageBoxIcon()
ProcedureReturn result
EndProcedure
EndModule
UseModule MessageBox
fonttextid = FontID(LoadFont(#PB_Any, "Consolas", 18))
For j = 1 To 12
txt$ + RSet(Str(j),2) + #TAB$
txt$ + RSet(Str(Random(999)),4) + #TAB$
txt$ + RSet(Str(Random(999)),5) + #TAB$
txt$ + RSet(Str(Random(999)),5) + #TAB$
txt$ + RSet(Str(Random(999)),5) + #LF$
Next
MessageBoxIcon("shell32.dll", 16771) ;oder
MessageBoxIcon("ieframe.dll", 30788)
MessageBoxIcon("pifmgr.dll", 39)
MessageBoxText(#IDOK, "Save", 80, #BS_LEFT)
MessageBoxText(#IDCANCEL, "nein", 80, #BS_RIGHT)
result = MessageBox("Change Font + Pos", txt$, #MB_OKCANCEL|#MB_DEFBUTTON2|#MB_USERICON, 100, 5)
oldfont = MessageBoxFont(fonttextid)
MessageBoxText(#IDOK, "ja ja", 60, #BS_LEFT)
MessageBoxIcon("", #IDI_WARNING)
MessageBoxIcon("pifmgr.dll", 3)
result = MessageBox("Change Font + Pos", "Sortieren ?", #MB_OKCANCEL|#MB_USERICON, 40,2)
MessageBoxFont(oldfont)
MessageBoxText(#IDYES, "rot", 60, #BS_LEFT)
MessageBoxText(#IDNO, "gelb", 60, #BS_CENTER)
MessageBoxText(#IDCANCEL, "grün", 60, #BS_RIGHT)
MessageBoxIcon("pifmgr.dll", 33)
result = MessageBox("Change Font + Pos", "Farbe ?", #MB_YESNOCANCEL|#MB_USERICON, 50)
MessageRequester("Original", "das Original", #PB_MessageRequester_YesNoCancel|#MB_ICONWARNING)
