TEAM-ADA Archives

Team Ada: Ada Programming Language Advocacy

TEAM-ADA@LISTSERV.ACM.ORG

Options: Use Forum View

Use Monospaced Font
Show Text Part by Default
Show All Mail Headers

Message: [<< First] [< Prev] [Next >] [Last >>]
Topic: [<< First] [< Prev] [Next >] [Last >>]
Author: [<< First] [< Prev] [Next >] [Last >>]

Print Reply
Subject:
From:
Carlisle Martin C Dr USAFA/DFCS <[log in to unmask]>
Reply To:
Carlisle Martin C Dr USAFA/DFCS <[log in to unmask]>
Date:
Wed, 5 Sep 2001 16:24:55 -0600
Content-Type:
text/plain
Parts/Attachments:
text/plain (619 lines)
Here is a sample program from AdaGIDE:

Martin C. Carlisle, PhD
Associate Professor of Computer Science
United States Air Force Academy


-----Original Message-----
From: EDUARDO HASBUN . [mailto:[log in to unmask]]
Sent: Wednesday, September 05, 2001 3:27 PM
To: [log in to unmask]
Subject: printing

I need to be able to set the output to a printer, in other words I want to
print something in Ada 95 using my printer.  I'm using GNAT 3.13p in
Windows.  Can someone help me??

---------------------------------------------------------------
--
--  ADA GNAT INTEGRATED DEVELOPMENT ENVIRONMENT (AdaGIDE)
--
--  PRINT.ADB
--  Description : Prints a command-line specified file
--
--  By: Dr. Martin C. Carlisle
--
--
--  Original Copyright (C) 1997 Martin C. Carlisle
--  This is a derivative work by:
--     US Air Force Academy Department of Computer Science
--
-- AdaGIDE is free software; you can redistribute it and/or
-- modify it under terms of the GNU General Public License
-- as published by the Free Software Foundation and modified
-- below; either version 2, or (at your option) any later version.
-- AdaGIDE is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty
-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-- See the GNU General Public License for more details.
-- You should have received a copy of the GNU General Public
-- License distributed with AdaGIDE; see file COPYING.HTML.  If
-- not, write to the Free Software Foundation, 59 Temple Place,
-- Suite 330, Boston, MA 02111-1307, USA.
--
-- The GNU General Public License is modified as follows.
-- If you distribute or publish this work (or any work based
-- on this work) along with a related program, you must cause
-- the related work and any modifications you have made to this
-- work to be licensed as a whole at no charge to all third
-- parties under the terms of the GNU General Public License. For
-- purpose of this modification, a related work is defined as any
-- work whose process is started by this work (or any work based
-- on this work), whose process starts a process running this work
-- (or any work based on this work), or whose process communicates
-- with a process running this work (or any work based on this
-- work).  In particular, this modification includes bundling a
-- compiler with this work (or any work based on this work).
--
---------------------------------------------------------------
WITH Win32,System,Win32.Winmain;
USE TYPE Win32.BOOL,Win32.UINT,Win32.INT,Win32.DWORD;
WITH Win32.CommDlg,Win32.WinGDI,Win32.Winbase,Win32.Windef;
WITH Win32.WinUser;
WITH WinConversions;
USE TYPE Win32.WinDef.HWND;
WITH Ada.Unchecked_Conversion;
WITH Ada.Text_IO;

PROCEDURE Print IS
pragma Linker_Options("-mwindows");
pragma Linker_Options("-lwin32ada");
pragma Linker_Options("-lcomctl32");
pragma Linker_Options("-lcomdlg32");
pragma Linker_Options("-ladvapi32");

TYPE String_Access IS ACCESS ALL String;

TYPE LPPAGESETUPHOOK IS NEW Win32.LPVOID;
SUBTYPE LPPAGEPAINTHOOK IS Win32.LPVOID;

TYPE PAGESETUPDLG IS RECORD
  lStructSize : Win32.DWORD;
  hwndOwner : Win32.Windef.HWND;
  hDevMode : Win32.Windef.HGLOBAL;
  hDevNames : Win32.Windef.HGLOBAL;
  Flags : Win32.DWORD;
  ptPaperSize : Win32.Windef.POINT;
  rtMinMargin : Win32.Windef.RECT;
  rtMargin : Win32.Windef.RECT;
  hInstance : Win32.Windef.HINSTANCE;
  lCustData : Win32.LPARAM;
  lpfnPageSetupHook : LPPAGESETUPHOOK;
  lpfnPagePaintHook : LPPAGEPAINTHOOK;
  lpPageSetupTemplateName : Win32.LPCSTR;
  hPageSetupTemplate : Win32.Windef.HGLOBAL;
