Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.basic.visual.misc > #1754

Re: Problem with loading a 256 color bitmap (using the hard way)

Show all headers | View raw

Am 23.03.2013 01:18, schrieb Paulo:

> My prototype is an atempt to automate the analysis by tracing the
> bitmaps and output different color markers into the bitmaps and
> display them. This task will be easier in paletted bitmaps.

Nope, not from my experience - it's easier to code and
perform a fast Image-Analysis on 32bpp-Bitmaps, represented
in a normal 2D-VB-Long-Array (each Pixel represented by
a 32Bit Long-Value). Especially when your Bitmaps are
smaller ones (only 640x480), then it's no large performance-
hog, when you "blow them up" to 32Bit.
After that, the Palette-Handling is not necessary anymore,
since each 2D-Array now contains direct Color-Values - and you
will also not have to deal with any "Scanline-Padding-issues"
anymore.

> So, actually, I need to split every bitmap in parts, perform
> tracing, analysis, TextOut, display and store in sql database
> both text and  graphics in 16 colors, perhaps.

As said, I would load your 256-Color Bitmaps as 32Bit ones
into 640x480 2D-Long-Arrays (or into a 2D-BGRQuad-Array, in
case you need direct access to the different Color-Channels
in your analysis- or tracing-routines and not just the "Color
of entire Pixels").

You can render directly from such a 2D-Array onto any hDC
(e.g. against a PictureBox-hDC) - then Overlay your TextOuts
against the same PictureBox (using normal VB-Print).

And for efficient storage, you could compress the 32Bit-
Array losless into *.png Format - or just use ZLib against
the 32Bit 2D-Array-Buffer and write this proprietary compressed
Format as Blob into the DB.

The compression should work well, despite the 32Bit per Pixel,
since such a blown up 256-Color image still contains only
256 Colors inside - so the compressor will shrink every
"blown up Bit away" again, without larger inefficiencies,
compared with the compression of e.g. the original 8Bit-Image.

If you don't bother shipping a (free) COM-lib with your Project,
then there'd be very good support for all the outlined tasks
already available (including png-compression of such 32Bit-
Buffers directly into VB-ByteArrays, fast Color-Manipulation-
functions, Gamma-Correction-stuff, blurring, sharpening...).

Anyways, here comes "plain VB-Code" - but I've omitted the
Png-Compression-stuff:

'***Into a Form, then Click the Form
Option Explicit

Private Declare Function GetDIBits& Lib "gdi32" (ByVal aHDC&, _
   ByVal hBM&, ByVal nStartSL&, ByVal nNumSL&, lpBits As Any, _
   lpBI As Any, ByVal wUsage&)
Private Declare Function GetDC& Lib "user32" (ByVal hWnd&)
Private Declare Function StretchDIBits& Lib "gdi32" (ByVal hDC&, _
   ByVal x&, ByVal y&, ByVal dx&, ByVal dy&, ByVal SrcX&, ByVal SrcY&, _
   ByVal Srcdx&, ByVal Srcdy&, lpBits As Any, lpBitsInfo As Any, ByVal _
   wUsage&, ByVal dwRop&)
Private Declare Function ReleaseDC& Lib "user32" (ByVal hWnd&, ByVal DC&)

Private Type BGRQuad
   B As Byte
   G As Byte
   R As Byte
   A As Byte
End Type

Private Sub Form_Click()
   ScaleMode = vbPixels 'to work with the Form-Container in Pixelspace

   Dim Arr() As BGRQuad

   'retrieve the 32Bit-Array directly from a StdPic
   GetArrFromHdl Arr, Load_BMP256("D:\8bpp.bmp")

   'demonstrate a simple Pixel-Looping-Manipulation
   SetRedChannelToMaximum Arr

   'Draw to any hDC directly from the Array
   DrawArr Arr, Me.hDC

   'Show TextOverlay "On-Screen"
   Me.FontName = "Arial": Me.FontSize = 22
   Me.CurrentX = 10: Me.CurrentY = 10
   Me.Print "OnScreen-TextOverlay"

   'Compress the Array in PNG-Format directly into Memory
   '... left as an exercise <g>
End Sub

Private Sub SetRedChannelToMaximum(Arr() As BGRQuad)
Dim x As Long, y As Long
   For y = 0 To UBound(Arr, 2)
     For x = 0 To UBound(Arr, 1)
       With Arr(x, y)
         '.B = 0
         '.G = 0
         .R = 255
       End With
     Next x
   Next y
End Sub

Private Sub GetArrFromHdl(P() As BGRQuad, ByVal Hdl&)
Dim BI&(9), TheDC&
   TheDC = GetDC(0): ReDim P(0, 0): BI(0) = 40
   GetDIBits TheDC, Hdl, 0, 0, ByVal 0&, BI(0), 0
   If BI(1) = 0 Or BI(2) = 0 Then ReleaseDC 0, TheDC: Exit Sub
   BI(3) = 1 + 65536 * 32: BI(4) = 0
   ReDim P(BI(1) - 1, BI(2) - 1): BI(2) = -BI(2)
   GetDIBits TheDC, Hdl, 0, -BI(2), P(0, 0), BI(0), 0
   ReleaseDC 0, TheDC
End Sub

Private Sub DrawArr(P() As BGRQuad, DC&)
Dim BI&(9), W&, H&
   On Error Resume Next
   W = UBound(P, 1) + 1: H = UBound(P, 2) + 1
   If W = 0 Or H = 0 Then Err.Clear: Exit Sub
   BI(0) = 40: BI(1) = W: BI(2) = -H: BI(3) = 1 + 65536 * 32 '32bpp
   StretchDIBits DC, 0, 0, W, H, 0, 0, W, H, P(0, 0), BI(0), 0, vbSrcCopy
End Sub

Function Load_BMP256(ByVal FileName As String) As IPictureDisp
Dim FNr&, FLen&, BMSig As String * 2, BMSize&, BMBits%

   FileName = Trim$(FileName)
   FLen = FileLen(FileName)

   FNr = FreeFile
   Open FileName For Binary Access Read As FNr
     Get FNr, , BMSig
     Get FNr, , BMSize
     Get FNr, 29, BMBits
   Close FNr

   'Check for the file type signature 'BM':
   If BMSig <> "BM" Then Err.Raise 321& 'Invalid FileFormat

   'Confirm file size:
   If BMSize <> FLen Then Err.Raise 321& 'Invalid FileFormat

   'Check for valid bits per pixel:
   Select Case BMBits
     Case 1, 4, 16, 24, 32
     Err.Raise vbObjectError + 1, , "The application does not support " _
                                  & BMBits & "-bit bitmaps"
   End Select

   Set Load_BMP256 = LoadPicture(FileName)
End Function

Olaf

Back to comp.lang.basic.visual.misc | Previous | Next — Previous in thread | Next in thread | Find similar | Unroll thread

Thread

Problem with loading a 256 color bitmap (using the hard way) "Paulo" <pmpcosta.nospam@netcabo.pt> - 2013-03-22 14:44 +0000
  Re: Problem with loading a 256 color bitmap (using the hard way) Schmidt <ng@vbRichClient.com> - 2013-03-22 23:55 +0100
    Re: Problem with loading a 256 color bitmap (using the hard way) "Paulo" <nospam.vbstudent@syscolor.net> - 2013-03-23 00:18 +0000
      Re: Problem with loading a 256 color bitmap (using the hard way) Schmidt <ng@vbRichClient.com> - 2013-03-23 04:21 +0100
        Re: Problem with loading a 256 color bitmap (using the hard way) "Paulo" <nospam.vbstudent@syscolor.net> - 2013-03-23 21:11 +0000

csiph-web