Differences in INPUT QBasic vesus PBasic

[Michael Mattias]

Almost sorry you did that, Fred.

I was thinking about updating the MS-DOS version myself, in the process attempting to set a record for "longest time ever between updates, " eclipsing the previous record, held by PowerBASIC Inc for the wait between PB/6x and PB/7x.

(7x==>8x, 8x ==>9x, plenty quick enough).

[Chris Holbrook]

And another text input version from the past: http://www.powerbasic.com/support/pb...ext#post170768

[Gösta H. Lovgren-2]

Kevin, if you'd like to take a stab at using Windows instead of DOS, here's a quick sample using all the edit keys in a Textbox.

'

'PBWIN 9.00 - WinApi 05/2008 - XP Pro SP3
#Dim All 
#Compile Exe  
#Include "WIN32API.INC"
'
Global hdlg As Dword                
 
%Id_Exit_Btn = 1000
%Id_Sample_Textbox = 1001
%Id_Show_Result_Btn = 1002
' 
Macro Common_Locals 'Macro easier than retyping and maintains coding consistency
  Global Dlg_hght, Dlg_Wd As Long 'Global in case want to use in Controls
  Local Row, col, hght, wd, Longest,ctr, ln, ln1, i As Long
  Local  l, s As String
End Macro  
'
CallBack Function Dialog_Processor              
  Common_Locals
  Select Case CbMsg     'This is TO determine the message TYPE 
     '       
     Case %WM_INITDIALOG'<- Initialiaton when the program loads 
     '
     Case %WM_SYSCOMMAND 'Traps Any Alt key but only F4 closes              
     '
     Case %WM_COMMAND  'This processes command messages
       Select Case CbCtl
         Case %Id_Show_Result_Btn 
            Control Get Text CbHndl, %Id_Sample_Textbox To l$
              ? l$, , FuncName$
         Case %Id_Exit_Btn
           Select Case CbCtlMsg        
              Case 0
                Dialog End CbHndl
           End Select
       End Select
  End Select
End Function
'
Function PBMain
  Common_Locals
  Dlg_hght = 400
  Dlg_Wd = 400
  Dialog New Pixels, hdlg, "Demo", , , Dlg_Wd, Dlg_Hght, %WS_SYSMENU To hdlg 'centered
 
  Row = 10
  col = 10
  Wd = 40
  Hght = 12
  Control Add Label, hdlg, -1, " Name & Address ", Col, Row, Wd, Hght
 
  s$ = "Brown, Kevin" & $CrLf & _
       "123 PBWin Avenue" & $CrLf & _
       "PowerBasic, FL 12345"
 
  Col = Col + Wd + 10 'just past label 
  Hght = 15 * 10 'Plenty room for 10 lines of text
  Wd = Dlg_Wd - 40 - 30 'minus the label and leave a little
  Control Add TextBox, hdlg, %Id_Sample_Textbox, s$, Col, Row, Wd, Hght, %ES_WantReturn Or %ES_MultiLine
 
   hght = 25   
   Wd = Dlg_Wd - 20
   Col = 10 'center
 
   Row = Dlg_hght - (Hght * 2) - 4 'Just off bottom
     Control Add Button, hdlg, %Id_Show_Result_Btn, "Show Textbox Results", col, row, Wd, Hght
 
   Row = Dlg_hght - Hght - 2 'Just off bottom
     Control Add Button, hdlg, %Id_Exit_Btn, "Abandon Ship", col, row, Wd, Hght
 
     Dialog Show Modal hDlg   Call Dialog_Processor
End Function
'

==================================
I do not feel obliged to believe
the same God who has endowed us
with sense, reason, and intellect
intended us to forgo their use.
~ Galileo Galilei
==================================

[Fred Buffington]

Gösta, I think he's using PBcc4

[Gösta H. Lovgren-2]

Gösta, I think he's using PBcc4

He probably is Fred. I just thought if he wanted to take a flyer on Windows (as most of us eventually want to do), I thought a simple example might encourage him sooner. However after I cobbled the simple sample together, I guess it really doesn't look all that "simple" when compared to a Dos Basic. {sigh}. Best intentions and all that.

===============================================
"There's many a bestseller that
could have been prevented by a good teacher."
Flannery O'Connor (1925-1964)
===============================================

[Arie Verheul]

Example of Windows style input

Last winter i wrote as an exercise (collected from examples on this forum) a Windows style input routine.
It also includes a menu, and font setting.
It takes some effort to grasp it, but if this it what you want it may be worth the trouble

Arie Verheul

#Compiler PBCC
#Console Off
#Dim All
%CCWIN = 1
%NumWindows = 5
$Include "WIN32API.INC"
#Include "comdlg32.inc"
 
