Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Gadget_String.bas mit LimitMode 6
| Uploader: |  Muttonhead |
| Datum/Zeit: | 12.08.2023 14:51:40 |
#include once "Gadget_Edit_Display.bas"
namespace sGUI
declare function AddStringGadget(win as sGUIWindow ptr,PosX as integer,PosY as integer,GadWidth as integer,MaxChars as integer=0 ,CharLimitation as integer=0,ShowEnd as integer=0,Focus as integer=0, Mode as integer=0) as Gadget ptr
declare function STG_Actions(gad as Gadget ptr,action as integer) as integer
declare sub STG_Update(gad as Gadget ptr)
declare sub SetString (gad as Gadget ptr,Text as string)
declare function GetString (gad as Gadget ptr) as string
declare sub ScrollToAnEnd (gad as Gadget ptr)
declare sub SetAllowedChars (gad as Gadget ptr,ac as string)
declare function UserDefinedKeysCheck(gad as Gadget ptr, a as integer) as integer
/'
type STG_Data
TContainer as sGUIText ptr
EditMode as integer
CharsPerWidth as integer
RowsPerHeight as integer
MaxChars as integer
CharLimitation as integer
ShowEnd as integer
Focus as integer
TimeStamp as double
edit as _Gadget ptr
end type
'/
function AddStringGadget(win as sGUIWindow ptr,PosX as integer,PosY as integer,GadWidth as integer,MaxChars as integer=0 ,CharLimitation as integer=0,ShowEnd as integer=0,Focus as integer=0, Mode as integer=0) as Gadget ptr
function=0
dim as Gadget ptr gad,lbs,scb
if win=0 then win=RootWindow
gad=win->GadgetList->AppendNew (GadgetType)
if gad then
gad->parent=win
gad->Selection=0
gad->Activation=0
gad->PosX=PosX
gad->PosY=PosY
gad->GadWidth=GadWidth
gad->GadHeight=GetFontHeight(1) + 2*LeastGap
gad->xtd.stg.Mode=Mode
gad->xtd.stg.MaxChars=MaxChars
gad->xtd.stg.CharLimitation=CharLimitation
gad->xtd.stg.ShowEnd=ShowEnd
gad->xtd.stg.Focus=Focus
gad->GadgetWindow=AddWindow(gad,0,0,gad->GadWidth,gad->GadHeight)
if gad->GadgetWindow then
gad->xtd.stg.edit =AddEditDisplay (gad->GadgetWindow,0,0,gad->GadWidth,gad->GadHeight,Mode+2)
end if
gad->xtd.TContainer =gad->xtd.stg.edit->xtd.TContainer
gad->xtd.stg.CharsPerWidth=int((GadWidth - 2*LeastGap)/GetFixedWidth)
gad->xtd.stg.RowsPerHeight=1
gad->DoAction =@STG_Actions
gad->DoUpdate =@STG_Update
ScrollToAnEnd(gad)
function=gad
end if
end function
function STG_Actions(gad as Gadget ptr,action as integer) as integer
function=0
dim as Gadget ptr edit
dim as sGUIText ptr TContainer
edit=gad->xtd.stg.edit
TContainer=gad->xtd.TContainer
dim as integer enable
select case action
case GADGET_LMBHIT
SetSelect(edit,1)
function=-1
case GADGET_KEYBOARD 'Keyboardauswertung
'Pfeiltasten/Cursorbewegung in beiden Modi erlaubt
if EXTENDED then
'Cursorbewegung mit Pfeiltasten
if ASCCODE=75 then TContainer->CursorLeft
if ASCCODE=77 then TContainer->CursorRight
'added by MilkFreeze, modified by Muttonhead :D
if ASCCODE=71 then TContainer->CursorKeyPos1
if ASCCODE=79 then TContainer->CursorKeyEnd
TraceCursorPosition(edit)
end if
'Editieren nur im Mode 0 möglich
if gad->xtd.stg.Mode=0 then
if EXTENDED then
'DEL Windows
#ifdef __fb_win32__
if ASCCODE=83 then
TContainer->KeyDelete
TraceCursorPosition(edit)
end if
#endif
else
'BACKSPACE
if ASCCODE=8 then
TContainer->KeyBackspace
TraceCursorPosition(edit)
end if
'DEL Linux
#ifdef __fb_linux__
if ASCCODE=127 then
TContainer->KeyDelete
TraceCursorPosition(edit)
end if
#endif
'Return
if ASCCODE=13 then
if gad->xtd.stg.Focus=1 then
function=-2
else
ScrollToAnEnd(gad)
function=-1
end if
end if
'Zeicheneingabe
enable=0
'Beschränkungen bei der Zeicheneingabe
select case gad->xtd.stg.CharLimitation
case 0'String
'Linux chr(127) (Delete) ausschließen
#ifdef __fb_linux__
if ASCCODE>=32 and ASCCODE<>127 then enable=1
#endif
'Windows
#ifdef __fb_win32__
if ASCCODE>=32 then enable=1
#endif
case 1'Ganze Zahlen
if ASCCODE>47 and ASCCODE<58 then enable=1
case 2'Fließkomma
if ASCCODE>47 and ASCCODE<58 then enable=1
if (ASCCODE=46) and (TContainer->GetNumRows>0) then
if instr(TContainer->GetRowContent(1),".")=0 then enable=1 'wenn . gedrückt und noch kein . im String ist
end if
case 3'binär
if ASCCODE>47 and ASCCODE<50 then enable=1
case 4'hexadezimal
if ASCCODE>47 and ASCCODE<58 then enable=1
if ASCCODE>64 and ASCCODE<71 then enable=1
if ASCCODE>96 and ASCCODE<103 then enable=1
case 5'IPAdressen ;)
if ASCCODE>47 and ASCCODE<58 then enable=1
if ASCCODE>64 and ASCCODE<71 then enable=1
if ASCCODE>96 and ASCCODE<103 then enable=1
if ASCCODE=46 then enable=1
case 6
enable=UserDefinedKeysCheck(gad,ASCCODE)
end select
'if TContainer->GetNumRows then
'Längenbegrenzung
if (gad->xtd.stg.MaxChars>0) and (len(TContainer->GetRowContent(1))>=gad->xtd.stg.MaxChars) then enable=0
'generelles Minus Override, es fehlt etwas an Eleganz :/
if (ASCCODE=45) and (TContainer->GetCursorPosition=1) and (instr(TContainer->GetRowContent(1),"-")=0) then enable=1 'wenn - gedrückt und noch kein - im String ist
'end if
if enable then
TContainer->KeyAddChar(KEY)
TraceCursorPosition(edit)
end if
end if
end if
case GADGET_KEYBOARDOFF'Abbruch Keyboardauswertung
ScrollToAnEnd(gad)
SetSelect(edit,0)
case GADGET_LOOPTHROUGH
if GADGETMESSAGE then
select case GADGETMESSAGE
case edit
TraceCursorPosition(edit)
end select
gad->xtd.stg.edit->ReDraw=1
end if
end select
end function
sub STG_Update(gad as Gadget ptr)
if gad->xtd.stg.TimeStamp <> gad->xtd.TContainer->GetTimeStamp then
gad->xtd.stg.TimeStamp = gad->xtd.TContainer->GetTimeStamp
gad->xtd.stg.edit->ReDraw=1
end if
end sub
sub SetString (gad as Gadget ptr,Text as string)
'es könnten sogar schon 2 existieren durch SetAllowedChars()
if gad->xtd.TContainer->GetNumRows=0 then gad->xtd.TContainer->AppendRow
gad->xtd.TContainer->SetRowContent(1,Text)
ScrollToAnEnd(gad)
end sub
function GetString (gad as Gadget ptr) as string
function=gad->xtd.TContainer->GetRowContent(1)
end function
sub ScrollToAnEnd (gad as Gadget ptr)
if gad->xtd.stg.ShowEnd=1 then
HScrollEditDisplay(gad->xtd.stg.edit,1)'erst Scrollfenster (virtuell) ganz nach links schieben
gad->xtd.TContainer->CursorKeyEnd
'dadurch ist immer das Ende des Textes im StringGadget zu sehen
'Da nun das "Cursorverfolgen" von links(Textanfang) erfolgt
else
gad->xtd.TContainer->CursorKeyPos1
end if
TraceCursorPosition(gad->xtd.stg.edit)
end sub
sub SetAllowedChars (gad as Gadget ptr,ac as string)
if gad->xtd.TContainer->GetNumRows<2 then
do
gad->xtd.TContainer->AppendRow
loop until gad->xtd.TContainer->GetNumRows=2
end if
gad->xtd.TContainer->SetRowContent(2,ac)
end sub
function UserDefinedKeysCheck(gad as Gadget ptr, a as integer) as integer
dim as integer offset,found,numchars
dim as byte ptr AllowedChars
dim as TextRow ptr row
row=gad->xtd.TContainer->GetRowAddress(2)'Adresse Zeile 2 enthält den Zeichenlimiterstring, siehe SetAllowedChars()
numchars=len(row->Text)'Anzahl der Zeichen
found=0
if numchars then
offset=0
AllowedChars=strptr(row->Text)'Zeiger auf String, siehe TextRow UDT in sGUIText.bi
'Checkloop
do
if AllowedChars[offset]=a then found=1
offset +=1
loop until (found=1) or (offset>=numchars)
end if
function=found
end function
end namespace