Eingabemaske mit Stringadget als Interface

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
hjbremer
Beiträge: 822
Registriert: 27.02.2006 22:30
Computerausstattung: von gestern
Wohnort: Neumünster

Eingabemaske mit Stringadget als Interface

Beitrag von hjbremer »

Letztens hat hier jemand gefragt, wie man eine Eingabemaske schreibt. Nun das ist nicht schwer, aber viele Wege führen nach Rom.

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 
 
 
nun 1 simples Beispiel, Pfad und Dateiname anpassen

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
noch ein simples Beispiel mit 2 Eingabefenstern, Pfad und Name anpassen nicht vergessen

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
EDIT: in der 2.Demo kleinen Fehler in Inputwindow beseitigt
Zuletzt geändert von hjbremer am 31.07.2009 15:00, insgesamt 3-mal geändert.
Purebasic 5.70 x86 5.72 X 64 - Windows 10

Der Computer hat dem menschlichen Gehirn gegenüber nur einen Vorteil: Er wird benutzt
grüße hjbremer
Benutzeravatar
hjbremer
Beiträge: 822
Registriert: 27.02.2006 22:30
Computerausstattung: von gestern
Wohnort: Neumünster

Beitrag von hjbremer »

sollte Interesse :mrgreen: bestehen, ich habe für den Callback des Stringadgets auch eine simple interne Formatfunktion für Dezimalstellen und/oder Tausender Trennzeichen.
Purebasic 5.70 x86 5.72 X 64 - Windows 10

Der Computer hat dem menschlichen Gehirn gegenüber nur einen Vorteil: Er wird benutzt
grüße hjbremer
topsoft
Beiträge: 67
Registriert: 16.09.2004 11:55
Wohnort: nrw

Re: Eingabemaske mit Stringadget als Interface

Beitrag von topsoft »

Hallo,

also ich hätte schon Interesse daran. :allright:

Gruß Rene
Skylake QuadCore i7 6700K @4400MHz, MSI Z170A Gaming M5, 64 GB DDR4 @ 2133MHz, B: Ramdisk 32GB, C: Raid0 SATA SSD 1TB, D: Raid0 M2 SSD 1TB, E: Raid0 HDD 8TB, 28" 4K @ RTX2080, Win10 X64
Benutzeravatar
hjbremer
Beiträge: 822
Registriert: 27.02.2006 22:30
Computerausstattung: von gestern
Wohnort: Neumünster

Re: Eingabemaske mit Stringadget als Interface

Beitrag von hjbremer »

Purebasic 5.70 x86 5.72 X 64 - Windows 10

Der Computer hat dem menschlichen Gehirn gegenüber nur einen Vorteil: Er wird benutzt
grüße hjbremer
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 7032
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Re: Eingabemaske mit Stringadget als Interface

Beitrag von STARGÅTE »

Danke für den Code hjbremer, habs jetzt erst gesehen :oops:

Allerdings kann man die ganzen "Sicherheitssperren" umgehen, indem man einfach Text hineinkopiert.
Genauso könnte ich auch mehr Dezimalstellen schreiben, indem ich erst 8 Zahlen eingebe, und dann nach erst das Komma.
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Benutzeravatar
hjbremer
Beiträge: 822
Registriert: 27.02.2006 22:30
Computerausstattung: von gestern
Wohnort: Neumünster

Re: Eingabemaske mit Stringadget als Interface

Beitrag von hjbremer »

STARGÅTE hat geschrieben:Allerdings kann man die ganzen "Sicherheitssperren" umgehen, indem man einfach Text hineinkopiert.
Genauso könnte ich auch mehr Dezimalstellen schreiben, indem ich erst 8 Zahlen eingebe, und dann nach erst das Komma.
In der Version Strg04 ist das nicht so einfach möglich, auch wenn diese nicht perfekt ist
Purebasic 5.70 x86 5.72 X 64 - Windows 10

Der Computer hat dem menschlichen Gehirn gegenüber nur einen Vorteil: Er wird benutzt
grüße hjbremer
Antworten