Array로부터 1bit 단일색상 BMP 파일 만들기

Barcode 발행 매크로를 만들면서 

2D Array에 담고, Excel sheet에 붙여 넣어서 그림으로 복사하는 방식을 사용했는데

이렇게 사용할 경우 함수로는 사용할 수 없어서 

Array로부터 직접 BMP파일을 생성하여 삽입하는 방식으로 정리하였습니다.

BMP파일을 일반적인 24bit로 만들경우 용량이 커지는 문제가 있어서

1bit 단일색상 BMP 파일로 최소한으로 만들기 위해서 정리했습니다.

 

색상표현 관련하여 제대로 표시되지 않은 문제를 v2.5로 개선했습니다.

 

BMP파일은 Version 3형식을 선택 (이유는 간단하므로,,,)

구조는 아래처럼 총 4가지 구조로 되어 있으며

File Header

DIB Header

Color Table

Image Data

 

아래 구조에 대한 참고: http://justsolve.archiveteam.org/wiki/BMP
Data types of 4Bytes => Long, 2Bytes => Integer, 1Byte => Byte
Character type of 4Bytes => String * 4, 2Bytes => String * 2

 

File Header는 아래처럼 선언

Private Type typBITMAPFILEHEADER
  bfType As String * 2          ' The file type. must be "BM".
  bfSize As Long                ' The size, in bytes, of the bitmap file.
  bfReserved1 As Integer        ' Reserved, must be zero.
  bfReserved2 As Integer        ' Reserved, must be zero.
  bfOffBits As Long             ' The offset, in bytes, from the beginning of the BITMAPFILEHEADER structure to the BitMap bits.
End Type

 

DIB Header는 아래처럼 선언

Private Type typBITMAPINFOHEADER
  biSize As Long                ' The number of bytes required by the structure. which mostly reveals its version. V3 must be 40.
  biWidth As Long               ' The width of the bitmap, in pixels.
  biHeight As Long              ' The height of the bitmap, in pixels.
  biPlanes As Integer           ' This value must be set to 1.
  biBitCount As Integer         ' The number of bits-per-pixel. 0,1,4,8,16,24,32
  biCompression As Long         ' The type of compression for a compressed bottom-up bitmap. BI_RGB=0
  biSizeImage As Long           ' The size, in bytes, of the image. This may be set to zero for BI_RGB bitmaps.
  biXPelsPerMeter As Long       ' The horizontal resolution, in pixels-per-meter, of the target device for the bitmap.
  biYPelsPerMeter As Long       ' The vertical resolution, in pixels-per-meter, of the target device for the bitmap.
  biClrUsed As Long             ' The number of color indexes in the color table that are actually used by the bitmap.
                                ' If this value is zero, the bitmap uses the maximum number of colors
  biClrImportant As Long        ' If this value is zero, all colors are required.
End Type

 

최종적인 BMP 파일은 아래처럼 선언

Private Type typBITMAPFILE
  fileHD As typBITMAPFILEHEADER ' Bitmap File Header
  infoHD As typBITMAPINFOHEADER ' Bitmap Info Header
  ClrLst() As Byte              ' 사용된 Color목록을 넣는다. RGBQUAD표기(B/G/R/NotUsed순 4Bytes)
  BitMap() As Byte              ' Pixel Bitmap Array
End Type

 

작성된 함수

Rem////////////////////////////////////////////////////////////////////////////////////////
Rem
Rem Function  : ArrayTo1BitBMP
Rem Describe  : Makes a 1bit BitMap file from an array which contains 1 and 0 or empty.
Rem Version   : v2r6
Rem Author    : EGTools (egexcelvba@gmail.com)
Rem Date      : 2024-04-11
Rem License   : MIT License
Rem Arguments :
Rem   BnWArray  - Black & White bitmap array, value 1 is display foreground color.
Rem   m         - Array to BipMap file multiply ratio, default x3.
Rem   FullName  - BitMap image saved folder, default %Temp% folder.
Rem   fColor    - foreground color, default 0(Black)
Rem   bColor    - background color, default 16777215(White)
Rem Returns   : Saved file name with path and filename.
Rem
Rem////////////////////////////////////////////////////////////////////////////////////////

Function ArrayTo1BitBMP(BnWArray As Variant, Optional m As Long = 3, Optional FullName As String = "", Optional fColor As Long = 0, Optional bColor As Long = 16777215)
  Dim bmpFile As typBITMAPFILE, lngRowSize As Long, lngBitMapSize As Long, lngFileSize As Long
  Dim lngWidth As Long, lngHeight As Long, tByte As Byte

  Dim i As Long, j As Long, k As Long, l As Long
  Dim r As Long, c As Long, rm As Long, cm As Long, vD As Variant
  
  On Error GoTo ERROR_EXIT
  
Rem Array Check
  If Not IsArray(BnWArray) Then err.Raise 601, "Is not Array"
  If (UBound(BnWArray, 1) * UBound(BnWArray, 2) < 4) Then err.Raise 601, "Too small image"
  
