Forum AtoutFox : Re: Imprimer un formulaire   

mer. 18 mars 2026, 08h39
jcriv
France
atoutfox.public.association

Re: Imprimer un formulaire

Bonjour.
Pour une astuce, j'utilisais ça pour imprimer via word (code d'origine donné par Mike Gagnon) : faire une copie de l'écran contenant les graphiques/images, coller dans un doc, imprimer le doc.
Si ça peut t'aider...

=Form2Clipboard(ThisForm.HWnd)


FUNCTION Form2Clipboard
PARAMETERS hWnd
*!* Parts of this code was borrowed http://www.news2news.com/vfp/
*!* Mike Gagnon
WAIT WINDOW "Calculs en cours..." NOWAIT
*!* * Removed 29/09/2015
*!* LOCAL oWord as Word.application
#DEFINE CF_BITMAP 2
#DEFINE SRCCOPY 13369376
DO copyActiveWindow
PRIVATE lnLeft,lnTop,lnRight,lnBottom,lnWidth,lnHeight
IF IsVide(hwnd)
hwnd = GetFocus()
ENDIF
STORE 0 TO lnLeft, lnTop, lnRight, lnBottom, lnWidth, lnHeight
= getRect (@lnLeft, @lnTop, @lnRight, @lnBottom, @lnWidth,@lnHeight)
hdc = GetWindowDC(m.hwnd)
hVdc = CreateCompatibleDC(m.hdc)
hBitmap = CreateCompatibleBitmap(m.hdc, m.lnWidth, m.lnHeight)
= SelectObject (m.hVdc, m.hBitmap)
= BitBlt (hVdc, 0,0, m.lnWidth, m.lnHeight, m.hdc, 0,0, SRCCOPY)
= OpenClipboard (m.hwnd)
= EmptyClipboard()
= SetClipboardData (CF_BITMAP, hBitmap)
= CloseClipboard()
= DeleteObject (hBitmap)
= DeleteDC (hVdc)
= ReleaseDC (hwnd, hdc)
*!* oWord=CREATEOBJECT("word.application")
*!* oWord.Documents.Add()
*!* loSelection=oWord.Selection
*!* IF m.loSelection.PageSetup.Orientation = 0 Then
*!* m.loSelection.PageSetup.Orientation = 1
*!* ELSE
*!* m.loSelection.PageSetup.Orientation = 0
*!* ENDIF
*!* m.loselection.PasteAndFormat(2)
*!* oWord.Visible =.t.
*!* WAIT CLEAR
Inform("L'image écran est dans le presse-papier")
RETURN
PROCEDURE copyActiveWindow
DECLARE INTEGER GetWindowRect IN user32 INTEGER hwnd, STRING @ lpRect
DECLARE INTEGER SelectObject IN gdi32 INTEGER hdc,INTEGER hObject
DECLARE INTEGER ReleaseDC IN user32 INTEGER hwnd,INTEGER hdc
DECLARE INTEGER CreateCompatibleDC IN gdi32 INTEGER hdc
DECLARE INTEGER DeleteObject IN gdi32 INTEGER hObject
DECLARE INTEGER DeleteDC IN gdi32 INTEGER hdc
DECLARE INTEGER CloseClipboard IN user32
DECLARE INTEGER GetFocus IN user32
DECLARE INTEGER EmptyClipboard IN user32
DECLARE INTEGER GetWindowDC IN user32 INTEGER hwnd
DECLARE INTEGER OpenClipboard IN user32 INTEGER hwnd
DECLARE INTEGER SetClipboardData IN user32 INTEGER wFormat, INTEGER hMem
DECLARE INTEGER CreateCompatibleBitmap IN gdi32;
INTEGER hdc, INTEGER nWidth, INTEGER nHeight

DECLARE INTEGER BitBlt IN gdi32;
INTEGER hDestDC, INTEGER x, INTEGER y,;
INTEGER nWidth, INTEGER nHeight, INTEGER hSrcDC,;
INTEGER xSrc, INTEGER ySrc, INTEGER dwRop
RETURN
PROCEDURE getRect(lnLeft, lnTop, lnRight, lnBottom,lnWidth, lnHeight)
LOCAL lpRect
lpRect = Repli(Chr(0), 16)
= GetWindowRect (hwnd, @lpRect)
lnLeft = buf2dword(SUBSTR(lpRect, 1,4))
lnTop = buf2dword(SUBSTR(lpRect, 5,4))
lnRight = buf2dword(SUBSTR(lpRect, 9,4))
lnBottom = buf2dword(SUBSTR(lpRect, 13,4))
lnWidth = lnRight - lnLeft
lnHeight = lnBottom - lnTop
RETURN
FUNCTION buf2dword (lcBuffer)
RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
Asc(SUBSTR(lcBuffer, 2,1)) * 256 +;
Asc(SUBSTR(lcBuffer, 3,1)) * 65536 +;
Asc(SUBSTR(lcBuffer, 4,1)) * 16777216

Permalink : http://www.atoutfox.org/nntp.asp?ID=0000020347