دوستان امروز میخوام یه کد با حال ویژوال بیسیک پروژه ۸ وزیر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

تا پست بعدی همه شما رو به خدا می سپارم .

اگه برنامه ای رو خواستید یا مطلبی چیزی می تونید تو بخش نظرات بنویسید تا براتون بزارم .