Ich habe hier mal ein Stringgadget in ein Interface gepackt incl. subclassing und ein paar andere Gimnicks.
Denn mit einem Interface und seinen Funktionen kann man einfach und bequem immer die gleichen Routinen mehrmals verwenden und doch ist das Ganze in sich gekapselt.
Manche nennen das auch OOP
Das Interface läßt sich einfach erweitern. z.B. eine Format Funktion oder was weiß ich
Die beiden Demos sind wie der Name sagt Demos und sollen nur zeigen wie man das Interface anwenden kann.
zuerst die Include Datei mit dem Interface, Abspeichern z.B. als Interface_Strg01a.pbi
Code: Alles auswählen
;die Reihenfolge im Interface
;und der zugehörigen DataSection muß gleich sein !!!
Interface IcStringGadget
Release()
PBnr()
IDnr()
Dezimal(a=0)
MaxChar(a)
Helptext(a.s)
SelectAll()
;interne Funktion
SubClassPrc(a,b,c,d)
;folgende Funktionen können auch wegfallen und durch PB Befehle ersetzt werden
getText.s()
setFont(a)
setFocus()
setFrontColor(a)
setBackColor(a)
EndInterface
Structure cStringGadget
*VTable_cStringGadget
pbnr.i
idnr.i
oldproc.i ;Adresse für subclassing
dezimal.i ;Zahlenfeld mit Anzahl Dezimalstellen, darf null sein
nurzahlen.i ;wird von dezimal gesetzt
maxchar.i ;soviele Zeichen eingeben
txt.s ;Gadgetinhalt
txtlg.i ;dessen Länge
infodezimal1.s ;infos im Callback
infodezimal2.s
infohelptext.s
EndStructure
Procedure.i IcStringGadget_BallonTip(hWnd, text$, icon=1, titel$="Information")
;diese Structure gibt es in 4.30 nicht
;merkwürdigerweise aber #EM_SHOWBALLOONTIP
Structure EDITBALLOONTIP
cbStruct.l
pszTitle.l
pszText.l
ttiIcon.l
EndStructure
Protected ebt.EDITBALLOONTIP , memtext , memtitel
;AnsiToUni
SHStrDup_(@text$,@memtext)
SHStrDup_(@titel$,@memtitel)
ebt\cbStruct = SizeOf(ebt)
ebt\ttiIcon = icon
ebt\pszText = memtext
ebt\pszTitle = memtitel
SendMessage_(hWnd, #EM_SHOWBALLOONTIP, 0, @ebt)
CoTaskMemFree_(ebt\pszText)
CoTaskMemFree_(ebt\pszTitle)
EndProcedure
Procedure.i IcStringGadget_SubClassPrc(hWnd, Msg, wParam, lParam)
;hwnd ist hier gleich der ID vom Gadget
;CallWindowProc_ muß hier am Ende gesetzt werden
;sonst geht nix richtig, weil wParam geändert wird
Protected *this.cStringGadget = GetWindowLong_(hWnd,#GWL_USERDATA)
Protected curpos, pktpos, anzdez, start, ende
If Msg = #WM_CHAR ;258
If *this\nurzahlen
Select wParam
Case 44: wparam = 46 ;Komma wird Punkt
Case 48 To 57 ;Zahlen erlaubt
Case #VK_BACK ;Backspace erlaubt
Case #VK_ESCAPE, #VK_RETURN
Default: wparam = 0 ;alles andere unterbinden
IcStringGadget_BallonTip(hWnd, "erlaubt sind nur Zahlen")
EndSelect
;keine Dezimalstellen, kein Punkt
If *this\dezimal = 0
If wparam = 46
wparam = 0
IcStringGadget_BallonTip(hWnd, *this\infodezimal1, 1)
EndIf
EndIf
;2 Punkte eingeben = nein
If wparam = 46
If CountString(GetGadgetText(*this\pbnr), ".")
wparam = 0
IcStringGadget_BallonTip(hWnd, *this\infodezimal2, 2)
EndIf
EndIf
;Anzahl Dezimalstellen checken
If *this\dezimal ;Dezimalstellen definiert ?
*this\txt = GetGadgetText(*this\pbnr)
*this\txtlg = SendMessage_(hwnd, #EM_LINELENGTH, 0, 0)
If CountString(*this\txt, ".") ;gibt es einen Punkt ?
SendMessage_(hwnd,#EM_GETSEL,@curpos,0) ;wo ist der Cursor ?
pktpos = FindString(*this\txt, ".", 1) ;wo ist der Punkt ?
anzdez = *this\txtlg - pktpos ;len - pktpos = Dezimalstellen
If anzdez >= *this\dezimal ;wenn Anzahl Dezimalstellen erreicht
If curpos >= pktpos ;wenn Cursor hinterm punkt
If wparam <> #VK_BACK ;wenn nicht Backspace
wparam = 0 ;dann Eingabe = 0
IcStringGadget_BallonTip(hWnd, *this\infodezimal1, 3)
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf ;von IF *this\nurzahlen
;max Länge kontrollieren, wenn definiert
If *this\maxchar
*this\txtlg = SendMessage_(hwnd, #EM_LINELENGTH, 0, 0)
If *this\txtlg = *this\maxchar
Select wparam
Case #VK_BACK, #VK_ESCAPE , #VK_RETURN
Default: If *this\dezimal
IcStringGadget_BallonTip(hWnd, "max Länge erreicht, Anzahl Dezimalstellen ok ?", 3)
Else
IcStringGadget_BallonTip(hWnd, "max Länge erreicht", 3)
EndIf
EndSelect
EndIf
EndIf
ElseIf Msg = #WM_KEYDOWN ;256
Select wparam
Case 38: ;"Pfeil oben"
;Simuliert Shift+Tab Taste
keybd_event_(#VK_SHIFT, 0,0,0)
keybd_event_(#VK_TAB,0,0,0)
keybd_event_(#VK_TAB,0,#KEYEVENTF_KEYUP,0)
keybd_event_(#VK_SHIFT,0,#KEYEVENTF_KEYUP,0)
Case 13,40: ;"Return, Pfeil unten"
;Simuliert Tab Taste
;If GetWindow_(hwnd, #GW_HWNDNEXT)
keybd_event_(#VK_TAB,0,0,0)
keybd_event_(#VK_TAB,0,#KEYEVENTF_KEYUP,0)
;EndIf
EndSelect
ElseIf msg = #WM_HELP ;83
IcStringGadget_BallonTip(hWnd, *this\infohelptext, 1, "Hilfe")
ElseIf msg = #WM_PASTE
If *this\maxchar
SendMessage_(hwnd,#EM_GETSEL,@start,@ende)
*this\txtlg = SendMessage_(hwnd, #EM_LINELENGTH, 0, 0) - (ende-start)
If *this\txtlg + Len(GetClipboardText()) > *this\maxchar
IcStringGadget_BallonTip(hWnd, "eingefügter Text zu lang", 3)
EndIf
EndIf
EndIf
ProcedureReturn CallWindowProc_(*this\oldproc, hWnd, Msg, wParam, lParam)
EndProcedure
Procedure.i IcStringGadget(pbnr, x, y, br, hh, text$="", flag=0)
Protected *this.cStringGadget = AllocateMemory(SizeOf(cStringGadget))
If Not *this: ProcedureReturn #Null: EndIf
*this\VTable_cStringGadget = ?VTable_cStringGadget
*this\dezimal = 0
*this\maxchar = 0
*this\nurzahlen = 0
*this\infohelptext = "keine Hilfe vorhanden"
flag | #WS_BORDER
If pbnr = #PB_Any
*this\pbnr = StringGadget(#PB_Any, x, y, br, hh, text$, flag)
*this\idnr = GadgetID(*this\pbnr)
Else
*this\pbnr = pbnr
*this\idnr = StringGadget(pbnr, x, y, br, hh, text$, flag)
EndIf
*this\oldproc = SetWindowLong_(*this\idnr, #GWL_WNDPROC, @IcStringGadget_SubClassPrc())
SetWindowLong_(*this\idnr, #GWL_USERDATA, *this)
ProcedureReturn *this
EndProcedure
Procedure.i IcStringGadget_PBnr(*this.cStringGadget)
ProcedureReturn *this\pbnr
EndProcedure
Procedure.i IcStringGadget_IDnr(*this.cStringGadget)
ProcedureReturn *this\idnr
EndProcedure
Procedure.i IcStringGadget_Dezimal(*this.cStringGadget, anz=0)
*this\dezimal = anz
*this\nurzahlen = #True
Select *this\dezimal
Case 0: *this\infodezimal1 = "Sie haben keine Dezimalstelle definiert"
Case 1: *this\infodezimal1 = "Sie haben nur 1 Dezimalstelle definiert"
*this\infodezimal2 = "Sie haben schon einen Dezimalpunkt eingegeben"
Default:*this\infodezimal1 = "Es sind " + Str(*this\dezimal) + " Dezimalstellen erlaubt"
*this\infodezimal2 = "Sie haben schon einen Dezimalpunkt eingegeben"
EndSelect
EndProcedure
Procedure.i IcStringGadget_MaxChar(*this.cStringGadget, anz)
If anz < 1: anz = 1: EndIf
SendMessage_(*this\idnr, #EM_LIMITTEXT, anz, 0)
*this\maxchar = anz
EndProcedure
Procedure.i IcStringGadget_Release(*this.cStringGadget)
FreeMemory ( *this )
ProcedureReturn #Null
EndProcedure
Procedure.i IcStringGadget_SelectAll(*this.cStringGadget)
SendMessage_(*this\idnr,#EM_SETSEL,0,-1)
EndProcedure
Procedure.i IcStringGadget_Helptext(*this.cStringGadget,txt.s)
*this\infohelptext = txt
EndProcedure
Procedure.s IcStringGadget_getText(*this.cStringGadget)
*this\txt = GetGadgetText(*this\pbnr)
ProcedureReturn *this\txt
EndProcedure
Procedure.i IcStringGadget_setFont(*this.cStringGadget,nr)
SetGadgetFont(*this\pbnr,FontID(nr))
EndProcedure
Procedure.i IcStringGadget_setFrontColor(*this.cStringGadget,farbe)
SetGadgetColor(*this\pbnr,#PB_Gadget_FrontColor, farbe)
EndProcedure
Procedure.i IcStringGadget_setBackColor(*this.cStringGadget,farbe)
SetGadgetColor(*this\pbnr,#PB_Gadget_BackColor, farbe)
EndProcedure
Procedure.i IcStringGadget_setFocus(*this.cStringGadget)
SetActiveGadget(*this\pbnr)
EndProcedure
DataSection
VTable_cStringGadget:
Data.i @ IcStringGadget_Release()
Data.i @ IcStringGadget_PBnr()
Data.i @ IcStringGadget_IDnr()
Data.i @ IcStringGadget_Dezimal()
Data.i @ IcStringGadget_MaxChar()
Data.i @ IcStringGadget_Helptext()
Data.i @ IcStringGadget_SelectAll()
Data.i @ IcStringGadget_SubClassPrc()
Data.i @ IcStringGadget_getText()
Data.i @ IcStringGadget_setFont()
Data.i @ IcStringGadget_setFocus()
Data.i @ IcStringGadget_setFrontColor()
Data.i @ IcStringGadget_setBackColor()
EndDataSection
;Flags beim Aufruf
;alle #PB_String_ ???
;#PB_Text_Right, #PB_Text_Center
;#WS_BORDER, #WS_THICKFRAME
Code: Alles auswählen
;ein simples Beispiel fürs Stringgadget-Interface mit #PB_Any
XIncludeFile "\Bremer\BeispieleXX\Interface\Interface_Strg01a.pbi"
fonthh = 12
font1 = LoadFont(#PB_Any, "Courier New", fonthh)
buthh = 25 ;oder buthh = fonthh * (1 + (1 / Log10(fonthh-1)))
Enumeration
#win1
#but1
EndEnumeration
OpenWindow(#win1,140,150,400,300,"Gadget",#PB_Window_SystemMenu);|1)
ButtonGadget(#but1,10,240,120,25,"Eingaben anzeigen")
i1.IcStringGadget
i1=IcStringGadget(#PB_Any,20,50,150,buthh,"33.66",#PB_Text_Right)
i1\Dezimal(2)
i1\MaxChar(9)
i1\setFont(font1)
i1\setFrontColor(#Red)
i1\setFocus()
i1\SelectAll()
i1\Helptext("max 9 Char, nur Zahlen, 2 Dezimalstellen")
;=====================================================
Repeat: event = WaitWindowEvent()
If Event = #PB_Event_Gadget Or Event = #PB_Event_Menu
welcherButton = EventGadget()
eventtype = EventType()
Select welcherButton
Case i1\PBnr(): If eventtype = #PB_EventType_Focus
Debug "Gadget 1 hat den Focus"
EndIf
Case #but1: Debug i1\getText()
EndSelect
EndIf
Until event = #PB_Event_CloseWindow
i1\Release() ;nur der Ordnung wegen
End
Code: Alles auswählen
;ein simples Demo-Beispiel fürs Stringgadget-Interface mit Eingabefenster
XIncludeFile "\Bremer\BeispieleXX\Interface\Interface_Strg01a.pbi"
Enumeration
#main_window
#sub_window
#but_subsave
#but_subende
#but1
#but2
EndEnumeration
Structure myprgvar
lastInputmax.i
lastInputWindow.i
;usw.
EndStructure
Global prgv.myprgvar
Global Dim ic.IcStringGadget(0)
Procedure SubWindowOpen(titel$)
DisableWindow(#main_window,1)
x = 50 + WindowX(#main_window)
y = 30 + WindowY(#main_window)
z = 450
buttonbr = 95: buttonhh = 22
OpenWindow(#sub_window, x, y, z, z, titel$, 0, WindowID(#main_window))
AddKeyboardShortcut(#sub_window, #PB_Shortcut_Escape, #but_subende)
x1 = 11 :x2 = z - buttonbr - 11: y = z - buttonhh - 11
ButtonGadget(#but_subsave, x1, y, buttonbr, buttonhh, "Save")
ButtonGadget(#but_subende, x2, y, buttonbr, buttonhh, "Close")
ProcedureReturn z
EndProcedure
Procedure SubWindowClose()
CloseWindow(#sub_window): DisableWindow(#main_window,0)
EndProcedure
Procedure InputWindow1()
max = 2
prgv\lastInputmax = max
prgv\lastInputWindow = 1
SubWindowOpen("Test")
ReDim ic.IcStringGadget(max)
x = 20 : y = 40: br = 150: hh = 22
ic(0) = IcStringGadget(#PB_Any,x,y,br,hh,"1",#PB_Text_Right)
ic(0) \ MaxChar(9)
ic(0) \ setFrontColor(#Red)
ic(0) \ Helptext("max 9 Zeichen wird erwartet")
ic(0) \ setFocus()
y + hh + 10
ic(1) = IcStringGadget(#PB_Any,x,y,br,hh,"2")
ic(1) \ MaxChar(7)
ic(1) \ setFrontColor(#Blue)
ic(1) \ Helptext("max 7 Zeichen wird erwartet")
y + hh + 10
ic(2) = IcStringGadget(#PB_Any,x,y,br,hh,"3",#PB_Text_Right)
ic(2) \ MaxChar(7)
ic(2) \ Dezimal(2)
ic(2) \ setFrontColor(#Blue)
ic(2) \ SelectAll()
ic(2) \ Helptext("max 7 stellige Zahl wird erwartet, incl. 2 Dezimalstellen")
EndProcedure
Procedure InputWindow2()
max = 3
prgv\lastInputmax = max
prgv\lastInputWindow = 2
SubWindowOpen("Test 2")
ReDim ic.IcStringGadget(max)
x = 20 : y = 40: br = 150: hh = 22
ic(0) = IcStringGadget(#PB_Any,x,y,br,hh,"Hallo")
ic(0) \ MaxChar(5)
ic(0) \ Helptext("nur 5 Zeichen Platz")
ic(0) \ setFocus()
y + hh + 10
ic(1) = IcStringGadget(#PB_Any,x,y,br,hh,"irgendein Text",#PB_Text_Center)
ic(1) \ setFrontColor(#Blue)
ic(1) \ SelectAll()
ic(1) \ Helptext("geben Sie ein was Sie wollen")
y + hh + 10
ic(2) = IcStringGadget(#PB_Any,x,y,br,hh,"2",#PB_Text_Right)
ic(2) \ MaxChar(6)
ic(2) \ Dezimal(2)
ic(2) \ Helptext("max 6 stellige Zahl wird erwartet, incl. 2 Dezimalstellen")
y + hh + 10
ic(3) = IcStringGadget(#PB_Any,x,y,br,hh,"20.33")
ic(3) \ MaxChar(6)
ic(3) \ Dezimal(2)
ic(3) \ SelectAll()
ic(3) \ Helptext("max 6 stellige Zahl wird erwartet, incl. 2 Dezimalstellen")
EndProcedure
Procedure InputWindowSave()
Select prgv\lastInputWindow
Case 1: dat$ = "Fenster1.dat"
For j = 0 To prgv\lastInputmax: Debug ic(j)\getText(): Next
Case 2: dat$ = "Fenster2.dat"
For j = 0 To prgv\lastInputmax: Debug ic(j)\getText(): Next
;usw
EndSelect
EndProcedure
OpenWindow(#main_window,140,150,600,500,"Gadget",#PB_Window_SystemMenu);|1)
ButtonGadget(#but1,10,40,150,25,"Eingabemaske 1 aufrufen")
ButtonGadget(#but2,10,90,150,25,"Eingabemaske 2 aufrufen")
;=====================================================
Repeat
event = WaitWindowEvent()
If Event = #PB_Event_Gadget Or Event = #PB_Event_Menu
Select EventGadget()
Case #but1: InputWindow1()
Case #but2: InputWindow2()
Case #but_subsave: InputWindowSave()
Case #but_subende: SubWindowClose()
EndSelect
EndIf
Until event = #PB_Event_CloseWindow
End