(* 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.