Проблема с разлочиванием DirectDrawSurface

Программирование на Visual Basic, главный форум. Обсуждение тем программирования на VB 1—6.
Даже если вы плохо разбираетесь в VB и программировании вообще — тут вам помогут. В разумных пределах, конечно.
Правила форума
Темы, в которых будет сначала написано «что нужно сделать», а затем просьба «помогите», будут закрыты.
Читайте требования к создаваемым темам.
Drag
Обычный пользователь
Обычный пользователь
Аватара пользователя
 
Сообщения: 85
Зарегистрирован: 29.01.2005 (Сб) 23:54
Откуда: Москва

Проблема с разлочиванием DirectDrawSurface

Сообщение Drag » 09.01.2007 (Вт) 21:33

У меня появилась одна из самых сложных проблем, которые я когда-либо встречал - на одних компьютерах программа работает, а на других - нет. На одном компьютере все прекрасно работает, на другом либо просто вылетает вместе с VB, либо выдает ошибку Invalid Rect. Первое происходит при строке
rotateSurface ddsS(9), ddsShip(9, i), i * 5, size(6) / 4, 0, 0
А второе при
rotateSurface ddsS(9), ddsShip(9, i), i * 5, 0, 0, 0
где ddsS(9) - исходная поверхность, ddsShip(9,i) - результативныя, а i * 5 - угол поворота.
Код: Выделить всё

Public Sub InitRotation()
    Set ddsS(9) = loadDirectXSurface(App.path & "\Graphics\LaserTower.bmp")
    size(6) = GetMaxRotateSize(ddsS(9))
    Key.high = vbBlack + 5: Key.low = vbBlack
    For i = 0 to 72
        Set ddsShip(9, i) = loadDirectXSurface("", size(6), size(6))
        ddsShip(9, i).SetColorKey DDCKEY_SRCBLT, Key
        ddsShip(9, i).BltColorFill srcRect, vbBlack
        rotateSurface ddsS(9), ddsShip(9, i), i * 5, size(6) / 4, 0, 0
    Next
End Sub

Public Function GetMaxRotateSize(Surface As DirectDrawSurface7) As Long
    Dim ddsdSource As DDSURFACEDESC2
    Surface.GetSurfaceDesc ddsdSource
    GetMaxRotateSize = Sqr(ddsdSource.lWidth ^ 2 + ddsdSource.lHeight ^ 2)
End Function

Public Sub rotateSurface(ByVal surfSource As DirectDrawSurface7, surfDestination As DirectDrawSurface7, iAngle As Integer, Optional XDest As Long = 0, Optional Ydest As Long = 0, Optional Transparency As Long = -1)
  Dim ddsdSource As DDSURFACEDESC2
  Dim lngXI As Long, lngYI As Long
  Dim lngXO As Long, lngYO As Long

  Dim rEmpty As RECT
  Dim sngA As Single, SinA As Single, CosA As Single
  Dim dblRMax As Double
  Dim lngColor As Long
 
  Dim lWidth As Long, lHeight As Long

    SinA = SinC.SSin(iAngle)
    CosA = SinC.SCos(iAngle)
    sngA = iAngle * PI / 180
    surfSource.GetSurfaceDesc ddsdSource
    lWidth = ddsdSource.lWidth
    lHeight = ddsdSource.lHeight

    dblRMax = Sqr(lWidth ^ 2 + lHeight ^ 2)
     
    XDest = XDest + lWidth / 2
    Ydest = Ydest + lHeight / 2
   
    surfDestination.Lock rEmpty, ddsdSource, DDLOCK_WAIT, 0
    surfSource.Lock rEmpty, ddsdSource, DDLOCK_WAIT, 0
   
    For lngXI = -dblRMax To dblRMax
        For lngYI = -dblRMax To dblRMax     
            lngXO = lWidth / 2 - (lngXI * CosA + lngYI * SinA)
            lngYO = lHeight / 2 - (lngXI * SinA - lngYI * CosA)
            If lngXO >= 0 And lngYO >= 0 Then
                If lngXO < lWidth And lngYO < lHeight Then
                    lngColor = surfSource.GetLockedPixel(lngXO, lngYO)
                    If lngColor <> Transparency Then surfDestination.SetLockedPixel XDest + lngXI, Ydest + lngYI, lngColor
                End If
            End If
        Next
    Next
   
    surfSource.Unlock rEmpty
    surfDestination.Unlock rEmpty
End Sub

Программа соответственно либо вылетает на строке с методом SetLockedPixel, либо выдает ошибку в surfDestination.Unlock. Непонятно то, что происходит это только для одной поверхности при i = 63. Появляется такое ощущение, что у видеокарты память переполняется.

Вернуться в Visual Basic 1–6

Кто сейчас на конференции

Сейчас этот форум просматривают: YaCy [Bot] и гости: 103

    TopList