About GetBitmapBits and SetBitmapBits

[Tec-Nico]

Hello there again, guys...

I am still trying the zoom thing, but I cannot get this thing to work. I use GetBitMapBits and it gets an array of Bytes corresponding to the picture given. Now I tried to get a part of that array and display it. So far so good...

When I give the default values (It is the Picture's Width and the Picture's Height) it shows the Picture as it is (Perfect) But if I give other values it simply shows a black background instead of the piece of the picture...

Please check this code... Thanks in advance:

'--- Code in BmpModule ---
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
 
Public StartPosX As Single
Public StartPosY As Single
Public EndPosX As Single
Public EndPosY As Single
 
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
 
Public Sub GetPart(Picture1 As PictureBox, Picture2 As PictureBox)
Dim bmWidth As Long
Dim bmHeight As Long
Dim bmSize As Long
Dim NewbmSize As Long
Dim bmBits() As Byte
 
Dim bmZoomWidth As Long
Dim bmZoomHeight As Long
 
'Get picture's Width and Height
bmWidth = Picture1.Width
bmHeight = Picture1.Height
 
bmZoomWidth = EndPosX - StartPosX
bmZoomHeight = EndPosY - StartPosY
 
'ReDefine Bit array to hold all pixels from picture box
ReDim Bits(0 To bmWidth - 1, 0 To bmHeight - 1) As Byte
'ReDim BitsZoom(0 To bmZoomWidth - 1, 0 To bmZoomHeight - 1) As Byte
ReDim BitsZoom(StartPosX To EndPosX - 1, StartPosY To EndPosY - 1) As Byte
 
'Store size of bitmap in total pixels
bmSize = bmWidth * bmHeight
 
'Grab picture's pixels and load to Bit array
GetBitmapBits Picture1.Image, bmSize, Bits(0, 0)
    
'Get Bits Selected
Dim Y As Long
Dim X As Long
 
For Y = StartPosY To EndPosY - 1
 For X = StartPosX To EndPosX - 1
  BitsZoom(X - StartPosX, Y - StartPosY) = Bits(X, Y)
 Next X
Next Y
 
'Load Bit array to picture box
Picture2.Width = bmZoomWidth
Picture2.Height = bmZoomHeight
 
NewbmSize = bmZoomWidth * bmZoomHeight
 
SetBitmapBits Picture2.Image, NewbmSize, BitsZoom(0, 0)
 
'Redraw
Picture2.Refresh
End Sub
 
'--- Form's Code ---
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
StartPosX = X
StartPosY = Y
 
'The Shape thing is to provide a sensation of selection
With Shape1
 .Left = X
 .Top = Y
 .Width = 0
 .Height = 0
 .BorderStyle = 5
 .Visible = True
 .Tag = ""
End With
End Sub
 
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
With Shape1
 If Shape1.Visible = True And .Tag = "" Then
  .Width = Abs(StartPosX - X)
  .Height = Abs(StartPosY - Y)
 End If
End With
End Sub
 
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
EndPosX = X
EndPosY = Y
Shape1.Tag = "Selected"
End Sub
 
Private Sub CmdCopyAll_Click()
StartPosY = 0
EndPosY = Picture1.Height
StartPosX = 0
EndPosX = Picture1.Width
 
GetPart Picture1, Picture2
End Sub
 
Private Sub CmdGetPart_Click()
If Shape1.Visible = False Then
 StartPosY = 0
 EndPosY = Picture1.Height
 StartPosX = 0
 EndPosX = Picture1.Width
Else
 Shape1.Visible = False
End If
 
Me.MousePointer = vbHourglass
GetPart Picture1, Picture2
Me.MousePointer = vbDefault
End Sub

[Tec-Nico]

Guys, to check my code please copy the first part to a module and the rest to a form with the following controls:

1.- 2 PictureBoxes One named "Picture1" and the other "Picture2"
2.- 1 Shape named "Shape1" which border can be dotted. It is just to show the "Selection"
3.- 2 Command Buttons named "CmdGetPart" and named "CmdCopyAll"

The Form's code strarts from where I put the following header:

'--- Form's Code ---