VB 6 and graphics

[ashvn]

Hi
I'm trying to make some kind of graphics effects using a picture box, the pset and point functions, and a pixel scalemode. However, since I have to calculate the color value for each and every pixel of the picture box, things go very slowly. Is there a way to accelerate things? Or better still, are there other ways for 'painting' pixel graphics?

Thanks a lot for the help !
: )

 

[sunaj]

Yes.

You can speed up things by using the win32 API dringing functions. There are many. To set a pixel use:
Public Declare Function SetPixelV Lib "gdi32.dll" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long

But by far the fastest way it to copy the image into memory and manipulated the data by treating it as an array of bytes. I can give you an example of that is you are interested.

Sunaj
'The gap between theory and practice is not as wide in theory as it is in practice'

 

[ashvn]

Sure !! Send me your example !
I'll try the function call in the meantime.
Thanks a lot Sunaj!

 

[sunaj]

Place a picture box & a command button on a form and paste the following code.
Set the picture property to a 256 color bitmap. The code only works with 256 color bitmaps because they have exactly one byte per pixel and the pict array is declared as () byte.

The code perfors a mercator projection, which is only relevant for world maps, but your can manipulate the pixles in the array according to your needs.

-----------------------------------------------------------
Option Explicit

Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type

Private Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type

Private Type SAFEARRAY2D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
Bounds(0 To 1) As SAFEARRAYBOUND
End Type

Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Const pi = 3.1415926

Public Sub Mercator(pic As PictureBox)
' these are used to address the pixel using matrices
Dim pict() As Byte
Dim sa As SAFEARRAY2D, bmp As BITMAP
Dim dx As Integer, dy As Integer, value As Byte
Dim sy As Integer, sx As Integer, t As Long
Dim L As Double, ML As Double
Dim HalfPi As Double, InvPi As Double, NegPiDivt As Double

' get bitmap info
GetObjectAPI pic.Picture, Len(bmp), bmp
' exit if not a supported bitmap
If bmp.bmPlanes <> 1 Or bmp.bmBitsPixel <> 8 Then
MsgBox &quot; 256-color bitmaps only&quot;, vbCritical
Exit Sub
End If
' have the local matrix point to bitmap pixels
With sa
.cbElements = 1
.cDims = 2
.Bounds(0).lLbound = 0
.Bounds(0).cElements = bmp.bmHeight
.Bounds(1).lLbound = 0
.Bounds(1).cElements = _
bmp.bmWidthBytes
.pvData = bmp.bmBits
End With
CopyMemory ByVal VarPtrArray(pict), VarPtr(sa), 4
'The image is now inside the pict array. Loop through the array and do what you want to do..
'Here I use a mercator projection of the image (to use with lat-lon world maps)
'New Image Scale
t = UBound(pict, 2) + 1
HalfPi = pi / 2
InvPi = 1 / pi
NegPiDivt = -pi / t
For dx = UBound(pict, 1) To 0 Step -1
For dy = UBound(pict, 2) To UBound(pict, 2) / 2 Step -1
ML = NegPiDivt * dy + HalfPi
L = 2 * Atn(Exp(ML)) - HalfPi
sy = t * (0.5 - L * InvPi)
pict(dx, dy) = pict(dx, sy)
Next
For dy = 0 To UBound(pict, 2) / 2
ML = NegPiDivt * dy + HalfPi
L = 2 * Atn(Exp(ML)) - HalfPi
sy = t * (0.5 - L * InvPi)
pict(dx, dy) = pict(dx, sy)
Next
Next
' clear the temporary array descriptor
' without destroying the local temporary array
CopyMemory ByVal VarPtrArray(pict), 0&, 4
' inform VB that something has changed
pic.Refresh
End Sub
Private Sub Command1_Click()
Mercator Picture1
End Sub
----------------------------------------------------------
Sunaj
'The gap between theory and practice is not as wide in theory as it is in practice'

 

[Guest_imported]

How to create a game?
Need some tips!!

 

[nofear]

Ideas on starting a vb game.
Tips and tricks about anything.

 

[ashvn]

Sunaj, just one more thing:
how do I change the color of pixels while looping through the pict array ?
Thanks again !

 

[sunaj]

Hi,

You set the color of a pixel by simply setting the value of the byte.
The colors are defined in a 1024 byte palette after the bitmap header (see e.g.

http://www.brackeen.com/home/vga/bitmaps.html).

Sunaj
'The gap between theory and practice is not as wide in theory as it is in practice'