da diese nun alle Flags vom StringGadget unterstützt und ein PopUp Menu hat, welches jeder erweitern und weitergeben mag,
habe ich einen neuen Thread gemacht.
Hier kann ich noch demnächst weitere kleine Erweiterungen posten. In Arbeit ist mehrfarbig und Protected Text.
hier Version 2.51 incl kleinem Test, der natürlich bei Verwendung des Moduls gelöscht werden kann
Sollten noch Fehler gefunden werden, oder wünsche bitte posten. (die gibts immer)
Code: Alles auswählen
;HJBremer
;InputGadget 2.51 - 14.Apr.2023 - ab PB 5.70 x86, 5.72 x64, 6.xx Windows 10 - basiert auf dem EditorGadget
;Flags wie : #PB_String_Numeric (8192), #PB_String_Password (32), #PB_String_ReadOnly (2048)
;StringGadget: #PB_String_LowerCase (16), #PB_String_UpperCase (8), #PB_String_BorderLess ($20000)
;Flags neu: #PB_Text_Center (1), #PB_Text_Right (2) (wenn #PB_Text_Right springt Text nach links)
;
;Eventtypes: #PB_EventType_Change, #PB_EventType_Focus, #PB_EventType_LostFocus
;
;Eventtype neu: #PB_EventType_ReturnKey, wenn Return gedrückt wurde
; #PB_EventType_RightClick, für rechte Maustaste
;da Editorgadget, funktioniert Drag/Drop automatisch
;F1 ruft Liste der Ctrl Codes auf (https://learn.microsoft.com ...)
;gibt es AddKeyboardShortcut(#mainwindow, #PB_Shortcut_Return, #xxx), funktioniert Return nicht
;Numeric: in #WM_KILLFOCUS: Komma wird Punkt + Formatierung -> StrD(ValD(text$), \decimals)
; in #WM_CHAR ab Case 44 wird manipuliert
;mit PopUpMenu, MenuItemNummern ab $DD00, falls im Main benutzt ev. ändern.
; wer ein eigenes PopUp will, muß DisplayPopUpMenu im Callback bei #WM_RBUTTONDOWN entfernen.
DeclareModule InputGadget
Declare.i InputGadget(pbnr, x, y, w, h, text$, flag=0, decimals=0) ;wie StringGadget + decimals wenn Numeric
Declare.i SetInputSelect(pbnr, flag=#PB_All) ;flag: 0=links, #PB_All, #PB_Text_Right = Vorgabe
#PB_EventType_ReturnKey = 1281 ;ab 5.72 nicht mehr in PB vorhanden
EndDeclareModule
Module InputGadget
EnableExplicit
#inputgadgetproptext = "#inputgadgetproptext" ;PropString um auf Gadgetdaten zuzugreifen
#mscc = "https://learn.microsoft.com/en-us/windows/win32/controls/about-rich-edit-controls#rich-edit-shortcut-keys"
Global selected = #PB_Text_Right ;Vorgabe Caret
Global backcolor = $aFFFFF ;BackColor wenn Focus
Global bordercolor = $EEB200 ;Rahmenfarbe hellblau
Global bordernormal = #Gray ;Rahmenfarbe Standard
Global verticalposi = 0 ;Future
Structure InputGadget
id.i ;GadgetId()
pbnr.i ;Purebasic Nr
flags.i ;
oldwndprc.i ;zeiger auf OriginalCallback
backcolor.i ;BackColor wenn Focus
numeric.i ;Zahlen Komma Punkt Minus
decimals.i ;Anzahl Dezimalstellen
selected.i ;wenn Focus, alles markiert oder Caret links oder rechts
lowerCase.i
upperCase.i
EndStructure
Enumeration $DD00 ;MenuItemNummern
#popupClear: #popupUndo: #popupCopy: #popupPaste: ;usw.
EndEnumeration
Global popupMenu, *popupData.InputGadget ;für PopupMenuHandler()
popupMenu = CreatePopupMenu(#PB_Any)
MenuItem(#popupClear, "Löschen")
MenuItem(#popupCopy, "Kopieren" + #TAB$ + "Strg C")
MenuItem(#popupPaste, "Einfügen" + #TAB$ + "Strg V")
MenuItem(#popupUndo, "Undo" + #TAB$ + "Strg Z")
Procedure.i PopupMenuCB()
Protected wp, lp
If *popupData ; *popupData ist global, kommt vom Callback
SendMessage_(*popupData\id, #EM_GETSEL, @wp, @lp)
Select EventMenu()
Case #popupClear:
If wp = lp ;keine Selection dann alles select
SendMessage_(*popupData\id, #EM_SETSEL, 0, $FFFF)
EndIf
SendMessage_(*popupData\id, #WM_CLEAR, 0, 0)
Case #popupCopy:
If wp = lp ;keine Selection dann ist einfacher mit PB
SetClipboardText(GetGadgetText(*popupData\pbnr))
Else
SendMessage_(*popupData\id, #WM_COPY, 0, 0)
EndIf
Case #popupPaste: SendMessage_(*popupData\id, #WM_PASTE, 0, 0)
Case #popupUndo: SendMessage_(*popupData\id, #EM_UNDO, 0, 0)
EndSelect
EndIf
*popupData = 0
EndProcedure
BindEvent(#PB_Event_Menu, @PopupMenuCB())
;-
Procedure.i SetInputSelect(pbnr, flag=#PB_All)
;flag: 0 oder #PB_All, #PB_Text_Right
If pbnr = #PB_Any
selected = flag ;Vorgabe ändern sonst nur für angegebenes Gadget
Else
Protected *data.InputGadget = GetProp_(GadgetID(pbnr), #inputgadgetproptext)
If *data
*data\selected = flag
EndIf
EndIf
EndProcedure
;-
Macro Gadget_Find(hwnd)
hwnd = FindWindowEx_(parent, hwnd, 0,0)
pbnr = GetDlgCtrlID_(hwnd)
If IsGadget(pbnr)
If GadgetType(pbnr) = #PB_GadgetType_Editor
SetActiveGadget(pbnr): Break
EndIf
EndIf
EndMacro
Procedure.i InputGadget_Next(hwnd)
;sucht das nächste Editor-InputGadget
Protected pbnr, parent = GetParent_(hwnd)
Repeat
Gadget_Find(hwnd)
If hwnd = 0: Gadget_Find(hwnd): EndIf
Until hwnd = 0
EndProcedure
Procedure.i InputGadget_Align(pbnr, flag)
Protected pfmt.PARAFORMAT
pfmt\cbSize = SizeOf(PARAFORMAT)
pfmt\dwMask = #PFM_ALIGNMENT
pfmt\wAlignment = flag ;#PFA_LEFT oder #PFA_RIGHT
SendMessage_(GadgetID(pbnr), #EM_SETPARAFORMAT, 0, pfmt)
EndProcedure
Procedure.i InputGadget_Border(hwnd, color)
;Rahmen andere Farbe (in Windows 10)
Protected rc.RECT, hdc = GetWindowDC_(hwnd)
Protected hbrush = CreateSolidBrush_(color)
Protected oldbrush = SelectObject_(hdc, hbrush)
GetWindowRect_(hWnd, rc): OffsetRect_(rc, -rc\left, -rc\top) ;Gadgetgröße
FrameRect_(hdc, rc, hbrush)
SelectObject_(hdc, oldbrush): DeleteObject_(hbrush): ReleaseDC_(hwnd, hdc)
EndProcedure
Procedure.i InputGadget_Vertical(hwnd, font, y=0)
Protected dc = GetDC_(hwnd), s.Size, r.Rect
SelectObject_(dc, font)
GetTextExtentPoint32_(dc,"ABC", 3, s)
ReleaseDC_(hwnd, dc)
GetClientRect_(hwnd, r)
SendMessage_(hwnd, #EM_GETRECT, 0, r)
r\top = ((r\bottom - s\cy + y) / 2)
SendMessage_(hwnd,#EM_SETRECT, 0, r)
EndProcedure
Procedure.i InputGadget_CallBack(hwnd, msg, wparam, lparam)
Protected *data.InputGadget = GetProp_(hwnd, #inputgadgetproptext)
Protected text$, oldwndproc = *data\oldwndprc ; muß sein wegen FreeStructure
With *data
Select msg
Case #WM_NOTIFY
Debug "#WM_NOTIFY"
Case #WM_HELP: RunProgram(#mscc): ProcedureReturn 0
Case #WM_NCDESTROY: RemoveProp_(hwnd, #inputgadgetproptext): FreeStructure(*data)
;-#WM_SETFONT
Case #WM_SETFONT: InputGadget_Vertical(hwnd, wparam)
;-#WM_SETFOCUS, KILLFOCUS
Case #WM_SETFOCUS
\backcolor = GetGadgetColor(\pbnr, #PB_Gadget_BackColor)
SetGadgetColor(\pbnr, #PB_Gadget_BackColor, backcolor)
InputGadget_Border(hwnd, bordercolor) ;Rahmen andere Farbe
Select \selected
Case 0: SendMessage_(\id, #EM_SETSEL, 0, 0) ;Caret am Anfang
Case #PB_All: SendMessage_(\id, #EM_SETSEL, 0, $FFFF) ;Text markieren
Case #PB_Text_Right: SendMessage_(\id, #EM_SETSEL, $FFFF, $FFFF) ;Caret am Textende
EndSelect
If \flags & #PB_Text_Right
InputGadget_Align(\pbnr, #PFA_LEFT)
EndIf
Case #WM_KILLFOCUS
SetGadgetColor(\pbnr, #PB_Gadget_BackColor, \backcolor)
InputGadget_Border(hwnd, bordernormal)
text$ = GetGadgetText(\pbnr)
If \numeric
ReplaceString(text$, "," , "." , #PB_String_InPlace) ;Komma wird Punkt
SetGadgetText(\pbnr, StrD(ValD(text$), \decimals)) ;falls Insert via Paste/Drop
EndIf
If \flags & #PB_Text_Right
InputGadget_Align(\pbnr, #PFA_RIGHT)
EndIf
If \lowerCase: CharLower_(text$): SetGadgetText(\pbnr, text$): EndIf
If \upperCase: CharUpper_(text$): SetGadgetText(\pbnr, text$): EndIf
;-#WM_RBUTTONDOWN, #WM_KEYDOWN, #WM_CHAR
Case #WM_RBUTTONDOWN
*popupData = *data
DisplayPopupMenu(popupMenu, WindowID(EventWindow()))
PostEvent(#PB_Event_Gadget, EventWindow(), \pbnr, #PB_EventType_RightClick)
Case #WM_KEYDOWN
If wparam = 13 ;Return muß hier abgefangen werden, sonst neue Zeile
wparam = 0 : InputGadget_Next(hwnd)
PostEvent(#PB_Event_Gadget, EventWindow(), \pbnr, #PB_EventType_ReturnKey)
EndIf
Case #WM_CHAR: ;Debug wparam
Select wparam
Case 8 ;tue nix
Case 9 ;TAB = 9 muß hier abgefangen werden, weil Editorgadget
wparam = 0 : SetFocus_(GetWindow_(hWnd, #GW_HWNDNEXT))
Case 44 ;Komma wird Punkt (44 wird 46)
If \numeric
wparam = 46
If CountString(GetGadgetText(\pbnr), ".")
wparam = 0 ;wenn Punkt schon da, dann nix Punkt
EndIf
EndIf
Case 45, 46, 48 To 57: ;Minus, Punkt + Zahlen = tue nix
Default
If \lowerCase: wparam = CharLower_(wparam): EndIf
If \upperCase: wparam = CharUpper_(wparam): EndIf
If \numeric: wparam = 0: EndIf
EndSelect
;Default
EndSelect
EndWith
ProcedureReturn CallWindowProc_(oldwndproc, hwnd, msg, wparam, lparam)
EndProcedure
;-
Procedure.i InputGadget(pbnr, x, y, w, h, text$, flags=0, decimals=0)
Protected id, nr, noborder, *data.InputGadget = AllocateStructure(InputGadget)
If flags & #PB_String_Numeric ;wenn dieses Flag, wird Rahmen nicht übermalt bei Start
flags - #PB_String_Numeric: *data\numeric = #True: *data\decimals = decimals
EndIf
If flags & #PB_String_LowerCase ;wenn dieses Flag, dann wer weiß es
flags - #PB_String_LowerCase: *data\lowerCase = #True
EndIf
If flags & #PB_String_UpperCase ;wenn dieses Flag, funktioniert Drop nicht
flags - #PB_String_UpperCase: *data\upperCase = #True
EndIf
If flags & #PB_String_BorderLess
flags - #PB_String_BorderLess: noborder = #True
EndIf
nr = EditorGadget(pbnr, x, y, w, h, flags)
If pbnr = #PB_Any : pbnr = nr: id = GadgetID(nr) : Else : id = nr : EndIf
SetGadgetText(pbnr, text$)
If noborder
SetWindowTheme_(id, @"", @""): SetGadgetColor(pbnr, #PB_Gadget_BackColor, $F0F0F0)
SetWindowPos_(id, 0, 0, 0, 0, 0, #SWP_NOMOVE|#SWP_NOSIZE|#SWP_FRAMECHANGED|#SWP_NOZORDER)
EndIf
*data\id = id
*data\pbnr = pbnr
*data\flags = flags
*data\selected = selected
*data\oldwndprc = SetWindowLongPtr_(id, #GWL_WNDPROC, @InputGadget_CallBack())
SetProp_(id, #inputgadgetproptext, *data)
SendMessage_(id, #EM_SHOWSCROLLBAR, #SB_HORZ, #False) ;Scrollbars weg,
SendMessage_(id, #EM_SHOWSCROLLBAR, #SB_VERT, #False)
SendMessage_(id, #EM_SETMARGINS, #EC_LEFTMARGIN, 5) ;Rand etwa wie StringGadget
SendMessage_(id, #EM_SETMARGINS, #EC_RIGHTMARGIN, 0|4 << 16) ;je nach PB Version ev 1 Pixel
InputGadget_Border(id, bordernormal)
InputGadget_Vertical(id, GetGadgetFont(pbnr))
ProcedureReturn nr
EndProcedure
EndModule
UseModule InputGadget
CompilerIf #PB_Compiler_IsMainFile
Global fontStd = LoadFont(#PB_Any, "Calibri", 12)
Global font10 = LoadFont(#PB_Any, "Calibri", 10)
Global font8 = LoadFont(#PB_Any, "Calibri", 8)
OpenWindow(10, 0, 0, 500, 330, "...Gadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
SetGadgetFont(#PB_Default, FontID(fontStd))
InputGadget(12, 10, 20, 120, 28, "Haus", #PB_String_LowerCase )
InputGadget(14, 10, 50, 100, 28, "0,0", #PB_String_Numeric|#PB_Text_Right, 2)
ButtonGadget(16, 10, 80, 80, 22, "tut nix")
InputGadget(18, 10, 110, 130, 16, "bubu", #PB_Text_Center|#PB_String_UpperCase )
StringGadget(20, 10, 140, 100, 24, "stringgadget")
ButtonGadget(22, 10, 170, 180, 24, "free Gadget 14")
InputGadget(24, 10, 200, 130, 30, "Read only", #PB_String_ReadOnly)
pbnr = InputGadget(#PB_Any, 10, 240, 130, 30, "mit pbany", #PB_String_BorderLess)
For j = 1 To 8
InputGadget(j, 210, j*30, 130, 24, Str(j), #PB_String_Numeric|#PB_Text_Right)
SetGadgetColor(j, #PB_Gadget_FrontColor, #Blue)
Next
StringGadget(10, 210, j*30, 130, 24, "stringgadget 8", #PB_String_Numeric|#PB_Text_Right)
SetGadgetColor(12, #PB_Gadget_FrontColor, #Red)
SetGadgetColor(14, #PB_Gadget_BackColor, #Yellow)
SetGadgetFont(14, FontID(font10))
SetGadgetFont(18, FontID(font8))
SetGadgetColor(pbnr, #PB_Gadget_FrontColor, #Red)
popupMenu = CreatePopupMenu(#PB_Any)
MenuItem(1, "Löschen")
MenuItem(2, "Einfügen")
MenuItem(3, "Kopieren")
MenuItem(4, "Undo")
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case 12 :
Select EventType()
Case #PB_EventType_Focus: Debug "#PB_EventType_Focus"
Case #PB_EventType_Change: Debug "#PB_EventType_Change"
Case #PB_EventType_LostFocus: Debug "#PB_EventType_LostFocus"
Case #PB_EventType_ReturnKey: Debug "#PB_EventType_ReturnKey"
Case #PB_EventType_RightClick: Debug "#PB_EventType_RightClick"
EndSelect
Case 8
If EventType() = #PB_EventType_ReturnKey
;springt zum angegebenen Gadget, und überschreibt damit internen Jump !!!
;SetGadgetText(8, "goto 1")
;SetActiveGadget(1)
EndIf
Case 22: If IsGadget(14): FreeGadget(14): EndIf
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow
CompilerEndIf