print preview using Windows metafiles

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
Wilko
Posts: 23
Joined: Oct 26, 2016 7:57

print preview using Windows metafiles

Postby Wilko » Mar 22, 2020 15:58

(Windows only)
Recently I wanted to make a print preview option in my program. I decided to dive onto Windows metafiles and that worked. I share with you the test-code. The printer and paper size are hardcoded in this demo. In a real application, I would put the code for displaying a page on screen in the WM_PAINT handler; in addition, I make one metafile per page (and an array of metafile handles) to quickly display previous or next page. Maybe useful for one of you. (And yes, it can be improved...)

Code: Select all

#DEFINE UNICODE

#INCLUDE ONCE "windows.bi"

declare FUNCTION GetFontHandle(byval hDC as HDC, strFName AS const wSTRING, BYVAL lPointSize AS LONG, BYVAL lWeight AS LONG, BYVAL bItalic AS BYTE, BYVAL bUnderline AS BYTE, BYVAL bStrikeOut AS BYTE, BYVAL bCharSet AS BYTE) AS HFONT
declare FUNCTION WndProc(BYVAL hWndForm AS HWND, BYVAL wMsg AS UINT, BYVAL wParam AS wParam, BYVAL lParam AS lParam) AS LRESULT
declare Sub CreateEMF
declare sub DisplayPrintPreview
declare sub PrintEMF

dim shared hEmf as HENHMETAFILE
dim shared hWndPage as HWND
dim shared hFont as HFONT

'---------------------------------------------------------------------------------------------------------------------------------------
FUNCTION WinMain(BYVAL hInstance AS HINSTANCE, BYVAL hPrevInstance AS HINSTANCE, BYVAL szCmdLine AS ZSTRING PTR, BYVAL nCmdShow AS LONG) AS LONG

  dim ClassName as wstring * MAX_PATH
  dim hwndMain as HWND
  DIM wMsg AS MSG
  DIM WCE AS WndClassEx

  ClassName = "TestPrinting"
  WCE.cbSize = SIZEOF(WCE)
  WCE.style = CS_HREDRAW or CS_VREDRAW
  WCE.lpfnWndProc = CAST(WNDPROC, @WndProc)
  WCE.cbClsExtra = 0
  WCE.cbWndExtra = 0
  WCE.hInstance = hInstance
  WCE.hIcon = LoadIcon(NULL, IDI_APPLICATION)
  WCE.hCursor = LoadCursor(NULL, IDC_ARROW)
  WCE.hbrBackground = GetStockObject(WHITE_BRUSH)
  WCE.lpszMenuName = NULL
  WCE.lpszClassName = @ClassName

  RegisterClassEx(VARPTR(WCE))

  hwndMain = CreateWindowEx(WS_EX_WINDOWEDGE OR WS_EX_CONTROLPARENT OR WS_EX_LEFT OR WS_EX_LTRREADING OR WS_EX_RIGHTSCROLLBAR, ClassName, "caption", _
                 WS_POPUP OR WS_THICKFRAME OR WS_CAPTION OR WS_SYSMENU OR WS_MINIMIZEBOX OR WS_MAXIMIZEBOX OR WS_CLIPSIBLINGS OR WS_CLIPCHILDREN, CW_USEDEFAULT, _
                 CW_USEDEFAULT, 600, 400, 0, CAST(HMENU, CAST(LONG_PTR, Null)), hInstance, 0)

  ShowWindow(hwndMain, SW_SHOWNORMAL)
  'create three buttons
  CreateWindowEx(0&, "BUTTON", "create EMF", (BS_PUSHBUTTON OR WS_TABSTOP OR WS_VISIBLE OR WS_CHILD), 16, 16, 100, 30, hwndMain, CAST(HMENU, 1000), hInstance, 0&)
  CreateWindowEx(0&, "BUTTON", "display EMF", (BS_PUSHBUTTON OR WS_TABSTOP OR WS_VISIBLE OR WS_CHILD), 146, 16, 100, 30, hwndMain, CAST(HMENU, 1001), hInstance, 0&)
  CreateWindowEx(0&, "BUTTON", "print EMF", (BS_PUSHBUTTON OR WS_TABSTOP OR WS_VISIBLE OR WS_CHILD), 276, 16, 100, 30, hwndMain, CAST(HMENU, 1002), hInstance, 0&)
  'create a static that we will use for displaying the metafile
  'now fixed paper size: A4 = 210 x 297 mm (+ 2 pixels for border)
  hWndPage = CreateWindowEx(0, "STATIC", "", (SS_LEFT or WS_VISIBLE OR WS_CHILD or WS_BORDER OR SS_OWNERDRAW), 16, 50, (210 + 2), (297 + 2), hwndMain, 0&, hInstance, 0&)

  UpdateWindow(hwndMain)

  DO WHILE GetMessage(@wMsg, 0, 0, 0)
    TranslateMessage @wMsg
    DispatchMessage @wMsg
  LOOP
  FUNCTION = false

