Guidance
指路人
g.yi.org
software / rapidq / Examples / Graphics & Animation / QLedScroll / QLEDSCROLL.bas

Register 
注册
Search 搜索
首页 
Home Home
Software
Upload

  
     $INCLUDE <rapidq.INC>

' AKX RAPID-Q Horizontal Scroller ''''''''''''''''''''''''''''''''''''''''''''
' akx@theakx.tk | www.theakx.tk

     TYPE QLEDSCROLL EXTENDS QCANVAS
      TextColor AS LONG
      BgColor AS LONG
      X AS SINGLE
      Y AS INTEGER
      Text AS STRING
      Raster AS INTEGER
      RasterLen AS INTEGER
      Font AS QFONT

      CONSTRUCTOR
       Width=200
       Height=32
       RasterLen=2
      END CONSTRUCTOR

      SUB Rewind
       this.X=this.Width+TextWidth(this.Text)+1
      END SUB

      SUB Paint
       y=this.Y
       this.FillRect 0,0,this.Width,this.Height,this.BgColor
       this.TextOut this.X,y,this.Text,this.TextColor,this.BgColor

       IF this.Raster THEN
        FOR i=0 TO this.Width STEP this.RasterLen
         this.Line i,0,i,this.Height,this.BgColor
        NEXT i
        FOR i=0 TO this.Height STEP this.RasterLen
         this.Line 0,i,this.Width,i,this.BgColor
        NEXT i
       END IF
      END SUB

      SUB Repaint
       this.Paint
      END SUB

      EVENT OnPaint
       this.Paint
      END EVENT

      SUB Move(p AS SINGLE)
       this.X=this.X-p
      END SUB

      SUB SetString(s$)
       this.Text=s$
       this.Rewind
      END SUB

      SUB SetColor(c AS LONG)
       this.TextColor=c
       this.Font.COLOR=this.TextColor
      END SUB

     END TYPE

'' END OF COMPONENT, START OF DEMO '''''''''''''''''''''''''''''''''''''''''''''''''''''

     DIM origtext AS STRING
     origtext = "Welcome to Rapid-Q, cheers, AKX  -- This is the LedScroll component by AKX <akx@theakx.tk>"

     DIM timtik AS LONG
     timtik=0

     CREATE Tmr AS QTIMER
      Interval=1
     END CREATE

     CREATE Form AS QFORM
      CAPTION = "LEDScroll Demo"
      Width = 220
      Height = 120
      AutoScroll=0
      BorderStyle=bsDialog
      Center

      CREATE Scroller AS QLEDSCROLL
       Width=220
       Height=32
       SetString origtext
       SetColor (RGB(0,255,0))
       BgColor=&H000000
       Font.Name="Arial"
       Font.Size=20
       Raster=0
       RasterLen=2
      END CREATE
      CREATE Speed AS QTRACKBAR
       Min=-20
       Max=20
       Position=-2
       Frequency=2
       TickStyle=1
       Height=20
       Top=33
       Left=10
       Width=200
       ShowHint=1
       Hint="Scroller speed"
      END CREATE
      CREATE sinize AS QCHECKBOX
       Checked=1
       CAPTION="Sine"
       Left=0
       Top=55
       Width=50
       Height=16
      END CREATE
      CREATE raster AS QCHECKBOX
       Checked=0
       CAPTION="Raster"
       Left=55
       Top=55
       Width=50
       Height=16
      END CREATE
      CREATE rwd AS QCHECKBOX
       Checked=0
       CAPTION="Rewind"
       Left=115
       Top=55
       Width=60
       Height=16
      END CREATE
      CREATE txt AS QEDIT
       Text=origtext
       Left=0
       Top=73
       Width=180
       Height=10
      END CREATE
      CREATE fb AS QBUTTON
       CAPTION="Font"
       Left=182
       Top=73
       Width=32
       Height=21
      END CREATE
     END CREATE

     DIM fd AS QFONTDIALOG

     SUB timerupd
      DIM sp AS SINGLE
      sp=-Speed.Position/2
      Scroller.Move sp
      INC timtik
      IF sinize.Checked THEN
       Scroller.Y=SIN(timtik/2)*5
      ELSE
       Scroller.Y=0
      END IF
      Scroller.Paint
     END SUB

     SUB rastersw
      IF raster.Checked=1 THEN
       Scroller.Raster=1
      ELSE
       Scroller.Raster=0
      END IF
     END SUB

     SUB rwds
      Scroller.Rewind
      rwd.Checked=false
     END SUB

     SUB sft

      IF fd.EXECUTE THEN
       Scroller.Font.Size=fd.Size
       Scroller.Font.Name=fd.Name
       fd.GetFont(Scroller.Font)
      END IF
     END SUB

     SUB stt
      Scroller.Text=txt.Text
     END SUB

     Tmr.OnTimer=timerupd
     Tmr.Enabled=true

     raster.OnClick=rastersw
     rwd.OnClick=rwds
     fb.OnClick=sft


     txt.OnChange=stt

     fd.SetFont(Scroller.Font)


     Form.SHOWMODAL
掌柜推荐
 
 
 
 
 
 
 
 
 
 
 
 
© Sat 2024-4-20  Guidance Laboratory Inc.
Email:webmaster1g.yi.org Hits:0 Last modified:2003-08-27 23:27:18