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

Groups > it.comp.lang.visual-basic > #18794

Re: Curiosità su file BMP e PDF

Show all headers | View raw

"Franz_aRTiglio ha scritto nel messaggio

> Sauro ci ha detto :
>
>> Ho già risolto ridisegnando il logo con paint però
>> mi rimane la curiosità di sapere cosa poteva
>> causare il cambio di colore.
>
> Mah... sei sicuro che fosse un vero BMP ? fagli l'autopsia con un
> hex editor e controlla le intestazioni, e' un po' che non ci "gioco"
> ma mi pare di ricordare che il "filtro" windows di importazione delle
> immagini non verifica se (esempio) un'immagine codificata in PNG
> ha estensione BMP o JPG, ovvio che se il modulo di cui parli (che
> non conosco) ammette un palette max di (sempre per esempio) 256
> colori 8 bit ma l'immagine e' in origine codificata con qualche
> palette "esotica" (es. le palette delle GIF che possono avere
> un  numero di colori semi-arbitrario)....

Non sono in grado di fare il controllo di cui parli
in quanto non conosco la struttura interna dei vari
file immagine.

Quel che posso dire è che il LoadPicture di vb6 lo
legge bene.

Di seguito riporto una funzione di quel modulo di
classe di cui parlavo.
Magari tu ci capisci qualcosa.

Private Function LeggeBMP(FileName As String, _
                         ByRef ImgBuf() As Byte, _
                         ByRef ImgColor() As Byte, _
                         ByRef ImgWidth As Long, _
                         ByRef ImgHeight As Long, _
                         ByRef ImgBPP As Byte, _
                         Optional ColorSpace As pdfColorSpace = pdfRGB) As 
Boolean

  ' BITMAPFILEHEADER_Type
  Dim bfType          As String * 2     ' The string "BM" (hex value 
&H424D).
  Dim bfSize          As Long           ' The size of the file, measured in 
[Bytes].
  Dim bfDummy         As Integer        ' Not used, set to zero.
  Dim bfOffBits       As Long           ' The start offset of the bitmap 
data in the file.

  ' BITMAPINFOHEADER
  Dim biSize            As Long         ' 40 (the size of this structure).
  Dim biWidth           As Long         ' The width of the bitmap in pixels.
  Dim biHeight          As Long         ' The height of the bitmap in 
pixels.
  Dim biPlanes          As Integer      ' 1 (DIBs always have one plane).
  Dim biBitCount        As Integer      ' 1 for monochrome, 4 for 16 colors, 
8 for 256 color, 24 for 24-bit RGB color.
  Dim biCompression     As Long         ' Specifies the type of compression 
for compressed
  Dim biSizeImage       As Long         ' The size of the image in bytes.
  Dim biXPelsPerMeter   As Long         ' Number of horizontal pixels per 
meter for
  Dim biYPelsPerMeter   As Long         ' Number of vertical pixels per 
meter for
  Dim biClrUsed         As Long         ' Number of entries in the DIB color 
table
  Dim biClrImportant    As Long         ' Number of entries in the DIB color 
