程序代码：

* 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