Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Very fast print for pb/cc (cprint)

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

  • Very fast print for pb/cc (cprint)

    Code:
    #compile exe          'display fast printing using cprint 11/23/2000
    #dim all              'suggestions to [email protected]
                          'no sleep's so will use up the cpu
                          
                          'the author of cprint is keith waters.
                          'without cprint this would not be possible.
                          
    #include "win32api.inc"
    declare sub cprint (byval row& ,_
                        byval col&, _
                        byval text$,_
                        byval tatrib&)
    
    union window_size
      wdw as dword
      wco as coord
    end union
    
    declare sub border(upperrow as long,uppercolumn as long,_
                bottomborderrow as long,bottombordercolumn as long,colr as long)
    
    declare sub clearbox(upperrow as long,uppercolumn as long,_
               bottomborderrow as long,bottombordercolumn as long,colr as long)
    
    sub cprint (byval row&, byval col&, byval text$, byval tatrib&)
      local posn as window_size, _
                    buff as asciiz * 81,_
                    hand as long,_
                    tlen as long, _
                    nos  as long
    
      posn.wco.x = col& - 1
      posn.wco.y = row& - 1
    
      buff = text$
      tlen = len(text$)
      hand = getstdout
    
      call writeconsoleoutputcharacter (hand, buff, tlen, byval posn.wdw, nos)
      call fillconsoleoutputattribute (hand, tatrib&, tlen, byval posn.wdw, nos)
    end sub
    
    function pbmain as long
      mouse on
      mouse 7, down
      rem console screen 26,81 'without this can run full screen!
      dim upperborderrow&,upperbordercolumn&,bottomborderrow&,bottombordercolumn&
      dim row&,col&,text$,colr&,counter&,textlength&,subtotal&
      dim midrow&, midcolumn&,msg$,org&,pagenumber&,toggle&
      upperborderrow = 8          'top border
      upperbordercolumn = 20
      bottomborderrow = 19        'bottom border
      bottombordercolumn = 64
      colr = 23
    
      row = upperborderrow + 1
      col = upperbordercolumn + 1
      textlength = 10
      text = space$(textlength)
      midrow = (upperborderrow + bottomborderrow)*.5
      midcolumn = (upperbordercolumn + bottombordercolumn) *.5
      colr = 118
      counter = 0
      pagenumber = 1
      border upperborderrow, upperbordercolumn, bottomborderrow, bottombordercolumn,23
    
      do
        incr counter
        lset text = str$(counter)
    
        colr = rnd * 253 + 1
        cprint row,col,text,colr       'display color of each box
    
        if counter mod 1 = 0  then     'how many items in each box
    
          row = row + 2
    
          if row > bottomborderrow -1 then
              row = upperborderrow + 1      'past bottom row, move up
              col = col + len(text) +1
    
              if col > bottombordercolumn - len(text) then
                 col = upperbordercolumn + 1 'past right column, start over
    
                 incr pagenumber
    
                  'simulate blinking
                  if pagenumber mod 10 = 0 then
                      cprint 24,33,"click to end",23
                  else
                      cprint 24,33,"click to end",31
                  end if
    
                 cprint upperborderrow,upperbordercolumn + 1,_
                               " page"+str$(pagenumber)+" " ,123
                 subtotal = org
                 for org = subtotal to subtotal + 10000
                     cprint bottomborderrow,upperbordercolumn+1,str$(org),118
                 next
    
            clearbox upperborderrow+1,upperbordercolumn+1,_ 'clear screen
                     bottomborderrow-1,bottombordercolumn-1,23 'blue background
    
              end if
          end if
        end if
      loop until instat
    end function
    
    sub border(upperrow as long,uppercolumn as long,_
               bottomborderrow as long,bottombordercolumn as long,colr as long)
      dim text as string
      dim length as long
      dim height as long
      dim row as long
      dim col as long
    
      'check parameters - remove after testing
      if (upperrow  < 1)        or (uppercolumn < 1) or _
         (bottomborderrow < upperrow) or (bottombordercolumn < uppercolumn) then
            beep  'some parameter checking
            beep
            exit sub
      end if
      'text = "00000000011111111112222222222333333333344444444445555555555666666666677777777778"
      'cprint 1,1,text,23
      'text = "12345678901234567890123456789012345678901234567890123456789012345678901234567890"
      'cprint 2,1,text,23
    
      cprint 2,13, " demonstrate how fast a console application can display ",124
    
    
      length = bottombordercolumn - uppercolumn - 1
      height = upperrow - bottomborderrow - 1
    
      text$ = chr$(218) + string$(length,196)+ chr$(191)
      cprint upperrow,uppercolumn,text,colr
      text = chr$(179)                             'down single line
      for row = upperrow+1 to bottomborderrow-1          '
          cprint row,uppercolumn,text,colr         'print on  left side
          cprint row,uppercolumn+length+1,text,colr'print on right side
      next
      text$ = chr$(192) + string$(length,196)+ chr$(217) 'bottom line
      cprint bottomborderrow,uppercolumn,text,colr       'print bottom line
    end sub
    
    sub clearbox(upperrow as long,uppercolumn as long,_
               bottomborderrow as long,bottombordercolumn as long,colr as long)
      dim text as string
      dim length as long
      dim row as long
      length = bottombordercolumn - uppercolumn +1
      text = string$(length, 32)
      for row = upperrow to bottomborderrow
          cprint row,uppercolumn,text,colr
      next
    end sub

    ------------------ http://www.powerbasic.com/support/pb...ad.php?t=19923



    [this message has been edited by mike doty (edited may 10, 2003).]
Working...
X