UnderwareDESIGN

PlayBASIC => Resources => Source Codes => Topic started by: Adaz on November 16, 2006, 09:03:41 AM

Title: Inputbox for PlayBasic
Post by: Adaz on November 16, 2006, 09:03:41 AM
Hi,

At least:) this is a one-line inputbox PSUB with scrolling and editing feature.

It's the first version, but fully functional.

It took 1 hour to write so it can be improved though :)

Usage:
inputbox(text$,ix,iy,iw,ih,bgcolor,bordercolor)

text$ = the text you wish to edit, or can be empty
ix,iy = the top left corner of the textbox
iw,ih = the width and height of the textbox
bgcolor, bordercolor = the background and border color of the textbox



Download InputBox Source Code form PlayBASIC.com (http://www.playbasic.com/sourcecodes.php?ID=44_Inputbox-2.0-for-PlayBasic)

Title: Re: Inputbox for PlayBasic
Post by: kevin on November 16, 2006, 09:57:03 AM
 Seems to work well!






[pbcode]

; PROJECT : Inputbox2
; AUTHOR  : ?d?z
; CREATED : 2006. 12. 02.
; EDITED  : 2006. 12. 02.
; MADE W/ : PlayBasic 1.59
; ---------------------------------------------------------------------

; Including CLIPBOARD.PBA by Kevin Picone (MODIFIED - not to emtpy clipboard contents)

;
;         USAGE:
;
;         inputtext$=inputbox(xpos,ypos,width,height,textcolor)
;
;         You MUST always use "inputtext$" and no other string!
;
;         You can now select text with SHIFT + Left / Right!
;         Copy / paste to/from Windows clipboard with CTRL+C / CTRL+V !
;
;         In this version the other routines of the program don't halt while we edit the text
;         You can draw background, move sprites or anything, AND check the entered text in every frame,
;         or deliberately finish the editing any time by setting the finished variable to True
;
;         Feel free to send me questions, suggestions or bug reports: adaz@fw.hu


SetFPS 40

Global maxlength=100            ;the maximum length of inputbox (you can set this later for each inputboxes)
Global inputtext$                  ;the placeholder for the actual text, it must have global scope
Global finished=True            ;while this variable is False, a text editing is in progress
Global curscolor=RGB(45,45,45)
Global addcolor=RGB(15,15,15)


LoadFont "Arial",1,16,1
SetFont 1



;In this example there will be 3 individual inputboxes.
;Each MUST use "inputtext$" variable, then you can save its contents to your own variable (e.g.text1$)

inputtext$="PlayBasic"   ;you can set the text to be edited beforehand
Repeat
   drawbackground()
   inputtext$=inputbox(100,100,300,20,RGB(255,255,255))
   Sync   
Until finished
text1$=inputtext$   ;we save the contents here



inputtext$="Inputbox 2.0"         ;we can set the next editable text (or empty)
Repeat
   drawbackground()
   inputtext$=inputbox(100,150,400,20,RGB(255,255,255))
   Sync   
Until finished
text2$=inputtext$   ;we save the contents here



inputtext$="by Adaz"         ;we can set the next editable text (or empty)
Repeat
   drawbackground()
   inputtext$=inputbox(100,200,200,20,RGB(255,255,255))
   Sync   
Until finished
text3$=inputtext$   ;we save the contents here

inputtext$=""         ;we are nice people so we empty it :)




;now we can use the user edited texts for our secret purposes:)
Cls RGB(0,80,130)
Print "The fields are:"
Print ""
Print text1$
Print text2$
Print text3$

Sync : WaitNoKey: WaitKey




Psub drawbackground()
   Ink Rnd(RGB(255,255,255)): Circle Rnd(640),300+Rnd(200),Rnd(100),Rnd(1)
EndPsub


