(*
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 227d
*)
unit dtp_unit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ActnList, ComCtrls, ToolWin, Menus, ImgList, ExtCtrls, dtpDocument, dtpPage,
dtpShape, dtpTextShape, StdCtrls, dtpExposedMetafile, ExtDlgs, dtpGr32,
sdOptionRefs, Printers, dtpEffectShape, dtpColoreffects, dtpShadowEffects,
dtpBitmapShape, dtpRasterFormats, dtpFreehandShape, ShellApi, dtpPolygonShape,
dtpMemoShape, dtpLineShape, dtpResource, dtpRasterHCK, dtpPolygonText,
dtpProjectiveText, dtpTextureEffects, dtpDefaults, dtpNativeXml, dtpHandles,
rsRuler, dtpW2K3Handles, Math, dtpCropBitmap, VirtualScrollbox,
Jpeg, dtpRasterGIF, dtpRasterPNG, WPPDFR1, WPPDFR2, WPPDFPRP, Buttons;
type
THackControl = class(TControl) // a way to publish some protected properties we need to set
published
property DragCursor;
end;
Tdtp_form = class(TForm)
sb_menu_bar: TMainMenu;
file_menu: TMenuItem;
zoom_menu: TMenuItem;
zoom_to_width_menu_entry: TMenuItem;
zoom_to_page_menu_entry: TMenuItem;
zoom_in_menu_entry: TMenuItem;
zoom_out_menu_entry: TMenuItem;
N1: TMenuItem;
show_grid_menu_entry: TMenuItem;
show_page_margins_menu_entry: TMenuItem;
N4: TMenuItem;
show_control_panel_menu_entry: TMenuItem;
load_dtp_menu_entry: TMenuItem;
clear_dtp_menu_entry: TMenuItem;
save_dtp_as_menu_entry: TMenuItem;
N5: TMenuItem;
sb_hide_menu_entry: TMenuItem;
edit_menu: TMenuItem;
cut_menu_entry: TMenuItem;
copy_menu_entry: TMenuItem;
paste_menu_entry: TMenuItem;
move_backwards_menu_entry: TMenuItem;
move_forwards_menu_entry: TMenuItem;
push_to_back_menu_entry: TMenuItem;
bring_to_front_menu_entry: TMenuItem;
N9: TMenuItem;
combine_menu_entry: TMenuItem;
split_menu_entry: TMenuItem;
Align1: TMenuItem;
align_menu_entry: TMenuItem;
align_left_menu_entry: TMenuItem;
align_centre_menu_entry: TMenuItem;
align_right_menu_entry: TMenuItem;
align_top_menu_entry: TMenuItem;
align_middle_menu_entry: TMenuItem;
align_bottom_menu_entry: TMenuItem;
sb_print_fit_paper_menu_entry: TMenuItem;
help_menu: TMenuItem;
sketchboard_help_menu_entry: TMenuItem;
delete_items_menu_entry: TMenuItem;
sb_export_image_menu_entry: TMenuItem;
show_page_rulers_menu_entry: TMenuItem;
sb_popup_menu: TPopupMenu;
move_backwards_popup_entry: TMenuItem;
move_forwards_popup_entry: TMenuItem;
push_to_back_popup_entry: TMenuItem;
bring_to_front_popup_entry: TMenuItem;
dtp_doc_panel: TPanel;
top_ruler_panel: TPanel;
rsrCorner: TRsRulerCorner;
page_ruler_top: TRsRuler;
left_ruler_panel: TPanel;
page_ruler_left: TRsRuler;
dtp_document: TdtpDocument;
Shape1: TShape;
Shape2: TShape;
options_menu: TMenuItem;
allow_trackplan_select_menu_entry: TMenuItem;
push_trackplan_to_background_menu_entry: TMenuItem;
model_ruler_bottom: TRsRuler;
model_ruler_right: TRsRuler;
show_model_rulers_menu_entry: TMenuItem;
zoom_normal_menu_entry: TMenuItem;
N2: TMenuItem;
delete_trackplan_menu_entry: TMenuItem;
N3: TMenuItem;
sb_pdf_menu_entry: TMenuItem;
bgnd_shape_image: TImage;
sb_save_dialog: TSaveDialog;
sb_load_dialog: TOpenDialog;
drag_zoom_rectangle_menu_entry: TMenuItem;
N11: TMenuItem;
N13: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
N16: TMenuItem;
N17: TMenuItem;
bring_trackplan_to_foreground_menu_entry: TMenuItem;
prevent_trackplan_selection_menu_entry: TMenuItem;
snap_to_guides_menu_entry: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N10: TMenuItem;
cut_popup_entry: TMenuItem;
copy_popup_entry: TMenuItem;
paste_popup_entry: TMenuItem;
N12: TMenuItem;
N18: TMenuItem;
combine_popup_entry: TMenuItem;
split_popup_entry: TMenuItem;
N19: TMenuItem;
delete_popup_entry: TMenuItem;
show_copyboard_menu_entry: TMenuItem;
sb_printer_setup_dialog: TPrinterSetupDialog;
sb_pdf_printer: TWPPDFPrinter;
sb_pdf_save_dialog: TSaveDialog;
sb_save_imagefile_dialog: TSavePictureDialog;
sb_export_screenshot_menu_entry: TMenuItem;
pull_trackplan_forwards_menu_entry: TMenuItem;
push_trackplan_backwards_menu_entry: TMenuItem;
N20: TMenuItem;
N21: TMenuItem;
alignhelp1: TMenuItem;
N22: TMenuItem;
sb_internals_help_menu_entry: TMenuItem;
set_custom_menu_entry: TMenuItem;
set_custom_popup_entry: TMenuItem;
metric_scale_calculator_menu_entry: TMenuItem;
N24: TMenuItem;
allow_all_selected_menu_entry: TMenuItem;
jotter_menu_entry: TMenuItem;
N8: TMenuItem;
undo_delete_menu_entry: TMenuItem;
sb_cropped_screenshot_menu_entry: TMenuItem;
N25: TMenuItem;
sb_600x400_screenshot_menu_entry: TMenuItem;
sb_800x600_screenshot_menu_entry: TMenuItem;
sb_1000x800_screenshot_menu_entry: TMenuItem;
sb_850x400_screenshot_menu_entry: TMenuItem;
sb_1170x810_screenshot_menu_entry: TMenuItem;
sb_585x405_screenshot_menu_entry: TMenuItem;
sb_780x540_screenshot_menu_entry: TMenuItem;
sb_975x675_screenshot_menu_entry: TMenuItem;
N27: TMenuItem;
N28: TMenuItem;
crop_marker_bottom_panel: TPanel;
crop_marker_right_panel: TPanel;
N29: TMenuItem;
hide_crop_markers_menu_entry: TMenuItem;
crop_marker_top_panel: TPanel;
crop_marker_left_panel: TPanel;
get_colour_at_mouse_menu_entry: TMenuItem;
sb_tools_menu: TMenuItem;
N26: TMenuItem;
N30: TMenuItem;
sb_print_help_menu_entry: TMenuItem;
top_panel: TPanel;
zoom_rectangle_latching_toolbutton: TSpeedButton;
zoom_out_toolbutton: TSpeedButton;
zoom_in_toolbutton: TSpeedButton;
x_label: TLabel;
y_label: TLabel;
x_page_label: TLabel;
y_page_label: TLabel;
copyboard_button: TButton;
show_dtp_on_pad_checkbox: TCheckBox;
control_panel_button: TButton;
corner_grip: TStatusBar;
sb_save_emf_dialog: TSavePictureDialog;
sk9sketchboardfilescanalsobe1: TMenuItem;
draggedontothesketchboard1: TMenuItem;
N23: TMenuItem;
N32: TMenuItem;
N33: TMenuItem;
go_to_my_documents_menu_entry: TMenuItem;
jpg_quality_menu_entry: TMenuItem;
N34: TMenuItem;
N35: TMenuItem;
N36: TMenuItem;
N37: TMenuItem;
N38: TMenuItem;
actual_size_printing_popup_entry: TMenuItem;
this_location_top_left_print_popup_entry: TMenuItem;
actualsizeprinting1: TMenuItem;
set_top_left_menu_entry: TMenuItem;
N43: TMenuItem;
sb_print_all_at_size_menu_entry: TMenuItem;
N39: TMenuItem;
N40: TMenuItem;
N46: TMenuItem;
set_fill_page_menu_entry: TMenuItem;
N47: TMenuItem;
sb_print_single_sheet_menu_entry: TMenuItem;
sb_print_reset_zero_menu_entry: TMenuItem;
modify_dims_menu_entry: TMenuItem;
modify_menu_entry: TMenuItem;
N31: TMenuItem;
modify_infill_menu_entry: TMenuItem;
help1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure load_dtp_menu_entryClick(Sender: TObject);
procedure save_dtp_as_menu_entryClick(Sender: TObject);
procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
procedure FormResize(Sender: TObject);
procedure show_page_rulers_menu_entryClick(Sender: TObject);
procedure allow_trackplan_select_menu_entryClick(Sender: TObject);
procedure push_trackplan_to_background_menu_entryClick(Sender: TObject);
procedure show_model_rulers_menu_entryClick(Sender: TObject);
procedure dtp_documentResize(Sender: TObject);
procedure dtp_documentUpdateScrollPosition(Sender: TObject);
procedure FormHide(Sender: TObject);
procedure zoom_normal_menu_entryClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure delete_trackplan_menu_entryClick(Sender: TObject);
procedure sb_print_fit_paper_menu_entryClick(Sender: TObject);
procedure sb_export_image_menu_entryClick(Sender: TObject);
procedure sb_hide_menu_entryClick(Sender: TObject);
procedure show_control_panel_menu_entryClick(Sender: TObject);
procedure FormKeyDown(Sender:TObject; var Key:Word; Shift:TShiftState);
procedure combine_menu_entryClick(Sender: TObject);
procedure drag_zoom_rectangle_menu_entryClick(Sender: TObject);
procedure zoom_to_width_menu_entryClick(Sender: TObject);
procedure zoom_to_page_menu_entryClick(Sender: TObject);
procedure zoom_in_menu_entryClick(Sender: TObject);
procedure zoom_out_menu_entryClick(Sender: TObject);
procedure sb_pdf_menu_entryClick(Sender: TObject);
procedure clear_dtp_menu_entryClick(Sender: TObject);
procedure sketchboard_help_menu_entryClick(Sender: TObject);
procedure prevent_trackplan_selection_menu_entryClick(Sender: TObject);
procedure FormDeactivate(Sender: TObject);
procedure file_menuClick(Sender: TObject);
procedure cut_menu_entryClick(Sender: TObject);
procedure copy_menu_entryClick(Sender: TObject);
procedure paste_menu_entryClick(Sender: TObject);
procedure delete_items_menu_entryClick(Sender: TObject);
procedure move_backwards_menu_entryClick(Sender: TObject);
procedure move_forwards_menu_entryClick(Sender: TObject);
procedure push_to_back_menu_entryClick(Sender: TObject);
procedure bring_to_front_menu_entryClick(Sender: TObject);
procedure bring_trackplan_to_foreground_menu_entryClick(Sender:TObject);
procedure split_menu_entryClick(Sender: TObject);
procedure show_page_margins_menu_entryClick(Sender: TObject);
procedure show_grid_menu_entryClick(Sender: TObject);
procedure snap_to_guides_menu_entryClick(Sender: TObject);
procedure align_bottom_menu_entryClick(Sender: TObject);
procedure align_middle_menu_entryClick(Sender: TObject);
procedure align_top_menu_entryClick(Sender: TObject);
procedure align_right_menu_entryClick(Sender: TObject);
procedure align_centre_menu_entryClick(Sender: TObject);
procedure align_left_menu_entryClick(Sender: TObject);
procedure show_copyboard_menu_entryClick(Sender: TObject);
procedure zoom_rectangle_latching_toolbuttonClick(Sender: TObject);
procedure sb_export_screenshot_menu_entryClick(Sender: TObject);
procedure push_trackplan_backwards_menu_entryClick(Sender: TObject);
procedure pull_trackplan_forwards_menu_entryClick(Sender: TObject);
procedure set_custom_menu_entryClick(Sender: TObject);
procedure metric_scale_calculator_menu_entryClick(Sender: TObject);
procedure allow_all_selected_menu_entryClick(Sender: TObject);
procedure jotter_menu_entryClick(Sender: TObject);
procedure undo_delete_menu_entryClick(Sender: TObject);
procedure sb_850x400_screenshot_menu_entryClick(Sender: TObject);
procedure hide_crop_markers_menu_entryClick(Sender: TObject);
procedure sb_585x405_screenshot_menu_entryClick(Sender: TObject);
procedure sb_600x400_screenshot_menu_entryClick(Sender: TObject);
procedure sb_780x540_screenshot_menu_entryClick(Sender: TObject);
procedure sb_800x600_screenshot_menu_entryClick(Sender: TObject);
procedure sb_975x675_screenshot_menu_entryClick(Sender: TObject);
procedure sb_1000x800_screenshot_menu_entryClick(Sender: TObject);
procedure sb_1170x810_screenshot_menu_entryClick(Sender: TObject);
procedure sb_internals_help_menu_entryClick(Sender: TObject);
procedure get_colour_at_mouse_menu_entryClick(Sender: TObject);
procedure sb_print_help_menu_entryClick(Sender: TObject);
procedure go_to_my_documents_menu_entryClick(Sender: TObject);
procedure jpg_quality_menu_entryClick(Sender: TObject);
procedure this_location_top_left_print_popup_entryClick(Sender: TObject);
procedure set_top_left_menu_entryClick(Sender: TObject);
procedure sb_print_all_at_size_menu_entryClick(Sender: TObject);
procedure set_fill_page_menu_entryClick(Sender: TObject);
procedure sb_print_reset_zero_menu_entryClick(Sender: TObject);
procedure sb_print_single_sheet_menu_entryClick(Sender: TObject);
procedure modify_menu_entryClick(Sender: TObject);
procedure modify_dims_menu_entryClick(Sender: TObject);
procedure modify_infill_menu_entryClick(Sender: TObject);
private
original_sb_window_proc:TWndMethod; // 214a for drag drop
FAbortTest: boolean;
FAlignAction: TAction;
FDragClass: TClass;
FDragObject: TObject;
FDragIndex: integer;
FDragPage: integer;
FDragSource: TObject;
FFileName: string;
FUpdating: boolean;
FPrintQuality: integer;
FRenderDpi: single;
FResampleMethod: integer;
FMultiSelectMethod: integer;
FRenderAtScreenRes: boolean;
FPerformance: integer;
procedure delete_selected_shapes;
procedure LoadDocument(const AFileName: string);
procedure SaveDocument(const AFileName: string);
procedure SetStatusText(const AText: string);
procedure UserSettingsFromDocument;
procedure UserSettingsToDocument;
procedure sb_window_proc (var msg:TMessage); // 214a
procedure sb_file_drop (var msg:TWMDROPFILES);
public
property AbortTest: boolean read FAbortTest write FAbortTest;
published
procedure dtp_documentMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure dtp_documentShapeInsertClosed(Sender: TObject; Shape: TdtpShape);
procedure dtp_documentStartDrag(Sender: TObject; var DragObject: TDragObject);
end;
const
cUntitled = 'untitled';
cDefaultText = 'double-click to enter text here';
cStatusFreehand = '[Enter key] = terminate, [Space bar] = close polygon + terminate, [Esc key] = cancel';
cDtpDocumentFilter = 'Templot sketchboard files (*.sk9)|*.sk9|';
cMetafileFilter = 'Metafiles (*.wmf, *.emf)|*.wmf;*.emf|';
// this expires on...
cExpiryYear = 5000;
cExpiryMonth = 1;
cExpiryDay = 1;
var
dtp_form: Tdtp_form;
omit_trackplan_from_rendering:boolean=False; // used for rendering back to pad or printing
copying_sb_to_pad:boolean=False; // 0.93.a flag for dtpPage.Print
copying_sb_to_printer:boolean=False; // 206e flag for dtpPage.Print
copying_sb_to_pdf:boolean=False; // 206e flag for dtpPage.Print
sb_printing_actual_size:boolean=False; // 226d
sb_print_rect:TRect; // 226d
sb_printer_rect:TRect; // 226d
render_page_background_transparent:boolean=False; // used when output printing items on templates (not used)
stretch_factor_wide:extended=1.0; // ratio between page ruler and model ruler
stretch_factor_high:extended=1.0;
trackplan_did_exist:boolean=False; // there is one to update from
// saved from previous trackplan ...
old_stretch_factor_wide:extended=1.0;
old_stretch_factor_high:extended=1.0;
old_model_ruler_x_offset:extended=0;
old_model_ruler_y_offset:extended=0;
old_window_left:extended=0;
old_window_top:extended=0;
pad_model_scale:extended=5.5; // model scale mm/ft T-55
pad_model_gauge:extended=25.4; // track gauge mm
// for rulers and X,Y readout...
model_ruler_x_offset:extended=0;
model_ruler_y_offset:extended=0;
// for drawing back on pad...
onpad_x_offset:extended=0;
onpad_y_offset:extended=0;
trackplan_exists:boolean=False;
sketchboard_trackplan_update_needed:boolean=True; // handshake between pad and sketchboard OnActivate
go_sketchboard:boolean=False; // no sketchboard startup until he ok it.
updating_now:boolean=False;
his_sb_pdf_file_name:string='';
his_sb_save_file_name:string='';
his_sb_load_file_name:string='';
custom_combined_shape:TdtpGroupShape=nil;
track_bgnd_width_in:extended=288; // 24ft default 206a
procedure add_sb_formatted_txt_metafile; // 0.97.a
function this_dtpshape_not_wanted(str:string):boolean; // called from the renderer in dtpShape unit
procedure add_sb_track_plan_bitmap(by_dragging:boolean);
procedure add_sb_track_plan_metafile(by_dragging,auto_add:boolean);
procedure update_model_rulers;
procedure sb_update_all_items(on_add:boolean);
procedure sb_update_menus;
function check_track_plan(str:string):boolean;
procedure sb_draw(on_canvas:TCanvas; canvas_width,canvas_height,output_code:integer); // draw control template or entire pad on sketchboard or exports
procedure set_cross_hairs_cursor;
procedure set_default_cursor;
procedure show_dtp_message(key:word); // debug
procedure dtp_form_resize;
procedure load_sketchboard_file(param_str:string); // sk9 file double-clicked to launch Templot 205b
procedure do_dtp_form_hide; // 205e now extracted from onHide event (also called fom pad menu to show items).
procedure sb_update_all_tabs_and_menus; // 205e now called from OnIdle
function draw_sb_low_res_output(on_bitmap:TBitmap):boolean; // 208a
procedure SetPolygonShapeDefaults(APoly:TdtpPolygonShape); // moved from dtp_settings_unit 227d
//______________________________________________________________________________
implementation
{$BOOLEVAL OFF}
// above 85A
{$R *.DFM}
uses
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, pdf_unit, sketchboard_unit,
dtp_settings_unit, export_unit,
GIFImage, PNGImage, sb_rvf_unit, arc_shape_unit,
RVStyle, metric_unit, jotter_unit, image_viewer_unit, mouse_colour_unit,
sb_rvf_outer_unit, edit_outline_unit, detail_mode_unit;
{$R DROPCURSORS.RES} // Load these additional cursors
const
// Cursor constants
crCopy = 101;
crMove = 102;
crLink = 103;
crCopyScroll = 104;
crMoveScroll = 105;
crLinkScroll = 106;
type
THackDocument = class(TdtpDocument);
var
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
show_page_rulers:boolean=True;
show_model_rulers:boolean=True;
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
top_left_print_page_x:extended=0; // 226d
top_left_print_page_y:extended=0; // 226d
x_page_now:extended=0; // 226d
y_page_now:extended=0; // 226d
procedure export_bgnd(on_canvas:TCanvas; canvas_height:integer; grid_left,grid_top:extended; output_code:integer);forward; // print background templates.
procedure export_bgnd_shapes(on_canvas:TCanvas; canvas_height:integer; grid_left,grid_top:extended; output_code:integer);forward; // print all background shapes.
procedure export_metafile;forward;
function export_draw_symbols(canv:TCanvas; canvas_height:integer; symbols:Tsymbols; symbol_type,layer:integer; grid_left,grid_top,ypd:extended; output_code:integer):boolean;forward; // 227c
//______________________________________________________________________________
procedure sb_update_all_tabs_and_menus; // 205e now called from OnIdle
begin
updating_now:=True; // lock out any generated clicks until all updated
if sb_tab_sheets_expanded=True
then begin
with dtp_settings_form do begin
page_tab_sheet_update;
settings_tab_sheet_update;
modify_tab_sheet_update;
// add item tab update...
with freehand_tracking_edit do if NOT Focused then Text:=round_str(freehand_tracking,1);
if trackplan_exists=True
then begin
with freehand_line_width_edit do if NOT Focused then Text:=round_str(freehand_line_width/stretch_factor_wide,1); // model mm
with polygon_line_width_edit do if NOT Focused then Text:=round_str(polygon_line_width/stretch_factor_wide,1); // model mm
end
else begin
with freehand_line_width_edit do if NOT Focused then Text:=round_str(freehand_line_width,1); // page mm
with polygon_line_width_edit do if NOT Focused then Text:=round_str(polygon_line_width,1); // page mm
end;
end;//with
end;// if expanded
sb_update_menus;
updating_now:=False;
end;
//______________________________________________________________________________
// for freehand shapes on sketchboard...
procedure set_cross_hairs_cursor;
begin
Screen.Cursor:=cross_hairs_cursor;
end;
//______________________________________________________________________________
procedure set_default_cursor;
begin
Screen.Cursor:=crDefault;
end;
//______________________________________________________________________________
procedure show_dtp_message(key:word); // debug
begin
ShowMessage(IntTostr(key));
end;
//______________________________________________________________________________
procedure Tdtp_form.align_bottom_menu_entryClick(Sender: TObject);
begin
FAlignAction := TAction(Sender);
dtp_document.AlignBottom;
end;
//______________________________________________________________________________
procedure Tdtp_form.align_centre_menu_entryClick(Sender: TObject);
begin
FAlignAction := TAction(Sender);
dtp_document.AlignCenter;
end;
//______________________________________________________________________________
procedure Tdtp_form.align_left_menu_entryClick(Sender: TObject);
begin
FAlignAction:=TAction(Sender);
dtp_document.AlignLeft;
end;
//______________________________________________________________________________
procedure Tdtp_form.align_middle_menu_entryClick(Sender: TObject);
begin
FAlignAction:=TAction(Sender);
dtp_document.AlignMiddle;
end;
//______________________________________________________________________________
procedure Tdtp_form.align_right_menu_entryClick(Sender: TObject);
begin
FAlignAction:=TAction(Sender);
dtp_document.AlignRight;
end;
//______________________________________________________________________________
procedure Tdtp_form.align_top_menu_entryClick(Sender: TObject);
begin
FAlignAction:=TAction(Sender);
dtp_document.AlignTop;
end;
//______________________________________________________________________________
procedure Tdtp_form.copy_menu_entryClick(Sender: TObject);
begin
dtp_document.Copy;
end;
//______________________________________________________________________________
procedure Tdtp_form.cut_menu_entryClick(Sender: TObject);
begin
dtp_document.Cut;
end;
//______________________________________________________________________________
procedure Tdtp_form.sb_hide_menu_entryClick(Sender: TObject);
begin
Hide;
end;
//______________________________________________________________________________
procedure ask_if_trackplan_locked;
var
i:integer;
begin
repeat
i:=alert(4,'php/530 sketchboard file loaded',
'The sketchboard contents include a trackplan item.'
+'||Do you want to lock this trackplan item, or perform auto updates from the trackpad?'
+'||Do not perform auto updates unless the trackpad currently contains a matching track plan,'
+' or you intend to reload a matching track plan from your .box template files.'
+'||You can change this option later on the `0TRACKPLAN`1 tab of the sketchboard control panel.'
+'||If you are unsure, click the green bar.',
'','','more information','perform auto updates','','lock trackplan item',3);
if i=3 then dtp_settings_form.sb_help_button.Click;
until i<>3;
if i=4 then pad_form.sb_auto_add_menu_entry.Click
else pad_form.sb_lock_menu_entry.Click;
end;
//______________________________________________________________________________
procedure Tdtp_form.load_dtp_menu_entryClick(Sender:TObject);
var
i:integer;
begin
if dtp_document.Modified=True
then begin
i:=alert(4,'php/501 reload sketchboard',
'There are unsaved changes on the sketchboard which will be lost if not saved.'
+'||Do you want to save them to a file before reloading the sketchboard?',
'','','','no - reload without saving','cancel','yes - save file first',0);
if i=5 then EXIT;
if i=6 then save_dtp_as_menu_entry.Click;
end;
with sb_load_dialog do begin
if his_sb_load_file_name<>'' then InitialDir:=ExtractFilePath(his_sb_load_file_name)
else InitialDir:=exe_str+'SKETCHBOARD-FILES\';
Filter:=cDtpDocumentFilter;
Filename:='*.sk9';
if Execute=False then EXIT; // get the file name.
try
his_sb_load_file_name:=FileName; // so we can use the same folder next time.
LoadDocument(FileName);
except
ShowMessage('Error loading sketchboard file.');
EXIT;
end;//try
update_model_rulers; // get new stretch factors if a trackplan loaded
if trackplan_exists=True
then begin // first add of a trackplan, init ...
old_stretch_factor_wide:=stretch_factor_wide;
old_stretch_factor_high:=stretch_factor_high;
old_model_ruler_x_offset:=model_ruler_x_offset;
old_model_ruler_y_offset:=model_ruler_y_offset;
old_window_left:=dtp_document.WindowLeft;
old_window_top:=dtp_document.WindowTop;
trackplan_did_exist:=True; // for next time
end
else trackplan_did_exist:=False; // for next time
end;//with
dtp_document.Modified:=False; // now matches a file.
zoom_normal_menu_entry.Click; // show all of it
if trackplan_exists=True then ask_if_trackplan_locked;
end;
//______________________________________________________________________________
procedure load_sketchboard_file(param_str:string); // sk9 file double-clicked to launch Templot 205b
// also dropped .sk9 files come here 214a
begin
pad_form.sb_lock_menu_entry.Click;
go_sketchboard:=True;
dtp_form.Show;
dtp_form.BringToFront;
dtp_settings_form.Show;
dtp_settings_form.BringToFront;
dtp_form.SetFocus;
Application.ProcessMessages;
try
his_sb_load_file_name:=param_str; // so we can use the same folder next time.
dtp_form.LoadDocument(param_str);
except
ShowMessage('Error loading sketchboard file.');
EXIT;
end;//try
update_model_rulers; // get new stretch factors if a trackplan loaded
if trackplan_exists=True
then begin // first add of a trackplan, init ...
old_stretch_factor_wide:=stretch_factor_wide;
old_stretch_factor_high:=stretch_factor_high;
old_model_ruler_x_offset:=model_ruler_x_offset;
old_model_ruler_y_offset:=model_ruler_y_offset;
old_window_left:=dtp_form.dtp_document.WindowLeft;
old_window_top:=dtp_form.dtp_document.WindowTop;
trackplan_did_exist:=True; // for next time
end
else trackplan_did_exist:=False; // for next time
dtp_form.dtp_document.Modified:=False; // now matches a file.
dtp_form.zoom_normal_menu_entry.Click; // show all of it
if trackplan_exists=True then ask_if_trackplan_locked;
end;
//______________________________________________________________________________
procedure Tdtp_form.save_dtp_as_menu_entryClick(Sender: TObject);
var
temp_str:string;
file_str:string;
begin
if dtp_document.CurrentPage.ShapeCount<1
then begin
show_modal_message('There are no items on the sketchboard to be saved.');
EXIT;
end;
with sb_save_dialog do begin
if his_sb_save_file_name<>'' then InitialDir:=ExtractFilePath(his_sb_save_file_name) // use his previous folder.
else InitialDir:=exe_str+'SKETCHBOARD-FILES\'; // or the default one.
Filter:=cDtpDocumentFilter;
temp_str:=remove_invalid_str(Copy('sketch_'+Trim(box_project_title_str),1,13)+FormatDateTime('_yyyy_mm_dd_hhmm_ss',Date+Time))+'.sk9'; // 13+7 = 20 chars
FileName:=lower_case_filename(temp_str); // to underscores and lower case.
if Execute=False then EXIT; // get his file name.
if invalid_85a_file_name(FileName)=True then EXIT;
his_sb_save_file_name:=FileName; // so can use same folder next time.
// invalid entered chars removed by dialog
file_str:=ExtractFilePath(FileName)+lower_case_filename(ExtractFileName(FileName)); // to underscores and lower case
SaveDocument(file_str); // save it.
dtp_document.Modified:=False; // all saved
end;//with
end;
//______________________________________________________________________________
procedure Tdtp_form.combine_menu_entryClick(Sender: TObject);
var
i:integer;
begin
with dtp_document do begin
if ShapeCount<1 then EXIT;
for i:=0 to (ShapeCount-1) do begin // first check if a trackplan is included
if Shapes[i].Selected=True
then begin
if check_track_plan(Shapes[i].Name)=True
then begin
if alert(3,'php/556 combining the trackplan item',
'The trackplan item cannot be combined with others.'
+'||If you continue the trackplan item will be removed from the items to be combined.',
'','','','','cancel','continue',0)=5 then EXIT;
Shapes[i].Selected:=False; // remove trackplan from selection
end;
end;
end;//for
if SelectionCount<2
then begin
ShowMessage('You must select at least 2 items to be combined.');
EXIT;
end;
Group;
end;//with
end;
//______________________________________________________________________________
procedure Tdtp_form.sketchboard_help_menu_entryClick(Sender: TObject);
begin
dtp_settings_form.sb_help_button.Click;
end;
//______________________________________________________________________________
procedure Tdtp_form.show_grid_menu_entryClick(Sender: TObject);
begin
if show_grid_menu_entry.Checked=True
then begin
show_grid_menu_entry.Checked:=False;
dtp_document.HelperMethod:=hmNone;
end
else begin
show_grid_menu_entry.Checked:=True;
dtp_document.HelperMethod:=hmGrid;
end;
end;
//____________________________________
procedure Tdtp_form.show_page_margins_menu_entryClick(Sender: TObject);
begin
show_page_margins_menu_entry.Checked:= NOT show_page_margins_menu_entry.Checked;
dtp_document.ShowMargins:=show_page_margins_menu_entry.Checked;
end;
//______________________________________________________________________________
procedure Tdtp_form.show_page_rulers_menu_entryClick(Sender: TObject);
begin
show_page_rulers:= NOT show_page_rulers;
show_page_rulers_menu_entry.Checked:=show_page_rulers;
top_ruler_panel.Visible:=show_page_rulers;
left_ruler_panel.Visible:=show_page_rulers;
dtp_form_resize;
end;
//______________________________________________________________________________
procedure Tdtp_form.show_model_rulers_menu_entryClick(Sender: TObject);
begin
show_model_rulers:= NOT show_model_rulers;
show_model_rulers_menu_entry.Checked:=show_model_rulers;
model_ruler_right.Visible:=show_model_rulers;
model_ruler_bottom.Visible:=show_model_rulers;
dtp_form_resize;
end;
//______________________________________________________________________________
procedure Tdtp_form.move_backwards_menu_entryClick(Sender: TObject);
begin
dtp_document.MoveBack;
end;
//___________________________________
procedure Tdtp_form.move_forwards_menu_entryClick(Sender: TObject);
begin
dtp_document.MoveFront;
end;
//___________________________________
procedure Tdtp_form.push_to_back_menu_entryClick(Sender: TObject);
begin
dtp_document.MoveToBackground;
end;
//___________________________________
procedure Tdtp_form.bring_to_front_menu_entryClick(Sender: TObject);
begin
dtp_document.MoveToForeground;
end;
//______________________________________________________________________________
procedure Tdtp_form.sb_export_image_menu_entryClick(Sender: TObject);
var
create_bitmap:TBitmap;
create_jpg:TJpegImage;
create_gif:TGIFImage;
create_png:TPNGObject;
folder_str:string;
file_name_str:string; // name part
file_str:string; // including path
i:integer;
img_width_mm:extended;
img_height_mm:extended;
img_dpmm:extended; // dots per mm.
img_width_dots:integer;
img_height_dots:integer;
sb_dtp_rect:TRect;
box_value:integer;
begin
if dtp_document.CurrentPage.ShapeCount<1
then begin
ShowMessage('There are no items on the sketchboard for export to an image file.');
EXIT;
end;
if sb_check_valid_int(dtp_settings_form.sb_image_width_edit,300,12000,box_value)=False // input limits 300 dots to 12000 dots (20" @ 600dpi)
then begin
ShowMessage('Error: The image width setting must be a valid whole number in the range 300 dots to 12000 dots.');
EXIT;
end;
try
img_width_dots:=box_value;
except
ShowMessage('Invalid data for image width.'); // ??? should have been found in sb_check_valid_ earlier
EXIT;
end;//try
file_name_str:=remove_invalid_str('sketchboard_'+FormatDateTime('yyyy_mm_dd_hhmm_ss',Date+Time)); //init
with sb_save_imagefile_dialog do begin
if his_image_file_name<>'' then InitialDir:=ExtractFilePath(his_image_file_name)
else InitialDir:=exe_str+'IMAGE-FILES\';
if dtp_settings_form.sb_transparent_gif_checkbox.Checked=True
then begin
DefaultExt:='gif';
FileName:=file_name_str+'.gif';
end
else begin
DefaultExt:='png';
FileName:=file_name_str+'.png';
end;
if Execute=False then EXIT;
his_image_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
end;//with
Screen.Cursor:=crHourGlass; // needed for large images or slow systems
img_width_mm:=dtp_document.CurrentPage.PageWidth;
img_height_mm:=dtp_document.CurrentPage.PageHeight;
img_dpmm:=img_width_dots/img_width_mm;
img_height_dots:=Round(img_width_dots*img_height_mm/img_width_mm);
create_bitmap:=TBitmap.Create;
create_jpg:=TJpegImage.Create;
create_gif:=TGIFImage.Create;
create_png:=TPNGObject.Create;
try
create_bitmap.Width:=img_width_dots;
create_bitmap.Height:=img_height_dots;
sb_dtp_rect.Left:=0;
sb_dtp_rect.Top:=0;
sb_dtp_rect.Right:=img_width_dots;
sb_dtp_rect.Bottom:=img_height_dots;
try
// draw templates on a bitmap
dtp_document.CurrentPage.Print(create_bitmap.Canvas, sb_dtp_rect, img_dpmm, 0,False,False);
if (LowerCase(ExtractFileExt(file_str))='.jpg')
or (LowerCase(ExtractFileExt(file_str))='.jpeg')
then begin
create_jpg.Assign(create_bitmap);
create_jpg.CompressionQuality:=jpg_quality; // global on control_room
create_jpg.JPEGNeeded;
create_jpg.SaveToFile(file_str);
end;
if LowerCase(ExtractFileExt(file_str))='.gif'
then begin
create_bitmap.TransparentColor:=clWhite;
create_bitmap.Transparent:=dtp_settings_form.sb_transparent_gif_checkbox.Checked;
create_gif.Assign(create_bitmap);
create_gif.SaveToFile(file_str);
end;
if LowerCase(ExtractFileExt(file_str))='.png'
then begin
create_png.Assign(create_bitmap);
create_png.SaveToFile(file_str);
end;
if LowerCase(ExtractFileExt(file_str))='.bmp'
then create_bitmap.SaveToFile(file_str);
repeat
i:=alert(2,' image file created',
'The image file was created successfully:||`0'+file_str+'`f'
+'||Click view image in Templot to see it.',
'','view image in Templot','view image in your usual image viewer','open the containing folder','','continue',0);
if i=2 then show_an_image_file(file_str);
if i=3
then begin
folder_str:=file_str;
if ShellExecute(0,'open',PChar(folder_str),nil,nil,SW_SHOWNORMAL)<=32
then ShowMessage('Sorry, unable to display the image.')
else external_window_showing:=True;
end;
if i=4
then begin
folder_str:=ExtractFilePath(file_str);
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;
until ((i<>2) or (FileExists(file_str)=False)); // may be deleted in image viewer
except
show_modal_message('Sorry, an error occurred in creating the image file.');
end;//try
finally
create_gif.Free;
create_png.Free;
create_jpg.Free;
create_bitmap.Free;
Screen.Cursor:=crDefault;
end;//try
end;
//______________________________________________________________________________
procedure Tdtp_form.paste_menu_entryClick(Sender: TObject);
begin
dtp_document.ClearSelection; // bug. needed before pasting transparent GIF, otherwise transparency is lost.
dtp_document.Paste;
end;
//______________________________________________________________________________
procedure Tdtp_form.sb_print_fit_paper_menu_entryClick(Sender: TObject);
begin
if no_printer_available=True // 0.93.a
then begin
ShowMessage('No printer available.');
EXIT;
end;
if dtp_document.CurrentPage.ShapeCount<1
then begin
ShowMessage('There are no items on the sketchboard to print.');
EXIT;
end;
if sb_printer_setup_dialog.Execute=False then EXIT;
Screen.Cursor:=crHourGlass;
Printer.Orientation:=poLandscape; // 227a no options, too complicated
omit_trackplan_from_rendering:=False; // include trackplan item in print
dtp_document.Print(dtp_document.CurrentPageIndex);
Screen.Cursor:=crDefault;
show_modal_message('sketchboard page printed');
end;
//______________________________________________________________________________
procedure Tdtp_form.sb_print_single_sheet_menu_entryClick(Sender: TObject);
const // WINAPI GetDeviceCaps Constants
HORZRES=8;
VERTRES=10;
LOGPIXELSX=88;
var
sb_print_width_dpi:integer; // reported dpi across width.
sb_print_width_dots:integer; // printer page-width in dots. 226d
sb_print_length_dots:integer; // printer page-length in dots. 226d
sb_print_dpmm:extended;
begin
if no_printer_available=True // 0.93.a
then begin
ShowMessage('No printer available.');
EXIT;
end;
if dtp_document.CurrentPage.ShapeCount<1
then begin
ShowMessage('There are no items on the sketchboard to print.');
EXIT;
end;
if sb_printer_setup_dialog.Execute=False then EXIT;
Printer.Orientation:=poLandscape; // 227a no options, too complicated
sb_print_width_dpi:=GetDeviceCaps(Printer.Handle, LOGPIXELSX); // dpi across width.
sb_print_width_dots:=GetDeviceCaps(Printer.Handle, HORZRES); // 226d printer page-width in dots.
sb_print_length_dots:=GetDeviceCaps(Printer.Handle, VERTRES); // 226d printer page-length in dots.
if sb_print_width_dpi<1
then begin
alert(0,' printer software problem ..',
'|||Templot is unable to access your printer software.'
+'||Please check your printer installation.',
'','','','','cancel printing','',0);
EXIT;
end;
sb_print_dpmm:=sb_print_width_dpi/25.4;
sb_printer_rect:=Rect(0,0,sb_print_width_dots,sb_print_length_dots); // printer dots
sb_print_rect:=Rect(Round(top_left_print_page_x*sb_print_dpmm),Round(top_left_print_page_y*sb_print_dpmm),Round(top_left_print_page_x*sb_print_dpmm)+sb_print_width_dots,Round(top_left_print_page_y*sb_print_dpmm)+sb_print_length_dots); // 226d
sb_printing_actual_size:=True; // 226d
omit_trackplan_from_rendering:=False; // include trackplan item in print
Screen.Cursor:=crHourGlass;
Printer.BeginDoc;
dtp_document.CurrentPage.Print(Printer.Canvas,sb_printer_rect,sb_print_dpmm,0,False,False); // 0 = no rotation
Printer.EndDoc;
sb_printing_actual_size:=False; // 226d reset
Screen.Cursor:=crDefault;
show_modal_message('single sheet printed');
end;
//______________________________________________________________________________
procedure Tdtp_form.sb_print_all_at_size_menu_entryClick(Sender: TObject); // 227a
const // WINAPI GetDeviceCaps Constants
HORZRES=8;
VERTRES=10;
LOGPIXELSX=88;
var
sb_print_width_dpi:integer; // reported dpi across width.
sb_print_width_dots:integer; // printer page-width in dots. 226d
sb_print_length_dots:integer; // printer page-length in dots. 226d
sb_print_dpmm:extended;
sb_page_width_mm:extended;
sb_page_length_mm:extended;
new_page:boolean;
print_count:integer;
begin
if no_printer_available=True // 0.93.a
then begin
show_modal_message('No printer available.');
EXIT;
end;
if dtp_document.CurrentPage.ShapeCount<1
then begin
show_modal_message('There are no items on the sketchboard to print.');
EXIT;
end;
if sb_printer_setup_dialog.Execute=False then EXIT;
Printer.Orientation:=poLandscape; // 227a no options, too complicated
sb_print_width_dpi:=GetDeviceCaps(Printer.Handle, LOGPIXELSX); // dpi across width.
sb_print_width_dots:=GetDeviceCaps(Printer.Handle, HORZRES); // 226d printer page-width in dots.
sb_print_length_dots:=GetDeviceCaps(Printer.Handle, VERTRES); // 226d printer page-length in dots.
if sb_print_width_dpi<1
then begin
alert(0,' printer software problem ..',
'|||Templot is unable to access your printer software.'
+'||Please check your printer installation.',
'','','','','cancel printing','',0);
EXIT;
end;
sb_printing_actual_size:=True; // 226d
omit_trackplan_from_rendering:=False; // include trackplan item in print
Screen.Cursor:=crHourGlass;
sb_print_dpmm:=sb_print_width_dpi/25.4;
sb_page_width_mm:=sb_print_width_dots/sb_print_dpmm;
sb_page_length_mm:=sb_print_length_dots/sb_print_dpmm;
sb_printer_rect:=Rect(0,0,sb_print_width_dots,sb_print_length_dots); // printer dots
top_left_print_page_x:=0; // init
top_left_print_page_y:=0; // init
new_page:=False; // init first page
print_count:=0; // init
Printer.BeginDoc;
repeat
INC(print_count);
if new_page=True then Printer.NewPage;
sb_print_rect:=Rect(Round(top_left_print_page_x*sb_print_dpmm),Round(top_left_print_page_y*sb_print_dpmm),Round(top_left_print_page_x*sb_print_dpmm)+sb_print_width_dots,Round(top_left_print_page_y*sb_print_dpmm)+sb_print_length_dots);
dtp_document.CurrentPage.Print(Printer.Canvas,sb_printer_rect,sb_print_dpmm,0,False,False); // 0 = no rotation
top_left_print_page_x:=top_left_print_page_x+sb_page_width_mm;
if top_left_print_page_x>dtp_document.CurrentPage.PageWidth // to next row ?
then begin
top_left_print_page_x:=0;
top_left_print_page_y:=top_left_print_page_y+sb_page_length_mm;
end;
new_page:=True;
until top_left_print_page_y>dtp_document.CurrentPage.PageHeight;
Printer.EndDoc;
sb_printing_actual_size:=False; // 226d reset
Screen.Cursor:=crDefault;
show_modal_message(IntToStr(print_count)+' sheets printed');
end;
//______________________________________________________________________________
procedure Tdtp_form.delete_items_menu_entryClick(Sender: TObject);
begin
delete_selected_shapes; // must use separate menu item to delete a trackplan
end;
//______________________________________________________________________________
procedure Tdtp_form.snap_to_guides_menu_entryClick(Sender: TObject);
begin
snap_to_guides_menu_entry.Checked:= NOT snap_to_guides_menu_entry.Checked;
dtp_document.SnapToGrid:=snap_to_guides_menu_entry.Checked;
end;
//______________________________________________________________________________
procedure Tdtp_form.split_menu_entryClick(Sender: TObject);
begin
dtp_document.Ungroup;
end;
//______________________________________________________________________________
procedure Tdtp_form.show_control_panel_menu_entryClick(Sender: TObject);
begin
if dtp_settings_form.Showing=True
then dtp_settings_form.Hide
else begin
dtp_settings_form.Show;
dtp_settings_form.BringTofront;
end;
end;
//______________________________________________________________________________
procedure Tdtp_form.delete_selected_shapes;
var
str,continue_str,more_str:string;
i,n:integer;
number_of_markers:integer;
begin
number_of_markers:=0; //init
with dtp_document do begin
if (ShapeCount<1) or (SelectionCount<1) then EXIT;
for i:=0 to (ShapeCount-1) do begin
if (Shapes[i].Selected=True)
and (Shapes[i] is TdtpOutlineMarkerShape)
then INC(number_of_markers);
end;//next
if number_of_markers>0 // delete selected markers, and ignore any other selected items...
then begin
if number_of_markers>(outline_markers_list.Count-2)
then begin
show_modal_message('Deleting too many outline markers.'
+#13+#13+'At least 2 outline markers must remain.');
for i:=0 to (ShapeCount-1) do begin // cancel
Shapes[i].Selected:=False;
end;
EXIT;
end;
i:=0; // init
repeat
if (Shapes[i].Selected=True)
and (Shapes[i] is TdtpOutlineMarkerShape)
then begin
if outline_markers_list.Count>0
then begin
for n:=0 to outline_markers_list.Count-1 do begin
if Shapes[i]=TdtpShape(Tmarker(outline_markers_list.Objects[n]).marker_shape)
then begin
ShapeRemove(Tmarker(outline_markers_list.Objects[n]).marker_shape);
DEC(i); // back one for next time
Tmarker(outline_markers_list.Objects[n]).Free;
outline_markers_list.Delete(n);
BREAK; // count changed
end;
end;//next in list
end;
end;//selected marker
INC(i);
until i>=ShapeCount;
end
else begin
// there were no markers selected..
str:='all'; // init
continue_str:='continue';
more_str:='||If you continue the trackplan item will be removed from the items to be deleted.';
for i:=0 to (ShapeCount-1) do begin
if Shapes[i].Selected=True
then begin
if check_track_plan(Shapes[i].Name)=True
then begin
if SelectionCount=1
then begin
continue_str:=''; // no other selected items to continue deleting.
more_str:='';
end;
if alert(3,'php/555 deleting the trackplan item',
'The trackplan item cannot be deleted this way.'
+'||To delete the trackplan item, click the|`0edit > delete trackplan`1 menu item instead|or press `0CTRL+D`2.'
+'||This will allow all other items to be updated to the plain page dimensions.'
+more_str,
'','','','','cancel',continue_str,0)=5 then EXIT;
Shapes[i].Selected:=False; // remove trackplan from selection
end;
end;
end;//next
if SelectionCount<1 then EXIT; // 212a
// no message if deleting multiple outline markers
if SelectionCount=2 then str:='both';
if SelectionCount>1
then begin
if alert(7,' delete multiple items ?',
'Do you want to delete '+str+' of these '+IntToStr(SelectionCount)+' items ?'
+'||Deleted items can be restored by clicking the|`0edit > undo deletions`1 menu item or by pressing `0CTRL+U`2.',
'','','','','no - cancel delete','yes - delete these '+IntToStr(SelectionCount)+' items',0)=5 then EXIT;
end;
if deleted_shapes_list.Count>9 then deleted_shapes_list.Delete(0); // remove oldest if would be more than 10 deletions saved.
deleted_shapes_list.Add(SelectionToText); // save deleted shapes in one string
// Do the deletion...
DeleteSelectedShapes;
end;
end;//with
end;
//______________________________________________________________________________
procedure Tdtp_form.dtp_documentMouseMove(Sender:TObject; Shift:TShiftState; X,Y:Integer);
var
AFloatPoint:TFloatPoint;
begin
// X,Y readouts in model dims (mm), reverse sign of Y...
if (trackplan_exists=True) and (stretch_factor_wide0 then dtp_document.ZoomPerCent:=100*dtp_document.CurrentPage.PageWidth/Shape.DocWidth;
delta_X:=Round(Shape.DocLeft*dtp_document.ScreenDpm);
delta_Y:=Round(Shape.DocTop*dtp_document.ScreenDpm);
dtp_document.ScrollBy(delta_X,delta_Y);
zoom_rectangle_latching_toolbutton.Down:=False;
end;
// update the copyright notice ...
if Shape is TdtpBitmapShape then do_copyright(Shape);
// for text shapes, only one add is likely at a time, so show the modify tab immediately ..
if (Shape is TdtpPolygonMemo)
or (Shape is TdtpTextShape)
or (Shape is TdtpCurvedText)
or (Shape is TdtpWavyText)
or (Shape is TdtpProjectiveText)
then dtp_settings_form.control_panel_page_control.ActivePage:=dtp_settings_form.modify_item_tab_sheet;
if (Shape is TdtpExposedMetafile)
then begin
if TdtpExposedMetafile(Shape).RvfShape=True
then dtp_settings_form.control_panel_page_control.ActivePage:=dtp_settings_form.modify_item_tab_sheet;
end;
end;
//______________________________________________________________________________
procedure Tdtp_form.dtp_documentStartDrag(Sender:TObject; var DragObject:TDragObject);
begin
dtp_document.DragCursor := crMove;
FDragClass := TdtpShape;
FDragObject := dtp_document.FocusedShape;
FDragPage := dtp_document.CurrentPageIndex;
if assigned(dtp_document.FocusedShape) then FDragIndex:=dtp_document.FocusedShape.Index
else FDragIndex := -1;
FDragSource := dtp_document;
end;
//______________________________________________________________________________
procedure Tdtp_form.FormCloseQuery(Sender:TObject; var CanClose:Boolean);
begin
Application.ProcessMessages;
if Application.Terminated=True then EXIT;
CanClose:=False;
Hide;
end;
//______________________________________________________________________________
procedure Tdtp_form.FormCreate(Sender: TObject);
begin
ClientWidth:=930; // these values don't match design time. Aspect ratio 13:9
// arrived at by experiment to get neat startup against the rulers.
ClientHeight:=688;
dtp_document.RenderDpm:=15; // 15 dots per mm
dtp_document.RenderDPI:=381; // * 25.4 = 381 dots per inch
dtp_document.CurrentPage.IsDefaultPage:=False; // no default pages.
page_ruler_left.Width:=26; // bug fixes..
page_ruler_left.Height:=3000;
dtp_form_resize;
dtp_document.FontEmbedding:=False; // no excessive file size
dtp_document.OptimizedPrinting:=True;
dtp_document.ZoomWidth; // 211b
update_model_rulers; // 211b
dtp_document.Modified:=False; // set false after applying all document settings
original_sb_window_proc:=dtp_form.WindowProc; // temp save WindowProc 214a...
dtp_form.WindowProc:=sb_window_proc; // and replace it
DragAcceptFiles(dtp_form.Handle,True);
end;
//______________________________________________________________________________
procedure Tdtp_form.LoadDocument(const AFileName: string);
begin
UserSettingsFromDocument;
with dtp_document do begin
LoadFromFile(AFileName);
FFileName := AFileName;
end;
UserSettingsToDocument;
end;
//______________________________________________________________________________
procedure Tdtp_form.SaveDocument(const AFileName: string);
begin
with dtp_document do begin
Screen.Cursor := crHourGlass;
try
SaveToFile(AFileName);
FFileName := AFileName;
finally
Screen.Cursor := crDefault;
end;
end;
end;
//______________________________________________________________________________
procedure Tdtp_form.SetStatusText(const AText: string);
begin
dtp_form.Caption:=' Templot sketchboard | '+AText;
Application.ProcessMessages;
end;
//______________________________________________________________________________
procedure sb_update_menus;
var
ASelCount:integer;
i:integer;
begin
with dtp_form do begin
if under_way=False then EXIT; // 85A don't allow this until all created.
with dtp_document do begin
ASelCount := SelectionCount;
combine_menu_entry.Enabled:=(ASelCount>1);
split_menu_entry.Enabled:=(ASelCount=1) and (Selection[0] is TdtpGroupShape);
set_custom_menu_entry.Enabled:=split_menu_entry.Enabled;
move_backwards_menu_entry.Enabled:=(ASelCount>0) and (ShapeCount>ASelCount);
move_forwards_menu_entry.Enabled:=move_backwards_menu_entry.Enabled;
push_to_back_menu_entry.Enabled:=move_backwards_menu_entry.Enabled;
bring_to_front_menu_entry.Enabled:=move_forwards_menu_entry.Enabled;
push_trackplan_to_background_menu_entry.Enabled:=((trackplan_exists=True) and (dtp_document.CurrentPage.ShapeCount>1));
bring_trackplan_to_foreground_menu_entry.Enabled:=((trackplan_exists=True) and (dtp_document.CurrentPage.ShapeCount>1));
push_trackplan_backwards_menu_entry.Enabled:=((trackplan_exists=True) and (dtp_document.CurrentPage.ShapeCount>1));
pull_trackplan_forwards_menu_entry.Enabled:=((trackplan_exists=True) and (dtp_document.CurrentPage.ShapeCount>1));
delete_trackplan_menu_entry.Enabled:=trackplan_exists;
undo_delete_menu_entry.Enabled:=(deleted_shapes_list.Count>0); // 205e
align_menu_entry.Enabled:=(ASelCount>1);
delete_items_menu_entry.Enabled:=(ASelCount>0);
cut_menu_entry.Enabled:=(ASelCount>0);
copy_menu_entry.Enabled:=(ASelCount>0);
paste_menu_entry.Enabled:=HasClipboardData;
if edit_outline_form.Visible=False then save_dtp_as_menu_entry.Enabled:=Modified
else save_dtp_as_menu_entry.Enabled:=False; // 212a
allow_trackplan_select_menu_entry.Enabled:=trackplan_exists;
prevent_trackplan_selection_menu_entry.Enabled:=trackplan_exists;
if trackplan_exists
then begin
for i:=0 to (dtp_document.ShapeCount-1) do begin
if check_track_plan(dtp_document.Shapes[i].Name)=True
then begin
allow_trackplan_select_menu_entry.Checked:=dtp_document.Shapes[i].AllowSelect; // radio item
prevent_trackplan_selection_menu_entry.Checked:= NOT dtp_document.Shapes[i].AllowSelect; // radio item
BREAK;
end;
end;//next
end;
// and popup entries ...
delete_popup_entry.Enabled:=delete_items_menu_entry.Enabled;
cut_popup_entry.Enabled:=cut_menu_entry.Enabled;
copy_popup_entry.Enabled:=copy_menu_entry.Enabled;
paste_popup_entry.Enabled:=paste_menu_entry.Enabled;
move_backwards_popup_entry.Enabled:=move_backwards_menu_entry.Enabled;
move_forwards_popup_entry.Enabled:=move_forwards_menu_entry.Enabled;
push_to_back_popup_entry.Enabled:=push_to_back_menu_entry.Enabled;
bring_to_front_popup_entry.Enabled:=bring_to_front_menu_entry.Enabled;
combine_popup_entry.Enabled:=combine_menu_entry.Enabled;
split_popup_entry.Enabled:=split_menu_entry.Enabled;
set_custom_popup_entry.Enabled:=split_menu_entry.Enabled;
end;
end;//with form
end;
//______________________________________________________________________________
procedure Tdtp_form.UserSettingsFromDocument;
begin
FPrintQuality:=integer(dtp_document.PrintQuality);
FRenderDPI:=dtp_document.RenderDPI;
FResampleMethod:=integer(dtp_document.Quality);
FMultiSelectMethod:=integer(dtp_document.MultiSelectMethod);
FRenderAtScreenRes:=dtp_document.RenderAtScreenRes;
FPerformance:=integer(dtp_document.Performance);
end;
//______________________________________________________________________________
procedure Tdtp_form.UserSettingsToDocument;
begin
dtp_document.PrintQuality:=TPrintQualityType(FPrintQuality);
dtp_document.RenderDPI:=FRenderDPI;
dtp_document.Quality:=TStretchFilter(FResampleMethod);
dtp_document.MultiSelectMethod:=TMultiSelectMethodType(FMultiSelectMethod);
dtp_document.RenderAtScreenRes:=FRenderAtScreenRes;
dtp_document.Performance:=TdtpDocPerformanceType(FPerformance);
end;
//______________________________________________________________________________
procedure Tdtp_form.FormMouseWheelDown(Sender:TObject; Shift:TShiftState; MousePos:TPoint; var Handled:Boolean);
begin
Handled:=True;
if panning_form.scroll_option_button.Checked=True
then dtp_document.ZoomOut
else dtp_document.ZoomIn;
update_model_rulers;
end;
//______________________________________________________________________________
procedure Tdtp_form.FormMouseWheelUp(Sender:TObject; Shift:TShiftState; MousePos:TPoint; var Handled:Boolean);
begin
Handled:=True;
if panning_form.scroll_option_button.Checked=True
then dtp_document.ZoomIn
else dtp_document.ZoomOut;
update_model_rulers;
end;
//_____________________________________________________
procedure dtp_form_resize;
// page rulers are on individual panels, on the dtp_doc_panel, and are handled by the dtp_document.
// model rulers are directly on the form, handled by this unit.
// hide_panel is on top of rulers.
// mods 14-07-2011 -- top moved down 28 to make room for tool button row.
// mods 211b 9-10-2014 28 replaced with (top_panel.Height+1) for dpi-aware (form is not scaled).
var
page_ruler_offset,model_ruler_offset:integer;
begin
with dtp_form do begin
model_ruler_offset:=0;
if show_model_rulers=True then model_ruler_offset:=26;
page_ruler_offset:=0;
if show_page_rulers=True then page_ruler_offset:=26;
dtp_doc_panel.Top:=top_panel.Height+1;
dtp_doc_panel.Width:=dtp_form.ClientWidth-model_ruler_offset;
dtp_doc_panel.Height:=dtp_form.ClientHeight-model_ruler_offset-(top_panel.Height+1);
dtp_document.Left:=page_ruler_offset;
dtp_document.Top:=page_ruler_offset;
dtp_document.Width:=dtp_doc_panel.Width-page_ruler_offset;
dtp_document.Height:=dtp_doc_panel.Height-page_ruler_offset;
model_ruler_right.Left:=dtp_doc_panel.Width;
model_ruler_bottom.Top:=dtp_doc_panel.Height+(top_panel.Height+1);
model_ruler_right.Height:=dtp_document.Height;
model_ruler_bottom.Width:=dtp_document.Width;
model_ruler_right.Top:=page_ruler_offset+(top_panel.Height+1)-1; // -1 by experiment
model_ruler_bottom.Left:=page_ruler_offset-1; // -1 by experiment
corner_grip.Left:=ClientWidth-20; // 211b
corner_grip.Top:=ClientHeight-20;
//out 206d dtp_document.ZoomWidth;
end;//with
update_model_rulers;
end;
//______________________________________________________________________________
procedure Tdtp_form.FormResize(Sender: TObject);
begin
dtp_form_resize;
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 (export_black_white=True) or (colour=virtual_black_colour)
then begin
RESULT:=clBlack;
EXIT;
end;
if export_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 export_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; // 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 - hatched?
sb_track_bgnd_colour:=clWhite; // 206a
sb_diagram_colour:=clWhite; // 209c
end
else begin
// calc grey shades if wanted...
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 swap_line_to(on_canvas:TCanvas; canvas_height,Xin,Yin:integer);
// swap X and Y for drawing on sketchboard instead of printer...
begin
on_canvas.LineTo(Yin,canvas_height-Xin);
end;
//____________________________
procedure swap_move_to(on_canvas:TCanvas; canvas_height,Xin,Yin:integer);
begin
on_canvas.MoveTo(Yin,canvas_height-Xin);
end;
//____________________________
procedure swap_text_out(on_canvas:TCanvas; canvas_height,Xin,Yin:integer; str:string);
begin
on_canvas.TextOut(Yin,canvas_height-Xin,str);
end;
//____________________________
procedure swap_rectangle(on_canvas:TCanvas; canvas_height,X1in,Y1in,X2in,Y2in:integer);
begin
on_canvas.Rectangle(Y1in, canvas_height-X2in, Y2in, canvas_height-X1in);
end;
//____________________________
procedure swap_polygon(on_canvas:TCanvas; canvas_height:integer; corners:array of TPoint; num_points:integer);
var
n:integer;
Xin,Yin:integer;
begin
for n:=0 to num_points-1 do begin
Xin:=corners[n].X; Yin:=corners[n].Y;
corners[n].X:=Yin; corners[n].Y:=canvas_height-Xin;
end;//next corner
on_canvas.Polygon(Slice(corners,num_points));
end;
//______________________________
procedure swap_ellipse(on_canvas:TCanvas; canvas_height,X1in,Y1in,X2in,Y2in:integer);
begin
on_canvas.Ellipse(Y1in, canvas_height-X2in, Y2in, canvas_height-X1in);
end;
//__________________________________________________________________________________________
procedure do_text_out(on_canvas:TCanvas; canvas_height,textoutX,textoutY:integer; str:string);
// blank text backgrounds, swapped X,Y for sketchboard
var
text_rect:TRect;
begin
with on_canvas do begin
text_rect.Left:=textoutY;
text_rect.Top:=canvas_height-textoutX;
text_rect.Right:=text_rect.Left+TextWidth(str);
text_rect.Bottom:=text_rect.Top+TextHeight(str);
Brush.Color:=clWhite;
Brush.Style:=bsSolid;
FillRect(text_rect);
end;//with
swap_text_out(on_canvas,canvas_height,textoutX,textoutY,str);
end;
//______________________________________________________________________________
procedure do_sb_draw(on_canvas:TCanvas; canvas_width,canvas_height,output_code:integer); // draw control template or entire pad on a bitmap or metafile.
// output_code 1=sketchboard bitmap, 2=sketchboard metafile, 3=create image file, 4=create EMF file
var
infill_points:array[0..3] of TPoint; // array of corners for infilled timbers.
gridx, gridy, now_gridx, now_gridy:extended;
grid_label:extended;
grid_now_dots:integer;
aq, rail, now, dots_index, mark_code:integer;
p1,p2,p3,p4:Tpoint;
radcen_arm:extended;
move_to, line_to: TPoint;
l_dims_valid:boolean;
w_dims_valid: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 units
grid_label_str:string;
sb_draw_page_size:Tpex;
img_bgnd_colour:TColor; // 206a
/////////////////////////////
procedure draw_marks(grid_left,grid_top:extended; rail_joints:boolean);
// if rail_joints=True draw only the rail joints, otherwise omit them.
var
i:integer;
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 on_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..
if rail_joints=(mark_code<>6) then CONTINUE; // do only the rail joints if rail_joints=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 ((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.
then begin
if ((mark_code=5) or (mark_code=55) or (mark_code=95)) and (out_factor<>1.0) then CONTINUE; // reduced ends are meaningless if not full-size.
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 export_black_white=True
then Pen.Color:=clBlack
else case mark_code of
1,101: Pen.Color:=printguide_colour; // guide marks. switch drive
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; // timber centre-lines.
5,55,95: Pen.Style:=psDot; // 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?).
else begin
Pen.Width:=1;
Pen.Style:=psSolid;
end;
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.)
// pdf if impact>0 then Pen.Width:=1; // overide for impact printer or plotter.
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
swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_line_to(on_canvas,canvas_height,line_to.X, line_to.Y);
end;
end;
// no timber numbering
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 swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y); swap_line_to(on_canvas,canvas_height,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 swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y); swap_line_to(on_canvas,canvas_height,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 export_black_white=True
then Brush.Color:=clBlack
else Brush.Color:=printtimber_infill_colour;
case print_timb_infill_style of
0: CONTINUE;
1: Brush.Style:=bsFDiagonal; // hatched. Forward diagonal for the foreground (control template).
2: Brush.Style:=bsDiagCross;
3: if export_black_white=True
then CONTINUE // 209c now no fill was Brush.Style:=bsFDiagonal
else Brush.Style:=bsSolid;
4: begin // blank.
Brush.Style:=bsSolid;
Brush.Color:=clWhite; // overide.
end;
else CONTINUE;
end;//case
swap_polygon(on_canvas,canvas_height,infill_points,4);
end;
end;
end;
end;//next mark i
// finally overdraw timber infill for shoved colours 226a
if (rail_joints=False) and (Length(current_shoved_timbers)>0) and (no_timbering=False) // 227d
and (timber_fill_overdraw_generated=True) // 227d
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
if shoved_mod_infill.shoved_number_str='' then CONTINUE; // 227e timber didn't get drawn
with shoved_mod_infill do begin
if (shove_data.sv_use_ocol=True) and (shove_data.sv_export=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
swap_polygon(on_canvas,canvas_height,infill_points,4);
end;//ckeck limits
end;//use ocol
end;//with
end;//with
end;//next
end;//if any
// 226a end
end;//with on_canvas
end;
///////////////////////////////
function get_w_dots(q,n:integer):integer;
begin
with sheet[0,0] 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[0,0] 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 on_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
swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_line_to(on_canvas,canvas_height,line_to.X, line_to.Y);
end;
move_to:=line_to;
end;//for
end;//with on_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);
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 on_canvas do begin
Pen.Color:=blank; // first blank across..
swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_line_to(on_canvas,canvas_height,line_to.X, line_to.Y);
Pen.Color:=edge; // then restore the corner points..
swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_line_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_move_to(on_canvas,canvas_height,line_to.X, line_to.Y);
swap_line_to(on_canvas,canvas_height,line_to.X, line_to.Y);
end;//with
end;
end;
end;
//%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
begin
with on_canvas do begin
if (rail=16) or (rail=20) // 0.93.a platforms
then Pen.Color:=printplat_edge_colour
else Pen.Color:=printcurail_colour;
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; // ???
//out 18-8-01 0.73.a if ((start+1)<=now_max) and (now_max>1) then drawn_full_aq1:=False; // ok to overdraw planing.
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 (rail=16) or (rail=20) // 0.93.a platforms
then begin
Brush.Color:=printplat_infill_colour;
case print_platform_infill_style of
0: Brush.Style:=bsClear;
1: Brush.Style:=bsBDiagonal; // hatched. backward diagonal (forward diagonal on control template timbers).
2: Brush.Style:=bsDiagCross;
3: if (export_black_white=True) or (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;
if dots_index>2
then begin
swap_polygon(on_canvas,canvas_height,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)
end;//case
end;
// 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 on_canvas do begin
Pen.Color:=blank; // first blank across..
swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_line_to(on_canvas,canvas_height,line_to.X, line_to.Y);
Pen.Color:=edge; // then restore the corner points..
swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_line_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_move_to(on_canvas,canvas_height,line_to.X, line_to.Y);
swap_line_to(on_canvas,canvas_height,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 on_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;
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
swap_polygon(on_canvas,canvas_height,dots,dots_index+1);
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)
end;//case
end;
// 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 on_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[0,0] 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 on_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 swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y); swap_line_to(on_canvas,canvas_height,line_to.X, line_to.Y); end;
end;//with
end;
end;
////////////////////////////////////////////////////////////
procedure outline_railends; // draw the rail ends in outline mode.
begin
if 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;
///////////////////////////////////////////////////////////////////
begin
grid_label:=0; // keep the compiler happy.
diagram_partials_omitted:=False; // init 226c
print_colours_setup; // first set up the colours.
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.
// output_code 1=sketchboard bitmap, 2=sketchboard metafile, 3=create image file, 4=create EMF file
case output_code of
1: if dtp_settings_form.raster_trackplan_bgnd_checkbox.Checked=True
then img_bgnd_colour:=dtp_settings_form.sb_page_colour_panel.Color // use the page colour
else img_bgnd_colour:=export_form.img_bgnd_colour_panel.Color; // use same as image export
3: img_bgnd_colour:=export_form.img_bgnd_colour_panel.Color; // export bitmap image file
else img_bgnd_colour:=clWhite;
end;//case
if page_info(False,True,True,output_code)=False
then EXIT;
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<1000{500} do gridx:=gridx*2; // 10mm (was 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.
slow_run:=0; // cancel any slow-running.
control_room_form.run_slow_menu_entry.Checked:=False;
with sheet[0,0] do begin
if empty=True then EXIT; //CONTINUE;
with on_canvas do begin
Font.Assign(print_labels_font); // for labels
Brush.Style:=bsSolid;
case output_code of
1,3: begin // bitmaps
Brush.Color:=img_bgnd_colour;
FillRect(Rect(0,0,printer_length_indexmax_dots,printer_width_indexmax_dots)); // swap X,Y for sketchboard
end;
else Brush.Color:=clWhite; // metafiles
end;//case
if pad_form.grid_in_front_of_shapes_menu_entry.Checked=True then export_bgnd_shapes(on_canvas,canvas_height,grid_left,grid_top,output_code); // first print all background shapes if wanted behind the grid.
// draw grid...
Font.Assign(print_labels_font);
if output_code=1 // sketchboard track plan as bitmap
then Font.Height:=0-Round(7*Font.Size*track_bmp_dpi/72); // 7* arbitrary trial and error
if output_code=2 // sketchboard track plan as metafile
then Font.Height:=0-Round(7*Font.Size*metafile_dpi/72);
if output_code=3 // track plan as an image file
then Font.Height:=0-Round(7*Font.Size*create_image_dpi/72);
if output_code=4 // track plan as EMF file
then Font.Height:=0-Round(7*Font.Size*metafile_dpi/72);
if ABS(Font.Height)<2 then Font.Height:=0-2; // dots
if (((output_code=1) or (output_code=2)) and (dtp_settings_form.include_grid_checkbox.Checked=True)) // 0.93.a
or (((output_code=3) or (output_code=4)) and (export_form.export_include_grid_checkbox.Checked=True))
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;
pen_width:=1; // must be 1 for dots.
end
else begin
Pen.Style:=psSolid;
pen_width:=printgrid_wide;
if pen_width<1 then pen_width:=1;
end;
// draw horizontal grid lines (across width)...
if 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 grid_now_dots>page_bottom_dots then BREAK; // 0.93.a remove unwanted extra line
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 swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y); swap_line_to(on_canvas,canvas_height,line_to.X, line_to.Y); end;
// 0.93.a option to omit grid labels on sketchbook ...
if (((output_code=1) or (output_code=2)) and (dtp_settings_form.include_grid_labels_checkbox.Checked=True)) // for sketchboard
or (((output_code=3) or (output_code=4)) and (export_form.export_include_grid_labels_checkbox.Checked=True))
then begin
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){+' '};
if (output_code=2) or (output_code=4) //metafile
then do_text_out(on_canvas,canvas_height,TextHeight('A')+60{left_blanking_dots},grid_now_dots-(TextWidth(grid_label_str) div 2),grid_label_str) // add labels.
else do_text_out(on_canvas,canvas_height,TextHeight('A')+6{left_blanking_dots},grid_now_dots-(TextWidth(grid_label_str) div 2),grid_label_str); // add labels.
end;
until 0<>0; // 0.93.a //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 grid_now_dots>page_right_dots then BREAK; // 0.93.a remove unwanted extra line
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 swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y); swap_line_to(on_canvas,canvas_height,line_to.X, line_to.Y); end;
// 0.93.a option to omit grid labels on sketchbook ...
if (((output_code=1) or (output_code=2)) and (dtp_settings_form.include_grid_labels_checkbox.Checked=True))
or (((output_code=3) or (output_code=4)) and (export_form.export_include_grid_labels_checkbox.Checked=True))
then begin
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){+' '};
if (output_code=2) or (output_code=4) // metafile
then do_text_out(on_canvas,canvas_height,grid_now_dots+(TextHeight('A') div 2),page_top_dots{-(printmargin_wide div 2)-halfmm_dots-TextHeight('A')}+40,grid_label_str) // add labels.
else do_text_out(on_canvas,canvas_height,grid_now_dots+(TextHeight('A') div 2),page_top_dots{-(printmargin_wide div 2)-halfmm_dots-TextHeight('A')}+4,grid_label_str); // add labels.
end;
until 0<>0; // 0.93.a grid_now_dots>page_right_dots;
// finally add the units string...
// 0.93.a option to omit grid labels on sketchboard ...
if (((output_code=1) or (output_code=2)) and (dtp_settings_form.include_grid_labels_checkbox.Checked=True))
or (((output_code=3) or (output_code=4)) and (export_form.export_include_grid_labels_checkbox.Checked=True))
then begin
if (output_code=2) or (output_code=4) // metafile
then do_text_out(on_canvas,canvas_height,TextHeight('A')+60{left_blanking_dots},page_top_dots{-(printmargin_wide div 2)-halfmm_dots-TextHeight('A')}+40,grid_str) // add the units string.
else do_text_out(on_canvas,canvas_height,TextHeight('A')+6{left_blanking_dots},page_top_dots{-(printmargin_wide div 2)-halfmm_dots-TextHeight('A')}+4,grid_str); // add the units string.
end;
Pen.Style:=psSolid; // reset in case of dotted.
end;//grid
// grid finished.
//----------------------------------------
if pad_form.grid_in_front_of_shapes_menu_entry.Checked=False then export_bgnd_shapes(on_canvas,canvas_height,grid_left,grid_top,output_code); // first print all background shapes if not already done.
export_bgnd(on_canvas,canvas_height,grid_left,grid_top,output_code); // now print any background templates.
// control template - draw timbers and all marks except rail joints...
if (print_entire_pad_flag=False)
and (output_diagram_mode=False) // 0.93.a no control template if diagram mode
and (turnoutx>0) // not if invalidated
then begin
if marks_list_ptr=nil then EXIT; //BREAK; // pointer to marks list not valid, exit all sheets.
draw_marks(grid_left,grid_top,False); // print all the background timbering and marks except rail joints.
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;
end
else begin
Pen.Color:=printcurail_colour;
// mods for track centre-lines 0.79.a ...
Pen.Width:=printcl_wide;
if Pen.Width<1 then Pen.Width:=1;
{end;}
if Pen.Width=1 then Pen.Style:=psDash
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 swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y); swap_line_to(on_canvas,canvas_height,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) ) // 226d
then begin
// draw turnout rails...
Pen.Width:=printrail_wide;
if Pen.Width<1 then Pen.Width:=1;
{end;}
if (rail_infill_i=0) // out for sb, 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
draw_fill_rail(1); // platforms and trackbed edges
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 swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y); swap_line_to(on_canvas,canvas_height,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 swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y); swap_line_to(on_canvas,canvas_height,line_to.X, line_to.Y); end;
move_to:=line_to;
end;//for
end;
end; // 226c
end;//polygon mode
// finally add rail joint marks across rails (will now mark over rail infill)...
draw_marks(grid_left,grid_top,True);
end;//if rails
end;// if control template
end;//with on_canvas
end;//with sheet
// 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 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 `0detail-mode`3 output.',
'','','','','','continue',0);
diagram_partial_msg_pref:=alert_box.preferences_checkbox.Checked;
alert_box.preferences_checkbox.Hide;
alert_box.preferences_checkbox.Tag:=0; // restore
end;
end;
//______________________________________________________________________________
procedure sb_draw(on_canvas:TCanvas; canvas_width,canvas_height,output_code:integer); // draw control template or entire pad on sketchboard or exports
// output_code 1=sketchboard bitmap, 2=sketchboard metafile, 3=create image file, 4=create EMF file
var
kludge_count:integer;
saved_extensions:boolean;
begin
saved_extensions:=False; // init
if (output_code=2) or (output_code=4) // metafiles (exact rectangle, no margin)...
then begin
export_limits:=True; // limit output to defined rectangle ...
min_export_x:=0; // dots
max_export_x:=canvas_width;
min_export_y:=0; // dots
max_export_y:=canvas_height;
end;
if classic_templot=False then store_and_background(False,True); // 0.93.a Quick mode - first store existing control template
if (print_settings_form.output_timber_extensions_checkbox.Checked=False) and (print_settings_form.output_timbering_checkbox.Checked=True) // 223d rebuild templates if necessary
then begin
saved_extensions:=outline_extensions;
if print_group_only_flag=True
then pad_form.remove_extensions_from_group_menu_entry.Click
else begin
pad_form.remove_extensions_from_all_menu_entry.Tag:=1; // flag no messages
pad_form.remove_extensions_from_all_menu_entry.Click;
end;
end;
if paper_bunching=True then cancel_paper_bunching; // don't want bunching in the export.
if output_diagram_mode=False
then kludge_count:=create_fb_kludge_templates // 0.94.a if any
else kludge_count:=0;
do_sb_draw(on_canvas,canvas_width,canvas_height,output_code); // draw control template or entire pad on a bitmap or metafile.
if kludge_count>0 then delete_fb_kludge_templates; // 0.94.a if any
export_limits:=False; // reset if necessary afterwards for global limits checking only
if saved_extensions=True then pad_form.restore_timber_extension_marks_menu_entry.Click; // 223d
end;
//______________________________________________________________________________
procedure export_bgnd_shapes(on_canvas:TCanvas; canvas_height:integer; grid_left,grid_top:extended; output_code:integer); // print all background shapes.
var
i,maxbg_index:integer;
font_size:integer;
arm,diamond:extended;
now_shape:Tbgnd_shape;
move_to,line_to:TPoint;
raster_rect:TRect;
begin
if print_settings_form.output_bgnd_shapes_checkbox.Checked=False then EXIT;
maxbg_index:=bgnd_form.bgnd_shapes_listbox.Items.Count-1;
if maxbg_index<0 then EXIT;
with on_canvas do begin
// label shapes..
Font.Assign(shapes_label_font);
Font.Color:=printshape_colour;
// output_code 1=sketchboard bitmap, 2=sketchboard metafile, 3=create image file, 4=create EMF file
// *3 arbitrary for typical non-100% use ...
case output_code of
1: Font.Height:=0-Round(3*Font.Size*track_bmp_dpi/72); // sketchboard bitmap
2,4: Font.Height:=0-Round(3*Font.Size*metafile_dpi/72); // metafiles
3: Font.Height:=0-Round(3*Font.Size*create_image_dpi/72); // export bitmap
end;//case
Pen.Mode:=pmCopy;
for i:=0 to maxbg_index do begin
Pen.Style:=psSolid;
Pen.Color:=printshape_colour; // it changes for a label or monochrome picture.
Pen.Width:=printshape_wide; // it changes for a picture border and label border.
now_shape:=Tbgshape(bgnd_form.bgnd_shapes_listbox.Items.Objects[i]).bgnd_shape; // next shape.
with now_shape do begin
if (hide_bits AND $02)<>0 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).
end;
1: begin
Brush.Color:=printtimber_infill_colour;
Brush.Style:=bsSolid; // blank out.
end;
2: begin
Brush.Color:=Pen.Color;
Brush.Style:=bsDiagCross; // cross-hatched.
swap_text_out(on_canvas,canvas_height,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; // dashed line.
end;
else begin
Brush.Color:=clWhite;
Brush.Style:=bsClear; // transparent.
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
// need to swap corners for swapped label rectangle...
line_to.Y:=move_to.Y+TextWidth(shape_name+' '); // add 3 spaces
line_to.X:=move_to.X-ABS(Font.Height*4 div 3); // arbitrary
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...
if (((output_code=1) or (output_code=2)) and (dtp_settings_form.include_picture_shapes_checkbox.Checked=True))
or (((output_code=3) or (output_code=4)) and (export_form.export_include_picture_shapes_checkbox.Checked=True))
then begin
try
// swap raster rectangle ...
raster_rect.Left:=move_to.Y;
raster_rect.Top:=canvas_height-line_to.X;
raster_rect.Right:=line_to.Y;
raster_rect.Bottom:=canvas_height-move_to.X;
if Tbgshape(bgnd_form.bgnd_shapes_listbox.Items.Objects[i]).bgnd_shape.picture_is_metafile=True
then begin
// metafile...
dtp_form.bgnd_shape_image.Picture.Graphic:=Tbgshape(bgnd_form.bgnd_shapes_listbox.Items.Objects[i]).bgimage.image_shape.image_metafile;
StretchDraw(raster_rect,dtp_form.bgnd_shape_image.Picture.Graphic); // needs TGraphic parameter to work reliably.
end
else begin // bitmap...
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.image_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.
swap_text_out(on_canvas,canvas_height,0,0,''); // !!! Delphi bug?
// TextOut obviously initialises some background mask property which I have been unable
// to find or set any other way.
end;
dtp_form.bgnd_shape_image.Picture.Graphic:=Tbgshape(bgnd_form.bgnd_shapes_listbox.Items.Objects[i]).bgimage.image_shape.image_bitmap;
StretchDraw(raster_rect,dtp_form.bgnd_shape_image.Picture.Graphic); // needs TGraphic parameter to work reliably.
CopyMode:=cmSrcCopy; // reset normal for destination Canvas.
end;//metafile/bitmap
// add a picture border if wanted... 205a
if (((output_code=1) or (output_code=2)) and (dtp_settings_form.include_picture_borders_checkbox.Checked=True))
or (((output_code=3) or (output_code=4)) and (export_form.export_include_picture_borders_checkbox.Checked=True))
then begin
Pen.Width:=printpicborder_wide;
Pen.Color:=printshape_colour;
Brush.Color:=clWhite;
Brush.Style:=bsClear;
swap_rectangle(on_canvas,canvas_height,move_to.X, move_to.Y, line_to.X, line_to.Y);
end;
except
CopyMode:=cmSrcCopy; // reset normal for destination Canvas.
Pen.Width:=1;
Pen.Color:=printshape_colour;
Brush.Color:=Pen.Color; // stretch failed - draw hatched outline.
Brush.Style:=bsBDiagonal;
swap_rectangle(on_canvas,canvas_height,move_to.X, move_to.Y, line_to.X, line_to.Y);
end;//try
end; //include pictures
end;//-1
0: begin
swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_line_to(on_canvas,canvas_height,line_to.X, line_to.Y);
end;
1: swap_rectangle(on_canvas,canvas_height,move_to.X, move_to.Y, line_to.X, line_to.Y);
2: swap_ellipse(on_canvas,canvas_height,move_to.X, move_to.Y, line_to.X, line_to.Y);
3: begin // label -- text first to avoid metafiles blanking over the box
swap_text_out(on_canvas,canvas_height,move_to.X,move_to.Y,' '+shape_name); // add 2 spaces
Brush.Color:=clWhite;
Brush.Style:=bsClear; // empty rectangle box over label text.
Pen.Color:=Font.Color;
Pen.Width:=ABS(Font.Height div 24); // arbitrary
if Pen.Width<1 then Pen.Width:=1;
swap_rectangle(on_canvas,canvas_height,move_to.X, move_to.Y, line_to.X, line_to.Y);
end;
end;//case
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
swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_line_to(on_canvas,canvas_height,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
swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_line_to(on_canvas,canvas_height,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
swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_line_to(on_canvas,canvas_height,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
swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_line_to(on_canvas,canvas_height,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
swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_line_to(on_canvas,canvas_height,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
swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_line_to(on_canvas,canvas_height,line_to.X, line_to.Y);
end;
end;
end;//with now_shape
end;//for next i
end;//with on_canvas
end;
//_______________________________________________________________________________________
procedure export_bgnd_marks(on_canvas:TCanvas; canvas_height:integer; grid_left,grid_top:extended; maxbg_index:integer; rail_joints:boolean); // print all the background timbering and marks.
// if rail_joints=True print only the rail joints, otherwise omit them.
var
i,n:integer;
move_to,line_to:TPoint;
p1,p2,p3,p4: TPoint;
now_keep:Tbgnd_keep;
now_ti:Ttemplate_info; // 227a
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;
begin
with on_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
if (use_print_mapping_colour=True)
and ( (mapping_colours_print=2) or (mapping_colours_print=3) )
and (export_black_white=False)
and (export_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 (export_black_white=False)
and (export_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,600..607: 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..
if rail_joints=(code<>6) then CONTINUE; // do only the rail joints if rail_joints=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 ((code=5) or (code=55) or (code=95)) and (out_factor<>1.0) then CONTINUE; // reduced ends are meaningless if not full-size.
if ((code=203) or (code=233) or (code=293)) and (i0) and (code<200) and (code<>99) ) // 223d
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?).
else Pen.Width:=1; // others not drawn.
end;//case
if Pen.Width<1 then Pen.Width:=1;
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
if Pen.Style<>psSolid then Pen.Width:=1; // delphi bug? (patterns only work for lines 1 dot wide.)
if export_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: Pen.Color:=printguide_colour; // guide marks. switch drive
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 swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y); swap_line_to(on_canvas,canvas_height,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 export_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 swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y); swap_line_to(on_canvas,canvas_height,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 swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y); swap_line_to(on_canvas,canvas_height,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 export_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;
1: Brush.Style:=bsBDiagonal; // hatched. Backward diagonal for the background templates.
2: Brush.Style:=bsDiagCross;
3: if (export_black_white=True) or (mapping_colours_print<0)
then CONTINUE // 209c now no fill was Brush.Style:=bsBDiagonal
else Brush.Style:=bsSolid;
4: begin // blank.
Brush.Style:=bsSolid;
Brush.Color:=clWhite; // overide.
end;
else CONTINUE;
end;//case
swap_polygon(on_canvas,canvas_height,infill_points,4);
end;
end;
// no timber numbering
end;//other codes
end;//next i background mark
// finally overdraw timber infill for shoved colours 226a
if (rail_joints=False) and (Length(now_ti.keep_shoved_timbers)>0) and (now_ti.keep_dims.turnout_info2.no_timbering_flag=False) // 227d
and (Ttemplate(keeps_list.Objects[n]).bgnd_timber_fill_overdraw_generated=True) // 227d
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
if shoved_mod_infill.shoved_number_str='' then CONTINUE; // 227e timber didn't get drawn
with shoved_mod_infill do begin
if (shove_data.sv_use_ocol=True) and (shove_data.sv_export=True) and (black_white=False) // 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
swap_polygon(on_canvas,canvas_height,infill_points,4);
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 on_canvas
end;
//__________________________________________________________________________________________
procedure export_bgnd(on_canvas:TCanvas; canvas_height:integer; grid_left,grid_top:extended; output_code:integer); // 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
cl_warning_shown:boolean; // 206a
this_one_platforms_trackbed:boolean; // 206b
this_one_trackbed_cess_ms:boolean; // 215a
this_one_trackbed_cess_ts:boolean; // 215a
bgnd_y_datum:extended; // 227c
kludge:boolean; //227c
////////////////////////////////////////////////////////////
procedure set_pen_railcolour; // 0.76.a 3-11-01.
begin
with on_canvas do begin
if export_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
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 // detail mode // 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, detail mode ...
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 on_canvas do begin
if blank_it=True
then Pen.Color:=blanking_colour
else set_pen_railcolour;
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
swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_line_to(on_canvas,canvas_height,line_to.X, line_to.Y);
end;
move_to:=line_to;
end;//next nk
end;//with on_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);
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 on_canvas do begin
Pen.Color:=blank; // first blank across..
swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_line_to(on_canvas,canvas_height,line_to.X, line_to.Y);
Pen.Color:=edge; // then restore the corner points..
swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_line_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_move_to(on_canvas,canvas_height,line_to.X, line_to.Y);
swap_line_to(on_canvas,canvas_height,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:=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:=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 on_canvas do begin
set_pen_railcolour;
Pen.Width:=printrail_wide;
if Pen.Width<1 then Pen.Width:=1;
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: Brush.Style:=bsClear;
1: Brush.Style:=bsFDiagonal; // hatched. forward diagonal (backward diagonal on bgnd template timbers).
2: Brush.Style:=bsDiagCross;
3: if (export_black_white=True) or (mapping_colours_print<0) // single colour
then Brush.Style:=bsFDiagonal
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(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 dots_index>2
then begin
swap_polygon(on_canvas,canvas_height,dots,dots_index+1);
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)
end;//case
end;
// 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 on_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 on_canvas do begin
Pen.Color:=blank; // first blank across..
swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_line_to(on_canvas,canvas_height,line_to.X, line_to.Y);
Pen.Color:=edge; // then restore the corner points..
swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_line_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_move_to(on_canvas,canvas_height,line_to.X, line_to.Y);
swap_line_to(on_canvas,canvas_height,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 on_canvas do begin
set_pen_railcolour;
Pen.Width:=printrail_wide;
if Pen.Width<1 then Pen.Width:=1;
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(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
if dots_index>4
then begin
swap_polygon(on_canvas,canvas_height,dots,dots_index+1);
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)
end;//case
end;
// 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 on_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 on_canvas do begin
set_pen_railcolour;
Pen.Width:=printrail_wide;
if Pen.Width<1 then Pen.Width:=1;
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 swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y); swap_line_to(on_canvas,canvas_height,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 (main rails)
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 on_canvas do begin
Pen.Color:=blank; // first blank across..
swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_line_to(on_canvas,canvas_height,line_to.X, line_to.Y);
Pen.Color:=edge; // then restore the corner points..
swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_line_to(on_canvas,canvas_height,move_to.X, move_to.Y);
swap_move_to(on_canvas,canvas_height,line_to.X, line_to.Y);
swap_line_to(on_canvas,canvas_height,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 then EXIT; // no data for straight stock rail
// if intarray_max(list_bgnd_rails[3,0])=0 then EXIT; // no data for curved stock rail
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 on_canvas do begin
set_pen_railcolour;
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 dots_index>2
then begin
swap_polygon(on_canvas,canvas_height,dots,dots_index+1);
// 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 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)
end;//case
end;
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
swap_move_to(on_canvas,canvas_height,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 swap_line_to(on_canvas,canvas_height,x_dots,y_dots);
end;
end;
end;//mark points
end;//with on_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.
cl_warning_shown:=False; // init 206a
if output_diagram_mode=False // first the timbering...
then begin
if (output_code>2) // not sketchboard
or (dtp_settings_form.include_track_checkbox.Checked=True)
then export_bgnd_marks(on_canvas,canvas_height,grid_left,grid_top,max_list_index,False); // 0.91.d if // first print all the background timbering and marks except rail joints.
end;
with on_canvas do begin
Pen.Mode:=pmCopy; // default
// or do all track backgrounds, if any ... 206a
if output_diagram_mode=True // mods 206a for track background
then begin
// first do track background as wide centre-lines // 206a
// output_code 1=sketchboard bitmap, 2=sketchboard metafile, 3=create image file, 4=create EMF file
if ( (output_code<3) and (dtp_settings_form.track_background_checkbox.Checked=True) ) // sketchboard
or ( (output_code>2) and (export_form.export_track_background_checkbox.Checked=True) ) // export image file
then begin
Pen.Mode:=pmCopy;
Pen.Style:=psSolid;
Pen.Color:=sb_track_bgnd_colour;
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 then CONTINUE; // 209c no track background for fb_kludge templates
if Ttemplate(keeps_list.Objects[n]).template_info.keep_dims.box_dims1.align_info.dummy_template_flag=True then CONTINUE; // 212a dummy templates not part of track plan
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???
Pen.Width:=Round(scaw_out*track_bgnd_width_in*box_dims1.proto_info.scale_pi*100/12); // scaw_out = dots per 1/100th mm. (at required output scaling).
if Pen.Width<1 then Pen.Width:=1;
end;//with
now_keep:=Ttemplate(keeps_list.Objects[n]).template_info.bgnd_keep; // next background keep.
with now_keep do begin
for aq:=24 to 25 do begin // use wide track centre-lines as track background
array_max:=intarray_max(list_bgnd_rails[aq,0]);
if array_max=0
then begin
if (aq=24) and (cl_warning_shown=False) // only checks main road in case plain track
then begin
ShowMessage('N.B. This trackplan contains one or more templates which have been created without track centre-lines.'
+#13+#13+'It is not possible to display a track background for these templates.');
cl_warning_shown:=True;
end;
CONTINUE; // empty rail.
end;
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 swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y); swap_line_to(on_canvas,canvas_height,line_to.X, line_to.Y); end;
move_to:=line_to;
end;//next nk
end;//next aq
end;//with now_keep
end;//next template
end;//backgrounds wanted
end;//diagram mode
// all done if he doesn't want the actual track (for sketchboard on print/PDF output?)...
if (output_code<3) // sketchboard
and (dtp_settings_form.include_track_checkbox.Checked=False)
then EXIT;
// 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 export_draw_symbols(on_canvas,canvas_height,now_ti.keep_symbols,0,1,grid_left,grid_top,bgnd_y_datum,output_code); // 227c draw the 0=dropper polyons over timbers
// 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 (export_black_white=False)
and (export_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 (export_black_white=False)
and (export_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; // now draw template in diagrammatic mode (main rails).
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;
Pen.Width:=printcl_wide;
if Pen.Width<1 then Pen.Width:=1;
if Pen.Width=1 then Pen.Style:=psDash
else 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 swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y); swap_line_to(on_canvas,canvas_height,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)
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;
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;
aq:=1;
if (intarray_max(list_bgnd_rails[aq,0])<>0) and (planing_end_aq1>0) { and (drawn_full_aq1=False)}
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 swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y); swap_line_to(on_canvas,canvas_height,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) { and (drawn_full_aq2=False)}
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 swap_move_to(on_canvas,canvas_height,move_to.X, move_to.Y); swap_line_to(on_canvas,canvas_height,line_to.X, line_to.Y); end;
move_to:=line_to;
end;//for
end;
end;//detail mode
end; // 226c
end;//polygon mode
end;//if rails
end;//with bgnd_keep
// add ID text, gaps and sticker symbols over the rails..
if kludge=False
then begin
export_draw_symbols(on_canvas,canvas_height,now_ti.keep_symbols,0,2,grid_left,grid_top,bgnd_y_datum,output_code); // 227c ID text over rails and platforms
export_draw_symbols(on_canvas,canvas_height,now_ti.keep_symbols,1,2,grid_left,grid_top,bgnd_y_datum,output_code); // 227a draw the 1=gaps
export_draw_symbols(on_canvas,canvas_height,now_ti.keep_symbols,2,2,grid_left,grid_top,bgnd_y_datum,output_code); // 227a draw the 2=stickers
end;
end;//for next n template
end;//with on_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 export_bgnd_marks(on_canvas,canvas_height,grid_left,grid_top,max_list_index,True);
end;
//________________________________________________________________________________________
procedure Tdtp_form.allow_trackplan_select_menu_entryClick(Sender:TObject);
var
i:integer;
begin
allow_trackplan_select_menu_entry.Checked:=True; // radio item
if dtp_document.ShapeCount<1 then EXIT;
for i:=0 to (dtp_document.ShapeCount-1) do begin
if check_track_plan(dtp_document.Shapes[i].Name)=True
then begin
dtp_document.Shapes[i].AllowSelect:=True;
BREAK;
end;
end;//next
end;
//______________________________________________________________________________
procedure Tdtp_form.prevent_trackplan_selection_menu_entryClick(Sender:TObject);
var
i:integer;
begin
prevent_trackplan_selection_menu_entry.checked:=True; // radio item
if dtp_document.ShapeCount<1 then EXIT;
for i:=0 to (dtp_document.ShapeCount-1) do begin
if check_track_plan(dtp_document.Shapes[i].Name)=True
then begin
dtp_document.Shapes[i].AllowSelect:=False;
BREAK;
end;
end;//next
end;
//______________________________________________________________________________
procedure Tdtp_form.allow_all_selected_menu_entryClick(Sender: TObject); // 0.98.a
var
i:integer;
begin
if dtp_document.ShapeCount<1 then EXIT;
for i:=0 to (dtp_document.ShapeCount-1) do begin
if check_track_plan(dtp_document.Shapes[i].Name)=False // not a trackplan
then dtp_document.Shapes[i].AllowSelect:=True;
end;//next
end;
//______________________________________________________________________________
procedure sb_update_all_items(on_add:boolean);
// relocate and scale all non-trackplan items after a change of trackplan
// called after a trackplan is inserted, but NOT if an existing one is moved or resized
// (user should combine items as required, or click button to update manually)
// if on_add=True, a replacement trackplan has been added. False=manual update button.
var
padx,pady,
new_this_x,
old_this_x,
new_this_y,
old_this_y:extended;
i:integer;
begin
if (on_add=True)
and (dtp_settings_form.auto_add_radiobutton.Checked=False) // auto add always updates
and (dtp_settings_form.manual_add_update_checkbox.Checked=False) // manual add update items not required
then EXIT;
update_model_rulers;
// update all sketchboard items if this is a new or modified trackplan...
if (trackplan_did_exist=True)
and ( (old_stretch_factor_wide<>stretch_factor_wide)
or (old_stretch_factor_high<>stretch_factor_high)
or (old_model_ruler_x_offset<>model_ruler_x_offset)
or (old_model_ruler_y_offset<>model_ruler_y_offset)
or (old_window_left<>dtp_form.dtp_document.WindowLeft)
or (old_window_top<>dtp_form.dtp_document.WindowTop) )
then begin
dtp_form.dtp_document.BeginUpdate; // otherwise ruler updates on every change.
with dtp_form.dtp_document.CurrentPage do begin
for i:=0 to (ShapeCount-1) do begin
if check_track_plan(Shapes[i].Name)=True then CONTINUE; // don't change this one or any other trackplans
if Tdtp_shape_tag(Shapes[i].Tag).no_update=True then CONTINUE; // or any items flagged not to be updated (e.g. titles text etc.)
padx:=(Shapes[i].DocLeft-old_window_left{dtp_form.dtp_document.WindowLeft})/old_stretch_factor_wide+old_model_ruler_x_offset;
pady:=0-((Shapes[i].DocTop-old_window_top{dtp_form.dtp_document.WindowTop})/old_stretch_factor_high+old_model_ruler_y_offset);
Shapes[i].DocLeft:=dtp_form.dtp_document.WindowLeft+(padx-model_ruler_x_offset)*stretch_factor_wide;
Shapes[i].DocTop:=dtp_form.dtp_document.WindowTop-(pady+model_ruler_y_offset)*stretch_factor_high;
Shapes[i].DocWidth:=Shapes[i].DocWidth*stretch_factor_wide/old_stretch_factor_wide;
Shapes[i].DocHeight:=Shapes[i].DocHeight*stretch_factor_high/old_stretch_factor_high;
if (TdtpShape(Shapes[i]) is TdtpPolygonShape)
then begin
TdtpPolygonShape(Shapes[i]).OutlineWidth:=TdtpPolygonShape(Shapes[i]).OutlineWidth*stretch_factor_high/old_stretch_factor_high;
end;
if (TdtpShape(Shapes[i]) is TdtpLineShape)
then begin
with TdtplineShape(Shapes[i]) do begin
LineWidth:=LineWidth*stretch_factor_high/old_stretch_factor_high;
Arrows[0].Width:=Arrows[0].Width*stretch_factor_high/old_stretch_factor_high;
Arrows[0].Length:=Arrows[0].Length*stretch_factor_high/old_stretch_factor_high;
Arrows[1].Width:=Arrows[1].Width*stretch_factor_high/old_stretch_factor_high;
Arrows[1].Length:=Arrows[1].Length*stretch_factor_high/old_stretch_factor_high;
end;//with
end;
if (TdtpShape(Shapes[i]) is TdtpPolygonMemo)
then begin
TdtpPolygonMemo(Shapes[i]).FontHeight:=TdtpPolygonMemo(Shapes[i]).FontHeight*stretch_factor_high/old_stretch_factor_high;
end;
end;//next i
end;//with
dtp_form.dtp_document.EndUpdate;
// reset for next time (e.g. manual update click) ...
old_stretch_factor_wide:=stretch_factor_wide;
old_stretch_factor_high:=stretch_factor_high;
old_model_ruler_x_offset:=model_ruler_x_offset;
old_model_ruler_y_offset:=model_ruler_y_offset;
old_window_left:=dtp_form.dtp_document.WindowLeft;
old_window_top:=dtp_form.dtp_document.WindowTop;
end;
end;
//______________________________________________________________________________
function check_tickboxes_valid(auto_add:boolean):boolean;
var
i:integer;
begin
RESULT:=False; // init
with dtp_settings_form do begin
if trackplan_fit_shapes_radiobutton.Checked=True // extent of background shapes
then begin
if bgnd_form.bgnd_shapes_listbox.Items.Count<1
then begin
alert(6,'php/215 fit trackplan boundary to background shapes',
'Fit trackplan boundary to background shapes.'
+'||No background shapes are currently defined.'
+'||Background shapes are added to the trackpad by clicking the `0BACKGROUND > SHAPES`1 menu item.'
+'||These can be the outlines of your baseboards or railway room, or a scanned guide image in a picture shape.| ',
'','','','','cancel','',0);
EXIT;
end;
end;
if (trackplan_boundary_rectangle_radiobutton.Checked=True) and (draw_export_rectangle_flag=False)
then begin
alert(6,'php/210 create trackplan from boundary rectangle',
'Create trackplan from boundary rectangle.'
+'||There is not currently a rectangle on the trackpad to mark the trackplan boundary.'
+'||Click the `0DRAW NEW RECTANGLE ON TRACKPAD`1 button to create one.'
+'||Or alternatively select the `0FIT ALL TEMPLATES`1 option instead.| ',
'','','','','cancel','',0);
EXIT;
end;
if ((manual_add_diagram_checkbox.Checked=True) and (auto_add=False))
or ((auto_update_diagram_checkbox.Checked=True) and (auto_add=True))
then begin
if include_control_template_radiobutton.Checked=True
then begin
repeat
i:=alert(6,'php/220 control template as trackplan',
'The `0IN DIAGRAM MODE`1 box is ticked to create a trackplan in diagram mode.'
+'||The control template can not be output in diagram mode.'
+'||Diagram mode is intended for background templates only, to display a track plan.| ',
'','','','? output mode - help','cancel','change to detail mode and continue',4);
if i=4 then alert_help(-300,output_mode_help_str,'');
until i<>4;
if i=5 then EXIT;
if auto_add=True
then auto_update_diagram_checkbox.Checked:=False
else manual_add_diagram_checkbox.Checked:=False;
end;
end;
if include_control_template_radiobutton.Checked=False
then begin
if any_bgnd<1
then begin
alert_no_bgnd;
EXIT; // no background templates
end;
end;
if include_group_only_radiobutton.Checked=True
then begin
if any_selected=0
then begin
if alert_no_group=True // alert him, and does he want all?
then EXIT;
end;
end;
print_entire_pad_flag:= NOT include_control_template_radiobutton.Checked;
print_group_only_flag:=include_group_only_radiobutton.Checked;
end;//with
RESULT:=True;
end;
//______________________________________________________________________________
procedure add_sb_track_plan_bitmap(by_dragging:boolean);
// default aspect ratio 13:9 , page 260mm x 180mm at 15 dots per mm = 3900 x 2700 pixels (381DPI)
var
dtp_track_bitmap:TBitmap; // (n.b. not TBitmap32)
dtp_track_shape_bmp:TdtpBitmapShape;
data_list:TStringList;
bitmap_width,bitmap_height:integer;
bmp_extents:Tpex; // mm
shape_extents:Textents;
save_print_pages_top_origin:extended;
save_print_pages_left_origin:extended;
save_out_factor:extended;
save_output_diagram_mode:boolean;
img_width_mm:extended;
img_height_mm:extended;
doc_width:extended;
doc_height:extended;
i:integer;
old_i:integer;
box_value:integer;
begin
print_now_bang:=False;
if check_tickboxes_valid(False)=False then EXIT;
with dtp_settings_form do begin
if sb_check_valid_int(trackplan_bitmap_width_edit,60,12000,box_value)=False // input limits 60 dots to 12000 dots (20" @ 600dpi)
then begin
ShowMessage('Error: The image width setting must be a valid whole number in the range 60 dots to 12000 dots.');
EXIT;
end;
try
bitmap_width:=box_value;
except
EXIT;
end;//try
// ready to go ...
Screen.Cursor:=crHourGlass; // needed for large images or slow systems
if trackplan_did_exist=True // save previous data before changes...
then begin
old_stretch_factor_wide:=stretch_factor_wide;
old_stretch_factor_high:=stretch_factor_high;
old_model_ruler_x_offset:=model_ruler_x_offset;
old_model_ruler_y_offset:=model_ruler_y_offset;
old_window_left:=dtp_form.dtp_document.WindowLeft;
old_window_top:=dtp_form.dtp_document.WindowTop;
end;
export_black_white:=trackplan_black_radiobutton.Checked;
export_grey_shade:=trackplan_grey_radiobutton.Checked;
save_print_pages_top_origin:=print_pages_top_origin;
save_print_pages_left_origin:=print_pages_left_origin;
save_out_factor:=out_factor;
save_output_diagram_mode:=output_diagram_mode;
out_factor:=1.0; // always 100% for exports
output_diagram_mode:=manual_add_diagram_checkbox.Checked;
// get boundary rectangle...
if trackplan_fit_all_radiobutton.Checked=True
then begin
bmp_extents:=get_fit_all_templates_size_mm((NOT print_entire_pad_flag),print_entire_pad_flag,print_group_only_flag);
print_pages_top_origin:=0-10*scale; // mm 10ft scale margin
print_pages_left_origin:=0-10*scale;
img_width_mm:=bmp_extents.x+20*scale; // 2 10ft margins
img_height_mm:=bmp_extents.y+20*scale;
end
else begin
if trackplan_fit_shapes_radiobutton.Checked=True // extent of background shapes
then begin
shape_extents:=get_fit_all_shapes_size_mm(False,True); // True = ignore any shapes hidden on output
print_pages_top_origin:=shape_extents.min.x-10*scale; // 10ft scale margin
print_pages_left_origin:=shape_extents.min.y-10*scale;
img_width_mm:=shape_extents.max.x-shape_extents.min.x+20*scale; // 2 10ft margins
img_height_mm:=shape_extents.max.y-shape_extents.min.y+20*scale;
end
else begin // drawn image boundary rectangle
if output_rectangle_x10
then begin
i:=0;
while i-1
then dtp_document.CurrentPage.ShapeInsert(old_i,dtp_track_shape_bmp) // replace previous trackplan in Z-order
else dtp_document.CurrentPage.ShapeAdd(dtp_track_shape_bmp); // no previous trackplan
update_model_rulers; // get new stretch factors
// update all items for the new trackplan..
if trackplan_did_exist=True
then sb_update_all_items(True)
else begin // first add of a trackplan, init ...
old_stretch_factor_wide:=stretch_factor_wide;
old_stretch_factor_high:=stretch_factor_high;
old_model_ruler_x_offset:=model_ruler_x_offset;
old_model_ruler_y_offset:=model_ruler_y_offset;
old_window_left:=dtp_document.WindowLeft;
old_window_top:=dtp_document.WindowTop;
end;
trackplan_did_exist:=True; // it does now, for next time
end;
finally
data_list.Free;
dtp_track_bitmap.Free;
end;//try
end;//with form
// restore for user
print_pages_top_origin:=save_print_pages_top_origin;
print_pages_left_origin:=save_print_pages_left_origin;
out_factor:=save_out_factor;
output_diagram_mode:=save_output_diagram_mode;
Screen.Cursor:=crDefault;
end;
//______________________________________________________________________________
procedure add_sb_track_plan_metafile(by_dragging,auto_add:boolean);
var
this_metafile:TMetafile;
metafile_canvas:TMetaFileCanvas;
dtp_track_shape_emf:TdtpExposedMetafile;
emf_stream:TMemoryStream;
data_list:TStringList;
emf_extents:Tpex; // mm
shape_extents:Textents;
save_print_pages_top_origin:extended;
save_print_pages_left_origin:extended;
save_out_factor:extended;
save_output_diagram_mode:boolean;
img_width_mm:extended;
img_height_mm:extended;
doc_width:extended;
doc_height:extended;
i:integer;
old_i:integer;
box_value:extended;
begin
print_now_bang:=False;
if check_tickboxes_valid(auto_add)=False then EXIT;
with dtp_settings_form do begin
if sb_check_valid_float(trackplan_metafile_dpi_edit,50,4800,box_value)=False // input limits 50dpi to 4800dpi
then begin
ShowMessage('Error: The DPI setting must be a valid number in the range 50 to 4800.');
EXIT;
end;
try
metafile_dpi:=box_value;
except
EXIT;
end;//try
// ready to go ...
Screen.Cursor:=crHourGlass; // needed for large images or slow systems
if trackplan_did_exist=True // save previous data before changes...
then begin
old_stretch_factor_wide:=stretch_factor_wide;
old_stretch_factor_high:=stretch_factor_high;
old_model_ruler_x_offset:=model_ruler_x_offset;
old_model_ruler_y_offset:=model_ruler_y_offset;
old_window_left:=dtp_form.dtp_document.WindowLeft;
old_window_top:=dtp_form.dtp_document.WindowTop;
end;
export_black_white:=trackplan_black_radiobutton.Checked;
export_grey_shade:=trackplan_grey_radiobutton.Checked;
save_print_pages_top_origin:=print_pages_top_origin;
save_print_pages_left_origin:=print_pages_left_origin;
save_out_factor:=out_factor;
save_output_diagram_mode:=output_diagram_mode;
out_factor:=1.0; // always 100% for exports and sketchboard
if auto_add=True
then output_diagram_mode:=auto_update_diagram_checkbox.Checked
else output_diagram_mode:=manual_add_diagram_checkbox.Checked;
// get boundary rectangle...
if trackplan_fit_all_radiobutton.Checked=True
then begin
emf_extents:=get_fit_all_templates_size_mm((NOT print_entire_pad_flag),print_entire_pad_flag,print_group_only_flag);
print_pages_top_origin:=0-10*scale; // mm 10ft scale margin
print_pages_left_origin:=0-10*scale;
img_width_mm:=emf_extents.x+20*scale; // 2 10ft margins
img_height_mm:=emf_extents.y+20*scale;
end
else begin
if trackplan_fit_shapes_radiobutton.Checked=True // extent of background shapes
then begin
shape_extents:=get_fit_all_shapes_size_mm(False,True); // True = ignore any shapes hidden on output
print_pages_top_origin:=shape_extents.min.x-10*scale; // 10ft scale margin
print_pages_left_origin:=shape_extents.min.y-10*scale;
img_width_mm:=shape_extents.max.x-shape_extents.min.x+20*scale; // 2 10ft margins
img_height_mm:=shape_extents.max.y-shape_extents.min.y+20*scale;
end
else begin // drawn image boundary rectangle
if output_rectangle_x10
then begin
i:=0;
while i-1
then dtp_document.CurrentPage.ShapeInsert(old_i,dtp_track_shape_emf) // replace previous trackplan in Z-order
else dtp_document.CurrentPage.ShapeAdd(dtp_track_shape_emf); // no previous trackplan
update_model_rulers; // get new stretch factors
// update all items for the new trackplan..
if trackplan_did_exist=True
then sb_update_all_items(True)
else begin // first add of a trackplan, init ...
old_stretch_factor_wide:=stretch_factor_wide;
old_stretch_factor_high:=stretch_factor_high;
old_model_ruler_x_offset:=model_ruler_x_offset;
old_model_ruler_y_offset:=model_ruler_y_offset;
old_window_left:=dtp_document.WindowLeft;
old_window_top:=dtp_document.WindowTop;
end;
trackplan_did_exist:=True; // it does now, for next time
end;
finally
data_list.Free;
this_metafile.Free;
emf_stream.Free;
end;//try
end;//with
// restore for user
print_pages_top_origin:=save_print_pages_top_origin;
print_pages_left_origin:=save_print_pages_left_origin;
out_factor:=save_out_factor;
output_diagram_mode:=save_output_diagram_mode;
Screen.Cursor:=crDefault;
end;
//______________________________________________________________________________
function check_track_plan(str:string):boolean;
begin
RESULT:=(Copy(str,1,10)='trackplan|'); // track plan identifier
end;
//______________________________________________________________________________
procedure Tdtp_form.push_trackplan_to_background_menu_entryClick(Sender:TObject);
var
i:integer;
begin
with dtp_document.CurrentPage do begin
if ShapeCount<1 then EXIT;
dtp_document.ClearSelection; //if any
for i:=0 to (ShapeCount-1) do begin
if check_track_plan(Shapes[i].Name)=True // track plan shape
then begin
Shapes[i].AllowSelect:=True; // temp allow
dtp_document.AddToSelection(Shapes[i]);
BREAK;
end;
end;//next
dtp_document.MoveToBackground;
dtp_document.ClearSelection;
for i:=0 to (ShapeCount-1) do begin
if check_track_plan(Shapes[i].Name)=True
then begin
Shapes[i].AllowSelect:=False;
BREAK;
end;
end;//next
end;//with
end;
//______________________________________________________________________________
procedure Tdtp_form.bring_trackplan_to_foreground_menu_entryClick(Sender:TObject);
var
i:integer;
begin
with dtp_document.CurrentPage do begin
if ShapeCount<1 then EXIT;
dtp_document.ClearSelection; //if any
for i:=0 to (ShapeCount-1) do begin
if check_track_plan(Shapes[i].Name)=True // track plan shape
then begin
Shapes[i].AllowSelect:=True; // temp allow
dtp_document.AddToSelection(Shapes[i]);
BREAK;
end;
end;//next
dtp_document.MoveToForeground;
dtp_document.ClearSelection;
for i:=0 to (ShapeCount-1) do begin
if check_track_plan(Shapes[i].Name)=True
then begin
Shapes[i].AllowSelect:=False;
BREAK;
end;
end;//next
end;//with
end;
//______________________________________________________________________________
procedure Tdtp_form.dtp_documentResize(Sender: TObject);
begin
update_model_rulers;
end;
//______________________________________________________________________________
procedure update_model_rulers;
var
i:integer;
model_factor,org_page_width,org_page_height:extended;
pad_pages_top,pad_pages_left:extended;
org_doc_left,org_doc_top,org_doc_width,org_doc_height:extended;
org_img_width,org_img_height:extended;
dummy:extended;
data_list:TStringList;
render_dpi:extended;
begin
// !!! we may be here from dtp_form.Create !!! Other forms may not yet have been created.
// !!! we may be here from dtp_form.Free !!! Other forms may no longer exist.
// !!! we may be here from dpi-aware startup adjustments 211b
if Application.Terminated=True then EXIT;
model_factor:=0; // keep compiler happy..
org_page_width:=0;
org_page_height:=0;
pad_pages_top:=0;
pad_pages_left:=0;
org_doc_left:=0;
org_doc_top:=0;
org_doc_width:=0;
org_doc_height:=0;
org_img_width:=0;
org_img_height:=0;
data_list:=TStringList.Create;
try
with dtp_form do begin
// only the first track plan found on page ...
with dtp_document.CurrentPage do begin
if ShapeCount>0
then begin
for i:=0 to (ShapeCount-1) do begin
if check_track_plan(Shapes[i].Name)=False then CONTINUE; // not a track plan
data_list.Text:=Shapes[i].Name;
try
dummy:=StrToFloat(data_list.Strings[1]); // print scaling from pad (now always 1.0 , not used)
org_page_width:=StrToFloat(data_list.Strings[2]); // original page size when added..
org_page_height:=StrToFloat(data_list.Strings[3]);
pad_pages_top:=StrToFloat(data_list.Strings[4]); // pad page origin mm..
pad_pages_left:=StrToFloat(data_list.Strings[5]);
pad_model_scale:=StrToFloat(data_list.Strings[6]); // model scale mm/ft
pad_model_gauge:=StrToFloat(data_list.Strings[7]); // track gauge mm
org_doc_left:=StrToFloat(data_list.Strings[8]); // not used
org_doc_top:=StrToFloat(data_list.Strings[9]); // not used
org_doc_width:=StrToFloat(data_list.Strings[10]);
org_doc_height:=StrToFloat(data_list.Strings[11]);
org_img_width:=StrToFloat(data_list.Strings[12]);
org_img_height:=StrToFloat(data_list.Strings[13]);
except
CONTINUE; // not valid
end;//try
// no negatives or division by zero..
if org_page_widthrender_dpi then dtp_document.RenderDPI:=render_dpi; // change it if not already
end;
// set globals for X,Y readout and printing...
model_ruler_x_offset:=model_ruler_bottom.Offset;
model_ruler_y_offset:=model_ruler_right.Offset;
// and pad drawing...
onpad_y_offset:=(0-Shapes[i].DocBottom)/stretch_factor_high-pad_pages_left;
onpad_x_offset:=(0-Shapes[i].DocLeft)/stretch_factor_wide+pad_pages_top;
trackplan_exists:=True;
EXIT;
end;//next
end;
end;//with
// no track plan or no valid dims...
model_ruler_right.ScreenDpm:=page_ruler_left.ScreenDpm;
model_ruler_bottom.ScreenDpm:=page_ruler_top.ScreenDpm;
model_ruler_right.Offset:=page_ruler_left.Offset-dtp_document.PageHeight;
model_ruler_bottom.Offset:=page_ruler_top.Offset;
stretch_factor_wide:=1.0;
stretch_factor_high:=1.0;
pad_model_scale:=5.5;
pad_model_gauge:=25.4;
trackplan_exists:=False;
end;//with form
finally
data_list.Free;
end;//try
end;
//______________________________________________________________________________
procedure Tdtp_form.dtp_documentUpdateScrollPosition(Sender: TObject);
begin
update_model_rulers;
end;
//______________________________________________________________________________
function this_dtpshape_not_wanted(str:string):boolean; // called from the renderer in dtpShape unit
begin
RESULT:=False; // init -- shape wanted
if check_track_plan(str)=False then EXIT; // not a trackplan
RESULT:=omit_trackplan_from_rendering;
end;
//______________________________________________________________________________
procedure do_dtp_form_hide; // 205e extracted from event (also called fom pad menu to show items).
var
trackplan_on_page:boolean;
i:integer;
begin
if edit_outline_form.Visible=True then edit_outline_form.edit_finish_button.Click; // remove any markers // 212a
dtp_settings_form.Hide;
sketchboard_form.Hide; // copyboard
dtp_settings_form.sb_ok_button.Click; // shrink tabs for next time
// set up for showing items on pad ...
try
if updating_now=True then EXIT;
with dtp_form do begin
if show_dtp_on_pad_checkbox.Checked=False then EXIT;
trackplan_on_page:=False; // init
if NOT assigned(dtp_document.CurrentPage) then EXIT;
dtp_document.ZoomPage; // needed to show items on pad -- calc from rulers.
update_model_rulers;
with dtp_document.CurrentPage do begin
for i:=0 to (ShapeCount-1) do begin
if check_track_plan(Shapes[i].Name)=True // track plan shape
then begin
trackplan_on_page:=True;
BREAK;
end;
end;//next
if trackplan_on_page=True
then begin
if dtp_settings_form.sb_use_pad_colour_checkbox.Checked=True
then PageColor:=paper_colour; // to match pad
end
else begin
alert(6,'php/565 no trackplan',
'You have selected the option to show sketchboard items on the trackpad, but there is currently no trackplan item on the sketchboard.'
+'||Templot is unable show sketchboard items on the trackpad if there is no trackplan reference available to set the scaled size.'
+'||To show items from the sketchboard on the trackpad, add a trackplan item to the sketchboard.',
'','','','','cancel','',0);
show_dtp_on_pad_checkbox.Checked:=False; // and untick it.
end;
end;//with
end;//with
finally
show_and_redraw(True,False); // refresh pad, no rollback.
end;//try
end;
//______________________________________________________________________________
procedure Tdtp_form.FormHide(Sender: TObject);
begin
do_dtp_form_hide; // 205e extracted from event (called fom pad menu to show items).
end;
//______________________________________________________________________________
procedure do_sb_activate;
var
i:integer;
begin
with dtp_form do begin
if dtp_settings_form.display_quality_radiobutton.Checked=True // 205a
then dtp_document.Quality:=sfLanczos // display quality slow
else dtp_document.Quality:=sfNearest; // design quality fast
dtp_document.CurrentPage.PageColor:=dtp_settings_form.sb_page_colour_panel.Color;
if sketchboard_trackplan_update_needed=True
then begin
sketchboard_trackplan_update_needed:=False; // once only, handshake -- set True when the pad activates.
if dtp_settings_form.auto_add_radiobutton.Checked=True
then begin
if (any_bgnd=0) or (classic_templot=False) then store_and_background(False,True); // 0.93.a Quick mode - first store existing control template
dtp_settings_form.allow_track_select_checkbox.Checked:=False; // don't allow it to be selected
add_sb_track_plan_metafile(False,True);
end;
end;
end;//with form
end;
//______________________________________________________________________________
procedure Tdtp_form.FormActivate(Sender: TObject);
begin
if go_sketchboard=True then do_sb_activate;
end;
//______________________________________________________________________________
procedure Tdtp_form.delete_trackplan_menu_entryClick(Sender:TObject);
// delete existing trackplan ...
var
i:integer;
begin
if dtp_document.CurrentPage.ShapeCount>0
then begin
i:=0;
while i'' then InitialDir:=ExtractFilePath(his_sb_pdf_file_name)
else InitialDir:=exe_str+'PDF-FILES\';
FileName:=remove_invalid_str('sketchboard_'+FormatDateTime('yyyy_mm_dd_hhmm_ss',Date+Time))+'.pdf';
Title:=' save PDF file as ...';
if Execute=False then EXIT;
his_sb_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;
sb_pdf_printer.FileName:=file_str;
end;//with
Screen.Cursor:=crHourGlass;
sb_pdf_dpi:=box_value;
sb_pdf_dpmm:=sb_pdf_dpi/25.4;
sb_pdf_width_dots:=Round(dtp_document.CurrentPage.PageWidth*sb_pdf_dpi/25.4);
sb_pdf_height_dots:=Round(dtp_document.CurrentPage.PageHeight*sb_pdf_dpi/25.4);
sb_dtp_rect.Left:=0;
sb_dtp_rect.Top:=0;
sb_dtp_rect.Right:=sb_pdf_width_dots;
sb_dtp_rect.Bottom:=sb_pdf_height_dots;
sb_pdf_printer.BeginDoc;
sb_pdf_printer.StartPage(sb_pdf_width_dots, sb_pdf_height_dots, sb_pdf_dpi, sb_pdf_dpi, 0);
try
omit_trackplan_from_rendering:=False; // include trackplan item in PDF
dtp_document.CurrentPage.Print(sb_pdf_printer.Canvas, sb_dtp_rect, sb_pdf_dpmm, 0,False,False);
sb_pdf_printer.EndPage;
sb_pdf_printer.EndDoc;
show_pdf_result(sb_pdf_printer.Filename,''); // 205a
except
ShowMessage('Sorry, an error occurred in creating the PDF file.');
end;//try
Screen.Cursor:=crDefault;
end;
//______________________________________________________________________________
procedure Tdtp_form.clear_dtp_menu_entryClick(Sender: TObject);
var
i:integer;
trackplan_type:integer; // 0=no trackplan, 1=metafile, 2=bitmap
metafile_trackplan:TdtpExposedMetafile;
bitmap_trackplan:TdtpBitmapShape;
begin
metafile_trackplan:=nil; // keep compiler happy.
bitmap_trackplan:=nil;
if (trackplan_exists=True) and (dtp_document.CurrentPage.ShapeCount<2)
then begin
alert(2,' clear sketchboard',
'There are no items on the sketchboard to be cleared.'
+'||To remove the trackplan from the sketchboard, click the EDIT > DELETE TRACKPLAN menu item.',
'','','','','cancel','',0);
EXIT;
end;
if (trackplan_exists=False) and (dtp_document.CurrentPage.ShapeCount<1)
then begin
alert(2,' clear sketchboard',
'There are no items on the sketchboard to be cleared.',
'','','','','cancel','',0);
EXIT;
end;
if trackplan_exists=True
then begin
i:=alert(7,' clear sketchboard',
'You are about to delete all items except the trackplan from the sketchboard.'
+'||If these items have not been saved to a sketchboard file they will be lost.'
+'||To remove the trackplan from the sketchboard, click the EDIT > DELETE TRACKPLAN menu item.',
'','','','save sketchboard','cancel','clear sketchboard',0);
if i=5 then EXIT;
if i=4
then begin
save_dtp_as_menu_entry.Click;
EXIT;
end;
end
else begin
i:=alert(7,' clear sketchboard',
'You are about to delete all items from the sketchboard.'
+'||If these items have not been saved to a sketchboard file they will be lost.',
'','','','save sketchboard','cancel','clear sketchboard',0);
if i=5 then EXIT;
if i=4
then begin
save_dtp_as_menu_entry.Click;
EXIT;
end;
end;
if dtp_document.CurrentPage.ShapeCount>0
then begin
// first save the trackplan ...
trackplan_type:=0; // init
i:=0;
while i0;
// put the trackplan back ...
case trackplan_type of
0: EXIT; // no trackplan
1: dtp_document.CurrentPage.ShapeAdd(metafile_trackplan);
2: dtp_document.CurrentPage.ShapeAdd(bitmap_trackplan);
end;//case
update_model_rulers;
end;// if any shapes
end;
//______________________________________________________________________________
procedure Tdtp_form.FormDeactivate(Sender: TObject);
begin
dtp_document.DoEditClose(True); // in case anything in progress (e.g. freehand drawing)
freehand_mode:=0;
Screen.Cursor:=crDefault;
end;
//______________________________________________________________________________
procedure Tdtp_form.file_menuClick(Sender: TObject);
// called by all menu items
begin
dtp_document.DoEditClose(True); // in case anything in progress (e.g. freehand drawing)
freehand_mode:=0;
Screen.Cursor:=crDefault;
show_page_margins_menu_entry.Checked:=dtp_document.ShowMargins;
show_grid_menu_entry.Checked:=(dtp_document.HelperMethod=hmGrid);
snap_to_guides_menu_entry.Checked:=dtp_document.SnapToGrid;
end;
//______________________________________________________________________________
procedure Tdtp_form.show_copyboard_menu_entryClick(Sender: TObject);
begin
if sketchboard_form.Showing=True
then sketchboard_form.Hide
else begin
sketchboard_form.Show;
sketchboard_form.BringTofront;
end;
end;
//______________________________________________________________________________
procedure Tdtp_form.zoom_rectangle_latching_toolbuttonClick(Sender:TObject);
var
zoom_rectangle:TdtpRectangleShape;
dtp_shape_tag:Tdtp_shape_tag;
begin
zoom_rectangle:=TdtpRectangleShape.Create;
SetPolygonShapeDefaults(zoom_rectangle);
with zoom_rectangle do begin
UseOutline:=False;
UseFill:=False;
AllowRotate:=False;
dtp_shape_tag:=Tdtp_shape_tag(Tag);
dtp_shape_tag.zooming_rectangle:=True; // dummy zooming rectangle
Tag:=integer(dtp_shape_tag);
end;//with
dtp_document.InsertShapeByDrag(zoom_rectangle);
end;
//______________________________________________________________________________
procedure export_screenshot(w,h:integer);
var
screen_rect,print_rect:TRect;
top_ruler_allowance:integer;
left_ruler_allowance:integer;
create_bitmap:TBitmap;
create_png:TPNGObject;
folder_str:string;
file_name_str:string; // name part
file_str:string; // including path
alert_str:string;
i:integer;
begin
if (w<1) or (h<1)
then alert_str:='make full screenshot image'
else alert_str:='make cropped screenshot image '+IntToStr(w)+' x '+IntToStr(h);
if alert(7,' make a sketchboard screenshot',
'This function makes an exact copy of the current sketchboard view, similar to using the Windows `0Print`2 `0Screen`2 key.'
+'||green_panel_begin tree.gif It is usually more useful to export an image file of your sketchboard contents, which will give much better image quality for display and publication.'
+'||To export an image file, cancel this and click the `0file > export image file ...`1 menu item instead.'
+'||The exported image size can be set on the sketchboard control panel `0settings`1 tab,|`0export file settings > bitmap width`1.green_panel_end',
'','','','','cancel',alert_str,0)=5 then EXIT;
with dtp_form do begin
if show_page_rulers=True
then begin
top_ruler_allowance:=page_ruler_top.Height;
left_ruler_allowance:=page_ruler_left.Width;
end
else begin
top_ruler_allowance:=0;
left_ruler_allowance:=0;
end;
screen_rect.Top:=dtp_doc_panel.Top+top_ruler_allowance;
screen_rect.Left:=dtp_doc_panel.Left+left_ruler_allowance;
if (w<1) or (h<1) // full screenshot
then begin
screen_rect.Right:=dtp_doc_panel.Left+dtp_doc_panel.Width-22; // 22 arbitrary to remove scrollbars
screen_rect.Bottom:=dtp_doc_panel.Top+dtp_doc_panel.Height-22; // ditto
end
else begin // specified w x h
screen_rect.Bottom:=screen_rect.Top+h;
screen_rect.Right:=screen_rect.Left+w;
end;
print_rect.Top:=0;
print_rect.Left:=0;
print_rect.Right:=screen_rect.Right-screen_rect.Left;
print_rect.Bottom:=screen_rect.Bottom-screen_rect.Top;
// mark crop outline on screen...
if (w<1) and (h<1) // full screenshot
then begin
crop_marker_left_panel.Visible:=False;
crop_marker_top_panel.Visible:=False;
crop_marker_right_panel.Visible:=False;
crop_marker_bottom_panel.Visible:=False;
end
else begin
crop_marker_left_panel.Top:=top_ruler_allowance;
crop_marker_right_panel.Top:=top_ruler_allowance;
crop_marker_top_panel.Left:=left_ruler_allowance-2;
crop_marker_bottom_panel.Left:=left_ruler_allowance;
crop_marker_left_panel.Height:=print_rect.Bottom+2; // +2 for neat corner.
crop_marker_right_panel.Height:=print_rect.Bottom+2; // +2 for neat corner.
crop_marker_top_panel.Width:=print_rect.Right+4;
crop_marker_bottom_panel.Width:=print_rect.Right;
crop_marker_left_panel.Left:=left_ruler_allowance-2;
crop_marker_right_panel.Left:=left_ruler_allowance+print_rect.Right;
crop_marker_top_panel.Top:=top_ruler_allowance-2;
crop_marker_bottom_panel.Top:=top_ruler_allowance+print_rect.Bottom;
crop_marker_left_panel.Visible:=True;
crop_marker_top_panel.Visible:=True;
crop_marker_right_panel.Visible:=True;
crop_marker_bottom_panel.Visible:=True;
end;
end;//with
file_name_str:=remove_invalid_str('sketch_screenshot'+FormatDateTime('_yyyy_mm_dd_hhmm_ss',Date+Time));
with pad_form.save_screenshot_dialog do begin
if his_image_file_name<>'' then InitialDir:=ExtractFilePath(his_image_file_name)
else InitialDir:=exe_str+'IMAGE-FILES\';
DefaultExt:='png';
FileName:=file_name_str+'.png';
if Execute=False then EXIT;
his_image_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
end;//with
Screen.Cursor:=crHourGlass; // needed for large images or slow systems
create_bitmap:=TBitmap.Create;
create_png:=TPNGObject.Create;
try
create_bitmap.Width:=print_rect.Right;
create_bitmap.Height:=print_rect.Bottom;
try
create_bitmap.Canvas.CopyMode:=cmSrcCopy;
create_bitmap.Canvas.CopyRect(print_rect,dtp_form.Canvas,screen_rect);
create_png.Assign(create_bitmap);
create_png.SaveToFile(file_str);
repeat
i:=alert(2,' screenshot image file created',
'The screenshot image file was created successfully:||`0'+file_str+'`f'
+'||Click view image in Templot to see it.',
'','view image in Templot','view image in your usual image viewer','open the containing folder','','continue',0);
if i=2 then show_an_image_file(file_str);
if i=3
then begin
folder_str:=file_str;
if ShellExecute(0,'open',PChar(folder_str),nil,nil,SW_SHOWNORMAL)<=32
then ShowMessage('Sorry, unable to display the image.')
else external_window_showing:=True;
end;
if i=4
then begin
folder_str:=ExtractFilePath(file_str);
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;
until ((i<>2) or (FileExists(file_str)=False)); // may be deleted in image viewer
except
ShowMessage('Sorry, an error occurred in creating the screenshot image file.');
end;//try
finally
create_png.Free;
create_bitmap.Free;
end;//try
Screen.Cursor:=crDefault;
end;
//______________________________________________________________________________
procedure Tdtp_form.sb_export_screenshot_menu_entryClick(Sender: TObject);
begin
export_screenshot(0,0); // default full screenshot
end;
//______________________________________________________________________________
procedure Tdtp_form.push_trackplan_backwards_menu_entryClick(Sender: TObject);
var
i:integer;
begin
with dtp_document.CurrentPage do begin
if ShapeCount<1 then EXIT;
dtp_document.ClearSelection; //if any
for i:=0 to (ShapeCount-1) do begin
if check_track_plan(Shapes[i].Name)=True // track plan shape
then begin
Shapes[i].AllowSelect:=True; // temp allow
dtp_document.AddToSelection(Shapes[i]);
BREAK;
end;
end;//next
dtp_document.MoveBack;
dtp_document.ClearSelection;
for i:=0 to (ShapeCount-1) do begin
if check_track_plan(Shapes[i].Name)=True
then begin
Shapes[i].AllowSelect:=False;
BREAK;
end;
end;//next
end;//with
end;
//______________________________________________________________________________
procedure Tdtp_form.pull_trackplan_forwards_menu_entryClick(Sender: TObject);
var
i:integer;
begin
with dtp_document.CurrentPage do begin
if ShapeCount<1 then EXIT;
dtp_document.ClearSelection; //if any
for i:=0 to (ShapeCount-1) do begin
if check_track_plan(Shapes[i].Name)=True // track plan shape
then begin
Shapes[i].AllowSelect:=True; // temp allow
dtp_document.AddToSelection(Shapes[i]);
BREAK;
end;
end;//next
dtp_document.MoveFront;
dtp_document.ClearSelection;
for i:=0 to (ShapeCount-1) do begin
if check_track_plan(Shapes[i].Name)=True
then begin
Shapes[i].AllowSelect:=False;
BREAK;
end;
end;//next
end;//with
end;
//______________________________________________________________________________
procedure add_sb_formatted_txt_metafile;
var
dtp_formatted_text_shape_emf:TdtpExposedMetafile;
formatted_txt_metafile:TMetafile;
formatted_txt_metafile_canvas:TMetaFileCanvas;
emf_stream,rvf_stream,data_stream:TMemoryStream;
data_list:TStringList;
i:integer;
border_width,border_height:integer;
added:boolean;
label cancel_add;
begin
with sb_rich_form do begin
sb_rvf_editor.Clear; // may be still showing a previous block
cancel_add: // come back here if adding the block is cacelled or fails
added:=False; // init
sb_rvf_outer_form.ok_button.Caption:='add to sketchboard';
sb_rvf_outer_form.ok_button.Hint:=' add text block to sketchboard - Insert key ';
sb_rvf_outer_form.exit_menu_entry.Caption:='add to sketchboard and close';
if do_show_modal(sb_rvf_outer_form)<>mrOk // 212a ShowModal
then EXIT;
if sb_rvf_add_msg_pref=False
then begin
alert_box.preferences_checkbox.Checked:=False; //%%%%
alert_box.preferences_checkbox.Show;
i:=alert(3,'php/540 adding formatted text to the sketchboard',
'Please now click and drag a rectangle on the sketchboard to contain the block of formatted text.'
+'||After it has been added you can resize it by dragging the corners, or rotate it by dragging the handle.'
+'||You can edit the text by selecting the text block and then clicking the `0MODIFY`1 tab on the sketchboard control panel.'
+'||Or click `0cancel`1 below to return to the text editor.',
'','','','','cancel','OK',0);
sb_rvf_add_msg_pref:=alert_box.preferences_checkbox.Checked; //%%%%
alert_box.preferences_checkbox.Hide;
if i=5 then goto cancel_add;
end;
Screen.Cursor:=crHourGlass; // may be needed for large images or slow systems
dtp_formatted_text_shape_emf:=TdtpExposedMetafile.Create; // create the dtp shape
data_list:=TStringList.Create;
formatted_txt_metafile:=TMetafile.Create;
formatted_txt_metafile.Enhanced:=True; // emf format
formatted_txt_metafile.Transparent:=True;
formatted_txt_metafile.Width:=sb_rvf_editor.ClientWidth;
sb_rvf_reporter.RichView.Style:=sb_rvf_style;
sb_rvf_reporter.RichView.RTFReadProperties.TextStyleMode:=rvrsAddIfNeeded;
sb_rvf_reporter.RichView.RTFReadProperties.ParaStyleMode:=rvrsAddIfNeeded;
sb_rvf_reporter.RichView.Color:=sb_rvf_editor.Color; // 212a
sb_rvf_reporter.RichView.LeftMargin:=sb_rvf_editor.LeftMargin;
sb_rvf_reporter.RichView.TopMargin:=0; //sb_rvf_editor.TopMargin - not included in EndAt height
sb_rvf_reporter.RichView.RightMargin:=sb_rvf_editor.RightMargin;
sb_rvf_reporter.RichView.BottomMargin:=0; //sb_rvf_editor.BottomMargin - not included in EndAt height
rvf_stream:=TMemoryStream.Create;
try
sb_rvf_editor.SaveRVFToStream(rvf_stream,False);
rvf_stream.Position:=0;
sb_rvf_reporter.RichView.LoadRVFFromStream(rvf_stream);
finally
rvf_stream.Free;
end;//try
sb_rvf_reporter.Init(dtp_form.Canvas,formatted_txt_metafile.Width);
// if document does not have page breaks, it will be formatted on one page..
repeat until sb_rvf_reporter.FormatNextPage($FFFFFF)=False; // very large value repeat for all pages or one
formatted_txt_metafile.Height:=sb_rvf_reporter.EndAt+sb_rvf_editor.TopMargin+sb_rvf_editor.BottomMargin;
border_width:=formatted_txt_metafile.Width; // 212a
border_height:=formatted_txt_metafile.Height;
formatted_txt_metafile_canvas:=TMetaFileCanvas.Create(formatted_txt_metafile,dtp_form.Canvas.Handle);
if sb_rvf_outer_form.rvf_transparent_checkbox.Checked=False // fill the backround 212a
then begin
formatted_txt_metafile_canvas.Brush.Color:=sb_rvf_outer_form.rvf_bgnd_colour_panel.Color;
formatted_txt_metafile_canvas.Brush.Style:=bsSolid;
formatted_txt_metafile_canvas.FillRect(Rect(0,0,border_width,border_height)); // 212a
end;
if sb_rvf_outer_form.rvf_add_border_checkbox.Checked=True // draw the border 212a
then begin
formatted_txt_metafile_canvas.Brush.Color:=sb_rvf_outer_form.rvf_border_colour_panel.Color;
formatted_txt_metafile_canvas.Brush.Style:=bsSolid;
formatted_txt_metafile_canvas.FrameRect(Rect(0,0,border_width,border_height)); // 212a
end;
// now draw the content...
formatted_txt_metafile_canvas.Brush.Style:=bsClear;
sb_rvf_reporter.DrawPageAt(0,sb_rvf_editor.TopMargin,1,formatted_txt_metafile_canvas,True,sb_rvf_reporter.EndAt);
formatted_txt_metafile_canvas.Free; // creates the metafile record when the canvas is freed.
emf_stream:=TMemoryStream.Create;
data_stream:=TMemoryStream.Create;
try
formatted_txt_metafile.SaveToStream(emf_stream);
emf_stream.Position:=0;
with dtp_formatted_text_shape_emf do begin
RvfShape:=True;
PreserveAspect:=True;
AllowRotate:=True;
AllowSelect:=True;
ShowHint:=True;
Hint:=' formatted text block ';
RvfWidth:=formatted_txt_metafile.Width; // 85A added 29-12-2011 metafile width in pixels
RvfHeight:=formatted_txt_metafile.Height; // 85A added 29-12-2011 metafile height in pixels
with sb_rvf_outer_form do begin
RvfBackgndColour:=rvf_bgnd_colour_panel.Color; // 85A added 20-03-2015 metafile background colour 212a
RvfTransparent:=rvf_transparent_checkbox.Checked; // 85A added 20-03-2015 True = metafile has transparent background, colour ignored
RvfBorderColour:=rvf_border_colour_panel.Color; // 85A added 20-03-2015 blue default
RvfAddBorder:=rvf_add_border_checkbox.Checked; // 85A added 20-03-2015
end;//with
RvfLeftMargin:=sb_rvf_editor.LeftMargin; // 85A added 20-03-2015 dots...
RvfTopMargin:=sb_rvf_editor.TopMargin; // 85A added 20-03-2015
RvfRightMargin:=sb_rvf_editor.RightMargin; // 85A added 20-03-2015
RvfBottomMargin:=sb_rvf_editor.BottomMargin; // 85A added 20-03-2015
Image.LoadFromStream(emf_stream,'.emf',0); // also sets DocWidth, DocHeight, (seemingly at 150dpi if zero when loaded)
// RVF data...
if sb_rvf_editor.SaveRVFToStream(data_stream,False)=True
then begin
data_stream.Position:=0;
data_list.LoadFromStream(data_stream);
RvfData:=data_list.Text;
dtp_form.dtp_document.InsertShapeByDrag(dtp_formatted_text_shape_emf);
added:=True;
end
else begin
ShowMessage('Sorry, the formatted text could not be added to the sketchboard.'
+#13+#13+'You may wish to save it in a separate file.');
dtp_formatted_text_shape_emf.Free; // 212a
sb_rvf_outer_form.save_menu_entry.Click;
end;
end;//with shape
finally
data_list.Free;
formatted_txt_metafile.Free;
emf_stream.Free;
data_stream.Free;
Screen.Cursor:=crDefault;
end;//try
if added=False then goto cancel_add; // 212a don't lose his input
end;//with sb_rich_form
end;
//______________________________________________________________________________
procedure Tdtp_form.set_custom_menu_entryClick(Sender: TObject);
begin
with dtp_document do begin
if (SelectionCount=1) and (Selection[0] is TdtpGroupShape)
then begin
if NOT assigned(custom_combined_shape) then custom_combined_shape:=TdtpGroupShape.Create;
custom_combined_shape.Assign(Selection[0]);
end;
end;//with
end;
//______________________________________________________________________________
procedure Tdtp_form.set_fill_page_menu_entryClick(Sender: TObject); // 226e
var
i:integer;
begin
if updating_now=True then EXIT;
with dtp_document do begin
if (ShapeCount<1) or (SelectionCount<>1) then EXIT;
dtp_settings_form.keep_aspect_ratio_checkbox.Checked:=False; // calls the click method to release aspect lock
BeginUpdate;
for i:=0 to ShapeCount-1 do begin
if Shapes[i].Selected=True
then begin
with Shapes[i] do begin
DocLeft:=0;
DocTop:=0;
DocWidth:=PageWidth;
DocHeight:=PageHeight;
end;//with
BREAK;
end;
end;//next
EndUpdate;
end;//with
end;
//______________________________________________________________________________
procedure Tdtp_form.metric_scale_calculator_menu_entryClick(Sender:TObject);
begin
if metric_form.Showing=True // added 0.98.a
then metric_form.Close
else metric_form.Show;
end;
//______________________________________________________________________________
procedure Tdtp_form.jotter_menu_entryClick(Sender: TObject);
begin
if jotter_form.Showing=True // added 205a
then jotter_form.Close
else jotter_form.Show;
end;
//______________________________________________________________________________
procedure Tdtp_form.undo_delete_menu_entryClick(Sender: TObject);
var
shape_count:integer; // number of shapes undeleted
str:string;
begin
if deleted_shapes_list.Count<1 then EXIT;
str:=deleted_shapes_list.Strings[deleted_shapes_list.Count-1];
deleted_shapes_list.Delete(deleted_shapes_list.Count-1);
shape_count:=dtp_document.SelectionFromText(str);
end;
//______________________________________________________________________________
procedure Tdtp_form.hide_crop_markers_menu_entryClick(Sender: TObject);
begin
crop_marker_left_panel.Visible:=False;
crop_marker_top_panel.Visible:=False;
crop_marker_right_panel.Visible:=False;
crop_marker_bottom_panel.Visible:=False;
end;
//______________________________________________________________________________
procedure Tdtp_form.sb_585x405_screenshot_menu_entryClick(Sender: TObject);
begin
export_screenshot(585,405);
end;
//______________________________________________________________________________
procedure Tdtp_form.sb_600x400_screenshot_menu_entryClick(Sender: TObject);
begin
export_screenshot(600,400);
end;
//______________________________________________________________________________
procedure Tdtp_form.sb_780x540_screenshot_menu_entryClick(Sender: TObject);
begin
export_screenshot(780,540);
end;
//______________________________________________________________________________
procedure Tdtp_form.sb_800x600_screenshot_menu_entryClick(Sender: TObject);
begin
export_screenshot(800,600);
end;
//______________________________________________________________________________
procedure Tdtp_form.sb_975x675_screenshot_menu_entryClick(Sender: TObject);
begin
export_screenshot(975,675);
end;
//______________________________________________________________________________
procedure Tdtp_form.sb_1000x800_screenshot_menu_entryClick(Sender: TObject);
begin
export_screenshot(1000,800);
end;
//______________________________________________________________________________
procedure Tdtp_form.sb_1170x810_screenshot_menu_entryClick(Sender: TObject);
begin
export_screenshot(1170,810);
end;
//______________________________________________________________________________
procedure Tdtp_form.sb_850x400_screenshot_menu_entryClick(Sender: TObject);
begin
export_screenshot(850,400);
end;
//______________________________________________________________________________
procedure Tdtp_form.sb_internals_help_menu_entryClick(Sender: TObject);
const
sb_internals_help_str:string='php/599 `0Sketchboard internals`9'
+'||For more information about the internal working of the sketchboard, please click more information online.';
begin
help(0,sb_internals_help_str,'');
end;
//______________________________________________________________________________
procedure Tdtp_form.get_colour_at_mouse_menu_entryClick(Sender: TObject);
begin
do_show_modal(mouse_colour_form); // 212a ShowModal
end;
//______________________________________________________________________________
function draw_sb_low_res_output(on_bitmap:TBitmap):boolean; // 208a
// used to include sketchboard items on print/PDF output at low res
var
img_dpmm:extended; // dots per mm.
img_width_dots:integer;
img_height_dots:integer;
sb_dtp_rect:TRect;
box_value:integer;
begin
RESULT:=False; // init
if dtp_form.dtp_document.CurrentPage.ShapeCount<1 then EXIT;
if dtp_form.dtp_document.CurrentPage.PageWidth print to fit paper`1 menu item.|The sketchboard contents will be scaled up or down to just fit the current paper size set on the printer.'
+'||To print the sketchboard contents at actual page size (shown on the yellow page rulers) click the|`0file > print actual page size`1 menu items.'
+'||If the `0single sheet`1 option is selected, as much of the sketchboard contents as will fit the printer paper size will be printed at actual size on a single sheet.'
+' To set the position of this sheet within the full sketchboard area, click the `0set top-left corner of sheet...`1 menu item.'
+'||green_panel_begintree.gif|rp.gif If you want to print the trackplan at actual model size (shown on the blue rulers) do not use these sketchboard print functions.'
+'||Instead print using the functions on the `0output`1 menu on the trackpad, and select the option to include sketchboard items in the print.green_panel_end';
begin
if help(0,sb_print_help_str,'more sketchboard information')=1 then dtp_settings_form.sb_help_button.Click;
end;
//______________________________________________________________________________
procedure export_metafile;
var
emf_metafile:TMetafile;
emf_canvas:TMetaFileCanvas;
sb_dtp_rect:TRect;
folder_str:string;
file_name_str:string; // name part
file_str:string; // including full path
wmf_factor1:extended;
wmf_factor2:extended;
i:integer;
metafile_dpmm,metafile_dpi,box_value:extended;
metafile_width_dots,metafile_height_dots:integer;
begin
with dtp_form do begin
if dtp_document.CurrentPage.ShapeCount<1
then begin
ShowMessage('There are no items on the sketchboard for export to a metafile.');
EXIT;
end;
if sb_check_valid_float(dtp_settings_form.sb_pdf_emf_dpi_edit,50,4800,box_value)=False // input limits 50dpi to 4800dpi
then begin
ShowMessage('Error: The DPI setting must be a valid whole number in the range 50 to 4800. A decimal point is not allowed.');
EXIT;
end;
try
metafile_dpi:=box_value;
except
ShowMessage('Invalid data for metafile DPI'); // ??? should have been found in sb_check_valid_ earlier
EXIT;
end;//try
if dtp_settings_form.sb_wmf_radiobutton.Checked=True
then begin
i:=alert(7,' WMF file format',
'You have selected the WMF file format which is an old Windows 16-bit metafile image format.'
+'||WMF images are limited to low-resolution 1600 x 1600 dots and may not display properly in versions of Windows later than Windows XP.'
+'||Create a WMF file only if you need it for legacy applications. Otherwise use EMF format instead.',
'','','','change to EMF format','cancel','continue - create WMF metafile',0);
if i=4 then dtp_settings_form.sb_emf_radiobutton.Checked:=True;
if i=5 then EXIT;
end;
file_name_str:=remove_invalid_str('sketchboard_'+FormatDateTime('yyyy_mm_dd_hhmm_ss',Date+Time));
with sb_save_emf_dialog do begin
if his_emf_file_name<>'' then InitialDir:=ExtractFilePath(his_emf_file_name)
else InitialDir:=exe_str+'EMF-FILES\';
if dtp_settings_form.sb_wmf_radiobutton.Checked=True
then begin
FileName:=file_name_str+'.wmf';
DefaultExt:='wmf';
Filter:='WMF metafile ( .wmf)|*.wmf';
Title:=' create WMF metafile ...';
end
else begin
FileName:=file_name_str+'.emf';
DefaultExt:='emf';
Filter:='EMF metafile ( .emf)|*.emf';
Title:=' create EMF metafile ...';
end;
if Execute=False then EXIT;
his_emf_file_name:=FileName; // so we can use the same folder next time.
dtp_settings_form.sb_emf_radiobutton.Checked:=(LowerCase(ExtractFileExt(FileName))='.emf'); // 0.95.a did he change the extension... ?
dtp_settings_form.sb_wmf_radiobutton.Checked:=(LowerCase(ExtractFileExt(FileName))='.wmf');
// invalid entered chars removed by dialog
file_str:=ExtractFilePath(FileName)+lower_case_filename(ExtractFileName(FileName)); // to underscores and lower case
end;//with
Screen.Cursor:=crHourGlass; // needed for large images or slow systems
metafile_dpmm:=metafile_dpi/25.4;
metafile_width_dots:=Round(dtp_document.CurrentPage.PageWidth*metafile_dpmm); // dots
metafile_height_dots:=Round(dtp_document.CurrentPage.PageHeight*metafile_dpmm);
sb_dtp_rect.Left:=0;
sb_dtp_rect.Top:=0;
sb_dtp_rect.Right:=metafile_width_dots;
sb_dtp_rect.Bottom:=metafile_height_dots;
if dtp_settings_form.sb_wmf_radiobutton.Checked=True
then begin
wmf_factor1:=1.0; // init
wmf_factor2:=1.0;
if metafile_width>1600
then begin
wmf_factor1:=1600/metafile_width; // (no zero div, it's over 1600)
metafile_width:=Round(metafile_width*wmf_factor1);
metafile_height:=Round(metafile_height*wmf_factor1);
end;
if metafile_height>1600 // still too big?
then begin
wmf_factor2:=1600/metafile_height; // (no zero div, it's over 1600)
metafile_width:=Round(metafile_width*wmf_factor2);
metafile_height:=Round(metafile_height*wmf_factor2);
end;
metafile_dpmm:=metafile_dpmm*wmf_factor1*wmf_factor2; // reduce dpmm accordingly
end;
emf_metafile:=TMetafile.Create;
emf_metafile.Width:=metafile_width_dots; // dots
emf_metafile.Height:=metafile_height_dots;
emf_metafile.Enhanced:=dtp_settings_form.sb_emf_radiobutton.Checked; // emf or wmf format
// generate the metafile data...
try
try
emf_canvas:=TMetaFileCanvas.Create(emf_metafile,0{pad_form.Canvas.Handle});
omit_trackplan_from_rendering:=False; // include trackplan item in EMF
dtp_document.CurrentPage.Print(emf_canvas,sb_dtp_rect,metafile_dpmm,0,False,False);
emf_canvas.Free; // creates the metafile record when the metafile canvas is freed.
emf_metafile.SaveToFile(file_str);
if alert(2,' metafile created',
' |The metafile was successfully created:||'+file_str+'| ',
'','','','open the containing folder','','continue',0)=4
then begin
folder_str:=ExtractFilePath(file_str);
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 metafile.');
end;//try
finally
emf_metafile.Free;
end;//try
Screen.Cursor:=crDefault;
end;//with
end;
//______________________________________________________________________________
procedure Tdtp_form.sb_window_proc(var msg:TMessage); // 214a
begin
if msg.Msg=WM_DROPFILES
then sb_file_drop(TWMDROPFILES(msg))
else original_sb_window_proc(msg);
end;
//______________________________________________________________________________
procedure Tdtp_form.sb_file_drop(var msg:TWMDROPFILES); // 214a
var
num_files:integer;
buffer:array[0..MAX_PATH] of char;
dropped_file_name,dropped_file_ext:string;
i:integer;
begin
num_files:=DragQueryFile(msg.Drop,$FFFFFFFF,nil,0);
if num_files>1
then begin
ShowMessage('error - attempt to drop more than one file');
EXIT;
end;
DragQueryFile(msg.Drop,0,@buffer,SizeOf(buffer));
dropped_file_name:=change_jpeg_filename(buffer); // if nec full path to file
dropped_file_ext:=LowerCase(ExtractFileExt(dropped_file_name));
if dropped_file_ext='.sk9'
then begin
if dtp_document.Modified=True
then begin
i:=alert(4,'php/501 dropped file - save first?',
'There are unsaved changes on the sketchboard which will be lost if not saved.'
+'||Do you want to save them before reloading the sketchboard from the dropped file?',
'','','','no - load dropped file without saving','cancel','yes - save first',0);
if i=5 then EXIT;
if i=6 then save_dtp_as_menu_entry.Click;
end;
load_sketchboard_file(dropped_file_name);
end
else begin // add bitmap image?
if (dropped_file_ext='.png')
or (dropped_file_ext='.gif')
or (dropped_file_ext='.jpg')
or (dropped_file_ext='.bmp')
then add_bitmap_image(dropped_file_name)
else begin // add metafile image?
if (dropped_file_ext='.emf')
or (dropped_file_ext='.wmf')
then add_metafile_image(dropped_file_name)
else ShowMessage('Error - the '+dropped_file_ext+' file format is not supported for dropping on the sketchboard.'
+#13+#13+'Only .sk9 files and image files can be dropped here.');
end;
end;
end;
//______________________________________________________________________________
procedure Tdtp_form.go_to_my_documents_menu_entryClick(Sender: TObject);
begin
open_MyDocuments; // 214a
end;
//______________________________________________________________________________
procedure Tdtp_form.jpg_quality_menu_entryClick(Sender: TObject);
begin
control_room_form.jpg_menu_entry.Click;
end;
//______________________________________________________________________________
procedure Tdtp_form.this_location_top_left_print_popup_entryClick(Sender:TObject); // 226d
begin
top_left_print_page_x:=x_page_now; // 226d
top_left_print_page_y:=y_page_now; // 226d
end;
//______________________________________________________________________________
procedure Tdtp_form.set_top_left_menu_entryClick(Sender: TObject); // 226d
const
help_str:string=' `0set top-left corner for actual-size printing`9'
+'||Enter new X and Y dimensions for the top-left printed sheet corner in millimetres.'
+'||This sets the position of the printed sheet within the full sketchboard page.'
+'||X-dimensions are read on the top yellow ruler.'
+'|Y-dimensions are read on the left yellow ruler.'
+'||This position can also be set by right-clicking at the required place on the sketchboard, and then click the `0actual-size printing`1 menu item.'
+'||The reset normal setting is X=0 , Y=0.';
var
n:integer;
od:Toutdim;
begin
putdim(help_str,1,'top-left X - dimension',top_left_print_page_x,False,True,False,False); // negative ok, no preset, zero ok, don't terminate on zero.
n:=putdim(help_str,1,'top-left Y - dimension',top_left_print_page_y,False,True,False,False); // negative ok, no preset, zero ok, don't terminate on zero.
if n<>1 then EXIT;
if getdims('set top-left sheet corner position','',dtp_form,n,od)=True
then begin
top_left_print_page_x:=od[0];
top_left_print_page_y:=od[1];
end;
end;
//______________________________________________________________________________
procedure Tdtp_form.sb_print_reset_zero_menu_entryClick(Sender: TObject);
begin
top_left_print_page_x:=0;
top_left_print_page_y:=0;
show_modal_message('The top-left corner for the next single sheet has been reset to zero.');
end;
//______________________________________________________________________________
procedure Tdtp_form.modify_menu_entryClick(Sender: TObject);
var i:integer;
begin
i:=find_reference_item;
modify_dims_menu_entry.Enabled:=(i<>-1);
modify_infill_menu_entry.Enabled:=(i<>-1);
end;
//______________________________________________________________________________
procedure Tdtp_form.modify_dims_menu_entryClick(Sender: TObject); // 227a
var
i,n:integer;
dtp_shape_tag:Tdtp_shape_tag;
ref_doc_width,ref_doc_height:extended;
doc_width,doc_height,doc_left,doc_top:extended;
begin
if selected_shapes_list.Count<1 then EXIT;
n:=find_reference_item;
if (n<0) or (n>(dtp_document.CurrentPage.ShapeCount-1)) then EXIT;
if (dtp_document.CurrentPage.Shapes[n] is TdtpPolygonShape)=False then EXIT; // ref not polygon?
ref_doc_width:=dtp_document.CurrentPage.Shapes[n].DocWidth;
ref_doc_height:=dtp_document.CurrentPage.Shapes[n].DocHeight;
with dtp_form do begin
if updating_now=True then EXIT;
dtp_document.BeginUpdate;
for i:=0 to selected_shapes_list.Count-1 do begin
if (TdtpShape(selected_shapes_list[i]) is TdtpPolygonShape)=False then CONTINUE; // not polygon
dtp_shape_tag:=Tdtp_shape_tag(TdtpShape(selected_shapes_list[i]).Tag);
if dtp_shape_tag.reference=True then CONTINUE; // ref item was included in selection
doc_left:=TdtpShape(selected_shapes_list[i]).DocLeft;
doc_width:=TdtpShape(selected_shapes_list[i]).DocWidth;
doc_top:=TdtpShape(selected_shapes_list[i]).DocTop;
doc_height:=TdtpShape(selected_shapes_list[i]).DocHeight;
TdtpShape(selected_shapes_list[i]).DocLeft:=doc_left+(doc_width-ref_doc_width)/2;
TdtpShape(selected_shapes_list[i]).DocWidth:=ref_doc_width;
TdtpShape(selected_shapes_list[i]).DocTop:=doc_top+(doc_height-ref_doc_height)/2;
TdtpShape(selected_shapes_list[i]).DocHeight:=ref_doc_height;
end;//next
dtp_document.EndUpdate;
end;//with form
end;
//______________________________________________________________________________
procedure Tdtp_form.modify_infill_menu_entryClick(Sender: TObject); // 227a
var
i,n:integer;
dtp_shape_tag:Tdtp_shape_tag;
ref_use_outline,ref_use_fill:boolean;
ref_outline_width:extended;
ref_fill_alpha:integer;
ref_outline_colour:TColor;
ref_fill_colour:TColor;
begin
if selected_shapes_list.Count<1 then EXIT;
n:=find_reference_item;
if (n<0) or (n>(dtp_document.CurrentPage.ShapeCount-1)) then EXIT;
if (dtp_document.CurrentPage.Shapes[n] is TdtpPolygonShape)=False then EXIT; // ref not polygon?
ref_use_outline:=TdtpPolygonShape(dtp_document.CurrentPage.Shapes[n]).UseOutline;
ref_use_fill:=TdtpPolygonShape(dtp_document.CurrentPage.Shapes[n]).UseFill;
ref_outline_width:=TdtpPolygonShape(dtp_document.CurrentPage.Shapes[n]).OutlineWidth;
ref_fill_alpha:=TdtpPolygonShape(dtp_document.CurrentPage.Shapes[n]).FillAlpha;
ref_outline_colour:=TdtpPolygonShape(dtp_document.CurrentPage.Shapes[n]).OutlineColor;
ref_fill_colour:=TdtpPolygonShape(dtp_document.CurrentPage.Shapes[n]).FillColor;
with dtp_form do begin
if updating_now=True then EXIT;
dtp_document.BeginUpdate;
for i:=0 to selected_shapes_list.Count-1 do begin
if (TdtpShape(selected_shapes_list[i]) is TdtpPolygonShape)=False then CONTINUE; // not polygon
dtp_shape_tag:=Tdtp_shape_tag(TdtpShape(selected_shapes_list[i]).Tag);
if dtp_shape_tag.reference=True then CONTINUE; // ref item was included in selection
TdtpPolygonShape(selected_shapes_list[i]).UseOutline:=ref_use_outline;
TdtpPolygonShape(selected_shapes_list[i]).UseFill:=ref_use_fill;
TdtpPolygonShape(selected_shapes_list[i]).OutlineWidth:=ref_outline_width;
TdtpPolygonShape(selected_shapes_list[i]).FillAlpha:=ref_fill_alpha;
TdtpPolygonShape(selected_shapes_list[i]).OutlineColor:=ref_outline_colour;
TdtpPolygonShape(selected_shapes_list[i]).FillColor:=ref_fill_colour;
end;//next
dtp_document.EndUpdate;
end;//with form
end;
//______________________________________________________________________________
function export_draw_symbols(canv:TCanvas; canvas_height:integer; symbols:Tsymbols; symbol_type,layer:integer; grid_left,grid_top,ypd:extended; output_code:integer):boolean; // 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 (output_code<3) and (dtp_settings_form.include_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
swap_polygon(canv,canvas_height,infill_points,num_points);
// 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
swap_move_to(canv,canvas_height,move_to.X,move_to.Y);
swap_line_to(canv,canvas_height,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
swap_polygon(canv,canvas_height,infill_points,num_points);
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_inty);
move_to.Y:=canvas_height-Round(check_intx);
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:=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;
Brush.Style:=bsSolid;
Rectangle(move_to.X-half_stringwidth-7, move_to.Y-half_stringheight-2, move_to.X+half_stringwidth+9, move_to.Y+half_stringheight); // 7,2,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;
//______________________________________________________________________________
procedure SetPolygonShapeDefaults(APoly:TdtpPolygonShape); // moved from dtp_settings_unit 227d
begin
if Assigned(APoly)=False then EXIT;
with APoly do begin
FillAlpha:=FFillAlpha;
UseFill:=FUseFill;
UseOutline:=FUseOutline;
FillColor:=FFillColor;
OutlineColor:=FOutlineColor;
OutlineWidth:=0.75/dtp_form.dtp_document.ScreenDpm; // 3/4 pixel wide at screen res (arbitrary after trial and error)
end;//with
end;
//______________________________________________________________________________
initialization
//Load custom cursors...
Screen.cursors[crCopy] := loadcursor(hinstance, 'DTCOPY');
Screen.cursors[crMove] := loadcursor(hinstance, 'DTMOVE');
Screen.cursors[crLink] := loadcursor(hinstance, 'DTLINK');
Screen.cursors[crCopyScroll] := loadcursor(hinstance, 'DTCOPYSC');
Screen.cursors[crMoveScroll] := loadcursor(hinstance, 'DTMOVESC');
Screen.cursors[crLinkScroll] := loadcursor(hinstance, 'DTLINKSC');
end.