Type WindowParm
    x       As Long
    y       As Long
    Length  As Long
End Type
Global WParms () As WindowParm
Declare Function PBMenu () As Long
Declare Sub SelectFont (hWndEdit() As Dword, Mode As Byte)
 
' ---------------------------------------------------------------------
Function WinMain (ByVal hCurrInstance As Long,_
                  ByVal hPrevInstance As Long,_
                  ByVal lpCmdLine     As Asciiz Ptr,_
                  ByVal nCmdShow      As Long) As Long
  Local  msg            As tagMsg,_
         wClass         As WndClassEx,_
         hWnd           As Dword
 
Local szAppName   As Asciiz*20        'Must be long enough
  szAppName = "Tekst Invoer"           'Set application name
  nCmdShow = %SW_Normal
  wClass.cbSize        = SizeOf(wClass)
  wClass.style         = %CS_HREDRAW Or %CS_VREDRAW
  wClass.lpfnWndProc   = CodePtr(MainWndProc)
  wClass.hInstance     = hCurrInstance
  wClass.hIcon         = LoadIcon  (%Null, ByVal %IDI_APPLICATION) 'loads an icon for use by the program
  wClass.hCursor       = LoadCursor(%Null, ByVal %IDC_ARROW)       'loads a mouse cursor for use by the program
  wClass.hbrBackground = CreateSolidBrush (RGB (0,72,0))
  wClass.lpszMenuName  = %Null
  wClass.lpszClassName = VarPtr(szAppName)
  wClass.hIConSm       = LoadIcon  (%Null, ByVal %IDI_APPLICATION) 'loads an icon for use by the program
 
  Call RegisterClassEx (wClass)                'registers a window class for the program window
                                               'creates a window based on registered window class
  hWnd = CreateWindow (szAppName,_              'window class name
                       szAppName,_                  'window caption
                       %WS_OVERLAPPEDWIN,_          'window style
                       100,_             'initial x position
                       100,_             'initial y position
                       800,_             'initial x size
                       500,_             'initial y
                       %Null,_                      'parent window handle
                       PBMenu (),_                  'window menu handle
                       hCurrInstance,_              'program instance handle
                       %Null)                       'creation parameter
 
  ShowWindow   (hWnd, nCmdShow)         'displays the window on the screen
  While GetMessage(Msg, %Null, 0, 0)    'gets a message from the message queque
    TranslateMessage (Msg)              'translates some keyboard messages
    DispatchMessage  (Msg)              'sends a message to a window procedure
  Wend
  Function = Msg.wParam
End Function
 
' ----------------------------------------------------------------------
Function MainWndProc(ByVal hWnd    As Dword,_
                     ByVal wMsg    As Dword,_                   ' message identifier
                     ByVal wParam  As Dword,_                   ' message parameter
                     ByVal lParam  As Dword) Export As Long
 
  Dim hWndEdit(%NumWindows) As Static Dword
  Static lpCS As CREATESTRUCT Ptr
  Local TextFlags As Dword
  Local N As Long
  '--------------------------------------------------------------------
  'Window specification
  Dim WParms(%NumWindows) As WindowParm
        WParms(1).x = 200 : WParms(1).y = 100 : WParms(1).Length = 400
        WParms(2).x = 200 : WParms(2).y = 150 : WParms(2).Length = 400
        WParms(3).x = 200 : WParms(3).y = 200 : WParms(3).Length = 90
        WParms(4).x = 300 : WParms(4).y = 200 : WParms(4).Length = 300
        WParms(5).x = 200 : WParms(5).y = 250 : WParms(5).Length = 300
  '--------------------------------------------------------------------
 
    Select Case wMsg
    Case %WM_CREATE
      lpCS = lParam
      hWndEdit (0) = hWnd
      TextFlags = %WS_CHILD Or %WS_VISIBLE Or %WS_BORDER
      For N = 1 To %NumWindows
      hWndEdit(N) = CreateWindow ("Edit",_              'window class name
                               ByVal %Null,_         'window caption
                               TextFlags,_
                               0,_                   'initial x position
                               0,_                   'initial y position
                               0,_                   'initial x size
                               0,_                   'initial y
                               hWnd,_                'parent window handle
                               1,_                   'window menu handle
                               @lpCS.hInstance,_     'program instance handle
                               %Null)                'creation parameter
      Next
      Function = 0
    Case %WM_SETFOCUS : SetFocus (hWndEdit(1)): Function = 0
    Case %WM_SIZE : SelectFont (hWndEdit(), 0) : Function = 0
    Case %WM_COMMAND        ' Menu processing
        Select Case LoWrd(wparam)
            Case  101 :
            Case  102 :
            Case  103
            Case  201 :
            Case  202 :
            Case  203 :
            Case  204 : SelectFont (hWndEdit(), 1)
        End Select
        Function = 0
    Case %WM_DESTROY : PostQuitMessage(0) : Function = 0
 
    Case Else
        Function = DefWindowProc(hWnd, wMsg, wParam, lParam)
  End Select