Psub inputbox(ix,iy,iw,ih,textcolor)
   Dim keys(255)
   Ink textcolor
   cur=True
   curscolor=curscolor+addcolor
   If curscolor=RGB(45,45,45) Or curscolor=RGB(255,255,255): addcolor=-addcolor: EndIf
   text$=inputtext$
   If Len(text$)>maxlength: text$=Left$(text$,maxlength): EndIf

   curx=GetTextWidth(Left$(text$,curpos))
   If finished
      finished=False
      textx=0: curpos=Len(text$)
      If curx+textx>iw-6
         textx=iw-6-GetTextWidth(Left$(text$,curpos))
      EndIf
   EndIf

   ScreenViewPort ix,iy,ix+iw,iy+ih+1
   BoxC ix,iy,ix+iw,iy+ih,True,RGB(205,125,0)
   BoxC ix,iy,ix+iw,iy+ih,False,RGB(0,205,255)

   i$=Inkey$(): inkey=Asc(i$): KeyBoardState keys()

   If Not keys(47): lastclipboard$="": EndIf

   If keys(29) And keys(46) ;ctrl + c
      If selstart
         TextToClipBoard(Mid$(text$,selstart,selend-selstart+1))
      EndIf
      Goto label1
   EndIf
   If keys(29) And keys(47);ctrl + v
      toclipboard$=GetTextFromClipBoard()
      iflonger=Len(text$)+Len(toclipboard$)
      If iflonger>maxlength: toclipboard$=Left$(toclipboard$,maxlength-Len(text$)): EndIf
      If toclipboard$<>"0" And toclipboard$<>lastclipboard$
         If selstart
            text$=Left$(text$,selstart-1)+Mid$(text$,selend+1,maxlength)
            curpos=selstart-1
         EndIf
     selstart=0
         text$=Insert$(text$,toclipboard$,curpos)
         curpos=curpos+Len(toclipboard$)
         curx=GetTextWidth(Left$(text$,curpos))
         If curx+textx>iw-6
            textx=textx-GetTextWidth(toclipboard$)
         EndIf
         If curx+textx<6
            textx=GetTextWidth(Left$(text$,curpos))
            If textx>0: textx=0: EndIf
         EndIf
         lastclipboard$=toclipboard$
         EndIf
      Goto label1
   EndIf

   Select inkey
      Case -1,27 ;no input
      Case 2 ;left
         If curpos>0
            If ShiftKeys(0)
               If selstart=0
                  selstart=curpos: selend=curpos
               Else
                  If curpos<selstart
                     selstart=curpos
                  Else
                     selend=curpos-1
                  EndIf
               EndIf
            Else
               selstart=0: selend=0
            EndIf
            curx=GetTextWidth(Left$(text$,curpos))
            If curx+textx<6
               textx=textx+GetTextWidth(Mid$(text$,curpos,1))
            EndIf
            Dec curpos
         EndIf
      Case 3 ;right
         If curpos<Len(text$)
            If ShiftKeys(0)
               If selstart=0
                  selstart=curpos+1: selend=curpos+1
               Else
                  If curpos>=selend
                     selend=curpos+1
                  Else
                     selstart=curpos+2
                  EndIf
               EndIf
            Else
               selstart=0: selend=0
            EndIf
            Inc curpos
         EndIf
         curx=GetTextWidth(Left$(text$,curpos))
         If curx+textx>iw-6
            textx=iw-6-GetTextWidth(Left$(text$,curpos))
         EndIf
      Case 8 ;backspace
         If selstart
            text$=Left$(text$,selstart-1)+Mid$(text$,selend+1,maxlength)
            curpos=selstart-1
            selstart=0: selend=0
            curx=GetTextWidth(Left$(text$,curpos))
            If curx+textx<6
               textx=GetTextWidth(Left$(text$,curpos))
               If textx>0: textx=0: EndIf
            EndIf
         Else
            If curpos>0
               If curx+textx<GetTextWidth(Mid$(text$,curpos,1))
                  textx=textx+GetTextWidth(Mid$(text$,curpos,1))
               EndIf
               text$=Left$(text$,curpos-1)+Mid$(text$,curpos+1,maxlength)
               curx=GetTextWidth(Left$(text$,curpos))
               Dec curpos
            EndIf
         EndIf
      Case 40 ;del
         If selstart
            text$=Left$(text$,selstart-1)+Mid$(text$,selend+1,maxlength)
            curpos=selstart-1
            selstart=0: selend=0
            curx=GetTextWidth(Left$(text$,curpos))
            If curx+textx<6
               textx=GetTextWidth(Left$(text$,curpos))
               If textx>0: textx=0: EndIf
            EndIf
         Else
            text$=Left$(text$,curpos)+Mid$(text$,curpos+2,maxlength)
         EndIf
      Case 41 ;home
         selstart=0: selend=0
         curpos=0
         textx=0
      Case 43 ;end
         selstart=0: selend=0
         curpos=Len(text$)
         curx=GetTextWidth(Left$(text$,curpos))
         If curx+textx>iw-6
            textx=iw-6-GetTextWidth(Left$(text$,curpos))
         EndIf
      Case 13 ;enter
         finished=True: cur=False: selstart=0
      Default
         If selstart
            text$=Left$(text$,selstart-1)+Mid$(text$,selend+1,maxlength)
            curpos=selstart-1
         EndIf
         If Len(text$)=maxlength: Goto label1: EndIf
         text$=Insert$(text$,i$,curpos): Inc curpos
         curx=GetTextWidth(Left$(text$,curpos))
         If curx+textx>iw-6
            textx=textx-GetTextWidth(Mid$(text$,curpos,1))
         EndIf
         selstart=0: selend=0
   EndSelect
