运算量极小的黑白化图片程序 - 编程论坛

#2

schtg2023-09-02 16:37

谢谢分享！

#3

seasoners2023-09-06 09:36

color.dat内容？

#4

seasoners2023-09-06 11:41

* 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

#5

seasoners2023-09-06 11:42

我将代码整理了一下，因为没有color.dat文件，所以没有调试，请高手整理出color.dat文件，并将此程序调通，谢谢

#6

sam_jiang2023-09-06 16:58

回复 5楼 seasoners

感谢你码的每个字母，哈哈哈。。。

#7

sam_jiang2023-09-06 17:03

感谢楼上热心的网友seasoners，我把黑白那部分代码重写了，仅供参考。。。

程序代码：

***********************************************************************************************************
*!* blackwhite.prg
*!*    参考自己10几年前写的图片格式转换代码，重新编写这一段精简代码。
*!*    这是一个直接将截屏转换为黑白图片的演示程序，
*!*    运行本示例可以将截取_screen 的200 X 200 的区域，
*!*    并在你的默认目录中以文件名为testbw.bmp保存。
*!*    同理，稍加修改，它可以用在图片格式转换中，直接将彩图转换为黑白图片。
*!*    这个速度简直不要太快，就是不知道成图效果和挨个对图像数据流进行运算的二值化算法的效果一不一样？
*!*    当初VB代码是一个台湾人写的，可惜忘记他的网名了，在此表示感谢！
*!*    作者：Sam Jiang
*!*    时间：2023/09/06
***********************************************************************************************************
clea all
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,integer,integer
declare integer CreateCompatibleBitmap in win32api integer
DECLARE integer GetBitmapBits IN WIN32API integer,integer,string
DECLARE integer CreateDIBSection IN WIN32API integer,string,integer,integer,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

hdc=getdc(_screen.HWnd)
hvdc=createcompatibledc(hdc,200,200)
hbitmap=createbitmap(200,200,1,1,null)
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
    lcbmpfdata=lcbitmapdata
ENDIF
messagebo(TRANSFORM(LEN(lcbmpfdata)))
bmpfile=NEWOBJECT("bmpfile","myclass")
WITH bmpfile
    .bitmapdata=lcbmpfdata
    .colortable=bintoc(0,"4rs")+bintoc(RGB(255,255,255),"4rs")
    WITH .bmfheader
        .bfoffbits=54+8
        .bfsize=54+8+LEN(lcbmpfdata)
    ENDWITH
    WITH .bmiheader
        .bibitcount=1
        .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

中间要用到一个我自己写的类，一并打包上传，有疑问的可以找我。。。
把文件解压到你的fox默认目录即可。

只有本站会员才能查看附件，请登录

#8

sam_jiang2023-09-06 17:15

我重新写了生成颜色表的几个程序：
把几个程序的值连起来保存为color.dat就可以了。
黑白的调色板很简单就8个字符：

colortable=bintoc(0,"4rs")+bintoc(RGB(255,255,255),"4rs")
&& 如果颠倒这个8个字符，可以获得一副反白的黑白图。。。
&& colortable=bintoc(RGB(255,255,255),"4rs")+bintoc(0,"4rs")

程序代码：

******************************************************
*！* 256色调色板生成程序colortable256
DIMENSION colors[256]
i=0
ccolortable256=""
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)
            ccolortable256=ccolortable256+BINTOC(colors[i+1],"4rs")
            i=i+1
        ENDFOR
    ENDFOR
ENDFOR

RETURN ccolortable256

程序代码：

******************************************************
*！* 16色调色板生成程序colortable16
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")
ENDF
RETURN ccolortable

程序代码：

******************************************************
*！* 灰阶256色调色板生成程序colortable256
DIMENSION graycolors[256]
ccolortable=""
FOR i=0 TO 255
graycolors[i+1]=RGB(i,i,i)
ccolortable=ccolortable+BINTOC(graycolors[i+1],"4rs")
ENDFOR
RETURN ccolortable

#9

schtg2023-09-06 18:17

谢谢你的指导！

#10

sam_jiang2023-09-06 19:19

回复 9楼 schtg

客气了。。

#11

sam_jiang2023-09-06 19:32

找到当时的VB源码，应该是一个台湾的蔡姓网友（C.K. Tsai），一会也分享上来，懂VB的兄弟可以翻译一下。

#12

seasoners2023-09-07 21:29

回复 6楼 sam_jiang

您这个类我学习了一下，其背后的应用一定是个极好的作品，能介绍一下吗？

#13

seasoners2023-09-07 21:31

sam jiang,您好，我所转的代码缺少int2buf函数，即使作出了COLOR.DAT，依然是用不了

#14

sam_jiang2023-09-07 21:52

回复 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

#15

sam_jiang2023-09-07 21:58

回复 12楼 seasoners

这个自己写的myclass类，只有有关ini文件的inifile，和有关bitmap图片的bmpfile比较成熟，感兴趣的话，可以交流。

其他类都是未完成的类

#16

seasoners2023-09-08 10:03

回复 14楼 sam_jiang

我运行了，是这个样子

只有本站会员才能查看附件，请登录

#17

sam_jiang2023-09-08 12:35

回复 16楼 seasoners

我重写了这个程序，另外立贴贴出源代码，你可以参考。

感谢你的热心和努力付出。

#18

蚂蚁0082023-10-22 11:30

厉害