2014-10-08 5 views
3

VB6을 사용하여 픽셀 당 1 비트를 사용하여 * .bmp 이미지를 만드는 방법은 무엇입니까? 예제 프로젝트가 이런 식으로 존재합니까?이진 데이터에서 * .bmp 이미지 만들기

'#    # Image Data Info :           # 
'#    #    Each black dot are represented as binary 1(high)# 
'#    #    and white are represented as binary 0(low) in # 
'#    #    form of hexadecimal character.     # 
'#    # Example  : (for this example assume the image width is 8)# 
'#    #    Data  : 7E817E       # 
'#    #    Binary data : 7=0111, E=1110, 8=1000, 1=0001 # 
'#    #        7=0111, E=1110     # 
'#    #    Image data : px1 px2 px3 px4 px5 px6 px7 px8 # 
'#    #       px1 w b b b b b b w # 
'#    #       px2 b w w w w w w b # 
'#    #       px3 w b b b b b b w # 
'#    #                # 
'#    #       w = white, b = black, px = pixel # 

세부 사항 :

1

+1

텍스트 헥스 데이터를 조각 (행), 행당 '너비/8'문자 쌍으로 나눕니다. 'Byte' 배열'b'을 조각 당 개수와 문자 쌍의 수와 일치하는 행과 열의 수로 각각 할당하십시오. 각 조각의 각 문자 쌍에 대해 배열의 해당 위치에 val ("& h"& pair) 값을 저장하십시오. 'CreateCompatibleDC (0)'을 호출하고'CreateBitmap (너비, 높이, 1, ByVal 0 &)'을 선택하고, 'BITMAPINFO' 구조체'bi'를 선언하고, 정확한 치수로 채우고,'SetDIBits (hDC , hBitmap, 0, 높이, b (lbound (b)), bi, DIB_PAL_COLORS)'. – GSerg

+0

폼상의'PictureBox'의 크기를 변경하고, 문자 쌍을 반복하며, 각 문자 쌍 안의 개별 픽셀 ('val ("& h"& 쌍) 내에서 두 개의 8 승)을 반복하여' 1 ', 및'Picture1.Pset '을 생성한다. – GSerg

답변

0

다음과 같은 코드를 사용할 수 있음을 유의하시기 바랍니다 :

  • 이미지 너비가 8의 배수 여야합니다;
  • 행은 맨 아래부터 시작합니다.

요구 사항이 적절하지 않은 경우 적절하게 코드를 수정할 수 있습니다.

Result

는 마이크로 소프트 페인트가 일부 픽셀의 스크램블링 결과 단색 이미지에 영향을 미치는 버그를 갖고있는 것 같아요 있습니다 :

Option Explicit 

Private Type BITMAPFILEHEADER 
    bfType As String * 2 
    bfSize As Long 
    bfReserved1 As Integer 
    bfReserved2 As Integer 
    bfOffBits As Long 
End Type 

Private Type BITMAPINFOHEADER 
    biSize As Long 
    biWidth As Long 
    biHeight As Long 
    biPlanes As Integer 
    biBitCount As Integer 
    biCompression As Long 
    biSizeImage As Long 
    biXPelsPerMeter As Long 
    biYPelsPerMeter As Long 
    biClrUsed As Long 
    biClrImportant As Long 
End Type 

Private Type RGBQUAD 
    rgbBlue As Byte 
    rgbGreen As Byte 
    rgbRed As Byte 
    rgbReserved As Byte 
End Type 

Private Type BITMAPINFO 
    bmiHeader As BITMAPINFOHEADER 
    bmiColors(1) As RGBQUAD 
End Type 

Public Function strToBmp(str As String, w As Integer, h As Integer, filename As String) As Boolean 
Dim bmfh As BITMAPFILEHEADER 
Dim bmi  As BITMAPINFO 
Dim r As Boolean 
Dim ff As Integer 
Dim i As Integer 
Dim x As Integer 
Dim rl As Integer 
Dim rw As Integer 
Dim s As String 
Dim b As Byte 
    rw = ((w + 31) \ 32 + 3) And &HFFFFFFFC 
    With bmfh 
     .bfType = "BM" 
     .bfSize = Len(bmfh) + Len(bmi) + rw * h 
     .bfOffBits = Len(bmfh) + Len(bmi) 
    End With 
    With bmi.bmiHeader 
     .biSize = Len(bmi.bmiHeader) 
     .biWidth = w 
     .biHeight = h 
     .biPlanes = 1 
     .biBitCount = 1 
     .biCompression = 0 
     .biSizeImage = rw * h 
     .biXPelsPerMeter = 72 
     .biYPelsPerMeter = 72 
     .biClrUsed = 0 
     .biClrImportant = 0 
    End With 
    With bmi.bmiColors(0) 
     .rgbRed = 255 
     .rgbGreen = 255 
     .rgbBlue = 255 
    End With 
    On Error Resume Next 
    Call Kill(filename) 
    On Error GoTo e2 
    ff = FreeFile() 
    Open filename For Binary Access Write As #ff 
    On Error GoTo e1 
    Put #ff, , bmfh 
    Put #ff, , bmi 
    For i = 1 To Len(str) Step 2 
     b = CByte("&H" & Mid(str, i, 2)) 
     Put #ff, , b 
     rl = rl + 1 
     x = x + 8 
     If x = w Then 
      b = 0 
      Do While rl < rw 
       Put #ff, , b 
       rl = rl + 1 
      Loop 
      x = 0 
      rl = 0 
     End If 
    Next i 
    r = True 
e1: 
    Close ff 
e2: 
    strToBmp = r 
End Function 

Public Sub test() 
    Call strToBmp("7E817E", 8, 3, "out.bmp") 
End Sub 

은 결과 이미지입니다.

관련 문제