label1:
   If selstart
      BoxC ix+textx+4+GetTextWidth(Left$(text$,selstart-1)),iy+2,ix+textx+4+GetTextWidth(Left$(text$,selend)),iy+ih,True,RGB(0,120,255)
   EndIf
   Text ix+textx+4,iy+2,text$
   If cur: BoxC ix+curx+3+textx,iy+2,ix+curx+4+textx,iy+ih,True,curscolor: EndIf
   ScreenViewPort 0,0,GetScreenWidth(),GetScreenHeight()
EndPsub text$







; PROJECT : ClipBoard
; EDITED  : 11/19/2006
; ---------------------------------------------------------------------


; *=------------------------------------------------------------------=*
;                 Clip Board Library For PlayBasic
;         (c) 2006 Kevin Picone, All Rights Reversed
; *=------------------------------------------------------------------=*




   ; Clip Board Formats FLags
   Constant CF_TEXT       = 1
   Constant CF_BITMAP    = 2
   Constant CF_DIB      = 8
      
   ; Global Memory Allocation Constants
   Constant GMEM_MOVEABLE = 2
   Constant GMEM_DDESHARE = $2000




LinkDll "User32.dll"
   ; Clipboard Functions
   OpenClipboard(hwnd) Alias "OpenClipboard" As Integer
   CloseClipboard() Alias "CloseClipboard" As Integer
   EmptyClipboard() Alias "EmptyClipboard" As Integer
   GetClipboardData(uFormat) Alias "GetClipboardData" As Integer
   SetClipboardData(uFormat,hData) Alias "SetClipboardData" As Integer
   IsClipboardFormatAvailable(format) Alias "IsClipboardFormatAvailable" As Integer

EndLinkDll



LinkDll "Kernel32.dll"
   ; Global Memory Alloc Functions
   GlobalAlloc(uFlags,dwBytes) Alias "GlobalAlloc" As Integer
   GlobalFree(hMem) Alias "GlobalFree" As Integer
   GlobalLock(hMem) Alias "GlobalLock" As Integer
   GlobalUnlock(hMem) Alias "GlobalUnlock" As Integer
EndLinkDll



; F:TextToClipBoard(PostString$) : Integer
Function TextToClipBoard(PostString$)
      ; get the size of the string      
      Size=Len(PostString$)
      If Size
               ; Alloc a global buffer to store this data in
            BufferHandle=GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE,size+1)

            ; Check if the allocation worked
            If BufferHandle
               ; Lock windows from moving this buffer
               BufferAddress=GlobalLock(bufferHandle)

               ; poke the string into the allocated buffer
               PokeString BufferAddress,PostString$,0
               ; Dump the text to the clip board
               If OpenClipBoard(0)
;                  EmptyClipboard()
                  SetClipboardData(CF_TEXT, BufferAddress)
                  result=True
                  CloseClipboard()
               EndIf

               ; unlock buffer so windows is free to move this buffer again
               GlobalUnLOck BufferHandle
               ; free the buffer
               GlobalFree BUfferHandle
            Else
               #Print "system out of memory"   
            EndIf
      EndIf   
EndFunction result




; F:GetTextFromClipBoard() : String
Function GetTextFromClipBoard()
   ; Open the ClipBoard
   If OpenClipBoard(0)
      ; Check if some text is available
      If IsClipboardFormatAvailable(CF_text)
         ; Get the Address of this text
         BufferAddress=GetClipboardData(CF_TEXT)
         If BufferAddress
            ; Copy the chr's from the Buffer to a PB string
            Result$=PeekString(BUfferAddress,0)  
         EndIf         
         ;Flush the Clipboiard
         ;EmptyClipboard()
      EndIf
      CloseClipBoard()
   Else
      #Print "failed to open clipboard"
   EndIf   
EndFunction Result$



[/pbcode]
Title: Re: Inputbox for PlayBasic
Post by: Adaz on November 16, 2006, 10:00:53 AM
Thank you very much :)
I'll improve it by adding ctrl+left/right word jumping and select/cut/paste text.