Rem Array 크기를 m의 배수로 확대
  ReDim vD(1 To (UBound(BnWArray, 1) - LBound(BnWArray, 1) + 1) * m, 1 To (UBound(BnWArray, 2) - LBound(BnWArray, 2) + 1) * m)
  For r = LBound(BnWArray, 1) To UBound(BnWArray, 1): For c = LBound(BnWArray, 2) To UBound(BnWArray, 2)
    For rm = 1 To m: For cm = 1 To m
        vD((r - LBound(BnWArray, 1)) * m + rm, (c - LBound(BnWArray, 2)) * m + cm) = BnWArray(r, c)
    Next cm: Next rm
  Next c: Next r

  lngWidth = UBound(vD, 2) - LBound(vD, 2) + 1
  lngHeight = UBound(vD, 1) - LBound(vD, 1) + 1
    
  With bmpFile
Rem BMP파일 Header 정리
    With .fileHD
      .bfType = "BM"            ' Basic BMP file
      .bfSize = 0               ' 최종정리시 실제 크기로 반영 (Bytes)
      .bfReserved1 = 0          ' 미사용으로 0으로 설정
      .bfReserved2 = 0          ' 미사용으로 0으로 설정
      .bfOffBits = 62           ' File Header(14) + Info Header(40) + ClrLst(8)
    End With
    With .infoHD
      .biSize = 40              ' BMP Version   v3=40
      .biWidth = lngWidth       ' 가로 화소수(Pixel)
      .biHeight = lngHeight     ' 세로 화소수(Pixel)
      .biPlanes = 1             ' 항상 1
      .biBitCount = 1           ' 흑백이므로 1
      .biCompression = 0        ' 압축안하므로 0
      .biSizeImage = 0          ' 실제크기, 압축안한 경우(biCompression=0) 0으로 설정
      .biXPelsPerMeter = 0      ' 0으로 설정
      .biYPelsPerMeter = 0      ' 0으로 설정
      .biClrUsed = 0            ' 사용한 색상 수, 0으로 설정하면 biBitCount에서 가능한 모든 색
      .biClrImportant = 0       ' 모두 사용하므로 0으로 설정
    End With
    
Rem 색정보는 RGBQUAD표기, 4Byte에 각0~255, B/G/R/N순임, B=FF,G=FF,R=FF,NotUsed=00
    ReDim .ClrLst(7) As Byte
    .ClrLst(0) = (fColor \ 256 \ 256) Mod 256: .ClrLst(1) = (fColor \ 256) Mod 256: .ClrLst(2) = (fColor Mod 256): .ClrLst(3) = 0
    .ClrLst(4) = (bColor \ 256 \ 256) Mod 256: .ClrLst(5) = (bColor \ 256) Mod 256: .ClrLst(6) = (bColor Mod 256): .ClrLst(7) = 0
    
Rem 한행은 반드시 4Byte의 배수로 만들고, 남는 부분을 공백 처리
    lngRowSize = WorksheetFunction.Ceiling((.infoHD.biBitCount * .infoHD.biWidth) / 32, 1) * 4
    lngBitMapSize = lngRowSize * .infoHD.biHeight

    ReDim .BitMap(1 To lngBitMapSize)
    
Rem 이미지는 상하를 뒤집어 아래왼쪽 Pixel부터 기재
    For j = UBound(vD, 1) To LBound(vD, 1) Step -1
        k = k + 1: tByte = 0: .BitMap(k) = tByte: c = 128  '// 행마다 초기화
        For i = LBound(vD, 2) To UBound(vD, 2)
          If vD(j, i) = 1 Then
            tByte = 255 Xor c: .BitMap(k) = .BitMap(k) And tByte
          Else
            .BitMap(k) = .BitMap(k) Or c
          End If
          If c = 1 And i < lngRowSize * 8 Then
            k = k + 1: .BitMap(k) = 0: c = 128
          Else
            c = c / 2
          End If
        Next i
        
Rem 4Byte배수에서 남는 bits 정리
        Do While i < lngRowSize * 8
          If c = 1 Then
            k = k + 1: .BitMap(k) = 0: c = 128
          Else
            c = c / 2
          End If
          i = i + 1
        Loop
    Next j

Rem 최종 파일 크기(Bytes)  FileHeader(14) + InfoHeader(40) + ClrLst(8) + BitMap
    .fileHD.bfSize = 14 + 40 + 8 + lngBitMapSize

Rem 파일명을 Path를 포함하여 지정하고, 이미 있으면 삭제
    If FullName = "" Then FullName = Environ("TEMP") & "\EGBarcode_1bit.BMP"
    If Dir(FullName) <> "" Then Kill FullName
    
Rem 파일을 기재하고 닫기
    Open FullName For Binary Access Write As 1 Len = 1
    Put 1, 1, .fileHD
    Put 1, , .infoHD
    Put 1, , .ClrLst
    Put 1, , .BitMap
    Close
    
  End With
  
Rem 저장된 Full path file name을 반환
  ArrayTo1BitBMP = FullName
  Exit Function
  
ERROR_EXIT:
  If err.Number Then ArrayTo1BitBMP = "ERROR ArrayTo1BitBMP : " & err.Description Else ArrayTo1BitBMP = False
  
End Function