VFP绘制Excel像素画。GetPixel 函数

VFP调用Win32API实现图片读取与Excel绘制

最新推荐文章于 2022-10-02 17:15:49 发布

原创最新推荐文章于 2022-10-02 17:15:49 发布 · 554 阅读

CC 4.0 BY-SA版权


*声明API
Declare Integer LoadImage In WIN32API Integer hinst,String lpszName,Integer uType,Integer cxDesired,Integer cyDesired,Integer fuLoad
Declare Integer CreateCompatibleDC In WIN32API Integer hdc
Declare Integer DeleteDC In WIN32API Integer hDC
Declare Integer SelectObject In WIN32API Integer hdc,Integer hgdiobj
Declare Integer DeleteObject In WIN32API Integer hObject
Declare Integer GetPixel In WIN32API Integer hdc,Integer nXPos,Integer nYPos

*定义常量
#Define IMAGE_BITMAP        0
#Define LR_LOADFROMFILE     0x0010

*获取位图文件
Local cFile As String
*cFile = Getfile()
cFile="C:\USERS\ADMINISTRATOR\PICTURES\TEST3.BMP"
?cFile
_cliptext=cfile
If !Empty(cFile) And File(cFile)
	Img = Createobject("WIA.ImageFile")
	Img.LoadFile (cFile )
    Local hBitmap As Integer ,hMemDC As Integer,hOldObject As Integer,;
        nXCoord As Integer ,nYCoord As Integer ,nColor As Integer ,nRedColor As Integer ,nGreenColor As Integer ,nBlueColor As Integer

    *加载位图文件
    hBitmap = LoadImage(0,cFile,IMAGE_BITMAP,0,0,LR_LOADFROMFILE)
    If Empty(hBitmap)
        Messagebox("加载位图失败！")
        Return .F.
    Endif

    *创建窗口兼容内存DC
    hMemDC = CreateCompatibleDC(0)
    If Empty(hMemDC)
        Messagebox("创建内存兼容DC失败！")
        DeleteObject(hBitmap)    &&释放句柄
        Return .F.
    Endif

    *将位图选入内存兼容DC
    hOldObject = SelectObject(hMemDC,hBitmap)
    
	*!* 1．创建Excel对象
	oExcel=Createobject("Excel.application")
	*!* 2．添加新工作簿
	oExcel.Workbooks.Add
	*!* 3．设置第3个工作表为激活工作表
	oExcel.Worksheets("sheet3").Activate     
	
	*!* 6．更改Excel标题栏
	oExcel.Caption="VFP应用程序调用Microsoft Excel"
	oExcel.Visible=.T.
	 
	oExcel.ActiveSheet.Range(oExcel.ActiveSheet.Cells(1, 1), oExcel.ActiveSheet.Cells(Img.Height,Img.Width )).Interior.Color=RGB(255,255 ,255 )
	oExcel.ActiveSheet.Range(oExcel.ActiveSheet.Columns(1), oExcel.ActiveSheet.Columns(Img.Width )).ColumnWidth=0.08
	oExcel.ActiveSheet.Range(oExcel.ActiveSheet.rows(1), oExcel.ActiveSheet.rows(Img.Height)).RowHeight=0.75
 
	for	y=1 TO Img.Height 		
		for	x=1 TO Img.Width
*!*	   			debug
			nColor = GetPixel(hMemDC,x,y)
			IF nColor>0	AND nColor<>16777215			
				nRedColor = BitRShift(BitLShift(nColor,24),24)        &&红色位于右侧第一个字节，所以先向左移动三个字节（作用是清除其左侧三个高位字节的值）再向右移动3个字节。
				nGreenColor = BitRShift(BitLShift(nColor,16),24)    &&绿色位于右侧第二个字节，所以先向左移动两个字节（作用是清除其左侧两个高位字节的值）再向右移动3个字节。
				nBlueColor = BitRshift(nColor,16)                    &&蓝色位于右侧第三个字节，所以向右移动2个字节。 
		        oExcel.cells(y,x).Interior.Color=RGB(nRedColor,nGreenColor ,nBlueColor )
	        endif
		ENDFOR
	ENDFOR
	
*!*		oExcel.Quit &&退出EXCEL
*!*		Release oExcel &&释放变量
    *恢复GDI环境
    SelectObject(hMemDC,hOldObject)

    *使用完毕清理环境，释放资源以避免内存泄漏！
    DeleteDC(hMemDC)
    DeleteObject(hBitmap)
Endif