End Function
' --------------------------------------------------------------------------
Function PBMenu () As Long
    Local hMenu, sMenu As Long
    hMenu = CreateMenu
    sMenu = CreatePopUpMenu
    AppendMenu hMenu, %MF_POPUP, sMenu, LSet$ ("&File", 20)
    AppendMenu sMenu,%MF_STRING,101,"&Open"
    AppendMenu sMenu,%MF_STRING,102,"&Save"
    AppendMenu sMenu,%MF_STRING,103,"&Exit"
    sMenu = CreatePopUpMenu
    AppendMenu hMenu, %MF_POPUP, sMenu, LSet$ ("&Edit", 20)
    AppendMenu sMenu,%MF_STRING,201,"&Copy"
    AppendMenu sMenu,%MF_STRING,202,"&Paste"
    AppendMenu sMenu,%MF_STRING,203,"&Delete"
    AppendMenu sMenu,%MF_STRING,204,"&Font"
    Function  = hMenu           ' Goes to CreateWindow call
End Function
 
' ---------------------------------------------------------------
Sub SelectFont (hWndEdit () As Dword, Mode As Byte)
  Local lfFont As LOGFONT
  Local hFont  As Long
  Local hFontNew As Long
  Local WindowRect    As RECT
  Local WindowHeight As Long
  Local N As Long
  N = FreeFile
  Open "D:\PBCC\SetFont.dat" For Binary As N
  If Lof(N) < 30 Then Mode = 1
  Get N,1,lfFont
                       ' Mode = 0 Restore previous font from data file
  If Mode = 1 Then     ' Mode = 1 Set Font
        Local cf As CHOOSEFONTAPI   ' Initialiseer Choosefontbox
        cf.lStructSize    = SizeOf(cf)
        cf.hWndOwner      = hWndEdit(0)
        cf.lpLogFont      = VarPtr(lfFont)
        cf.Flags          =  %CF_SCREENFONTS _
                          Or %CF_INITTOLOGFONTSTRUCT _
                          Or %CF_NOSCRIPTSEL _
                          Or %CF_TTONLY
        ChooseFont (cf)
        Put N,1,lfFont
  End If
  Close N
        hFontNew = CreateFontIndirect (lfFont)
        DeleteObject (hFont)
        hFont = hFontNew
        WindowHeight = -9 * lfFont.lfHeight \ 7
  For N = 0 To %NumWindows
        SendMessage (hWndEdit(N), %WM_SETFONT, hFontNew, 0)
        If N = 0 Then Iterate For
        GetClientRect  (hWndEdit(N), WindowRect)
        InvalidateRect (hWndEdit(N), WindowRect, %TRUE)
        MoveWindow(hWndEdit(N), WParms(N).x, WParms(N).y, WParms(N).Length, WindowHeight, %True)
   Next
 End Sub
' ---------------------------------------------------------------

[Kevin Brown]

Differences in INPUT Qbasic versus PBasic

Gents thank you all for you advise and suggestions, I have now have two possible solutions to my initial post.

The first one here is one I wrote, I will also send a copy of an adaptation of the solution offered by Fred, thanks indeed Fred, did you honestly just knock that together in a few minutes ?

Every journey starts with the first footstep, I suppose I'm at least a yard or so into the journey, now where are those bridges y'all been talking about. Seriously guys thanks for the assistance, looking forward to taking on my first real useful project below, but before that I will take a look at and try and understand the code that you all sent.

Next Project:
Using PBCC to work with Parts via Random Access Files, this in time will probably lead me to raise questions on databases, however for the meantime, I can work with GET and PUT from these files and work in one of these text editors to help. This will not be such as massive task but by the time I have done it I'm sure I will be asking questions on PBWin
versus PBCC for the applications I have.




Kevin Brown

 
 
'
'Power Basic Console Compiler  PBCC  4.0
'Text Editor for editing 6 lines of text
'Utility for other programs
'
GLOBAL I$              'keyboard input
GLOBAL FCN AS INTEGER  'Foreground
GLOBAL BCN AS INTEGER  'Background
GLOBAL SCN AS INTEGER  'Screen

