Der Gestaltung ist keine Grenzen gesetzt. Erklärungen im Code
sollten Fehler vorhanden sein, bitte melden, my english very
Code: Alles auswählen
;DialogBox by HJBremer Jan. 2010
Enumeration
#fnt1
#fnt2
#win
#db1
EndEnumeration
;Structure DLGTEMPLATE ;in PB bereits definiert
; style.i ;Fensterstile
; dwExtendedStyle.i ;??
; cdit.w ;immer null
; x.w ;wenn #DS_Center null
; y.w ;sonst posi vom Dialog
; cx.w ;breite + höhe, im Dialog werden sogenannte Dialog Units
; cy.w ;benutzt, diese sind doppelt so groß
;EndStructure
Structure DLG_TEMPLATE Extends DLGTEMPLATE
x1.w ;folgende Werte x1 bis x3 müssen sein, sagt die MSDN
x2.w ;ohne gehts auch nicht.
x3.w ;
EndStructure
Structure DLG_PARAMETER ;kann beliebig erweitert werden
titel.s ;um den Dialog zu steuern
text.s
vg.s
eingabe.s
fontid.i
EndStructure
Procedure myInputRequesterDlgProc(hwnd, msg, wparam, lparam)
;folgende Variablen müssen Static sein, da sie auch ausserhalb von
;#WM_INITDIALOG gebraucht werden
Static *p.DLG_PARAMETER ;Zeiger auf Parameter Structur
Static oknr, abnr, stnr ;Gadgetnummern
;folgende Variablen werden nur in #WM_INITDIALOG benutzt beim Aufruf
Protected nr ;allgemeine Gadgetnr für diverse Gadgets
Protected wbr, whh, r.rect ;reale Werte vom Dialogfenster
Protected sp, ze ;Hilfsvariablen
Select msg
Case #WM_INITDIALOG
*p = lparam
;wenn style mit #WS_SYSMENU|#WS_CAPTION
;SetWindowText_(hwnd, *p\titel)
imgnr = CreateImage(#PB_Any, 220, 42)
StartDrawing(ImageOutput(imgnr))
Box(0,0,220,42,#Red)
StopDrawing()
GetClientRect_(hwnd, r.rect)
wbr = r\right - r\left ;:Debug wbr
whh = r\bottom - r\top ;:Debug whh
UseGadgetList(hwnd)
nr = TextGadget(#PB_Any, 10, 10, 100, 22, *p\titel)
SetGadgetFont(nr, *p\fontid)
nr = TextGadget(#PB_Any, 10, 50, 100, 22, *p\text)
SetGadgetFont(nr, *p\fontid)
nr = ImageGadget(#PB_Any, 5, 90, 0, 0, ImageID(imgnr))
stnr = StringGadget(#PB_Any, 15, 100, 200, 22, *p\vg)
SetGadgetFont(stnr, *p\fontid)
sp = 10
ze = whh - 22 - 10
oknr = ButtonGadget(#PB_Any, sp, ze, 100, 22, "Ok")
abnr = ButtonGadget(#PB_Any, sp + 110, ze, 100, 22, "abbrechen")
oknr & $FFFF ;muß sein, sonst kann man bei #WM_COMMAND
abnr & $FFFF ; die Gadgetnummern nicht abfragen
Case #WM_COMMAND
If wparam = oknr Or wparam = 1 ;wparam = 1 = Return
*p\eingabe = GetGadgetText(stnr)
EndDialog_(hwnd, wparam)
ElseIf wparam = abnr
*p\eingabe = ""
EndDialog_(hwnd, 0)
EndIf
;Case #WM_CLOSE ;wenn style mit #WS_SYSMENU|#WS_CAPTION
; *p\eingabe = ""
; EndDialog_(hwnd, 0)
EndSelect
ProcedureReturn 0
EndProcedure
Procedure.s myInputRequester(titel$, text$, vorgabe$)
Static dlg.DLG_TEMPLATE
Static ipr.DLG_PARAMETER
Protected nr = GetActiveWindow()
dlg\style = #WS_POPUP|#DS_CENTER|#DS_MODALFRAME ;|#WS_SYSMENU|#WS_CAPTION
dlg\cx = 200 ;Breite, im Dialog der doppelte Wert
dlg\cy = 100 ;Höhe
ipr\titel = titel$
ipr\text = text$
ipr\vg = vorgabe$
ipr\fontid = FontID(#fnt2)
DialogBoxIndirectParam_(0, dlg, WindowID(nr), @myInputRequesterDlgProc(), ipr)
ProcedureReturn ipr\eingabe
EndProcedure
LoadFont(#fnt1, "Arial", 8)
LoadFont(#fnt2, "Arial", 11)
OpenWindow(#win, 0, 0, 555, 333, "Test", #PB_Window_SystemMenu|1)
ButtonGadget(#db1, 22, 222, 111, 33, "Dialog Test")
Repeat: event = WaitWindowEvent()
If event = #PB_Event_Gadget Or event = #PB_Event_Menu
wB = EventGadget()
Select wB
Case #db1
vg$ = "hjb"
input$ = myInputRequester("Suchen", "ihre Eingabe", vg$)
If input$
Debug input$
Else
Debug "Abbruch"
EndIf
EndSelect
EndIf
Until event = #PB_Event_CloseWindow
End