END FUNCTION
END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)
'---------------------------------------------------------------------------------------------------------------------------------------
FUNCTION WndProc(BYVAL hWnd AS HWND, BYVAL wMsg AS UINT, BYVAL wParam AS wParam, BYVAL lParam AS lParam) AS LRESULT

  dim ps as PAINTSTRUCT
  dim rc as RECT
  dim hdc as HDC     
  dim hdcEMF as hDC
  dim RC2 as RECT

  SELECT CASE wMsg
    case WM_COMMAND
      select case wParam
        case 1000 'button create enhanced metafile
          CreateEMF
        case 1001
          if hEmf > 0 then DisplayPrintPreview else print "metafile does not exit yet; no painting"
        case 1002
          if hEmf > 0 then PrintEMF else print "metafile does not exit yet; no printing"
      end select
    CASE WM_CLOSE
      DeleteEnhMetaFile(hEmf)
      PostQuitMessage 0
      FUNCTION = FALSE
      EXIT FUNCTION
  end select

  FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

END FUNCTION
'---------------------------------------------------------------------------------------------------------------------------------------
FUNCTION GetFontHandle(hDC as HDC, strFName AS const wSTRING, BYVAL lPointSize AS LONG, BYVAL lWeight AS LONG, BYVAL bItalic AS BYTE, BYVAL bUnderline AS BYTE, BYVAL bStrikeOut AS BYTE, BYVAL bCharSet AS BYTE) AS HFONT
 
  DIM TLF AS LOGFONTW
 
  TLF.lfHeight = -MulDiv(lPointSize, GetDeviceCaps(hDC, LOGPIXELSY), 72)
'  TLF.lfWidth = 0   
'  TLF.lfEscapement = 0
'  TLF.lfOrientation = 0
  TLF.lfWeight = lWeight 
  TLF.lfItalic = bItalic
  TLF.lfUnderline = bUnderline
  TLF.lfStrikeOut = bStrikeOut   
  TLF.lfCharSet = bCharset       
  TLF.lfOutPrecision = OUT_TT_PRECIS   
  'TLF.lfClipPrecision = CLIP_DEFAULT_PRECIS 
  'TLF.lfQuality = DEFAULT_QUALITY 
  'TLF.lfPitchAndFamily = FF_DONTCARE     
  TLF.lfFaceName = strFName     
 
  FUNCTION = CreateFontIndirectW(@TLF)