GLOBAL CP AS INTEGER   'Cursor posn
GLOBAL IC$             'Insert mode
GLOBAL LN AS STRING    'Line
GLOBAL L1 AS STRING    'Line 1
GLOBAL L2 AS STRING    '2
GLOBAL L3 AS STRING    '3
GLOBAL L4 AS STRING    '4
GLOBAL L5 AS STRING    '5
GLOBAL L6 AS STRING    '6
GLOBAL LS AS INTEGER   'Length of string
GLOBAL FC AS INTEGER   'First charachter
GLOBAL CL AS INTEGER   'Current line
GLOBAL LL AS INTEGER   'Last line
GLOBAL FL AS INTEGER   'First line
GLOBAL CV AS INTEGER   'Cursor Vertical Positionc
GLOBAL FV AS INTEGER   'Firt Vertical
GLOBAL NV AS INTEGER   'Number of verticals
GLOBAL CS AS INTEGER   'Cursor Min Horz
GLOBAL CM AS INTEGER   'Cursor Max Horz
GLOBAL TD AS DOUBLE    'TimeDelay
GLOBAL StartTime AS DOUBLE
GLOBAL TimePast AS DOUBLE
 

 SUB  ColorScreen
 CONSOLE SCREEN 26,80
    PRINT "Press any key to proceed "
               'FCN Foreground
               'BCN Background
     IF FCN = 0 THEN FCN = 7
     IF BCN = 0 THEN BCN = 0
    COLOR FCN,BCN
    'COLOR [foreground], [background]
    '0 Black      '1 Blue    '2 Green    '3 Cyan    '4 Red    '5 Magenta    '6 Brown
    '7 White    '8 Gray    '9 Light blue    '10 Light green    '11 Light cyan    '12 Light red
    '13 Light magenta    '14 Yellow    '15 High intensity white
END SUB

SUB ArrowDown
    IF CL = LL THEN CL =1: CV =FV  ELSE CL =CL +1:CV =CV +1
    CALL LineEdit
    CP =10 + LEN(LN)
    CALL LineEdit
END SUB
SUB ArrowUp
    IF CL = FL THEN CL =LL: CV = FV + (NV-1) ELSE CL =CL -1 :CV =CV -1
    CALL LineEdit
    CP =10 + LEN(LN)
    CALL LineEdit
END SUB
SUB ArrowRight
    IF CP = CM THEN CP = 10 ELSE CP = CP +1
END SUB

SUB ArrowLeft
     IF CP =CS THEN CP =CM ELSE CP = CP -1
END SUB
 
SUB CharcAdd
    CALL LineEdit
    IF CP < = 69 THEN LN= LN+I$:  CP=(CP+1)
    CALL LineDone
END SUB

SUB CharcCut
    CALL LineEdit
      LN= LEFT$(LN,(CP-FC))+RIGHT$(LN,(LEN(LN)-(CP-FC+1)))
    CALL LineDone
END SUB
SUB CharcLastCut
    CALL LineEdit
     IF CP > 10 THEN LN= LEFT$(LN, (LEN(LN) -1)):CP =(CP -1)
    CALL LineDone
END SUB

SUB CharcFindWords
    CALL LineEdit
       CP = CP + 1
       IF CP = LEN(LN) + 10 THEN CP =10
       CP = (INSTR((CP-(10)) , LN, " ")) + 10
     CALL LineDone
END SUB
 

SUB CharcInsert
    CALL LineEdit
    IF LEN(LN) < = 59 THEN LN= LEFT$(LN,(CP-FC))+ I$ +RIGHT$(LN,(LEN(LN)-(CP-FC))): CP=(CP+1)
    CALL LineDone
END SUB
 
SUB CharcOverite
    CALL LineEdit
       LN= LEFT$(LN,(CP-FC))+ I$ +RIGHT$(LN,(LEN(LN)-(CP-FC+1))): CP=(CP+1)
    CALL LineDone
END SUB

SUB LineEdit
    IF CL = 1 THEN LN =L1: LS = LEN(L1)
    IF CL = 2 THEN LN =L2: LS = LEN(L2)
    IF CL = 3 THEN LN =L3: LS = LEN(L3)
    IF CL = 4 THEN LN =L4: LS = LEN(L4)
    IF CL = 5 THEN LN =L5: LS = LEN(L5)
    IF CL = 6 THEN LN =L6: LS = LEN(L6)
END SUB

SUB LineDone
    IF CL = 1 THEN L1 = LN:LS = LEN(L1)
    IF CL = 2 THEN L2 = LN: LS = LEN(L2)
    IF CL = 3 THEN L3 = LN: LS = LEN(L3)
    IF CL = 4 THEN L4 = LN: LS = LEN(L4)
    IF CL = 5 THEN L5 = LN: LS = LEN(L5)
    IF CL = 6 THEN L6 = LN: LS = LEN(L6)
END SUB

SUB KeyBoard
    FC =10
    COLOR FCN,BCN
    CONSOLE NAME "6 Line Text Editor utility"
    CURSOR ON  ,05
    'IF CP = 0 THEN CP = FC
