截屏保存为bmp文件完整版mbpsaver
感谢seasoners网友对我的代码感兴趣，给我动力，促使我重写这个程序，并在win7+vfp9下编译通过。本源码仅供学习交流，如商用，请私信联系我，非常感谢！
程序代码：
***********************************************************************************************************
*!* 参考自己10几年前写的图片格式转换代码，重新编写这一段精简代码。
*!* 这是一个直接将截屏转换为黑白图片的演示程序，
*!* 运行本示例可以将截取_screen 的200 X 200 的区域，可以把程序中的200改成任何你想要的尺寸
*!* 也可以把你想要的尺寸再设置成2个参数。
*!* 并在你的默认目录中以文件名为testbw.bmp保存。
*!* 同理，稍加修改，它可以用在图片格式转换中，直接将彩图转换为黑白图片。
*!* 这个速度简直不要太快，就是不知道成图效果和挨个对图像数据流进行运算的二值化算法的效果一不一样？
*!* 当初VB代码是一个台湾人写的，可惜忘记他的网名了，在此表示感谢！
*!* 作者：Sam Jiang
*!* 时间：2023/09/06
*!* 1st revised： 2023/09/08
*!* 修改内容：添加16色，256色，及灰阶图，真彩，全彩
*!* 改名为bmpsaver.prg
*!* 本程序在win7 和 vfp9.0（7423版）环境下编译通过
***********************************************************************************************************
PARAMETERS npara
DO case
CASE npara=1 &&黑白
nbitcount=1
ccolortable=bintoc(0,"4rs")+bintoc(RGB(255,255,255),"4rs")
CASE npara=2 &&16色
nbitcount=4
DIMENSION colors[16]
colors[1]=RGB(0,0,0)
colors[2]=RGB(0,0,191)
colors[3]=RGB(0,191,0)
colors[4]=RGB(0,191,191)
colors[5]=RGB(191,0,0)
colors[6]=RGB(191,0,191)
colors[7]=RGB(191,191,0)
colors[8]=RGB(191,191,191)
colors[9]=RGB(64,64,64)
colors[10]=RGB(0,0,255)
colors[11]=RGB(0,255,0)
colors[12]=RGB(0,255,255)
colors[13]=RGB(255,0,0)
colors[14]=RGB(255,0,255)
colors[15]=RGB(255,255,0)
colors[16]=RGB(255,255,255)
ccolortable=""
FOR i=1 TO 16
ccolortable=ccolortable+BINTOC(colors[i],"4rs")
ENDFOR
CASE npara=3 &&256色
nbitcount=8
DIMENSION colors[256]
i=0
ccolortable=""
FOR b=0 to 0xe0 step 0x20
FOR g=0 to 0xe0 step 0x20
FOR r=0 TO 0xc0 STEP 0x40
colors[i+1]=IIF(b=0xe0,0xff,b)*0x10000+;
IIF(g=0xe0,0xff,g)*0x100+;
IIF(r=0xc0,0xff,r)
ccolortable=ccolortable+BINTOC(colors[i+1],"4rs")
i=i+1
ENDFOR
ENDFOR
ENDFOR
CASE npara=4 &&256灰色
nbitcount=8
DIMENSION graycolors[256]
ccolortable=""
FOR i=0 TO 255
graycolors[i+1]=RGB(i,i,i)
ccolortable=ccolortable+BINTOC(graycolors[i+1],"4rs")
ENDFOR
CASE npara=5 &&真彩
nbitcount=24
ccolortable=""
CASE npara=6 &&全彩
nbitcount=32
ccolortable=""
OTHERWISE
return .f.
ENDCASE
DO decl
obmiheader=NEWOBJECT([bmiheader],[myclass])
WITH obmiheader
.bibitcount=nbitcount
.biheight=200
.biwidth=200
.bisizeimage=CEILING(.biwidth/16)*2*.biheight
endwith
lcbitmapinfoheader=obmiheader.getstruct()
hdc=getdc(_screen.HWnd)
hvdc=createcompatibledc(hdc)
if npara=1
hbitmap=createbitmap(200,200,1,1,null)
ELSE
hbitmap=createdibsection(hdc,lcbitmapinfoheader+ccolortable,0,null,0,0)
ENDIF
selectobject(hvdc,hbitmap)
=bitblt(hvdc,0,0,200,200,hdc,0,0,0x00cc0020)
n=getobjecta(hbitmap,0,null)
lcbitmap=REPLICATE(CHR(0),n)
GETOBJECTA(hbitmap,n,@lcbitmap)
obitmap=NEWOBJECT([bitmap],[myclass])
obitmap.set(lcbitmap)
m=obitmap.bmwidthbytes*obitmap.bmheight
lcbitmapdata=REPLICATE(CHR(0),m)
getbitmapbits(hbitmap,m,@lcbitmapdata)
x=CEILING(obitmap.bmwidthbytes/4)*4-obitmap.bmwidthbytes
lcbmpfdata=""
if x#0
for i=1 to obitmap.bmheight
lcbmpfdata=SUBSTR(lcbitmapdata,(i-1)*obitmap.bmwidthbytes+1,obitmap.bmwidthbytes)+REPLICATE(CHR(0),x)+lcbmpfdata
ENDFOR
ELSE
if npara=1
lcbmpfdata=lcbitmapdata
ELSE
for i=obitmap.bmheight to 1 step -1
lcbmpfdata=lcbmpfdata+SUBSTR(lcbitmapdata,(i-1)*obitmap.bmwidthbytes+1,obitmap.bmwidthbytes)
ENDFOR
ENDIF
ENDIF
bmpfile=NEWOBJECT("bmpfile","myclass")
WITH bmpfile
.bitmapdata=lcbmpfdata
.colortable=ccolortable
WITH .bmfheader
.bfoffbits=54+LEN(ccolortable)
.bfsize=54+LEN(ccolortable)+LEN(lcbmpfdata)
ENDWITH
WITH .bmiheader
.bibitcount=nbitcount
.biwidth=200
.biheight=200
.bisize=40
.bisizeimage=LEN(lcbmpfdata)
.bixpelspermeter=0
.biypelspermeter=0
ENDWITH
ENDWITH
deletedc(hvdc)
deleteobject(hbitmap)
releasedc(_screen.hwnd,hdc)
bmpfile.save("testbw.bmp")
clea memory
release all
FUNCTION decl
DECLARE integer GetObject IN WIN32API as getobjecta integer,integer,string
DECLARE integer ReleaseDC IN WIN32API integer,integer
DECLARE integer DeleteDC IN WIN32API integer
DECLARE integer CreateBitmap IN WIN32API integer,integer,integer,integer,string
DECLARE integer SelectObject IN WIN32API integer,integer
DECLARE integer DeleteObject IN WIN32API integer
DECLARE integer CreateCompatibleDC IN WIN32API integer
declare integer CreateCompatibleBitmap in win32api integer,integer,integer
DECLARE integer GetBitmapBits IN WIN32API integer,integer,string
DECLARE integer CreateDIBSection IN WIN32API integer,string,integer,string,integer,integer
DECLARE integer BitBlt IN WIN32API integer,integer,integer,integer,integer,integer,integer,integer,integer
DECLARE integer GetDC IN WIN32API integer
declare integer GetDIBits in win32api integer,integer,integer,integer,string,string,integer
ENDFUNC
黑白效果图：
16色效果图：
256色效果图：
灰阶效果图：
真彩效果图：
全彩效果图：
[此贴子已经被作者于2023-9-8 12:18编辑过]
