* Placing the active window (retrieved with GetFoucs) into a BMP file
* with defferent format , such as 2colors, 16colors , 256colors , fullcolor and truecolor
* 将当前窗口作为BMP图像以不同的格式保存到文件中
* 小蒋
* *****************************
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
dvdc = 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(hbitmap)
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
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
2023-09-02 15:12
程序代码：
myclass.rar
(22.68 KB)