DO
   ' TD = 0.1
   ' StartTime = TIMER
   ' WHILE  TimePast < TD
   ' TimePast = TIMER -StartTime
   ' WEND
   ' TimePast= 0

    I$ = WAITKEY$  ' Wait for a key or mouse event
   FL =1
   LL =6
   FV = 9
   NV = 6
   CS =10
   CM =70
      'Current line
    IF CL = 0 THEN CL=1: I$ =""
    IF CP = 0 THEN CP =10 'CS
    IF CV = 0 THEN CV =9
    IF LEN(I$) = 1 AND ASC(I$, 1) = 13 THEN EXIT DO        'Car Return
    IF LEN(I$) = 2 AND ASC(I$, 2) = 71 THEN   CP = FC :CURSOR ON,05        ' Home
    IF LEN(I$) = 2 AND ASC(I$, 2) = 75 THEN   CALL ArrowLeft               '<
    IF LEN(I$) = 2 AND ASC(I$, 2) = 77 THEN   CALL ArrowRight              '>
    IF LEN(I$) = 2 AND ASC(I$, 2) = 80 THEN   CALL ArrowDown :CURSOR ON,05 'Down arrow
    IF LEN(I$) = 2 AND ASC(I$, 2) = 72 THEN   CALL ArrowUp:CURSOR ON,05    'UP arrow
    IF LEN(I$) = 2 AND ASC(I$, 2) = 79 THEN   CP = LS+FC :CURSOR ON,05     'End
 
          'Set up Cursor for insert /Delete
      DO
        'Insert
        IF LEN(I$) = 2 AND ASC(I$, 2) = 82 AND IC$="Insert"  THEN IC$="":CURSOR ON,05 :EXIT DO
        IF LEN(I$) = 2 AND ASC(I$, 2) = 82 AND IC$=""  THEN IC$="Insert" :CURSOR ON,75:EXIT DO
        IF LEN(I$) = 2 AND ASC(I$, 2) = 82 AND IC$="Insert"  THEN IC$="" :CURSOR ON,05:EXIT DO
        'Delete
        IF LEN(I$) = 2 AND ASC(I$, 2) = 83 THEN IC$="" :CURSOR ON,05
      LOOP UNTIL IC$ ="Insert" OR IC$=""

      'Tab use to find blanks between words & position cursor on each word
      IF LEN(I$) = 1 AND ASC(I$, 1) = 9  THEN CALL CharcFindWords
          DO
             'Delete intermediate
            IF LEN(I$) = 2 AND ASC(I$, 2) = 83 AND (CP-FC)<LS THEN CALL CharcCut:EXIT DO
             'Backspace delete intermediate charc
             IF LEN(I$) = 1 AND ASC(I$, 1) = 8 AND (CP-FC)<LS THEN CALL CharcCut:EXIT DO
             'Backspace delete last charc
            IF LEN(I$) = 1 AND ASC(I$, 1) = 8 AND CP = LS + FC THEN CALL CharcLastCut:EXIT DO
              'Insert text WITH insert ON
            IF LEN(I$) = 1 AND IC$ ="Insert" AND ASC(I$, 1)> 31 AND ASC(I$, 1)< 128 THEN CALL CharcInsert:EXIT DO
              'Insert text WITH insert OFF but cursor location to left of end
            IF LEN(I$) = 1 AND IC$="" AND CP >11  AND CP < 10+LS AND ASC(I$, 1)> 31 AND ASC(I$, 1)< 128 THEN CALL CharcOverite:EXIT DO

              'Add text to end of string
            IF LEN(I$) = 1 AND IC$ ="" AND CP>= 10+LS AND ASC(I$, 1)> 31 AND ASC(I$, 1)< 128 THEN CALL CharcAdd :EXIT DO
            EXIT DO
          LOOP

            LOCATE 1,1
                        'Development information
                      'PRINT TAB(2)"Temporary Development Data";TAB (55) I$; TAB(65) "CHR$("; ASC(I$, 1); ")"
                      'PRINT TAB (2) ">"MID$ (LN, (CP-(10-1)),1)"<"TAB (55) I$; TAB(65) "CHR$(0,"; ASC(I$, 2); ")"
                      'PRINT TAB(2)IC$ TAB(12)"Line " CL TAB(25)"String " LS " Cursor " CP
                      PRINT""
                      PRINT""
                      PRINT""
                      PRINT ""
                      PRINT ""
                      PRINT ""
                      PRINT ""
                      PRINT TAB(9)CHR$(201) STRING$(61,CHR$(205)) CHR$(187)
                      PRINT TAB(9)CHR$(186)TAB(10) L1   TAB(71)CHR$(186)TAB(73)"1"
                      PRINT TAB(9)CHR$(186)TAB(10) L2   TAB(71)CHR$(186)TAB(73)"2"
                      PRINT TAB(9)CHR$(186)TAB(10) L3   TAB(71)CHR$(186)TAB(73)"3"
                      PRINT TAB(9)CHR$(186)TAB(10) L4   TAB(71)CHR$(186)TAB(73)"4"
                      PRINT TAB(9)CHR$(186)TAB(10) L5   TAB(71)CHR$(186)TAB(73)"5"
                      PRINT TAB(9)CHR$(186)TAB(10) L6   TAB(71)CHR$(186)TAB(73)"6"
                      PRINT TAB(9)CHR$(200) STRING$(61,CHR$(205))CHR$(188)
                      PRINT""
                      PRINT "CONTROLS: Up/Down/Home/End/Delete/Backspace/Inset/Tab   Return/Esc to EXIT"
                      LOCATE CV, (CP)
             IF LEN(I$) = 1 AND ASC(I$, 1) = 13 THEN EXIT DO        'Car Return
             IF LEN(I$) = 1 AND ASC(I$, 1) = 27 THEN EXIT DO        'Esc
         I$=""
   LOOP UNTIL ASC(I$, 1) = 27

