|
|
#7
sych2024-10-31 11:07
自己写一个，可以避免屏幕放大造成的困扰，而且屏幕被遮挡也可以正确截屏
PUBLIC oform1
oform1=NEWOBJECT("form1")
oform1.Show
RETURN
DEFINE CLASS form1 AS form
ShowWindow = 2
DoCreate = .T.
Caption = "Form1"
BackColor = RGB(240,240,0)
Name = "Form1"
ADD OBJECT image1 AS image WITH ;
Picture = GETPICT(),;
Stretch = 2, ;
Height = 200, ;
Left = 84, ;
Top = 24, ;
Width = 200, ;
Name = "Image1"
ADD OBJECT command1 AS commandbutton WITH ;
Top = 108, ;
Left = 324, ;
Height = 25, ;
Width = 60, ;
Caption = "截图", ;
Name = "Command1"
PROCEDURE command1.Click
thisformTitleBar=thisform.TitleBar
thisformBorderStyle= thisform.BorderStyle
thisform.TitleBar=0
thisform.BorderStyle= 0
hwnd=thisform.hwnd
tcFile="c:\tp.bmp"
lleft=thisform.image1.Left
ltop=thisform.image1.Top
lwidth=thisform.image1.Width
lheight=thisform.image1.height
DECLARE INTEGER GetDesktopWindow IN win32api
DECLARE INTEGER GetDC IN win32api INTEGER hwnd
Declare SHORT GetWindowRect IN user32 INTEGER hwnd, STRING @ lpRect
DECLARE Long GetWindowDC IN WIN32API Long hWnd
DECLARE Long ReleaseDC IN WIN32API Long hWnd, Long hDc
DECLARE Long CreateCompatibleDC IN WIN32API Long hDc
DECLARE Long DeleteDC IN WIN32API Long hDc
DECLARE Long CreateCompatibleBitmap IN WIN32API Long hDc, Long nWidth, Long nHeight
DECLARE Long SelectObject IN WIN32API Long hDc, Long hObject
DECLARE Long DeleteObject IN WIN32API Long hObject
DECLARE Long GdiplusStartup IN gdiplus Long @ token, String @ inputbuf, Long @ outputbuf
DECLARE Long GdiplusShutdown IN gdiplus Long token
DECLARE Long GdipCreateBitmapFromHBITMAP IN gdiplus Long hbitmap, Long hpalette, Long @ hGpBitmap
Declare Long GdipCreateBitmapFromScan0 in GdiPlus.dll ;
Integer width, Integer height, Integer stride, Long format, Long scan0, Long @ bitmap
Declare Long GdipGetImageGraphicsContext in GdiPlus.dll Long image, Long @ graphics
DECLARE LONG GdipDeleteGraphics IN GDIPLUS LONG graphics
Declare Long GdipDrawImageRectI in GdiPlus.dll ;
Long graphics, Long image, Integer x, Integer y, Integer width, Integer height
DECLARE Long GdipDisposeImage IN gdiplus Long image
DECLARE Long GdipSaveImageToFile IN gdiplus Long nImage, String FileName,String @ clsIdEncoder, Long encoderParams
DECLARE INTEGER CLSIDFromString IN ole32 STRING lpsz, STRING @pclsid
DECLARE INTEGER PrintWindow IN win32api INTEGER,INTEGER ,INTEGER
DECLARE INTEGER BitBlt IN gdi32;
INTEGER hDestDC, INTEGER x, INTEGER y,;
INTEGER nWidth, INTEGER nHeight, INTEGER hSrcDC,;
INTEGER xSrc, INTEGER ySrc, INTEGER dwRop
#define SRCCOPY 0x00CC0020
LOCAL cFileExtName, cEncoder, iInputBuf, iResult, hDesktopDc, hVDc, hBitmap, hToken, hGdipBitmap,encoderClsid,lpRect,lnWidth,lnheight,abc
m.cFileExtName =LOWER( JUSTEXT( m.tcFile ))
m.hDesktopDc = GetDC( m.hWnd )
m.hVdc = CreateCompatibleDC( m.hDesktopDc )
lpRect = REPLI (Chr(0), 16)
=GetWindowRect (m.hWnd, @lpRect)
lnWidth=ctobin(SUBS(lpRect,9,4),'4rs')-ctobin(SUBS(lpRect,1,4),'4rs')
lnHeight=ctobin(SUBS(lpRect,13,4),'4rs')-ctobin(SUBS(lpRect,5,4),'4rs')
m.hBitmap = CreateCompatibleBitmap( m.hDesktopDc,lnWidth,lnHeight )
ABC=SelectObject( m.hVdc, m.hBitmap )
IF hwnd=GetDesktopWindow()
=BitBlt(hvDC,0,0,lnwidth,lnHeight,hDesktopDc,0,0,SRCCOPY)
else
=PrintWindow(m.hWnd,m.hVdc,0)
endif
m.hToken = 0
m.iInputBuf = PADR(CHR(1), 16, CHR(0))
m.iResult = -1
IF ( 0 == GdiplusStartup( @ m.hToken, @ m.iInputBuf, 0 ))
m.hGdipBitmap = 0
IF ( 0 == GdipCreateBitmapFromHBITMAP(m.hBitmap, 0, @ m.hGdipBitmap ))
lnFormat=0x00021808
graphics = 0
resizedImage = 0
=GdipCreateBitmapFromScan0(lwidth,lheight, 0, m.lnFormat, 0, @resizedImage)
=GdipGetImageGraphicsContext(m.resizedImage, @graphics)
=GdipDrawImageRectI(m.graphics, m.hGdipBitmap,-lleft,-ltop,lnwidth,lnheight)
m.encoderClsid = "{557CF40"+chr(47+(at(m.cFileExtName,"bmpjpggif tifpng")+2)/3)+"-1A04-11D3-9A73-0000F81EF32E}"
cEncoder= REPLICATE(CHR(0),16)
CLSIDFromString(STRCONV(m.encoderClsid + CHR(0), 5), @cEncoder)
m.iResult = GdipSaveImageToFile(m.resizedImage,STRCONV( m.tcFile+CHR(0), 5 ), @ m.cEncoder, 0 )
GdipDeleteGraphics(graphics)
GdipDisposeImage(m.resizedImage)
GdipDisposeImage( m.hGdipBitmap )
ENDIF
GdiplusShutdown( m.hToken )
ENDIF
=DeleteObject( m.hBitmap )
=DeleteDC( m.hVdc )
=ReleaseDC( 0, m.hDesktopDc )
thisform.TitleBar=thisformTitleBar
thisform.BorderStyle=thisformBorderStyle
RETURN
ENDPROC
ENDDEFINE
|
