Encore un problème de tableau ...

Question

Bonjours, dans le cadre de la conception d'un moteur 2D, j'ai une question a vous poser. D'abord, la situation : -J'ai un tableau qui contient toute mes données ( couleur de pixel ) -> C'est un tableau à 3 dimensions : bArray(1 To 4, 1 To Pic.Width, 1 To Pic.Height) ou Pic est le controle PictureBox où je fais mon rendu. -J'ai un second tableau qui contient une texture : TexBitArray(1 To 4, 1 To TexPicture.Width, 1 To TexPicture.Height) où TexPicture est le pictureBox qui contient ma texture. J'ai chargé l'image dans mon second tableau, il n'y a aucune problème. ( Call GetDIBits(TexPicture.hdc, TexPicture.Image, 0, TexPicture.ScaleHeight, TexBitArray(1, 1, 1), TexInfo, DIB_RGB_COLORS) ) Mais je voudrais copier TexBitArray à une certaine place de bArray pour mettre ma texture dans le tableau principale. J'ai un code qui marche mais il est trop lent ( voir le code à la fin ) et je n'arrive pas à recopier le tableau qui contient ma texture dans le tableau principale grace à GetDIBits. J'epère avoir été assez claire. Voici mon code :

Sub LoadTex(TexPath As String, ByVal iX As Single, ByVal iY As Single, Height As Long, Width As Long) Dim TexInfo As BITMAPINFO Dim TexBitArray() As Byte Dim iXBuffer As Single Dim iYBuffer As Single Dim RealY As Single TexPicture.Picture = LoadPicture(TexPath) If Height <> 0 Or Width <> 0 Then If TexPicture.Height <> Height Or TexPicture.Width <> Width Then TexPicture.Height = Height TexPicture.Width = Width StretchBlt TexPicture.hdc, 0, 0, Width, Height, TexPicture.hdc, 0, 0, TexPicture.Width, TexPicture.Height, vbSrcCopy End If End If TexInfo.bmiHeader.biSize = Len(TexInfo.bmiHeader) TexInfo.bmiHeader.biWidth = TexPicture.Width TexInfo.bmiHeader.biHeight = TexPicture.Height TexInfo.bmiHeader.biPlanes = 1 TexInfo.bmiHeader.biBitCount = 32 TexInfo.bmiHeader.biCompression = BI_RGB ReDim TexBitArray(1 To 4, 1 To TexPicture.Width, 1 To TexPicture.Height) Call GetDIBits(TexPicture.hdc, TexPicture.Image, 0, TexPicture.ScaleHeight, TexBitArray(1, 1, 1), TexInfo, DIB_RGB_COLORS) RealY = GetRealY(iY) - TexPicture.Height iXBuffer = 1 iYBuffer = 1 If iX = 0 Then iX = 1 End If If iY = 0 Then iY = 1 End If Do Do bArray(Red, iX, RealY) = TexBitArray(Red, iXBuffer, iYBuffer) bArray(Green, iX, RealY) = TexBitArray(Green, iXBuffer, iYBuffer) bArray(Blue, iX, RealY) = TexBitArray(Blue, iXBuffer, iYBuffer) iYBuffer = iYBuffer + 1 RealY = RealY + 1 If RealY >= Pic.Height Then Exit Sub End If Loop Until iYBuffer >= TexInfo.bmiHeader.biHeight If iX >= Pic.Width Then Exit Sub End If iYBuffer = 1 iXBuffer = iXBuffer + 1 iX = iX + 1 RealY = GetRealY(iY) - TexPicture.Height Loop Until iXBuffer >= TexInfo.bmiHeader.biWidth End Sub

Merci d'avance ! -=Ar$£nik=-

cs_rt15 · Answer

En générale, l'API windows est plus rapide que ce qu'ont peut essayer de faire par nous même en VB.

Pour ton moteur, tu peux simplement utiliser des routines de l'API, par exemple BitBlt, qui copie un rectangle d'un hdc dans un autre. Sinon, il y a aussi PlgBlt qu'est pas mal, pour les rotations nottement. Et il y en à une autre que j'ai jamais réussi à utiliser, (MaskBlt ou quelque chose comme ça), qui est sensé copier en fonction d'un mask, et qui permet donc des copies par parties (PlgBlt le fait aussi: elle est vraiment bien.). Mais pour les Mask, il faut faire les mask soit même (Bmp noir et blanc) ou les générer à partir des fichiers de base (Je suis pas sûr que ce soit possible en VB).

Désolé de faire ma pub, mais pour un moteur 2D sans DirectX :
http://www.vbfrance.com/code.aspx?ID=32268

Encore un problème de tableau ...

1 réponse

Discussions similaires