END SUB

SUB EndProg

LOCAL StartTime AS DOUBLE
LOCAL TimePast AS DOUBLE
LOCAL TD AS SINGLE
    LOCATE 17,1
     PRINT STRING$(80," ")
    LOCATE 17,1
     PRINT "Program is ending, press any key to finish."
     TD = 1.0
    StartTime = TIMER
    WHILE  TimePast < TD
    TimePast = TIMER -StartTime
    WEND
    TimePast= 0
WAITKEY$
END SUB
 
'------------------------------
' Main program entry point...
'
FUNCTION PBMAIN () AS LONG
 CALL ColorScreen
 CALL KeyBoard
 CALL EndProg
END FUNCTION

[Michael Mattias]

>Using PBCC to work with Parts via Random Access Files

Syntax is nearly identical and usage is exactly identical to both QBasic and QuickBasic (and PowerBASIC for DOS, for that matter).

(And now that compiler supports FIELD, you can even use those if you are comfy with them).

[Kevin Brown]

Dirrerences in INPUT QBasic versus PBasic

Gents

Adaptation of the code provided by Fred.

Added arrays to provide 6 lines of text, use arrow up down keys to move up /down lines of text for edit.



Kevin Brown

 
#COMPILE EXE
'Power Basic Console Comiler  PBCC  4.0
'Text Editor for editing 6 lines of text
'Utility for other programs
'
' L%   Length of string
' X%   Column position
' Y%   Row Position
' R%   Row 1 to 6 of text
' M%   Maximum number of rows
' Q8$  String on screen for viewer
' Z$   read INKEY$
' STT$ String after edit transfer to Q8$
' COL& Current cursor Column position
' ZZ&  Current cursor Column position
GLOBAL Q1 AS STRING
GLOBAL Q2 AS STRING
GLOBAL STT$
GLOBAL CL% 'AS INTEGER  'current line
GLOBAL VA AS INTEGER
GLOBAL AryT$()      'as string
GLOBAL AryI%()
GLOBAL Z$
GLOBAL Z1$
'ARRAY

SUB MakeArrays
    CONSOLE NAME "Adapted 6 Line text editor utility"

 DIM AryI%(1 TO 6, 1 TO 5)
 DIM AryT$(1 TO 6)
 LOCAL HA AS INTEGER
 LOCAL EE%
 FOR VA =1 TO 6
          AryI%(VA,1)=VA: AryI%(VA,2)=6 :AryI%(VA,3)=10:AryI%(VA,4)=VA+4:AryI%(VA,5)=60
          AryT$(VA)= STRING$(60," ")
   NEXT VA

   'Display Array
   'FOR VA =1 TO 6
   '    LOCATE 14+VA,1
   '    FOR HA = 1 TO 5
   '     PRINT AryI%(VA,HA); " ";
   '    NEXT HA
   'NEXT VA
   'LOCATE 22,1
   'INPUT "AKP ",EE%
END SUB
 
 

SUB linput(X%,Y%,L%,Q8$) 'AS STRING
   CURSOR ON, 10

   'LOCATE Y%,X%-1
   '   PRINT "[";SPACE$(L%);TAB(71)"]";CL%  'Set up field
   'LOCATE Y%,X%
   Z$=""
 
   IF Q8$<>"" THEN
     STT$=Q8$
     LOCATE Y%,X%-1:PRINT"[" Q8$;TAB(71)"]";CL%
     LOCATE 15,1: PRINT "CONTROLS: Up/Down/Home/End/Delete/Backspace    Return/Esc to EXIT"
     '"Valid keys: Up/Down  Home/End Delete      Car.Return/Esc to Exit"
     LOCATE Y%,X%
     STT$=Q8$
   END IF
    ' Z$=""
