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;