END FUNCTION
'---------------------------------------------------------------------------------------------------------------------------------------
Sub CreateEMF

  dim FontHeight as single
  dim hdcEMF as hDC
  dim hDCPrinter as hDC
  dim I as long
  dim PrintY as long
  dim RC AS RECT
  dim wstrTmp as wstring * Max_Path
  DIM SL AS SIZE

  RC.Left = 1: RC.Top = 1: RC.Right = 21000: RC.Bottom = 29700 'paper size A4 now hardcoded
  hDCPrinter = CreateDC(NULL, "Foxit Reader PDF Printer", NULL, NULL)  'printer now hardcoded
  hdcEMF = CreateEnhMetaFile(hDCPrinter, NULL, @RC, NULL)
  SetMapMode(hdcEMF, MM_ANISOTROPIC)
  SetWindowExtEx(hdcEMF, 21000, 29700, NULL) 'logical units!   'now hardcoded
  SetViewportExtEx(hdcEMF, 4960, 7015, NULL) 'hardcoded for printer device units
 
  'some graphic commands to show that it works
  Rectangle (hdcEMF, 8000, 8000, 9000, 10000)
  MoveToEx  (hdcEMF, 6900, 6900, NULL)
  LineTo    (hdcEMF, 7100, 7100)
  MoveToEx  (hdcEMF, 6900, 7100, NULL)
  LineTo    (hdcEMF, 7100, 6900)

  'create font for use in metafile
  FontHeight = 10 * (29700 / GetDeviceCaps(hDCPrinter, PHYSICALHEIGHT))
  hFont = GetFontHandle(hDCPrinter, "Cambria", FontHeight, FW_NORMAL, FALSE, False, False, DEFAULT_CHARSET)
  SelectObject(hDCEMF, hFont) 'use in metafile

  'select in hDCPrinter for GetTextExtentPoint32
  SelectObject(hDCPrinter, hFont)
  GetTextExtentPoint32 hDCPrinter, "Text", 4, @SL 'get text size; any string will do
  PrintY = 1000 'start printing at 1 cm from top of page
  for I = 1 to 66
    wstrTmp = "This is Cambria 11 pt, line " & wstr(I)
    TextOut(hDCEMF, 1000, PrintY, wstrTmp, len(wstrTmp))
    PrintY = PrintY + SL.CY
  next I

  hEmf = CloseEnhMetaFile(hdcEMF)

end sub
'---------------------------------------------------------------------------------------------------------------------------------------
sub DisplayPrintPreview

  dim rc as RECT
  dim hdc as HDC
 
  'once the metafile is created, this is all the code you need to display it
  hdc = GetDC(hWndPage)
  GetClientRect(hWndPage, @RC) 
  PlayEnhMetaFile(hdc, hemf, @RC)
  releaseDC(hWndPage, hDC)

end sub
'---------------------------------------------------------------------------------------------------------------------------------------
sub PrintEMF

  dim hDCPrinter as hDC
  dim MyDocInfo as DOCINFO
  dim RC as RECT

  'once the metafile is created, this is all the code you need to print it
  hDCPrinter = CreateDC(NULL, "Foxit Reader PDF Printer", NULL, NULL) 'printer now hardcoded

  MyDocInfo.cbSize = SizeOf(MyDocInfo)
  MyDocInfo.lpszDocName = @"TestFile"
  MyDocInfo.lpszOutput = NULL
  StartDoc(hDCPrinter, @MyDocInfo)
  StartPage(hDCPrinter)
 
  'in case you want to set a clip region: uncomment next 6 lines
'  dim hRgn as HRGN
'  dim CutOff as Single
'  CutOff = 0.1 'for testing: set a 10% margin
'  hRgn = CreateRectRgn(GetDeviceCaps(hDCPrinter, PHYSICALWIDTH) * CutOff, GetDeviceCaps(hDCPrinter, PHYSICALHEIGHT) * CutOff, GetDeviceCaps(hDCPrinter, PHYSICALWIDTH) * (1 - CutOff), GetDeviceCaps(hDCPrinter, PHYSICALHEIGHT) * (1 - CutOff)) 'must be in device units!
'  'The SelectClipRgn function assumes that the coordinates for a region are specified in device units.
'  SelectClipRgn(hDCPrinter, hRgn)
 
  RC.left   = 0
  RC.right  = GetDeviceCaps(hDCPrinter, PHYSICALWIDTH)
  RC.top    = 0
  RC.bottom = GetDeviceCaps(hDCPrinter, PHYSICALHEIGHT)

  PlayEnhMetaFile(hDCPrinter, hemf, @RC)
  EndPage(hDCPrinter)
  EndDoc(hDCPrinter)
  DeleteDC(hDCPrinter)

end sub
UEZ
Posts: 417
Joined: May 05, 2017 19:59
Location: Germany

Re: print preview using Windows metafiles

Postby UEZ » Mar 22, 2020 16:04

Somehow it doesn't look properly when I run it and press create EMF -> display EMF

Image

Print button is not working.

Tested on Win10
Wilko
Posts: 23
Joined: Oct 26, 2016 7:57

Re: print preview using Windows metafiles

Postby Wilko » Mar 22, 2020 16:12

This is how it is supposed to look: http://www.cheaqs.eu/screen.png. And printing only works if you have the Foxit PDF printer installed, or hardcode your own printer and then also change the printer width and height (device units) (this was only a proof of concept).

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 1 guest