Start:
   WHILE Z$="":Z$=INKEY$:WEND
   IF LEN(Z$)=1 THEN
      SELECT CASE ASC(Z$)
        CASE 13 'Enter
           Z1$ = Z$
         EXIT SUB

        CASE 27 'Esc
            Z1$=Z$
          EXIT SUB

        CASE 8 'backspace destructive
          COL&=CURSORX
          XX$=MID$(STT$,1,COL&-X%+1-2)+MID$(STT$,COL&-X%+1)
          STT$=XX$
          COL&=COL&-1
          COL&=MAX(COL&,X%)
          LOCATE Y%,X%:PRINT SPACE$(L%);:LOCATE Y%,X%:PRINT STT$;TAB(71)"]";CL%    'Reprint with latest char. inserted/added
          LOCATE Y%,COL&
          Z$=""
        CASE ELSE
                  'Add char. or insert char.
             ZZ&=CURSORX
             STT$=MID$(STT$+SPACE$(L%),1,L%)                'Make full length string with spaces on end
             LOCA&=ZZ&-X%+1                                 'Location where to inser/add char.
             XXX$=MID$(STT$,1,LOCA&-1)+Z$+MID$(STT$,LOCA&)  'Add in Z$ at LOCA& position
             STT$=XXX$
             LOCATE Y%,X%:PRINT STT$;                       'Reprint with latest char. inserted/added
             LOCATE Y%,X%+L%:PRINT ;TAB(71)"]"; CL%;
             LOCATE Y%,ZZ&+1
      END SELECT
      Z$=""
      GOTO Start
   ELSEIF LEN(Z$)=2 THEN
      aa&=ASC(RIGHT$(Z$,1))
      SELECT CASE aa&
 
        CASE 71 'Home
          LOCATE Y%,X%
        CASE 72 ' UP Arrow
            Z1$ = Z$
            EXIT SUB

        CASE 75 'left arrow
          COL&=CURSORX
          IF COL&>X% THEN COL&=COL&-1:LOCATE Y%,COL&
        CASE 77 'right arrow
          COL&=CURSORX
          IF COL&<X%+L% THEN COL&=COL&+1:LOCATE Y%,COL&

        CASE 79 'End
            CURSOR ON, 10
          LOCATE Y%,X%+ LEN(STT$)-1
 
        CASE 80 'down arrow
            Z1$ = Z$
            EXIT SUB

        CASE 82 'insert
          'ignore for now  see above add/insert

        CASE 83 'delete
          CURSOR ON, 10
          COL&=CURSORX
          LOCA&=COL&-X%+1                              'Location where to delete char.
          XXX$=MID$(STT$,1,LOCA&-1)+MID$(STT$,LOCA&+1) 'Delete char. at LOCA& position
          STT$=MID$(XXX$+SPACE$(L%),1,L%)              'Make full length string with spaces on end
          LOCATE Y%,X%:PRINT STT$; ;TAB(71)"]";CL%     'Reprint with latest char. deleted
          LOCATE Y%,COL&
        CASE ELSE
      END SELECT

       Z$=""
       GOTO start
   ' ELSEIF LEN(Z$)=4 'mouse
       'mouse code here
   END IF
END SUB

SUB EndProg
LOCAL StartTime AS DOUBLE
LOCAL TimePast AS DOUBLE
LOCAL TD AS SINGLE
   LOCATE 15,1
     PRINT STRING$(80," ")
   LOCATE 15,1
     PRINT "Program is ending, press any key to finish."
     TD = 1.0
    StartTime = TIMER
    WHILE  TimePast < TD
    TimePast = TIMER -StartTime
    WEND
    TimePast= 0
WAITKEY$
END SUB
 
 
SUB MakeLines

   'IF CL%= 0 THEN
   CL% = AryI%(1,1)
   CONSOLE SCREEN 26,80

   'Fred Q6$=linput(10,5,60,"")
   CALL linput(10,AryI%(CL%,4),60,AryT$(CL%))
Start1:
   WHILE Z1$="":Z1$=INKEY$:WEND
   IF LEN(Z1$)=1 THEN
       SELECT CASE ASC(Z1$)
        CASE 13 'Enter
           EXIT SUB
         CASE 27 'Esc
            EXIT SUB
     END SELECT
     END IF

   IF LEN(Z1$)=2 THEN
      aa1&=ASC(RIGHT$(Z1$,1))
      SELECT CASE aa1&
        CASE 72 ' UP Arrow
            AryT$(CL%)=STT$:STT$ =""
            IF CL% > 1 THEN CL% = CL% -1 ELSE CL% =6
            CALL linput(10,AryI%(CL%,4),60,AryT$(CL%))
        CASE 80 'Down arrow
          AryT$(CL%)=STT$:STT$=""
           IF CL% < 6 THEN  CL% = CL% + 1 ELSE CL% =1
           CALL linput(10,AryI%(CL%,4),60,AryT$(CL%))
          'Z1$=""
        ''CASE ELSE
          ' eXIT SUB
        END SELECT
     END IF
  GOTO Start1
 
