GFLEDBox/Testfrm.frm

VERSION 5.00
Begin VB.Form Testfrm
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6375
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   6375
   StartUpPosition =   3 'Windows‑Standard
   Begin VB.CommandButton Command2
      Caption         =   "Touch Thread Control"
      Height          =   375
      Left            =   1920
      TabIndex        =   2
      Top             =   2760
      Width           =   2895
   End
   Begin VB.CommandButton Command1
      Caption         =   "Show"
      Height          =   375
      Left            =   4860
      TabIndex        =   1
      Top             =   2760
      Width           =   1455
   End
   Begin VB.PictureBox Picture1
      BackColor       =   &H00E0E0E0&
      BeginProperty Font
         Name            =   "Arial Black"
         Size            =   18
         Charset         =   0
         Weight          =   700
         Underline       =   0 'False
         Italic          =   ‑1 'True
         Strikethrough   =   0 'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   675
      Left            =   60
      ScaleHeight     =   615
      ScaleWidth      =   6195
      TabIndex        =   0
      Top             =   360
      Width           =   6255
   End
End
Attribute VB_Name = "Testfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2001 by Louis
'GFLEDBox
Const TEXTSTYLEEX_SPEEDITALIC As Long = 1 'font is set to italic when moving only
Const TEXTSTYLEEX_USEBLINKSTRING As Long = 2 'display blinks when resting at a stop point and this string is visible
Const TEXTSTYLEEX_JERKING As Long = 4 'no smooth scrolling (can be read better)
'GFLEDBox
Dim GFLEDBox_MouseMoveXPosOld As Long
Dim GFLEDBox_MouseMoveYPosOld As Long
Dim GFLEDBox_AnimationEnabledFlagOld As Boolean

Private Sub Command1_Click()
    'on error resume next
    GFLEDBoxfrm.Show '***TEMP***
    Call GFLEDBoxfrm.LED_Initialize(Picture1, Picture1.ForeColor, Picture1.BackColor, 2, 5)
    Call GFLEDBoxfrm.LED_Program_HScroll("This is the ultimate Test used to check if GFLEDBox works probably. Peace folks! BLAHBLAH", 10, 0, TEXTSTYLEEX_SPEEDITALIC + TEXTSTYLEEX_JERKING, "")
    Call GFLEDBoxfrm.LEDAnimation_Enable
    'Do
    '    Picture1.Cls
    '    Picture1.Print "hello"
    '    DoEvents
    'Loop
End Sub

Private Sub Command2_Click()
    'on error resume next
    Call Picture1.Move(Picture1.Left, Picture1.Top + Screen.TwipsPerPixelY)
End Sub

'***PICTURE1***
'NOTE: copy the following code to the target project and replace 'Picture1' with
'the name of the target picture box that displays the animated text.
'The code below allows the user to scroll the text as well as enabling or disabling
'the auto scrolling.

'NOTE: the following mouse event handling subs were copied
'out of the GFLEDBox project files (copy code from there).

Private Sub Picture1_DblClick()
    'on error resume next
    If GFLEDBoxfrm.IsAnimationEnabled = True Then
        GFLEDBox_AnimationEnabledFlagOld = False 'see mouse up event
        Call GFLEDBoxfrm.LEDAnimation_Disable
    Else
        GFLEDBox_AnimationEnabledFlagOld = True 'see mouse up event
        Call GFLEDBoxfrm.LEDAnimation_Enable
    End If
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'on error resume next
    If Button = vbLeftButton Then
        GFLEDBox_AnimationEnabledFlagOld = GFLEDBoxfrm.IsAnimationEnabled
        'do not disable scrolling yet to avoid conflict with DblClick‑function
        GFLEDBox_MouseMoveXPosOld = X
        GFLEDBox_MouseMoveYPosOld = Y
    End If
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'on error resume next
    If Button = vbLeftButton Then
        Call GFLEDBoxfrm.LEDAnimation_Disable 'do not do at MouseDown event as then DblClick function does not work anymore
        Call GFLEDBoxfrm.LEDAnimation_MoveX((X ‑ GFLEDBox_MouseMoveXPosOld) / Screen.TwipsPerPixelX)
        Call GFLEDBoxfrm.LEDAnimation_Redraw(True)
        GFLEDBox_MouseMoveXPosOld = X
        GFLEDBox_MouseMoveYPosOld = Y
    End If
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'on error resume next
    If Button = vbLeftButton Then
        If GFLEDBox_AnimationEnabledFlagOld = True Then
            Call GFLEDBoxfrm.LEDAnimation_Enable
        End If
    End If
End Sub


[END OF FILE]