(* 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 file_viewer; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, FileCtrl, ComCtrls, Grids, Outline, DirOutln, ExtCtrls, Htmlview; type Tfile_viewer_form = class(TForm) folder_listbox: TDirectoryListBox; disk_drive_combo: TDriveComboBox; Label1: TLabel; Label2: TLabel; help_shape: TShape; help_button: TButton; html_file_viewer: THTMLViewer; blue_corner_panel: TPanel; size_updown: TUpDown; controls_panel: TPanel; found_label: TLabel; count_label: TLabel; progress_bar: TProgressBar; close_panel: TPanel; close_button: TButton; refresh_button: TButton; open_folder_button: TButton; mouse_hover_panel: TPanel; images_clickable_checkbox: TCheckBox; name_labels_checkbox: TCheckBox; images_label: TLabel; instant_show_checkbox: TCheckBox; escape_label: TLabel; export_button: TButton; export_all_checkbox: TCheckBox; export_overwrite_checkbox: TCheckBox; Label3: TLabel; Label4: TLabel; procedure FormCreate(Sender: TObject); procedure FormResize(Sender: TObject); procedure folder_listboxClick(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure help_buttonClick(Sender: TObject); procedure close_buttonClick(Sender: TObject); procedure FormKeyDown(Sender:TObject; var Key:Word; Shift:TShiftState); procedure FormActivate(Sender: TObject); procedure refresh_buttonClick(Sender: TObject); procedure open_folder_buttonClick(Sender: TObject); procedure size_updownClick(Sender: TObject; Button: TUDBtnType); procedure html_file_viewerMouseMove(Sender:TObject; Shift:TShiftState; X,Y:Integer); procedure FormDeactivate(Sender: TObject); procedure html_file_viewerImageRequest(Sender:TObject; const SRC:String; var Stream:TMemoryStream); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure instant_show_checkboxClick(Sender: TObject); procedure export_all_checkboxClick(Sender: TObject); procedure export_buttonClick(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); private { Private declarations } public { Public declarations } end; var file_viewer_form: Tfile_viewer_form; box_file_list:TStringList; box_size_list:TStringList; box_time_list:TStringList; box_export_list:TStringList; // 224a num_bgnd_list:TStringList; num_unused_list:TStringList; num_lib_list:TStringList; img_name_list:TStringList; next_html_list:TStringList; readme_list:TStringList; fv_tag_list:TStringList; fv_gauge_str:string; html_str:string; // table rows keep_form_was_showing:boolean=False; fv_has_been_active:boolean=False; procedure fv_reload_file(n:integer); procedure fv_add_file(n:integer); procedure fv_tags(n:integer); procedure fv_read_me(n:integer); procedure fv_rename_file(n:integer); procedure fv_find_file(n:integer); procedure fv_delete_file(n:integer); procedure fv_export_file(n:integer); // 224a procedure no_readme_help(none:boolean); //______________________________________________________________________________ implementation {$R *.DFM} uses ShellAPI,control_room,pad_unit,grid_unit,math_unit,PNGImage, panning_unit, shove_timber,rail_options_unit,platform_unit,check_diffs_unit, data_memo_unit,stay_visible_unit,info_unit,keep_select,help_sheet,alert_unit, mecbox_unit; const html_header_str:string='Templot file viewer'; html_footer_str:string='
'; var saved_pad_width,saved_pad_height:integer; escape_pressed:boolean=False; no_onresize:boolean=False; use_bmp_image_streams:boolean=False; showing_as_png_files:boolean=False; bmp_stream:TMemoryStream; spacebar_count:integer=-1; html_create_str:string=''; html_top_str:string=''; tag_str:string=''; readme_str:string=''; fv_tag_str:string=''; num_files_str:string=''; next_str:string=''; some_selected:boolean=False; procedure show_files_as_bitmaps;forward; procedure do_full_view;forward; //______________________________________________________________________________ procedure show_files_as_png; // 208d // deprecated in 208e - use bitmap objects instead of PNG image files - see show_files_as_bitmaps; // user can choose option in program menu on control room - this is slower but uses less RAM. var i,n:integer; tag_count:integer; screen_rect,print_rect:TRect; create_bitmap:TBitmap; create_png:TPNGObject; img_file_name_str:string; // name part img_file_str:string; // including full path oldbox_str:string; // save box for restore old_save_done:boolean; search_record_png,search_record_box:TSearchRec; dir_str,boxfile_str:string; next_str:string; hl:integer; append:boolean; windows_cursor_count:integer; saved_hide_name_labels:boolean; ////////////////////////////////////////////////////////////////// procedure add_file_to_box_lists(search_record:TSearchRec); begin box_file_list.Add(search_record.Name); box_size_list.Add(IntToStr(Round(search_record.Size/1024))+' KB'); box_time_list.Add(DateToStr(FileDateToDateTime(search_record.Time))+'   '+TimeToStr(FileDateToDateTime(search_record.Time))); box_export_list.Add('0'); // 224a end; ////////////////////////////////////////////////////////////////// begin with file_viewer_form do begin // no changes while building list disk_drive_combo.Enabled:=False; folder_listbox.Enabled:=False; refresh_button.Enabled:=False; images_clickable_checkbox.Enabled:=False; name_labels_checkbox.Enabled:=False; instant_show_checkbox.Enabled:=False; progress_bar.Position:=0; escape_pressed:=False; img_name_list.Clear; box_file_list.Clear; box_size_list.Clear; box_time_list.Clear; box_export_list.Clear; // 224a num_bgnd_list.Clear; num_unused_list.Clear; num_lib_list.Clear; next_html_list.Clear; readme_list.Clear; fv_tag_list.Clear; dir_str:=folder_listbox.Directory+'\'; // add trailing slash // build the lists ... if FindFirst(dir_str+'*.box',0,search_record_box)=0 then begin add_file_to_box_lists(search_record_box); while FindNext(search_record_box)=0 do add_file_to_box_lists(search_record_box); end; FindClose(search_record_box); try if (box_file_list.Count>60) and (too_many_files_msg_pref=False) then begin alert_box.preferences_checkbox.Checked:=False; alert_box.preferences_checkbox.Show; i:=alert(3,'php/950 large number of files', '||`0'+dir_str+'`f' +'||This folder contains a large number of .box files ('+IntToStr(box_file_list.Count)+').' +'||Creating all the screenshot images may take some time.' +'||You may prefer to cancel and organize your files into|sub-folders.' +'||If you continue you can press the `0ESC`2 key to stop the process.', '','','','cancel and open folder','cancel','continue',0); too_many_files_msg_pref:=alert_box.preferences_checkbox.Checked; alert_box.preferences_checkbox.Hide; case i of 4: begin open_folder_button.Click; EXIT; end; 5: EXIT; end;//case end; // please wait ... // 3 table columns... html_top_str:='   '+IntToStr(box_file_list.Count)+'  .box  files  in  this  folder  ' +'     '+dir_str+'' +'
'; if box_file_list.Count>0 then html_str:='   please wait while the images are generated' +'

    you can stop the process by pressing the ESC key' else html_str:=''; html_str:=html_header_str+html_top_str+html_str+html_footer_str; use_bmp_image_streams:=False; // normal load images from file html_file_viewer.LoadFromString(html_str); count_label.Caption:='0'; // some .box files to show? ... if box_file_list.Count>0 then begin showing_as_png_files:=True; images_label.Caption:='png files'; escape_label.Show; count_label.Show; found_label.Show; ShowCursor(False); // Windows SDK progress_bar.Max:=box_file_list.Count; // first set up the trackpad... old_save_done:=save_done; // save flag in case a confirm is needed on a reload oldbox_str:=exe_str+'fv.ebk'; // save existing box DeleteFile(oldbox_str); // delete any previous file. save_box(0,0,0,oldbox_str); // save existing contents for restore later. saved_pad_width:=pad_form.ClientWidth; saved_pad_height:=pad_form.ClientHeight; saved_hide_name_labels:=hide_name_labels; hide_name_labels:= NOT name_labels_checkbox.Checked; pad_form.ClientWidth:=676; // screenshot image size pad_form.ClientHeight:=320; // delete all previous PNG files in the fview folder... while FindFirst(exe_str+'internal\fview\*.png',0,search_record_png)=0 do DeleteFile(exe_str+'internal\fview\'+search_record_png.Name); FindClose(search_record_png); screen_rect.Top:=0; screen_rect.Left:=0; screen_rect.Right:=pad_form.ClientWidth; //-1; screen_rect.Bottom:=pad_form.ClientHeight; //-1; print_rect:=screen_rect; for n:=0 to box_file_list.Count-1 do begin clear_keeps(False,False); // clear all templates append:=False; boxfile_str:=dir_str+box_file_list.Strings[n]; if Pos('.box',LowerCase(boxfile_str))=0 then boxfile_str:=boxfile_str+'.box'; // in case his system hides extensions. if load_storage_box(False,False,boxfile_str,False,False,append,hl)=True then begin if keeps_list.Count>0 then begin if (loaded_version<93) and (hl>-1) and (hl92) then mint_final_or_copy_control(hl); // copy the control template if there is one in the file. end; end; show_and_redraw(False,False); // update pad num_bgnd_list.Add(IntToStr(any_bgnd)); num_unused_list.Add(IntToStr(any_unused)); num_lib_list.Add(IntToStr(any_library)); readme_list.Add(get_readme_notes); tag_count:=build_tag_list(False); // tag_count not used tag_str:=''; if tag_list.Count>0 then begin for i:=0 to tag_list.Count-1 do begin tag_str:=tag_str+'     '+tag_list.Strings[i]+'|'; // add indent and separator end;//next end; fv_tag_list.Add(tag_str); img_file_name_str:=StringReplace(box_file_list.Strings[n],'.box','_box',[rfReplaceAll, rfIgnoreCase]); img_file_str:=exe_str+'internal\fview\'+img_file_name_str+'.png'; img_name_list.Add(img_file_str); create_bitmap:=TBitmap.Create; create_png:=TPNGObject.Create; try create_bitmap.Width:=pad_form.ClientWidth; create_bitmap.Height:=pad_form.ClientHeight; try create_bitmap.Canvas.CopyMode:=cmSrcCopy; create_bitmap.Canvas.CopyRect(print_rect,offdraw_bmp.Canvas,screen_rect); with create_bitmap.Canvas do begin Brush.Style:=bsSolid; Brush.Color:=clYellow; Font.Color:=clBlack; Font.Height:=0-13; Font.Style:=[fsBold]; Font.Name:='Arial'; TextOut(0,0,' '+IntToStr(n+1)+': '+fv_gauge_str+' '+box_project_title_str+' '); // add the short gauge label end;//with create_png.Assign(create_bitmap); create_png.SaveToFile(img_file_str); except show_modal_message('Sorry, an error occurred in creating image:'+#13+#13+IntToStr(n+1)+' : '+img_file_name_str); end;//try finally create_png.Free; create_bitmap.Free; end;//try progress_bar.Position:=n+1; count_label.Caption:=IntToStr(n+1); Application.ProcessMessages; // for pressing ESC key if escape_pressed=True then BREAK; end;//next // restore trackpad... clear_keeps(False,False); // clear all templates append:=False; if load_storage_box(False,False,oldbox_str,False,False,append,hl)=True then begin if keeps_list.Count>0 then begin if (loaded_version<93) and (hl>-1) and (hl92) then mint_final_or_copy_control(hl); // copy the control template if there is one in the file. end; end; pad_form.ClientWidth:=saved_pad_width; pad_form.ClientHeight:=saved_pad_height; hide_name_labels:=saved_hide_name_labels; show_and_redraw(False,False); // update pad if any_bgnd<1 then pad_form.fit_current_only_menu_entry.Click; save_done:=old_save_done; // restore flag in case a confirm is needed on a reload // now create the HTML view... progress_bar.Position:=0; html_str:=html_header_str+html_top_str; if readme_list.Count=1 then num_files_str:=' file' else num_files_str:=' files'; if readme_list.Count  process stopped (ESC pressed)  -  showing '+IntToStr(readme_list.Count)+num_files_str+' only' +'  -  click  refresh list  to restart' +'
'; html_str:=html_str+' '; for n:=0 to readme_list.Count-1 do begin // add each image (if cancelled, this list may be shorter than the box list) if readme_list.Strings[n]='' then readme_str:='read me ? ' else readme_str:='read me   '; if fv_tag_list.Strings[n]='' then fv_tag_str:='tags' else fv_tag_str:='tags'; next_str:=''; if images_clickable_checkbox.Checked=True then next_str:=next_str+'' else next_str:=next_str+''; next_str:=next_str+'' +''+IntToStr(n+1)+':  '+box_file_list.Strings[n]+'' +''+box_size_list.Strings[n]+'    '+box_time_list.Strings[n]+'' +' load this file' +'   add from this file' +'   '+fv_tag_str +'   '+readme_str+'' +'' +'this file:   rename ' +'
find ' +'
delete ' +'' +'background templates: '+num_bgnd_list.Strings[n]+' ' +'
unused templates: '+num_unused_list.Strings[n]+' ' +'
library templates: '+num_lib_list.Strings[n]+' '; html_str:=html_str+next_str +'
' +' '; next_html_list.Add(next_str); // keep this string part for possible delete / replace end;//next html_str:=html_str+html_footer_str; use_bmp_image_streams:=False; // normal load images from file html_file_viewer.LoadFromString(html_str); repeat windows_cursor_count:=ShowCursor(True); // Windows SDK until windows_cursor_count>-1; // ensure visible refresh_button.Caption:='refresh list'; end;//if count>0 finally disk_drive_combo.Enabled:=True; folder_listbox.Enabled:=True; refresh_button.Enabled:=True; images_clickable_checkbox.Enabled:=True; name_labels_checkbox.Enabled:=True; instant_show_checkbox.Enabled:=True; html_file_viewer.SetFocus; // for mouse wheel and arrow keys after selecting drive or folder. end;//try end;//with end; //______________________________________________________________________________ procedure Tfile_viewer_form.FormCreate(Sender: TObject); var folder_str:string; begin ClientWidth:=1000; ClientHeight:=748; AutoScroll:=False; img_name_list:=TStringList.Create; box_file_list:=TStringList.Create; box_size_list:=TStringList.Create; box_time_list:=TStringList.Create; box_export_list:=TStringList.Create; // 224a num_bgnd_list:=TStringList.Create; num_unused_list:=TStringList.Create; num_lib_list:=TStringList.Create; next_html_list:=TStringList.Create; readme_list:=TStringList.Create; fv_tag_list:=TStringList.Create; folder_str:=ExtractFilePath(Application.ExeName)+'BOX-FILES'; // exe_str not yet set if DirectoryExists(folder_str)=True then folder_listbox.Directory:=folder_str; html_create_str:='




' +'



to see all the .box files in the selected disk drive and folder

' +'

click the [ show files ] button

' +'




to scroll quickly through the list press repeatedly
or hold down the SPACEBAR on the keyboard

' +'



for more information click the [ ? help ] button

' +'





to avoid seeing this message every time tick the [ instant show files ] tickbox

'; use_bmp_image_streams:=False; // normal load images from file html_file_viewer.LoadFromString(html_create_str); bmp_stream:=TMemoryStream.Create; end; //______________________________________________________________________________ procedure Tfile_viewer_form.FormResize(Sender: TObject); begin if no_onresize=True then EXIT; html_file_viewer.Width:=ClientWidth-html_file_viewer.Left; html_file_viewer.Height:=ClientHeight; controls_panel.Top:=ClientHeight-controls_panel.Height; folder_listbox.Height:=controls_panel.Top-folder_listbox.Top-images_label.Height; end; //______________________________________________________________________________ procedure Tfile_viewer_form.folder_listboxClick(Sender: TObject); var search_record_box:TSearchRec; top_str,dir_str:string; file_count:integer; begin if no_onresize=True then EXIT; // ??? scaling appears to cause a click folder_listbox.OpenCurrent; // mimics a double-click to open the folder if instant_show_checkbox.Checked=True // 208g then begin if control_room_form.viewer_png_menu_entry.Checked=True then show_files_as_png else show_files_as_bitmaps; end else begin // 208g refresh_button.Caption:='show files'; escape_label.Hide; count_label.Hide; found_label.Hide; dir_str:=folder_listbox.Directory+'\'; // add trailing slash file_count:=0; // init // count the files ... if FindFirst(dir_str+'*.box',0,search_record_box)=0 then begin INC(file_count); while FindNext(search_record_box)=0 do INC(file_count); end; FindClose(search_record_box); top_str:='' +'' +'' +'
  '+IntToStr(file_count)+'  .box  files  in  this  folder
    '+dir_str+'

'; use_bmp_image_streams:=False; // normal load images from file html_file_viewer.LoadFromString(top_str+html_create_str); end; end; //______________________________________________________________________________ procedure fv_reload_file(n:integer); var file_str:string; begin file_str:=file_viewer_form.folder_listbox.Directory+'\'+box_file_list.Strings[n]; reload_specified_file(False,False,file_str); file_viewer_form.Close; end; //______________________________________________________________________________ procedure fv_add_file(n:integer); var file_str:string; begin file_str:=file_viewer_form.folder_listbox.Directory+'\'+box_file_list.Strings[n]; reload_specified_file(False,True,file_str); file_viewer_form.Close; end; //______________________________________________________________________________ procedure fv_tags(n:integer); var tags_str,list_str:string; begin tags_str:=fv_tag_list.Strings[n]; if tags_str='' then list_str:='No name prefix tags have been used in this file.' else list_str:='The following prefix tags are used in this file:||'+tags_str; help(-8,IntToStr(n+1)+': '+box_file_list.Strings[n]+'||'+list_str,''); // -8 caption = 'prefix tags' end; //______________________________________________________________________________ procedure fv_read_me(n:integer); begin help(-7,IntToStr(n+1)+': '+box_file_list.Strings[n]+'||'+readme_list.Strings[n],''); // -7 caption = 'read me' end; //______________________________________________________________________________ procedure fv_rename_file(n:integer); var old_path_str,new_path_str,dir_str:string; old_name_str,new_name_str:string; saved_pos:integer; begin old_name_str:=box_file_list.Strings[n]; dir_str:=file_viewer_form.folder_listbox.Directory+'\'; with math_form do begin Caption:=' rename file ...'; big_label.Caption:=insert_crlf_str('||||Enter a new name for the file:||| '+IntToStr(n+1)+': '+old_name_str); math_editbox.Text:=old_name_str; math_editbox.SelectAll; try do_show_modal(math_form); if ModalResult=mrOK then begin new_name_str:=StringReplace(Trim(math_editbox.Text),'.box','',[rfReplaceAll, rfIgnoreCase])+'.box'; if new_name_str=old_name_str then EXIT; if new_name_str='.box' then begin show_modal_message('The new name cannot be blank.'); EXIT; end; old_path_str:=dir_str+old_name_str; new_path_str:=dir_str+new_name_str; if FileExists(new_path_str)=True then begin show_modal_message('Sorry, the file cannot be renamed because there is an existing file named:' +#13+#13+new_name_str +#13+#13+'in the same folder.'); EXIT; end; if FileExists(old_path_str)=True then begin if RenameFile(old_path_str,new_path_str)=True then begin html_str:=StringReplace(html_str,old_name_str,new_name_str,[rfReplaceAll, rfIgnoreCase]); box_file_list.Strings[n]:=new_name_str; saved_pos:=file_viewer_form.html_file_viewer.Position; use_bmp_image_streams:= NOT showing_as_png_files; // HTML viewer image requests file_viewer_form.html_file_viewer.LoadFromString(html_str); // reload modified content use_bmp_image_streams:=False; // restore normal load images from file file_viewer_form.html_file_viewer.Position:=saved_pos; // restore viewer position after reload. end else show_modal_message('Sorry, the file:'+#13+#13+old_path_str+#13+#13+'could not be renamed.'); end else show_modal_message('Sorry, the file:'+#13+#13+old_path_str+#13+#13+'could not be found.'); end; finally Caption:=' TEMPLOT'; // reset form caption. end;//try end;//with end; //______________________________________________________________________________ procedure fv_find_file(n:integer); var file_str:string; begin file_str:=file_viewer_form.folder_listbox.Directory+'\'+box_file_list.Strings[n]; if ShellExecute(0, nil, PChar('explorer.exe'), PChar('/select,'+file_str), nil, SW_SHOWNORMAL)<=32 then show_modal_message('Sorry, unable to open the containing folder.') else external_window_showing:=True; end; //______________________________________________________________________________ procedure fv_delete_file(n:integer); var file_str,path_str,update_str,dir_str:string; i,saved_width,saved_pos:integer; img_png:TPNGObject; img_str:string; begin file_str:=box_file_list.Strings[n]; saved_width:=alert_box.ClientWidth; if alert_box.ClientWidth<692 then alert_box.ClientWidth:=692; // to show 680 image dir_str:=file_viewer_form.folder_listbox.Directory+'\'; if showing_as_png_files=True then img_str:=img_name_list.Strings[n] else begin // save the bitmap as a file for alert box... img_str:=exe_str+'internal\fview\fv_deletion_confirm.png'; img_png:=TPNGObject.Create; img_png.Assign(Tbitmap(box_file_list.Objects[n])); img_png.SaveToFile(img_str); img_png.Free; end; try i:=alert(7,'php/950 delete this file ?', 'The current folder is: '+dir_str+'' +'||' +'||'+IntToStr(n+1)+': '+file_str+'' +'||You are about to delete this file from the current folder. This operation cannot be reversed.' +'||You may want to make a backup copy of the current folder before deleting files.' +'||Are you sure you want to delete this file ?', '','','','find file in current folder instead','no - cancel delete','yes - delete file',0); if i=5 then EXIT; if i=4 then begin fv_find_file(n); EXIT; end; path_str:=dir_str+file_str; if FileExists(path_str)=True then begin if DeleteFile(path_str)=True then begin update_str:=''+IntToStr(n+1)+': '+file_str+'' +'This file has been deleted.' +'refresh the list '; saved_pos:=file_viewer_form.html_file_viewer.Position; html_str:=StringReplace(html_str,next_html_list.Strings[n],update_str,[rfReplaceAll, rfIgnoreCase]); use_bmp_image_streams:= NOT showing_as_png_files; // HTML viewer image requests file_viewer_form.html_file_viewer.LoadFromString(html_str); use_bmp_image_streams:=False; // restore normal load images from file file_viewer_form.html_file_viewer.Position:=saved_pos; // restore viewer position after reload. end else show_modal_message('Sorry, the file:'+#13+#13+path_str+#13+#13+'could not be deleted.'); end else show_modal_message('Sorry, the file:'+#13+#13+path_str+#13+#13+'could not be found.'); finally alert_box.ClientWidth:=saved_width; // restore end;//try end; //______________________________________________________________________________ procedure fv_export_file(n:integer); // 224a var cur_pos:integer; begin if box_export_list.Strings[n]<>'1' then begin file_viewer_form.export_button.Enabled:=True; box_export_list.Strings[n]:='1'; some_selected:=True; end else box_export_list.Strings[n]:='0'; cur_pos:=file_viewer_form.html_file_viewer.Position; do_full_view; // update file_viewer_form.html_file_viewer.Position:=cur_pos; end; //______________________________________________________________________________ procedure Tfile_viewer_form.FormDestroy(Sender: TObject); var n:integer; begin img_name_list.Free; if box_file_list.Count>0 then begin for n:=0 to box_file_list.Count-1 do begin if Assigned(box_file_list.Objects[n]) then TBitmap(box_file_list.Objects[n]).Free; // free any bitmaps end; end; box_file_list.Free; box_size_list.Free; box_time_list.Free; box_export_list.Free; // 224a num_bgnd_list.Free; num_unused_list.Free; num_lib_list.Free; next_html_list.Free; readme_list.Free; fv_tag_list.Free; bmp_stream.Free; end; //______________________________________________________________________________ procedure no_readme_help(none:boolean); const readme_help_str:string='green_panel_begin tree.gif To add reference notes to your storage box or data file, store a template with the name `0read me`3.' +'||Enter your notes as the memo notes for that template.' +'||It can be an existing template, or a dummy template created for the purpose.' +'||If it is a background template, you can click on it and then `0edit memo notes...`1 on its menu.' +'||Or `0add jotter to memo`1 if you prefer to enter your notes on the jotter as you work.' +'||(You can add memo notes to any template, but only those for a template named `0read me`3 are available as read-me notes in the file viewer.)green_panel_end'; var none_str:string; begin if none=True then none_str:=' `0· There are no read-me reference notes for this file.`8||' else none_str:=''; if help(-7,'php/950'+none_str+readme_help_str,'more about the file viewer')=1 then file_viewer_form.help_button.Click; end; //______________________________________________________________________________ procedure Tfile_viewer_form.help_buttonClick(Sender: TObject); const fv_help_str:string='php/950 `0.box file viewer`9' +'||Select the disk drive and folder from which you want to browse your .box template files, and then click the|`0show files`1 button.' +'||A screenshot image will be created from each file, and displayed in a scrollable list.' +'||You can jump quickly down the list one file at a time by pressing or holding down the `0SPACE`2 bar. You can jump quickly back up the list by pressing or holding down `0SHIFT+SPACE`2.' +' You can jump to the top or bottom of the list by pressing the `0HOME`2 or `0END`2 keys.' +'||green_panel_begintree.gif The screenshots will reflect your current trackpad settings for colours, generator settings etc.' +'||They will be created much more quickly if you change to `0skeleton settings`1 in the `0generator`1 menu before using the viewer.green_panel_end' +'|If the screenshots are taking too long to create, press the `0ESC`2 key to cancel and then split the files into several smaller folders.' +'||You can choose whether to include the template name labels in the screenshots by ticking or unticking the|`0template name labels`1 tickbox.' +'||To load a file into Templot click the `0load this file`1 link below the relevant screenshot. Loading a file closes the file viewer.' +'||You can choose whether the screenshot images should also be clickable to load a file by ticking or unticking the|`0images clickable`1 tickbox. If an image is clickable it will be outlined in red when the mouse pointer moves over it.' +'||If you click the `0add from this file`1 link the templates from the selected file will be added to any existing templates in your storage box and on the trackpad.' +'||Click the `0tags`1 link to see a list of the template name prefix tags used in the selected file. If the link is greyed out it means that there are no tags used in the selected file.' +'||Click the `0read me`1 link to see the `0read me`3 notes for the selected file. If the link is greyed out it means that there are no notes for the selected file. For more information about `0read me`3 notes, click the bar below.' +'||If you would prefer the list to be created instantly without waiting for you to click the `0show files`1 button, tick the `0instant show files`1 tickbox.' +'||You can use the viewer to select .box files to be exported in the MECBOX format for transfer to the `0Templot3`3 and `0TemplotMEC`3 open-source versions of Templot.' +' Tick the export tickbox on each file to select it, and then click the `0export files`1 button. Or tick or untick the `0export all`1 tickbox to select or deselect all the files in the list.' +'||For more information about using the file viewer please click more information online.'; begin if help(0,fv_help_str,'more about ''read me'' notes')=1 then no_readme_help(False); html_file_viewer.SetFocus; end; //______________________________________________________________________________ procedure Tfile_viewer_form.close_buttonClick(Sender: TObject); begin Close; end; //______________________________________________________________________________ procedure Tfile_viewer_form.FormKeyDown(Sender:TObject; var Key:Word; Shift:TShiftState); begin if Key=VK_ESCAPE then begin escape_pressed:=True; Key:=0; end; if Key=VK_SPACE then begin if Shift=[ssShift] then begin DEC(spacebar_count); if spacebar_count<0 then spacebar_count:=readme_list.Count-1; // going up - back to the bottom end else begin INC(spacebar_count); if spacebar_count>(readme_list.Count-1) then spacebar_count:=0; // going down - back to the top end; html_file_viewer.PositionTo('#file'+IntToStr(spacebar_count)); Key:=0; end; if Key=VK_HOME then spacebar_count:=-1; // falls through to the viewer.. if Key=VK_END then spacebar_count:=readme_list.Count-1; end; //______________________________________________________________________________ procedure Tfile_viewer_form.FormActivate(Sender: TObject); var top_str,dir_str:string; file_count:integer; search_record_box:TSearchRec; begin pad_form.Hide; // no trackpad while viewer in use keep_form.Hide; // nor storage box if fv_has_been_active=False // first time only then begin dir_str:=folder_listbox.Directory+'\'; // add trailing slash file_count:=0; // init // count the files ... if FindFirst(dir_str+'*.box',0,search_record_box)=0 then begin INC(file_count); while FindNext(search_record_box)=0 do INC(file_count); end; FindClose(search_record_box); top_str:='' +'' +'' +'
  '+IntToStr(file_count)+'  .box  files  in  this  folder
    '+dir_str+'

'; use_bmp_image_streams:=False; // normal load images from file html_file_viewer.LoadFromString(top_str+html_create_str); if instant_show_checkbox.Checked=True // 208g then begin if control_room_form.viewer_png_menu_entry.Checked=True then show_files_as_png else show_files_as_bitmaps; end else refresh_button.Caption:='show files'; end; fv_has_been_active:=True; // bug fix for THTMLViewer -- prevent middle mouse button scrolling from using our custom cursors... Screen.Cursors[adjust_ns_cursor_invert]:=LoadCursor(0,IDC_SIZENS); // use N-S arrows scrolling instead. Screen.Cursors[adjust_we_cursor_invert]:=LoadCursor(0,IDC_SIZENS); Screen.Cursors[mouse_action_cursor]:=LoadCursor(0,IDC_SIZENS); end; //______________________________________________________________________________ procedure Tfile_viewer_form.FormDeactivate(Sender: TObject); begin // restore custom cursors for trackpad... Screen.Cursors[adjust_ns_cursor_invert]:=LoadCursor(HInstance,'CURSOR_ADJUST_NS_INVERT'); Screen.Cursors[adjust_we_cursor_invert]:=LoadCursor(HInstance,'CURSOR_ADJUST_WE_INVERT'); Screen.Cursors[mouse_action_cursor]:=LoadCursor(HInstance,'CURSOR_MOUSE_ACTION'); end; //______________________________________________________________________________ procedure Tfile_viewer_form.refresh_buttonClick(Sender: TObject); begin if control_room_form.viewer_png_menu_entry.Checked=True then show_files_as_png else show_files_as_bitmaps; end; //______________________________________________________________________________ procedure Tfile_viewer_form.open_folder_buttonClick(Sender: TObject); var dir_str:string; begin html_file_viewer.SetFocus; // for return dir_str:=file_viewer_form.folder_listbox.Directory+'\'; if ShellExecute(0,'explore',PChar(dir_str),nil,nil,SW_SHOWNORMAL)<=32 then show_modal_message('Sorry, unable to open the folder.') else external_window_showing:=True; end; //______________________________________________________________________________ procedure Tfile_viewer_form.size_updownClick(Sender:TObject; Button:TUDBtnType); begin no_onresize:=True; // don't permit on-resize until finished. if size_updown.Position>size_updown.Tag // ! position goes up, size goes down. then ScaleBy(9,10); // scale the form contents down. if size_updown.Position''); // show panel if element has a title. if mouse_hover_panel.Visible=True then begin mouse_hover_panel.Caption:=html_file_viewer.titleattr; mouse_hover_panel.Left:=X+20; mouse_hover_panel.Top:=Y+10; end; end; //______________________________________________________________________________ procedure show_files_as_bitmaps; const screenshot_width:integer=676; screenshot_height:integer=320; var i,n:integer; tag_count:integer; screen_rect,print_rect:TRect; create_bitmap:TBitmap; oldbox_str:string; // save box for restore old_save_done:boolean; search_record_box:TSearchRec; dir_str,boxfile_str:string; next_str:string; hl:integer; append:boolean; windows_cursor_count:integer; saved_hide_name_labels:boolean; ////////////////////////////////////////////////////////////////// procedure add_file_to_box_lists(search_record:TSearchRec); begin box_file_list.Add(search_record.Name); box_size_list.Add(IntToStr(Round(search_record.Size/1024))+' KB'); box_time_list.Add(DateToStr(FileDateToDateTime(search_record.Time))+'   '+TimeToStr(FileDateToDateTime(search_record.Time))); box_export_list.Add('0'); // 224a end; ////////////////////////////////////////////////////////////////// begin some_selected:=False; // init with file_viewer_form do begin // no changes while building list disk_drive_combo.Enabled:=False; folder_listbox.Enabled:=False; refresh_button.Enabled:=False; images_clickable_checkbox.Enabled:=False; name_labels_checkbox.Enabled:=False; instant_show_checkbox.Enabled:=False; export_button.Enabled:=False; export_all_checkbox.Enabled:=False; progress_bar.Position:=0; escape_pressed:=False; img_name_list.Clear; if box_file_list.Count>0 then begin for n:=0 to box_file_list.Count-1 do begin if Assigned(box_file_list.Objects[n]) then TBitmap(box_file_list.Objects[n]).Free; // free previous bitmaps end; end; box_file_list.Clear; box_size_list.Clear; box_time_list.Clear; box_export_list.Clear; // 224a num_bgnd_list.Clear; num_unused_list.Clear; num_lib_list.Clear; next_html_list.Clear; readme_list.Clear; fv_tag_list.Clear; dir_str:=folder_listbox.Directory+'\'; // add trailing slash // build the lists ... if FindFirst(dir_str+'*.box',0,search_record_box)=0 then begin add_file_to_box_lists(search_record_box); while FindNext(search_record_box)=0 do add_file_to_box_lists(search_record_box); end; FindClose(search_record_box); try if (box_file_list.Count>60) and (too_many_files_msg_pref=False) then begin alert_box.preferences_checkbox.Checked:=False; //%%%% alert_box.preferences_checkbox.Show; i:=alert(3,'php/950 large number of files', '||`0'+dir_str+'`f' +'||This folder contains a large number of .box files ('+IntToStr(box_file_list.Count)+').' +'||Creating all the screenshot images may take some time.' +'||You may prefer to cancel and organize your files into|sub-folders.' +'||If you continue you can press the `0ESC`2 key to stop the process.', '','','','cancel and open folder','cancel','continue',0); too_many_files_msg_pref:=alert_box.preferences_checkbox.Checked; alert_box.preferences_checkbox.Hide; case i of 4: begin open_folder_button.Click; EXIT; end; 5: EXIT; end;//case end; // please wait ... // 3 table columns... html_top_str:='   '+IntToStr(box_file_list.Count)+'  .box  files  in  this  folder  ' +'     '+dir_str+'' +'
'; if box_file_list.Count>0 then html_str:='   please wait while the images are generated' +'

    you can stop the process by pressing the ESC key' else html_str:=''; html_str:=html_header_str+html_top_str+html_str+html_footer_str; use_bmp_image_streams:=False; // normal load images from file html_file_viewer.LoadFromString(html_str); count_label.Caption:='0'; // some .box files to show? ... if box_file_list.Count>0 then begin showing_as_png_files:=False; images_label.Caption:='bitmaps'; escape_label.Show; count_label.Show; found_label.Show; ShowCursor(False); // Windows SDK progress_bar.Max:=box_file_list.Count; // first set up the trackpad... old_save_done:=save_done; // save flag in case a confirm is needed on a reload oldbox_str:=exe_str+'fv.ebk'; // save existing box DeleteFile(oldbox_str); // delete any previous file. save_box(0,0,0,oldbox_str); // save existing contents for restore later. saved_pad_width:=pad_form.ClientWidth; saved_pad_height:=pad_form.ClientHeight; saved_hide_name_labels:=hide_name_labels; hide_name_labels:= NOT name_labels_checkbox.Checked; pad_form.ClientWidth:=screenshot_width; // image size pad_form.ClientHeight:=screenshot_height; screen_rect:=Rect(0,0,screenshot_width,screenshot_height); print_rect:=screen_rect; for n:=0 to box_file_list.Count-1 do begin clear_keeps(False,False); // clear all templates append:=False; boxfile_str:=dir_str+box_file_list.Strings[n]; if Pos('.box',LowerCase(boxfile_str))=0 then boxfile_str:=boxfile_str+'.box'; // in case his system hides extensions. if load_storage_box(False,False,boxfile_str,False,False,append,hl)=True then begin if keeps_list.Count>0 then begin if (loaded_version<93) and (hl>-1) and (hl92) then mint_final_or_copy_control(hl); // copy the control template if there is one in the file. end; end; show_and_redraw(False,False); // update pad num_bgnd_list.Add(IntToStr(any_bgnd)); num_unused_list.Add(IntToStr(any_unused)); num_lib_list.Add(IntToStr(any_library)); readme_list.Add(get_readme_notes); tag_count:=build_tag_list(False); // tag_count not used tag_str:=''; if tag_list.Count>0 then begin for i:=0 to tag_list.Count-1 do begin tag_str:=tag_str+'     '+tag_list.Strings[i]+'|'; // add indent and separator end;//next end; fv_tag_list.Add(tag_str); create_bitmap:=TBitmap.Create; //try create_bitmap.Width:=screenshot_width; create_bitmap.Height:=screenshot_height; try create_bitmap.Canvas.CopyMode:=cmSrcCopy; create_bitmap.Canvas.CopyRect(print_rect,offdraw_bmp.Canvas,screen_rect); with create_bitmap.Canvas do begin Brush.Style:=bsSolid; Brush.Color:=clYellow; Font.Color:=clBlack; Font.Height:=0-13; Font.Style:=[fsBold]; Font.Name:='Arial'; TextOut(0,0,' '+IntToStr(n+1)+': '+fv_gauge_str+' '+box_project_title_str+' '); // add the short gauge label end;//with box_file_list.Objects[n]:=create_bitmap; except show_modal_message('Sorry, an error occurred in creating image:'+#13+#13+IntToStr(n+1)+' : '+box_file_list.Strings[n]); end;//try progress_bar.Position:=n+1; count_label.Caption:=IntToStr(n+1); Application.ProcessMessages; // for pressing ESC key if escape_pressed=True then BREAK; end;//next // restore trackpad... clear_keeps(False,False); // clear all templates append:=False; if load_storage_box(False,False,oldbox_str,False,False,append,hl)=True then begin if keeps_list.Count>0 then begin if (loaded_version<93) and (hl>-1) and (hl92) then mint_final_or_copy_control(hl); // copy the control template if there is one in the file. end; end; pad_form.ClientWidth:=saved_pad_width; pad_form.ClientHeight:=saved_pad_height; hide_name_labels:=saved_hide_name_labels; show_and_redraw(False,False); // update pad if any_bgnd<1 then pad_form.fit_current_only_menu_entry.Click; save_done:=old_save_done; // restore flag in case a confirm is needed on a reload do_full_view; // create the HTML view use_bmp_image_streams:=False; // restore normal image files spacebar_count:=-1; // init repeat windows_cursor_count:=ShowCursor(True); // Windows SDK until windows_cursor_count>-1; // ensure visible refresh_button.Caption:='refresh list'; end;//if count>0 finally disk_drive_combo.Enabled:=True; folder_listbox.Enabled:=True; refresh_button.Enabled:=True; images_clickable_checkbox.Enabled:=True; name_labels_checkbox.Enabled:=True; instant_show_checkbox.Enabled:=True; export_overwrite_checkbox.Enabled:=True; html_file_viewer.SetFocus; // for mouse wheel and arrow keys after selecting drive or folder. end;//try end;//with end; //______________________________________________________________________________ procedure Tfile_viewer_form.html_file_viewerImageRequest(Sender:TObject; const SRC:String; var Stream:TMemoryStream); var n:integer; begin if (control_room_form.viewer_png_menu_entry.Checked=True) or (use_bmp_image_streams=False) then EXIT; if POS('.',SRC)<>0 then EXIT; // normal image link try n:=StrToInt(SRC); except n:=0; end;//try bmp_stream.Clear; if Assigned(box_file_list.Objects[n]) then Tbitmap(box_file_list.Objects[n]).SaveToStream(bmp_stream); bmp_stream.Position:=0; Stream:=bmp_stream; end; //______________________________________________________________________________ procedure Tfile_viewer_form.FormClose(Sender:TObject; var Action:TCloseAction); begin pad_form.Show; // trackpad visible again if keep_form_was_showing=True then pad_form.view_box_menu_entry.Click; end; //______________________________________________________________________________ procedure Tfile_viewer_form.instant_show_checkboxClick(Sender: TObject); begin if instant_show_checkbox.Checked=True then refresh_button.Click; // 208g end; //______________________________________________________________________________ procedure do_full_view; // 224a var n:integer; begin with file_viewer_form do begin progress_bar.Position:=0; html_str:=html_header_str+html_top_str; if readme_list.Count=1 then num_files_str:=' file' else num_files_str:=' files'; if readme_list.Count  process stopped (ESC pressed)  -  showing '+IntToStr(readme_list.Count)+num_files_str+' only' +'  -  click  refresh list  to restart' +'
'; html_str:=html_str+' '; for n:=0 to readme_list.Count-1 do begin // add each image (if cancelled, this list may be shorter than the box list) if readme_list.Strings[n]='' then readme_str:='read me ? ' else readme_str:='read me   '; if fv_tag_list.Strings[n]='' then fv_tag_str:='tags' else fv_tag_str:='tags'; next_str:=''; if images_clickable_checkbox.Checked=True then next_str:=next_str+'' else next_str:=next_str+''; next_str:=next_str+'' +''+IntToStr(n+1)+':  '+box_file_list.Strings[n]+'' +''+box_size_list.Strings[n]+'    '+box_time_list.Strings[n]+'' +' load this file' +'   add from this file' +'   '+fv_tag_str +'   '+readme_str +'

  '; if box_export_list.Strings[n]='1' then next_str:=next_str+'  selected for export in MECBOX format' else next_str:=next_str+'  select this file for export in MECBOX format'; next_str:=next_str+'
' +'' +'this file:   rename ' +'
find ' +'
delete ' +'' +'background templates: '+num_bgnd_list.Strings[n]+' ' +'
unused templates: '+num_unused_list.Strings[n]+' ' +'
library templates: '+num_lib_list.Strings[n]+' '; html_str:=html_str+next_str +'
' +' '; next_html_list.Add(next_str); // keep this string part for possible delete / replace end;//next html_str:=html_str+html_footer_str; use_bmp_image_streams:=True; // use OnImageRequest to get the images html_file_viewer.LoadFromString(html_str); export_all_checkbox.Enabled:=True; end;//with end; //______________________________________________________________________________ procedure Tfile_viewer_form.export_all_checkboxClick(Sender: TObject); var n,cur_pos:integer; flag_str:string; begin if export_all_checkbox.Checked=True then begin export_button.Enabled:=True; flag_str:='1'; some_selected:=True; end else begin export_button.Enabled:=False; flag_str:='0'; end; if box_export_list.Count<1 then EXIT; // ??? for n:=0 to box_export_list.Count-1 do box_export_list.Strings[n]:=flag_str; cur_pos:=file_viewer_form.html_file_viewer.Position; do_full_view; // update file_viewer_form.html_file_viewer.Position:=cur_pos; end; //______________________________________________________________________________ procedure Tfile_viewer_form.export_buttonClick(Sender: TObject); var n,exported_count,cur_pos:integer; oldbox_str,dir_str,boxfile_str:string; old_save_done:boolean; mecbox_str:string; hl:integer; append:boolean; begin old_save_done:=save_done; // save flag in case a confirm is needed on a reload oldbox_str:=exe_str+'fv.ebk'; // save existing box DeleteFile(oldbox_str); // delete any previous file. save_box(0,0,0,oldbox_str); // save existing contents for restore later. dir_str:=folder_listbox.Directory+'\'; // add trailing slash exported_count:=0; for n:=0 to box_file_list.Count-1 do begin if box_export_list.Strings[n]<>'1' then CONTINUE; // not selected for export clear_keeps(False,False); // clear all templates append:=False; boxfile_str:=dir_str+box_file_list.Strings[n]; if Pos('.box',LowerCase(boxfile_str))=0 then boxfile_str:=boxfile_str+'.box'; // in case his system hides extensions. mecbox_str:=ChangeFileExt(boxfile_str,'.mecbox'); if (FileExists(mecbox_str)) and (export_overwrite_checkbox.Checked=False) then CONTINUE; if load_storage_box(False,False,boxfile_str,False,False,append,hl)=True then begin if keeps_list.Count>0 then begin export_mecbox(False,mecbox_str); // False= don't show export result INC(exported_count); box_export_list.Strings[n]:='0'; // deselect now exported end; end; end;//next file // restore.. clear_keeps(False,False); // clear all templates append:=False; if load_storage_box(False,False,oldbox_str,False,False,append,hl)=True then begin if keeps_list.Count>0 then begin if (loaded_version<93) and (hl>-1) and (hl92) then mint_final_or_copy_control(hl); // copy the control template if there is one in the file. end; end; DeleteFile(oldbox_str); save_done:=old_save_done; some_selected:=False; ShowMessage(IntToStr(exported_count)+' files were exported in MECBOX format' +#13+' to the currently selected folder.'); cur_pos:=file_viewer_form.html_file_viewer.Position; do_full_view; // update selections file_viewer_form.html_file_viewer.Position:=cur_pos; end; //______________________________________________________________________________ procedure Tfile_viewer_form.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin if some_selected=True then begin if alert(4,' export some files before closing viewer ?', 'You selected some files for export in MECBOX format but you did not export them.' +'||Do you want to export them now?', '','','','','no thanks','yes please',0)=6 then begin CanClose:=False; export_button.Click; end; end; end; //______________________________________________________________________________ end.