🚀 go-pugleaf

<1>$B$N#23,D4$GJ]B8$9$kJ}K!$@$15-:\$7$^$9!#(J
$B<!$NDL$j$G$9!#(J

'$B?'<hF@MQ(J
Private Declare Function GetPixel Lib "GDI32" (ByVal hDC As Long, ByVal X
As Long, ByVal Y As Long) As Long
'BMP$B%U%!%$%k$N%X%C%@!<!]%U%!%$%k>pJs(J
Private Type BITMAPFILEHEADER
        bfType As Integer
        bfSize As Long
        bfReserved1 As Integer
        bfReserved2 As Integer
        bfOffBits As Long
End Type
'BMP$B%U%!%$%k$N%X%C%@!<!]%S%C%H%^%C%W$N>pJs(J
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
'$B%Q%l%C%HMQ(J
Private Type RGBQUAD
        rgbBlue As Byte
        rgbGreen As Byte
        rgbRed As Byte
        rgbReserved As Byte
End Type

Sub SaveMonoImage(FN As String, picBox As PictureBox)
Dim BFH As BITMAPFILEHEADER '$B%X%C%@!<$=$N#1(J
Dim BIH As BITMAPINFOHEADER '$B%X%C%@!<$=$N#2(J
Dim Pal(1) As RGBQUAD '$B%Q%l%C%H#2?'J,(J
Dim BMByte() As Byte '$B<B:]$N%P%$%H(J
Dim BMX As Integer, BMY As Integer '$B=D2#$N%5%$%:(J
Dim BMXByte As Integer '1$B%i%$%s$"$?$j$N%P%$%H?t(J
Dim Temp As Integer, Temp2 As Integer, Temp3 As Long, Temp4 As Long
'$B:n6HMQJQ?t(J
Dim Tcol As Byte '$B:n6HMQJQ?t(J
Dim srcDC As Long '$B%G%P%$%9%3%s%F%-%9%H(J

'$B9bB.2=$N$?$a$K(JPoint$B4X?t$G$J$/(JGetPixel$B$r;H$C$F$$$^$9!#(J
'$B$=$N$?$a(JAutoRedraw$B%W%m%Q%F%#$,(JTrue$B$G$J$$$H$&$^$/F0:n$7$^$;$s!#(J

'$B%S%C%H%^%C%W%U%!%$%k$N3F%i%$%s$N%P%$%H?t7W;;(J
BMX = picBox.ScaleWidth
BMY = picBox.ScaleHeight
BMXByte = (BMX - 1) \ 8 + 1 '$B%P%$%H?t7W;;(J
Temp = ((BMXByte - 1) \ 4 + 1) * 4 - 1 '$B%P%$%H6-3&$r(J4$B%P%$%H$K$=$m$($F$$$k(J
ReDim BMByte(Temp, BMY - 1)

'$B%X%C%@!<=i4|2=(J
With BFH
    .bfType = &H4D42 '$BJ]B8;~$K!V(JBM$B!W$H$J$k(J
    .bfOffBits = 62 'BFH$B$,(J14$B%P%$%H!"(JBIF$B$,(J40$B%P%$%H!"%Q%l%C%H$,(J8$B%P%$%H(J
    .bfSize = 62 + (Temp + 1) * BMY
End With

With BIH
    .biSize = 40 'BIF$B$O(J40$B%P%$%H(J
    .biWidth = BMX '$BI}(J
    .biHeight = BMY '$B9b$5(J
    .biPlanes = 1 '$B>o$K#1(J
    .biBitCount = 1 '2$B?'$J$N$G(J1$B%S%C%H(J
    .biSizeImage = BFH.bfSize - 62
End With

With Pal(0)
.rgbBlue = 255: .rgbRed = 255: .rgbGreen = 255
'rgbReserved$B$O(J0$B$J$N$G$=$N$^$^(J
'Pal(1)$B$O9u$@$,!"$9$Y$F(J0$B$G$$$$$N$G$=$N$^$^(J
End With


srcDC = picBox.hDC

For Temp = BMY - 1 To 0 Step -1 '1$B%i%$%s$:$D2<$+$i:n@.(J
    For Temp2 = 0 To BMXByte - 1 '1$B%P%$%H$:$D:n@.(J
        Tcol = 0
        For Temp3 = 0 To 7 '1$B%P%$%H$O(J8$B%S%C%H(J
            Temp4 = GetPixel(srcDC, Temp2 * 8 + Temp3, Temp)
            If Temp4 = 0 Then Tcol = Tcol + 2 ^ (7 - Temp3) '$B9u$N>l9g(J
        Next
        BMByte(Temp2, BMY - 1 - Temp) = Tcol
    Next
Next

Open FN For Binary As 1
Put 1, , BFH
Put 1, , BIH
Put 1, , Pal()
Put 1, , BMByte()
Close

End Sub

$B8e$O$3$N$h$&$K8F$S=P$9$@$1$G$9!#(J
Call SaveMonoImage(strFilename, picbox1)

----------------------------------
TAKUYA  
           fvgm8171@mb.infoweb.ne.jp

-----------------------------------