END SUB

'DECLARE FUNCTION linput(X%,Y%,L%,Q8$) AS STRING
FUNCTION PBMAIN() AS LONG
CALL MakeArrays
CALL MakeLines
CALL EndProg
 
END FUNCTION
__________________

[Kevin Brown]

Kevin, if you'd like to take a stab at using Windows instead of DOS

Gosta, I pressume I can not run this on PBCC and that I would need to purchase a copy or obtain a trial copy of PBWin to run this.

I've had a look at the code and I can see what some of it is doing.

I don't know if there are trial copies of PBWin available.

Kevin

[jcfuller]

It can be done with PBCC 4.04.
See attached.
James

[jcfuller]

Here is another approach using ResEd by KetilO

http://www.radasm.com/resed/

James

[Michael Mattias]

>I don't know if there are trial copies of PBWin available.

I think PB still has the 30-day no-questions-asked money-back thing.

But contact PB sales [email protected] or call (888) 659-8000 to get something official on this.

[Cliff Nichols]

Like MCM said.

But thats one of the things I LOVE about PB

At least they give you the shot to try and return, no harm no foul

If you don't like it in the timeframe just because you do not understand it, then you are inherently going to want to keep it and learn because of the price.

If you don't like it just because you do not like it (not likely IMNSHO ) then at least you gave it a chance.

If you don't like it because it does not do what you wanted? (More likely you did not research/understand enough....or they are still working on it)

From my own personal experience, PB has been from the day I tried it ("Thinking SHYaaaa right" till this day my favorite software when it comes to speed, simplicity, complexity, and my willingness to learn

[Chris Holbrook]

At least they give you the shot to try and return, no harm no foul

That way of selling used to be called a "puppydog"!

[Gösta H. Lovgren-2]

Gosta, I pressume I can not run this on PBCC and that I would need to purchase a copy or obtain a trial copy of PBWin to run this.

I've had a look at the code and I can see what some of it is doing.

I don't know if there are trial copies of PBWin available.

Kevin

It probably won't run on PBCC (but James provided code that presumably works the same with CC). Don't have CC myself. Looking at the sample I posted again, I can see where it could have been better commented for you. At any rate, you can see PBWin is doable ("can see what is some of it is doing").

For someone considering Windows programming, reading these forums can make it appear daunting, especially coming from a Basic\Dos background (and it can be daunting).

However as you can see, Kevin, there's no lack of people to help a Newby get started.

=====================================
"The nice thing about egotists is
they don't talk about other people."
Lucille S. Harper
=====================================

[Chris Holbrook]

I suspect that the text editor for GRAPHIC WINDOW which I have just posted on the PBCC forum would handle six lines OK. However, it would cost you an upgrade to PBCC V5!

[Fred Buffington]

Kevin, there is a learning curve for getting into the pbwin, but, at least for me,
with all the great guys and gals here that so unselfishly help and submit code,
it can really be not so lengthy a process. I still havent mastered SDK, (building custom windows/painting/etc.) but am getting into it slowly but surely. With DDT and the current enhancements I still can do all that I need to do.

For example, my first major menu program was not with a typical menu bar but with a dialog full of buttons for different things. I also used console tools and graphics from Perfect Sync with pbcc to make my CC programs have the look and feel of a windows dialog.

As for a trial copy, I think the only type of product like that that PB has is for pbdos. Personally I don't care for it, not because it's not a good product, but rather because, as I recall you cannot save or load programs but have to type them in each time to run them.

Now there are plenty of samples, of course, and i was sold on PB when i saw how compatible it was with QuickBasic for input/output of files so many other commands/statements. Of course I new this was true for pbdos from the old quickbasic Bulletin boards that many times showed syntax for QB and PB if different. When I saw that PBcc and PBwin kept so many of these statements, i was sold.

[Michael Mattias]

If you don't like it in the timeframe just because you do not understand it, then you are inherently going to want to keep it and learn because of the price

If you can't decide in 30 days if you want it....

A. You should not have ordered it when you did because you should have known you would not give it a fair trial
OR
B. It's not right for you; but you should be obliged to keep it anyway, since it took you so long to decide exactly nothing. Call it "procrastination costs" or something.

MCM