VFP繪製Excel像素畫。GetPixel 函數


*聲明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

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章