strongm's suggestion is the most convenient method for most tasks. For learning purposes I'm posting code from an old voxel landscape renderer that copies the base address of the bitmap bits to the address of an array so you can access them like pict(x,y) or pict(x) if you use a one dimensional array.
This may not be too friendly at first but the reason I'm mentioning it is that it is much better faster for image processing especially with 24 bit bmps because you usually need to work with RGB values. If you're using a memory DC then you need to convert the long value to its RGB components, do the manipulation, and then conver it back. This is also a faster when working with large chunks of the bitmap because copying is faster. I converted this code to use 24 bit bmps in just a few minutes a couple years back. If you decide to do this you will need to read up on the bitmap format. That's why I said it was for learning purposes
If you are doing manipulation you would probably be much happier with the speed.
Option Explicit
Private Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type
Private Type SAFEARRAY1D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
Bounds(0 To 0) As SAFEARRAYBOUND
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 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)
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 Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Const SCREEN_WIDTH = 319
Private Const SCREEN_HEIGHT = 239
Private Const MAX_STEPS = 300
Dim x_ray As Double, y_ray As Double, z_ray As Double
Dim vp_x As Double, vp_y As Double, vp_z As Double
Dim vp_ang_x As Double, xr As Double, yr As Double
Dim curr_row As Integer, curr_step As Integer, curr_voxel_scale As Double
Dim dslope As Double, raycast_ang As Integer
Dim column_height As Double, color As Byte
Dim mx As Integer, my As Integer
Dim exitflag As Boolean
Dim dx As Double, dy As Double, dz As Double
Sub DrawFrame()
'***********************************
' Setup the bitmaps so we can
' get to their memory
'***********************************
' these are used to address the pixel using matrices
Dim pict() As Byte
Dim pict2() As Byte
Dim pict3() As Byte
Dim sa As SAFEARRAY2D, bmp As BITMAP
Dim sa2 As SAFEARRAY2D, bmp2 As BITMAP
Dim sa3 As SAFEARRAY2D, bmp3 As BITMAP
Dim r As Integer, c As Integer
' get bitmap info
GetObjectAPI Pic.Picture, Len(bmp), bmp 'picture
GetObjectAPI Pictxt.Picture, Len(bmp2), bmp2 'texture
GetObjectAPI Pichgt.Picture, Len(bmp3), bmp3 'height map
' exit if not a supported bitmap
If bmp.bmBitsPixel <> 8 Then
MsgBox " 8-bit bitmaps only", 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
' have the local matrix point to bitmap pixels
With sa2
.cbElements = 1
.cDims = 2
.Bounds(0).lLbound = 0
.Bounds(0).cElements = bmp2.bmHeight
.Bounds(1).lLbound = 0
.Bounds(1).cElements = bmp2.bmWidthBytes
.pvData = bmp2.bmBits
End With
CopyMemory ByVal VarPtrArray(pict2), VarPtr(sa2), 4
' have the local matrix point to bitmap pixels
With sa3
.cbElements = 1
.cDims = 2
.Bounds(0).lLbound = 0
.Bounds(0).cElements = bmp3.bmHeight
.Bounds(1).lLbound = 0
.Bounds(1).cElements = bmp3.bmWidthBytes
.pvData = bmp3.bmBits
End With
CopyMemory ByVal VarPtrArray(pict3), VarPtr(sa3), 4
'***********************************
' Here is where we draw a frame
'***********************************
For c = 0 To 319
For r = 0 To 239
pict(c, r) = 0
Next
Next
'**********************************************************
'Thanks to Andre' LaMothe for the C source code this Voxel
'demonstration is based on. David Brebner 24/1/98
'**********************************************************
For c = 0 To SCREEN_WIDTH 'cast a ray for each column of the screen
' seed starting point for cast
x_ray = vp_x
y_ray = vp_y
z_ray = vp_z
' compute deltas to project ray at, note the spherical cancelation factor
dx = Cos((raycast_ang + c) / 360)
dy = Sin((raycast_ang + c) / 360)
' dz is a bit complex, remember dz is the slope of the ray we are casting
' therefore, we need to take into consideration the down angle, or
' x axis angle, the more we are looking down the larger the intial dz
' must be
dz = dslope * -100
' reset current voxel scale
curr_voxel_scale = 0
' reset row
curr_row = 0
For curr_step = 0 To MAX_STEPS ' enter into casting loop
xr = x_ray And 511 'trim
yr = y_ray And 511 'trim
' get current height in height map
' and the added multiplication factor used to scale the mountains
column_height = pict3(xr, yr) '* 2
'test if column height is greater than current voxel height for current step
'from intial projection point
If column_height > z_ray Then
' we know that we have intersected a voxel column, therefore we must
' render it until we have drawn enough pixels on the display such that
' thier projection would be correct for the height of this voxel column
' or until we have reached the top of the screen
' get the color for the voxel
color = pict2(xr, yr)
' draw vertical column voxel
Do
' draw a pixel
pict(c, curr_row) = color
' now we need to push the ray upward on z axis, so increment the slope
dz = dz + dslope
' now translate the current z position of the ray by the current voxel
' scale per unit
z_ray = z_ray + curr_voxel_scale
' test if we are done with column
curr_row = curr_row + 1
If (curr_row >= 239) Then
' force exit of outer steping loop
curr_step = MAX_STEPS
Exit Do
End If
Loop Until z_ray > column_height
End If
' update the position of the ray
x_ray = x_ray + dx
y_ray = y_ray + dy
z_ray = z_ray + dz
' update the current voxel scale, remember each step out means the scale increases
' by the delta scale
curr_voxel_scale = curr_voxel_scale + dslope * 0.5
Next
Next
'***********************************
' Clean up the bitmaps
'***********************************
' clear the temporary array descriptor
' without destroying the local temporary array
CopyMemory ByVal VarPtrArray(pict), 0&, 4
CopyMemory ByVal VarPtrArray(pict2), 0&, 4
CopyMemory ByVal VarPtrArray(pict3), 0&, 4
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyQ
vp_y = vp_y + 10
Case vbKeyA
vp_y = vp_y - 10
Case vbKeyZ
vp_x = vp_x + 10
Case vbKeyX
vp_x = vp_x - 10
Case vbKeyW
vp_z = vp_z + 10
Case vbKeyS
vp_z = vp_z - 10
Case vbKeyE
dslope = dslope + 0.005
Case vbKeyD
dslope = dslope - 0.005
Case vbKeyC
raycast_ang = raycast_ang + 30
Case vbKeyV
raycast_ang = raycast_ang - 30
End Select
End Sub
Private Sub Form_Load()
'Pic.Picture = LoadPicture(App.Path & "\title.gif"
'Pictxt.Picture = LoadPicture(App.Path & "\texture.gif"
Pichgt.Picture = LoadPicture(App.Path & "\height.gif"
'set up the default starting positions
vp_z = 500: vp_x = 200: vp_y = 200
dslope = 0.05
raycast_ang = 100
End Sub
Private Sub Form_Unload(Cancel As Integer)
exitflag = True
End Sub
Private Sub Pic_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'get the mouse position so you can fly in the correct direction
mx = X
my = Y
End Sub
Private Sub Timer1_Timer()
'This timer is only designed to go off once when the program
'first starts. After that it is disabled, and the tight
'animation loop begins.
Dim u%
Timer1.Enabled = 0
'start the voxel rendering
Do
'reposition based on mouse
vp_x = vp_x - (mx - (Pic.ScaleWidth / 2)) / 10
vp_y = vp_y - (my - (Pic.ScaleHeight / 2)) / 10
'redraw the frame
DrawFrame
Pic.Refresh
'wait for user input
u% = DoEvents
Loop Until exitflag
End Sub
