Thread View: fj.lang.visualbasic
2 messages
2 total messages
Started by SS95Plus!
Fri, 13 Feb 1998 00:00
ビットマップをモノクロ（２値）で保存したい。
Author: SS95Plus!
Date: Fri, 13 Feb 1998 00:00
Date: Fri, 13 Feb 1998 00:00
18 lines
1261 bytes
1261 bytes
初めまして、２点ほど質問させて下さい。ＶＢ５です １ ２値のＤＣを作成するか、保存時に２値のビットマップ形式に 変換したい。 ピクチャボックスに描画した文字や線を２値（白黒）ビットマップ形式 で保存したいのですが、やり方がわかりません。 ２ Ｐｌｕｓ！の機能を解除したい ピクチャボックスに黒のペンでTextOutを使用して文字を描画する場合に WindowsPlusのオプションの「スクリーンフォントの縁をなめらかにする」 が選択されていると、グレーが混じって２値としてデータがとれなくなっ てしいます。この設定を一時解除して、TextOut後に再度設定を戻す事は 可能でしょうか？ －以上、何卒よろしくお願いいたします。
Re: $B%S%C%H%^%C%W$r%b%N%/%m!J#2CM!K$GJ]B8$7$?$$!#(J
Author: TAKUYA
Date: Mon, 30 Mar 1998 00:00
Date: Mon, 30 Mar 1998 00:00
114 lines
3820 bytes
3820 bytes
<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
-----------------------------------
Thread Navigation
This is a paginated view of messages in the thread with full content displayed inline.
Messages are displayed in chronological order, with the original post highlighted in green.
Use pagination controls to navigate through all messages in large threads.
Back to All Threads