EditorGadget Protected Text + farbig

[hjbremer]

Das Beispiel ist so wie es ist im Grunde zu nix nutze.

Es soll nur zeigen wie Protected Text funktioniert.
Denn das heraus zu finden gehört mal wieder nicht zu den Sternstunden der MSDN Api Beschreibung

Der große Nachteil ist für mich das es einen MainCallback geben muß !!!

Farben und Zoom sind etwas Spielkram um Text zu verschönern

Code: Alles auswählen

Procedure SetInputColor(pbnr, p1, p2, color)
   ;es muß an p1 mindestens ein Zeichen vorhanden sein
   ;Protected Text kann nicht geändert werden
   
   Protected pbid = GadgetID(pbnr)
   Protected charformat.charformat2\cbSize = SizeOf(charformat2)
   
   charformat\dwMask      = #CFM_COLOR
   charformat\crTextColor = color             
   SendMessage_(pbid, #EM_SETSEL, p1, p2)   
   SendMessage_(pbid, #EM_SETCHARFORMAT, #SCF_SELECTION, charformat)
   SendMessage_(pbid, #EM_SETSEL, p2, p2)
   
EndProcedure

Procedure SetInputText(pbnr, p$, t$="", cp=0, ct=0)
   ;p$ wird protected, t$ ist normaler Text der verändert werden kann
   ;cp + ct sind Farbwerte welche vor Protected gesetzt werden müssen
   
   SetGadgetText(pbnr, p$ + " " + t$)
   SetInputColor(pbnr, 0, Len(p$), cp)
   SetInputColor(pbnr, Len(p$), 1000, ct)   
   
   Protected pbid = GadgetID(pbnr)
   Protected charformat.charformat2\cbSize = SizeOf(charformat2)   
   Protected eventmask = SendMessage_(pbid, #EM_GETEVENTMASK, 0, 0)
   
   SendMessage_(pbid, #EM_SETEVENTMASK, 0, eventmask|#ENM_PROTECTED)
   
   charformat\dwMask    = #CFM_PROTECTED
   charformat\dwEffects = #CFE_PROTECTED             
   SendMessage_(pbid, #EM_SETSEL, 0, Len(p$)+1)   
   SendMessage_(pbid, #EM_SETCHARFORMAT, #SCF_SELECTION, charformat)
   SendMessage_(pbid, #EM_SETSEL, $FFFF, $FFFF) ;Caret ans Ende
   
EndProcedure

Procedure MainCallback(hWnd, Msg, wParam, lParam)
   Protected result = #PB_ProcessPureBasicEvents
   Protected *nmhdr.nmhdr
   
   Select Msg
      Case #WM_NOTIFY 
         *nmhdr.nmhdr = lParam
         If *nmhdr\code = #EN_PROTECTED
            Debug "#EN_PROTECTED"
            ProcedureReturn #True
         EndIf
   EndSelect
   
   ProcedureReturn result
EndProcedure


pbnr = 12

OpenWindow(0,0,0,500,400,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)

SetWindowCallback(@MainCallback())

EditorGadget(pbnr,10,10,200,150 )   

SetInputText(pbnr, "Bananen 1 kg:", "9.23", #Blue, #Red)   
   

;noch etwas Spielkram
; SendMessage_(GadgetID(pbnr), #EM_SETSEL, 14, $FFFF)   
; SendMessage_(GadgetID(pbnr), #EM_SETFONTSIZE, 4, 0)
; SendMessage_(GadgetID(pbnr), #EM_SETSEL, $FFFF, $FFFF)   

Repeat
   Event = WaitWindowEvent()   
Until Event = #PB_Event_CloseWindow

[Axolotl]

Hey hjbremer,
danke für das Beispiel...

Der große Nachteil ist für mich das es einen MainCallback geben muß !!!

unter windows gibt es noch die subclassing Möglichkeit.
Hier mal ein Template um die verschiedenen Möglichkeiten (Bearbeitungsreihenfolge) am Beispiel "Size Window" zu zeigen:
1. Subclass
2. Callback
3. BindEvent

Code: Alles auswählen

EnableExplicit 

Enumeration EWindow 
	#WINDOW_Main 
EndEnumeration 
Enumeration EGadget 
	#GADGET_Info 
	#GADGET_Output 
EndEnumeration 


Macro Output(Message) 
	If IsGadget(#GADGET_Output) 
		AddGadgetItem(#GADGET_Output, -1, Message) 

		SetGadgetState(#GADGET_Output, CountGadgetItems(#GADGET_Output)-1)
	EndIf 
	;Debug Message 
EndMacro 


Procedure ApplicationWindowSubclass(hWnd, uMsg, wParam, lParam)  ; standard windows interface for message events  
  Static s_hOrigWndProc = 0 
  Protected hWndProc 

  hWndProc = s_hOrigWndProc  ; set the original window proc pointer for CallWindowProc_() 

  Select uMsg 
    Case -1 
      Output("subclass:  INTERNAL: init ") 
      If s_hOrigWndProc <> 0   ; original proc is still in use 
        SetWindowLongPtr_(hWnd, #GWLP_WNDPROC, s_hOrigWndProc)  ; set it back  
      EndIf 

      If wParam = ('I' << 24) | ('N' << 16) | ('I' << 8) | 'T' 	; wParam = 'INIT' .. make sure its from me 
        hWndProc = GetWindowLongPtr_(hWnd, #GWLP_WNDPROC) 			; get the window procedure address 
        s_hOrigWndProc = hWndProc 															; and keep them in a static variable for further use 
        SetWindowLongPtr_(hWnd, #GWLP_WNDPROC, @ApplicationWindowSubclass()) 
        ProcedureReturn 0  ; system can give up on this message 
      EndIf 

    Case #WM_NCDESTROY 
    	Output("subclass: WM_NCDESTROY ") 
      SetWindowLongPtr_(hWnd, #GWLP_WNDPROC, hWndProc)  ; set original procedure back 
      s_hOrigWndProc = 0                                ; reset static variable 

    Case #WM_SIZE 
    	Output("subclass: Window was resized " + lParam) 

  EndSelect ; uMsg 

  ProcedureReturn CallWindowProc_(hWndProc, hWnd, uMsg, wParam, lParam)  ; use stored window procedure address 
EndProcedure 


Procedure.i SetApplicationWindow(Window)  ; HANDLE ~  // returns hwnd Or zero  
  Protected hWnd, hMenu, hSubMenu, txt$ 

  If IsWindow(Window) 
    hWnd = WindowID(Window) 
    ApplicationWindowSubclass(hWnd, -1, ('I' << 24) | ('N' << 16) | ('I' << 8) | 'T', 0)  ; wParam = 'INIT' 
  Else 
    Debug "ERROR: wrong Window == 0x" + Hex(Window) + " (" + Window + ")"  
  EndIf 
  ProcedureReturn hWnd 
EndProcedure 


Procedure OnEvent_SizeWindow() 
  Protected wndw, wndh 

	Output("onevent : window was sized ") 

  wndw = WindowWidth(#WINDOW_Main) : wndh = WindowHeight(#WINDOW_Main) 
  ResizeGadget(#GADGET_Output, #PB_Ignore, #PB_Ignore, wndw - 8, wndh - 36) 
EndProcedure 


Procedure WindowCallBack(hWnd, uMsg, wParam, lParam) 	; 
  Protected result = #PB_ProcessPureBasicEvents 
  Select uMsg 
    Case #WM_SIZE 
    	Output("callback: Window was resized " + lParam) 
  EndSelect 
  ProcedureReturn result
EndProcedure 


; --- main window and loop --- 

Procedure CreateMainWindow(WndW = 480, WndH = 240)  
  If OpenWindow(#WINDOW_Main, 0, 0, WndW, WndH, "Tester...", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget) 
    TextGadget(#GADGET_Info, 4, 4, 472, 20, "Size the Window ... ") 
    ListViewGadget(#GADGET_Output, 4, 32, WndW - 8, WndH - 36, $4000)  ; #LBS_NoSEL 

    BindEvent(#PB_Event_SizeWindow, @OnEvent_SizeWindow(), #WINDOW_Main) 
    SetWindowCallback(@WindowCallBack(), #WINDOW_Main) 
    SetApplicationWindow(#WINDOW_Main) 
    
    ProcedureReturn 1 
  EndIf 
  ProcedureReturn 0  
EndProcedure 

Procedure main() 
  Protected state 

  If CreateMainWindow() 
    Repeat  ; main loop 
      Select WaitWindowEvent()  
        Case #PB_Event_CloseWindow 
          If EventWindow() = #WINDOW_Main : Break : EndIf  ; close button on main window --> close application 

        Case #PB_Event_SizeWindow 
          Output("mainloop: Size Window") 
      EndSelect
    ForEver ; main loop 
  EndIf ; OpenWindow 
EndProcedure 

End main() 

[hjbremer]

wie geschrieben es muß einen MainCallback geben, denn die Meldung wird nur an ein übergeordnetes Fenster gesendet.

Nur das EditorGadget subclassen reicht nicht.

[Axolotl]

ich habe das schon verstanden.... habe ich auch nicht gemacht.

Nachteil von PB SetWindowCallback() ist, dass es nur einmal benutzt werden kann.
Mein Beispiel verwendet subclassing auf dem Fenster.
Vorteil: Man kann SetWindowCallback() weiterhin verwenden.
Siehe dein angepasstes Beispiel, wie ich das gemein habe.

Code: Alles auswählen

Procedure SetInputColor(pbnr, p1, p2, color)
   ;es muß an p1 mindestens ein Zeichen vorhanden sein
   ;Protected Text kann nicht geändert werden
   
   Protected pbid = GadgetID(pbnr)
   Protected charformat.charformat2\cbSize = SizeOf(charformat2)
   
   charformat\dwMask      = #CFM_COLOR
   charformat\crTextColor = color             
   SendMessage_(pbid, #EM_SETSEL, p1, p2)   
   SendMessage_(pbid, #EM_SETCHARFORMAT, #SCF_SELECTION, charformat)
   SendMessage_(pbid, #EM_SETSEL, p2, p2)
   
EndProcedure

Procedure SetInputText(pbnr, p$, t$="", cp=0, ct=0)
   ;p$ wird protected, t$ ist normaler Text der verändert werden kann
   ;cp + ct sind Farbwerte welche vor Protected gesetzt werden müssen
   
   SetGadgetText(pbnr, p$ + " " + t$)
   SetInputColor(pbnr, 0, Len(p$), cp)
   SetInputColor(pbnr, Len(p$), 1000, ct)   
   
   Protected pbid = GadgetID(pbnr)
   Protected charformat.charformat2\cbSize = SizeOf(charformat2)   
   Protected eventmask = SendMessage_(pbid, #EM_GETEVENTMASK, 0, 0)
   
   SendMessage_(pbid, #EM_SETEVENTMASK, 0, eventmask|#ENM_PROTECTED)
   
   charformat\dwMask    = #CFM_PROTECTED
   charformat\dwEffects = #CFE_PROTECTED             
   SendMessage_(pbid, #EM_SETSEL, 0, Len(p$)+1)   
   SendMessage_(pbid, #EM_SETCHARFORMAT, #SCF_SELECTION, charformat)
   SendMessage_(pbid, #EM_SETSEL, $FFFF, $FFFF) ;Caret ans Ende
   
EndProcedure
; 
; Procedure MainCallback(hWnd, Msg, wParam, lParam)
;    Protected result = #PB_ProcessPureBasicEvents
;    Protected *nmhdr.nmhdr
;    
;    Select Msg
;       Case #WM_NOTIFY 
;          *nmhdr.nmhdr = lParam
;          If *nmhdr\code = #EN_PROTECTED
;             Debug "#EN_PROTECTED"
;             ProcedureReturn #True
;          EndIf
;    EndSelect
;    
;    ProcedureReturn result
; EndProcedure

Procedure EditorGadget_Special_WindowSubclass(hWnd, uMsg, wParam, lParam)  ; standard windows interface for message events  
  Static s_hOrigWndProc = 0 
  Protected hWndProc, *nmhdr.nmhdr 

  hWndProc = s_hOrigWndProc  ; set the original window proc pointer for CallWindowProc_() 

  Select uMsg 
    Case -1 
      If s_hOrigWndProc <> 0   ; original proc is still in use 
        SetWindowLongPtr_(hWnd, #GWLP_WNDPROC, s_hOrigWndProc)  ; set it back  
      EndIf 

      If wParam = ('I' << 24) | ('N' << 16) | ('I' << 8) | 'T' 	; wParam = 'INIT' .. make sure its from me 
        hWndProc = GetWindowLongPtr_(hWnd, #GWLP_WNDPROC) 			; get the window procedure address 
        s_hOrigWndProc = hWndProc 															; and keep them in a static variable for further use 
        SetWindowLongPtr_(hWnd, #GWLP_WNDPROC, @EditorGadget_Special_WindowSubclass()) 
        ProcedureReturn 0  ; system can give up on this message 
      EndIf 

    Case #WM_NCDESTROY 
      SetWindowLongPtr_(hWnd, #GWLP_WNDPROC, hWndProc)  ; set original procedure back 
      s_hOrigWndProc = 0                                ; reset static variable 

    Case #WM_NOTIFY 
       *nmhdr.nmhdr = lParam
       If *nmhdr\code = #EN_PROTECTED
          Debug "#EN_PROTECTED"
          ProcedureReturn #True
       EndIf

  EndSelect ; uMsg 

  ProcedureReturn CallWindowProc_(hWndProc, hWnd, uMsg, wParam, lParam)  ; use stored window procedure address 
EndProcedure 


Procedure EditorGadget_Special(Gadget, X, Y, W, H, Flags=0) 
 	Protected hGadget, hWindow 
 	
  hGadget = EditorGadget(Gadget, X, Y, W, H, Flags) 
  If Gadget = #PB_Any 
  	Gadget = hGadget 
  	hGadget = GadgetID(hGadget) 
  EndIf 
	hWindow = GetAncestor_(hGadget, #GA_ROOT) 
	If hWindow 
		EditorGadget_Special_WindowSubclass(hWindow, -1, ('I' << 24) | ('N' << 16) | ('I' << 8) | 'T', 0)  ; wParam = 'INIT' 
  EndIf 
  ProcedureReturn hGadget   
EndProcedure 




pbnr = 12

OpenWindow(0,0,0,500,400,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)

; SetWindowCallback(@MainCallback()) 

EditorGadget_Special(pbnr,10,10,200,150)   

SetInputText(pbnr, "Bananen 1 kg:", "9.23", #Blue, #Red)   


;noch etwas Spielkram
; SendMessage_(GadgetID(pbnr), #EM_SETSEL, 14, $FFFF)   
; SendMessage_(GadgetID(pbnr), #EM_SETFONTSIZE, 4, 0)
; SendMessage_(GadgetID(pbnr), #EM_SETSEL, $FFFF, $FFFF)   

Repeat
   Event = WaitWindowEvent()   
Until Event = #PB_Event_CloseWindow

[DePe]

Nur als Hinweis, ich habe mich gewundert was eure Beispiele machen, bei mir gibt es keine Debugausgaben.
Das lag an der neuen PB Beta-Version v6.02b1/2. Die Beispiele funktionieren hier nur bis v6.01 unter Windows 7 32-Bit.

Peter

[Axolotl]

Ja, danke für den Hinweis...
Es scheint, das API- Programmierung unter Windows bei PB-Versionsupdates mehr und mehr zum Glückspiel wird....
Ich musste auch gerade feststellen, das liebgewonnene Implementierungen in der neusten Beta nicht mehr tun.