با سلام خدمت تک مکانیک شبهای تصادفی قلبم

سحر ناز

و همه دوستای گرامی و عزیز خودم .
دوستان امروز میخوام یه کد با حال ویژوال بیسیک پروژه ۸ وزیرFor VB eight queens رو براتون بزارم امیدوارم بتونه به دردتون بخوره .
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Const N = 8
Private Sub Command1_Click()
Dim a(N, N) As Byte
Static byCount As Byte
Me.ScaleMode = vbPixels
For m = 0 To N - 1
For j = 0 To N - 1
a(m, j) = 0
Next j
Next m
a(0, byCount) = 1
Call solve(0, a)
If (byCount < N - 1) Then
byCount = byCount + 1
Else
byCount = 0
End If
End Sub
Private Sub solve(i As Integer, a() As Byte)
Dim j As Integer
If (i = N - 1) Then
Call PrintCess(a)
Else
For j = 0 To N - 1
Dim b(N, N) As Byte
CopyMemory b(0, 0), a(0, 0), (N + 1) * (N + 1)
b(i + 1, j) = 1
If judge(b, i + 1, j) Then
Call solve(i + 1, b)
End If
Next j
End If
End Sub
Private Function judge(a() As Byte, ByVal i As Integer, ByVal j As Integer) As Boolean
Dim ii, jj As Integer
jj = j - 1
For ii = i - 1 To 0 Step -1
If (jj < 0) Then Exit For
If (a(ii, jj) = 1) Then
judge = False
Exit Function
End If
jj = jj - 1
Next ii
For ii = i - 1 To 0 Step -1
If (a(ii, j) = 1) Then
judge = False
Exit Function
End If
Next ii
jj = j + 1
For ii = i - 1 To 0 Step -1
If (jj = N) Then Exit For
If (a(ii, jj) = 1) Then
judge = False
Exit Function
End If
jj = jj + 1
Next ii
judge = True
End Function
Private Sub PrintCess(a() As Byte)
For i = 0 To N - 1
For j = 0 To N - 1
Me.FillColor = RGB(0, 0, 0)
Me.FillStyle = 0
Me.Line (30 * j + 30, 30 * i + 30)-(30 * (j + 1) + 30, 30 * (i + 1) + 30), RGB(0, 0, 255), B
If (a(i, j) = 1) Then
Me.FillColor = RGB(255, 255, 0)
Me.FillStyle = 0
Me.Circle (30 * j + 45, 30 * i + 45), 10, RGB(255, 0, 0)
Me.FillStyle = 1
End If
Next j
Next i
End Sub
تا پست بعدی همه شما رو به خدا می سپارم .
اگه برنامه ای رو خواستید یا مطلبی چیزی می تونید تو بخش نظرات بنویسید تا براتون بزارم .