Announcement

Collapse
No announcement yet.

Differences in INPUT QBasic vesus PBasic

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • #21
    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).
    Michael Mattias
    Tal Systems (retired)
    Port Washington WI USA
    [email protected]
    http://www.talsystems.com

    Comment


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

      Comment


      • #23
        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.

        '
        Code:
        '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
        ==================================
        Gösta H. Lovgren-2
        Member
        Last edited by Gösta H. Lovgren-2; 27 Oct 2008, 09:47 PM.
        It's a pretty day. I hope you enjoy it.

        Gösta

        JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
        LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

        Comment


        • #24
          Gösta, I think he's using PBcc4
          Client Writeup for the CPA

          buffs.proboards2.com

          Links Page

          Comment


          • #25
            Originally posted by Fred Buffington View Post
            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)
            ===============================================
            It's a pretty day. I hope you enjoy it.

            Gösta

            JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
            LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

            Comment


            • #26
              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

              Code:
              #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
              ' ---------------------------------------------------------------

              Comment


              • #27
                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


                Code:
                 
                 
                '
                '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
                “Oh wad some power the giftie gie us To see oursel's as others see us! It wad frae monie a blunder free us, And foolish notion”

                Robert Burns (1759-96)

                Comment


                • #28
                  >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).
                  Michael Mattias
                  Tal Systems (retired)
                  Port Washington WI USA
                  [email protected]
                  http://www.talsystems.com

                  Comment


                  • #29
                    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


                    Code:
                     
                    #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
                    __________________
                    “Oh wad some power the giftie gie us To see oursel's as others see us! It wad frae monie a blunder free us, And foolish notion”

                    Robert Burns (1759-96)

                    Comment


                    • #30
                      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
                      Kevin Brown
                      Member
                      Last edited by Kevin Brown; 29 Oct 2008, 01:42 PM. Reason: learning how to add quotes
                      “Oh wad some power the giftie gie us To see oursel's as others see us! It wad frae monie a blunder free us, And foolish notion”

                      Robert Burns (1759-96)

                      Comment


                      • #31
                        It can be done with PBCC 4.04.
                        See attached.
                        James
                        Attached Files

                        Comment


                        • #32
                          Here is another approach using ResEd by KetilO

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

                          James
                          Attached Files

                          Comment


                          • #33
                            >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.
                            Michael Mattias
                            Tal Systems (retired)
                            Port Washington WI USA
                            [email protected]
                            http://www.talsystems.com

                            Comment


                            • #34
                              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
                              Engineer's Motto: If it aint broke take it apart and fix it

                              "If at 1st you don't succeed... call it version 1.0"

                              "Half of Programming is coding"....."The other 90% is DEBUGGING"

                              "Document my code????" .... "WHYYY??? do you think they call it CODE? "

                              Comment


                              • #35
                                Originally posted by Cliff Nichols View Post
                                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"!

                                Comment


                                • #36
                                  Originally posted by Kevin Brown View Post
                                  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
                                  =====================================
                                  It's a pretty day. I hope you enjoy it.

                                  Gösta

                                  JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                                  LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                                  Comment


                                  • #37
                                    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!

                                    Comment


                                    • #38
                                      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.
                                      Client Writeup for the CPA

                                      buffs.proboards2.com

                                      Links Page

                                      Comment


                                      • #39
                                        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
                                        Michael Mattias
                                        Tal Systems (retired)
                                        Port Washington WI USA
                                        [email protected]
                                        http://www.talsystems.com

                                        Comment

                                        Working...
                                        X