END RECORD;
TYPE LPPAGESETUPDLG IS ACCESS ALL PAGESETUPDLG;


 PSD_DEFAULTMINMARGINS             :CONSTANT := 16#00000000#; -- default
(printer's)
 PSD_INWININIINTLMEASURE           :CONSTANT := 16#00000000#; -- 1st of 4
possible

 PSD_MINMARGINS                    :CONSTANT := 16#00000001#; -- use
caller's
 PSD_MARGINS                       :CONSTANT := 16#00000002#; -- use
caller's
 PSD_INTHOUSANDTHSOFINCHES         :CONSTANT := 16#00000004#; -- 2nd of 4
possible
 PSD_INHUNDREDTHSOFMILLIMETERS     :CONSTANT := 16#00000008#; -- 3rd of 4
possible
 PSD_DISABLEMARGINS                :CONSTANT := 16#00000010#;
 PSD_DISABLEPRINTER                :CONSTANT := 16#00000020#;
 PSD_NOWARNING                     :CONSTANT := 16#00000080#; -- must be
same as PD_*
 PSD_DISABLEORIENTATION            :CONSTANT := 16#00000100#;
 PSD_RETURNDEFAULT                 :CONSTANT := 16#00000400#; -- must be
same as PD_*
 PSD_DISABLEPAPER                  :CONSTANT := 16#00000200#;
 PSD_SHOWHELP                      :CONSTANT := 16#00000800#; -- must be
same as PD_*
 PSD_ENABLEPAGESETUPHOOK           :CONSTANT := 16#00002000#; -- must be
same as PD_*
 PSD_ENABLEPAGESETUPTEMPLATE       :CONSTANT := 16#00008000#; -- must be
same as PD_*
 PSD_ENABLEPAGESETUPTEMPLATEHANDLE :CONSTANT := 16#00020000#; -- must be
same as PD_*
 PSD_ENABLEPAGEPAINTHOOK           :CONSTANT := 16#00040000#;
 PSD_DISABLEPAGEPAINTING           :CONSTANT := 16#00080000#;
 PSD_NONETWORKBUTTON               :CONSTANT := 16#00200000#; -- must be
same as PD_*

function PageSetupDlg_func(
                lppd: LPPAGESETUPDLG)
               return Win32.BOOL;
pragma Import(Stdcall, PageSetupDlg_func, "PageSetupDlgA");


pd : ALIASED Win32.CommDlg.PRINTDLG;
psd : ALIASED PAGESETUPDLG;
tm : ALIASED Win32.WinGDI.TEXTMETRIC;
buffer : ARRAY(0..79) OF ALIASED Win32.CHAR;
docinfo : ALIASED Win32.WinGDI.DOCINFO;
bUserAbort : Boolean;
hDlgPrint : Win32.Windef.HWND;

FUNCTION PrintDlgProc(hDlg : Win32.Windef.HWND;
  Message : Win32.UINT; Wparam : Win32.WPARAM;
  Lparam : Win32.LPARAM) RETURN Win32.BOOL;
PRAGMA Convention(Stdcall,PrintDlgProc);

FUNCTION AbortProc(hPrinterDC : Win32.Windef.HDC;
  nCode : Win32.INT) RETURN Win32.BOOL;
PRAGMA Convention(Stdcall,AbortProc);

------------------------------------------------------------------
-- FUNCTION PrintDlgProc
--
-- Handles messages to Print Dialog box
-- currently unused as PrintDialog isn't working
--
-- IF init, grey close on system menu
-- IF command, set abort
------------------------------------------------------------------
FUNCTION PrintDlgProc(hDlg : Win32.Windef.HWND;
  Message : Win32.UINT; Wparam : Win32.WPARAM;
  Lparam : Win32.LPARAM) RETURN Win32.BOOL IS
  Bool : Win32.BOOL;
BEGIN
  IF Message = Win32.WinUser.WM_INITDIALOG THEN

    Bool := Win32.WinUser.EnableMenuItem(Win32.WinUser.GetSystemMenu(
      hDlg, 0), Win32.WinUser.SC_CLOSE,
      Win32.WinUser.MF_GRAYED);
    RETURN 1;
  ELSIF Message = Win32.WinUser.WM_COMMAND THEN

    bUserAbort := True;
    Bool := Win32.WinUser.EnableWindow(Win32.WinUser.GetParent(hDlg),1);
    Bool := Win32.WinUser.DestroyWindow(hDlg);
    hDlgPrint := Win32.WinDef.HWND(System.Null_Address);

    RETURN 1;
  END IF;

  RETURN 0;
END PrintDlgProc;

------------------------------------------------------------------
-- FUNCTION AbortProc
--
-- Handles aborting current print
-- currently unused as PrintDialog isn't working
--
-- WHILE not Abort AND GetMessage LOOP
--   process message
-- If abort return 0, else 1
------------------------------------------------------------------
msg : ALIASED Win32.WinUser.MSG;
FUNCTION AbortProc(hPrinterDC : Win32.Windef.HDC;
  nCode : Win32.INT) RETURN Win32.BOOL IS
  Bool : Win32.BOOL;
  IgnoreLong : Win32.LONG;
BEGIN
  WHILE (NOT bUserAbort) AND (Win32.WinUser.PeekMessage(msg'ACCESS,
      System.Null_Address, 0, 0, Win32.WinUser.PM_REMOVE) /= 0) LOOP
    IF hDlgPrint = Win32.Windef.HWND(System.Null_Address) OR
        (Win32.WinUser.IsDialogMessage(hDlgPrint,
         msg'ACCESS) = 0) THEN
      Bool := Win32.WinUser.TranslateMessage(msg'Unchecked_ACCESS);
      IgnoreLong := Win32.WinUser.DispatchMessage(msg'Unchecked_ACCESS);
    END IF;
  END LOOP;

  IF bUserAbort THEN
    RETURN 0;
  ELSE
    RETURN 1;
  END IF;
END AbortProc;

------------------------------------------------------------------
-- FUNCTION GetPrinterDC
--
-- gets device context for printer
-- used since Dialog Box not working
--
-- get profile of printer
-- replace "," with ASCII.NUL
-- Create and return device context
------------------------------------------------------------------
FUNCTION GetPrinterDC RETURN Win32.Windef.HDC IS
  IgnoreDWORD : Win32.DWORD;
  IgnoreInt   : Win32.INT;
  counter     : Integer;
  DriverLoc,OutputLoc : Integer;
BEGIN
  IgnoreDWORD := Win32.Winbase.GetProfileString(
    WinConversions.ConvertStaticString("windows" & Character'First),
    WinConversions.ConvertStaticString("device" & Character'First),
    WinConversions.ConvertStaticString(",,," & Character'First),
    buffer(0)'Unchecked_ACCESS, 80);

  counter := 0;
  WHILE Character(buffer(counter)) /= ',' AND counter < 80 LOOP
    counter := counter + 1;
  END LOOP;

  IF counter < 80 THEN
    DriverLoc := counter+1;
    buffer(counter) := Win32.CHAR'First;
  END IF;

  WHILE Character(buffer(counter)) /= ',' AND
        Character(buffer(counter)) /= ' ' AND counter < 80 LOOP
    counter := counter + 1;
  END LOOP;

  IF counter < 80 THEN
    OutputLoc := counter+1;
    buffer(counter) := Win32.CHAR'First;

    RETURN Win32.Wingdi.CreateDC(buffer(DriverLoc)'Unchecked_ACCESS,
        buffer(0)'Unchecked_ACCESS,buffer(OutputLoc)'Unchecked_ACCESS,NULL);
  END IF;

  IgnoreInt := Win32.WinUser.MessageBox(System.Null_Address,
    WinConversions.ConvertStaticString(
      "Unable to print file" & Character'First),
    WinConversions.ConvertStaticString(
      "No printer found" & Character'First),
    0);

  RETURN Win32.Windef.HDC(System.Null_Address);
END GetPrinterDC;

------------------------------------------------------------------
-- PROCEDURE PageSetupChoice
--
------------------------------------------------------------------
PROCEDURE PageSetupChoice IS
  IgnoreBool : Win32.BOOL;
BEGIN

  psd.lStructSize := Win32.DWORD(PAGESETUPDLG'Size/8);
  psd.hwndOwner := System.Null_Address;
  psd.hInstance := System.Null_Address;
  psd.lCustData := 0;
  psd.lpfnPagePaintHook := System.Null_Address;

  IgnoreBool := PageSetupDlg_func(psd'ACCESS);
END PageSetupChoice;

FUNCTION Get_File_Name RETURN String_Access IS
  USE TYPE Win32.LPSTR;

  CommandLPSTR  : Win32.LPSTR;
  IgnoreLPSTR   : Win32.LPSTR;
  CommandLength : Integer;
  StartFileName : Integer;
  Result : String_Access;
BEGIN
    CommandLPSTR := Win32.Winbase.GetCommandLine;
    IF CommandLPSTR = NULL THEN
      RETURN NULL;
    END IF;
    CommandLength := Integer(Win32.Winbase.lstrlen(Win32.LPCSTR(
      CommandLPSTR)));

    IF CommandLength > 0 THEN
      DECLARE
        CommandString : String(1..CommandLength+1);
      BEGIN
        IgnoreLPSTR := Win32.Winbase.lstrcpy(
          WinConversions.ConvertStaticString(CommandString),
          Win32.LPCSTR(CommandLPSTR));


          StartFileName := 2;

          WHILE StartFileName < CommandLength AND THEN
                CommandString(StartFileName) /= ' ' LOOP
            StartFileName := StartFileName + 1;
          END LOOP;

          -- skip over blank space
          StartFileName := StartFileName + 1;

          -- only try if we have at least one character filename
          IF StartFileName < CommandLength-1 THEN
            Result := new String'(
                CommandString(StartFileName..CommandLength));
          END IF;
      END;
    ELSE
      Result := NULL;
    END IF;

    RETURN Result;
END Get_File_Name;


------------------------------------------------------------------
--
-- call Common Dialog routine so
-- Get number of lines, exit if 0
-- get font resolution (horiz and vert)
-- Compute characters per line/page
-- Compute number of pages
-- Disable window
-- start document
-- FOR number of pages LOOP
--   start page
--   FOR min(lines per page, lines this page) LOOP
--     print line
--   end page
-- end document
-- enable window
-- delete device context
------------------------------------------------------------------

  Lines                : Integer;
  yChar,nCharsPerLine  : Integer;
  nLinesPerPage        : Integer;
  LineNum              : Integer;
  IgnoreInt            : Win32.INT;
  Bool                 : Win32.BOOL;
  bSuccess             : Boolean := True;
  AllPages             : Boolean := True;
  rect                 : Win32.Windef.RECT;
  Int2,Int3            : Win32.INT;
  HFont                : Win32.Windef.HFONT;
  HGDIOBJ              : Win32.Windef.HGDIOBJ;
  StartLineOffset      : Integer := 0;
  FileName             : String_Access;
  FilePtr              : Ada.Text_IO.File_Type;
  DoDialog             : Boolean;
  Lines_Done_This_Page : Integer;
BEGIN
  FileName := Get_File_Name;

  IF FileName = NULL THEN
    RETURN;
  END IF;

  IF FileName(FileName'First..FileName'First+1) = "-q" THEN
    DoDialog := False;
    FileName := new String'(FileName(FileName'First+3..FileName'Last));
  ELSE
    DoDialog := True;
  END IF;


  psd.rtMargin.top := 1000;
  psd.rtMargin.left := 1000;
  psd.rtMargin.bottom := 1000;
  psd.rtMargin.right := 1000;
  psd.hDevMode := System.Null_Address;
  psd.HDevNames := System.Null_Address;
  psd.Flags := Win32.DWORD(PSD_MARGINS +
    PSD_INTHOUSANDTHSOFINCHES);

  pd.lStructSize := Win32.DWORD(Win32.CommDlg.PRINTDLG'Size/8);
  pd.hwndOwner := System.Null_Address;
  pd.hDevMode := System.Null_Address;
  pd.HDevNames := System.Null_Address;
  pd.hDC := System.Null_Address;
  pd.Flags := Win32.DWORD(Win32.CommDlg.PD_RETURNDC +
  --  Win32.CommDlg.PD_ALLPAGES +
    Win32.CommDlg.PD_NOSELECTION +
    Win32.CommDlg.PD_NOPAGENUMS +
    Win32.CommDlg.PD_USEDEVMODECOPIES );
  pd.nFromPage := 0;
  pd.nToPage := 0;
  pd.nMinPage := 0;
  pd.nMaxPage := 0;
  pd.nCopies := 1;
  pd.hInstance := System.Null_Address;
  pd.lCustData := 0;
  pd.lpfnPrintHook := NULL;
  pd.lpfnSetupHook := NULL;
  pd.lpPrintTemplateName := NULL;
  pd.lpSetupTemplateName := NULL;
  pd.hPrintTemplate := System.Null_Address;
  pd.hSetupTemplate := System.Null_Address;

  pd.lStructSize := Win32.DWORD(66);  -- HACK!!
  IF DoDialog THEN
    Bool := Win32.CommDlg.PrintDlg_Func(pd'Unchecked_ACCESS);
    IF Bool = 0 THEN
      RETURN; -- user pressed cancel.
    END IF;
  ELSE
    pd.hdc := GetPrinterDC;
    IF pd.hdc = System.Null_Address THEN
      RETURN; -- no printer!
    END IF;
  END IF;


  Int2 := Win32.WinGDI.GetDeviceCaps(pd.hdc, Win32.WinGDI.LOGPIXELSY);
  Int3 := -(Win32.WinBase.MulDiv(Win32.INT(10), Int2, 72));
  Hfont := Win32.WinGDI.CreateFont(Int3,
      0, 0, 0, Win32.WinGDI.FW_NORMAL, 0,
      0, 0, 0, 0, 0, 0, 0,
      WinConversions.ConvertStaticString(
        "Courier New" & Character'First));
  HGDIOBJ := Win32.WinGDI.SelectObject(pd.hDC, hFont);

  Bool := Win32.WinGDI.GetTextMetrics(pd.hDC, tm'ACCESS);


  -- compute drawing rectangle (adopted from Win95 common
  -- controls bible book 2, p. 66)
  rect.top := Win32.LONG(Integer(Win32.WinGDI.GetDeviceCaps(pd.hDc,
    Win32.WinGDI.LOGPIXELSY)) * Integer(psd.rtMargin.top) / 1000
    - Integer(Win32.WinGDI.GetDeviceCaps(pd.hDc,
      Win32.WinGDI.PHYSICALOFFSETY)));
  rect.left := Win32.LONG(Integer(Win32.WinGDI.GetDeviceCaps(pd.hDc,
    Win32.WinGDI.LOGPIXELSX)) * Integer(psd.rtMargin.left) / 1000
    - Integer(Win32.WinGDI.GetDeviceCaps(pd.hDc,
      Win32.WinGDI.PHYSICALOFFSETX)));
  -- really we blow off the right margin
  rect.right := Win32.LONG(
    Integer(Win32.WinGDI.GetDeviceCaps(pd.hDc,
        Win32.WinGDI.HORZRES)) -
    Integer(Win32.WinGDI.GetDeviceCaps(pd.hDc,
      Win32.WinGDI.LOGPIXELSX)) *
    Integer(psd.rtMargin.left) / 1000 -
    Integer(Win32.WinGDI.GetDeviceCaps(pd.hDc,
      Win32.WinGDI.PHYSICALOFFSETX)));
  rect.bottom := Win32.LONG(
    Integer(Win32.WinGDI.GetDeviceCaps(pd.hDc,
        Win32.WinGDI.PHYSICALHEIGHT)) -
    Integer(Win32.WinGDI.GetDeviceCaps(pd.hDc,
    Win32.WinGDI.LOGPIXELSY)) * Integer(psd.rtMargin.bottom) / 1000
    - Integer(Win32.WinGDI.GetDeviceCaps(pd.hDc,
      Win32.WinGDI.PHYSICALOFFSETY)));

  yChar := Integer(tm.tmHeight) + Integer(tm.tmExternalLeading);
  nCharsPerLine := (Integer(rect.right) - Integer(rect.left)) /
    Integer(tm.tmAveCharWidth);

  nLinesPerPage := (Integer(rect.bottom) - Integer(rect.top)) /
    yChar;
--  nCharsPerLine := Integer(Win32.WinGDI.GetDeviceCaps(
--    pd.hDC, Win32.WinGDI.HORZRES)) / Integer(tm.tmAveCharWidth);
--  nLinesPerPage := Integer(Win32.WinGDI.GetDeviceCaps(
--    pd.hDC, Win32.WinGDI.VERTRES)) / yChar;

  Ada.Text_IO.Open(File => FilePtr, Name => FileName.all,
    Mode => Ada.Text_IO.In_File);

  Lines := 0;
  WHILE NOT Ada.Text_IO.End_Of_File(FilePtr) LOOP
    Lines := Lines + 1;
    Ada.Text_IO.Skip_Line(FilePtr);
  END LOOP;

  Ada.Text_IO.Close(File => FilePtr);



  bUserAbort := False;


--  hDlgPrint := Win32.WinUser.CreateDialog(gbObjects.gbAppInst,
--    gbObjects.Convert("PrintDlgBox" & Character'First),
--    Window1.form.Handle,PrintDlgProc'ACCESS);
--
--  IgnoreInt := Win32.WinGDI.SetAbortProc(pd.hDC, AbortProc'Access);

  docinfo.cbSize := docinfo'SIZE / 8;
  docinfo.lpszDocName := NULL;
  docinfo.lpszOutput := NULL;

  IF Win32.WinGDI.StartDoc(pd.hDC,docinfo'Unchecked_ACCESS) > 0 THEN

    Ada.Text_IO.Open(File => FilePtr, Name => FileName.all,
      Mode => Ada.Text_IO.In_File);

    LineNum := 0;

    -- While there are lines left, loop starting a new page
    WHILE LineNum < Lines LOOP

      IgnoreInt := Win32.WinGDI.StartPage(pd.hDC);
      IF IgnoreInt < 0 THEN
        bSuccess := False;
        EXIT;
      END IF;

        -- While lines on this page is less than max loop
        -- offset by one, since last line may wrap
        -- Note that we only allow a line to wrap once
        -- since it was a lot easier that way.
        Lines_Done_This_Page := 0;
        WHILE Lines_Done_This_Page < nLinesPerPage-1 AND THEN
              LineNum < Lines LOOP
          DECLARE
            LineString : String(1..4095);
            TempChar   : Character;
            Last       : Integer;
            FUNCTION SAtoLPCSTR IS NEW Ada.Unchecked_Conversion(
              System.Address, Win32.LPCSTR);
          BEGIN
            Ada.Text_IO.Get_Line(File => FilePtr, Item => LineString,
              Last => Last);
            LineNum := LineNum + 1;

            -- null terminate the string for Windows
            LineString(Last+1) := Character'First;

            IF Last > nCharsPerLine THEN
              TempChar := LineString(nCharsPerLine);
              LineString(nCharsPerLine) := Character'First;

              Bool := Win32.WinGDI.TextOut(pd.hDC,
                Win32.INT(rect.left),  -- x location
                Win32.INT(yChar * Lines_Done_This_Page +
                  Integer(rect.top)), -- y location
                Win32.LPCSTR(SAtoLPCSTR(LineString(1)'Address)),
                Win32.INT(nCharsPerLine-1));

              Lines_Done_This_Page := Lines_Done_This_Page + 1;

              LineString(nCharsPerLine) := TempChar;
              Bool := Win32.WinGDI.TextOut(pd.hDC,
                Win32.INT(rect.left),  -- x location
                Win32.INT(yChar * Lines_Done_This_Page +
                  Integer(rect.top)), -- y location
                Win32.LPCSTR(SAtoLPCSTR(LineString(nCharsPerLine)'Address)),
                Win32.INT(Last-nCharsPerLine+1));

              Lines_Done_This_Page := Lines_Done_This_Page + 1;
            ELSE
              Bool := Win32.WinGDI.TextOut(pd.hDC,
                Win32.INT(rect.left),  -- x location
                Win32.INT(yChar * Lines_Done_This_Page +
                  Integer(rect.top)), -- y location
                Win32.LPCSTR(SAtoLPCSTR(LineString(1)'Address)),
                Win32.INT(Last));

              Lines_Done_This_Page := Lines_Done_This_Page + 1;
            END IF;
          END; -- DECLARE
        END LOOP; -- End loop on lines/page

        IgnoreInt := Win32.WinGDI.EndPage(pd.hDC);

      IF IgnoreInt < 0 THEN
        bSuccess := False;
        EXIT;
      END IF;

      IF bUserAbort THEN
        EXIT;
      END IF;
   END LOOP; -- on linenum < lines
   Ada.Text_IO.Close(File => FilePtr);
 ELSE
   bSuccess := False;
 END IF;



 IF bSuccess THEN
   IgnoreInt := Win32.WinGDI.EndDoc(pd.hDC);
 END IF;

 -- restore to prior state
 HGDIOBJ := Win32.WinGDI.SelectObject(pd.hDC,HGDIOBJ);
 Bool := Win32.WinGDI.DeleteDC(pd.hDC);
 Bool := Win32.WinGDI.DeleteObject(hFont);


END Print;

ATOM RSS1 RSS2