table that


  Dim c As Long
  Dim fb As Integer
  Dim XBMP As Long
  Dim BPP As Byte
  Dim i As Long
  Dim KK As Long
  Dim blnFlag As Boolean
  Dim TempImg() As Byte
  Dim TempCol() As Byte ' RGBQUAD_Type
  Dim lngGray As Long

  fb = FreeFile
  Open FileName For Binary As #fb

  ' BITMAPFILEHEADER
  Get #fb, , bfType
  Get #fb, , bfSize
  Get #fb, , bfDummy
  Get #fb, , bfDummy
  Get #fb, , bfOffBits

  LeggeBMP = False

  If bfType = "BM" Then

    ' BITMAPINFOHEADER
    Get #fb, , biSize
    Get #fb, , biWidth
    Get #fb, , biHeight
    Get #fb, , biPlanes
    Get #fb, , biBitCount
    Get #fb, , biCompression
    Get #fb, , biSizeImage
    Get #fb, , biXPelsPerMeter
    Get #fb, , biYPelsPerMeter
    Get #fb, , biClrUsed
    Get #fb, , biClrImportant


    BPP = biBitCount

    If BPP <= 8 Then

      ' legge la palette di colori
      ReDim TempCol(1 To (2 ^ BPP) * 4)
      Get #fb, , TempCol()

      If ColorSpace = pdfRGB Then
        ReDim ImgColor(1 To 3 * (2 ^ BPP))
        For c = 0 To (2 ^ BPP) - 1
          ImgColor(c * 3 + 1) = TempCol(c * 4 + 1) ' red
          ImgColor(c * 3 + 2) = TempCol(c * 4 + 2) ' green
          ImgColor(c * 3 + 3) = TempCol(c * 4 + 3) ' blue
        Next
      Else
        ReDim ImgColor(1 To (2 ^ BPP))
        For c = 0 To (2 ^ BPP) - 1
          lngGray = (0.33 * TempCol(c * 4 + 1) + 0.59 * TempCol(c * 4 + 2) + 
0.11 * TempCol(c * 4 + 3))
          ImgColor(c + 1) = IIf(lngGray > 255, 255, lngGray)
        Next
      End If
    End If

    XBMP = ((biWidth * BPP / 8) + 3&) And &HFFFFFFFC      ' [Bytes].

    ImgWidth = biWidth
    ImgHeight = biHeight
    ImgBPP = CByte(biBitCount)

    ReDim TempImg(1 To biHeight * XBMP)
    Get #fb, bfOffBits + 1, TempImg()
    Close #fb

    ReDim ImgBuf(1 To biHeight * XBMP)
    KK = 0

    If BPP > 8 Then
      blnFlag = ((biWidth Mod 4) <> 0)

      If ColorSpace = pdfRGB Then
        For c = 1 To UBound(TempImg) - 1 Step 3
          ImgBuf(3 * KK + 1) = TempImg(c + 2)
          ImgBuf(3 * KK + 2) = TempImg(c + 1)
          ImgBuf(3 * KK + 3) = TempImg(c)
          If (((KK + 1) Mod biWidth) = 0) And blnFlag Then c = c + (biWidth 
Mod 4)
          KK = KK + 1
        Next

      Else
        For c = 1 To UBound(TempImg) - 1 Step 3
          lngGray = 0.33 * TempImg(c + 2) + 0.59 * TempImg(c + 1) + 0.11 * 
TempImg(c)
          ImgBuf(KK + 1) = IIf(lngGray > 255, 255, lngGray)
          If (((KK + 1) Mod biWidth) = 0) And blnFlag Then c = c + (biWidth 
Mod 4)
          KK = KK + 1
        Next
        ReDim Preserve ImgBuf(1 To KK)

      End If

    ElseIf BPP <= 8 Then
      blnFlag = (biWidth Mod IIf(BPP = 8, 4, 8)) <> 0
      For i = 1 To UBound(TempImg)
        ImgBuf(KK + 1) = TempImg(i)
        If ((KK + 1) Mod Int((biWidth + (8 / BPP) - 1) / (8 / BPP))) = 0 And 
blnFlag Then
          i = i + (XBMP - (i Mod XBMP))
        End If
        KK = KK + 1
      Next
      ReDim Preserve ImgBuf(1 To KK)

    End If

    LeggeBMP = True
  End If

  If fb > 0 Then Close #fb

End Function



Ciao Franz e grazie.
Sauro 

Back to it.comp.lang.visual-basic | Previous | Next — Previous in thread | Next in thread | Find similar

Thread

Curiosità su file BMP e PDF "Sauro" <vicchi@crsscala.it> - 2016-04-27 17:55 +0200
  Re: Curiosità su file BMP e PDF Franz_aRTiglio <franzgol@N0SPAMtin.it> - 2016-04-27 18:16 +0200
    Re: Curiosità su file BMP e PDF "Sauro" <vicchi@crsscala.it> - 2016-04-28 14:24 +0200
      Re: Curiosità su file BMP e PDF Franz_aRTiglio <franzgol@N0SPAMtin.it> - 2016-04-28 16:49 +0200
        Re: Curiosità su file BMP e PDF Franz_aRTiglio <franzgol@N0SPAMtin.it> - 2016-04-28 16:55 +0200
          Re: Curiosità su file BMP e PDF "Sauro" <vicchi@crsscala.it> - 2016-05-01 09:38 +0200
            Re: Curiosità su file BMP e PDF Franz_aRTiglio <franzgol@N0SPAMtin.it> - 2016-05-01 10:06 +0200
              Re: Curiosità su file BMP e PDF "Sauro" <vicchi@crsscala.it> - 2016-05-01 20:46 +0200

csiph-web