VB程序问题

分类: 电脑/网络 >>程序设计 >>其他编程语言

问题描述:

标题： 谁帮我做个数字时钟的代码，谢谢，急！！

内容： 6点之前要交作业的，谁帮帮我。

解析:

数字时钟：

设置Timer的Interval值为1000

Private Sub Timer1_Timer()

Label1 = Time()

End Sub

下面是网上找的指针时钟的，你可以参考

'/

'小闹钟示例

'Written By griefforyou

'在窗体中添加一个Timer控件，将Interval设为1000以下。

'

Option Explicit

Const PI = 3.1415926

Dim BaseX As Integer, BaseY As Integer, R As Integer

Dim r1 As Integer, r2 As Integer, r3 As Integer

Private Sub Form_Load()

Me.ScaleMode = 3

Me.AutoRedraw = True

If Me.Width <3000 Then Me.Width = 3000

If Me.Height <3000 Then Me.Height = 3000

End Sub

Private Sub Init()

Dim i As Integer

BaseX = Me.ScaleWidth / 2

BaseY = Me.ScaleHeight / 2

R = IIf(BaseX >BaseY, BaseY * 0.8, BaseY * 0.8)

r1 = R * 0.2

r2 = R * 0.1

r3 = R * 0.05

For i = 0 To 360 Step 6

If i Mod 30 = 0 Then '时

Me.DrawWidth = 2

DrawLine BaseX + (R - 3) * Sin(i * PI / 180), BaseY - (R - 3) * Cos(i * PI / 180), BaseX + (R - 8) * Sin(i * PI / 180), BaseY - (R - 8) * Cos(i * PI / 180), 3

Else '分

Me.DrawWidth = 2

Me.PSet (BaseX + (R - 3) * Sin(i * PI / 180), BaseY - (R - 3) * Cos(i * PI / 180))

End If

Next

Me.DrawWidth = 1

Me.Circle (BaseX, BaseY), R

End Sub

'绘制指针

Private Sub DrawClock()

Dim Second As Integer

Dim Minute As Integer

Dim Hours As Integer

Second = DatePart("s", Time)

Minute = DatePart("n", Time)

Hours = DatePart("h", Time)

If Hours >12 Then

Hours = Hours - 12

End If

Me.DrawWidth = 1

Me.Circle (BaseX, BaseY), 4

DrawLine BaseX - r1 * Sin(Second * PI / 30), BaseY + r1 * Cos(Second * PI / 30), BaseX + (R - 10) * Sin(Second * PI / 30), BaseY - (R - 10) * Cos(Second * PI / 30), 0

DrawLine BaseX - r2 * Sin(Minute * PI / 30), BaseY + r2 * Cos(Minute * PI / 30), BaseX + R * 0.8 * Sin(Minute * PI / 30), BaseY - R * 0.8 * Cos(Minute * PI / 30), 1

DrawLine BaseX - r3 * Sin((Hours + Minute / 60) * PI / 6), BaseY + r3 * Cos((Hours + Minute / 60) * PI / 6), BaseX + R * 0.6 * Sin((Hours + Minute / 60) * PI / 6), BaseY - R * 0.6 * Cos((Hours + Minute / 60) * PI / 6), 2

End Sub

'画线函数

Private Sub DrawLine(x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, Flag As Integer)

Static OldSX1 As Integer, OldSX2 As Integer, OldSY1 As Integer, OldSY2 As Integer

Static OldMX1 As Integer, OldMX2 As Integer, OldMY1 As Integer, OldMY2 As Integer

Static OldHX1 As Integer, OldHX2 As Integer, OldHY1 As Integer, OldHY2 As Integer

Select Case Flag

Case 0

Me.DrawWidth = 1

Me.Line (OldSX1, OldSY1)-(OldSX2, OldSY2), Me.BackColor

Me.Line (x1, y1)-(x2, y2)

OldSX1 = x1

OldSX2 = x2

OldSY1 = y1

OldSY2 = y2

Case 1

Me.DrawWidth = 2

Me.Line (OldMX1, OldMY1)-(OldMX2, OldMY2), Me.BackColor

Me.Line (x1, y1)-(x2, y2)

OldMX1 = x1

OldMX2 = x2

OldMY1 = y1

OldMY2 = y2

Case 2

Me.DrawWidth = 3

Me.Line (OldHX1, OldHY1)-(OldHX2, OldHY2), Me.BackColor

Me.Line (x1, y1)-(x2, y2)

OldHX1 = x1

OldHX2 = x2

OldHY1 = y1

OldHY2 = y2

Case Else

Me.Line (x1, y1)-(x2, y2)

End Select

End Sub

Private Sub Form_Resize()

Me.Cls

Call Init

End Sub

Private Sub Timer1_Timer()

Call DrawClock

End Sub

看我的BLOG

hi.baidu/yhpp521/blog/item/e13fc513ba793423dd5401d8

分类: 电脑/网络 >>程序设计 >>其他编程语言

问题描述:

大家好，我在编程时遇到了一个问题，问题就出在下面这段程序。这段程序我在调试和编译时都不报错，可是我编译完成后一运行就提示“数组下标越界”，可我怎么看都看不来为什么越界，请各位高手帮我看看，小弟不胜感激！！！

Public Function ReadFile(strFilePath As String) As String()

Dim fso As New FileSystemObject

Dim file

Dim IsFileExist As Boolean

Dim ts As TextStream

Dim strData() As String

ReDim strData(0)

IsFileExist = fso.FileExists(strFilePath)

If IsFileExist = True Then

Set file = fso.GetFile(strFilePath)

Set ts = file.OpenAsTextStream(ForReading)

While Not ts.AtEndOfStream

ReDim Preserve strData(UBound(strData) + 1)

strData(UBound(strData)) = ts.ReadLine

Wend

ts.Close

End If

ReadFile = strData

End Function

解析:

此函数应该没有错误，在WinXP sp2 + VB6 sp6下测试通过

Private Sub Command1_Click()

Dim pp() As String

Dim i As Integer

pp = ReadFile("d:\a.txt")

For i = 1 To UBound(pp)

MsgBox pp(i)

Next

End Sub

怪事儿了，我已经把以上代码放在Load里面用生成的EXE文件试过了，没有问题，你可以用我的代码试一下，如果仍有问题的话，可能是你的VB或是系统有问题了，把sp6的补丁打上，另外最好检查一下有没有在LOAD里面 *** 作数组或是Grid之类的。从前也遇到过VB这类的错误，在调试时期看不到问题，只有运行的时候才可以出现，当时无法解决，你可以重装系统或VB试下。

其实，没有必要加壳的，不过我可以给你一些建议。

1.将你VB做出来的东西做成EXE发布，由于VB的反编译具有巨大的困难=，=所以除非微软的工程师想看你的代码，基本上源代码这块是很安全的。。。

2.如果不想别人随意使用你的程序，你在Login界面做一个认证程序就OK老

步骤：a.首先在你的函数模块里弄一个加密算法，至于什么算法随你喜欢。

b.用函数算出机器码，用以认证（一机一码防止盗用）

c.自己用加密算法做一个注册软件（很小的，个人能力完全可以完成）

d.Login界面上作一个判断，注册码正确时进入软件，否则关闭

（当然你可以很邪恶的判断注册码错误时执行自动关机程序=，=...）

以上均是可以实现的，至少我自己做的程序采用过，希望能对你有所帮助

---