回复 13楼 seasoners
这是我10几年前写的代码，明显稚嫩，略显青涩
时间有点长了，代码有些冗余，见笑了。。。你感兴趣的话，改天我重写。
之前的代码完整版如下：
程序代码：
* Placing the active window (retrieved [color=#0000FF]with GetFoucs) into a BMP file[/color]
* [color=#0000FF]with defferent format , such as 2colors, 16colors , 256colors , fullcolor and truecolor[/color]
* 将当前窗口作为BMP图像以不同的格式保存到文件中
* 小蒋
* [color=#808080]*****************************[/color]
PARAMETERS ncode
CLEAR
ncode = 16
IF PARAMETERS()#1 then
nbitcount = 24
nbytesperpixel = 3
lccolor = ""
ELSE
fhandle = FOPEN("color.dat")
IF fhandle < 0 then
MESSAGEBOX("Can not find important data file color.dat!",0+16,"Warn!")
CANCEL
ENDIF
DO case
CASE ncode = 1
nbitcount = 1
nbytesperpixel = 0.125
FSEEK(fhandle,0,0)
lccolor = FREAD(fhandle,8)
CASE ncode = 2
nbitcount = 4
nbytesperpixel = 0.5
FSEEK(fhandle,8,0)
lccolor = FREAD(fhandle,64)
CASE ncode = 4
nbitcount = 8
nbytesperpixel = 1
FSEEK(fhandle,8+64,0)
lccolor = FREAD(fhandle,1024)
CASE ncode = 8
nbitcount = 8
nbytesperpixel = 1
FSEEK(fhandle,8+64+1024,0)
lccolor = FREAD(fhandle,1024)
CASE ncode = 16
nbitcount = 24
nbytesperpixel = 3
lccolor = ""
CASE ncode = 0
nbitcount = 32
nbytesperpixel = 4
lccolor = ""
OTHERWISE
MESSAGEBOX("Invalid parameter, will use default mode!",0+16,"Remind!")
nbitcount = 32
nbytesperpixel = 4
lccolor = ""
ENDCASE
FCLOSE(fhandle)
ENDIF
PRIVATE hwnd, lnLeft, lnTop, lnRight, lnBottom, lnWidth, lnHeight
DO decl
hwnd = GetFocus()
hdc = GetWindowDC(hwnd)
STORE 0 TO lnLeft, lnTop, lnRight, lnBottom, lnWidth, lnHeight
= GetRect(@lnLeft, @lnTop, @lnRight, @lnBottom, @lnWidth, @lnHeight)
lnwidthbytes = lnwidth
DO WHILE .t.
temp = MOD(lnwidthbytes*nbytesperpixel,4)
IF temp#0 then
lnwidthbytes = lnwidthbytes + 1
LOOP
ELSE
EXIT
ENDIF
ENDDO
nbytesperline = lnwidthbytes*nbytesperpixel
?nbytesperline
nbitmapsize = nbytesperline*lnHeight
biSize = 40
biWidth = lnWidth
biHeight = lnHeight
biPlanes = 1
biBitCount = nbitcount
biCompression = 0
biSizeImage = nbitmapsize
biXpersPerMeter = 0
biYpersPerMeter = 0
biClrUsed = 0
biClrImportant = 0
lcBitmapInfoHeader = int2buf(biSize ,4) + ;
int2buf(biWidth ,4) + ;
int2buf(biHeight ,4) + ;
int2buf(biPlanes ,2) + ;
int2buf(biBitCount ,2) + ;
int2buf(biCompression ,4) + ;
int2buf(biSizeImage ,4) + ;
int2buf(biXpersPerMeter ,4) + ;
int2buf(biYpersPerMeter ,4) + ;
int2buf(biClrUsed ,4) + ;
int2buf(biClrImportant ,4)
if nbitcount = 1 then
hdib = CreateBitmap(lnWidth, lnHeight,1,1,0)
ELSE
hdib = CreateDIBSection(hdc,lcBitmapInfoHeader + lccolor,0,"a",0,0)
ENDIF
hvdc = CreateCompatibleDC(hdc)
*?dvdc
selectobject(hvdc,hdib)
bitblt(hvdc,0,0,lnWidth, lnHeight,hdc,0,0,0xcc0020)
lpdib = REPLICATE(CHR(0),24)
= getobjectapi(hdib,24,@lpdib)
bmtype = buf2int(SUBSTR(lpdib,1,4))
*?bmtype
*bmwidth = buf2int(substr(lpdib,5,4))
*?bmwidth
*bmHeight = buf2int(substr(lpdib,9,4))
*?bmHeight
bmwidthbytes = buf2int(substr(lpdib,13,4))
*?bmwidthbytes
*bmplanes = buf2int(substr(lpdib,17,2))
*?bmplanes
*bmbitspixel = buf2int(substr(lpdib,19,2))
*?bmbitspixel
*bmbits = buf2int(substr(lpdib,21,4))
*?bmbits
bfType = "BM"
bfSize = 14+40+LEN(lccolor) + nbitmapsize
bfReserved1 = 0
bfReserved2 = 0
bfOffBits = 14+40+LEN(lccolor)
lcbitmapfileheader = "BM" + ;
int2buf(bfSize ,4) + ;
int2buf(bfReserved1 ,2) + ;
int2buf(bfReserved2 ,2) + ;
int2buf(bfOffBits ,4)
lcbuffer = REPLICATE(CHR(0),nbitmapsize )
GetBitmapBits(hdib,nbitmapsize ,@lcbuffer )
fname = PUTFILE("Save as BMP file:","","bmp")
hfile = FCREATE(fname)
FWRITE(hfile,lcbitmapfileheader)
FWRITE(hfile,lcBitmapInfoHeader)
FWRITE(hfile,lccolor)
ndistance = nbytesperline - bmwidthbytes
*?ndistance
FOR i = lnHeight TO 1 STEP -1
FWRITE(hfile,SUBSTR(lcbuffer,(i-1)*bmwidthbytes +1,bmwidthbytes )) &&+repli(chr(0),ndistance))
ENDFOR
FCLOSE(hfile)
= releaseDC(hwnd,hdc)
DeleteObject(hdib)
CLEAR ALL
CLEAR DLLS
RELEASE ALL
RETURN &&main
PROCEDURE decl
DECLARE integer GetFocus IN win32api
DECLARE integer GetObject IN WIN32API as GetObjectAPI integer hobject,integer ncount,string lpbitmap
DECLARE SHORT GetWindowRect IN WIN32API integer hwnd,string @ lpRect
DECLARE integer GetWindowDC IN WIN32API integer hwnd
DECLARE integer ReleaseDC IN WIN32API integer hwnd,integer hdc
DECLARE integer CreateCompatibleDC IN WIN32API integer hdc
DECLARE integer CreateBitmap IN WIN32API integer nwidth,integer nheight,integer nplanes,integer nbitcount,string lpbits
DECLARE integer CreateCompatibleBitmap IN WIN32API integer hdc, integer nwidth,integer nheight
DECLARE integer SelectObject IN WIN32API integer hdc, integer hobject
DECLARE integer DeleteObject IN WIN32API integer hobject
DECLARE integer BitBlt IN WIN32API integer hDestDC, ;
integer x, ;
integer y, ;
integer nwidth, ;
integer nheight, ;
integer nSrcDC, ;
integer xSrc, ;
integer ySrc, ;
integer dwRop
DECLARE integer GetBitmapBits IN WIN32API integer hbitmap, integer dwcount, string lpbits
DECLARE integer CreateDIBSection IN WIN32API integer hdc, string lcbitmapinfo, integer un, string lplpvoid, integer handle, integer dw
ENDPROC
PROCEDURE getRect(lnLeft, lnTop, lnRight, lnBottom, lnWidth, lnHeight)
LOCAL lpRect
lpRect = REPLICATE(CHR(0),16)
= GetWindowRect(hwnd,@lpRect)
lnLeft = buf2int(SUBSTR(lpRect, 1,4))
lnTop = buf2int(SUBSTR(lpRect, 5,4))
lnRight = buf2int(SUBSTR(lpRect, 9,4))
lnBottom = buf2int(SUBSTR(lpRect, 13,4))
lnWidth = lnRight - lnLeft
*!* lnHeight = lnTop -lnBottom
lnHeight =lnBottom-lntop
RETURN
PROCEDURE
FUNCTION buf2int
PARAMETERS oldpc
IF TYPE('oldpc') = 'N' then
lnBig = INT(oldpc/256)
lnSmall = oldpc -lnBig*256
RETURN ALLTRIM(CHR(lnSmall)) + ALLTRIM(CHR(lnBig)) + CHR(0) + CHR(0)
ELSE
lnresult = 0
lnlast = LEN(oldpc)
FOR lni = 1 TO lnlast
lnresult = lnresult + ASC(SUBSTR(oldpc,lni,1))*(256^(lni-1))
ENDFOR
lnmsb = (lnlast*8) - 1
IF BITTEST(lnresult,lnmsb)
lnmax = (2^(lnmsb + 1))
lnresult = lnresult - lnmax
ENDIF
RETURN lnresult
ENDIF
ENDFUNC
FUNCTION int2buf &&这段代码写得如此青涩，见证了一段岁月，现在只需一句即可。。。
PARAMETERS lnumber,lnlength
DO case
CASE lnlength=1
max_lnumber=0xff
CASE lnlength=2
max_lnumber=0xffff
CASE lnlength=3
max_lnumber=0xffffff
CASE lnlength=4
max_lnumber=0xffffffff
OTHERWISE
messagebox([只能转换4位以下数据！],0+16,[错误！]
return []
ENDCASE
lcbuff=[]
if lnumber>max_lnumber
messagebox([数据太大超过许可范围！],0+16,[错误！])
return []
ELSE
lchex=int2hex(lnumber)
lchex=SUBSTR(lchex,3,LEN(lchex))
lnlen=LEN(lchex)
lchex=REPLICATE([0],lnlength*2-lnlen)+lchex
for i=1 to lnlength
nhex=[0x]+SUBSTR(lchex,(lnlength+1-i)*2-1,2)
lcbuff=lcbuff+CHR(&nhex)
ENDFOR
ENDIF
return lcbuff
FUNCTION int2hex
PARAMETERS x
lcreturn=[0x]
if x>=16
i=qumi(x)
DO while .t.
temp=INT(x/16^i)
x=x-temp*16^i
if x<16
lcreturn=lcreturn+hexchar(temp)+REPLICATE([0],i-1)+hexchar(x)
EXIT
ELSE
lcreturn=lcreturn+hexchar(temp)
i=i-1
LOOP
ENDIF
ENDDO
return lcreturn
ELSE
return lcreturn+hexchar(x)
ENDIF
ENDFUNC
FUNCTION qumi
PARAMETERS y
n=0
if y<16
return n
ELSE
DO while .t.
y=INT(y/16)
n=n+1
if y<16
EXIT
ELSE
LOOP
ENDIF
ENDDO
return n
ENDIF
ENDFUNC
FUNCTION hexchar
PARAMETERS z
DO case
CASE z<10
return allt(STR(z))
CASE z=10
return [A]
CASE z=11
return [B]
CASE z=12
return [C]
CASE z=13
return [D]
CASE z=14
return [E]
CASE z=15
return [F]
ENDCASE
ENDFUNC
2023-09-02 15:12
myclass.rar
(22.68 KB)