Buchempfehlung
Visual Basic 6 Kochbuch
Visual Basic 6 Kochbuch
Viele praktische Tipps zum Programmieren mit Visual Basic 6, die sich oft auch auf FB übertragen lassen. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

Gadget_String.bas mit LimitMode 6

Uploader:MitgliedMuttonhead
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