frmadtext.frm

传奇网吧伴侣源码

VERSION 5.00
Begin VB.Form frmADText 
   Caption         =   "滚动广告条内容设置"
   ClientHeight    =   3780
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5235
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9.75
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   ScaleHeight     =   3780
   ScaleWidth      =   5235
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton CmdDel 
      Caption         =   "删除"
      Height          =   375
      Left            =   1680
      TabIndex        =   4
      Top             =   3240
      Width           =   1335
   End
   Begin VB.CommandButton CmdADD 
      Caption         =   "添加"
      Height          =   375
      Left            =   240
      TabIndex        =   3
      Top             =   3240
      Width           =   1335
   End
   Begin VB.ListBox List1 
      Height          =   2205
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   4935
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   2520
      Width           =   4815
   End
   Begin VB.CommandButton CmdSave 
      Caption         =   "保存"
      Height          =   375
      Left            =   3120
      TabIndex        =   0
      Top             =   3240
      Width           =   1335
   End
End
Attribute VB_Name = "frmADText"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private iniPath As String
Private Entry As String

Private Sub CmdADD_Click()

Debug.Print "text2 ", LenB(StrConv(Text2.Text, vbFromUnicode))
'添加广告词
Text2.Locked = False
List1.AddItem Text2.Text
End Sub



Private Sub CmdDel_Click()
'删除广告词，注意：在这里会删除所有的广告词，有兴趣的话可以把它改为删除当前广告词
Debug.Print List1.ListIndex
List1.Clear
End Sub

Private Sub CmdSave_Click()
Dim strAD As String
Dim i, r As Long
'计算广告词总数
Entry$ = Str(List1.ListCount)
r = WritePrivateProfileString("滚动广告条", "数量", Entry, iniPath)
For i = 0 To List1.ListCount
Debug.Print Entry
Entry$ = List1.List(i)
strAD = "广告词" + Str(i)
'把广告词保存在INI文件中。strAD是标题 Entry是内容 iniPath是INI文件路径
r = WritePrivateProfileString("滚动广告条", strAD, Entry, iniPath)
Next i

End Sub

Private Sub Form_Load()
Dim i, ADcount As Long
'设定广告词配置文件路径
iniPath$ = App.Path + "\SysSet.ini"
'读取广告词总数
ADcount = Val(GetFromINI("滚动广告条", "数量", iniPath))
Debug.Print ADcount
'循环读出所有广告词
If ADcount > 1 Then
    For i = 0 To ADcount - 1
    List1.AddItem GetFromINI("滚动广告条", "广告词" + Str(i), iniPath)
    Next i
End If

End Sub

Private Sub Text2_Change()
'由于滚动广告条的设计原理是把写有广告词的label控件放在Picture控件上，然后移动Picture。这种方法决定了广告词的长度不能超出Picture控件的长度。
'为了防止这种事情的发生，在输入广告词时就要进行检查！
If LenB(StrConv(Text2.Text, vbFromUnicode)) >= 36 Then
MsgBox "广告词过长，将无法在滚动条内完全显示。建议您把长句分段！", vbInformation, "警告"
Text2.Locked = True
End If
Debug.Print LenB(StrConv(Text2.Text, vbFromUnicode))
End Sub