ICEE/CLSDESKLRC.CLS at master · greatbody/ICEE · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsDeskLrc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Dim frm     As FRMSHOW
Private m_Karaoke       As Boolean      '是否卡拉OK模式

Private Sub Class_Initialize()
    Set frm = New FRMSHOW
    frm.Show
End Sub
'
Private Sub Class_Terminate()
    Unload frm
    Set frm = Nothing
End Sub

Property Let Karaoke(NewValue As Boolean)
    m_Karaoke = NewValue
End Property

Property Get Karaoke() As Boolean
    Karaoke = m_Karaoke
End Property

Public Sub ShowText(ByVal Text As String)
    Call frm.DrawText(Text, 0)
End Sub

Public Sub ReDraw()
    Call frm.ReDrawText
End Sub

Public Property Get FontName() As String
    FontName = frm.LrcFontName
End Property

Public Property Let FontName(ByVal NewName As String)
    frm.LrcFontName = NewName
End Property

Public Property Get FontSize() As Single
    FontSize = frm.LrcFontSize
End Property

Public Property Let FontSize(ByVal NewSize As Single)
    frm.LrcFontSize = NewSize
End Property

Public Property Get FontBold() As Boolean
    FontBold = frm.LrcFontBold
End Property

Public Property Let FontBold(ByVal Bold As Boolean)
    frm.LrcFontBold = Bold
End Property

Public Property Get BackColor1() As OLE_COLOR
    BackColor1 = frm.BackColor1
End Property

Public Property Let BackColor1(ByVal NewColor As OLE_COLOR)
    frm.BackColor1 = NewColor
End Property

Public Property Get BackColor2() As OLE_COLOR
    BackColor2 = frm.BackColor2
End Property

Public Property Let BackColor2(ByVal NewColor As OLE_COLOR)
    frm.BackColor2 = NewColor
End Property

Public Property Get ForeColor1() As OLE_COLOR
    ForeColor1 = frm.ForeColor1
End Property

Public Property Let ForeColor1(ByVal NewColor As OLE_COLOR)
    frm.ForeColor1 = NewColor
End Property

Public Property Get ForeColor2() As OLE_COLOR
    ForeColor2 = frm.ForeColor2
End Property

Public Property Let ForeColor2(ByVal NewColor As OLE_COLOR)
    frm.ForeColor2 = NewColor
End Property

Public Property Get LineColor() As OLE_COLOR
    LineColor = frm.LineColor
End Property

Public Property Let LineColor(ByVal NewColor As OLE_COLOR)
    frm.LineColor = NewColor
End Property


Public Sub SeekLrc(sTime As Double, Optional ReSeek As Boolean = False)   '设置当前歌词
On Error Resume Next
    If ReSeek Then
        Call 歌词模块.SeekLrc(sTime)
    End If

    Dim sLrcShowWidth           As Single               '本句歌词的显示宽度
    Dim iCurTimer               As Double               '本句歌词的播放长度,用于计算滚动比例
    Dim iWidth                  As Long                 '卡拉OK歌词宽度

    If m_Karaoke Then
        If iCurPlay = iLrcRows Then
            iCurTimer = 10
        Else
'            iCurTimer = myLrc(iCurPlay + 1).lrcTime - myLrc(iCurPlay).lrcTime ' - 0.1
        End If
'        sLrcShowWidth = frm.TextWidth(myLrc(iCurPlay).lrcString)    '本句歌词总宽度

        '已唱的时间 / 总时间 * 总宽度
'        iWidth = (sTime - myLrc(iCurPlay).lrcTime) / iCurTimer * sLrcShowWidth
    Else
        iWidth = 0
    End If

    If iCurPlay = -1 Then
        frm.DrawText "", iWidth
    Else
        frm.DrawText myLrc(iCurPlay).lrcString, iWidth
    End If
End Sub