Printing FBGFX screen or image on Windows.

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
D.J.Peters
Posts: 7852
Joined: May 28, 2005 3:28

Printing FBGFX screen or image on Windows.

Postby D.J.Peters » Nov 25, 2013 4:43

Print the whole FBGFX screen or an image streched or in original size.

Joshy

Code: Select all

#include once "windows.bi"
#include once "win/wingdi.bi"
#include once "win/commdlg.bi"

sub PrintImage(p as any ptr=0, Stretched as integer=1)
  static as integer id=0
  if screenptr()=0 then return
  dim as HWND hWin : Screencontrol 2,cast(integer,hWin)
  id+=1
  dim as string path = environ("Tmp")
  if right(path,1)<>"\" then path += "\"
  dim as string file = path & "printjob" & id & ".bmp"
  BSave path, p
  ' get printer DC
  dim as PRINTDLG pd
  with pd
    .lStructSize = sizeof(PRINTDLG)
    .hwndOwner = hWin
    .Flags = PD_RETURNDC
  end with
  PrintDlg(@pd)
  dim as HDC hDCPrinter =pd.hDC
  if hDCPrinter then
    dim as HBITMAP hBitmap = LoadImage(NULL,File,IMAGE_BITMAP,0,0,LR_CREATEDIBSECTION or LR_DEFAULTSIZE or LR_LOADFROMFILE)
    if hBitmap then
      dim as BITMAP bm
      GetObject(hBitmap,sizeof(BITMAP),@bm)
      dim as DOCINFO di
      with di
        .cbSize = sizeof(DOCINFO)
        .lpszDocName =strptr(file)
      end with

      dim as HDC hDCMemory = CreateCompatibleDC(hDCPrinter)
      dim as HBITMAP hOldBitmap = SelectObject(hDCMemory, hBitmap)
      StartDoc(hDCPrinter, @di)
        StartPage(hDCPrinter)
          if Stretched then
            dim as integer PrinterW = GetDeviceCaps(hDCPrinter, HORZRES)
            dim as integer PrinterH = GetDeviceCaps(hDCPrinter, VERTRES)
            dim as single MaxPixels = iif(bm.bmWidth>bm.bmHeight,bm.bmWidth,bm.bmHeight)
            dim as single RowDotsPerPixele = PrinterW/MaxPixels
            dim as single ColDotsPerPixele = PrinterH/MaxPixels
            if ColDotsPerPixele>RowDotsPerPixele then
              PrinterH=RowDotsPerPixele*bm.bmHeight
            else
              PrinterH=RowDotsPerPixele*bm.bmWidth
            end if
            SetMapMode (hDCPrinter, MM_ISOTROPIC)
            SetWindowExtEx(hDCPrinter, PrinterW,PrinterH, NULL)
            SetViewportExtEx(hDCPrinter, PrinterW, PrinterH,NULL)
            SetViewportOrgEx(hDCPrinter, 0, 0, NULL)
            StretchBlt(hDCPrinter,0,0,PrinterW,PrinterH, hDCMemory,0,0,bm.bmWidth,bm.bmHeight,SRCCOPY)
          else
            BitBlt(hDCPrinter,0,0,bm.bmWidth,bm.bmHeight, hDCMemory,0,0,SRCCOPY)
          end if
        EndPage(hDCPrinter)
      EndDoc(hDCPrinter)
      SelectObject(hDCMemory, hOldBitmap)
      DeleteDC(hDCMemory)
      DeleteObject hBitmap
    end if
    DeleteDC(hDCPrinter)
  end if
end sub

ScreenRes 640,480,32
Color 0,&HFFFFFFFF : Cls
circle (320,240),100
line (0,0)-(639,479)
line (0,0)-(639,479),,B

PrintImage

sleep
Last edited by D.J.Peters on Nov 28, 2013 16:22, edited 1 time in total.
aloberoger
Posts: 480
Joined: Jan 13, 2009 19:23

Re: Printing FBGFX screen or image on Windows.

Postby aloberoger » Nov 26, 2013 23:16

Peters. the printer don't work
D.J.Peters
Posts: 7852
Joined: May 28, 2005 3:28

Re: Printing FBGFX screen or image on Windows.

Postby D.J.Peters » Nov 27, 2013 1:11

aloberoger wrote:Peters. the printer don't work
Any more information about your OS ?

I tested it only with WinXP 32 bit.

Normaly it opens the printer dialog where you can select one of your connected printers.

after the line: dim as HDC hDCPrinter =pd.hDC
write:

Code: Select all

if hDCPrinter = 0 then
  WindowTitle "error:  hDCPrinter = NULL ! "
  beep : sleep : end 1
end if
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Re: Printing FBGFX screen or image on Windows.

Postby MichaelW » Nov 27, 2013 2:07

Under Windows XP SP3 (32-bit) it did not work for me as posted, even though the print dialog was opening and returning a printer DC. It did work after I made a few small changes:

Code: Select all

  '' dim as string path = environ("Temp")
  '' if right(path,1)<>"\" then path += "\"
  '' dim as string file = path & "printjob" & id & ".bmp"
  '' BSave path, p
  dim as string file = "printjob" & id & ".bmp"
  BSave file, 0

And it also worked with stretched = 0, but going from 120 DPI on the display to 600 DPI on the printer, I thought it was printing a blank page, and even checked the return value from BitBlt, before I put on my reading glasses :)
D.J.Peters
Posts: 7852
Joined: May 28, 2005 3:28

Re: Printing FBGFX screen or image on Windows.

Postby D.J.Peters » Nov 28, 2013 16:25

Hello MichaelW dim as string path = environ("Tmp") is the right on your and other win boxes ?

Joshy
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

Re: Printing FBGFX screen or image on Windows.

Postby MichaelW » Nov 28, 2013 22:52

D.J.Peters wrote:Hello MichaelW dim as string path = environ("Tmp") is the right on your and other win boxes ?

It is on the Windows XP system that I used for the test. Now that I test again, your code as posted works correctly. I’m running Microsoft Security Essentials on a slow system, and at times it monopolizes the CPU to the point that it interferes with everything else.

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 1 guest