Simpler Requester mit DialogBoxIndirectParam

[hjbremer]

kann nur passieren wenn es kein aktives Window gibt. z.B. Aufruf bevor OpenWindow benutzt wird. Also z.B. ohne Democode benutzt

Ansonsten macht man dagegen folgendes:

Code: Alles auswählen

Protected hwnd  = 0

anstatt

Code: Alles auswählen

Protected hwnd  = WindowID(GetActiveWindow())

das macht aber wenig Sinn, denn dann hat der InputRequester keinen Papa und keine Mama

[Peter-AC]

Hallo hjbremer

ich schrieb ja schon: umgewandelt, läuft.

Das heisst, natürlich mit dem DemoCode. Nur im Debugger bekomme ich den Fehler. Also umwandeln mit Debugger = Fehler. F5 kein Fehler und läuft.

LG
Peter

[hjbremer]

dann weiß ich das auch nicht, bei mir ist dat nicht so

nimm mal die betreffende Zeile auseinander

z.B. so

Code: Alles auswählen

x = GetActiveWindow() : Debug x
Protected hwnd  = WindowID(x)

und schau was Sache ist

[Peter-AC]

Hallo hjbremer

x=-1
Danch tritt der Fehler beim Befehl Protected hwnd = WindowID(x)
Ich nutze PB 4.40. Kann es daran liegen?

LG
Peter

[Peter-AC]

Hie der komplette Code

LG
Peter

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

[Peter-AC]

Hallo

ich denke, ich habe das Problem behoben.

Wenn der Debugger im Einzelschritt startet, wechselt das aktive Fenster zum Debugger. Die Funktion GetActiveWindow() liefert dann -1.
Man muss die Funktion GetActiveWindow() vor erreichen des Einzelschritt ermitteln und dann weiter verwenden. Dann klappt es.

LG
Peter

[hjbremer]

jo, das wirds sein, sollte dich das Problem irgendwie behindern, beim entwickeln eines Programmes, mußt du halt dem InputRequester3 noch einen Parameter verpassen.

hwnd = OpenWindow(#win, ...

....
....

InputRequester3(hwnd, "Suchen", "Suchbegriff", .....

dann ist das Problem ganz sicher weg, aber man hat einen Parameter mehr, was ich nicht so schön fand.

Ein anderer Weg wäre, um völlig sicher zu gehen, die Api Funktion GetGUIThreadInfo () zu benutzen, aber das ist irgendwie ein bißchen übertrieben.