(*
This file is part of Templot1, a computer program for the design of model railway track.
Copyright (C) 2018, 2021 Martin Wynne. email: martin@85a.uk
This program is free software: you may redistribute it and/or modify
it under the terms of the GNU General Public Licence as published by
the Free Software Foundation, either version 3 of the Licence, or
(at your option) any later version.
This program 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 Licence for more details.
You should have received a copy of the GNU General Public Licence
along with this program. See the file: licence.txt
Or if not, refer to the web site: https://www.gnu.org/licenses/
================================================================================
This file was saved from Delphi5
This file was derived from Templot2 version 227c
*)
unit pdf_unit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComCtrls, WPPDFPRP, WPPDFR1, WPPDFR2,
dtpShape,dtpGR32; // 206e
type
Tpdf_form = class(TForm)
page_panel: TPanel;
blue_corner_panel: TPanel;
how_panel: TPanel;
size_updown: TUpDown;
colour_panel: TPanel;
colour_patch: TImage;
datestamp_label: TLabel;
omit_all_panel: TPanel;
omit_all_button: TButton;
all_panel: TPanel;
all_button: TButton;
next_row_button: TButton;
omit_panel: TPanel;
print_panel: TPanel;
omit_page_button: TButton;
ok_button: TButton;
header_label: TLabel;
page_label: TLabel;
font_button: TButton;
origin_label: TLabel;
printer_label: TLabel;
row_progressbar: TProgressBar;
help_button: TButton;
help_shape: TShape;
pdf_printer: TWPPDFPrinter;
pdf_save_dialog: TSaveDialog;
black_edges_checkbox: TCheckBox;
picture_borders_checkbox: TCheckBox;
include_pictures_checkbox: TCheckBox;
detail_mode_radiobutton: TRadioButton;
diagram_mode_radiobutton: TRadioButton;
include_sketchboard_items_checkbox: TCheckBox;
row_label: TLabel;
page_ident_checkbox: TCheckBox;
Label1: TLabel;
ident_prefix_edit: TEdit;
Label2: TLabel;
page_listbox: TListBox;
symbols_checkbox: TCheckBox;
procedure FormShow(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure colour_panelClick(Sender: TObject);
procedure size_updownClick(Sender: TObject; Button: TUDBtnType);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure omit_all_buttonClick(Sender: TObject);
procedure omit_page_buttonClick(Sender: TObject);
procedure ok_buttonClick(Sender: TObject);
procedure all_buttonClick(Sender: TObject);
procedure FormDeactivate(Sender: TObject);
procedure how_panelClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure banner_fill_checkboxClick(Sender: TObject);
procedure next_row_buttonClick(Sender: TObject);
procedure font_buttonClick(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure black_edges_checkboxClick(Sender: TObject);
procedure detail_mode_radiobuttonClick(Sender: TObject);
procedure diagram_mode_radiobuttonClick(Sender: TObject);
procedure include_sketchboard_items_checkboxClick(Sender: TObject);
procedure page_listboxClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
pdf_form: Tpdf_form;
//________________________
pdf_width_mm:extended=180.0; // same defaults as sketchboard 13:9 aspect ratio
pdf_height_mm:extended=260.0;
pdf_width_dots:integer=4252; // 180mm at 600dpi
pdf_height_dots:integer=6142; // 260mm at 600dpi
pdf_width_dpi:integer=600; // default
pdf_height_dpi:integer=600;
pdf_black_white:boolean=False;
pdf_grey_shade:boolean=False;
procedure pdf_draw; // draw control template or entire pad on the output. // 0.91.d pdf
//___________________________________________________________________________________________
implementation
{$BOOLEVAL ON}
{$R *.DFM}
uses
ShellAPI, Printers, calibration_unit, preview_unit, control_room, pad_unit, alert_unit, keep_select, math_unit, gauge_unit,
info_unit, colour_unit, bgnd_unit, bgkeeps_unit, help_sheet,
stay_visible_unit, panning_unit, shove_timber, grid_unit, edit_memo_unit,
print_settings_unit, print_unit, entry_sheet, export_unit,
dtp_settings_unit, dtp_unit, rail_options_unit, platform_unit,
check_diffs_unit, data_memo_unit,
PNGImage, trackbed_unit, make_slip_unit, detail_mode_unit; // 214b
type // 227a
Tsheet_id=class(TObject)
across:integer;
down:integer;
end;
const
pdf_help_str:string=' Printing Pages'
+'||Behind this PRINT PAGES window you can see the layout of pages comprising your drawing. Drag and resize this window as necessary to get a clear view.'
+' (It is often useful to have resized the trackpad window beforehand to less than the full screen.)'
+'||The tracks are drawn in skeleton form with rails only, but will print out fully detailed according to your current settings in the GENERATOR and PRINT menus.'
+' The rails are shown in different colours for the control template and background templates, the latter being shown as single rail-edges only.'
+'||( The TOP of the printed pages corresponds to the LEFT MARGIN on the screen, so selecting between upright (portrait) and sideways (landscape) paper orientation might at first seem confusing.'
+' In most cases the pre-set upright (portrait) setting gives the best fit on the pages.)'
+'||If PRINT CONTROL TEMPLATE was selected only pages containing it will be printed, along with any background items which happen to be on them.'
+'||If PRINT ENTIRE TRACKPAD was selected, all the pages needed to contain any background templates will be printed.'
+'||To enlarge or reduce the scale of the printed template, or change the printed colours or line thicknesses, select the various PRINT menu items.'
+' The page layout shown here (and on the trackpad) will change to reflect the new size.'
+'||You can choose to print any or all of the pages shown:'
+'||To create all the pages click the CREATE ALL REMAINING PAGES bar.'
+'||To cancel any printing, click the OMIT ALL REMAINING PAGES bar or press the F12 or Esc keys.'
+'||To create individual page(s), click the OMIT PAGE button until the NEXT PAGE display shows the page you require. Then click the CREATE PAGE button.'
+'||To omit all the pages in a row, or the remaining pages in the current row, click the NEXT ROW button.'
+'||Continue clicking the OMIT PAGE, CREATE PAGE and NEXT ROW buttons as required. If no more pages are required click the OMIT ALL REMAINING PAGES bar. To print'
+' all the remaining pages click the CREATE ALL REMAINING PAGES bar.'
+'|--------------'
+'|Handy Hint:'
+'|To rapidly run through the pages of a large plan you can repeatedly select the OMIT PAGE, CREATE PAGE or NEXT ROW buttons by using the accelerator keys marked on the buttons'
+' (i.e. hold down the O key on the keyboard to omit a run of pages, the C key to create a run of pages, or the N key to omit several rows of pages).'
+'|--------------'
+'||To change the font used for the page labels on the preview screen click the FONT... button.'
+'||To print a copy of this preview screen click the PRINT PAGE MAP button. This is a useful guide to joining the pages when you are printing a large plan.'
+' (If the button is clicked after page printing has started, the page map will be printed when page printing has finished. The font used for the page labels on the page map'
+' can be changed by selecting the PROGRAM > PRINTER FONT + MARGINS... menu item on the PROGRAM PANEL window.)'
+'||If the page margins do not conveniently fit the paper size or grid spacings being used, the trim margins can be changed. Return to the trackpad (F12) and then click the PRINT > TRIM MARGINS > ? TRIM MARGINS HELP menu item for more information.'
+'||If the drawing is not conveniently placed between the page margins, the page origin can be moved. Return to the trackpad (F12) and then click either the PRINT > PAGE ORIENTATION / ORIGIN > SET PAGE ORIGIN... menu item'
+' to enter the new page origin position directly, or the ACTION > MOUSE ACTIONS:PAD > MOVE PAGE ORIGIN menu item (SHIFT+CTRL-F10) to move the page origin with the mouse.'
+'||Likewise when printing the entire trackpad at a reduced size, the print size can be changed by mouse action to achieve a convenient fit to the pages. Click the ACTION > MOUSE ACTIONS:PAD > ADJUST PRINT SIZE menu item.'
+' The page outlines on the trackpad will change accordingly.'
+'|--------------'
+'||There are four OPTIONS > tickboxes:'
+'||If INFORMATION PAGE is ticked, a page containing the INFO details from the information panel will be printed to accompany the control template.'
+'||This is useful when printing final construction templates as a permanent written record, but you will probably want to untick the box when doing trial templates to save paper.'
+' Any MEMO notes for the control template will also be added.'
+'||This option box has no effect when the entire trackpad is being printed, even if the control template is included.'
+' The text font used for this page can be changed - select the PROGRAM > PRINTER FONT + MARGINS... menu item on the PROGRAM PANEL window.'
+'||If BLACK RAIL-EDGES is ticked, all rail edges will be printed in black regardless of any other colour, print-intensity or grey-shade settings which you may have made.'
+'||This option is useful when the print intensity has been reduced (see below),'
+' or when printing the background templates in their mapping colours, or in a single non-black colour ( PRINT > PRINTED DRAWING OPTIONS > CLOLOUR OPTIONS > PRINT ALL TEMPLATES IN A SINGLE COLOUR menu item),'
+' but you want to retain a full black for the rail edge lines.'
+'||If WARNINGS is ticked, a warning will be printed on each page if the printer is uncalibrated, or if data distortions are in force. For more information about'
+' printer calibration, select the PRINT > PRINTER CALIBRATION > CALIBRATE PRINTER... menu item.'
+'||For information about data distortions, select the PROGRAM > EXPERT menu items on the PROGRAM PANEL menus.'
+'||When printing on single sheets of paper Templot ignores any empty (blank) pages and prints only the pages of your drawing which actually contain track.'
+'||If BANNER FILL is ticked, any such empty pages will be included in the print run when printing on banner or roll paper, so that no lengthwise page joins are needed. Bear in mind that for some track plans'
+' this could mean printing a great many blank pages (e.g. for a circular layout you would be printing blank pages to fill the whole of the centre space).'
+' In such cases you will probably want to untick the box and separate out the individual pages from the banner print run.'
+' This option box has no effect when printing on single sheets.'
{
+'||Some printers continue to feed paper after banner printing is finished until the end of the paper is reached. If PAUSE BANNER BEFORE FINAL PAGE is ticked,'
+' Templot will pause before sending the final page to the printer. This gives you the opportunity to cut continuous roll or z-fold paper (allowing sufficient for one more page).'
+' Click OK when you are ready to proceed. (To use this option you should have the printer spooler set to begin printing as soon as the first page is sent.)'
+' This option box has no effect when printing on single sheets.'
}
+'||The PRINT INTENSITY adjuster is useful to darken trial templates when using the printer''s Draft/Fast print-quality mode, without upsetting your colour settings for final templates using the Best/Letter-Quality mode.'
+'||Change the setting by sliding the adjuster, or by clicking the LIGHT and DARK labels. The RESET button restores the normal print intensity setting.'
+'||The setting is also reset to normal after changing any of the print colours (PRINT > PRINTED DRAWING OPTIONS menu items).'
+'||The intensity setting modifies the print colours, not the line thicknesses (line widths) which can be set separately using the PRINT > PRINTED LINE THICKNESS menu items.'
+'||When using a reduced print intensity, you can ensure that the rail edges remain a full black by ticking the BLACK RAIL-EDGES option box (see above).'
+'||The print intensity adjustment is not available when printing in black && white only. Select GREY-SHADE PRINTING instead.'
+'||Printers vary considerably in performance and you may need to experiment to achieve the optimum results from your particular printer.'
+'||This print intensity setting is internal to Templot. Many printers also include setup options to vary the ink intensity and to print'
+' in grey-shades (gray-scale). You can compare the results from these hardware options with those from changing the settings here in Templot.'
+'||For some additional notes about colour options for printing, click the ABOUT MAPPING COLOURS button below.'
+'|-----------------'
+'||N.B. If PRINT ALL REMAINING PAGES has been selected you can abort the sending of pages to the printer by pressing the F12 or Esc keys, but any already sent will continue to be printed.'
+'||After all the pages have been sent, Templot returns to the trackpad so that you can continue working while the pages are being printed. To abort printing at this stage you must use the Windows'
+' printer controls (double-click on the printer icon in the taskbar, in the window which appears click the TEMPLOT PAGES entry, then in the DOCUMENT menu, select CANCEL PRINTING).'
+'||When printing all the pages of a complete track plan at full-size, you may be printing several dozen pages of graphics. If your system memory or disk space is limited, the Windows'
+' printer spooler and/or your printer driver software may have problems. Try changing the spooler settings, or printing directly to the printer.'
+' To make these changes, from the Windows taskbar click Start > Settings > Printers > File menu > Properties > Details tab > Spool Settings, or consult Windows Help and your printer documentation for further details.'
+'||If you print directly to the printer Templot sends pages for printing one at a time, so you will be able to abort printing after each page by pressing F12 or Esc,'
+' but you will not be able to continue working in Templot until all of the required pages have been printed.'
+'||( The difference between pressing F12 or Esc is that F12 additionally unlocks the trackpad redraw if you have been printing with the redraw locked. For more information about locking the redraw, see'
+' the help notes in the REAL > TIMBERING > TIMBERING DATA... menu item. Locking the redraw is unnecessary when timber randomizing is switched off, or when printing only background templates between rebuilds.'
+' If you have not locked the redraw, there is no difference between F12 and Esc.)'
{+'||IMPORTANT : Before printing a multi-paged track plan for the first time, make sure that you have saved your work (CONTROL > SAVE ALL TEMPLATES... menu items), as a precaution against any printing problems.'}
+'||Handy Hints :'
+'||When printing the entire trackpad the control template is normally omitted and only the templates comprising the background drawing are printed. To include the control template,'
+' select the PRINT > ENTIRE TRACKPAD OPTIONS > INCLUDE CONTROL TEMPLATE menu item.'
+'||If your background contains a great many templates, it could take up to a minute or more before the printer starts printing. This is true even if you are printing only the control template on a single page.'
+' To speed up printing, temporarily wipe unwanted background templates from the trackpad.'
{
+'||Templot normally infills timber and sleeper outlines with a cross-hatch pattern. The density of this pattern will be determined by the dpi resolution of your printer. If you are using a high-resolution printer,'
+' you might prefer to modify or omit the infilling to save ink. To modify the infill pattern, change the GENERATOR > TIMBER INFILL menu options. Then if you are printing background templates,'
+' click the GENERATOR > REBUILD ALL BACKGROUND menu item to update the drawing.'
+'||To omit the printed timber infill without affecting the infill on the pad (screen), select instead the PRINT > PRINTED DRAWING OPTIONS > TIMBER INFILL > OMIT TIMBER INFILL menu item.'
}
+'||If your printer is capable of printing continuous banners on Z-fold or roll paper this can usefully eliminate most (or all) of the page-joins for a large template.'
+' It is important to make the correct settings for the printer. Click the PRINT > BANNER / ROLL PAPER menu item, and read the help notes.';
picture_help_str:string=' Printing Background Picture Shapes'
+'||The background picture shapes are intended mainly for use on the screen. It is recommended that you normally print them as rectangle outlines only on your track templates.'
+'||Including large bitmap images in the printed pages may significantly increase printing time, and is not supported on all printers.'
+'||If possible the STRETCH option should be used to print them. However, this is a Windows function which may fail at high magnifications of the original image, and is not available on some printers.'
+' If you are using Windows NT, 2000 or XP, see also the PROGRAM > EXPERT > GRAPHICS LIMITS > ? GRAPHICS LIMITS - HELP menu item on the PROGRAM PANEL window.'
+'||The DOTS option will work at all magnifications and on most printers, but is extremely slow, and should be regarded as a last resort. It is significantly faster for images scanned in black and white only.'
+' In many cases the DOTS method will work better if you change the printer spooler setting to RAW data (see below).'
+'||For the STRETCH method, if the TRANSPARENT option is set for a picture shape (in the BACKGROUND SHAPES window) it will be printed with underlying detail showing through (if the printer supports raster functions).'
+' Otherwise underlying detail will be covered over, including the grid lines and page trim margins.'
+' To avoid this, ensure that the GRID IN FRONT tickbox is selected.'
+'||For the DOTS method the TRANSPARENT option does not apply and is ignored. However, any white areas of the image will always be printed as transparent.'
+'||Both methods adjust the intensity of the image according to the current PRINT INTENSITY setting.'
+'||Printing large bitmaps makes great demands on your system''s memory and resources. Don''t have more picture shapes on the trackpad than you need,'
+' and keep bitmap files as small as possible by cropping off unwanted areas or by scanning at a lower resolution or in grey-scale instead of colour.'
+' Close any other applications which you have running. If lengthy disk drive activity takes place - please be patient.'
+' If you experience problems, quit Templot, restart Windows, restart Templot and try again.'
+'||Printing performance may also be improved by changing from EMF to RAW data, or by printing directly to the printer instead of via the Windows spooler.'
+' To make these changes, from the Windows taskbar click Start > Settings > Printers > select printer > File menu > Properties > Details tab > Spool Settings, or consult Windows Help and your printer documentation for further details.'
+'||If problems persist, restart Templot and print background picture shapes as outlines only.'
+'||N.B. PLEASE BE AWARE that printing scanned images may require the permission of the copyright owner.'
+'||For more information about using Background Shapes and bitmap images, click MORE ABOUT PICTURE SHAPES below.';
var
button_clicked:boolean=False;
banner_changed:boolean=False;
printer_printing:boolean=False;
index_sheet_wanted:boolean=False;
info_was_showing:boolean=False;
panning_was_showing:boolean=False;
shove_was_showing:boolean=False;
spacing_was_showing:boolean=False;
rail_options_was_showing:boolean=False;
platform_was_showing:boolean=False;
trackbed_was_showing:boolean=False;
check_diffs_was_showing:boolean=False;
data_child_was_showing:boolean=False;
stay_visible_was_showing:boolean=False;
form_scaling:boolean=False;
printgrid_wide:integer=1; // dots line thickness default.
printpicborder_wide:integer=1; // dots.
printmargin_wide:integer=3; // dots.
printshape_wide:integer=2; // dots.
printrail_wide:integer=2; // dots.
printtimber_wide:integer=2; // dots.
printmark_wide:integer=2; // dots.
printcl_wide:integer=1; // dots. track centre-line 0.79.a
his_pdf_file_name:string='';
shove_list_index:integer=-1; // 226a
shove_infill_colour:integer=clWhite; // 226a colour for output
shove_infill_style:integer=0; // 226a style code 0=solid
shove_modify_this_timber_infill:boolean=False; // 226a
sheet_down:integer; // 227a now global current sheet index.
sheet_across:integer; // 227a now global ditto
procedure pdf_bgnd(grid_left,grid_top:extended);forward; // print background items.
procedure pdf_bgnd_shapes(grid_left,grid_top:extended);forward; // print all background shapes.
procedure pdf_sketchboard_items(on_canvas:TCanvas; grid_left,grid_top:extended);forward; // 206e
procedure pdf_rotate_bitmap(i:integer);forward; // rotate bitmap for picture shape.
procedure pdf_rotate_metafile(i:integer);forward; // rotate metafile supplied 90degs clockwise. 213b
function pdf_draw_symbols(canv:TCanvas; symbols:Tsymbols; symbol_type,layer:integer; grid_left,grid_top,ypd:extended):boolean;forward; // ypd 227c
//_______________________________________________________________________________________
procedure disable_buttons;
begin
with pdf_form do begin
omit_page_button.Enabled:=False;
next_row_button.Enabled:=False;
ok_button.Enabled:=False;
all_button.Enabled:=False;
page_listbox.Enabled:=False; // 227a
all_panel.Enabled:=False;
end;//with
end;
//___________________________________________________________________________________
procedure enable_buttons(next_row_enabled:boolean);
begin
with pdf_form do begin
omit_all_button.Enabled:=True;
omit_page_button.Enabled:=True;
next_row_button.Enabled:=next_row_enabled;
ok_button.Enabled:=True;
all_button.Enabled:=True;
omit_all_panel.Enabled:=True;
all_panel.Enabled:=True;
page_listbox.Enabled:=True; // 227a
end;//with
end;
//___________________________________________________________________________________
function calc_intensity(colour:integer):integer;
var
red,green,blue,av:integer; // colour components (0-255).
begin
RESULT:=colour; // default init
if colour=clWhite then EXIT;
if (pdf_black_white=True) or (colour=virtual_black_colour)
then begin
RESULT:=clBlack;
EXIT;
end;
if pdf_grey_shade=True // average to a grey..
then begin
try
red:=(colour AND $000000FF);
green:=(colour AND $0000FF00) div $100;
blue:=(colour AND $00FF0000) div $10000;
av:=(red+green+blue) div 3;
red:=av;
green:=av;
blue:=av;
RESULT:=(blue*$10000)+(green*$100)+red;
except
RESULT:=clGray;
end;//try
end;
end;
//____________________________________________________________________________________
procedure print_colours_setup; // set grey shades and/or print intensity.
begin
if pdf_black_white=True
then begin
print_railedge_colour:=clBlack;
printcurail_colour:=clBlack;
printbgrail_colour:=clBlack;
printtimber_colour:=clBlack;
printrail_infill_colour_cu:=clWhite; // !!! used for solid infill.
printrail_infill_colour_bg:=clWhite; // !!! used for solid infill.
printtimber_infill_colour:=clBlack; // !!! only used for hatched infill.
printgrid_colour:=clBlack;
printmargin_colour:=clBlack;
printguide_colour:=clBlack;
printjoint_colour:=clBlack;
printalign_colour:=clBlack;
print_labels_font.Color:=clBlack;
print_timber_numbers_font.Color:=clBlack;
printshape_colour:=clBlack;
printbg_single_colour:=clBlack;
printplat_edge_colour:=clBlack; // platform edges
printplat_infill_colour:=clBlack; // platform infill
sb_track_bgnd_colour:=clWhite; // 206a
sb_diagram_colour:=clWhite; // 209c
end
else begin
// calc grey shades if wanted...
if pdf_form.black_edges_checkbox.Checked=True
then print_railedge_colour:=clBlack
else print_railedge_colour:=calc_intensity(save_prc);
printcurail_colour:=print_railedge_colour;
printbgrail_colour:=print_railedge_colour;
printtimber_colour:=calc_intensity(save_ptc);
printrail_infill_colour_cu:=calc_intensity(save_priccu);
printrail_infill_colour_bg:=calc_intensity(save_pricbg);
printtimber_infill_colour:=calc_intensity(save_ptic);
printgrid_colour:=calc_intensity(save_grc);
printmargin_colour:=calc_intensity(save_pmc);
printguide_colour:=calc_intensity(save_pgc);
printjoint_colour:=calc_intensity(save_pjc);
printalign_colour:=calc_intensity(save_pac);
print_labels_font.Color:=calc_intensity(save_fc);
print_timber_numbers_font.Color:=calc_intensity(save_tnfc);
print_corner_page_numbers_font.Color:=calc_intensity(save_cpnfc); // 0.93.a added
printshape_colour:=calc_intensity(save_psc);
printbg_single_colour:=calc_intensity(save_pbg);
printplat_edge_colour:=calc_intensity(save_priplatedge); // platform edges
printplat_infill_colour:=calc_intensity(save_priplatfill); // platform infill
sb_track_bgnd_colour:=calc_intensity(save_sb_track_bgnd); // 206a
sb_diagram_colour:=calc_intensity(save_sb_diagram_col); // 209c
end;
end;
//__________________________________________________________________________________________
procedure print_line_thickness_setup;
var
av_dpi:extended;
///////////////////////////////////////////////
function calc_thick(mm_thick:extended; adjust:boolean):integer; // calc line thickness in dots.
var
line_dots:extended;
begin
line_dots:=mm_thick*av_dpi/25.4;
if (adjust=True) and (pad_form.adjust_line_thickness_menu_entry.Checked=True) then line_dots:=line_dots*out_factor;
RESULT:=Round(line_dots);
if RESULT<1 then RESULT:=1;
end;
///////////////////////////////////////////////
begin
av_dpi:=(nom_width_dpi+nom_length_dpi)/2;
printgrid_wide:=calc_thick( printgrid_thick,False); // don't reduce line thickness for scaled output - the paper size is still the same.
printmargin_wide:=calc_thick(printmargin_thick,False); // ditto.
printshape_wide:=calc_thick( printshape_thick,True);
printpicborder_wide:=calc_thick(printpicborder_thick,True);
printrail_wide:=calc_thick( printrail_thick,True);
printtimber_wide:=calc_thick( printtimber_thick,True);
printcl_wide:=calc_thick( printcl_thick,True); // 0.79.a
printmark_wide:=calc_thick( printmark_thick,True);
end;
//__________________________________________________________________________________________
procedure text_out(textoutX,textoutY:integer; str:string);
// wPDF bug -- blank text backgrounds
var
text_rect:TRect;
begin
with pdf_form.pdf_printer.Canvas do begin
text_rect.Left:=textoutX;
text_rect.Top:=textoutY;
text_rect.Right:=textoutX+TextWidth(str);
text_rect.Bottom:=textoutY+TextHeight(str);
Brush.Color:=clWhite;
Brush.Style:=bsSolid;
FillRect(text_rect);
TextOut(textoutX,textoutY,str);
end;//with
end;
//______________________________________________________________________________
procedure make_pdf_preview_screenshot; // 214b
var
create_png:TPNGObject;
file_str:string; // including path
begin
file_str:=exe_str+'PDF-PAGEMAP-RECORD-FILES\pdf_pagemap'+FormatDateTime('_yyyy_mm_dd_hhmm_ss',Date+Time)+'.png';
create_png:=TPNGObject.Create;
try
try
create_png.Assign(offdraw_bmp);
create_png.SaveToFile(file_str);
except
ShowMessage('Sorry, an error occurred in creating the page-map record file.'
+#13+#13+'This doesn''t prevent a PDF file being created.');
end;//try
finally
create_png.Free;
end;//try
end;
//______________________________________________________________________________
procedure pdf_draw; // draw control template or entire pad on the output. // 0.91.d pdf
// n.b. this code tries to draw the complete turnout on every sheet,
// and relies on API/Delphi to crop it to the current page rectangle.
// return true if any printing done, false if he cancels all.
var
infill_points:array[0..3] of TPoint; // array of corners for infilled timbers.
gridx, gridy, now_gridx, now_gridy:extended;
grid_label:extended;
down:integer;
across:integer;
max_sheet_across:integer; // highest used.
max_sheet_down:array[0..sheet_across_c] of integer; // 0.93.a keep track of highest non-empty page in each row.
gridco:integer;
grid_now_dots:integer;
i, aq, rail, now, now_max, dots_index, mark_code:integer;
w_dots, l_dots, w_dots1, l_dots1, w_dots2, l_dots2:integer;
w1,l1,w2,l2,wmid,lmid:integer;
n:integer; // 227a
all_pages:boolean; // False = print one page at a time.
page_count:integer;
row_count:integer;
page_num_str:string;
page_str, {227a info_str,} top_str, bottom_str:string;
xing_str:string;
button_str:string;
pgco_str:string;
stry:integer;
p1,p2,p3,p4:Tpoint;
radcen_arm:extended;
move_to, line_to: TPoint;
l_dims_valid:boolean;
w_dims_valid:boolean;
banner_top_done:boolean;
x_dots, y_dots:integer;
bangrid_dots:integer;
pen_width:integer;
ptr_1st,ptr_2nd:^Tmark; // pointers to a Tmark record. ###
markmax:integer;
fontsize:extended;
num_str, tbnum_str:string;
grid_str:string;
grid_label_str:string;
folder_str:string;
switch_label_str:string; // 206b
all_pages_origin_str,this_page_begin_str,this_page_end_str:string; // 208g
last_file_str:string; // 214a
ident_left,ident_top,wm_shift:integer; // 214a
preview_record_file_made:boolean; // 214b
file_str:string; // 217b
ident_margin:integer; // 225d ..
ident_str:string;
/////////////////////////////
procedure begin_doc;
begin
printer_printing:=True;
pdf_form.pdf_printer.BeginDoc;
pdf_form.pdf_printer.StartPage(pdf_width_dots,pdf_height_dots,pdf_width_dpi,pdf_height_dpi,0); // 0.91.d
end;
/////////////////////////////
procedure end_doc(no_cancel:boolean);
var
pdf_size_str:string;
i:integer;
begin
try
pdf_form.pdf_printer.EndPage;
pdf_form.pdf_printer.EndDoc;
if (pdf_height_mm>3000) or (pdf_width_mm>3000)
then pdf_size_str:='|||
rp.gif | green_panel_begintree.gif Large PDF page sizes:'
+'||If the PDF file does not display properly in Adobe Reader the most likely reason is that the page size exceeds the limit for Adobe Reader.'
+'||Other free PDF reader programs are available which will display and print much larger page sizes.'
+' For more information and download links, click more information online .'
+'green_panel_end |
'
else pdf_size_str:='';
i:=alert(2,'php/260 PDF file created',
'The PDF file was created successfully:'
+'||`0'+pdf_form.pdf_printer.Filename+'`f'
+'||Click open PDF file to open the file in your PDF reader.'
+pdf_size_str,
'','','open PDF file','open the containing folder','','continue',0);
if i=3
then begin
folder_str:=pdf_form.pdf_printer.Filename;
if ShellExecute(0,'open',PChar(folder_str),nil,nil,SW_SHOWNORMAL)<=32
then ShowMessage('Sorry, unable to open the file.')
else external_window_showing:=True;
end;
if i=4
then begin
folder_str:=ExtractFilePath(pdf_form.pdf_printer.Filename);
if ShellExecute(0,'explore',PChar(folder_str),nil,nil,SW_SHOWNORMAL)<=32
then ShowMessage('Sorry, unable to open the folder.')
else external_window_showing:=True;
end;
except
ShowMessage('Sorry, an error occurred in creating the PDF file.');
end;//try
printer_printing:=False;
end;
/////////////////////////////
procedure draw_marks(grid_left,grid_top:extended; rail_joints_now,numbers_now:boolean);
// if rail_joints_now=True draw only the rail joints, otherwise omit them.
// if numbers_now=True draw only the timber numbers, otherwise omit them. // 226d
// !!! NOT BOTH TRUE AT SAME TIME
var
i:integer;
s:string; // 208a
begin
markmax:=intarray_max(marks_list_ptr); // max index for the present list.
if mark_index>markmax then mark_index:=markmax; // ??? shouldn't be.
tbnum_str:=timb_numbers_str; // the full string of timber numbering for the control template.
with pdf_form.pdf_printer.Canvas do begin
for i:=0 to (mark_index-1) do begin // (mark_index is always the next free slot)
ptr_1st:=Pointer(intarray_get(marks_list_ptr,i)); // pointer to the next Tmark record.
if ptr_1st=nil then BREAK;
mark_code:=ptr_1st^.code; // check this mark wanted.
if mark_code=0 then CONTINUE; // ignore mark entries with code zero (might be the second or third of a multi-mark entry, e.g. for timber infill).
if print_settings_form.output_rail_joints_checkbox.Checked=False // 223d
then begin
case mark_code of
6: CONTINUE; // rail joints not wanted.
end;//case
end;
// overwrite rail joints on rails / timber numbers on platforms ...
if rail_joints_now=(mark_code<>6) then CONTINUE; // do only the rail joints if rail_joints_now=True and ignore them otherwise.
if numbers_now=(mark_code<>99) then CONTINUE; // 226d do only the timber numbers if numbers_now=True and ignore them otherwise.
if print_settings_form.output_timbering_checkbox.Checked=False
then begin
case mark_code of
3,4,5,14,33,44,54,55,93,95,99,203,233,293: CONTINUE; // no timbering wanted.
end;//case
end;
if print_settings_form.output_timber_centres_checkbox.Checked=False // 223d
then begin
case mark_code of
4,14,44,54: CONTINUE; // timber centre-lines not wanted.
end;//case
end;
if print_settings_form.output_guide_marks_checkbox.Checked=False // 223d
then begin
case mark_code of
1: CONTINUE; // guide marks not wanted.
end;//case
end;
if print_settings_form.output_switch_drive_checkbox.Checked=False // 223d
then begin
case mark_code of
101: CONTINUE; // switch drive not wanted.
end;//case
end;
if print_settings_form.output_chairs_checkbox.Checked=False
then begin
case mark_code of
480..499: CONTINUE; // no chair outlines wanted 221a
end;//case
end;
if print_settings_form.output_radial_ends_checkbox.Checked=False
then begin
case mark_code of
2,7: CONTINUE; // no radial ends wanted 206a
end;//case
end;
if print_settings_form.output_switch_labels_checkbox.Checked=False
then begin
case mark_code of
600,601..605: CONTINUE; // no long marks or switch labels wanted 206b
end;//case
end;
if print_settings_form.output_xing_labels_checkbox.Checked=False
then begin
case mark_code of
700..703: CONTINUE; // no long marks or crossing labels wanted 211b
end;//case
end;
if ((mark_code=203) or (mark_code=233) or (mark_code=293)) and (i<(mark_index-1)) // timber infill
then begin
ptr_2nd:=Pointer(intarray_get(marks_list_ptr,i+1)); // pointer to the second infill Tmark record.
if ptr_2nd=nil then BREAK;
p1:=ptr_1st^.p1; // x1,y1 in 1/100ths mm
p2:=ptr_1st^.p2; // x2,y2 in 1/100ths mm
p3:=ptr_2nd^.p1; // x3,y3 in 1/100ths mm
p4:=ptr_2nd^.p2; // x4,y4 in 1/100ths mm
end
else ptr_2nd:=nil; // keep compiler happy.
if ( (mark_code>0) and (mark_code<200) and (mark_code<>8) and (mark_code<>9) and (mark_code<>10) ) // ignore peg, rad centres, timber selector and peg arms, plain track start, label.
or (mark_code=600) or (mark_code=700) // 206b 211b overwrite switch marks on output
then begin
if ((mark_code=5) or (mark_code=55) or (mark_code=95) or (mark_code=600) or (mark_code=700)) and (out_factor<>1.0) then CONTINUE; // reduced ends are meaningless if not full-size. 206b 600 added - 211b 700 added
p1:=ptr_1st^.p1; // x1,y1 in 1/100ths mm
if mark_code<>99
then begin
p2:=ptr_1st^.p2; // x2,y2 in 1/100ths mm
Brush.Color:=clWhite; // 0.93.a gaps in dotted lines.
Brush.Style:=bsClear;
TextOut(0,0,'');
if pdf_black_white=True
then Pen.Color:=clBlack
else case mark_code of
1,101,600,700: Pen.Color:=printguide_colour; // guide marks. switch drive 206b 600 added, 211b 700 added
2: Pen.Color:=printalign_colour; // rad end marks.
3,33,93: Pen.Color:=printtimber_colour; // timber outlines.
6: Pen.Color:=printjoint_colour; // rail joint marks.
7: Pen.Color:=printalign_colour; // transition/slewing ends.
else Pen.Color:=calc_intensity(clBlack); // thin dotted lines in black only.
end;//case
Pen.Mode:=pmCopy;
Pen.Width:=1;
Pen.Style:=psSolid; // default init.
case mark_code of
1,101: Pen.Width:=printmark_wide; // guide marks. switch drive
2: Pen.Width:=printmark_wide; // rad end marks.
3,33,93: Pen.Width:=printtimber_wide; // timber outlines.
//4,44: Pen.Style:=psDash; //out wPDF bug // timber centre-lines.
//5,55,95: Pen.Style:=psDot; //out wPDF bug // timber reduced ends.
6: Pen.Width:=printmark_wide; // rail joint marks.
7: Pen.Width:=printmark_wide; // transition ends.
14,54: Pen.Width:=printrail_wide; // timber centre-lines with rail centre-lines (for rivet locations?).
600,700: Pen.Width:=printrail_wide + printrail_wide div 2; // 206b 211b long marks
else Pen.Width:=1;
end;//case
// overides...
if Pen.Width<1 then Pen.Width:=1;
if Pen.Style<>psSolid then Pen.Width:=1; // delphi bug? (patterns only work for lines 1 dot wide.)
move_to.X:=Round((p1.Y+ypd-grid_left)*scaw_out)+page_left_dots;
move_to.Y:=Round((p1.X-grid_top)*scal_out)+page_top_dots;
line_to.X:=Round((p2.Y+ypd-grid_left)*scaw_out)+page_left_dots;
line_to.Y:=Round((p2.X-grid_top)*scal_out)+page_top_dots;
if check_limits(move_to, line_to)=True then begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
end
else begin // code 99...
if ( (pad_form.print_timber_numbering_menu_entry.Checked=True) or ((out_factor>0.99) and (pad_form.numbering_fullsize_only_menu_entry.Checked=True)) )
and (print_settings_form.output_timber_numbers_checkbox.Checked=True) // 223d
then begin
move_to.X:=Round((p1.Y+ypd-grid_left)*scaw_out)+page_left_dots; // 208a use the screen number position p1 for the control template (no ID number).
move_to.Y:=Round((p1.X-grid_top)*scal_out)+page_top_dots;
num_str:=extract_tbnumber_str(tbnum_str); // get next timber numbering string from the acummulated string.
if num_str='' then CONTINUE; // no string available??
if (pad_form.timber_numbering_on_plain_track_menu_entry.Checked=False) // 208a
and (num_str<>'A1')
then begin
s:=Copy(num_str,1,1);
if (s='A') or (s='E') or (s='R') or (s='N') // not wanted on plain track,
then CONTINUE;
end;
if check_limit(False,False,move_to)=True
then begin
Font.Assign(print_timber_numbers_font);
if pad_form.scale_timber_numbering_menu_entry.Checked=True
then begin
fontsize:=Font.Size*out_factor;
if fontsize<4 then CONTINUE; // minimum to be legible.
Font.Size:=Round(fontsize);
end;
Brush.Color:=clWhite;
Brush.Style:=bsClear; // 226d was solid
TextOut(0,0,'');
text_out(move_to.X-(TextWidth(num_str) div 2),
move_to.Y-(TextHeight(num_str) div 2),
' '+num_str+' ');
Font.Assign(print_labels_font); // reset for grid labels
end;
end;
end;
end
else begin // other codes...
if ( (mark_code=-2) or (mark_code=-3) ) and {(pad_form.print_radial_centres_menu_entry.Checked=True)} // 0.82.b
(print_settings_form.output_radial_centres_checkbox.Checked=True)
// draw curving rad centres...
then begin
Pen.Width:=printmark_wide; // guide marks.
if Pen.Width<1 then Pen.Width:=1;
Pen.Style:=psSolid;
Pen.Mode:=pmCopy;
Pen.Color:=calc_intensity(clBlack);
p1:=ptr_1st^.p1; // x1,y1 in 1/100ths mm
radcen_arm:=400*scale; // 4ft scale arbitrary (scale is for control template).
move_to.X:=Round((p1.Y+radcen_arm+ypd-grid_left)*scaw_out)+page_left_dots; // mark centre widthwise.
move_to.Y:=Round((p1.X-grid_top)*scal_out)+page_top_dots;
line_to.X:=Round((p1.Y-radcen_arm+ypd-grid_left)*scaw_out)+page_left_dots;
line_to.Y:=Round((p1.X-grid_top)*scal_out)+page_top_dots;
if check_limits(move_to, line_to)=True then begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
move_to.X:=Round((p1.Y+ypd-grid_left)*scaw_out)+page_left_dots; // mark centre lengthwise
move_to.Y:=Round((p1.X+radcen_arm-grid_top)*scal_out)+page_top_dots;
line_to.X:=Round((p1.Y+ypd-grid_left)*scaw_out)+page_left_dots;
line_to.Y:=Round((p1.X-radcen_arm-grid_top)*scal_out)+page_top_dots;
if check_limits(move_to, line_to)=True then begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
end;
if ((mark_code=203) or (mark_code=233) or (mark_code=293)) and (ptr_2nd<>nil) // timber infill...
then begin
infill_points[0].X:=Round((p1.Y+ypd-grid_left)*scaw_out)+page_left_dots;
infill_points[0].Y:=Round((p1.X-grid_top)*scal_out)+page_top_dots;
infill_points[1].X:=Round((p2.Y+ypd-grid_left)*scaw_out)+page_left_dots;
infill_points[1].Y:=Round((p2.X-grid_top)*scal_out)+page_top_dots;
infill_points[2].X:=Round((p3.Y+ypd-grid_left)*scaw_out)+page_left_dots;
infill_points[2].Y:=Round((p3.X-grid_top)*scal_out)+page_top_dots;
infill_points[3].X:=Round((p4.Y+ypd-grid_left)*scaw_out)+page_left_dots;
infill_points[3].Y:=Round((p4.X-grid_top)*scal_out)+page_top_dots;
if (check_limits(infill_points[0],infill_points[1])=True) and (check_limits(infill_points[2],infill_points[3])=True)
then begin
Pen.Width:=1;
Pen.Style:=psSolid;
Pen.Mode:=pmCopy;
Pen.Color:=clWhite; // so no overdrawing of timber outlines.
if pdf_black_white=True
then Brush.Color:=clBlack
else Brush.Color:=printtimber_infill_colour;
// 0.95.a PDF bug-fix...
case print_timb_infill_style of
0: CONTINUE; // no infill
1: begin // hatched infill
if Brush.Color=clBlack then Brush.Color:=virtual_black_colour; // PDF bug fix -- hatching won't work if black
Brush.Style:=bsFDiagonal; // Forward diagonal for the foreground (control template).
end;
2: begin // cross-hatched infill
if Brush.Color=clBlack then Brush.Color:=virtual_black_colour;
Brush.Style:=bsDiagCross;
end;
3: if pdf_black_white=True // solid infill
then CONTINUE // 209c now no fill
else Brush.Style:=bsSolid;
4: begin // blank infill.
Brush.Style:=bsSolid;
Brush.Color:=clWhite; // overide.
end;
else CONTINUE;
end;//case
Polygon(infill_points);
end;
end;
case mark_code of // switch labels 206b
601..605,701..703: begin
if out_factor<>1.0 then CONTINUE; // on full size prints only
p1:=ptr_1st^.p1; // x1,y1 in 1/100ths mm
move_to.X:=Round((p1.Y+ypd-grid_left)*scaw_out)+page_left_dots;
move_to.Y:=Round((p1.X-grid_top)*scal_out)+page_top_dots;
if check_limit(False,False,move_to)=True
then begin
Font.Assign(print_timber_numbers_font);
Font.Style:=[fsBold,fsItalic];
Font.Color:=printguide_colour;
if scale>3 then Font.Size:=Font.Size+1; // a bit bigger above 3mm/ft
Brush.Style:=bsSolid;
Brush.Color:=clWhite;
case mark_code of
601: switch_label_str:='tips';
602: switch_label_str:='set (bend)';
603: switch_label_str:='planing';
604: switch_label_str:='stock gauge';
605: switch_label_str:='joggles';
701: switch_label_str:='intersection FP';
702: switch_label_str:='blunt nose';
703: switch_label_str:='blunt tips';
else switch_label_str:='';
end;//case
text_out(move_to.X-(TextWidth(switch_label_str) div 2), // div 2 allows for rotation of template
move_to.Y-(TextHeight(switch_label_str) div 2),
' '+switch_label_str+' ');
Font.Assign(print_labels_font); // reset for grid labels
end;
end;
end;//case
end;
end;//next mark i
// finally overdraw timber infill for shoved colours 226a
if (rail_joints_now=False) and (numbers_now=False) and (Length(current_shoved_timbers)>0)
then begin
for i:=0 to Length(current_shoved_timbers)-1 do begin
with current_shoved_timbers[i] do begin
if shove_data.sv_col_has_been_set=False then CONTINUE; // 227a no modified infill
with shoved_mod_infill do begin
if (shove_data.sv_use_ocol=True) and (black_white=False) {and (impact<1)} // overdraw previous infill on output
then begin
infill_points[0].X:=Round((current_shoved_corners.p1.Y+ypd-grid_left)*scaw_out)+page_left_dots;
infill_points[0].Y:=Round((current_shoved_corners.p1.X-grid_top)*scal_out)+page_top_dots;
infill_points[1].X:=Round((current_shoved_corners.p2.Y+ypd-grid_left)*scaw_out)+page_left_dots;
infill_points[1].Y:=Round((current_shoved_corners.p2.X-grid_top)*scal_out)+page_top_dots;
infill_points[2].X:=Round((current_shoved_corners.p3.Y+ypd-grid_left)*scaw_out)+page_left_dots;
infill_points[2].Y:=Round((current_shoved_corners.p3.X-grid_top)*scal_out)+page_top_dots;
infill_points[3].X:=Round((current_shoved_corners.p4.Y+ypd-grid_left)*scaw_out)+page_left_dots;
infill_points[3].Y:=Round((current_shoved_corners.p4.X-grid_top)*scal_out)+page_top_dots;
if (check_limits(infill_points[0],infill_points[1])=True) and (check_limits(infill_points[2],infill_points[3])=True)
then begin
Pen.Width:=printtimber_wide;
Pen.Style:=psSolid;
Pen.Mode:=pmCopy;
Pen.Color:=printtimber_colour;
Brush.Color:=shove_data.sv_ocol;
case shove_data.sv_ocol_infill of
0: Brush.Style:=bsSolid;
1: begin Brush.Color:=clWhite; Brush.Style:=bsSolid; end; // blank style
2: Brush.Style:=bsHorizontal;
3: Brush.Style:=bsVertical;
4: Brush.Style:=bsFDiagonal;
5: Brush.Style:=bsBDiagonal;
6: Brush.Style:=bsCross;
7: Brush.Style:=bsDiagCross;
else Brush.Style:=bsSolid;
end;//case
Polygon(Slice(infill_points,4)); // number of points, not index
end;//ckeck limits
end;//use ocol
end;
end;//with
end;//next
end;//if any
// 226a end
end;//with pdf_form.pdf_printer.Canvas
end;
///////////////////////////////
function get_w_dots(q,n:integer):integer;
begin
with sheet[sheet_down,sheet_across] do begin // (grid_left)
RESULT:=Round((outoflist(q,n,1)+ypd-grid_left)*scaw_out)+page_left_dots;
end;//with
w_dims_valid:=check_draw_dim_w(RESULT);
end;
////////////////////////////
function get_l_dots(q,n:integer):integer;
begin
with sheet[sheet_down,sheet_across] do begin // (grid_top)
RESULT:=Round((outoflist(q,n,0)-grid_top)*scal_out)+page_top_dots;
end;//with
l_dims_valid:=check_draw_dim_l(RESULT);
end;
////////////////////////////
procedure draw_outline_railedge(aq,pencol:integer);
var
now:integer;
begin
if ( (plain_track=False) or (aq=0) or (aq=8) or (aq=3) or (aq=11) or ((aq>15) and (aq<24)) ) and (aqyn[aq]=True)
then begin
with pdf_form.pdf_printer.Canvas do begin
Pen.Color:=pencol;
Pen.Mode:=pmCopy;
Pen.Style:=psSolid;
move_to.X:=get_w_dots(aq,0); move_to.Y:=get_l_dots(aq,0);
for now:=1 to nlmax_array[aq] do begin
line_to.X:=get_w_dots(aq,now); line_to.Y:=get_l_dots(aq,now);
if check_limits(move_to, line_to)=True
then begin
MoveTo(move_to.X, move_to.Y);
LineTo(line_to.X, line_to.Y);
end;
move_to:=line_to;
end;//for
end;//with Canvas
end;
end;
////////////////////////////
procedure draw_fill_rail(outer_add:integer); // draw a complete filled rail.
const
dots_max_c=xy_pts_c*2;
var
dots:array[0..dots_max_c] of TPoint; // array of points for filled polygon mode.
// (xy_pts_c=3000;)
// 3000 points for each side of rail. if incx is 18" scale (SQRT 9ft scale in 4mm = SQRT(36) =6 mm),
// template max is 4500' scale length.
// ( = 18000 mm or 59ft approx in 4 mm scale).
// ( = 66 A4 sheets long if straight turnout - but normally less for curved turnout).
// N.B. huge standard Pascal array is used instead of our own dynamic integer arrays,
// because needed for the Polygon function.
// total memory = 6000*8 bytes = 48kb.
now, start, now_max:integer;
edge_started:boolean;
mid_dots_index:integer;
edge_colour, blanking_colour:integer;
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
procedure modify_rail_end(start_index,stop_index,edge,blank:integer);
var
saved_pen_width:integer; // 206b
begin
if (start_index>=0) and (start_index<=dots_index) and (stop_index>=0) and (stop_index<=dots_index)
then begin
move_to:=dots[start_index];
line_to:=dots[stop_index];
if check_limits(move_to, line_to)=True
then begin
with pdf_form.pdf_printer.Canvas do begin
saved_pen_width:=Pen.Width; // 206b
if Brush.Style<>bsSolid then Pen.Width:=saved_pen_width+3; // 206b PDF bug, needs a wider line to ensure full blanking if hatched fill
Pen.Color:=blank; // first blank across..
MoveTo(move_to.X, move_to.Y);
LineTo(line_to.X, line_to.Y);
Pen.Width:=saved_pen_width; // 206b restore original width
Pen.Color:=edge; // then restore the corner points..
MoveTo(move_to.X, move_to.Y);
LineTo(move_to.X, move_to.Y);
MoveTo(line_to.X, line_to.Y);
LineTo(line_to.X, line_to.Y);
end;//with
end;
end;
end;
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
begin
with pdf_form.pdf_printer.Canvas do begin
if (rail=16) or (rail=20) // 0.93.a platforms
then Pen.Color:=printplat_edge_colour
else Pen.Color:=printcurail_colour; // 1 = virtual black. Bug in HP driver if black (0) specified.
Pen.Mode:=pmCopy;
Pen.Style:=psSolid;
aq:=rail; // gauge-faces.
if ( (plain_track=False) or (aq=0) or (aq=3) or ((aq>15) and (aq<24)) )
// if plain track, stock rails and adjacent tracks only.
then begin
if (aqyn[aq]=False) or (aqyn[aq+outer_add]=False) // data not for both edges?
then begin
if aqyn[aq]=True then draw_outline_railedge(aq,Pen.Color);
if aqyn[aq+outer_add]=True then draw_outline_railedge(aq+outer_add,Pen.Color);
EXIT;
end;
now_max:=nlmax_array[aq];
if gaunt=False // 0.93.a normal turnout.
then begin
case aq of
1: begin
start:=list_planing_mark_aq1; // start from end of planing - no infill in planing.
if (start<0) or (start>now_max) then EXIT; // ???
end;
2: begin // ditto
start:=list_planing_mark_aq2;
if (start<0) or (start>now_max) then EXIT; // ???
end;
else start:=0; // whole list.
end;//case
end
else start:=0; // 0.93.a gaunt template, no planing. 0.81 09-Jul-2005
dots_index:=0-1; // first increment is to zero.
edge_started:=False;
for now:=start to now_max do
begin
x_dots:=get_w_dots(aq,now);
y_dots:=get_l_dots(aq,now);
if (w_dims_valid=True) and (l_dims_valid=True)
then begin
edge_started:=True;
Inc(dots_index);
if dots_index>dots_max_c then dots_index:=dots_max_c;
dots[dots_index].X:=x_dots;
dots[dots_index].Y:=y_dots;
end
else if edge_started=True then BREAK; // don't resume adding dots to this edge once started and then gone out of limits.
end;//next now
mid_dots_index:=dots_index;
aq:=rail+outer_add; // outer-edges.
now_max:=nlmax_array[aq];
edge_started:=False;
for now:=now_max downto 0 do
begin
x_dots:=get_w_dots(aq,now);
y_dots:=get_l_dots(aq,now);
if (w_dims_valid=True) and (l_dims_valid=True)
then begin
edge_started:=True;
Inc(dots_index);
if dots_index>dots_max_c then dots_index:=dots_max_c;
dots[dots_index].X:=x_dots;
dots[dots_index].Y:=y_dots;
end
else if edge_started=True then BREAK; // don't resume adding dots to this edge once started and then gone out of limits.
end;//next now
if pdf_black_white=True
then begin
Brush.Style:=bsSolid; // solid infill white.
Brush.Color:=clWhite;
end
else begin
if (rail=16) or (rail=20) // 0.93.a platforms
then begin
Brush.Color:=printplat_infill_colour;
case print_platform_infill_style of
0: begin Brush.Style:=bsClear; TextOut(0,0,''); end;
1: Brush.Style:=bsBDiagonal; // hatched. backward diagonal (forward diagonal on control template timbers).
2: Brush.Style:=bsDiagCross;
3: if mapping_colours_print<0 // solid.
then Brush.Style:=bsBDiagonal // impact printer or plotter, or printing black and white or in a single colour.
else Brush.Style:=bsSolid;
else begin // 4 = blank.
Brush.Style:=bsSolid;
Brush.Color:=clWhite; // overide.
end;
end;//case
end
else begin
if ((draw_ts_trackbed_cess_edge=True) and (rail=18))
or ((draw_ms_trackbed_cess_edge=True) and (rail=22)) // 215a
then begin
Brush.Color:=sb_track_bgnd_colour; // cess use same colour as track background
Brush.Style:=bsFDiagonal;
end
else begin // normal rails...
Brush.Color:=printrail_infill_colour_cu;
case rail_infill_i of
1: Brush.Style:=bsBDiagonal; // hatched
2: Brush.Style:=bsSolid; // solid
3: Brush.Style:=bsDiagCross; // cross_hatched
4: begin // blank
Brush.Style:=bsSolid;
Brush.Color:=clWhite;
end;
else Brush.Style:=bsSolid; // ??? solid
end;//case
end;
end;
end;
if dots_index>2
then begin
Polygon(Slice(dots,dots_index+1)); // +1, number of points, not index. must have 4 points.
edge_colour:=Pen.Color; // existing rail edges.
if Brush.Style=bsSolid
then blanking_colour:=Brush.Color // infill colour.
else
{begin // 206b hatched fill...
// output_code 1=sketchboard bitmap, 2=sketchboard metafile, 3=create image file, 4=create EMF file
case output_code of
1,2: blanking_colour:=dtp_settings_form.sb_page_colour_panel.Color;
3: blanking_colour:=export_form.img_bgnd_colour_panel.Color;
4: blanking_colour:=Brush.Color; // for metafile export
else}
blanking_colour:=clWhite; // assume white background (print, PDF)
// remove polygon line across end of planing (not for fixed-diamond)..
// (for gaunt template this removes the polygon line across the rail end)
if ((half_diamond=False) or (fixed_diamond=False)) and ((rail=1) or (rail=2)) then modify_rail_end(0,dots_index,edge_colour,blanking_colour);
// remove polygon lines across stock rail ends...
// and trackbed ends 206b
if (rail=0) or (rail=3) or (rail=18) or (rail=22) // 18,22 added 206b
then begin
modify_rail_end(0,dots_index,edge_colour,blanking_colour); // toe or approach end.
modify_rail_end(mid_dots_index,mid_dots_index+1,edge_colour,blanking_colour); // exit end.
end;
if adjacent_edges=True // platforms
then begin
// 0.93.a blank platform rear edges ...
if (rail=16) and (draw_ts_platform=True) and (draw_ts_platform_rear_edge=False) // 0.93.a TS platform start
then draw_outline_railedge(16,blanking_colour); // blank rear edge
if (rail=20) and (draw_ms_platform=True) and (draw_ms_platform_rear_edge=False) // 0.93.a TS platform start
then draw_outline_railedge(20,blanking_colour); // blank rear edge
// 0.93.a blank platform ends ...
if (rail=16) and (draw_ts_platform=True) and (draw_ts_platform_start_edge=False) // 0.93.a TS platform start
then modify_rail_end(0,dots_index,edge_colour,blanking_colour);
if (rail=16) and (draw_ts_platform=True) and (draw_ts_platform_end_edge=False) // 0.93.a TS platform end
then modify_rail_end(mid_dots_index,mid_dots_index+1,edge_colour,blanking_colour);
if (rail=20) and (draw_ms_platform=True) and (draw_ms_platform_start_edge=False) // 0.93.a MS platform start
then modify_rail_end(0,dots_index,edge_colour,blanking_colour);
if (rail=20) and (draw_ms_platform=True) and (draw_ms_platform_end_edge=False) // 0.93.a MS platform end
then modify_rail_end(mid_dots_index,mid_dots_index+1,edge_colour,blanking_colour);
end;
if (rail=26) or (rail=28)
then begin
modify_rail_end(0,dots_index,edge_colour,blanking_colour); // centre of K-crossing check rails.
end;
end;
end;
end;//with
end;
//////////////////////////////////
procedure draw_fill_vee; // do complete vee in one go ...
const
dots_max_c=xy_pts_c*2;
var
dots:array[0..dots_max_c] of TPoint; // array of points for filled polygon mode.
// (xy_pts_c=3000;)
// 3000 points for each side of rail. if incx is 18" scale (SQRT 9ft scale in 4mm = SQRT(36) =6 mm),
// template max is 4500' scale length.
// ( = 18000 mm or 59ft approx in 4 mm scale).
// ( = 66 A4 sheets long if straight turnout - but normally less for curved turnout).
// N.B. huge standard Pascal array is used instead of our own dynamic integer arrays,
// because needed for the Polygon function.
// total memory = 6000*8 bytes = 48kb.
now:integer;
edge_started:boolean;
dots_index:integer;
x_dots,y_dots:integer;
aq:integer;
point_mid_dots_index, splice_mid_dots_index:integer;
edge_colour, blanking_colour:integer;
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
procedure modify_vee_end(start_index,stop_index,edge,blank:integer);
begin
if (start_index>=0) and (start_index<=dots_index) and (stop_index>=0) and (stop_index<=dots_index)
then begin
move_to:=dots[start_index];
line_to:=dots[stop_index];
if check_limits(move_to, line_to)=True
then begin
with pdf_form.pdf_printer.Canvas do begin
Pen.Color:=blank; // first blank across..
MoveTo(move_to.X, move_to.Y);
LineTo(line_to.X, line_to.Y);
Pen.Color:=edge; // then restore the corner points..
MoveTo(move_to.X, move_to.Y);
LineTo(move_to.X, move_to.Y);
MoveTo(line_to.X, line_to.Y);
LineTo(line_to.X, line_to.Y);
end;//with
end;
end;
end;
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
begin
if plain_track=True then EXIT; // not if plain track.
if (aqyn[4]=False) or (aqyn[5]=False) or (aqyn[12]=False) or (aqyn[13]=False) // not enough data for filled vee.
or (nlmax_array[4]=0) or (nlmax_array[5]=0) or (nlmax_array[12]=0) or (nlmax_array[13]=0)
then begin
if aqyn[4]=True then draw_outline_railedge(4,printcurail_colour); // draw outline vee...
if aqyn[5]=True then draw_outline_railedge(5,printcurail_colour);
if aqyn[12]=True then draw_outline_railedge(12,printcurail_colour);
if aqyn[13]=True then draw_outline_railedge(13,printcurail_colour);
end
else begin
dots_index:=0-1; // first increment is to zero.
aq:=4;
edge_started:=False;
for now:=0 to nlmax_array[aq] do // vee main-side, gauge_face, start from the tip.
begin
x_dots:=get_w_dots(aq,now);
y_dots:=get_l_dots(aq,now);
if (w_dims_valid=True) and (l_dims_valid=True)
then begin
edge_started:=True;
Inc(dots_index);
if dots_index>dots_max_c then dots_index:=dots_max_c;
dots[dots_index].X:=x_dots;
dots[dots_index].Y:=y_dots;
end
else if edge_started=True then BREAK; // don't resume adding dots to this edge once started and then gone out of limits.
end;//next now
point_mid_dots_index:=dots_index;
aq:=12;
edge_started:=False;
for now:=nlmax_array[aq] downto 0 do // back along outer-edge.
begin
x_dots:=get_w_dots(aq,now);
y_dots:=get_l_dots(aq,now);
if (w_dims_valid=True) and (l_dims_valid=True)
then begin
edge_started:=True;
Inc(dots_index);
if dots_index>dots_max_c then dots_index:=dots_max_c;
dots[dots_index].X:=x_dots;
dots[dots_index].Y:=y_dots;
end
else if edge_started=True then BREAK; // don't resume adding dots to this edge once started and then gone out of limits.
end;//next now
aq:=13;
edge_started:=False;
for now:=0 to nlmax_array[aq] do // and then turnout side outer edge.
begin
x_dots:=get_w_dots(aq,now);
y_dots:=get_l_dots(aq,now);
if (w_dims_valid=True) and (l_dims_valid=True)
then begin
edge_started:=True;
Inc(dots_index);
if dots_index>dots_max_c then dots_index:=dots_max_c;
dots[dots_index].X:=x_dots;
dots[dots_index].Y:=y_dots;
end
else if edge_started=True then BREAK; // don't resume adding dots to this edge once started and then gone out of limits.
end;//next now
splice_mid_dots_index:=dots_index;
aq:=5;
edge_started:=False;
for now:=nlmax_array[aq] downto 0 do // and back along the gauge face to the tip.
begin
x_dots:=get_w_dots(aq,now);
y_dots:=get_l_dots(aq,now);
if (w_dims_valid=True) and (l_dims_valid=True)
then begin
edge_started:=True;
Inc(dots_index);
if dots_index>dots_max_c then dots_index:=dots_max_c;
dots[dots_index].X:=x_dots;
dots[dots_index].Y:=y_dots;
end
else if edge_started=True then BREAK; // don't resume adding dots to this edge once started and then gone out of limits.
end;//next now
with pdf_form.pdf_printer.Canvas do begin
Pen.Color:=printcurail_colour; // 1 = virtual black. Bug in HP driver if black (0) specified.
// (but not on "econofast" print !).
Pen.Mode:=pmCopy;
Pen.Style:=psSolid;
Brush.Color:=printrail_infill_colour_cu;
if {(}pdf_black_white=True {) or (impact>0)}
then begin
Brush.Style:=bsSolid; // solid infill white.
Brush.Color:=clWhite;
end
else case rail_infill_i of
1: Brush.Style:=bsBDiagonal; // hatched
2: Brush.Style:=bsSolid; // solid
3: Brush.Style:=bsDiagCross; // cross_hatched
4: begin // blank
Brush.Style:=bsSolid;
Brush.Color:=clWhite;
end;
else Brush.Style:=bsSolid; // solid
end;//case
if dots_index>4
then begin
Polygon(Slice(dots,dots_index+1)); // +1, number of points, not index. must have at least 5 points.
edge_colour:=Pen.Color; // existing rail edges.
if Brush.Style=bsSolid then blanking_colour:=Brush.Color // infill colour.
else blanking_colour:=clWhite;
// remove polygon lines across vee rail ends...
modify_vee_end(point_mid_dots_index,point_mid_dots_index+1,edge_colour,blanking_colour); // point rail end.
modify_vee_end(splice_mid_dots_index,splice_mid_dots_index+1,edge_colour,blanking_colour); // splice rail end.
end;
end;//with Canvas
end;
end;
////////////////////////////////////////////////////////////////////////
procedure mark_end(aq1, aq1end, aq2, aq2end:integer); // make a rail end mark
begin
if (endmarks_yn[aq1,aq1end]=True) and (endmarks_yn[aq2,aq2end]=True)
then begin
p1:=endmarks[aq1,aq1end];
p2:=endmarks[aq2,aq2end];
with sheet[sheet_down,sheet_across] do begin
move_to.X:=Round((p1.Y+ypd-grid_left)*scaw_out)+page_left_dots; move_to.Y:=Round((p1.X-grid_top)*scal_out)+page_top_dots;
line_to.X:=Round((p2.Y+ypd-grid_left)*scaw_out)+page_left_dots; line_to.Y:=Round((p2.X-grid_top)*scal_out)+page_top_dots;
end;//with
with pdf_form.pdf_printer.Canvas do begin
Pen.Color:=printcurail_colour; // 1 = virtual black. Bug in HP driver if black (0) specified.
// (but not on "econofast" print !).
Pen.Mode:=pmCopy;
Pen.Style:=psSolid;
if check_limits(move_to, line_to)=True then begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
end;//with
end;
end;
////////////////////////////////////////////////////////////
procedure outline_railends; // draw the rail ends in outline mode.
begin
if {(railend_marks=True) and} (plain_track=False)
then begin // mark rail-ends...
mark_end(1,1,9,1); // turnout rail wing rail finish.
mark_end(2,1,10,1); // main rail wing rail finish.
mark_end(6,0,14,0); // main side check rail start.
mark_end(6,1,14,1); // main side check rail finish.
mark_end(7,0,15,0); // turnout side check rail start.
mark_end(7,1,15,1); // turnout side check rail finish.
mark_end(4,0,5,0); // blunt nose.
if (half_diamond=True) and (fixed_diamond=True) // planed faced of point rails for a fixed-diamond.
then begin
mark_end(1,0,9,0);
mark_end(2,0,10,0);
mark_end(26,1,27,1); // MS K-crossing check rails.
mark_end(28,1,29,1); // DS K-crossing check rails.
end;
end;
end;
///////////////////////////////////////////////////////////////////
procedure pdf_shapes_and_sketchboard_items(grid_left,grid_top:extended); // 206e
begin
if bgnd_form.output_shapes_in_front_of_sb_checkbox.Checked=True
then pdf_sketchboard_items(pdf_form.pdf_printer.Canvas,grid_left,grid_top); // 206e
pdf_bgnd_shapes(grid_left,grid_top); // output all background shapes
if bgnd_form.output_shapes_in_front_of_sb_checkbox.Checked=False
then pdf_sketchboard_items(pdf_form.pdf_printer.Canvas,grid_left,grid_top); // 206e
end;
//////////////////////////////////////////////////////////////////
begin
with pdf_form.pdf_save_dialog do begin
if his_pdf_file_name<>'' then InitialDir:=ExtractFilePath(his_pdf_file_name)
else InitialDir:=exe_str+'PDF-FILES\';
FileName:=remove_invalid_str(Copy(Trim(box_project_title_str),1,20)+'_pages_'+FormatDateTime('yyyy_mm_dd_hhmm_ss',Date+Time))+'.pdf';
Title:=' save PDF file as ...';
if Execute=False then EXIT;
his_pdf_file_name:=FileName; // so we can use the same folder next time.
// invalid entered chars removed by dialog
file_str:=ExtractFilePath(FileName)+lower_case_filename(ExtractFileName(FileName)); // to underscores and lower case
if FileExists(file_str)=True // 217b
then begin
if DeleteFile(file_str)=False
then begin
ShowMessage('Error:'+#13+#13+'The PDF file "'+ExtractFileName(file_str)+'" cannot be created '
+#13+'because a file having the same name is currently in use '
+#13+'by another program, possibly your PDF reader program. '
+#13+#13+'Please close that program and then try again. '
+#13+#13+'Or use a different file name (recommended). ');
EXIT;
end;
end;
pdf_form.pdf_printer.FileName:=file_str;
end;//with
diagram_partials_omitted:=False; // init 226c
print_colours_setup; // first set up the colours.
preview_record_file_made:=False; // 214b init
pdf_form.all_panel.Caption:='create all pages '; // init 223d
pdf_form.omit_all_panel.Caption:='cancel F12'; // init 223d
try
print_busy:=True; // lock-out the loop while printing.
if pdf_form.pdf_printer.Printing=True
then begin
if alert(6,' PDF output busy',
'The PDF output is currently in use.'
+'||Please try again later.',
'','','','','cancel PDF output','wait until ready',0)=5 // 208a mod
then pdf_form.pdf_printer.Printing:=False
else EXIT;
end;
printer_printing:=False; // init for new job.
if calcs_done_and_valid=False then redraw(False); // first do a direct redraw if nec to ensure valid calcs.
if calcs_done_and_valid=False then EXIT; // calcs still not valid.
if print_preview(False,True,0)=False // calc the sheet sizes from the printer and preview the output.
then EXIT; // (also gets ypd y datum offset).
print_line_thickness_setup; // needs the dpi via print_preview. mod 0.73.a 12-9-01.
gridx:=grid_spacex*100; //gridsizex*2540; // grid line spacings. in 1/100th mm. (any output scaling is done later).
gridy:=grid_spacey*100; //gridsizey*2540;
while gridx*out_factor<500 do gridx:=gridx*2; // 5 mm closest grid spacing permitted down the page.
while gridy*out_factor<1000 do gridy:=gridy*2; // 10 mm ditto across page to allow for labels.
all_pages:=False; // init for one page at a time.
slow_run:=0; // cancel any slow-running.
control_room_form.run_slow_menu_entry.Checked:=False;
with pdf_form.page_listbox.Items do begin // 227a init
if Count>0 then for n:=0 to Count-1 do Tsheet_id(Objects[n]).Free;
Clear;
end;//with
banner_top_done:=False;
page_count:=0;
// check every sheet for any content, all 858 sheets (26*33)...
max_sheet_across:=0; // init
for across:=0 to sheet_across_c do begin
max_sheet_down[across]:=0; // 0.93.a init
for down:=0 to sheet_down_c do begin // every sheet in row.
if sheet[down,across].empty=True then CONTINUE;
Inc(page_count);
max_sheet_across:=across; // keep track of highest non-empty page row.
max_sheet_down[across]:=down; // 0.93.a keep track of highest non-empty page in each row.
page_num_str:=Chr(across+97)+'/'+IntToStr(down+1);
n:=pdf_form.page_listbox.Items.AddObject(' '+page_num_str,Tsheet_id.Create);
Tsheet_id(pdf_form.page_listbox.Items.Objects[n]).across:=across;
Tsheet_id(pdf_form.page_listbox.Items.Objects[n]).down:=down;
end;//next down
end;//next across
if page_count<1 then page_count:=1; // how did that happen?
if page_count>1 then pgco_str:=''+IntToStr(page_count)+' PDF pages'
else pgco_str:='one PDF page';
with pdf_form do begin
if print_entire_pad_flag=True
then begin
if print_group_only_flag=True
then header_label.Caption:='export group templates only scaled at : '+round_str(out_factor*100,2)+' %'
else header_label.Caption:='export background templates scaled at : '+round_str(out_factor*100,2)+' %';
end
else header_label.Caption:=Trim(gauge_str)+' '+round_str(scale,2)+' mm/ft scaled at : '+round_str(out_factor*100,2)+' %';
page_label.Caption:=pgco_str;
origin_label.Caption:='page origin : X = '+round_str(print_pages_top_origin,2)+' mm Y = '+round_str(print_pages_left_origin,2)+' mm';
end;//with
//---------------------------------------------------
pdf_form.row_progressbar.Max:=pdf_form.page_listbox.Items.Count-1; // 227a
pdf_form.row_progressbar.Position:=0;
// 227a allow CONTINUE and going back in page_listbox...
sheet_across:=-1; // 227a init
while sheet_across<(max_sheet_across) do begin
INC(sheet_across);
sheet_down:=-1;
while sheet_down<(sheet_down_c) do begin
INC(sheet_down);
with sheet[sheet_down,sheet_across] do begin
if empty=True then CONTINUE;
case xing_type_i of
0: xing_str:=' regular V-crossing';
1: xing_str:=' curviform V-crossing';
-1: xing_str:=' generic V-crossing';
else xing_str:='';
end;//case
page_num_str:=Chr(sheet_across+97)+'/'+IntToStr(sheet_down+1);
page_str:=' page '+page_num_str+' ';
if print_entire_pad_flag=True
then bottom_str:=' of '+IntToStr(page_count)+' pages for '+box_project_title_str
else begin
bottom_str:=' ref : '+current_name_str+' '+info_form.gauge_label.Caption;
if plain_track=False then bottom_str:=bottom_str+xing_str;
if (ABS(nomrad)1 then bottom_str:=bottom_str+' scaled at '+round_str(out_factor*100,2)+' %'; // page number and scaling.
bottom_str:=bottom_str+' '+DateToStr(Date)+' '+TimeToStr(Time);
top_str:=' TEMPLOT v:'+round_str(program_version/100,2)+version_build+' 85a.uk/templot This drawing contains design elements and data © Martin Wynne.';
if box_project_title_str<>'' then top_str:=top_str+' Project : '+box_project_title_str;
button_str:=Chr(sheet_across+97)+'/'+IntToStr(sheet_down+1);
pdf_form.page_panel.Caption:='next page is '+button_str;
pdf_form.ok_button.Caption:='&create page '+button_str;
pdf_form.omit_page_button.Caption:='&omit page '+button_str;
pdf_form.page_listbox.ItemIndex:=pdf_form.page_listbox.Items.IndexOf(' '+button_str); // 227a
pdf_form.row_progressbar.Position:=pdf_form.page_listbox.ItemIndex; // 227a
if all_pages=False
then begin
button_clicked:=False;
banner_changed:=False;
enable_buttons(sheet_across3) // 214a show large page ident if many pages
then begin
ident_margin:=Round(nom_width_dpi/10); // /10 arbitrary
if pdf_form.ident_prefix_edit.Text<>''
then ident_str:=Trim(pdf_form.ident_prefix_edit.Text)+':'+page_num_str // 225d
else ident_str:=page_num_str;
Brush.Style:=bsClear;
TextOut(0,0,'');
Font.Name:='Courier New';
Font.Height:=0-ABS((page_left_dots-page_right_dots)*9 div 23); // 9/23 trial and error for this font up to z/99
if Font.Height>-6 then Font.Height:=-6; // smallest sensible (Height is negative)
while (TextWidth(ident_str)+ident_margin*4)>(page_right_dots-page_left_dots) do begin // reduce to fit if long prefix *4 arbitrary
Font.Height:=Font.Height+1;
if Font.Height>-7 then BREAK;
end;//while
if pdf_black_white=True
then begin
wm_shift:=1; // watermark outline shift
Font.Color:=clBlack;
end
else begin
wm_shift:=Round(nom_width_dpi/30); // watermark outline shift /30 arbitrary
Font.Color:=$00D0D0D0; // pale-ish grey
end;
ident_left:=page_left_dots+(ident_margin+page_right_dots-page_left_dots-TextWidth(ident_str)) div 2; // extra margin for neatness
ident_top:=page_top_dots+(page_bottom_dots-page_top_dots+Font.Height) div 2;
TextOut(ident_left-wm_shift,ident_top-wm_shift,ident_str);
TextOut(ident_left+wm_shift,ident_top-wm_shift,ident_str);
TextOut(ident_left-wm_shift,ident_top+wm_shift,ident_str);
TextOut(ident_left+wm_shift,ident_top+wm_shift,ident_str);
Font.Color:=clWhite;
TextOut(ident_left,ident_top,ident_str); // ink saving, make watermark outline
Brush.Style:=bsSolid; // reset..
Font.Color:=clBlack;
end;
if bgnd_form.output_grid_in_front_checkbox.Checked=True // do shapes and sb first
then pdf_shapes_and_sketchboard_items(grid_left,grid_top); // 206e
Brush.Color:=clWhite; // 206e moved here
Brush.Style:=bsSolid;
Font.Assign(print_labels_font);
if printgrid_i=1
then begin
case grid_labels_code_i of
1: grid_str:='feet'; // labels in feet.
2: grid_str:='inches'; // labels in inches.
3: grid_str:='proto-feet'; // labels in prototype feet.
4: grid_str:='cm'; // labels in cm.
6: grid_str:='mm'; // labels in mm.
else run_error(213);
end;//case
Pen.Color:=printgrid_colour; // for grid lines.
Pen.Mode:=pmCopy;
if pad_form.printed_grid_dotted_menu_entry.Checked=True
then begin
Brush.Color:=clWhite; // 0.93.a gaps in dotted lines.
Brush.Style:=bsSolid;
//Pen.Style:=psDot; //out wPDF bug
Pen.Style:=psSolid;
pen_width:=1; // must be 1 for dots.
end
else begin
Pen.Style:=psSolid;
{if impact>0 then pen_width:=1 // impact printer or plotter.
else}
pen_width:=printgrid_wide;
if pen_width<1 then pen_width:=1;
end;
// draw horizontal grid lines (across width)...
if {(banner_paper=True) or (} print_pages_top_origin<>0 {)}
then now_gridx:=0-gridx
else now_gridx:=0; // init grid lines. no need for first line (gets overwritten by trim margins).
repeat
now_gridx:=now_gridx+gridx;
grid_now_dots:=Round((now_gridx-grid_top)*scal_out)+page_top_dots;
if grid_now_dots<0 then CONTINUE;
if (now_gridx=0) and (Pen.Style=psSolid)
then Pen.Width:=pen_width+2 // thicker datum line (only appears if page origin is negative).
else Pen.Width:=pen_width;
move_to.X:=left_blanking_dots; move_to.Y:=grid_now_dots;
line_to.X:=printer_width_indexmax_dots; line_to.Y:=grid_now_dots;
if check_limits(move_to, line_to)=True then begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
case grid_labels_code_i of
1: grid_label:=now_gridx/30480; // labels in feet.
2: grid_label:=now_gridx/2540; // labels in inches.
3: grid_label:=now_gridx/(100*scale); // labels in prototype feet.
4: grid_label:=now_gridx/1000; // labels in cm.
6: grid_label:=now_gridx/100; // labels in mm.
else begin
grid_label:=0; // keep the compiler happy.
run_error(223);
end;
end;//case
grid_label_str:=FormatFloat('0.###',grid_label);
text_out(left_blanking_dots,grid_now_dots-(TextHeight('A') div 2),grid_label_str+' '); // add labels.
until grid_now_dots>page_bottom_dots;
// draw vertical grid lines (down length)...
if print_pages_left_origin<>0
then now_gridy:=0-gridy
else now_gridy:=0; // init grid lines. no need for first line (gets overwritten by trim margin).
repeat
now_gridy:=now_gridy+gridy;
grid_now_dots:=Round((now_gridy-grid_left)*scaw_out)+page_left_dots;
if grid_now_dots<0 then CONTINUE;
if (now_gridy=0) and (Pen.Style=psSolid)
then Pen.Width:=pen_width+2 // thicker datum line (only appears if page origin is negative).
else Pen.Width:=pen_width;
move_to.X:=grid_now_dots; move_to.Y:=top_blanking_dots;
line_to.X:=grid_now_dots; line_to.Y:=printer_length_indexmax_dots;
if check_limits(move_to, line_to)=True then begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
case grid_labels_code_i of
1: grid_label:=now_gridy/30480; // labels in feet.
2: grid_label:=now_gridy/2540; // labels in inches.
3: grid_label:=now_gridy/(100*scale); // labels in prototype feet.
4: grid_label:=now_gridy/1000; // labels in cm.
6: grid_label:=now_gridy/100; // labels in mm.
else begin
grid_label:=0; // keep the compiler happy.
run_error(224);
end;
end;//case
grid_label_str:=FormatFloat('0.###',grid_label);
text_out(grid_now_dots-(TextWidth(grid_label_str) div 2),page_top_dots-(printmargin_wide div 2)-halfmm_dots-TextHeight('A'),grid_label_str); // add labels.
until grid_now_dots>page_right_dots;
// finally add the units string...
text_out(left_blanking_dots,page_top_dots-(printmargin_wide div 2)-halfmm_dots-TextHeight('A'),grid_str); // add the units string.
Pen.Style:=psSolid; // reset in case of dotted.
end;
// grid finished.
//----------------------------------------
if bgnd_form.output_grid_in_front_checkbox.Checked=False // now do shapes and sb over the grid
then pdf_shapes_and_sketchboard_items(grid_left,grid_top); // 206e
pdf_bgnd(grid_left,grid_top); // now print any background templates.
// control template - draw timbers and all marks except rail joints...
if (print_entire_pad_flag=False) // control template
and (output_diagram_mode=False) // 0.93.a no control template if diagram mode
and (turnoutx>0) // not if invalidated
// 0.93.a if printing background templates in Quick mode, the control template has been put on the background
then begin
if marks_list_ptr=nil then BREAK; // pointer to marks list not valid, exit all sheets.
draw_marks(grid_left,grid_top,False,False); // print all the background timbering and marks except rail joints and timber numbers.
if pad_form.timber_numbering_over_platforms_menu_entry.Checked=False
then draw_marks(grid_left,grid_top,False,True); // 226d and again to do the timber numbers now if wanted under platforms
// add dropper symbols under rails..
pdf_draw_symbols(pdf_form.pdf_printer.Canvas,current_symbols,0,1,grid_left,grid_top,ypd); // 227c draw the 0=droppers over timbers 1=first layer
// rails and track centre-lines...
if ( (print_settings_form.output_centrelines_checkbox.Checked=True) and (dummy_template=False) ) // 212a
or ( (print_settings_form.output_bgnd_shapes_checkbox.Checked=True) and (dummy_template=True) )
then begin
Brush.Color:=clWhite; // 0.93.a gaps in dotted lines.
Brush.Style:=bsClear;
TextOut(0,0,'');
Pen.Mode:=pmCopy;
if dummy_template=True // 212a
then begin
Pen.Style:=psSolid;
Pen.Color:=printshape_colour;
Pen.Width:=printshape_wide;
if Pen.Width<1 then Pen.Width:=1;
end
else begin
Pen.Color:=printcurail_colour;
Pen.Width:=printcl_wide;
if Pen.Width<1 then Pen.Width:=1;
{if Pen.Width=1 then Pen.Style:=psDash // out wPDF bug
else} Pen.Style:=psSolid;
end;
for aq:=24 to 25 do begin
if ( (plain_track=False) or (aq=24) ) and (aqyn[aq]=True)
// main side only only if plain track, and data available ?
then begin
move_to.X:=get_w_dots(aq,0); move_to.Y:=get_l_dots(aq,0);
for now:=1 to nlmax_array[aq] do begin
line_to.X:=get_w_dots(aq,now); line_to.Y:=get_l_dots(aq,now);
if check_limits(move_to, line_to)=True then begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
move_to:=line_to;
end;//for
end;
end;//for-next aq
end;//if track centre-lines.
if (print_settings_form.output_rails_checkbox.Checked=True) or ( (detail_mode_form.thickcl_radio.Checked=True) and (detail_mode_form.no_platforms_radio.Checked=False) ) // 226e
then begin
// draw turnout rails...
Pen.Width:=printrail_wide;
if Pen.Width<1 then Pen.Width:=1;
if (rail_infill_i=0) // out for pdf, was or ((scale*out_factor)<0.75) // less than 18.75% for 4mm scale (control template) (10.71% for 7mm).
then begin // outline (pen) mode ...
// n.b. this mode does not automatically close the rail-ends.
for aq:=0 to 23 do begin // 24, 25 centre-lines already done.
if (adjacent_edges=False) and (aq>15) then CONTINUE; // no adjacent tracks in output // 206b
if (detail_mode_form.thickcl_radio.Checked=True) and (aq<16) and (aq>23) then CONTINUE; // 226c add only platforms if centre-lines only
case aq of // 223d
16,17,20,21: if print_settings_form.output_platforms_checkbox.Checked=False then CONTINUE; // platforms not wanted
18,19,22,23: if print_settings_form.output_trackbed_edges_checkbox.Checked=False then CONTINUE; // trackbed edges not wanted
end;//case
draw_outline_railedge(aq,printcurail_colour);
end;//next aq
for aq:=26 to aq_max_c do draw_outline_railedge(aq,printcurail_colour); // K-crossing check rails.
outline_railends; // finally do the rail ends for outline mode
end
else begin // infill (polygon) mode ...
// do blades first - neater result.
if detail_mode_form.thickcl_radio.Checked=False // 226c
then begin
for rail:=1 to 3 do draw_fill_rail(8); // closure rails and curved stock rail.
rail:=0; // straight stock rail.
draw_fill_rail(8);
for rail:=6 to 7 do draw_fill_rail(8); // check rails
end; // 226c
if adjacent_edges=True // 206b
then begin
rail:=16;
repeat
case rail of // 223d
16,20: if print_settings_form.output_platforms_checkbox.Checked=True then draw_fill_rail(1); // platforms
18,22: if print_settings_form.output_trackbed_edges_checkbox.Checked=True then draw_fill_rail(1); // trackbed edges
end;//case
rail:=rail+2;
until rail>22;
end;
if detail_mode_form.thickcl_radio.Checked=False // 226c
then begin
rail:=26;
repeat
draw_fill_rail(1); // K-crossing MS check rails.
rail:=rail+2;
until rail>28;
draw_fill_vee; // now do the vee.
// finally draw in or overdraw the planing gauge-faces - (no infill) ...
aq:=1;
if (plain_track=False) and (gaunt=False) and (aqyn[1]=True) and (list_planing_mark_aq1>0) {and (drawn_full_aq1=False)} // not if already drawn.
then begin
move_to.X:=get_w_dots(aq,0); move_to.Y:=get_l_dots(aq,0);
for now:=1 to list_planing_mark_aq1{+1} do begin // +1 to overdraw
line_to.X:=get_w_dots(aq,now); line_to.Y:=get_l_dots(aq,now);
if check_limits(move_to, line_to)=True then begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
move_to:=line_to;
end;//for
end;
aq:=2;
if (plain_track=False) and (gaunt=False) and (aqyn[2]=True) and (list_planing_mark_aq2>0) {and (drawn_full_aq2=False)} // not if already drawn.
then begin
move_to.X:=get_w_dots(aq,0); move_to.Y:=get_l_dots(aq,0);
for now:=1 to list_planing_mark_aq2{+1} do begin // +1 to overdraw
line_to.X:=get_w_dots(aq,now); line_to.Y:=get_l_dots(aq,now);
if check_limits(move_to, line_to)=True then begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
move_to:=line_to;
end;//for
end;
// CAN'T GET FLOODFILL TO WORK ON THE PRINTER 26-8-98.
// and flood fill the planing with the margin colour ...
end; // 226c
end;//polygon mode
// add ID text, gaps and sticker symbols over the rails..
pdf_draw_symbols(pdf_form.pdf_printer.Canvas,current_symbols,0,2,grid_left,grid_top,ypd); // 227c
pdf_draw_symbols(pdf_form.pdf_printer.Canvas,current_symbols,1,2,grid_left,grid_top,ypd); // 227a draw the 1=gaps 2=second layer
pdf_draw_symbols(pdf_form.pdf_printer.Canvas,current_symbols,2,2,grid_left,grid_top,ypd); // 227a draw the 2=stickers 2=second layer
// finally add rail joint marks across rails (will now mark over rail infill) and timber numbers over platforms ... 226d
draw_marks(grid_left,grid_top,True,False);
if pad_form.timber_numbering_over_platforms_menu_entry.Checked=True // 226d
then draw_marks(grid_left,grid_top,False,True);
end;//if rails
end;// if control template
// now the trim margins....
Pen.Color:=printmargin_colour;
Pen.Mode:=pmCopy;
Pen.Style:=psSolid;
Pen.Width:=printmargin_wide;
move_to.X:=left_blanking_dots; move_to.Y:=page_top_dots; // paper top left.
line_to.X:=printer_width_indexmax_dots; line_to.Y:=page_top_dots; // paper top margin.
if check_limits(move_to, line_to)=True then begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
// and right-hand alignment targets...
move_to.X:=page_right_dots; move_to.Y:=top_blanking_dots;
line_to.X:=page_right_dots; line_to.Y:=printer_length_indexmax_dots; // paper right margin.
if check_limits(move_to, line_to)=True then begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
move_to.X:=page_right_dots-alignmarks_inner_dots;
line_to.X:=printer_width_indexmax_dots;
move_to.Y:=page_quarter_dots; // right 1/4 target.
line_to.Y:=page_quarter_dots;
if check_limits(move_to, line_to)=True then begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
move_to.Y:=page_mid_dots; // right centre target.
line_to.Y:=page_mid_dots;
if check_limits(move_to, line_to)=True then begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
move_to.Y:=page_3quarter_dots; // right 3/4 target.
line_to.Y:=page_3quarter_dots;
if check_limits(move_to, line_to)=True then begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
// don't show bottom trim line on the last sheet down, otherwise he might trim off the info line,
// and no bottom trim lines on any sheet for banners, unless for multiple print runs.
if sheet_down0 then Rectangle(0,0,left_blanking_dots,printer_length_indexmax_dots+1);
if right_blanking_dots<=printer_width_indexmax_dots then Rectangle(right_blanking_dots,0,printer_width_indexmax_dots+1,printer_length_indexmax_dots+1);
if {(} top_blanking_dots>0 then Rectangle(0,0,printer_width_indexmax_dots+1,top_blanking_dots);
if {(} bottom_blanking_dots<=printer_length_indexmax_dots then Rectangle(0,bottom_blanking_dots,printer_width_indexmax_dots+1,printer_length_indexmax_dots+1);
// top branding...
Brush.Color:=clWhite;
Brush.Style:=bsSolid;
Font.Assign(set_font('Arial',6,[],clBlack));
text_out(left_blanking_dots,top_blanking_dots,top_str); // name and "who for?" string at topleft.
// small text inside the margins...
// mods 208g 20-04-2014 show page origin dims on templates...
if print_entire_pad_flag=True // 214a for Gordon, see message ref: 19595 // background templates
then begin
if keep_form.box_file_label.Caption<>''
then last_file_str:=' printing from: '+ExtractFileName(keep_form.box_file_label.Caption)
else last_file_str:=' printing background templates';
end
else last_file_str:=' printing the control template';
if pad_form.show_margin_coordinates_menu_entry.Checked=True
then begin
all_pages_origin_str:='all pages origin (a/1): top(X)='+round_str(print_pages_top_origin,2)+'mm, left(Y)='+round_str(print_pages_left_origin,2)+'mm '; // 208g
this_page_begin_str:='this page begins: top(X)='+round_str(grid_top/100,2)+'mm, left(Y)='+round_str(grid_left/100,2)+'mm'+last_file_str; // 208g
this_page_end_str:='this page ends: bottom(X)='+round_str(grid_bottom/100,2)+'mm, right(Y)='+round_str(grid_right/100,2)+'mm'; // 208g
end
else begin
all_pages_origin_str:='';
this_page_begin_str:=last_file_str;
this_page_end_str:='';
end;
if pad_form.show_corner_info_menu_entry.Checked=True // 223d
then begin
Font.Assign(print_corner_page_numbers_font); // 0.93.a
if print_corner_page_numbers_font.Size>8
then begin
Brush.Style:=bsClear;
TextOut(0,0,'');
end;
Textout(page_left_dots+printmargin_wide+3, page_top_dots+printmargin_wide+2, this_page_begin_str); // top left corner
Textout(page_left_dots+printmargin_wide+3, page_bottom_dots+Font.Height-printmargin_wide-4, page_num_str+' '+box_project_title_str+' '+DateToStr(Date)+' '+TimeToStr(Time)); // bottom left corner
Textout(page_right_dots-printmargin_wide-TextWidth(all_pages_origin_str+page_num_str)-3,page_top_dots+printmargin_wide+2,all_pages_origin_str+page_num_str); // top right corner
Textout(page_right_dots-printmargin_wide-TextWidth(this_page_end_str)-3,page_bottom_dots+Font.Height-printmargin_wide-4,this_page_end_str); // bottom right corner
end;
if distortions<>0 // ) and (pdf_form.warnings_checkbox.Checked=True)
then begin
Font.Assign(set_font('Arial',7,[],printmargin_colour));
text_out(page_left_dots+printmargin_wide,page_top_dots+printmargin_wide-(Font.Height*5),
' Warning : Data distortions are in force. This template may not be dimensionally accurate.');
end;
Font.Assign(print_labels_font); // reset for labels.
Font.Color:=calc_intensity(clBlack);
Brush.Color:=clWhite;
Brush.Style:=bsClear; // transparent over detail.
TextOut(0,0,'');
TextOut(left_blanking_dots,page_bottom_dots+(printmargin_wide div 2)+halfmm_dots,page_str+bottom_str); // add the bottom string last.
Font.Assign(print_labels_font); // reset for labels.
Brush.Style:=bsSolid;
end;//with Canvas 0.91.d pdf
end;//with sheet
end;// 227a while was for-next
end;// 227a while was for-next
if printer_printing=True then end_doc(True); // last or only page.
finally
// 226c ...
if (diagram_partials_omitted=True) and (diagram_partial_msg_pref=False) // php/910 diagram-mode no partial templates
then begin
alert_box.preferences_checkbox.Checked:=False;
alert_box.preferences_checkbox.Tag:=1; // no what's this note about prefs
alert_box.preferences_checkbox.Show;
alert(2,'php/910 diagram-mode - partial templates omitted',
'Your trackplan includes some partial templates which it has not been possible to include in `0diagram-mode`3 PDF output.'
+'||For example templates in complex formations such as a tandem turnout or a slip.'
+'||Please click `0more information online`1 above, for more explanation and suggested solutions.'
+'||• This does not apply to normal `0detail-mode`3 output| of construction templates.',
'','','','','','continue',0);
diagram_partial_msg_pref:=alert_box.preferences_checkbox.Checked;
alert_box.preferences_checkbox.Hide;
alert_box.preferences_checkbox.Tag:=0; // restore
end;
print_busy:=False;
enable_buttons(True); // ?? not really needed.
pdf_form.Close;//Hide;
end;//try
end;
//_____________________________________________________________________________________
procedure Tpdf_form.FormShow(Sender: TObject);
begin
detail_mode_radiobutton.Checked:= NOT output_diagram_mode;
diagram_mode_radiobutton.Checked:= output_diagram_mode;
Left:=pad_form.Left+pad_form.Width-Width-20;
if info_form.Showing=True // don't want the info cluttering the print preview.
then begin
info_was_showing:=True;
pad_form.hide_info_menu_entry.Click;
end
else info_was_showing:=False;
if panning_form.Showing=True // nor the panning controls.
then begin
panning_was_showing:=True;
panning_form.Hide;
end
else panning_was_showing:=False;
if shove_timber_form.Showing=True // nor the shove timbers form.
then begin
shove_was_showing:=True;
shove_timber_form.Hide;
end
else shove_was_showing:=False;
if grid_form.Showing=True // nor the spacing ring form.
then begin
spacing_was_showing:=True;
grid_form.Hide;
end
else spacing_was_showing:=False;
// bugs fixed -- 208d ...
if rail_options_form.Showing=True // nor this
then begin
rail_options_was_showing:=True;
rail_options_form.Hide;
end
else rail_options_was_showing:=False;
if platform_form.Showing=True // nor this
then begin
platform_was_showing:=True;
platform_form.Hide;
end
else platform_was_showing:=False;
if trackbed_form.Showing=True // nor this
then begin
trackbed_was_showing:=True;
trackbed_form.Hide;
end
else trackbed_was_showing:=False;
if check_diffs_form.Showing=True // nor this
then begin
check_diffs_was_showing:=True;
check_diffs_form.Hide;
end
else check_diffs_was_showing:=False;
if data_child_form.Showing=True // nor this
then begin
data_child_was_showing:=True;
data_child_form.Hide;
end
else data_child_was_showing:=False;
if stay_visible_form.Showing=True // nor this
then begin
stay_visible_was_showing:=True;
stay_visible_form.Hide;
end
else stay_visible_was_showing:=False;
if all_button.Enabled=True then all_button.SetFocus;
if print_entire_pad_flag=True
then begin
if print_group_only_flag=True
then Caption:=' create PDF file : group templates only'
else Caption:=' create PDF file : background templates';
end
else Caption:=' create PDF file : the control template';
if fit_single_sheet=True then Caption:=Caption+' on a single page';
pad_form.top_toolbar_panel.Hide;
pad_form.second_toolbar_panel.Hide; // 217a
make_slip_form.Hide; // toolbars marker
show_output_mode_panel;
end;
//_________________________________________________________________________________________
procedure Tpdf_form.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Key=VK_F10
then begin
Key:=0; // otherwise selects the menus.
end;
if Key=VK_PAUSE then Application.Minimize; // hide TEMPLOT on PAUSE key.
if Key=VK_F12 // same as cancel, but unlocks the redraw
then begin
Key:=0;
pdf_form.omit_all_button.Click;
pad_form.redraw_menu_entry.Click; // unlock the redraw if locked.
//Close;
end;
end;
//________________________________________________________________________________________
procedure Tpdf_form.colour_panelClick(Sender: TObject);
begin
Color:=get_colour('choose a new colour for the print information window',Color);
button_clicked:=False; // overide the print form Deactivate.
end;
//_________________________________________________________________________________________
procedure Tpdf_form.size_updownClick(Sender: TObject; Button: TUDBtnType);
begin
form_scaling:=True; // no ScrollInView on resize.
if size_updown.Position>size_updown.Tag // ! position goes up, size goes down.
then ScaleBy(9,10); // scale the form contents down.
if size_updown.Position(make_slip_form.Width+pad_form.top_toolbar_panel.Width) then make_slip_form.Show; // toolbars marker
pad_form.output_mode_panel.Visible:=False;
end;
//______________________________________________________________________________
procedure Tpdf_form.omit_all_buttonClick(Sender: TObject);
begin
button_clicked:=True;
ModalResult:=mrCancel; // clicking the panel instead of the button doesn't set this.
end;
//______________________________________________________________________________
procedure Tpdf_form.next_row_buttonClick(Sender: TObject);
begin
button_clicked:=True; // ModalResult = mrRetry
end;
//_________________________________________________________________________________________
procedure Tpdf_form.omit_page_buttonClick(Sender: TObject);
begin
button_clicked:=True; // ModalResult = mrIgnore
end;
//________________________________________________________________________________________
procedure Tpdf_form.ok_buttonClick(Sender: TObject);
begin
button_clicked:=True; // ModalResult = mrOK
end;
//_________________________________________________________________________________________
procedure Tpdf_form.all_buttonClick(Sender: TObject);
begin
button_clicked:=True;
ModalResult:=mrYes; // clicking the panel instead of the button doesn't set this.
end;
//_________________________________________________________________________________________
procedure Tpdf_form.FormDeactivate(Sender: TObject);
begin
if print_busy=True // don't let him click off the form.
then begin
Beep;
Show;
BringToFront;
EXIT;
end;
button_clicked:=True;
ModalResult:=mrCancel;
end;
//________________________________________________________________________________________
procedure pdf_sketchboard_items(on_canvas:TCanvas; grid_left,grid_top:extended); // 206e
var
dtp_rect:TRect;
dtp_width,dtp_height:extended;
p1,p2:Tpex;
move_to,line_to:TPoint; // 208a
raster_rect:TRect; // 208a
low_res_bitmap:TBitmap; // 208a
this_graphic:TGraphic; // 208a
saved_cursor:TCursor;
begin
if print_settings_form.output_sketchboard_items_checkbox.Checked=False then EXIT;
if pdf_form.include_sketchboard_items_checkbox.Checked=False then EXIT;
if dtp_form.Active=True then EXIT;
if go_sketchboard=False then EXIT; // 205e sketchboard not in use
dtp_form.dtp_document.ZoomPage; // needed to print items -- fresh calc from rulers.
update_model_rulers;
if trackplan_exists=False then EXIT; // can't scale the items without a trackplan item
if stretch_factor_wide0 then CONTINUE; // shape hidden for output
if shape_code<>4 // not a target mark
then begin
case shape_style of
0: begin
Brush.Color:=clWhite;
Brush.Style:=bsClear; // transparent. (also lines).
TextOut(0,0,'');
end;
1: begin
if pdf_black_white=True // 0.93.a -- use timber infill colour
then Brush.Color:=clWhite
else begin
{if impact>0 then Brush.Color:=printtimber_colour // colour plotter.
else} Brush.Color:=printtimber_infill_colour;
end;
// out 0.93.a Brush.Color:=clWhite;
Brush.Style:=bsSolid; // blank out.
end;
2: begin
Brush.Color:=Pen.Color;
Brush.Style:=bsDiagCross; // cross-hatched.
TextOut(0,0,''); // !!! Delphi bug? This seems to be necessary before dotted lines will draw properly.
// TextOut obviously initialises some background mask property which I have been unable
// to find or set any other way.
//if shape_code=0 then Pen.Style:=psDot; // out wPDF bug // dashed line.
Pen.Style:=psSolid;
end;
else begin
Brush.Color:=clWhite;
Brush.Style:=bsClear; // transparent.
TextOut(0,0,'');
end;
end;//case
move_to.X:=Round((p1.y*100+re_org_y-grid_left)*scaw_out)+page_left_dots;
move_to.Y:=Round((p1.x*100+re_org_x-grid_top)*scal_out)+page_top_dots;
if shape_code=3 // label rectangle..
then begin
Font.Color:=printshape_colour;
line_to.X:=move_to.X+TextWidth(shape_name+' '); // 0.93.a add 4 spaces // was +5
line_to.Y:=move_to.Y+ABS(Font.Height*4 div 3); // 0.93.a // was +5
Brush.Color:=clWhite;
Brush.Style:=bsSolid; // blank rectangle box for label.
Pen.Color:=Font.Color;
Pen.Width:=ABS(Font.Height div 24); // 0.93.a added arbitrary
if Pen.Width<1 then Pen.Width:=1;
end
else begin
line_to.X:=Round((p2.y*100+re_org_y-grid_left)*scaw_out)+page_left_dots;
line_to.Y:=Round((p2.x*100+re_org_x-grid_top)*scal_out)+page_top_dots;
end;
if (move_to.X<0) and (line_to.X<0) then CONTINUE; // not on this page.
if (move_to.X>printer_width_indexmax_dots) and (line_to.X>printer_width_indexmax_dots) then CONTINUE; // not on this page.
if (move_to.Y<0) and (line_to.Y<0) then CONTINUE; // not on this page.
if (move_to.Y>printer_length_indexmax_dots) and (line_to.Y>printer_length_indexmax_dots) then CONTINUE; // not on this page.
if check_limits(move_to, line_to)=True
then begin
case shape_code of
-1: begin // picture = bitmap image. !!! needs 90 deg rotate. 9-2-01.
if pdf_form.include_pictures_checkbox.Checked=True
then begin
raster_rect.Left:=move_to.X;
raster_rect.Top:=move_to.Y;
raster_rect.Right:=line_to.X;
raster_rect.Bottom:=line_to.Y;
if Tbgshape(bgnd_form.bgnd_shapes_listbox.Items.Objects[i]).bgnd_shape.picture_is_metafile=True
then begin
// metafile... 214a
// wPDF pdf_printer Canvas bug - stretchdrawing rotated metafiles gives angle error
// convert it to a bitmap and copy to pdf Canvas instead.
// this means metafiles no longer transparent on PDF...
dummy_bitmap:=TBitmap.Create;
dummy_bitmap.Width:=raster_rect.Right-raster_rect.Left;
dummy_bitmap.Height:=raster_rect.Bottom-raster_rect.Top;
dummy_rect:=Rect(0,0,dummy_bitmap.Width,dummy_bitmap.Height);
// blank to start...
with dummy_bitmap.Canvas do begin
Brush.Color:=pdf_form.pdf_printer.Canvas.Brush.Color;
Brush.Style:=bsSolid;
FillRect(dummy_rect);
TextOut(0,0,''); // !!! Delphi bug?
end;//with
try
if Tbgshape(bgnd_form.bgnd_shapes_listbox.Items.Objects[i]).bgimage.image_shape.rotated_picture.Width=0 // empty Graphic
then begin
pdf_rotate_metafile(i);
Application.ProcessMessages; // this seems to be necessary for StretchDraw to work first time.
end;
dummy_bitmap.Canvas.StretchDraw(dummy_rect,Tbgshape(bgnd_form.bgnd_shapes_listbox.Items.Objects[i]).bgimage.image_shape.rotated_picture.Graphic); // draw rotated metafile on it
CopyMode:=cmSrcCopy;
CopyRect(raster_rect,dummy_bitmap.Canvas,dummy_rect); // and copy it to PDF.
except
Pen.Color:=printshape_colour;
Brush.Color:=Pen.Color; // metafile failed - draw hatched outline.
Brush.Style:=bsBDiagonal;
Rectangle(move_to.X, move_to.Y, line_to.X, line_to.Y);
end;//try
dummy_bitmap.Free;
end //end metafile
else begin // bitmap...
try
if Tbgshape(bgnd_form.bgnd_shapes_listbox.Items.Objects[i]).bgimage.image_shape.rotated_bitmap.Empty=True
then begin
pdf_rotate_bitmap(i);
Application.ProcessMessages; // this seems to be necessary for StretchDraw to work first time.
end;
if Tbgshape(bgnd_form.bgnd_shapes_listbox.Items.Objects[i]).bgnd_shape.show_transparent=True // 0.93.a moved into file
then CopyMode:=cmSrcAnd // (destination Canvas) transparent if on white background.
else CopyMode:=cmSrcCopy; // reset normal for destination Canvas.
if Tbgshape(bgnd_form.bgnd_shapes_listbox.Items.Objects[i]).bgimage.image_shape.rotated_bitmap.Monochrome=True
then begin
Brush.Style:=bsSolid; //!!! these are all needed to get StretchDraw to work with monochrome bitmaps
Brush.Color:=clWhite;
Pen.Color:=clBlack;
Font.Color:=clBlack; // !!!! including this.
TextOut(0,0,''); // !!! Delphi bug?
// TextOut obviously initialises some background mask property which I have been unable
// to find or set any other way.
end;
// Delphi funny: StretchDraw requires TGraphic parameter instead of TBitmap to work reliably...
StretchDraw(raster_rect,Tbgshape(bgnd_form.bgnd_shapes_listbox.Items.Objects[i]).bgimage.image_shape.rotated_picture.Graphic);
CopyMode:=cmSrcCopy; // reset normal for destination Canvas.
except
CopyMode:=cmSrcCopy; // reset normal for destination Canvas.
Pen.Color:=printshape_colour;
Brush.Color:=Pen.Color; // stretch failed - draw hatched outline.
Brush.Style:=bsBDiagonal;
Rectangle(move_to.X, move_to.Y, line_to.X, line_to.Y);
end;//try
end;// bitmap
end;//include pictures
if (pdf_form.picture_borders_checkbox.Checked=True) or (pdf_form.include_pictures_checkbox.Checked=False) // or (pdf_form.picture_outlines_radio.Checked=True)
then begin
if pdf_form.include_pictures_checkbox.Checked=True {pdf_form.picture_outlines_radio.Checked=False}
then Pen.Width:=printpicborder_wide; // picture borders thinner unless an outline only.
Pen.Color:=printshape_colour;
Brush.Color:=clWhite;
Brush.Style:=bsClear;
TextOut(0,0,'');
Rectangle(move_to.X, move_to.Y, line_to.X, line_to.Y);
end;
if pdf_form.include_pictures_checkbox.Checked=False // pdf_form.picture_outlines_radio.Checked=True
then begin
MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); // printing picture outlines only - draw diagonal line.
MoveTo(move_to.X, line_to.Y); LineTo(line_to.X, move_to.Y); // and other diagonal line.
end;
end;//-1
0: begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
1,3: Rectangle(move_to.X, move_to.Y, line_to.X, line_to.Y);
2: Ellipse(move_to.X, move_to.Y, line_to.X, line_to.Y);
end;//case
if shape_code=3
then begin
Brush.Color:=clWhite;
Brush.Style:=bsClear;
TextOut(move_to.X,move_to.Y,' '+shape_name); // 0.93.a 2 spaces // was +1 // insert label text in rectangle box.
end;
end;
end
else begin // shape_code=4, draw a target mark
arm:=p2.x; // cross arm length.
diamond:=arm/2; // size of centre diamond.
move_to.X:=Round((p1.y*100+re_org_y-grid_left)*scaw_out)+page_left_dots; // lengthwise arms...
move_to.Y:=Round(((p1.x-arm)*100+re_org_x-grid_top)*scal_out)+page_top_dots;
line_to.X:=move_to.X;
line_to.Y:=Round(((p1.x+arm)*100+re_org_x-grid_top)*scal_out)+page_top_dots;
if check_limits(move_to, line_to)=True
then begin
MoveTo(move_to.X, move_to.Y);
LineTo(line_to.X, line_to.Y); // draw lengthwise arms.
end;
move_to.X:=Round(((p1.y-arm)*100+re_org_y-grid_left)*scaw_out)+page_left_dots; // widthwise arms...
move_to.Y:=Round((p1.x*100+re_org_x-grid_top)*scal_out)+page_top_dots;
line_to.X:=Round(((p1.y+arm)*100+re_org_y-grid_left)*scaw_out)+page_left_dots;
line_to.Y:=move_to.Y;
if check_limits(move_to, line_to)=True
then begin
MoveTo(move_to.X, move_to.Y);
LineTo(line_to.X, line_to.Y); // draw widthwise arms.
end;
// now do 4 diamond lines...
// NW line...
move_to.X:=Round((p1.y*100+re_org_y-grid_left)*scaw_out)+page_left_dots;
move_to.Y:=Round(((p1.x-diamond)*100+re_org_x-grid_top)*scal_out)+page_top_dots;
line_to.X:=Round(((p1.y+diamond)*100+re_org_y-grid_left)*scaw_out)+page_left_dots;
line_to.Y:=Round((p1.x*100+re_org_x-grid_top)*scal_out)+page_top_dots;
if check_limits(move_to, line_to)=True
then begin
MoveTo(move_to.X, move_to.Y);
LineTo(line_to.X, line_to.Y);
end;
move_to:=line_to; // NE line...
line_to.X:=Round((p1.y*100+re_org_y-grid_left)*scaw_out)+page_left_dots;
line_to.Y:=Round(((p1.x+diamond)*100+re_org_x-grid_top)*scal_out)+page_top_dots;
if check_limits(move_to, line_to)=True
then begin
MoveTo(move_to.X, move_to.Y);
LineTo(line_to.X, line_to.Y);
end;
move_to:=line_to; // SE line...
line_to.X:=Round(((p1.y-diamond)*100+re_org_y-grid_left)*scaw_out)+page_left_dots;
line_to.Y:=Round((p1.x*100+re_org_x-grid_top)*scal_out)+page_top_dots;
if check_limits(move_to, line_to)=True
then begin
MoveTo(move_to.X, move_to.Y);
LineTo(line_to.X, line_to.Y);
end;
move_to:=line_to; // SW line...
line_to.X:=Round((p1.y*100+re_org_y-grid_left)*scaw_out)+page_left_dots;
line_to.Y:=Round(((p1.x-diamond)*100+re_org_x-grid_top)*scal_out)+page_top_dots;
if check_limits(move_to, line_to)=True
then begin
MoveTo(move_to.X, move_to.Y);
LineTo(line_to.X, line_to.Y);
end;
end;
end;//with now_shape
end;//for next i
end;//with pdf_form.pdf_printer.Canvas
end;
//_______________________________________________________________________________________
procedure pdf_bgnd_marks(grid_left,grid_top:extended; maxbg_index:integer; rail_joints_now,numbers_now:boolean); // print all the background timbering and marks.
// if rail_joints_now=True draw only the rail joints, otherwise omit them.
// if numbers_now=True draw only the timber numbers, otherwise omit them. // 226d
// !!! NOT BOTH TRUE AT SAME TIME
var
//single_colour_flag:boolean;
i,n:integer;
move_to,line_to:TPoint;
p1,p2,p3,p4: TPoint;
now_keep:Tbgnd_keep;
now_ti:Ttemplate_info;
array_max:integer;
code:integer;
radcen_arm:extended;
infill_points:array [0..3] of TPoint;
fontsize:extended;
num_str:string;
tbnum_str:string;
mapping_colour:integer;
using_mapping_colour:boolean;
switch_label_str:string; // 206b
s,idnum_str,idtb_str:string; // 208a
num:integer; // 208a
begin
with pdf_form.pdf_printer.Canvas do begin
Pen.Mode:=pmCopy; // defaults.
Pen.Style:=psSolid;
for n:=0 to maxbg_index do begin
if Ttemplate(keeps_list.Objects[n]).bg_copied=False then CONTINUE; // no data, not on background.
if (Ttemplate(keeps_list.Objects[n]).group_selected=False) and (print_group_only_flag=True) then CONTINUE; // not in group. 0.78.b 10-12-02.
if Ttemplate(keeps_list.Objects[n]).template_info.keep_dims.box_dims1.fb_kludge_template_code>0 then CONTINUE; // 209c no marks for fb_kludge templates
now_ti:=Ttemplate(keeps_list.Objects[n]).template_info; // 227a
now_keep:=now_ti.bgnd_keep; // next background keep
with now_keep do begin
// mapping_colours_print: 0=normal, 1=rails only, 2=timbers only, 3=rails and timber outlines, 4:=use the PAD colour instead, -1=single colour.
using_mapping_colour:=False; // default init.
mapping_colour:=clBlack; // init - keep compiler happy.
with Ttemplate(keeps_list.Objects[n]).template_info.keep_dims.box_dims1 do begin
idnum_str:=id_number_str; // 208a
if (use_print_mapping_colour=True)
and ( (mapping_colours_print=2) or (mapping_colours_print=3) )
and (pdf_black_white=False)
and (pdf_grey_shade=False)
then begin
mapping_colour:=calc_intensity(print_mapping_colour);
using_mapping_colour:=True;
end;
if (use_pad_marker_colour=True)
and (mapping_colours_print=4) // use pad settings instead
and (pdf_black_white=False)
and (pdf_grey_shade=False)
then begin
mapping_colour:=calc_intensity(pad_marker_colour);
using_mapping_colour:=True;
end;
end;//with
tbnum_str:=timber_numbers_string; // the full string of timber numbering.
// first draw bgnd marks and timbers ...
array_max:=intarray_max(list_bgnd_marks[0]);
for i:=0 to array_max do begin
code:=intarray_get(list_bgnd_marks[4],i);
case code of
-5,-4,-1,0,8,9,10,501..508: CONTINUE; // no name label, timber selector, peg centre, blank, peg arms, plain-track end marks. // 0.94.a no check-rail labels
end;//case
if print_settings_form.output_rail_joints_checkbox.Checked=False // 223d
then begin
case code of
6: CONTINUE; // rail joints not wanted.
end;//case
end;
// overwrite rail joints on rails / timber numbering on platforms
if rail_joints_now=(code<>6) then CONTINUE; // do only the rail joints if rail_joints=True and ignore them otherwise.
if numbers_now=(code<>99) then CONTINUE; // 226d do only the timber numbers if numbers_now=True and ignore them otherwise.
if print_settings_form.output_timbering_checkbox.Checked=False
then begin
case code of
3,4,5,14,33,44,54,55,93,95,99,203,233,293: CONTINUE; // no timbering wanted.
end;//case
end;
if print_settings_form.output_timber_centres_checkbox.Checked=False // 223d
then begin
case code of
4,14,44,54: CONTINUE; // timber centre-lines not wanted.
end;//case
end;
if print_settings_form.output_guide_marks_checkbox.Checked=False // 223d
then begin
case code of
1: CONTINUE; // guide marks not wanted.
end;//case
end;
if print_settings_form.output_switch_drive_checkbox.Checked=False // 223d
then begin
case code of
101: CONTINUE; // switch drive not wanted.
end;//case
end;
if print_settings_form.output_chairs_checkbox.Checked=False
then begin
case code of
480..499: CONTINUE; // no chair outlines wanted 221a
end;//case
end;
if print_settings_form.output_radial_ends_checkbox.Checked=False
then begin
case code of
2,7: CONTINUE; // no radial ends wanted 206a
end;//case
end;
if print_settings_form.output_switch_labels_checkbox.Checked=False
then begin
case code of
600,601..605: CONTINUE; // no long marks or switch labels wanted 206b
end;//case
end;
if print_settings_form.output_xing_labels_checkbox.Checked=False
then begin
case code of
700,701..703: CONTINUE; // no long marks or crossing labels wanted 211b
end;//case
end;
if ((code=5) or (code=55) or (code=95) or (code=600) or (code=700)) and (out_factor<>1.0) then CONTINUE; // reduced ends are meaningless if not full-size. 206b 600 added. 211b 700 added
if ((code=203) or (code=233) or (code=293)) and (i0) and (code<200) and (code<>99) ) // 223d
or (code=600) or (code=700) // 206b 211b overwrite switch marks on output
then begin
Brush.Color:=clWhite; // 0.93.a gaps in dotted lines.
Brush.Style:=bsClear;
TextOut(0,0,'');
p1.X:=intarray_get(list_bgnd_marks[0],i); // x1,y1 in 1/100ths mm
p1.Y:=intarray_get(list_bgnd_marks[1],i);
p2.X:=intarray_get(list_bgnd_marks[2],i); // x2,y2 in 1/100ths mm
p2.Y:=intarray_get(list_bgnd_marks[3],i);
case code of
1,101: Pen.Width:=printmark_wide; // guide marks. switch drive
2: Pen.Width:=printmark_wide; // rad end marks.
3,33,93: Pen.Width:=printtimber_wide; // timber outlines.
4,44: Pen.Width:=1; // timber centre-lines.
5,55,95: Pen.Width:=1; // timber reduced ends.
6: Pen.Width:=printmark_wide; // rail joint marks.
7: Pen.Width:=printmark_wide; // transition ends.
14,54: Pen.Width:=printrail_wide; // timber centre-lines with rail centre-lines (for rivet locations?).
600,700: Pen.Width:=printrail_wide + printrail_wide div 2; // 206b 211b long marks
else Pen.Width:=1; // others not drawn.
end;//case
if Pen.Width<1 then Pen.Width:=1;
{ out wPDF bug on dotted lines
case code of
4,44: Pen.Style:=psDash; // timber centre-lines (not for rivets).
5,55,95: Pen.Style:=psDot; // timber reduced ends.
else Pen.Style:=psSolid; // all the rest.
end;//case
}
Pen.Style:=psSolid;
if Pen.Style<>psSolid then Pen.Width:=1; // delphi bug? (patterns only work for lines 1 dot wide.)
if pdf_black_white=True
then Pen.Color:=clBlack
else begin
if using_mapping_colour=True
then Pen.Color:=mapping_colour
else begin
if mapping_colours_print<0 // 0=normal, 1=rails only, 2=timbers only, 3=rails and timber outlines, 4:=use the PAD colour instead, -1=single colour.
then Pen.Color:=printbg_single_colour // single colour for all of background templates.
else begin
case code of
1,101,600,700: Pen.Color:=printguide_colour; // guide marks. switch drive 206b 600 added, 211b 700 added
2: Pen.Color:=printalign_colour; // rad end marks.
3,33,93: Pen.Color:=printtimber_colour; // timber outlines.
6: Pen.Color:=printjoint_colour; // rail joints.
7: Pen.Color:=printalign_colour; // transition ends.
else Pen.Color:=calc_intensity(clBlack); // thin dotted lines in black only for timber centres and reduced ends.
end;//case
end;
end;
end;
Pen.Mode:=pmCopy;
move_to.X:=Round((p1.Y-grid_left)*scaw_out)+page_left_dots;
move_to.Y:=Round((p1.X-grid_top)*scal_out)+page_top_dots;
line_to.X:=Round((p2.Y-grid_left)*scaw_out)+page_left_dots;
line_to.Y:=Round((p2.X-grid_top)*scal_out)+page_top_dots;
if check_limits(move_to, line_to)=True then begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
end
else begin
if ((code=-2) or (code=-3)) and {(pad_form.print_radial_centres_menu_entry.Checked=True)} // 0.82.b
(print_settings_form.output_radial_centres_checkbox.Checked=True) // draw curving rad centres...
then begin
Pen.Width:=printmark_wide; // guide marks.
if Pen.Width<1 then Pen.Width:=1;
Pen.Style:=psSolid;
Pen.Mode:=pmCopy;
if pdf_black_white=True
then Pen.Color:=clBlack // overide.
else begin
if mapping_colours_print<>-1
then Pen.Color:=calc_intensity(clBlack)
else Pen.Color:=printbg_single_colour;
end;
p1.X:=intarray_get(list_bgnd_marks[0],i); // x1,y1 in 1/100ths mm
p1.Y:=intarray_get(list_bgnd_marks[1],i);
radcen_arm:=400*scale; // 4ft scale arbitrary (scale is for control template).
move_to.X:=Round((p1.Y+radcen_arm-grid_left)*scaw_out)+page_left_dots; // mark centre widthwise.
move_to.Y:=Round((p1.X-grid_top)*scal_out)+page_top_dots;
line_to.X:=Round((p1.Y-radcen_arm-grid_left)*scaw_out)+page_left_dots;
line_to.Y:=Round((p1.X-grid_top)*scal_out)+page_top_dots;
if check_limits(move_to, line_to)=True then begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
move_to.X:=Round((p1.Y-grid_left)*scaw_out)+page_left_dots; // mark centre lengthwise
move_to.Y:=Round((p1.X+radcen_arm-grid_top)*scal_out)+page_top_dots;
line_to.X:=Round((p1.Y-grid_left)*scaw_out)+page_left_dots;
line_to.Y:=Round((p1.X-radcen_arm-grid_top)*scal_out)+page_top_dots;
if check_limits(move_to, line_to)=True then begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
end;
if (code=203) or (code=233) or (code=293) // timber infill...
then begin
infill_points[0].X:=Round((p1.Y-grid_left)*scaw_out)+page_left_dots;
infill_points[0].Y:=Round((p1.X-grid_top)*scal_out)+page_top_dots;
infill_points[1].X:=Round((p2.Y-grid_left)*scaw_out)+page_left_dots;
infill_points[1].Y:=Round((p2.X-grid_top)*scal_out)+page_top_dots;
infill_points[2].X:=Round((p3.Y-grid_left)*scaw_out)+page_left_dots;
infill_points[2].Y:=Round((p3.X-grid_top)*scal_out)+page_top_dots;
infill_points[3].X:=Round((p4.Y-grid_left)*scaw_out)+page_left_dots;
infill_points[3].Y:=Round((p4.X-grid_top)*scal_out)+page_top_dots;
if (check_limits(infill_points[0],infill_points[1])=True) and (check_limits(infill_points[2],infill_points[3])=True)
then begin
Pen.Width:=1;
Pen.Style:=psSolid;
Pen.Mode:=pmCopy;
Pen.Color:=clWhite; // so no overdrawing of timber outlines.
if pdf_black_white=True
then Brush.Color:=clBlack
else begin
if mapping_colours_print<>-1
then Brush.Color:=printtimber_infill_colour
else Brush.Color:=printbg_single_colour;
end;
case print_timb_infill_style of
0: CONTINUE; // no infill
1: begin // hatched infill
if Brush.Color=clBlack then Brush.Color:=virtual_black_colour; // PDF bug fix -- hatching won't work if black
Brush.Style:=bsBDiagonal; // backward diagonal for the background templates
end;
2: begin // cross-hatched infill
if Brush.Color=clBlack then Brush.Color:=virtual_black_colour;
Brush.Style:=bsDiagCross;
end;
3: if (pdf_black_white=True) or (mapping_colours_print<0) // solid infill
then CONTINUE // 209c now no fill
else Brush.Style:=bsSolid;
4: begin // blank infill.
Brush.Style:=bsSolid;
Brush.Color:=clWhite; // overide.
end;
else CONTINUE;
end;//case
Polygon(infill_points);
end;
end;
if (code=99)
and ( (pad_form.print_timber_numbering_menu_entry.Checked=True) or ((out_factor>0.99) and (pad_form.numbering_fullsize_only_menu_entry.Checked=True)) )
and (print_settings_form.output_timber_numbers_checkbox.Checked=True) // 223d
then begin
p1.X:=intarray_get(list_bgnd_marks[0],i); // x1,y1 in 1/100ths mm
p1.Y:=intarray_get(list_bgnd_marks[1],i);
p2.X:=intarray_get(list_bgnd_marks[2],i); // x2,y2 in 1/100ths mm numbers on output
p2.Y:=intarray_get(list_bgnd_marks[3],i);
if print_settings_form.output_timb_id_prefix_checkbox.Checked=True // 223d
then begin
move_to.X:=Round((p2.Y-grid_left)*scaw_out)+page_left_dots;
move_to.Y:=Round((p2.X-grid_top)*scal_out)+page_top_dots;
end
else begin // 223d ID prefix not wanted, use p1 *screen* positions (as for control template)
move_to.X:=Round((p1.Y-grid_left)*scaw_out)+page_left_dots;
move_to.Y:=Round((p1.X-grid_top)*scal_out)+page_top_dots;
end;
num_str:=extract_tbnumber_str(tbnum_str); // get next timber numbering string from the acummulated string.
if num_str='' then CONTINUE; // no string available??
if pad_form.timber_numbering_on_plain_track_menu_entry.Checked=False // 208a
then begin
s:=Copy(num_str,1,1);
if (s='A') or (s='E') or (s='R') or (s='N') // not wanted on plain track,
then begin
if Copy(num_str,Length(num_str),1)='1' // every 10 sleepers
then num_str:='' // show template ID only
else CONTINUE;
end;
end;
if check_limit(False,False,move_to)=True
then begin
Font.Assign(print_timber_numbers_font);
if pdf_black_white=True // overides..
then Font.Color:=clBlack
else begin
if mapping_colours_print<0 then Font.Color:=printbg_single_colour;
end;
if pad_form.scale_timber_numbering_menu_entry.Checked=True
then begin
fontsize:=Font.Size*out_factor;
if fontsize<4 then CONTINUE; // minimum to be legible.
Font.Size:=Round(fontsize);
end;
Brush.Color:=clWhite;
Brush.Style:=bsClear; // 226d was solid
TextOut(0,0,'');
if print_settings_form.output_timb_id_prefix_checkbox.Checked=True // 223d
then begin
if num_str='' then idtb_str:=idnum_str // 208a template ID only
else idtb_str:=idnum_str+'.'+num_str; // 208a timber number output with template ID
end
else begin // IDs not wanted 223d
if num_str='' then CONTINUE;
idtb_str:=num_str;
end;
idtb_str:=' '+idtb_str+' ';
text_out(move_to.X-(TextWidth(idtb_str) div 2),
move_to.Y-(TextHeight(idtb_str) div 2),
idtb_str);
Font.Assign(print_labels_font); // reset for grid labels
end;
end;//numbering
case code of // switch labels 206b
601..605,701..703: begin
if out_factor<>1.0 then CONTINUE; // on full size prints only
p1.X:=intarray_get(list_bgnd_marks[0],i); // x1,y1 in 1/100ths mm
p1.Y:=intarray_get(list_bgnd_marks[1],i);
move_to.X:=Round((p1.Y-grid_left)*scaw_out)+page_left_dots;
move_to.Y:=Round((p1.X-grid_top)*scal_out)+page_top_dots;
if check_limit(False,False,move_to)=True
then begin
Font.Assign(print_timber_numbers_font);
Font.Style:=[fsBold,fsItalic];
Font.Color:=printguide_colour;
if scale>3 then Font.Size:=Font.Size+1; // a bit bigger above 3mm/ft
Brush.Style:=bsSolid;
Brush.Color:=clWhite;
case code of
601: switch_label_str:='tips';
602: switch_label_str:='set (bend)';
603: switch_label_str:='planing';
604: switch_label_str:='stock gauge';
605: switch_label_str:='joggles';
701: switch_label_str:='intersection FP';
702: switch_label_str:='blunt nose';
703: switch_label_str:='blunt tips';
else switch_label_str:='';
end;//case
text_out(move_to.X-(TextWidth(switch_label_str) div 2), // div 2 allows for rotation of template
move_to.Y-(TextHeight(switch_label_str) div 2),
' '+switch_label_str+' ');
Font.Assign(print_labels_font); // reset for grid labels
end;
end;
end;//case
end;//other codes
end;//next i background mark
// finally overdraw timber infill for shoved colours 226a
if (rail_joints_now=False) and (numbers_now=False) and (Length(now_ti.keep_shoved_timbers)>0)
then begin
for i:=0 to Length(now_ti.keep_shoved_timbers)-1 do begin
with now_ti.keep_shoved_timbers[i] do begin
if shove_data.sv_col_has_been_set=False then CONTINUE; // 227a no modified infill
with shoved_mod_infill do begin
if (shove_data.sv_use_ocol=True) and (black_white=False) {and (impact<1)} // overdraw previous infill on output
then begin
infill_points[0].X:=Round((stored_shoved_corners.p1.Y-grid_left)*scaw_out)+page_left_dots;
infill_points[0].Y:=Round((stored_shoved_corners.p1.X-grid_top)*scal_out)+page_top_dots;
infill_points[1].X:=Round((stored_shoved_corners.p2.Y-grid_left)*scaw_out)+page_left_dots;
infill_points[1].Y:=Round((stored_shoved_corners.p2.X-grid_top)*scal_out)+page_top_dots;
infill_points[2].X:=Round((stored_shoved_corners.p3.Y-grid_left)*scaw_out)+page_left_dots;
infill_points[2].Y:=Round((stored_shoved_corners.p3.X-grid_top)*scal_out)+page_top_dots;
infill_points[3].X:=Round((stored_shoved_corners.p4.Y-grid_left)*scaw_out)+page_left_dots;
infill_points[3].Y:=Round((stored_shoved_corners.p4.X-grid_top)*scal_out)+page_top_dots;
if (check_limits(infill_points[0],infill_points[1])=True) and (check_limits(infill_points[2],infill_points[3])=True)
then begin
Pen.Width:=printtimber_wide;
Pen.Style:=psSolid;
Pen.Mode:=pmCopy;
Pen.Color:=printtimber_colour;
Brush.Color:=shove_data.sv_ocol;
case shove_data.sv_ocol_infill of
0: Brush.Style:=bsSolid;
1: begin Brush.Color:=clWhite; Brush.Style:=bsSolid; end; // blank style
2: Brush.Style:=bsHorizontal;
3: Brush.Style:=bsVertical;
4: Brush.Style:=bsFDiagonal;
5: Brush.Style:=bsBDiagonal;
6: Brush.Style:=bsCross;
7: Brush.Style:=bsDiagCross;
else Brush.Style:=bsSolid;
end;//case
Polygon(Slice(infill_points,4)); // number of points, not index
end;//check limits
end;//use ocol
end;//with
end;//with
end;//next
end;//if any
// 226a end
end;//with now_keep
end;//next n template
end;//with pdf_form.pdf_printer.Canvas
end;
//__________________________________________________________________________________________
procedure pdf_bgnd(grid_left,grid_top:extended); // print background templates.
var
max_list_index:integer;
move_to,line_to:TPoint;
p1,p2: TPoint;
now_keep:Tbgnd_keep;
now_ti:Ttemplate_info;
n,aq,nk:integer;
array_max:integer;
xint,yint:integer;
l_dims_valid:boolean;
w_dims_valid:boolean;
now,rail:integer;
mapping_colour:integer;
using_mapping_colour:boolean;
fixed_diamond_ends:boolean;
gaunt_template:boolean; // 0.93.a ex 0.81
fb_kludge_this:integer; // 0.94.a
this_one_platforms_trackbed:boolean; // 206b
this_one_trackbed_cess_ms:boolean; // 206b
this_one_trackbed_cess_ts:boolean; // 206b
bgnd_y_datum:extended; // 227c
kludge:boolean; //227c
////////////////////////////////////////////////////////////
procedure set_pen_railcolour(rail_edges:boolean); // 0.76.a 3-11-01.
begin
with pdf_form.pdf_printer.Canvas do begin
if pdf_black_white=True
then begin
Pen.Color:=clBlack;
EXIT;
end;
if output_diagram_mode=True // 0.94.a don't use mapping colour for rail edges (used for infill instead).
then begin
if (rail=16) or (rail=20) // 0.93.a platforms
then Pen.Color:=printplat_edge_colour
else Pen.Color:=printbgrail_colour;
EXIT;
end;
// detail-mode ...
if (using_mapping_colour=True) and ( (pdf_form.black_edges_checkbox.Checked=False) or (rail_edges=False) )
then begin
if ((rail=16) or (rail=18) or (rail=20) or (rail=22)) and (detail_mode_form.thickcl_radio.Checked=True) and (detail_mode_form.normal_colours_radio.Checked=True) // 226d
then begin
if (rail=16) or (rail=20)
then Pen.Color:=printplat_edge_colour // 226d platforms with thick centre-lines
else Pen.Color:=printbgrail_colour; // 226d trackbed edges with thick centre-lines
end
else Pen.Color:=mapping_colour;
EXIT;
end;
if (mapping_colours_print<0) and ( (pdf_form.black_edges_checkbox.Checked=False) or (rail_edges=False) ) // 0=normal, 1=rails only, 2=timbers only, 3=rails and timber outlines, 4:=use the PAD colour instead, -1=single colour.
then begin
Pen.Color:=printbg_single_colour; // single colour for all of background templates.
EXIT;
end;
// normal output...
if (rail=16) or (rail=20) // 0.93.a platforms
then Pen.Color:=printplat_edge_colour
else Pen.Color:=printbgrail_colour;
end;//with
end;
///////////////////////////////////////////////////////////////
function pbg_get_w_dots(q,n:integer):integer;
var
yint:integer;
begin
yint:=intarray_get(now_keep.list_bgnd_rails[q,1],n);
RESULT:=Round((yint-grid_left)*scaw_out)+page_left_dots;
w_dims_valid:=check_draw_dim_w(RESULT);
end;
////////////////////////////
function pbg_get_l_dots(q,n:integer):integer;
var
xint:integer;
begin
xint:=intarray_get(now_keep.list_bgnd_rails[q,0],n);
RESULT:=Round((xint-grid_top)*scal_out)+page_top_dots;
l_dims_valid:=check_draw_dim_l(RESULT);
end;
////////////////////////////////////////////////
procedure pbg_outline_railedge(aq,blanking_colour:integer; blank_it:boolean);
var
nk:integer;
begin
with now_keep do begin
array_max:=intarray_max(list_bgnd_rails[aq,0]);
if array_max=0 then EXIT; // empty rail.
xint:=intarray_get(list_bgnd_rails[aq,0],0);
yint:=intarray_get(list_bgnd_rails[aq,1],0);
move_to.X:=Round((yint-grid_left)*scaw_out)+page_left_dots;
move_to.Y:=Round((xint-grid_top)*scal_out)+page_top_dots;
with pdf_form.pdf_printer.Canvas do begin
if blank_it=True
then Pen.Color:=blanking_colour
else set_pen_railcolour(True);
for nk:=1 to array_max do begin
xint:=intarray_get(list_bgnd_rails[aq,0],nk);
yint:=intarray_get(list_bgnd_rails[aq,1],nk);
line_to.X:=Round((yint-grid_left)*scaw_out)+page_left_dots;
line_to.Y:=Round((xint-grid_top)*scal_out)+page_top_dots;
if check_limits(move_to, line_to)=True
then begin
MoveTo(move_to.X, move_to.Y);
LineTo(line_to.X, line_to.Y);
end;
move_to:=line_to;
end;//next nk
end;//with Canvas
end;//with bgnd template
end;
////////////////////////////
procedure pbg_draw_fill_rail(outer_add:integer); // draw a complete filled rail.
const
dots_max_c=xy_pts_c*2;
var
dots:array[0..dots_max_c] of TPoint; // array of points for filled polygon mode.
// (xy_pts_c=3000;)
// 3000 points for each side of rail. if incx is 18" scale (SQRT 9ft scale in 4mm = SQRT(36) =6 mm),
// template max is 4500' scale length.
// ( = 18000 mm or 59ft approx in 4 mm scale).
// ( = 66 A4 sheets long if straight turnout - but normally less for curved turnout).
// N.B. huge standard Pascal array is used instead of our own dynamic integer arrays,
// because needed for the Polygon function.
// total memory = 6000*8 bytes = 48kb.
now, start, now_max:integer;
edge_started:boolean;
dots_index:integer;
x_dots,y_dots:integer;
aq:integer;
mid_dots_index:integer;
edge_colour, blanking_colour:integer;
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
procedure pbg_modify_rail_end(start_index,stop_index,edge,blank:integer);
var
saved_pen_width:integer; // 206b
begin
if (start_index>=0) and (start_index<=dots_index) and (stop_index>=0) and (stop_index<=dots_index)
then begin
move_to:=dots[start_index];
line_to:=dots[stop_index];
if check_limits(move_to, line_to)=True
then begin
with pdf_form.pdf_printer.Canvas do begin
saved_pen_width:=Pen.Width; // 206b
if Brush.Style<>bsSolid then Pen.Width:=saved_pen_width+3; // 206b PDF bug, needs a wider line to ensure full blanking if hatched fill
Pen.Color:=blank; // first blank across..
MoveTo(move_to.X, move_to.Y);
LineTo(line_to.X, line_to.Y);
Pen.Width:=saved_pen_width; // 206b restore original width
Pen.Color:=edge; // then restore the corner points..
MoveTo(move_to.X, move_to.Y);
LineTo(move_to.X, move_to.Y);
MoveTo(line_to.X, line_to.Y);
LineTo(line_to.X, line_to.Y);
end;//with
end;
end;
end;
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
begin
aq:=rail; // gauge-faces.
with now_keep do begin
if (intarray_max(list_bgnd_rails[aq,0])=0) or (intarray_max(list_bgnd_rails[aq+outer_add,0])=0) // data not for both edges?
then begin
if intarray_max(list_bgnd_rails[aq,0])<>0 then pbg_outline_railedge(aq,0,False);
if intarray_max(list_bgnd_rails[aq+outer_add,0])<>0 then pbg_outline_railedge(aq+outer_add,0,False);
EXIT;
end;
now_max:=intarray_max(list_bgnd_rails[aq,0]);
if gaunt_template=False
then begin
case aq of
1: begin
{start:=list_mark_straight; // out - bug fix 0.73 11-8-01. }
start:=planing_end_aq1; // start from end of planing - no infill in planing.
if (start<0) or (start>now_max) then EXIT; // ???
end;
2: begin // ditto
{start:=list_mark_curve; // out - bug fix 0.73 11-8-01. }
start:=planing_end_aq2; // start from end of planing - no infill in planing.
if (start<0) or (start>now_max) then EXIT; // ???
end;
else start:=0; // whole list.
end;//case
end
else start:=0; // gaunt template, no planing. 0.81 09-Jul-2005
dots_index:=0-1; // first increment is to zero.
edge_started:=False;
for now:=start to now_max do begin
x_dots:=pbg_get_w_dots(aq,now);
y_dots:=pbg_get_l_dots(aq,now);
if (w_dims_valid=True) and (l_dims_valid=True)
then begin
edge_started:=True;
Inc(dots_index);
if dots_index>dots_max_c then dots_index:=dots_max_c;
dots[dots_index].X:=x_dots;
dots[dots_index].Y:=y_dots;
end
else if edge_started=True then BREAK; // don't resume adding dots to this edge once started and then gone out of limits.
end;//next now
mid_dots_index:=dots_index;
aq:=rail+outer_add; // outer-edges.
now_max:=intarray_max(list_bgnd_rails[aq,0]);
edge_started:=False;
for now:=now_max downto 0 do begin
x_dots:=pbg_get_w_dots(aq,now);
y_dots:=pbg_get_l_dots(aq,now);
if (w_dims_valid=True) and (l_dims_valid=True)
then begin
edge_started:=True;
Inc(dots_index);
if dots_index>dots_max_c then dots_index:=dots_max_c;
dots[dots_index].X:=x_dots;
dots[dots_index].Y:=y_dots;
end
else if edge_started=True then BREAK; // don't resume adding dots to this edge once started and then gone out of limits.
end;//next now
with pdf_form.pdf_printer.Canvas do begin
set_pen_railcolour(True);
if (rail=16) or (rail=20) // 0.93.a platforms
then begin
if ( (using_mapping_colour=True) and (Pen.Color=mapping_colour) ) or ( (mapping_colours_print<0) and (Pen.Color=printbg_single_colour) ) // 206b
then Brush.Color:=Pen.Color
else Brush.Color:=printplat_infill_colour;
case print_platform_infill_style of
0: begin Brush.Style:=bsClear; TextOut(0,0,''); end;
1: Brush.Style:=bsFDiagonal; // hatched. forward diagonal (backward diagonal on bgnd template timbers).
2: Brush.Style:=bsDiagCross;
3: if mapping_colours_print<0 // solid option.
then Brush.Style:=bsFDiagonal // single colour.
else Brush.Style:=bsSolid;
else begin // 4 = blank.
Brush.Style:=bsSolid;
Brush.Color:=clWhite; // overide.
end;
end;//case
end
else begin
if ((this_one_trackbed_cess_ts=True) and (rail=18)) // 215a
or ((this_one_trackbed_cess_ms=True) and (rail=22)) // 215a
then begin
if ( (using_mapping_colour=True) and (Pen.Color=mapping_colour) ) or ( (mapping_colours_print<0) and (Pen.Color=printbg_single_colour) )
then Brush.Color:=Pen.Color
else Brush.Color:=sb_track_bgnd_colour; // cess use same colour as track background
Brush.Style:=bsBDiagonal;
end
else begin // normal rails...
if ( (using_mapping_colour=True) and (Pen.Color=mapping_colour) ) or ( (mapping_colours_print<0) and (Pen.Color=printbg_single_colour) )
then Brush.Color:=calc_intensity(clSilver) // 214b - was clGray
else begin
if fb_kludge_this>0 then Brush.Color:=printrail_infill_colour_cu // 0.94.a
else Brush.Color:=printrail_infill_colour_bg;
end;
case rail_infill_i of
1: Brush.Style:=bsBDiagonal; // hatched
2: Brush.Style:=bsSolid; // solid
3: Brush.Style:=bsDiagCross; // cross_hatched
4: begin // blank
Brush.Style:=bsSolid;
Brush.Color:=clWhite; // overide
end;
else Brush.Style:=bsSolid; // solid
end;//case
end;
end;
if pdf_black_white=True
then begin
Brush.Style:=bsSolid; // solid infill white.
Brush.Color:=clWhite; // overide
end;
if dots_index>2
then begin
Polygon(Slice(dots,dots_index+1)); // +1, number of points, not index. must have 4 points.
edge_colour:=Pen.Color; // existing rail edges.
if Brush.Style=bsSolid then blanking_colour:=Brush.Color // infill colour.
else blanking_colour:=clWhite;
// remove polygon line across end of planing (not for fixed-diamond)..
// (for gaunt template this removes the polygon line across the rail end)
if (fixed_diamond_ends=False) and ((rail=1) or (rail=2)) then pbg_modify_rail_end(0,dots_index,edge_colour,blanking_colour);
// remove polygon lines across stock rail ends...
// and trackbed ends 206b
if (rail=0) or (rail=3) or (rail=18) or (rail=22) // 18,22 added 206b
then begin
pbg_modify_rail_end(0,dots_index,edge_colour,blanking_colour); // toe or approach end.
pbg_modify_rail_end(mid_dots_index,mid_dots_index+1,edge_colour,blanking_colour); // exit end.
end;
// 0.93.a blank platform edges ...
with Ttemplate(keeps_list.Objects[n]).template_info.keep_dims.box_dims1.platform_trackbed_info do begin
if adjacent_edges_keep=True // platforms
then begin
// 0.93.a blank platform rear edges ...
if (rail=16) and (draw_ts_platform_keep=True) and (draw_ts_platform_rear_edge_keep=False) // 0.93.a TS platform start
then pbg_outline_railedge(16,blanking_colour,True); // blank rear edge
if (rail=20) and (draw_ms_platform_keep=True) and (draw_ms_platform_rear_edge_keep=False) // 0.93.a TS platform start
then pbg_outline_railedge(20,blanking_colour,True); // blank rear edge
// 0.93.a blank platform ends ...
if (rail=16) and (draw_ts_platform_keep=True) and (draw_ts_platform_start_edge_keep=False) // 0.93.a TS platform start
then pbg_modify_rail_end(0,dots_index,edge_colour,blanking_colour);
if (rail=16) and (draw_ts_platform_keep=True) and (draw_ts_platform_end_edge_keep=False) // 0.93.a TS platform end
then pbg_modify_rail_end(mid_dots_index,mid_dots_index+1,edge_colour,blanking_colour);
if (rail=20) and (draw_ms_platform_keep=True) and (draw_ms_platform_start_edge_keep=False) // 0.93.a MS platform start
then pbg_modify_rail_end(0,dots_index,edge_colour,blanking_colour);
if (rail=20) and (draw_ms_platform_keep=True) and (draw_ms_platform_end_edge_keep=False) // 0.93.a MS platform end
then pbg_modify_rail_end(mid_dots_index,mid_dots_index+1,edge_colour,blanking_colour);
end;
end;//with
if (rail=26) or (rail=28)
then begin
pbg_modify_rail_end(0,dots_index,edge_colour,blanking_colour); // centre of K-crossing check rails.
end;
end;
end;//with Canvas
end;//with background template
end;
////////////////////////////////////////////////////////////////////////
procedure pbg_draw_fill_vee; // do complete vee in one go ...
const
dots_max_c=xy_pts_c*2;
var
dots:array[0..dots_max_c] of TPoint; // array of points for filled polygon mode.
// (xy_pts_c=3000;)
// 3000 points for each side of rail. if incx is 18" scale (SQRT 9ft scale in 4mm = SQRT(36) =6 mm),
// template max is 4500' scale length.
// ( = 18000 mm or 59ft approx in 4 mm scale).
// ( = 66 A4 sheets long if straight turnout - but normally less for curved turnout).
// N.B. huge standard Pascal array is used instead of our own dynamic integer arrays,
// because needed for the Polygon function.
// total memory = 6000*8 bytes = 48kb.
now:integer;
edge_started:boolean;
dots_index:integer;
x_dots,y_dots:integer;
aq:integer;
point_mid_dots_index, splice_mid_dots_index:integer;
edge_colour, blanking_colour:integer;
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
procedure pbg_modify_vee_end(start_index,stop_index,edge,blank:integer);
begin
if (start_index>=0) and (start_index<=dots_index) and (stop_index>=0) and (stop_index<=dots_index)
then begin
move_to:=dots[start_index];
line_to:=dots[stop_index];
if check_limits(move_to, line_to)=True
then begin
with pdf_form.pdf_printer.Canvas do begin
Pen.Color:=blank; // first blank across..
MoveTo(move_to.X, move_to.Y);
LineTo(line_to.X, line_to.Y);
Pen.Color:=edge; // then restore the corner points..
MoveTo(move_to.X, move_to.Y);
LineTo(move_to.X, move_to.Y);
MoveTo(line_to.X, line_to.Y);
LineTo(line_to.X, line_to.Y);
end;//with
end;
end;
end;
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
begin
with now_keep do begin
if (intarray_max(list_bgnd_rails[4,0])=0)
or (intarray_max(list_bgnd_rails[5,0])=0)
or (intarray_max(list_bgnd_rails[12,0])=0)
or (intarray_max(list_bgnd_rails[13,0])=0) // not enough data for filled vee.
then begin
if intarray_max(list_bgnd_rails[4,0])<>0 then pbg_outline_railedge(4,0,False); // draw outline vee...
if intarray_max(list_bgnd_rails[5,0])<>0 then pbg_outline_railedge(5,0,False);
if intarray_max(list_bgnd_rails[12,0])<>0 then pbg_outline_railedge(12,0,False);
if intarray_max(list_bgnd_rails[13,0])<>0 then pbg_outline_railedge(13,0,False);
end
else begin // polygon mode...
dots_index:=0-1; // first increment is to zero.
aq:=4;
edge_started:=False;
for now:=0 to intarray_max(list_bgnd_rails[aq,0]) do begin // vee main-side, gauge_face, start from the tip.
x_dots:=pbg_get_w_dots(aq,now);
y_dots:=pbg_get_l_dots(aq,now);
if (w_dims_valid=True) and (l_dims_valid=True)
then begin
edge_started:=True;
Inc(dots_index);
if dots_index>dots_max_c then dots_index:=dots_max_c;
dots[dots_index].X:=x_dots;
dots[dots_index].Y:=y_dots;
end
else if edge_started=True then BREAK; // don't resume adding dots to this edge once started and then gone out of limits.
end;//next now
point_mid_dots_index:=dots_index;
aq:=12;
edge_started:=False;
for now:=intarray_max(list_bgnd_rails[aq,0]) downto 0 do begin // back along outer-edge.
x_dots:=pbg_get_w_dots(aq,now);
y_dots:=pbg_get_l_dots(aq,now);
if (w_dims_valid=True) and (l_dims_valid=True)
then begin
edge_started:=True;
Inc(dots_index);
if dots_index>dots_max_c then dots_index:=dots_max_c;
dots[dots_index].X:=x_dots;
dots[dots_index].Y:=y_dots;
end
else if edge_started=True then BREAK; // don't resume adding dots to this edge once started and then gone out of limits.
end;//next now
aq:=13;
edge_started:=False;
for now:=0 to intarray_max(list_bgnd_rails[aq,0]) do begin // and then turnout side outer edge.
x_dots:=pbg_get_w_dots(aq,now);
y_dots:=pbg_get_l_dots(aq,now);
if (w_dims_valid=True) and (l_dims_valid=True)
then begin
edge_started:=True;
Inc(dots_index);
if dots_index>dots_max_c then dots_index:=dots_max_c;
dots[dots_index].X:=x_dots;
dots[dots_index].Y:=y_dots;
end
else if edge_started=True then BREAK; // don't resume adding dots to this edge once started and then gone out of limits.
end;//next now
splice_mid_dots_index:=dots_index;
aq:=5;
edge_started:=False;
for now:=intarray_max(list_bgnd_rails[aq,0]) downto 0 do begin // and back along the gauge face to the tip.
x_dots:=pbg_get_w_dots(aq,now);
y_dots:=pbg_get_l_dots(aq,now);
if (w_dims_valid=True) and (l_dims_valid=True)
then begin
edge_started:=True;
Inc(dots_index);
if dots_index>dots_max_c then dots_index:=dots_max_c;
dots[dots_index].X:=x_dots;
dots[dots_index].Y:=y_dots;
end
else if edge_started=True then BREAK; // don't resume adding dots to this edge once started and then gone out of limits.
end;//next now
with pdf_form.pdf_printer.Canvas do begin
set_pen_railcolour(True);
if ( (using_mapping_colour=True) and (Pen.Color=mapping_colour) ) or ( (mapping_colours_print<0) and (Pen.Color=printbg_single_colour) )
then Brush.Color:=calc_intensity(clSilver) // 214b - was clGray
else begin
if fb_kludge_this>0 then Brush.Color:=printrail_infill_colour_cu
else Brush.Color:=printrail_infill_colour_bg;
end;
case rail_infill_i of
1: Brush.Style:=bsBDiagonal; // hatched
2: Brush.Style:=bsSolid; // solid
3: Brush.Style:=bsDiagCross; // cross_hatched
4: begin // blank
Brush.Style:=bsSolid;
Brush.Color:=clWhite; // overide
end;
else Brush.Style:=bsSolid; // solid
end;//case
if pdf_black_white=True
then begin
Brush.Style:=bsSolid; // solid infill white.
Brush.Color:=clWhite; // overide
end;
if dots_index>4
then begin
Polygon(Slice(dots,dots_index+1)); // +1, number of points, not index. must have at least 5 points.
edge_colour:=Pen.Color; // existing rail edges.
if Brush.Style=bsSolid then blanking_colour:=Brush.Color // infill colour.
else blanking_colour:=clWhite;
// remove polygon lines across vee rail ends...
pbg_modify_vee_end(point_mid_dots_index,point_mid_dots_index+1,edge_colour,blanking_colour); // point rail end.
pbg_modify_vee_end(splice_mid_dots_index,splice_mid_dots_index+1,edge_colour,blanking_colour); // splice rail end.
end;
end;//with Canvas
end;//polygon mode
end;//with background template
end;
////////////////////////////////////////////////////////////////////////
procedure pbg_mark_end(aq1, aq1end, aq2, aq2end:integer); // print the background rail end mark.
begin
with now_keep do begin
if (bgnd_endmarks_yn[aq1,aq1end]=True) and (bgnd_endmarks_yn[aq2,aq2end]=True)
then begin
p1:=bgnd_endmarks[aq1,aq1end];
p2:=bgnd_endmarks[aq2,aq2end];
with pdf_form.pdf_printer.Canvas do begin
set_pen_railcolour(True);
move_to.X:=Round((p1.Y-grid_left)*scaw_out)+page_left_dots;
move_to.Y:=Round((p1.X-grid_top)*scal_out)+page_top_dots;
line_to.X:=Round((p2.Y-grid_left)*scaw_out)+page_left_dots;
line_to.Y:=Round((p2.X-grid_top)*scal_out)+page_top_dots;
if check_limits(move_to, line_to)=True then begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
end;//with
end;
end;//with
end;
////////////////////////////////////////////////////////////
procedure pbg_outline_railends; // draw in the rail ends using existing pen settings...
begin
pbg_mark_end(1,1,9,1); // main rail wing rail finish.
pbg_mark_end(2,1,10,1); // turnout rail wing rail finish.
pbg_mark_end(6,0,14,0); // main side check rail start.
pbg_mark_end(6,1,14,1); // main side check rail finish.
pbg_mark_end(7,0,15,0); // turnout side check rail start.
pbg_mark_end(7,1,15,1); // turnout side check rail finish.
pbg_mark_end(4,0,5,0); // blunt nose.
if fixed_diamond_ends=True
then begin
pbg_mark_end(1,0,9,0); // planed faced of point rails for a fixed-diamond.
pbg_mark_end(2,0,10,0);
pbg_mark_end(26,1,27,1); // MS K-crossing check rails.
pbg_mark_end(28,1,29,1); // DS K-crossing check rails.
end;
end;
////////////////////////////////////////////////////////////////
procedure pbg_draw_diagram_mode; // 0.91.d draw a complete template in diagrammatic mode
const
dots_max_c=xy_pts_c*2;
var
dots:array[0..dots_max_c] of TPoint; // array of points for filled polygon mode.
// (xy_pts_c=3000;)
// 3000 points for each side of rail. if incx is 18" scale (SQRT 9ft scale in 4mm = SQRT(36) =6 mm),
// template max is 4500' scale length.
// ( = 18000 mm or 59ft approx in 4 mm scale).
// ( = 66 A4 sheets long if straight turnout - but normally less for curved turnout).
// N.B. huge standard Pascal array is used instead of our own dynamic integer arrays,
// because needed for the Polygon function.
// total memory = 6000*8 bytes = 48kb.
now,now_max:integer;
edge_started:boolean;
dots_index:integer;
x_dots,y_dots:integer;
ms_mid_dots_index,ts_mid_dots_index:integer;
edge_colour, blanking_colour:integer;
no_vee:boolean;
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
procedure pbg_modify_boundary(start_index,stop_index,edge,blank:integer);
begin
if (start_index>=0) and (start_index<=dots_index) and (stop_index>=0) and (stop_index<=dots_index)
then begin
move_to:=dots[start_index];
line_to:=dots[stop_index];
if check_limits(move_to, line_to)=True
then begin
with pdf_form.pdf_printer.Canvas do begin
Pen.Color:=blank; // first blank across..
MoveTo(move_to.X, move_to.Y);
LineTo(line_to.X, line_to.Y);
Pen.Color:=edge; // then restore the corner points..
MoveTo(move_to.X, move_to.Y);
LineTo(move_to.X, move_to.Y);
MoveTo(line_to.X, line_to.Y);
LineTo(line_to.X, line_to.Y);
end;//with
end;
end;
end;
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
begin
with now_keep do begin
if (intarray_max(list_bgnd_rails[0,0])=0) // no data for straight stock rail
or (intarray_max(list_bgnd_rails[3,0])=0) // no data for curved stock rail
then begin
diagram_partials_omitted:=True; // 226c
EXIT;
end;
if (intarray_max(list_bgnd_rails[4,0])=0) or (intarray_max(list_bgnd_rails[5,0])=0) // no data for vee rails
then no_vee:=True
else no_vee:=False;
dots_index:=0-1; // first increment is to zero.
now_max:=intarray_max(list_bgnd_rails[0,0]); // straight stock rail
edge_started:=False;
for now:=0 to now_max do begin
x_dots:=pbg_get_w_dots(0,now);
y_dots:=pbg_get_l_dots(0,now);
if (w_dims_valid=True) and (l_dims_valid=True)
then begin
edge_started:=True;
Inc(dots_index);
if dots_index>dots_max_c then dots_index:=dots_max_c;
dots[dots_index].X:=x_dots;
dots[dots_index].Y:=y_dots;
end
else if edge_started=True then BREAK; // don't resume adding dots to this edge once started and then gone out of limits.
end;//next now
ms_mid_dots_index:=dots_index;
if no_vee=False
then begin
now_max:=intarray_max(list_bgnd_rails[4,0]); // point rail
edge_started:=False;
for now:=now_max downto 0 do begin
x_dots:=pbg_get_w_dots(4,now);
y_dots:=pbg_get_l_dots(4,now);
if (w_dims_valid=True) and (l_dims_valid=True)
then begin
edge_started:=True;
Inc(dots_index);
if dots_index>dots_max_c then dots_index:=dots_max_c;
dots[dots_index].X:=x_dots;
dots[dots_index].Y:=y_dots;
end
else if edge_started=True then BREAK; // don't resume adding dots to this edge once started and then gone out of limits.
end;//next now
now_max:=intarray_max(list_bgnd_rails[5,0]); // splice rail
edge_started:=False;
for now:=0 to now_max do begin
x_dots:=pbg_get_w_dots(5,now);
y_dots:=pbg_get_l_dots(5,now);
if (w_dims_valid=True) and (l_dims_valid=True)
then begin
edge_started:=True;
Inc(dots_index);
if dots_index>dots_max_c then dots_index:=dots_max_c;
dots[dots_index].X:=x_dots;
dots[dots_index].Y:=y_dots;
end
else if edge_started=True then BREAK; // don't resume adding dots to this edge once started and then gone out of limits.
end;//next now
end;//if vee
ts_mid_dots_index:=dots_index;
now_max:=intarray_max(list_bgnd_rails[3,0]); // curved stock rail
edge_started:=False;
for now:=now_max downto 0 do begin
x_dots:=pbg_get_w_dots(3,now);
y_dots:=pbg_get_l_dots(3,now);
if (w_dims_valid=True) and (l_dims_valid=True)
then begin
edge_started:=True;
Inc(dots_index);
if dots_index>dots_max_c then dots_index:=dots_max_c;
dots[dots_index].X:=x_dots;
dots[dots_index].Y:=y_dots;
end
else if edge_started=True then BREAK; // don't resume adding dots to this edge once started and then gone out of limits.
end;//next now
with pdf_form.pdf_printer.Canvas do begin
set_pen_railcolour(True);
Pen.Width:=printrail_wide;
if Pen.Width<1 then Pen.Width:=1;
if using_mapping_colour=True
then Brush.Color:=mapping_colour
else Brush.Color:=sb_diagram_colour; // 209c was printrail_infill_colour_bg;
case rail_infill_i of
1: Brush.Style:=bsBDiagonal; // hatched
2: Brush.Style:=bsSolid; // solid
3: Brush.Style:=bsDiagCross; // cross_hatched
4: begin // blank
Brush.Style:=bsSolid;
Brush.Color:=clWhite; // overide
end;
else Brush.Style:=bsSolid; // solid
end;//case
if pdf_black_white=True
then begin
Brush.Style:=bsSolid; // solid infill white.
Brush.Color:=clWhite; // overide
end;
if dots_index>2
then begin
Polygon(Slice(dots,dots_index+1)); // +1, number of points, not index. must have 4 points.
// blank out template boundaries...
if output_include_boundaries=False
then begin
edge_colour:=Pen.Color; // existing rail edges.
if Brush.Style=bsSolid then blanking_colour:=Brush.Color // infill colour.
else blanking_colour:=clWhite;
pbg_modify_boundary(0,dots_index,edge_colour,blanking_colour); // toe or approach end.
pbg_modify_boundary(ms_mid_dots_index,ms_mid_dots_index+1,edge_colour,blanking_colour); // exit end (turnout) or Ctrl-1 end (plain track).
if no_vee=False then pbg_modify_boundary(ts_mid_dots_index,ts_mid_dots_index+1,edge_colour,blanking_colour); // turnout road end.
end;
end;
if output_show_points_mark=True // mark position of points
then begin
if (Ttemplate(keeps_list.Objects[n]).template_info.keep_dims.box_dims1.turnout_info1.plain_track_flag=False) // not for plain track
and (Ttemplate(keeps_list.Objects[n]).template_info.keep_dims.turnout_info2.semi_diamond_flag=False) // not for half-diamond
and (Ttemplate(keeps_list.Objects[n]).template_info.keep_dims.turnout_info2.gaunt_flag=False) // not for gaunt turnout
and (intarray_max(list_bgnd_rails[1,0])<>0) // data for straight switch rail
and (intarray_max(list_bgnd_rails[2,0])<>0) // data for curved stock rail
then begin
if Brush.Color=clWhite
then Pen.Color:=clBlack
else Pen.Color:=clWhite; // white points mark
x_dots:=pbg_get_w_dots(1,0); // ms toe.
y_dots:=pbg_get_l_dots(1,0);
if (w_dims_valid=True) and (l_dims_valid=True)
then begin
MoveTo(x_dots,y_dots);
x_dots:=pbg_get_w_dots(2,0); // ts toe.
y_dots:=pbg_get_l_dots(2,0);
if (w_dims_valid=True) and (l_dims_valid=True)
then LineTo(x_dots,y_dots);
end;
end;
end;//mark points
end;//with Canvas
end;//with background template
end;
////////////////////////////////////////////////////////////////////////
begin // print background templates...
max_list_index:=keeps_list.Count-1;
if max_list_index<0 then EXIT; // no templates in box.
if output_diagram_mode=False
then begin
pdf_bgnd_marks(grid_left,grid_top,max_list_index,False,False); // 0.93.a // first print all the background timbering and marks except rail joints and timber numbers.
if pad_form.timber_numbering_over_platforms_menu_entry.Checked=False
then pdf_bgnd_marks(grid_left,grid_top,max_list_index,False,True); // 226d and again to do the timber numbers now if wanted under platforms
end;
with pdf_form.pdf_printer.Canvas do begin
Pen.Mode:=pmCopy; // default
// now print bgnd track centre-lines and turnout rails...
for n:=0 to max_list_index do begin
if Ttemplate(keeps_list.Objects[n]).bg_copied=False then CONTINUE; // no data, not on background.
if (Ttemplate(keeps_list.Objects[n]).group_selected=False) and (print_group_only_flag=True) then CONTINUE; // not in group. 0.78.b 10-12-02.
if (Ttemplate(keeps_list.Objects[n]).template_info.keep_dims.box_dims1.fb_kludge_template_code>0) // 209c
and (print_settings_form.output_fb_foot_lines_checkbox.Checked=False)
then CONTINUE; // foot lines not wanted.
this_one_platforms_trackbed:=Ttemplate(keeps_list.Objects[n]).template_info.keep_dims.box_dims1.platform_trackbed_info.adjacent_edges_keep; // True = platforms and trackbed edges 206b
this_one_trackbed_cess_ms:=Ttemplate(keeps_list.Objects[n]).template_info.keep_dims.box_dims1.platform_trackbed_info.draw_ms_trackbed_cess_edge_keep; // True = cess width instead of trackbed cutting line 215a
this_one_trackbed_cess_ts:=Ttemplate(keeps_list.Objects[n]).template_info.keep_dims.box_dims1.platform_trackbed_info.draw_ts_trackbed_cess_edge_keep; // True = cess width instead of trackbed cutting line 215a
now_ti:=Ttemplate(keeps_list.Objects[n]).template_info; // 227a
// but first add dropper symbols under rails..
bgnd_y_datum:=now_ti.keep_dims.box_dims1.transform_info.datum_y*100;
kludge:=(now_ti.keep_dims.box_dims1.fb_kludge_template_code>0); // no symbols for fb_kludge templates
if kludge=False
then pdf_draw_symbols(pdf_form.pdf_printer.Canvas,now_ti.keep_symbols,0,1,grid_left,grid_top,bgnd_y_datum); // 227a draw the 0=droppers over timbers 1=polygon only
// now rails and track centre-lines...
now_keep:=now_ti.bgnd_keep; // next background keep
with now_keep do begin
// mapping_colours_print: 0=normal, 1=rails only, 2=timbers only, 3=rails and timber outlines, 4:=use the PAD colour instead, -1=single colour.
using_mapping_colour:=False; // default init.
with Ttemplate(keeps_list.Objects[n]).template_info.keep_dims do begin
if box_dims1.bgnd_code_077<>1 then CONTINUE; // 0.77.b BUG???
with turnout_info2 do begin
fixed_diamond_ends:=(semi_diamond_flag=True) and (diamond_fixed_flag=True); // need end marks on fixed diamond point rails.
gaunt_template:=gaunt_flag; // 0.93.a ex 0.81
end;//with
if (box_dims1.use_print_mapping_colour=True)
and ( (mapping_colours_print=1) or (mapping_colours_print=3) )
and (pdf_black_white=False)
and (pdf_grey_shade=False)
then begin
mapping_colour:=calc_intensity(box_dims1.print_mapping_colour);
using_mapping_colour:=True;
end;
if (box_dims1.use_pad_marker_colour=True)
and (mapping_colours_print=4) // use pad settings instead
and (pdf_black_white=False)
and (pdf_grey_shade=False)
then begin
mapping_colour:=calc_intensity(box_dims1.pad_marker_colour);
using_mapping_colour:=True;
end;
fb_kludge_this:=box_dims1.fb_kludge_template_code; // 0.94.a
if fb_kludge_this=0 // no track centre-lines or diagram mode for kludge templates 212a
then begin
if output_diagram_mode=True then pbg_draw_diagram_mode; // first draw template in diagrammatic mode.
if ((print_settings_form.output_centrelines_checkbox.Checked=True) and (output_diagram_mode=False) and (box_dims1.align_info.dummy_template_flag=False))
or ((print_settings_form.output_bgnd_shapes_checkbox.Checked=True) and (box_dims1.align_info.dummy_template_flag=True)) // 212a dummy templates not part of track plan
then begin
Brush.Color:=clWhite; // 0.93.a gaps in dotted lines.
Brush.Style:=bsClear;
TextOut(0,0,'');
Pen.Mode:=pmCopy;
if box_dims1.align_info.dummy_template_flag=True // 212a dummy template as bgnd shapes
then begin
Pen.Style:=psSolid;
Pen.Color:=printshape_colour;
Pen.Width:=printshape_wide;
end
else begin
set_pen_railcolour(False);
Pen.Width:=printcl_wide;
if Pen.Width<1 then Pen.Width:=1;
Pen.Style:=psSolid;
end;
for aq:=24 to 25 do begin // track centre-lines.
array_max:=intarray_max(list_bgnd_rails[aq,0]);
if array_max=0 then CONTINUE; // empty rail.
xint:=intarray_get(list_bgnd_rails[aq,0],0);
yint:=intarray_get(list_bgnd_rails[aq,1],0);
move_to.X:=Round((yint-grid_left)*scaw_out)+page_left_dots;
move_to.Y:=Round((xint-grid_top)*scal_out)+page_top_dots;
for nk:=1 to array_max do begin
xint:=intarray_get(list_bgnd_rails[aq,0],nk);
yint:=intarray_get(list_bgnd_rails[aq,1],nk);
line_to.X:=Round((yint-grid_left)*scaw_out)+page_left_dots;
line_to.Y:=Round((xint-grid_top)*scal_out)+page_top_dots;
if check_limits(move_to, line_to)=True then begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
move_to:=line_to;
end;//next nk
end;//next aq
end;//if track-centres
end;//if not kludge
end;//with template
if (print_settings_form.output_rails_checkbox.Checked=True) or ( (detail_mode_form.thickcl_radio.Checked=True) and (detail_mode_form.no_platforms_radio.Checked=False) ) // 226d
then begin
Pen.Mode:=pmCopy;
Pen.Style:=psSolid;
Pen.Width:=printrail_wide;
if Pen.Width<1 then Pen.Width:=1;
if (rail_infill_i=0) // out for pdf, was or ((scale*out_factor)<0.75) // less than 18.75% for 4mm scale (control template) (10.71% for 7mm).
and (output_diagram_mode=False)
then begin // outline (pen) mode ...
// n.b. this mode does not automatically close the rail-ends.
// no infill for platforms
set_pen_railcolour(True);
for aq:=0 to 23 do begin // 24, 25 centre-lines already done.
if (this_one_platforms_trackbed=False) and (aq>15) then CONTINUE; // no adjacent tracks in output // 206b
if (detail_mode_form.thickcl_radio.Checked=True) and (aq<16) and (aq>23) then CONTINUE; // 226c add only platforms if centre-lines only
case aq of // 223d
16,17,20,21: if print_settings_form.output_platforms_checkbox.Checked=False then CONTINUE; // platforms not wanted
18,19,22,23: if print_settings_form.output_trackbed_edges_checkbox.Checked=False then CONTINUE; // trackbed edges not wanted
end;//case
pbg_outline_railedge(aq,0,False);
end;
for aq:=26 to aq_max_c do pbg_outline_railedge(aq,0,False); // K-crossing check rails.
pbg_outline_railends; // next, draw in the rail ends using same pen settings...
end
else begin // infill (polygon) mode ...
// do blades first - neater result.
if detail_mode_form.thickcl_radio.Checked=False // 226c
then begin
if output_diagram_mode=False // detail mode only
then begin
for rail:=1 to 3 do pbg_draw_fill_rail(8); // closure rails and curved stock rail.
rail:=0; // straight stock rail.
pbg_draw_fill_rail(8);
for rail:=6 to 7 do pbg_draw_fill_rail(8); // check rails
end;
end; // 226c
if this_one_platforms_trackbed=True // no adjacent tracks in output 206b
then begin
rail:=16; // detail mode or diagram mode (for platforms/trackbed)
repeat
case rail of // 223d
16,20: if print_settings_form.output_platforms_checkbox.Checked=True then pbg_draw_fill_rail(1); // platforms
18,22: if print_settings_form.output_trackbed_edges_checkbox.Checked=True then pbg_draw_fill_rail(1); // trackbed edges
end;//case
rail:=rail+2;
if (output_diagram_mode=True) and (output_include_trackbed_edges=False) and ((rail=18) or (rail=22)) then rail:=rail+2; // 206b no trackbed/cess in diagram mode
until rail>22;
end;
if detail_mode_form.thickcl_radio.Checked=False // 226c
then begin
if output_diagram_mode=False // detail mode only
then begin
rail:=26;
repeat
pbg_draw_fill_rail(1); // K-crossing check rails.
rail:=rail+2;
until rail>28;
pbg_draw_fill_vee; // do complete vee in one go ...
// finally draw in the planing gauge-faces - no infill...
set_pen_railcolour(True);
aq:=1;
if (intarray_max(list_bgnd_rails[aq,0])<>0) and (planing_end_aq1>0)
then begin
move_to.X:=pbg_get_w_dots(aq,0); move_to.Y:=pbg_get_l_dots(aq,0);
for now:=1 to planing_end_aq1{+1} do begin
line_to.X:=pbg_get_w_dots(aq,now); line_to.Y:=pbg_get_l_dots(aq,now);
if check_limits(move_to, line_to)=True then begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
move_to:=line_to;
end;//for
end;
aq:=2;
if (intarray_max(list_bgnd_rails[aq,0])<>0) and (planing_end_aq2>0)
then begin
move_to.X:=pbg_get_w_dots(aq,0); move_to.Y:=pbg_get_l_dots(aq,0);
for now:=1 to planing_end_aq2{+1} do begin
line_to.X:=pbg_get_w_dots(aq,now); line_to.Y:=pbg_get_l_dots(aq,now);
if check_limits(move_to, line_to)=True then begin MoveTo(move_to.X, move_to.Y); LineTo(line_to.X, line_to.Y); end;
move_to:=line_to;
end;//for
end;
end;//detail mode
end; // 226c
end;//polygon mode
// finally add the rail-joint marks over the rail infill...
end;//if rails
end;//with bgnd_keep
// add ID text, gaps and sticker symbols over the rails..
if kludge=False
then begin
pdf_draw_symbols(pdf_form.pdf_printer.Canvas,now_ti.keep_symbols,0,2,grid_left,grid_top,bgnd_y_datum); // 227c
pdf_draw_symbols(pdf_form.pdf_printer.Canvas,now_ti.keep_symbols,1,2,grid_left,grid_top,bgnd_y_datum); // 227a draw the 1=gaps
pdf_draw_symbols(pdf_form.pdf_printer.Canvas,now_ti.keep_symbols,2,2,grid_left,grid_top,bgnd_y_datum); // 227a draw the 2=stickers
end;
end;//for next n template
end;//with pdf_form.pdf_printer.Canvas
// finally add the rail-joint marks over the rail infill... // 209c moved outside loop
if (print_settings_form.output_rails_checkbox.Checked=True) and (output_diagram_mode=False)
then pdf_bgnd_marks(grid_left,grid_top,max_list_index,True,False);
// and the timber numbering over the platforms ... 226d
if (pad_form.timber_numbering_over_platforms_menu_entry.Checked=True) and (output_diagram_mode=False)
then pdf_bgnd_marks(grid_left,grid_top,max_list_index,False,True);
end;
//________________________________________________________________________________________
procedure Tpdf_form.how_panelClick(Sender: TObject);
begin
if help(-1,pdf_help_str,'about mapping colours')=1 then pad_form.marker_and_mapping_colours_help_menu_entry.Click;
end;
//____________________________________________________________________________________________
procedure Tpdf_form.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if print_busy=True
then begin
CanClose:=False; // can''t close if still busy.
omit_all_button.Click;
end
else CanClose:=True;
end;
//___________________________________________________________________________________________
procedure Tpdf_form.banner_fill_checkboxClick(Sender: TObject);
begin
button_clicked:=True;
banner_changed:=True;
end;
//_______________________________________________________________________________________
procedure Tpdf_form.font_buttonClick(Sender: TObject);
begin
preview_form.Font.Assign(get_font('choose a new font and text colour for the preview page labels',preview_form.Font,True));
if printer_printing=False then print_preview(True,True,0); // redraw in new font.
end;
//__________________________________________________________________________________________
procedure Tpdf_form.black_edges_checkboxClick(Sender: TObject);
// need to repeat the colour setup, already set before form shows.
begin
print_colours_setup;
end;
//_______________________________________________________________________________________
procedure Tpdf_form.FormResize(Sender: TObject);
begin
if (Showing=True) and (initdone_flag=True) and (form_scaling=False) // otherwise clobbers Windows on startup or quit.
then ScrollInView(all_button);
end;
//___________________________________________________________________________________________
procedure intensity_changed;
var
n:integer;
begin
print_colours_setup; // set up the new colours.
// clear any existing rotated bitmaps, so new ones are created with new colours...
with bgnd_form.bgnd_shapes_listbox.Items do begin
if Count>0
then begin
for n:=0 to Count-1 do begin
if Tbgshape(Objects[n]).bgnd_shape.shape_code<>-1 then CONTINUE; // not a picture
Tbgshape(Objects[n]).bgimage.image_shape.rotated_bitmap.Free; // clear the bitmap...
Tbgshape(Objects[n]).bgimage.image_shape.rotated_bitmap:=TBitmap.Create;
end;//for
end;
end;//with
end;
//__________________________________________________________________________________________
procedure pdf_rotate_metafile(i:integer); // rotate metafile supplied 90degs clockwise. 213b
var
dest_metafile:TMetafile;
dest_canvas:TMetafileCanvas;
transform_matrix:tagXFORM;
saved_screen_cursor:TCursor;
inwidth,inheight:integer;
str:string;
in_picture:TPicture; // need a TGraphic for drawing
begin
if Tbgshape(bgnd_form.bgnd_shapes_listbox.Items.Objects[i]).bgnd_shape.picture_is_metafile=False then EXIT;
saved_screen_cursor:=Screen.Cursor;
Screen.Cursor:=crHourglass;
dest_metafile:=TMetafile.Create;
dest_metafile.Enhanced:=False;
dest_metafile.Transparent:=True;
in_picture:=TPicture.Create;
try
with Tbgshape(bgnd_form.bgnd_shapes_listbox.Items.Objects[i]) do begin
str:=bgnd_shape.shape_name;
with bgimage.image_shape do begin
in_picture.Assign(image_metafile);
inwidth:=image_metafile.Width;
inheight:=image_metafile.Height;
try
dest_metafile.Width:=inheight;
dest_metafile.Height:=inwidth;
except
alert(2,' image preparation failure',
'Preparation of the following picture shape for PDF output has failed:'
+'||'+str
+'||The failure was caused by insufficient resources in your system.',
'','','','','','O K',0);
EXIT;
end;//try
dest_canvas:=TMetafileCanvas.Create(dest_metafile,0); // 0 = use screen as reference device
SetGraphicsMode(dest_canvas.Handle,GM_ADVANCED);
SetMapMode(dest_canvas.Handle,MM_TEXT);
FillChar(transform_matrix,SizeOf(transform_matrix),0);
// clockwise 90 degs...
transform_matrix.eM11:=0; // Cos(Angle);
transform_matrix.eM12:=1; // Sin(Angle);
transform_matrix.eM21:=-1; // -Sin(Angle);
transform_matrix.eM22:=0; // Cos(Angle);
transform_matrix.eDx:=inheight;
transform_matrix.eDy:=0;
SetWorldTransform(dest_canvas.Handle,transform_matrix);
dest_canvas.Draw(0,0,in_picture.Graphic); // draw it rotated
//dest_canvas.Unlock;
dest_canvas.Free; // freeing metafile canvas to create the metafile
rotated_picture.Assign(dest_metafile); // return rotated metafile in a Graphic
// rotate_metafile in shape not used
end;//with image_shape
end;//with shape object
finally
dest_metafile.Free;
in_picture.Free;
Screen.Cursor:=saved_screen_cursor;
end;//try
end;
//______________________________________________________________________________
procedure pdf_rotate_bitmap(i:integer); // rotate bitmap supplied 90degs clockwise.
var
inrow,incol:integer;
inwidth,inheight:integer;
pixel_colour:TColor;
saved_screen_cursor:TCursor;
str:string;
begin
saved_screen_cursor:=Screen.Cursor;
Screen.Cursor:=crHourglass;
try
with Tbgshape(bgnd_form.bgnd_shapes_listbox.Items.Objects[i]) do begin
str:=bgnd_shape.shape_name;
with bgimage.image_shape do begin
inwidth:=image_bitmap.Width;
inheight:=image_bitmap.Height;
rotated_bitmap.Monochrome:=image_bitmap.Monochrome;
try
rotated_bitmap.Width:=inheight;
rotated_bitmap.Height:=inwidth;
except
alert(2,' image preparation failure',
'Sorry, preparation of the following picture shape for PDF output has failed:'
+'||'+str
+'||The failure was caused by insufficient resources in your system.'
+'||Try re-scanning the image at a lower resolution, or if it is colour image try re-scanning in grey-scale or black and white.',
'','','','','','O K',0);
EXIT;
end;//try
with rotated_bitmap do begin
with Canvas do begin
Brush.Color:=clWhite; // this clears the new bitmap for starters.
Brush.Style:=bsSolid;
FillRect(Rect(0, 0, Width, Height));
end;//with
end;//with
if inheight<32767 then pdf_form.row_progressbar.Max:=inheight // Delphi 16-bit limits..
else pdf_form.row_progressbar.Max:=32767;
pdf_form.row_progressbar.Position:=0;
for inrow:=0 to (inheight-1) do begin
for incol:=0 to (inwidth-1) do begin
pixel_colour:=image_bitmap.Canvas.Pixels[incol,inrow];
if pixel_colour<>clWhite then rotated_bitmap.Canvas.Pixels[inheight-1-inrow,incol]:=calc_intensity(pixel_colour);
end;//for
pdf_form.row_progressbar.StepIt;
pdf_form.row_label.Caption:='processing... '+IntToStr(inrow); // 208b
Application.ProcessMessages;
end;//for
rotated_picture.Graphic:=rotated_bitmap;
end;//with
end;//with
finally
pdf_form.row_progressbar.Position:=0;
pdf_form.row_label.Caption:='';
Screen.Cursor:=saved_screen_cursor;
end;//try
end;
//________________________________________________________________________________________
procedure Tpdf_form.diagram_mode_radiobuttonClick(Sender: TObject);
begin
if diagram_mode_radiobutton.Checked=True then pad_form.output_diagram_mode_menu_entry.Click;
show_output_mode_panel;
end;
//______________________________________________________________________________
procedure Tpdf_form.detail_mode_radiobuttonClick(Sender: TObject);
begin
if detail_mode_radiobutton.Checked=True then pad_form.output_detail_mode_menu_entry.Click;
show_output_mode_panel;
end;
//______________________________________________________________________________
procedure Tpdf_form.include_sketchboard_items_checkboxClick(Sender: TObject); // 206e
begin
if include_sketchboard_items_checkbox.Checked=False then EXIT;
if go_sketchboard=True // sketchboard in use?
then begin
dtp_form.dtp_document.ZoomPage; // needed to print items -- calc from rulers.
update_model_rulers;
if trackplan_exists=False
then begin
alert(6,'php/560 no sketchboard trackplan',
'You have selected the option to include sketchboard items in the PDF file, but there is currently no trackplan item on the sketchboard.'
+'||Templot is unable to include sketchboard items in the PDF file if there is no trackplan reference available to set the scaled size.'
+'||To include items from the sketchboard in the PDF file, add a trackplan item to the sketchboard.',
'','','','','cancel','',0);
include_sketchboard_items_checkbox.Checked:=False; // and untick it.
end;
end
else begin
alert(6,'php/500 sketchboard not in use',
'You have selected the option to include sketchboard items in the PDF file, but the sketchboard is not currently in use.'
+'||To start using the sketchboard click the `0sketchboard`1 button on the trackpad (top left).',
'','','','','cancel','',0);
include_sketchboard_items_checkbox.Checked:=False; // and untick it.
end;
end;
//______________________________________________________________________________
procedure Tpdf_form.page_listboxClick(Sender: TObject); // 227a
begin
with page_listbox do begin
if ItemIndex<1
then begin
sheet_across:=0;
sheet_down:=-1;
end
else begin
sheet_across:=Tsheet_id(pdf_form.page_listbox.Items.Objects[ItemIndex-1]).across;
sheet_down:=Tsheet_id(pdf_form.page_listbox.Items.Objects[ItemIndex-1]).down;
end;
omit_page_button.Click; // for a change of page
end;//with
end;
//______________________________________________________________________________
function pdf_draw_symbols(canv:TCanvas; symbols:Tsymbols; symbol_type,layer:integer; grid_left,grid_top,ypd:extended):boolean; // layer, ypd 227c
var
i,n,dummy_i:integer;
move_to,line_to:TPoint;
check_intx,check_inty:extended;
check_int1x,check_int1y,check_int2x,check_int2y:extended;
pole_length:extended;
infill_points:array[0..23] of TPoint;
font_height,half_stringwidth,half_stringheight:integer;
drawn_id_str:string;
begin
RESULT:=False; // default init.
if print_settings_form.output_symbols_checkbox.Checked=False then EXIT;
if pdf_form.symbols_checkbox.Checked=False then EXIT;
if output_diagram_mode=True then EXIT;
with canv do begin
if Length(symbols)<1 then EXIT;
for n:=0 to Length(symbols)-1 do begin
with symbols[n] do begin
with symbol_data do begin
if symb_type<>symbol_type then CONTINUE;
with drawn_symbol do begin
case symb_type of
0: if layer=1
then begin // it's a dropper polygon...
Pen.Width:=1;
Pen.Style:=psSolid;
Pen.Mode:=pmCopy;
Pen.Color:=symb_colour;
Brush.Style:=bsSolid;
Brush.Color:=symb_colour;
for i:=0 to (num_points-1) do begin
check_intx:=limits(h_minint,h_maxint,(poly_points[i].Y+ypd-grid_left)*scaw_out+page_left_dots,dummy_i);
check_inty:=limits(h_minint,h_maxint,(poly_points[i].X-grid_top)*scal_out+page_top_dots,dummy_i);
infill_points[i].X:=Round(check_intx);
infill_points[i].Y:=Round(check_inty);
end;//next
Polygon(Slice(infill_points,num_points)); // number of points, not index
// now the flagpole ...
check_int1x:=limits(h_minint,h_maxint,(symbol_point.Y+ypd-grid_left)*scaw_out+page_left_dots,dummy_i);
check_int1y:=limits(h_minint,h_maxint,(symbol_point.X-grid_top)*scal_out+page_top_dots,dummy_i);
check_int2x:=limits(h_minint,h_maxint,(end_point.Y+ypd-grid_left)*scaw_out+page_left_dots,dummy_i);
check_int2y:=limits(h_minint,h_maxint,(end_point.X-grid_top)*scal_out+page_top_dots,dummy_i);
move_to.X:=Round(check_int1x); move_to.Y:=Round(check_int1y);
line_to.X:=Round(check_int2x); line_to.Y:=Round(check_int2y);
pole_length:=SQRT(SQR(move_to.X-line_to.X)+SQR(move_to.Y-line_to.Y)); // in dots
Pen.Width:=Round(pole_length/5); // 5 arbitrary
MoveTo(move_to.X, move_to.Y);
LineTo(line_to.X, line_to.Y);
end;
1: begin // gap H-section fishplate tuf
Pen.Width:=1;
Pen.Style:=psSolid;
Pen.Mode:=pmCopy;
Pen.Color:=symb_colour;
Brush.Style:=bsSolid;
Brush.Color:=symb_colour;
for i:=0 to (num_points-1) do begin
check_intx:=limits(h_minint,h_maxint,(poly_points[i].Y+ypd-grid_left)*scaw_out+page_left_dots,dummy_i);
check_inty:=limits(h_minint,h_maxint,(poly_points[i].X-grid_top)*scal_out+page_top_dots,dummy_i);
infill_points[i].X:=Round(check_intx);
infill_points[i].Y:=Round(check_inty);
end;//next
Polygon(Slice(infill_points,num_points)); // number of points, not index
end;
// 2: sticker - boxed string only - below
end;//case
// now the ID text...
if (symb_type<>1) and (layer=2) // no text for a gap
then begin
check_intx:=limits(h_minint,h_maxint,(id_point.Y+ypd-grid_left)*scaw_out+page_left_dots,dummy_i);
check_inty:=limits(h_minint,h_maxint,(id_point.X-grid_top)*scal_out+page_top_dots,dummy_i);
move_to.X:=Round(check_intx); move_to.Y:=Round(check_inty);
Font.Assign(pad_form.pad_dropper_font_label.Font); // Courier New
font_height:=Round(id_height.X*scal_out);
if font_height<1 then font_height:=1;
Font.Height:=0-font_height; // heights negative
drawn_id_str:=Trim(symb_id_str);
half_stringwidth:=TextWidth(drawn_id_str) div 2;
half_stringheight:=TextHeight(drawn_id_str) div 2;
Font.Color:=symb_colour;
Brush.Color:=clWhite;
Brush.Style:=bsSolid; //bsClear;
if symb_type=2 // sticker draw box rectangle
then begin
Pen.Width:=2;
Pen.Style:=psSolid;
Pen.Mode:=pmCopy;
Pen.Color:=clBlack;
Brush.Color:=symb_colour;
Rectangle(move_to.X-half_stringwidth-7, move_to.Y-half_stringheight, move_to.X+half_stringwidth+9, move_to.Y+half_stringheight); // 7,9 arbitrary padding
Brush.Style:=bsClear; // for TextOut over rectangle
Pen.Width:=1; // reset
Font.Color:=clBlack;
end;
TextOut(move_to.X-half_stringwidth,move_to.Y-half_stringheight,drawn_id_str);
Font.Assign(print_labels_font); // restore
end;
end;//with
end;//with
end;//with
RESULT:=True; // something was drawn
end;//next symbol
end;//with canv
end;
//______________________________________________________________________________
end.