文本特殊效果函数

lihaizhu

'====================================================================
' 名称:        LHZWZXGA(文字效果A)----NOHZ-FUNCTION-001
' 作用:        实现动态文字的函数(可实现三种效果变化)
'
' 输入值:      待处理字符串 As String
'
'              类型 As String
'
' 返回类型:    String
'
' 作者:        李海柱 版权所有严禁复制或他人用于商业用途
' 日期:        2006-10-31
' 注释:        实现动态文字的函数
'调用方法如下:在TIMER事件中加入调用即可,时钟自已随意设定
'Me.Label4.Caption = LHZWZXGA("这是从两边向中间减小的文本", "flymove")
'Me.Label5.Caption = LHZWZXGA(("这是带有一定空格的移动文东", "FLYSPACE")
'Me.mylable.Caption = LHZWZXGA(("这是一个滚动的文本", "FLYCIRCLE")
'用于非商业用途的试用、或技术研究全文引用。
'====================================================================
Function LHZWZXGA(待处理字符串 As String, 类型 As String) As String
    Static flytimesa As Integer '声明一个静态变量,改变了使用TIMER内变量渐增的难度
    Static flytimesb As Integer
    Static flytimesc As Integer
    flytimesa = flytimesa + 1
    flytimesb = flytimesb + 1
    flytimesc = flytimesc + 1
    If Len(待处理字符串) = 0 Then
    MsgBox "Error Because Your String's Length =0" & vbNewLine & "Or  String Is Null!", 48, "Call Wrong"
    Else
        Select Case 类型
        Case Is = "FLYSPACE" '这是带有一定空格的移动文本,空格的数量视情况而定,默认为10个空格,可在程序中修改
            If flytimesa > Len(待处理字符串) Then
                flytimesa = 0
            Else
                LHZWZXGA = Left(待处理字符串, flytimesa) & Space(10) & Right(待处理字符串, Len(待处理字符串) - flytimesa)
            End If
        Case Is = "FLYCIRCLE" '这是一个滚动的文本
            If flytimesb > Len(待处理字符串) Then
                flytimesb = 0
            Else
                LHZWZXGA = Right(待处理字符串, Len(待处理字符串) - flytimesb) & Left(待处理字符串, flytimesb)
            End If
        Case Is = "FLYMOVE" '这是从两边向中间减小的文本,请将标签文本设为居中格式
            If 2 * flytimesc > Len(待处理字符串) Then
                flytimesc = 0
            Else
                LHZWZXGA = Mid(待处理字符串, flytimesc + 1, Len(待处理字符串) - 2 * flytimesc)
            End If
        End Select
    End If
