VB娓告垙鏀荤暐锛嶅钩闈㈤瓟鏂规父鎴
鍙戝竷: 2008-7-15 14:39 | 浣滆: 缃戠粶杞浇 | 鏉ユ簮: 缃戠粶杞浇 | 鏌ョ湅: 49娆
缂栧啓杩欎釜绋嬪簭鍦ㄦ妧鏈笂娌℃湁浠涔堥毦鐐癸紝鍏抽敭鐨勫湴鏂规槸鍦ㄦ暟鎹畻娉曡璁′笂锛屽鍦ㄦ柟鏍间腑闅忔満濉厖棰滆壊鐨勭畻娉曡璁′腑锛屾垜寮濮嬫槸鐢ㄦ暟缁勬潵杩涜璁捐锛岀粨鏋滃彂鐜扮畻娉曟湁鐐瑰鏉傦紝浠g爜鏈夌偣闀匡紝鍚庢潵鏀圭敤闆嗗悎瀵硅薄锛岀畻娉曞氨澶уぇ绠鍗曟槑浜嗕簡銆
銆銆闂茶瘽灏戣锛岀幇鍦ㄦ垜浠氨寮濮嬬紪绋嬨傞鍏堟墦寮VB锛屾柊寤轰竴涓爣鍑嗗伐绋嬶紝鍦╢orm1涓婃坊鍔犱竴涓猵icturebox鎺т欢锛岃缃畃icture1鐨刟utoredraw灞炴т负true锛岀劧鍚庡垏鎹㈠埌浠g爜缂栬緫妗嗘坊鍔犲涓嬩唬鐮:
'瀹氫箟x1銆亂1涓哄叏灞鍙橀噺锛岀敤鏉ヨ〃绀洪紶鏍囨寜涓嬫椂鐨勫潗鏍
Dim x1 As Integer
Dim y1 As Integer
'瀹氫箟fill_color杩囩▼锛屽湪5*5鐨勬柟鏍间腑闅忔満濉厖棰滆壊
Sub fill_color()
Dim color As Integer
Dim color_col As New Collection '瀹氫箟涓涓泦鍚堝彉閲
'鍦ㄩ泦鍚堜腑瑁呰浇5绉嶉鑹
For i = 0 To 24
color_col.Add Int(i / 5)锛 Str(i)
Next i
'鍦ㄦ柟鏍间腑濉厖棰滆壊
j = 0
For n = 0 To 4
For m = 1 To 5
Randomize
X = Int((25 - j) * Rnd() + 1)
color = color_col.Item(X)
Picture1.Line (n锛 m)-(n + 1锛 m - 1)锛 QBColor(color)锛 BF
color_col.Remove (X)
j = j + 1
Next m
Next n
End Sub
'瀹氫箟draw杩囩▼锛岀敾杈规涓虹櫧鑹茬殑鏂规牸
Sub draw()
For n = 0 To 5
Picture1.Line (0锛 n)-(5锛 n)锛 QBColor(15)
Picture1.Line (n锛 0)-(n锛 5)锛 QBColor(15)
Next n
End Sub
Private Sub Form_Activate()
fill_color
draw
End Sub
Private Sub Form_Load()
Picture1.Scale (0锛 5)-(5锛 0)
End Sub
Private Sub Picture1_MouseDown(Button As Integer锛 Shift As Integer锛 X As Single锛 Y As Single)
x1 = Int(X)
y1 = Int(Y)
Picture1.MousePointer = 14
End Sub
Private Sub Picture1_MouseUp(Button As Integer锛 Shift As Integer锛 X As Single锛 Y As Single)
Dim color1(4) As Long
Dim x2 As Integer
Dim y2 As Integer
x2 = Int(X)
y2 = Int(Y)
If y1 = y2 Then
For n = 0 To 4
color1(n) = Picture1.Point(n + 0.5锛 y2 + 0.5)
Next n
a = x2 - x1
For n = 0 To 4
If n - a <= 4 And n - a >= 0 Then
z = n - a
Else
z = Abs(5 - Abs(n - a))
End If
Picture1.Line (n锛 y2 + 1)-(n + 1锛 y2)锛 color1(z)锛 BF
Next n
Else
If x1 = x2 Then
For n = 0 To 4
color1(n) = Picture1.Point(x2 + 0.5锛 n + 0.5)
Next n
a = y2 - y1
For n = 0 To 4
If n - a <= 4 And n - a >= 0 Then
z = n - a
Else
z = Abs(5 - Abs(n - a))
End If
Picture1.Line (x2 + 1锛 n)-(x2锛 n + 1)锛 color1(z)锛 BF
Next n
Else
MsgBox "浣犵殑绉诲姩鏃犳晥"锛 锛 "璀﹀憡"
End If
End If
draw
Picture1.MousePointer = vbDefault
End Sub
銆銆绋嬪簭姣旇緝绠鍗曪紝澶у涓瀹氬緢瀹规槗鐪嬫噦锛岃繖涓▼搴忕殑鏂规牸鎴戜滑涔熷彲浠ユ敼鎴6*6銆7*7绛夌瓑锛屼絾鐜╄捣鏉ョ殑闅惧害鍙兘浼氬ぇ澶у鍔狅紝灏辨槸杩欎釜5*5鏂规牸鐨勬父鎴忥紝鎴戞湁鏃跺欓兘寰堥毦鐜╅氥
鏈▼搴忓湪VB6.0+ Windows Me涓嬭皟璇曢氳繃銆




发表于 2009-1-5 19:48
| 











