EmulateDialog windows only

[ts-soft]

Dieser Code basiert auf einem Beispiel von Justin: http://www.purebasic.fr/english/viewtop ... 11#p346411

Code: Alles auswählen

EnableExplicit

Procedure EmulateDialogCallback(hWnd, uMsg, wParam, lParam)
  Protected oldproc = GetProp_(hWnd, "oldproc")
  
  Select uMsg
    Case #WM_NCDESTROY
      RemoveProp_(hWnd, "oldproc")
    Case #WM_KEYDOWN
      Select GadgetType(GetDlgCtrlID_(hWnd))
        Case #PB_GadgetType_Button, #PB_GadgetType_ButtonImage
          If wParam = #VK_RETURN
            SendMessage_(hWnd, #BM_CLICK , 0, 0)
            ProcedureReturn 0
          EndIf
        Case #PB_GadgetType_String
          If wParam = #VK_RETURN
            SetFocus_(GetNextDlgTabItem_(GetParent_(hWnd), hWnd, #False))
            ProcedureReturn 0
          EndIf
        Case #PB_GadgetType_Option
          If wParam = #VK_DOWN
            SendMessage_(GetNextDlgGroupItem_(GetParent_(hWnd), hWnd, #False), #BM_CLICK , 0, 0)
            ProcedureReturn 0
          ElseIf wparam = #VK_UP
            SendMessage_(GetNextDlgGroupItem_(GetParent_(hWnd), hWnd, #True), #BM_CLICK , 0, 0)
            ProcedureReturn 0
          EndIf
      EndSelect
  EndSelect
  
  ProcedureReturn CallWindowProc_(oldproc, hWnd, uMsg, wParam, lParam)
EndProcedure

Procedure EmulateDialog(ID)
  Protected oldproc = SetWindowLongPtr_(GadgetID(ID), #GWL_WNDPROC, @EmulateDialogCallback())
  ProcedureReturn SetProp_(GadgetID(ID), "oldproc", oldproc)
EndProcedure

Procedure InitEmulateWin(ID)
  ProcedureReturn SendMessage_(WindowID(ID), #WM_CHANGEUISTATE, 2 | (1 << 16), 0)
EndProcedure

; Example

Define i
OpenWindow(0, 0, 0, 222, 200, "ButtonGadgets", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    
ButtonGadget(0, 10, 10, 200, 20, "Default Button")
StringGadget(1, 10, 40, 200, 20, "")
StringGadget(2, 10, 70, 200, 20, "")
OptionGadget(3, 10, 100, 60, 20, "Option 1")
OptionGadget(4, 10, 130, 60, 20, "Option 2")
OptionGadget(5, 10, 160, 60, 20, "Option 3")
SetGadgetState(3, 1)
SetActiveGadget(0)
For i = 0 To 5
  EmulateDialog(i)
Next

InitEmulateWin(0)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow : Break
    Case #PB_Event_Gadget
      Debug "Gadget: " + Str(EventGadget()) + " : Type: " + Str(EventType())
  EndSelect
ForEver

[bobobo]

und niemand weiß was man damit anfangen soll ..

[ts-soft]

und niemand weiß was man damit anfangen soll ..

Ist der Code so schwer zu nutzen oder der Zweck nicht klar?

Gab doch schon des öfteren Anfragen, warum die Gadgets nicht auf Return reagieren,
weil viele das unterschiedliche Verhalten von Dialogen und Fenstern nicht verstehen.

Hiermit kann man ohne jeglichen Aufwand das Verhalten emulieren, aber warum sich da
keiner für interessiert

Mir egal

[hjbremer]

Hiermit kann man ohne jeglichen Aufwand das Verhalten emulieren, aber warum sich da
keiner für interessiert
Mir egal

War vielleicht zuviel des Guten

hier mal etwas einfacher, nur Zahlen und Punkt erlaubt. Navigation mit Pfeiltasten und Return

Code: Alles auswählen

EnableExplicit

Procedure StringGadgetCallback(hWnd, uMsg, wParam, lParam)
   
   Protected oldproc = GetProp_(hWnd, "oldproc")
   Protected parent  = GetParent_(hWnd)
   
   Select uMsg
      Case #WM_NCDESTROY
         RemoveProp_(hWnd, "oldproc")
         
      Case #WM_KEYDOWN
         
         Select wParam 
            Case #VK_RETURN
               SetFocus_(GetNextDlgTabItem_(parent, hWnd, #False))
               ProcedureReturn 0
               
            Case #VK_DOWN
               SetFocus_(GetNextDlgTabItem_(parent, hWnd, #False))
               ProcedureReturn 0
               
            Case  #VK_UP
               SetFocus_(GetNextDlgTabItem_(parent, hWnd, #True))
               ProcedureReturn 0
               
         EndSelect
         
      Case #WM_CHAR
         
         Select wParam
            Case 44: wparam = 46          ;Komma wird Punkt
            Case 48 To 57                 ;erlaubt   
            Default: ProcedureReturn 0    ;tue nix
         EndSelect   
         
   EndSelect
   
   ProcedureReturn CallWindowProc_(oldproc, hWnd, uMsg, wParam, lParam)
EndProcedure

Procedure SubClassingStringGadgetWithSetProp(ID)
   Protected oldproc = SetWindowLongPtr_(GadgetID(ID), #GWL_WNDPROC, @StringGadgetCallback())
   ProcedureReturn SetProp_(GadgetID(ID), "oldproc", oldproc)
EndProcedure

; Example

Define i
OpenWindow(0, 0, 0, 222, 200, "ButtonGadgets", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

StringGadget(1, 10, 40, 200, 20, "")
StringGadget(2, 10, 70, 200, 20, "")
StringGadget(3, 10, 100, 200, 20, "")
StringGadget(4, 10, 130, 200, 20, "")
StringGadget(5, 10, 160, 200, 20, "")

SetActiveGadget(1)

For i = 1 To 5
   SubClassingStringGadgetWithSetProp(i)
Next

Repeat
   Select WaitWindowEvent()
      Case #PB_Event_CloseWindow : Break
      Case #PB_Event_Gadget
         ;Debug "Gadget: " + Str(EventGadget()) + " : Type: " + Str(EventType())
   EndSelect
ForEver

[ts-soft]

Das man mit Pfeil rauf und runter von Text zu Text springen kann in Dialogen wäre mir Neu
Aber ich bekomme so selten Dialoge zu Gesicht, das ich mir da nicht sicher bin.

Das mit dem Numeric-String könnte man ja noch einbauen, wenn der Style entsprechend gesetzt ist,
aber mir fehlt im Moment die Lust hier noch was zu ändern, wenn es eh keiner braucht.

[bobobo]

und niemand weiß was man damit anfangen soll ..

Ist der Code so schwer zu nutzen oder der Zweck nicht klar?

mir war es schon klar .. aber anderen wohl nicht .. ich wollte halt nur nochmal draufhinweisen