End Function
'====================================================================
' 名称:        LHZSTGG(双图广告) NOHZ-FUNCTION-002
' 作用:        在窗体上实现动态交互广告
'
' 输入值:      第一个图片 As Image
'              第一个图片地址 As String
'              第二个图片 As Image
'              第二个图片地址 As String
'
'
' 返回类型:    String
'
' 作者:        李海柱 版权所有严禁复制或他人用于商业用途
' 日期:        2006-10-31
' 注释:        实现动态文字的函数
'调用方法如下:在TIMER事件中加入调用即可,时钟自已随意设定
'Me.Label9.Caption = LHZSTGG(Me.Image7, "HTTP://WWW.SINA.COM", Me.Image8, "HTTP://WWW.YAHOO.COM.CN")
'用于非商业用途的试用、或技术研究全文引用。
'====================================================================
Function LHZSTGG(第一个图片 As Image, 第一个图片地址 As String, 第二个图片 As Image, 第二个图片地址 As String) As String
Static X As Boolean
If 第二个图片.Visible = True Then
X = False
Else
X = True
End If
第一个图片.HyperlinkAddress = 第一个图片地址
MYIMAGEB.HyperlinkAddress = 第二个图片地址
MYIMAGEB.Visible = X
If 第二个图片.Visible = False Then
LHZSTGG = 第一个图片地址
Else
LHZSTGG = 第二个图片地址
End If
End Function
'====================================================================
' 名称:        LHZDTDH(多图动画)  NOHZ-FUNCTION-003
' 作用:        用6 幅图片实现动画的函数
'
' 输入值:      pic1 As Image
'              pic2 as image
'              pic3 as image
'              pic4 as image
'              pic5 as image
'              pic6 as image
' 返回类型:    string
'
' 作者:        李海柱 版权所有严禁复制或他人用于商业用途
' 日期:        2006-10-31
' 注释:
'调用方法如下:在TIMER事件中加入调用即可,时钟自已随意设定
'Private Sub Form_Timer()
'X = LHZDTDH(Me.Image10, Me.Image11, Me.Image12, Me.Image13, Me.Image14, Me.Image15)
'End Sub
'用于非商业用途的试用、或技术研究全文引用。
'====================================================================
Function LHZDTDH(pic1 As Image, pic2 As Image, pic3 As Image, pic4 As Image, pic5 As Image, pic6 As Image) As String
    Dim picarrary(6) As Image
    Dim i As Integer
    Static nowtime As Integer
    nowtime = nowtime + 1
    Set picarrary(1) = pic1
    Set picarrary(2) = pic2
    Set picarrary(3) = pic3
    Set picarrary(4) = pic4
    Set picarrary(5) = pic5
    Set picarrary(6) = pic6
    If nowtime = 7 Then
        nowtime = 0
    Else
        For i = 1 To 6
            If i = nowtime Then
                picarrary(i).Visible = True
                LHZDTDH = "Now show image no is" & STR(i)
            Else
                picarrary(i).Visible = False
            End If
        Next
    End If
End Function
'====================================================================
' 名称:        LHZWZXGB(文字效果B)----NO:LHZ-FUNCTION-004
' 作用:        实现动态文字的函数(交互式的变化效果)
'
' 输入值:      待处理字符串一 As String
'              待处理字符串二 As String
'
'
' 返回类型:    String
'
' 作者:        李海柱 版权所有严禁复制或他人用于商业用途
' 日期:        2006-10-31
' 注释:        实现动态文字的函数
'调用方法如下:在TIMER事件中加入调用即可,时钟自已随意设定
'Private Sub Form_Timer()
'Me.Label16.Caption = LHZWZXGB("aaaaaaaaaaaaaaaaaaa", "BBBBBBBBBBBBBBBBBBBBBB")
'End Sub
'用于非商业用途的试用、或技术研究全文引用。
'====================================================================
Function LHZWZXGB(待处理字符串一 As String, 待处理字符串二 As String) As String
Dim nowstring As String
Static X As Boolean
If X = False Then
X = True
Else
X = False
End If
If X = True Then
LHZWZXGB = 待处理字符串二
Else
LHZWZXGB = 待处理字符串一
End If
End Function
'====================================================================
' 名称:        LHZDTBQ(动态标签)----NO:LHZ-FUNCTION-005
' 作用:        实现动态文字的函数(主要用于标签)
'
' 输入值:      标签 As LABEL
'              最大字号 AS INTEGER
'              最小字号 AS INTEGER
'
' 返回类型:    BOOLEAN
'
' 作者:        李海柱 版权所有严禁复制或他人用于商业用途
' 日期:        2006-10-31
' 注释:
'调用方法如下:在TIMER事件中加入调用即可,时钟自已随意设定
'Private Sub Form_Timer()
'x = LHZDTBQ(Me.Label16, 50, 25)
'End Sub
'用于非商业用途的试用、或技术研究全文引用。
'====================================================================
Function LHZDTBQ(标签 As Label, 最大字号 As Integer, 最小字号 As Integer) As Boolean
    Dim labelstring As String
    labelstring = 标签.Caption
    Static X As Integer
    X = X + 1
    If X < 最小字号 Then
        X = 最小字号
    End If
    If X > 最大字号 Then
        X = 最小字号

    Else
        If X < 最小字号 Then
        Else
            标签.FontSize = X
        End If
    End If
    LHZDTBQ = True
End Function

bach

上传个例子就更好了

lihaizhu

函数里已经有使用的说明了啊！试试就知道了！

goto2008

能否来个库，方便收藏

蓝天飞猪

好用！！！！！！！！！！！！！！