Code: Alles auswählen
;Input-DialogBox mit Combobox by hjbremer Jan.2010
;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
info1.s
datname.s
vorgabe.s
eingabe.s
fontid1.i
fontid2.i
bgbrush.i
gksflag.i
EndStructure
;EnableExplicit
Procedure.s InputRequester3FileName(dat$)
If dat$ = ""
dat$ = ReplaceString(GetFilePart(ProgramFilename()), ".exe", "-cb.txt", 0)
EndIf
ProcedureReturn dat$
EndProcedure
Procedure.i InputRequester3FileSave(dat$, Array cb$(1), input$)
Protected anz = ArraySize(cb$())
Protected j, dnr
dat$ = InputRequester3FileName(dat$)
anz + 1
ReDim cb$(anz)
cb$(anz) = input$
For j = 0 To anz - 1
If cb$(j) = input$
cb$(j) = ""
EndIf
Next
If anz
SortArray(cb$(), #PB_Sort_Ascending|#PB_Sort_NoCase, 0, anz-1)
EndIf
dnr = CreateFile(#PB_Any, dat$)
If dnr
For j = 0 To anz
If cb$(j)
WriteStringN(dnr, cb$(j))
EndIf
Next
CloseFile(dnr)
EndIf
EndProcedure
Procedure.i InputRequester3FileDelete(dat$)
dat$ = InputRequester3FileName(dat$)
DeleteFile(dat$)
EndProcedure
Procedure.i InputRequester3FileLoad(dat$, Array cb$(1))
Protected anz, dnr, txt$
dat$ = InputRequester3FileName(dat$)
anz = -1
dnr = ReadFile(#PB_Any, dat$)
If dnr
While Eof(dnr) = 0
txt$ = ReadString(dnr)
If txt$
anz + 1
ReDim cb$(anz)
cb$(anz) = txt$
EndIf
Wend
CloseFile(dnr)
EndIf
ProcedureReturn anz
EndProcedure
Procedure.i InputRequester3DlgProc(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, ipnr ;Gadgetnummern ok, abbr., input
Static c1nr, c2nr, nr ;Checkboxen, Textgadget
;folgende Variablen werden nur in #WM_INITDIALOG benutzt beim Aufruf
Protected oldGadgetList
Protected wbr, whh, r.rect ;reale Größe vom Dialogfenster
Protected abstd, zeile
Protected j, x, y, hh, br, x1, x2
;für Combobox
Static comboanzahl
Static Dim combo$(0)
; ---------------------------------------------------
Select msg
Case #WM_INITDIALOG
*p = lparam
;Combobox Inhalt laden
comboanzahl = InputRequester3FileLoad(*p\datname, combo$())
SetWindowText_(hwnd, *p\titel)
GetClientRect_(hwnd, r.rect)
wbr = r\right - r\left ;:Debug wbr
whh = r\bottom - r\top ;:Debug whh
oldGadgetList = UseGadgetList(hwnd)
abstd = 10: zeile = 15
;Info
x = abstd: y = zeile: br = wbr / 2: hh = 22
nr = TextGadget(#PB_Any, x, y, br, hh, "Eingabe: " + *p\info1)
SetGadgetFont(nr, *p\fontid1)
;Combobox
x = abstd: y = zeile + hh + 5: br = wbr - x - x
ipnr = ComboBoxGadget(#PB_Any, x, y, br, hh, #PB_ComboBox_Editable)
SetGadgetFont(ipnr, *p\fontid1)
For j = 0 To comboanzahl
AddGadgetItem(ipnr, -1, combo$(j))
SetGadgetState(ipnr, j)
Next
;If *p\vorgabe: SetGadgetText(stnr, *p\vorgabe): EndIf
;Kasten + Checkbox
x1 = abstd: y + hh + 8: br = (wbr - 3 * abstd) / 2: hh = 36
x2 = abstd + br + abstd
Frame3DGadget(#PB_Any, x1, y, br, hh,"")
Frame3DGadget(#PB_Any, x2, y, br, hh,"")
x1 + 4: y + 10: br - 6: hh = 22
x2 + 4
c1nr = CheckBoxGadget(#PB_Any, x1, y, br, hh, "Groß/Klein beachten")
c2nr = CheckBoxGadget(#PB_Any, x2, y, br, hh, "Eingabe-Liste löschen")
;ok + abbrechen
br = 100: hh = 22
x = (wbr - abstd - (2 * br)) / 2: y = whh - hh - abstd
oknr = ButtonGadget(#PB_Any, x, y, br, hh, "Ok")
abnr = ButtonGadget(#PB_Any, x + br + abstd, y, br, hh, "abbrechen")
SetActiveGadget(ipnr)
UseGadgetList(oldGadgetList)
Case #WM_COMMAND ;Button gedrückt oder Eingabe
If wparam = c1nr & $FFFF
*p\gksflag = GetGadgetState(c1nr)
;Button ok oder Return
ElseIf wparam = oknr & $FFFF Or wparam = 1 ;wparam = 1 = Return
If GetGadgetState(c2nr) ;Checkbox Kill
InputRequester3FileDelete(*p\datname)
SetGadgetState(c2nr, 0)
ClearGadgetItems(ipnr)
ReDim combo$(0)
Else
*p\eingabe = GetGadgetText(ipnr)
InputRequester3FileSave(*p\datname, combo$(), *p\eingabe)
EndDialog_(hwnd, wparam)
EndIf
;abbrechen oder Esc
ElseIf wparam = abnr & $FFFF Or wparam = 2
*p\eingabe = ""
EndDialog_(hwnd, 0)
EndIf
Case #WM_CLOSE ;wie Button abbrechen
*p\eingabe = ""
EndDialog_(hwnd, 0)
Case #WM_CTLCOLORDLG, #WM_CTLCOLORBTN
ProcedureReturn *p\bgbrush
Case #WM_CTLCOLORSTATIC
SetBkMode_(wparam, #TRANSPARENT)
Select lparam
Case GadgetID(c1nr), GadgetID(c2nr) ;Checkboxen
ProcedureReturn *p\bgbrush
Default: ProcedureReturn GetStockObject_(#NULL_BRUSH)
EndSelect
EndSelect
ProcedureReturn 0
EndProcedure
Procedure.s InputRequester3(titel$, text$, dat$ = "", *i.integer = 0)
Static dlg.DLG_TEMPLATE ;muß Static sein !!!
Static ipr.DLG_PARAMETER
x = GetActiveWindow() : Debug x
Protected hwnd = WindowID(x)
;Protected hwnd = WindowID(GetActiveWindow())
Protected font1 = LoadFont(#PB_Any, "Arial", 11)
Protected font2 = LoadFont(#PB_Any, "Arial", 9)
dlg\style = #WS_POPUP|#DS_CENTER|#WS_SYSMENU|#WS_CAPTION|#DS_MODALFRAME
dlg\cx = 150 ;Breite, im Dialog der doppelte Wert
dlg\cy = 75 ;Höhe
ipr\titel = titel$
ipr\info1 = text$
ipr\datname = dat$
ipr\vorgabe = ""
ipr\fontid1 = FontID(font1)
ipr\fontid2 = FontID(font2)
ipr\bgbrush = CreateSolidBrush_($DFFFFF)
ipr\gksflag = 0
DialogBoxIndirectParam_(0, dlg, hwnd, @InputRequester3DlgProc(), ipr)
FreeFont(font1)
FreeFont(font2)
DeleteObject_(ipr\bgbrush)
If ipr\gksflag = 0: ipr\eingabe = LCase(ipr\eingabe): EndIf
If *i: *i\i = ipr\gksflag: EndIf
ProcedureReturn ipr\eingabe
EndProcedure
Enumeration
#win
#db1
#ShortCut_F3
#ShortCut_CF4
#Shortcut_Return
EndEnumeration
; ----------------------------------------
Procedure.i LvGetCols(id)
Protected head = SendMessage_(id, #LVM_GETHEADER, 0, 0)
Protected cols = SendMessage_(head, #HDM_GETITEMCOUNT, 0, 0)
ProcedureReturn cols
EndProcedure
Procedure.s LvGetItem(pbnr, item, cols)
Protected j, x$ = ""
For j = 0 To cols
x$ + GetGadgetItemText(pbnr, item, j) + #LF$
Next
ProcedureReturn x$
EndProcedure
Procedure.i LvSuchen(lvnr, such$, gkflag, lvposi = 0)
Protected cols, found, j, satz$
If such$ ;:Debug such$: Debug gkflag
cols = LvGetCols(GadgetID(lvnr))
found = -1
For j = lvposi To CountGadgetItems(lvnr)
satz$ = LvGetItem(lvnr, j, cols) ;:Debug satz$
If Not gkflag: satz$ = LCase(satz$): EndIf ;:Debug satz$
If FindString(satz$, such$, 0) ;:Debug satz$
found = j ;:Debug found
Break
EndIf
Next
If found > -1
SetGadgetState(lvnr, found)
SendMessage_(GadgetID(lvnr), #LVM_ENSUREVISIBLE, found, 1)
lvposi = found + 1
Else
lvposi = 0
MessageRequester("", "Ende der Liste")
EndIf
EndIf
ProcedureReturn lvposi
EndProcedure
; ----------------------------------------
Dim subitem$(3,2)
Restore LvItemsData
For j = 0 To 3: Read.s subitem$(j,0): Next
For j = 0 To 3: Read.s subitem$(j,1): Next
For j = 0 To 3: Read.s subitem$(j,2): Next
hwnd = OpenWindow(#win, 50, 100, 555, 340, "Test", #PB_Window_SystemMenu)
AddKeyboardShortcut(#win, #PB_Shortcut_F3, #ShortCut_F3)
AddKeyboardShortcut(#win, #PB_Shortcut_Control|#PB_Shortcut_F, #ShortCut_CF4)
;ev. Probleme, z.B. WebGadget reagiert nicht mehr auf Return
AddKeyboardShortcut(#win, #PB_Shortcut_Return, #Shortcut_Return)
ButtonGadget(#db1, 22, 300, 150, 33, "Dialog Suchen / Strg + F")
TextGadget(#PB_Any, 180, 300, 111, 33, "F3 = weitersuchen", #SS_CENTERIMAGE)
flag = #PB_ListIcon_GridLines
flag | #PB_ListIcon_FullRowSelect
flag | #PB_ListIcon_AlwaysShowSelection
lvnr = ListIconGadget(#PB_Any, 10, 10, 535, 280, "Sp 0", 50, flag)
AddGadgetColumn(lvnr, 1, "Sp 1", 200)
AddGadgetColumn(lvnr, 2, "Sp 2", 200)
AddGadgetColumn(lvnr, 3, "Sp 3", 200)
For j = 0 To 39
a$ = Str(j) + #LF$
a$ + subitem$(Random(3), 0) + #LF$
a$ + subitem$(Random(3), 1) + #LF$
a$ + subitem$(Random(3), 2) + #LF$
AddGadgetItem(lvnr, -1, a$)
Next
Repeat: event = WaitWindowEvent()
If event = #PB_Event_Gadget Or event = #PB_Event_Menu
wB = EventGadget()
Select wB
Case #ShortCut_CF4, #db1
such$ = InputRequester3("Suchen", "Suchbegriff", "test.txt", @flag)
posi = LvSuchen(lvnr, such$, flag)
Case #ShortCut_F3, #Shortcut_Return
posi = LvSuchen(lvnr, such$, flag, posi)
EndSelect
EndIf
Until event = #PB_Event_CloseWindow
End
DataSection
LvItemsData:
Data.s "Bremer", "Meier", "Schulze", "Müller"
Data.s "Hamburg", "Berlin", "München", "Bremen"
Data.s "83", "67", "74", "92"
EndDataSection
