unit Main; { [Main] [1.5] Delphi 2005 June 2008 LICENSE The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at "http://www.mozilla.org/MPL/" Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is "[Main.pas] and [Main.dfm]". The Initial Developer of the Original Code is Martin Holmes (Victoria, BC, Canada, "http://www.mholmes.com/"). Copyright (C) 2005-8 Martin Holmes and the University of Victoria Computing and Media Centre. The code was co-developed for university and personal projects, and rights are shared by Martin Holmes and the University of Victoria. All Rights Reserved. } { Written by Martin Holmes, 2006. Updated steadily every since. This unit is the main form for the application. It contains the main application menus, toolbars etc., as well as the main TImgView32 control used for displaying the image which is being worked on. Most annotation of the image is done through the udlgAnnCat editing window, which is also always visible. Dependencies: TntUnicodeControls (Troy Wolbrink) Graphics32 () FormState for saving size/position etc. XDOM_4_1 (Dieter Köhler) mdhReplaceDialog (Martin Holmes) } interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, TntStdCtrls, ComCtrls, TntForms, FormState, TntControls, IconsIncluder, SplashAbout, ExtCtrls, GR32, GR32_Image, FileCtrl, TntClasses, GR32_Layers, GR32_RangeBars, GR32_Filters, GR32_Transforms, GR32_Resamplers, TntComCtrls, TntExtCtrls, ToolWin, Menus, RecentFiles, XDOM_4_1, AppEvnts, ActnList, TntActnList, TntDialogs, TntExtDlgs, IMTDocument, IMTDocGlobals, Annotation, Jpeg, GraphicEx, TntSysUtils, jclUnicode, jvConsts, mdhGraphics, mdhLibxml2, TntMenus, FileFunctions, ShellAPI, JvComponentBase, JvBaseDlg, JvProgressDialog, StringFunctions, Clipbrd, GenFunctions, Math, mdhHelp, AnnotationCategories, Thumbnail, mdhReplaceDialog, IMTSearch, SynEditHighlighter, SynHighlighterXML, SynEdit, SynMemo, InsertTag, TntClipbrd; type TLastFocusWin = (lfwNone, lfwTeiHeader, lfwAnnCat, lfwCatProp, lfwMain); type TufrmMain = class(TTntForm) ummMain: TTntMainMenu; umnFile: TTntMenuItem; umnEdit: TTntMenuItem; umnAnnotations: TTntMenuItem; umnTEI: TTntMenuItem; umnOptions: TTntMenuItem; umnHelp: TTntMenuItem; utbrMain: TTntToolBar; cmbScale: TTntComboBox; utbSep1: TTntToolButton; utbNew: TTntToolButton; utbOpen: TTntToolButton; utbSave: TTntToolButton; utbSaveAs: TTntToolButton; utbSep7: TTntToolButton; utbImportImage: TTntToolButton; utbSep5: TTntToolButton; utbTeiHeader: TTntToolButton; upnMainTitle: TTntPanel; ustImageTitle: TTntStaticText; ueTitle: TTntEdit; usbMain: TTntStatusBar; ImgView: TImgView32; imgSplash: TImage; udlgOpenFile: TTntOpenDialog; udlgLoadImage: TTntOpenPictureDialog; udlgSaveFile: TTntSaveDialog; umnNew: TTntMenuItem; ualMain: TTntActionList; aNew: TTntAction; aOpen: TTntAction; aSave: TTntAction; aSaveAs: TTntAction; aLoadImage: TTntAction; aQuit: TTntAction; umnOpen: TTntMenuItem; umnSave: TTntMenuItem; umnSaveAs: TTntMenuItem; N1: TTntMenuItem; umnRecentFiles: TTntMenuItem; umnLoadImage: TTntMenuItem; N2: TTntMenuItem; N3: TTntMenuItem; umnQuit: TTntMenuItem; umsgUnableToLoadImage: TTntLabel; aEditTeiHeader: TTntAction; umnEditTeiHeader: TTntMenuItem; umsgSaveChanges: TTntLabel; umsgUntitled: TTntLabel; aNewAnnotation: TTntAction; aDeleteAnnotations: TTntAction; utbSep2: TTntToolButton; utbNewAnnotation: TTntToolButton; utbDeleteAnnotation: TTntToolButton; aeMain: TApplicationEvents; umnNewAnnotation: TTntMenuItem; umnDeleteAnnotations: TTntMenuItem; umnPreferences: TTntMenuItem; aPreferences: TTntAction; aTranslate: TTntAction; umnTranslate: TTntMenuItem; aAddNewCategory: TTntAction; umnCategories: TTntMenuItem; umnAddNewCategory: TTntMenuItem; aCategoryManager: TTntAction; umnCategoryManager: TTntMenuItem; utbSep4: TTntToolButton; utbAddNewCategory: TTntToolButton; utbCategoryManager: TTntToolButton; aNewWithCategories: TTntAction; umnNewFiles: TTntMenuItem; umnNewWithCategories: TTntMenuItem; aCloneAnnotation: TTntAction; utbCloneAnnotation: TTntToolButton; utbSep3: TTntToolButton; utbSettings: TTntToolButton; umnSettings: TTntMenuItem; aCreateWebView: TTntAction; utbCreateWebView: TTntToolButton; N4: TTntMenuItem; umnCreateWebView: TTntMenuItem; umsgShowInBrowser: TTntLabel; udlgSaveHTMLFile: TTntSaveDialog; umsgFailedToRunBrowser: TTntLabel; jvdlgProgress: TJvProgressDialog; aAbout: TTntAction; umnAbout: TTntMenuItem; aEditUndo: TTntAction; umnEditUndo: TTntMenuItem; aEditCut: TTntAction; N5: TTntMenuItem; umnEditCut: TTntMenuItem; aEditCopy: TTntAction; umnEditCopy: TTntMenuItem; aEditPaste: TTntAction; umnEditPaste: TTntMenuItem; aEditDelete: TTntAction; umnEditDelete: TTntMenuItem; N6: TTntMenuItem; aEditSelectAll: TTntAction; umnSelectAll: TTntMenuItem; aExportToDocBook: TTntAction; udlgSaveDocBookFile: TTntSaveDialog; umnExportToDocBook: TTntMenuItem; umsgViewXMLFile: TTntLabel; umsgUnableToShowXMLFile: TTntLabel; udlgOpenDocBookFile: TTntOpenDialog; aImportDocBookFile: TTntAction; umnImportDocBookFile: TTntMenuItem; umsgFileConverted: TTntLabel; umsgUnableToFindFile: TTntLabel; umsgUnableToSaveTempFile: TTntLabel; aShowAnnCatWindow: TTntAction; utbShowAnnCatWindow: TTntToolButton; umnView: TTntMenuItem; umnShowAnnCatWindow: TTntMenuItem; umsgUnableToFindImage: TTntLabel; umsgFiguringOutFileNames: TTntLabel; umsgCreatingImageFiles: TTntLabel; umsgCreatingWebFiles: TTntLabel; umsgDoingXSLTransformation: TTntLabel; umsgReplaceThisImage: TTntLabel; umsgCreatingWebView: TTntLabel; aTutorial: TTntAction; umnTutorial: TTntMenuItem; aHelpContents: TTntAction; umnHelpContents: TTntMenuItem; aCloseFile: TTntAction; umnCloseFile: TTntMenuItem; aCreateZipPackage: TTntAction; umsgNoImageFileLoaded: TTntLabel; umnCreateZipPackage: TTntMenuItem; aImportCategories: TTntAction; umsgUnableToLoadFile: TTntLabel; umnImportCategories: TTntMenuItem; aCreateWebViewZip: TTntAction; umnCreateWebViewZip: TTntMenuItem; aCreateThumbnail: TTntAction; udlgSaveThumbnail: TTntSaveDialog; umnCreateThumbnail: TTntMenuItem; umsgUnableToSaveThumbnail: TTntLabel; umsgViewThumbnailImage: TTntLabel; umsgSaveFileBeforeWebView: TTntLabel; aSettings: TTntAction; aFind: TTntAction; umsgStringNotFound: TTntLabel; umsgSaveModifiedData: TTntLabel; umsgFailedReplacements: TTntLabel; N7: TTntMenuItem; umnFind: TTntMenuItem; umnCloneAnnotation: TTntMenuItem; aInsertTag: TTntAction; umnInsertTag: TTntMenuItem; umsgCheckForUpdate: TTntLabel; aCheckForUpdate: TTntAction; umnCheckForUpdate: TTntMenuItem; umsgUnableToBrowseSite: TTntLabel; umsgUrlOnClipboard: TTntLabel; umsgGoToSiteManually: TTntLabel; upopImage: TTntPopupMenu; Cloneannotation1: TTntMenuItem; Newannotation1: TTntMenuItem; Deleteannotations1: TTntMenuItem; N8: TTntMenuItem; Createthumbnail1: TTntMenuItem; N9: TTntMenuItem; Loadanimage1: TTntMenuItem; procedure aCheckForUpdateExecute(Sender: TObject); procedure TntFormDeactivate(Sender: TObject); procedure TntFormActivate(Sender: TObject); procedure aInsertTagExecute(Sender: TObject); procedure ustImageTitleDblClick(Sender: TObject); procedure aFindExecute(Sender: TObject); procedure aSettingsExecute(Sender: TObject); procedure aCreateThumbnailExecute(Sender: TObject); procedure aCreateWebViewZipExecute(Sender: TObject); procedure aImportCategoriesExecute(Sender: TObject); procedure aCreateZipPackageExecute(Sender: TObject); procedure aCloseFileExecute(Sender: TObject); function aeMainHelp(Command: Word; Data: Integer; var CallHelp: Boolean): Boolean; procedure aHelpContentsExecute(Sender: TObject); procedure aTutorialExecute(Sender: TObject); procedure aShowAnnCatWindowExecute(Sender: TObject); procedure aImportDocBookFileExecute(Sender: TObject); procedure aExportToDocBookExecute(Sender: TObject); procedure aEditSelectAllExecute(Sender: TObject); procedure aEditDeleteExecute(Sender: TObject); procedure aEditPasteExecute(Sender: TObject); procedure aEditCopyExecute(Sender: TObject); procedure aEditCutExecute(Sender: TObject); procedure aEditUndoExecute(Sender: TObject); procedure aAboutExecute(Sender: TObject); procedure aCreateWebViewExecute(Sender: TObject); procedure aCloneAnnotationExecute(Sender: TObject); procedure aOpenExecute(Sender: TObject); procedure aNewWithCategoriesExecute(Sender: TObject); procedure aLoadImageExecute(Sender: TObject); procedure aCategoryManagerExecute(Sender: TObject); procedure aAddNewCategoryExecute(Sender: TObject); procedure aTranslateExecute(Sender: TObject); procedure aPreferencesExecute(Sender: TObject); procedure aeMainIdle(Sender: TObject; var Done: Boolean); procedure aDeleteAnnotationsExecute(Sender: TObject); procedure aNewAnnotationExecute(Sender: TObject); procedure cmbScaleChange(Sender: TObject); procedure ImgViewMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer); procedure aQuitExecute(Sender: TObject); procedure TntFormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure aNewExecute(Sender: TObject); procedure aSaveAsExecute(Sender: TObject); procedure aSaveExecute(Sender: TObject); procedure ueTitleExit(Sender: TObject); procedure TntFormClose(Sender: TObject; var Action: TCloseAction); procedure aEditTeiHeaderExecute(Sender: TObject); procedure ImgViewMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure ImgViewMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure ImgViewMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer); procedure ImgViewMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer); procedure TntFormShow(Sender: TObject); procedure TntFormCreate(Sender: TObject); private FFormStateSaver: TFormStateSaver; //URL for application updates FUpdateURL: WideString; FSelection: TPositionedLayer; FRecentFiles: TRecentFiles; CurrFileName: WideString; DraggingImage: Boolean; ImageDragOrigin: TPoint; procedure SetSelection(const Value: TPositionedLayer); procedure OpenImage(const FileName: WideString; ClearAnns, ClearCats: Boolean); procedure StashTitle; function SaveChanges: Boolean; function Save: Boolean; function SaveAs: Boolean; procedure ClearDocument; procedure UpdateCaption; procedure BeginImageDrag(X, Y: integer); function ExportToDocbook(OutFile: WideString): Boolean; function ImportDocBookFile(InFile: WideString): Boolean; function SaveImageAsJPEG(OutFile: WideString): Boolean; procedure ClearDialogBoxes; procedure WMDROPFILES(var Message: TWMDROPFILES); message WM_DROPFILES; function CreateWebView(OutputFile: WideString; FileList: TTntStringList; Silent: Boolean): Boolean; procedure GetCursorLocation(Sel: TIMTSelection); procedure ShowSelection(Sel: TIMTSelection; Replace: Boolean; ReplaceWith: WideString); function IsAltDown: Boolean; function IsCtrlDown: Boolean; function IsShiftDown: Boolean; { Private declarations } protected RBLayer: TRubberbandLayer; procedure RBResizing(Sender: TObject; const OldLocation: TFloatRect; var NewLocation: TFloatRect; DragState: TDragState; Shift: TShiftState); public IMTDoc: TIMTDoc; //This is the document object for the application SplashAbout: TSplashAbout; LastFocusWin: TLastFocusWin; procedure SetSelectedLayerByAnnNum(AnnNum: integer); procedure OpenRecent(Sender: TObject; const FileName: WideString); {In the following, the LoadAsNew parameter allows us to load a temp file without adding it to the recent files list or saving back over it.} procedure OpenFile(TheFileName: WideString; LoadAsNew: Boolean); {The following function preloads an XML file to check what version of the IMT created it. If it's from an older version of IMT, then it can be transformed with XSLT to the current version, and then the temp converted file can be loaded.} function GetIMTFileVersion(InFile: WideString; var Maj, Min: integer): Boolean; {This converts an old IMT file to a new version by calling libxml2 to do an XSLT transformation on it, saving it in a temp location, and passing back that location. If WideFileExists on the return value is false, then it means no conversion was performed.} function ConvertIMTFile(InFile: WideString; FromVersionMaj, FromVersionMin, ToVersionMaj, ToVersionMin: integer): WideString; function StashDirtyData: Boolean; //Functions for searching (interfacing between the GUI, the Find/Replace //dialog, and the document's own self-searching capabilities). procedure Find(wsFind: WideString; MatchCase, WholeWordOnly, Down: Boolean); function FindNext(wsFind: WideString; MatchCase, WholeWordOnly, Down: Boolean; Replace: Boolean; ReplaceWith: WideString): Boolean; procedure FindAll(wsFind: WideString; uslHits: TTntStringList; MatchCase, WholeWordOnly, Down: Boolean); procedure Replace(wsFind, wsReplaceWith: WideString; var Replaced: Boolean; MatchCase, WholeWordOnly, Down: Boolean); procedure ReplaceAll(wsFind, wsReplaceWith: WideString; var TotalReplacements: integer; MatchCase, WholeWordOnly, Down: Boolean); procedure GoToSearchHit(ItemNum: integer); procedure FitImageToWindow; function GetCurrFileName: WideString; { Public declarations } published property Selection: TPositionedLayer read FSelection write SetSelection; end; var ufrmMain: TufrmMain; const crHand = 300; implementation uses dlgAnnCat, Preferences, TeiHeader, translate, dlgCategoryManager, FileOverwriteConfirm, zipmasterfunc, zipprogress, Settings, dlgCategoryProperties; {$R *.dfm} {$R cursors.res} procedure TufrmMain.TntFormCreate(Sender: TObject); begin Screen.Cursors[crHand]:= LoadCursor(hInstance, 'CRHAND'); IMTDoc := TIMTDoc.Create(ImgView); CurrFileName := ''; DraggingImage := False; DragAcceptFiles(Self.Handle, True); AppHelpFile := WideExtractFilePath(Application.ExeName) + 'help\help.htm'; //Set the update URL (hard-coded). Changed to hcmc url for 1.8.2.2. //FUpdateURL := 'http://www.tapor.uvic.ca/~mholmes/image_markup/update.php'; FUpdateURL := 'http://hcmc.uvic.ca/~mholmes/image_markup/update.php'; LastFocusWin := lfwTeiHeader; end; procedure TufrmMain.TntFormShow(Sender: TObject); begin FFormStateSaver := TFormStateSaver.Create(Self, True, True, False, False, False, False, False, False, True); FRecentFiles := TRecentFiles.Create(Self, umnRecentFiles, OpenRecent); //If it's the first run, add an example files to the file menu if FRecentFiles.LastFile = '' then FRecentFiles.AddNewFile(ExtractFilePath(Application.ExeName) + 'tutorial\example_01.xml'); SplashAbout := TSplashAbout.Create; SplashAbout.ShowSplash(imgSplash.Picture.Bitmap, 3, BoundsRect); //Set the imtSchemaFileName based on the app version number imtSchemaFileName := 'imt_' + IntToStr(SplashAbout.AppVersionInfo.V1) + '_' + IntToStr(SplashAbout.AppVersionInfo.V2); //Initialize the image control and associated objects Selection := nil; RBLayer := nil; ImgView.Layers.Clear; ImgView.Scale := 1; ufrmAnnCat.IMTDoc := IMTDoc; ufrmAnnCat.SetSelectedLayerProc := SetSelectedLayerByAnnNum; ufrmAnnCat.Show; //Store a copy of the original, hard-coded English strings ufrmPreferences.StoreOriginalAppRef; //Now load the last set of settings ufrmPreferences.ReadSettingsFromDisk; //If user has configured the preference to reload the last file, try to do so if ufrmPreferences.ucbReloadLastFileOnStartup.Checked then if FileExists(FRecentFiles.LastFile) then OpenFile(FRecentFiles.LastFile, False); UpdateCaption; if (isShiftDown = True) then ufrmAnnCat.FormStyle := fsNormal; ufrmAnnCat.BringToFront; //See if we need to check for updates FFormStateSaver.UpdateURL := FUpdateURL; if FFormStateSaver.IsUpdateCheckDue then begin if WideMessageDlg(umsgCheckForUpdate.Caption, mtConfirmation, [mbYes, mbNo], 0) = mrYes then aCheckForUpdateExecute(nil); FFormStateSaver.UpdatePrompted := True; end; end; procedure TufrmMain.ImgViewMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer); begin if (Layer = RBLayer) and (RBLayer <> nil) then Exit; if Layer = nil then //We're selecting nothing, which = deselecting any current selection. begin ufrmAnnCat.CurrAnnNum := -1; BeginImageDrag(X,Y); ReleaseCapture; end else begin if Layer is TPositionedLayer then begin //Check whether it's the currently-selected layer or not //If it is, then just exit because we don't need to do anything if Layer = Selection then Exit; //So we need to set the selection ufrmAnnCat.CurrAnnNum := TPositionedLayer(Layer).Tag; //(That should trigger the callback from the ufrmAnnCat which actually //selects the layer on the image.) end; end; end; procedure TufrmMain.SetSelectedLayerByAnnNum(AnnNum: integer); var i: integer; begin //If it's being set to -1, then set selection to nil if AnnNum < 0 then begin SetSelection(nil); Exit; end; //See if there's a matching layer to select for this annnum if ImgView.Layers.Count > 0 then for i := 0 to ImgView.Layers.Count-1 do if TPositionedLayer(ImgView.Layers[i]).Tag = AnnNum then if FSelection <> TPositionedLayer(ImgView.Layers[i]) then SetSelection(TPositionedLayer(ImgView.Layers[i])); end; procedure TufrmMain.SetSelection(const Value: TPositionedLayer); begin if RBLayer <> nil then begin RBLayer.ChildLayer := nil; RBLayer.LayerOptions := LOB_NO_UPDATE; RBLayer.Visible := False; if FSelection <> nil then FSelection.Update; ImgView.Invalidate; end; if Value <> FSelection then begin FSelection := Value; if Value <> nil then begin if RBLayer = nil then begin RBLayer := TRubberBandLayer.Create(ImgView.Layers); RBLayer.MinHeight := 1; RBLayer.MinWidth := 1; RBLayer.Tag := -100; //make sure it's not the same as any other layer tag end; RBLayer.Visible := True; RBLayer.BringToFront; RBLayer.ChildLayer := Value; RBLayer.LayerOptions := LOB_VISIBLE or LOB_MOUSE_EVENTS or LOB_NO_UPDATE; RBLayer.OnResizing := RBResizing; end; end; end; procedure TufrmMain.RBResizing(Sender: TObject; const OldLocation: TFloatRect; var NewLocation: TFloatRect; DragState: TDragState; Shift: TShiftState); var w, h, cx, cy: Single; nw, nh: Single; begin if DragState = dsMove then Exit; // we are interested only in scale operations if Shift = [] then Exit; // special processing is not required if ssCtrl in Shift then begin { make changes symmetrical } with OldLocation do begin cx := (Left + Right) / 2; cy := (Top + Bottom) / 2; w := Right - Left; h := Bottom - Top; end; with NewLocation do begin nw := w / 2; nh := h / 2; case DragState of dsSizeL: nw := cx - Left; dsSizeT: nh := cy - Top; dsSizeR: nw := Right - cx; dsSizeB: nh := Bottom - cy; dsSizeTL: begin nw := cx - Left; nh := cy - Top; end; dsSizeTR: begin nw := Right - cx; nh := cy - Top; end; dsSizeBL: begin nw := cx - Left; nh := Bottom - cy; end; dsSizeBR: begin nw := Right - cx; nh := Bottom - cy; end; end; if nw < 10 then nw := 10; if nh < 10 then nh := 10; Left := cx - nw; Right := cx + nw; Top := cy - nh; Bottom := cy + nh; end; end; end; procedure TufrmMain.ImgViewMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer); var P, ScrollBy: TPoint; begin if DraggingImage then begin P := Point(X,Y); ScrollBy := Point((ImageDragOrigin.X-P.X), (ImageDragOrigin.Y-P.Y)); ImgView.Scroll(ScrollBy.X, ScrollBy.Y); ImageDragOrigin := P; end else begin // get coordinates of mouse position P := ImgView.ControlToBitmap(Point(X,Y)); usbMain.Panels[1].Text := 'x: ' + IntToStr(P.X) + ', y: ' + IntToStr(P.Y); end; end; procedure TufrmMain.ImgViewMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); var s: Single; begin { Scrolling behaviour goes like this: if mousewheel only, then vertical scroll. if Shift + mousewheel, then horizontal scroll. if Control + mousewheel, then zoom. } if (ssCtrl in Shift) then begin s := ImgView.Scale / 1.1; if s < 0.1 then s := 0.1; ImgView.Scale := s; cmbScale.Text := IntToStr(Round(s * 100)) + '%'; //Now centre the current annotation, if there is one. if ufrmAnnCat.CurrAnnNum > -1 then IMTDoc.ScrollAnnToCenter(ufrmAnnCat.CurrAnnNum); end else if (ssShift in Shift) then ImgView.Scroll(-1, -0) else ImgView.Scroll(0, -1); Handled := True; end; procedure TufrmMain.ImgViewMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); var s: Single; begin { Scrolling behaviour goes like this: if mousewheel only, then vertical scroll. if Shift + mousewheel, then horizontal scroll. if Control + mousewheel, then zoom. } if (ssCtrl in Shift) then begin s := ImgView.Scale * 1.1; if s > 10 then s := 10; ImgView.Scale := s; cmbScale.Text := IntToStr(Round(s * 100)) + '%'; //Now centre the current annotation, if there is one. if ufrmAnnCat.CurrAnnNum > -1 then IMTDoc.ScrollAnnToCenter(ufrmAnnCat.CurrAnnNum); end else if (ssShift in Shift) then ImgView.Scroll(1, 0) else ImgView.Scroll(0, 1); Handled := True; end; procedure TufrmMain.OpenImage(const FileName: WideString; ClearAnns, ClearCats: Boolean); begin if ClearAnns then begin IMTDoc.IMTAnnList.Empty; CurrFileName := ''; UpdateCaption; if ClearCats then IMTDoc.AnnCatList.Empty; ufrmAnnCat.Clear; end; with ImgView do begin try Selection := nil; RBLayer := nil; Scale := 1; cmbScale.Text := '100%'; Cursor := crHourglass; Screen.Cursor := crHourglass; NudgeCursor; Application.ProcessMessages; try Application.ProcessMessages; try Bitmap.LoadFromFile(FileName); Application.ProcessMessages; FitImageToWindow; Application.ProcessMessages; except WideMessageDlg(umsgUnableToLoadImage.Caption, mtWarning, [mbOK], 0); Exit; end; finally Cursor := crDefault; Screen.Cursor := crDefault; end; IMTDoc.ImageFilePath := FileName; if ClearAnns then begin ueTitle.Text := WideExtractFileName(FileName); IMTDoc.DocTitle := ueTitle.Text; IMTDoc.ProjDesc := IntToStr(Bitmap.Width) + ' x ' + IntToStr(Bitmap.Height); end else IMTDoc.ProjDesc := IMTDoc.ProjDesc + ' ' + IntToStr(Bitmap.Width) + ' x ' + IntToStr(Bitmap.Height); finally //Any other final processing should go here, to ensure that state is returned to normal. end; end; end; procedure TufrmMain.aEditTeiHeaderExecute(Sender: TObject); begin StashTitle; ufrmTeiHeader.usmTeiHeader.Text := WideTrim(IMTDoc.wsTEIHeader); if ufrmTeiHeader.ShowModal = mrOK then begin IMTDoc.wsTEIHeader := ufrmTeiHeader.usmTeiHeader.Text; ueTitle.Text := IMTDoc.DocTitle; end; end; procedure TufrmMain.TntFormClose(Sender: TObject; var Action: TCloseAction); begin FreeAndNil(IMTDoc); FreeAndNil(FFormStateSaver); FreeAndNil(FRecentFiles); FreeAndNil(SplashAbout); end; procedure TufrmMain.OpenRecent(Sender: TObject; const FileName: WideString); begin OpenFile(FileName, False); end; procedure TufrmMain.OpenFile(TheFileName: WideString; LoadAsNew: Boolean); var NewScale: double; FileVerMaj: integer; FileVerMin: integer; TempFile: WideString; begin if (not IMTDoc.Modified) or SaveChanges then begin TempFile := ''; //Check the file version, and do a conversion if necessary GetIMTFileVersion(TheFileName, FileVerMaj, FileVerMin); if (FileVerMaj <> SplashAbout.AppVersionInfo.V1) or (FileVerMin <> SplashAbout.AppVersionInfo.V2) then begin TempFile := ConvertIMTFile(TheFileName, FileVerMaj, FileVerMin, SplashAbout.AppVersionInfo.V1, SplashAbout.AppVersionInfo.V2); if FileExists(TempFile) then begin //Set up to load the temp converted file instead of the original TheFileName := TempFile; LoadAsNew := True; //Tell the user what's happened. WideShowMessage(umsgFileConverted.Caption); end; end; Screen.Cursor := crHourglass; ImgView.Cursor := crHourglass; NudgeCursor; try Application.ProcessMessages; ClearDocument; ClearDialogBoxes; if IMTDoc.LoadFromXMLFile(TheFileName) = True then begin if LoadAsNew then IMTDoc.Modified := True else begin CurrFileName := TheFileName; FRecentFiles.AddNewFile(CurrFileName); UpdateCaption; end; ueTitle.Text := IMTDoc.DocTitle; Application.ProcessMessages; ufrmAnnCat.InitializeCategories; Screen.Cursor := crHourglass; Application.ProcessMessages; try if not (WideFileExists(IMTDoc.ImageFilePath)) then begin Screen.Cursor := crDefault; WideMessageDlg(umsgUnableToFindImage.Caption, mtWarning, [mbOK], 0); Exit; end; ImgView.Bitmap.LoadFromFile(IMTDoc.ImageFilePath); //Finally, let's set the scale appropriately so the image is contained by the //viewport. FitImageToWindow; except Screen.Cursor := crDefault; WideMessageDlg(umsgUnableToLoadImage.Caption, mtWarning, [mbOK], 0); Exit; end; end; finally //Delete the temp file if one has been created if WideFileExists(TempFile) then DeleteFile(TempFile); ImgView.Cursor := crDefault; Screen.Cursor := crDefault; end; end; end; function TufrmMain.GetIMTFileVersion(InFile: WideString; var Maj, Min: integer): Boolean; var wsInput: WideString; DomImpl: TDomImplementation; DomDoc: TDomDocument; XMLToDomParser: TXMLToDomParser; AppInfoNode, AppDetailNode, AppNode: TDomElement; VerString: WideString; sList: TStringList; i, j: integer; begin //Default returns might as well be the current app version. Maj := SplashAbout.AppVersionInfo.V1; Min := SplashAbout.AppVersionInfo.V2; Result := False; //Get the file into a widestring WLoadFileToString(InFile, wsInput); //First, look for signs of the old v 0.9 if Pos(WideString('type="imtAnnotationLayer"'), wsInput) > 0 then begin Maj := 0; Min := 9; Result := True; Exit; end; DomImpl := TDomImplementation.Create(Self); try DomDoc := TDomDocument.Create(DomImpl); try XMLToDomParser := TXMLToDomParser.Create(DomImpl); try XMLToDomParser.DOMImpl := DomImpl; DomDoc := XMLToDomParser.ParseFile(InFile, False); if DomDoc.GetElementsByTagName(teiAppInfoTag).Length > 0 then for i := 0 to DomDoc.GetElementsByTagName(teiAppInfoTag).Length-1 do begin AppInfoNode := TDomElement(DomDoc.GetElementsByTagName(teiAppInfoTag).Item(i)); if (AppInfoNode.GetAttributeNormalizedValue('xml:id') = SplashAbout.AppVersionInfo.InternalName) {Original appInfo proposal} or {old internal name} (AppInfoNode.GetAttributeNormalizedValue('xml:id') = 'ImageMarkupTool1') then begin if AppInfoNode.GetElementsByTagName(teiAppDetailTag).Length > 0 then for j := 0 to AppInfoNode.GetElementsByTagName(teiAppDetailTag).Length-1 do begin AppDetailNode := TDomElement(AppInfoNode.GetElementsByTagName(teiAppDetailTag).Item(j)); if AppDetailNode.GetAttributeNormalizedValue('adType') = teiAppVersion then begin VerString := WideTrim(AppDetailNode.TextContent); sList := TStringList.Create; try sList.Delimiter := '.'; sList.DelimitedText := string(VerString); if sList.Count > 0 then Maj := StrToIntDef(Trim(sList[0]), Maj); if sList.Count > 1 then Min := StrToIntDef(Trim(sList[1]), Min); Result := True; finally FreeAndNil(sList); end; end; end; end else begin if AppInfoNode.GetElementsByTagName(teiAppTag).Length > 0 then begin AppNode := TDomElement(AppInfoNode.GetElementsByTagName(teiAppTag).Item(0)); if (AppNode.GetAttributeNormalizedValue('ident') = SplashAbout.AppVersionInfo.InternalName) {P5 final release} then begin VerString := WideTrim(AppNode.GetAttributeNormalizedValue('version')); sList := TStringList.Create; try sList.Delimiter := '.'; sList.DelimitedText := string(VerString); if sList.Count > 0 then Maj := StrToIntDef(Trim(sList[0]), Maj); if sList.Count > 1 then Min := StrToIntDef(Trim(sList[1]), Min); Result := True; finally FreeAndNil(sList); end; end; end; end; end; finally FreeAndNil(XMLToDomParser); end; finally FreeAndNil(DomDoc); end; finally FreeAndNil(DomImpl); end; end; function TufrmMain.ConvertIMTFile(InFile: WideString; FromVersionMaj, FromVersionMin, ToVersionMaj, ToVersionMin: integer): WideString; var CurrCursor: integer; TempFile: WideString; XSLFile: WideString; begin Result := ''; //default false/fail return //Check the file exists if not WideFileExists(InFile) then Exit; CurrCursor := Screen.Cursor; Screen.Cursor := crHourglass; try //Find a temp folder location + file we can use TempFile := WideString(WideExtractFilePath(InFile) + 'imt_' + UniqueIDFromTime + '.xml'); Application.ProcessMessages; //Get the location of the transformation stylesheet XSLFile := WideExtractFilePath(Application.ExeName) + 'conversions\imt_' + IntToStr(FromVersionMaj) + '_' + IntToStr(FromVersionMin) + '_to_imt_' + IntToStr(ToVersionMaj) + '_' + IntToStr(ToVersionMin) + '.xsl'; Application.ProcessMessages; //Check that exists if not WideFileExists(XSLFile) then begin WideMessageDlg(umsgUnableToFindFile.Caption + #13#10#13#10 + XSLFile, mtWarning, [mbOK], 0); Exit; end; //Do the transformation if mdhDoXSLTTransform(InFile, XSLFile, TempFile) = True then begin //If successful, pass back the path to the temp file Application.ProcessMessages; Result := TempFile; end; finally Screen.Cursor := CurrCursor; end; end; procedure TufrmMain.ueTitleExit(Sender: TObject); begin StashTitle; end; function TufrmMain.Save: Boolean; begin StashTitle; if Length(CurrFileName) > 0 then begin Result := IMTDoc.SaveToXMLFile(CurrFileName, ufrmSettings.ucbCopySchemaWhenSaving.Checked); FRecentFiles.AddNewFile(CurrFileName); end else Result := SaveAs; end; function TufrmMain.SaveChanges: Boolean; begin Result := False; if WideMessageDlg(umsgSaveChanges.Caption, mtConfirmation, [mbYes, mbNo], 0) = mrYes then Result := Save else Result := True; end; function TufrmMain.SaveAs: Boolean; var FileList: TTntStringList; SchemaFileName: WideString; begin Result := False; StashTitle; if udlgSaveFile.Execute then begin //Various scenarios may pertain here; we have to handle each separately. FileList := TTntStringList.Create; try //Do we need to confirm overwrite of the xml file itself? FileList.Add(udlgSaveFile.FileName); //How about the schema? SchemaFileName := WideExtractFilePath(udlgSaveFile.FileName) + imtSchemaFileName + '.rng'; if ufrmSettings.ucbCopySchemaWhenSaving.Checked then FileList.Add(SchemaFileName); if ufrmFileOverwriteConfirm.CheckForOverwrites(FileList) then begin if ufrmFileOverwriteConfirm.ShowModal <> mrCancel then begin //First, file only (no schema): if ufrmSettings.ucbCopySchemaWhenSaving.Checked = False then begin if ufrmFileOverwriteConfirm.CanOverwrite(udlgSaveFile.FileName) then Result := IMTDoc.SaveToXMLFile(udlgSaveFile.FileName, False); end else begin if (ufrmFileOverwriteConfirm.CanOverwrite(udlgSaveFile.FileName)) then Result := IMTDoc.SaveToXMLFile(udlgSaveFile.FileName, (ufrmSettings.ucbCopySchemaWhenSaving.Checked and ufrmFileOverwriteConfirm.CanOverwrite(SchemaFileName))); end; end; end else begin Result := IMTDoc.SaveToXMLFile(udlgSaveFile.FileName, ufrmSettings.ucbCopySchemaWhenSaving.Checked); end; finally FreeAndNil(FileList); end; if Result = True then begin CurrFileName := udlgSaveFile.FileName; FRecentFiles.AddNewFile(CurrFileName); end; UpdateCaption; end; end; procedure TufrmMain.aSaveExecute(Sender: TObject); begin Save; end; procedure TufrmMain.aSaveAsExecute(Sender: TObject); begin SaveAs; end; procedure TufrmMain.aNewExecute(Sender: TObject); begin StashTitle; if (not IMTDoc.Modified) or SaveChanges then begin ClearDocument; ClearDialogBoxes; if udlgLoadImage.Execute then OpenImage(udlgLoadImage.FileName, True, True); end; end; procedure TufrmMain.aNewWithCategoriesExecute(Sender: TObject); begin StashTitle; if (not IMTDoc.Modified) or SaveChanges then begin CurrFileName := ''; ClearDialogBoxes; UpdateCaption; IMTDoc.IMTAnnList.Empty; ufrmAnnCat.Clear; if udlgLoadImage.Execute then OpenImage(udlgLoadImage.FileName, True, False); end; end; procedure TufrmMain.aOpenExecute(Sender: TObject); begin if udlgOpenFile.Execute then OpenFile(udlgOpenFile.FileName, False); end; procedure TufrmMain.ClearDocument; var BGColor32: TColor32; begin //Get a background colour which is appropriate for filling the bitmap space BGColor32 := Color32(ImgView.Color); Selection := nil; RBLayer := nil; //Clear the document first, because destroying the annotations will also //free their asociated layers. IMTDoc.Empty; with ImgView do begin // Selection := nil; // RBLayer := nil; Layers.Clear; Application.ProcessMessages; Scale := 1; Bitmap.Clear(BGColor32); Invalidate; cmbScale.Text := '100%'; end; ufrmAnnCat.Clear; CurrFileName := ''; ueTitle.Text := ''; UpdateCaption; end; procedure TufrmMain.UpdateCaption; var ShortName: TFileName; begin ShortName := MinimizeName(TFileName(CurrFileName), Canvas, Width div 2); if Caption <> Application.Title + ': ' + WideString(ShortName) then if Length(ShortName) > 0 then Caption := Application.Title + ': ' + WideString(ShortName) else Caption := Application.Title + ': ' + umsgUntitled.Caption; end; procedure TufrmMain.TntFormCloseQuery(Sender: TObject; var CanClose: Boolean); begin StashTitle; CanClose := ((not IMTDoc.Modified) or SaveChanges); end; procedure TufrmMain.StashTitle; begin IMTDoc.DocTitle := ueTitle.Text; end; procedure TufrmMain.aQuitExecute(Sender: TObject); begin Close; end; procedure TufrmMain.ImgViewMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer); var AnnNum: integer; Loc: TFloatRect; begin if DraggingImage then begin DraggingImage := False; ImgView.Cursor := crDefault; Exit; end; if Layer = nil then Exit; //In this function, we need to check whether the active layer is the rubberband layer. //If so, then... if (Layer = RBLayer) and (RBLayer.ChildLayer <> nil) then begin //we need to find they layer it's overlaying AnnNum := TPositionedLayer(RBLayer.ChildLayer).Tag; Loc := TPositionedLayer(RBLayer.ChildLayer).Location; //Report its position and size data back to the document IMTDoc.IMTAnnList.Left[AnnNum] := Loc.Left; IMTDoc.IMTAnnList.Top[AnnNum] := Loc.Top; IMTDoc.IMTAnnList.Right[AnnNum] := Loc.Right; IMTDoc.IMTAnnList.Bottom[AnnNum] := Loc.Bottom; end; end; procedure TufrmMain.cmbScaleChange(Sender: TObject); var S: string; I: Integer; begin S := cmbScale.Text; S := StringReplace(S, '%', '', [rfReplaceAll]); S := StringReplace(S, ' ', '', [rfReplaceAll]); if S = '' then Exit; I := StrToIntDef(S, -1); if (I < 1) or (I > 2000) then I := Round(ImgView.Scale * 100) else ImgView.Scale := I / 100; cmbScale.Text := IntToStr(I) + '%'; cmbScale.SelStart := Length(cmbScale.Text) - 1; //Now centre the current annotation, if there is one. if ufrmAnnCat.CurrAnnNum > -1 then IMTDoc.ScrollAnnToCenter(ufrmAnnCat.CurrAnnNum); end; procedure TufrmMain.aNewAnnotationExecute(Sender: TObject); begin ufrmAnnCat.AddAnnotation; { AnnNum := IMTDoc.AddAnnotation; IMTDoc.AnnShowing[AnnNum] := True; Selection := TPositionedLayer(TIMTAnnotation(IMTDoc.IMTAnnList[AnnNum]).PositionedLayer); } end; procedure TufrmMain.aDeleteAnnotationsExecute(Sender: TObject); begin ufrmAnnCat.DeleteSelectedAnnotations; end; procedure TufrmMain.aeMainIdle(Sender: TObject; var Done: Boolean); var LastFocusForm: TTntForm; begin aDeleteAnnotations.Enabled := ufrmAnnCat.HasSelection; aCloneAnnotation.Enabled := (ufrmAnnCat.CurrAnnNum > -1); if Screen.ActiveForm.ActiveControl is TCustomEdit then begin aEditUndo.Enabled := TCustomEdit(Screen.ActiveForm.ActiveControl).CanUndo; aEditCut.Enabled := (Length(TCustomEdit(Screen.ActiveForm.ActiveControl).SelText) > 0); aEditCopy.Enabled := aEditCut.Enabled; aEditPaste.Enabled := Clipboard.HasFormat(CF_TEXT); aEditDelete.Enabled := True; aEditSelectAll.Enabled := aEditDelete.Enabled; aInsertTag.Enabled := True; end else begin if Screen.ActiveForm.ActiveControl is TSynMemo then begin aEditUndo.Enabled := TSynMemo(Screen.ActiveForm.ActiveControl).CanUndo; aEditCut.Enabled := (Length(TSynMemo(Screen.ActiveForm.ActiveControl).SelText) > 0); aEditCopy.Enabled := aEditCut.Enabled; aEditPaste.Enabled := Clipboard.HasFormat(CF_TEXT); aEditDelete.Enabled := True; aEditSelectAll.Enabled := aEditDelete.Enabled; aInsertTag.Enabled := True; end else begin aEditUndo.Enabled := False; aEditCut.Enabled := False; aEditCopy.Enabled := False; aEditPaste.Enabled := False; aEditDelete.Enabled := (Screen.ActiveForm.ActiveControl is TImgView32) and (aDeleteAnnotations.Enabled); //aEditDelete.Enabled := False; aEditSelectAll.Enabled := False; aInsertTag.Enabled := False; end; end; aShowAnnCatWindow.Checked := ufrmAnnCat.Visible; end; procedure TufrmMain.aPreferencesExecute(Sender: TObject); begin ufrmPreferences.ShowModal; end; procedure TufrmMain.aTranslateExecute(Sender: TObject); begin ufrmTranslate.ShowModal; end; procedure TufrmMain.aAddNewCategoryExecute(Sender: TObject); begin ufrmAnnCat.AddNewCategory; end; procedure TufrmMain.aCategoryManagerExecute(Sender: TObject); begin ufrmCategoryManager.ShowModal; end; procedure TufrmMain.aLoadImageExecute(Sender: TObject); begin if udlgLoadImage.Execute then OpenImage(udlgLoadImage.FileName, False, False); end; procedure TufrmMain.BeginImageDrag(X, Y: integer); begin DraggingImage := True; ImgView.Cursor := crHand; Application.ProcessMessages; ImageDragOrigin := Point(X,Y); end; procedure TufrmMain.aCloneAnnotationExecute(Sender: TObject); begin ufrmAnnCat.CloneCurrentAnnotation; end; function TufrmMain.CreateWebView(OutputFile: WideString; FileList: TTntStringList; Silent: Boolean): Boolean; var OutputPath: WideString; FNameRoot: WideString; FShortName: WideString; OutputXMLPath: WideString; OutputScaledImagePath: WideString; OutputZoomImagePath: WideString; IncludingZoom: Boolean; OutputHTMLPath: WideString; SourceFilePath: WideString; ScaleFactor: Double; ImageDimensions: TPoint; XSLProc: TDomProcessingInstruction; DomImpl: TDomImplementation; DomDoc: TDomDocument; DomToXMLParser: TDomToXMLParser; XMLToDomParser: TXMLToDomParser; FileStream: TFileStream; El: TDomElement; ElName: WideString; NewEl: TDomElement; TextNode: TDomText; i: integer; CommandLine: string; Launched: integer; LaunchPath: array[0..255] of Char; procedure ChangeXSLVarVal(El: TDomElement; NodeVal: WideString); begin while El.ChildNodes.Length > 0 do El.RemoveChild(El.ChildNodes.Item(0)); TextNode := TDomText.Create(DomDoc); TextNode.NodeValue := NodeVal; El.AppendChild(TextNode); end; begin { This function creates the Web view output routine. It can be called with the Silent flag set to true, in which case it shows progress bars but allows no interactivity. It populates FileList with the list of files it has created. } Result := False; //default try FileList.Clear; Screen.Cursor := crHourglass; jvdlgProgress.InitValues(0, 15, 1, 0, string(umsgCreatingWebView.Caption), ''); jvdlgProgress.Max := 15; jvdlgProgress.Position := 0; jvdlgProgress.Show; Application.ProcessMessages; try //Generate list of files that will be saved jvdlgProgress.Position := 1; jvdlgProgress.Text := umsgFiguringOutFileNames.Caption; Application.ProcessMessages; {Determine whether we're going to be needing a full-sized copy of the image to allow zooming in to details. We'll need it if the set size for the image width is less than the actual width of the image. } IncludingZoom := (ImgView.Bitmap.Width > ufrmSettings.seWVMaxImageWidth.Value); SourceFilePath := WideExtractFilePath(Application.ExeName) + 'web_view\'; OutputPath := WideExtractFilePath(OutputFile); FNameRoot := WideChangeFileExt(OutputFile, ''); FShortName := WideChangeFileExt(WideExtractFileName(OutputFile), ''); OutputScaledImagePath := OutputPath + FShortName + '_wv_' + WideChangeFileExt(WideExtractFileName(IMTDoc.ImageFilePath), '.jpg'); OutputZoomImagePath := OutputPath + FShortName + '_wv_zoom_' + WideChangeFileExt(WideExtractFileName(IMTDoc.ImageFilePath), '.jpg'); OutputXMLPath := FNameRoot + '_wv.xml'; OutputHTMLPath := OutputFile; FileList.Add(OutputXMLPath); FileList.Add(FNameRoot + '.css'); FileList.Add(FNameRoot + '_wv.xsl'); FileList.Add(FNameRoot + '.js'); FileList.Add(OutputScaledImagePath); if IncludingZoom then FileList.Add(OutputZoomImagePath); FileList.Add(OutputHTMLPath); jvdlgProgress.Position := 2; Application.ProcessMessages; //Check whether they already exist, and if so, warn and allow the user //to decline to overwrite if not Silent then if ufrmFileOverwriteConfirm.CheckForOverwrites(FileList) then if ufrmFileOverwriteConfirm.ShowModal = mrCancel then begin Screen.Cursor := crDefault; jvdlgProgress.Hide; Exit; end; jvdlgProgress.Position := 3; jvdlgProgress.Text := umsgCreatingImageFiles.Caption; Application.ProcessMessages; {If we're using a full-scale version of the image, create it.} if IncludingZoom then if ufrmFileOverwriteConfirm.CanOverwrite(OutputZoomImagePath) then SaveImageAsJPEG(OutputZoomImagePath); jvdlgProgress.Position := 4; Application.ProcessMessages; //Create a scaled copy of the image file and copy it to location. if (Silent = True) or (ufrmFileOverwriteConfirm.CanOverwrite(OutputScaledImagePath)) then SaveScaledImage(ufrmSettings.seWVMaxImageWidth.Value, IMTDoc.ImageFilePath, OutputScaledImagePath, ScaleFactor, ImageDimensions); jvdlgProgress.Position := 5; jvdlgProgress.Text := umsgCreatingWebFiles.Caption; Application.ProcessMessages; //Copy js file to location if appropriate if (Silent = True) or (ufrmFileOverwriteConfirm.CanOverwrite(FNameRoot + '.js')) then WideCopyFile(SourceFilePath + 'web_view.js', FNameRoot + '.js', False); jvdlgProgress.Position := 6; Application.ProcessMessages; //Copy CSS file to location if appropriate if (Silent = True) or (ufrmFileOverwriteConfirm.CanOverwrite(FNameRoot + '.css')) then WideCopyFile(SourceFilePath + 'web_view.css', FNameRoot + '.css', False); jvdlgProgress.Position := 7; Application.ProcessMessages; //Copy XML file to location if appropriate //This is complex because we need to add a processing instruction if (Silent = True) or (ufrmFileOverwriteConfirm.CanOverwrite(OutputXMLPath)) then begin jvdlgProgress.Position := 8; jvdlgProgress.Text := umsgDoingXSLTransformation.Caption; Application.ProcessMessages; //Create DOM parsing components DomImpl := TDomImplementation.Create(nil); try XmlToDomParser := TXmlToDomParser.Create(nil); try DomToXmlParser := TDomToXmlParser.Create(nil); try //Set up some properties XmlToDomParser.DOMImpl := DomImpl; DomToXmlParser.DOMImpl := DomImpl; DomDoc := TDomDocument.Create(DomImpl); try Application.ProcessMessages; //Load the file DomDoc := XMLToDomParser.ParseFile(CurrFileName, False); jvdlgProgress.Position := 9; Application.ProcessMessages; //Add the stylesheet processing instruction XSLProc := TDomProcessingInstruction.Create(DomDoc, 'xml-stylesheet'); XSLProc.Data := 'type="text/xsl" href="' + FShortName + '_wv.xsl"'; DomDoc.InsertBefore(XSLProc, DomDoc.FirstChild); jvdlgProgress.Position := 10; Application.ProcessMessages; //Save the file to the new location FileStream := TFileStream.Create(TFileName(OutputXMLPath), fmCreate or fmShareExclusive); try DomToXMLParser.WriteToStream(DomDoc, 'UTF-8', FileStream); jvdlgProgress.Position := 11; finally FreeAndNil(FileStream); Application.ProcessMessages; end; finally DomDoc.Free; Application.ProcessMessages; end; finally FreeAndNil(DomToXmlParser); Application.ProcessMessages; end; finally FreeAndNil(XmlToDomParser); Application.ProcessMessages; end; finally FreeAndNil(DomImpl); Application.ProcessMessages; end; end; //Load the XSL file from the source location, and modify it with the required info //before saving it again to the output location if (Silent = True) or (ufrmFileOverwriteConfirm.CanOverwrite(FNameRoot + '_wv.xsl')) then begin //Create DOM parsing components DomImpl := TDomImplementation.Create(nil); try XmlToDomParser := TXmlToDomParser.Create(nil); try DomToXmlParser := TDomToXmlParser.Create(nil); try //Set up some properties XmlToDomParser.DOMImpl := DomImpl; DomToXmlParser.DOMImpl := DomImpl; DomDoc := TDomDocument.Create(DomImpl); try jvdlgProgress.Position := 12; Application.ProcessMessages; //Load the file DomDoc := XMLToDomParser.ParseFile(TFileName(SourceFilePath + 'web_view.xsl'), False); //Insert the nodes we need to add to customize the file //We need to insert them at the beginning of the file //First, make sure the decimal separator is a point, otherwise xsltproc will choke //when doing calculations DecimalSeparator := '.'; if DomDoc.GetElementsByTagName('xsl:variable').Length > 0 then for i := 0 to DomDoc.GetElementsByTagName('xsl:variable').Length-1 do begin El := TDomElement(DomDoc.GetElementsByTagName('xsl:variable').Item(i)); ElName := El.GetAttributeNormalizedValue('name'); if ElName = 'DocTitle' then ChangeXSLVarVal(El, IMTDoc.DocTitle); if ElName = 'DocFileName' then ChangeXSLVarVal(El, FShortName); if ElName = 'ScaledImageWidth' then ChangeXSLVarVal(El, IntToStr(ImageDimensions.X)); if ElName = 'ScaledImageHeight' then ChangeXSLVarVal(El, IntToStr(ImageDimensions.Y)); if ElName = 'ZoomImageWidth' then ChangeXSLVarVal(El, IntToStr(ImgView.Bitmap.Width)); if ElName = 'ZoomImageHeight' then ChangeXSLVarVal(El, IntToStr(ImgView.Bitmap.Height)); if ElName = 'ImageScaleFactor' then ChangeXSLVarVal(El, FloatToStrF(ScaleFactor, ffGeneral, 6, 2)); if ElName = 'ScaledImageFileName' then ChangeXSLVarVal(El, WideExtractFileName(OutputScaledImagePath)); if ElName = 'ZoomImageFileName' then ChangeXSLVarVal(El, WideExtractFileName(OutputZoomImagePath)); end; jvdlgProgress.Position := 13; Application.ProcessMessages; //Save the file to the new location FileStream := TFileStream.Create(FNameRoot + '_wv.xsl', fmCreate or fmShareExclusive); try DomToXMLParser.WriteToStream(DomDoc, 'UTF-8', FileStream); finally FreeAndNil(FileStream); end; finally FreeAndNil(DomDoc); end; finally FreeAndNil(DomToXmlParser); end; finally FreeAndNil(XmlToDomParser); end; finally FreeAndNil(DomImpl); end; end; finally Screen.Cursor := crDefault; end; jvdlgProgress.Position := 14; jvdlgProgress.Text := ''; Application.ProcessMessages; //Now create a hard-coded HTML file using libxml2 XSLT transform engine: try Screen.Cursor := crHourglass; mdhDoXSLTTransform(OutputXMLPath, FNameRoot + '_wv.xsl', OutputHTMLPath); jvdlgProgress.Position := 15; Application.ProcessMessages; finally jvdlgProgress.Hide; Screen.Cursor := crDefault; end; //Report results and offer to show the file to the user if not Silent then begin if WideMessageDlg(umsgShowInBrowser.Caption, mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin StrPCopy(LaunchPath, string(OutputHTMLPath)); Launched := ShellExecute(0, 'open', LaunchPath, nil, nil, SW_SHOWNORMAL); if Launched <= 32 then WideMessageDlg(umsgFailedToRunBrowser.Caption, mtWarning, [mbOK], 0); end; end; Result := True; except //Returning false is enough end; end; procedure TufrmMain.aCreateWebViewExecute(Sender: TObject); var FileList: TTntStringList; begin //Confirm save changes if IMTDoc.Modified then if not SaveChanges then Exit; //Check the filename is valid, because we'll need to use it. if not (WideFileExists(CurrFileName)) then begin WideShowMessage(umsgSaveFileBeforeWebView.Caption); Exit; end; //Get location for file save if udlgSaveHTMLFile.Execute then begin FileList := TTntStringList.Create; try CreateWebView(udlgSaveHTMLFile.FileName, FileList, False); finally FileList.Free; end; end; end; procedure TufrmMain.aAboutExecute(Sender: TObject); begin SplashAbout.ShowAbout(imgSplash.Picture.Bitmap, BoundsRect, clWhite); end; procedure TufrmMain.aEditUndoExecute(Sender: TObject); begin if Screen.ActiveForm.ActiveControl is TCustomEdit then TCustomEdit(Screen.ActiveForm.ActiveControl).Undo; if Screen.ActiveForm.ActiveControl is TSynMemo then TSynMemo(Screen.ActiveForm.ActiveControl).Undo; end; procedure TufrmMain.aEditCutExecute(Sender: TObject); begin if Screen.ActiveForm.ActiveControl is TCustomEdit then TCustomEdit(Screen.ActiveForm.ActiveControl).CutToClipboard; if Screen.ActiveForm.ActiveControl is TSynMemo then TSynMemo(Screen.ActiveForm.ActiveControl).CutToClipboard; end; procedure TufrmMain.aEditCopyExecute(Sender: TObject); begin if Screen.ActiveForm.ActiveControl is TCustomEdit then TCustomEdit(Screen.ActiveForm.ActiveControl).CopyToClipboard; if Screen.ActiveForm.ActiveControl is TSynMemo then TSynMemo(Screen.ActiveForm.ActiveControl).CopyToClipboard; end; procedure TufrmMain.aEditPasteExecute(Sender: TObject); begin if Screen.ActiveForm.ActiveControl is TCustomEdit then TCustomEdit(Screen.ActiveForm.ActiveControl).PasteFromClipboard; if Screen.ActiveForm.ActiveControl is TSynMemo then TSynMemo(Screen.ActiveForm.ActiveControl).PasteFromClipboard; end; procedure TufrmMain.aEditDeleteExecute(Sender: TObject); begin if Screen.ActiveForm.ActiveControl is TCustomEdit then begin if TCustomEdit(Screen.ActiveForm.ActiveControl).SelLength > 0 then TCustomEdit(Screen.ActiveForm.ActiveControl).ClearSelection else begin TCustomEdit(Screen.ActiveForm.ActiveControl).SelLength := 1; TCustomEdit(Screen.ActiveForm.ActiveControl).ClearSelection; end; end; if Screen.ActiveForm.ActiveControl is TSynMemo then begin if TSynMemo(Screen.ActiveForm.ActiveControl).SelLength > 0 then TSynMemo(Screen.ActiveForm.ActiveControl).ClearSelection else begin TSynMemo(Screen.ActiveForm.ActiveControl).SelLength := 1; TSynMemo(Screen.ActiveForm.ActiveControl).ClearSelection; end end; if Screen.ActiveForm.ActiveControl is TImgView32 then if (aDeleteAnnotations.Enabled) then aDeleteAnnotations.Execute; end; procedure TufrmMain.aEditSelectAllExecute(Sender: TObject); begin if Screen.ActiveForm.ActiveControl is TCustomEdit then TCustomEdit(Screen.ActiveForm.ActiveControl).SelectAll; if Screen.ActiveForm.ActiveControl is TSynMemo then TSynMemo(Screen.ActiveForm.ActiveControl).SelectAll; end; procedure TufrmMain.aExportToDocBookExecute(Sender: TObject); begin //Get the output filename from the user if udlgSaveDocBookFile.Execute then //Call the function to do the transformation ExportToDocBook(udlgSaveDocBookFile.FileName); end; function TufrmMain.ExportToDocBook(OutFile: WideString): Boolean; var TempFile: WideString; XSLFile: WideString; Launched: integer; LaunchPath: array[0..255] of Char; begin Result := False; Screen.Cursor := crHourglass; try //OLD: Find a temp folder location + file we can use // TempFile := WideString(TempFolder + 'imt_' + UniqueIDFromTime + '.xml'); {Don't use a temp folder! Use the same folder as the output will be saved in. This means that relative paths will work for the image. } TempFile := WideExtractFilePath(OutFile) + 'imt_' + UniqueIDFromTime + '.xml'; //Save a temporary copy of the XML file if IMTDoc.SaveToXMLFile(TempFile, False) = False then begin WideMessageDlg(umsgUnableToSaveTempFile.Caption, mtWarning, [mbOK], 0); Exit; end; //Get the location of the transformation stylesheet XSLFile := WideExtractFilePath(Application.ExeName) + 'docbook\' + imtSchemaFileName + '_to_docbook.xsl'; if not FileExists(XSLFile) then begin WideMessageDlg(umsgUnableToFindFile.Caption + #13#10#13#10 + XSLFile, mtWarning, [mbOK], 0); Exit; end; Application.ProcessMessages; //Do the transformation if mdhDoXSLTTransform(TempFile, XSLFile, OutFile) = True then begin //Report results and offer to show the file to the user if WideMessageDlg(umsgViewXMLFile.Caption, mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin StrPCopy(LaunchPath, string(OutFile)); Launched := ShellExecute(0, 'open', LaunchPath, nil, nil, SW_SHOWNORMAL); if Launched <= 32 then WideMessageDlg(umsgUnableToShowXMLFile.Caption, mtWarning, [mbOK], 0); end; Result := True; end; finally if WideFileExists(TempFile) then DeleteFile(TempFile); Screen.Cursor := crDefault; end; end; procedure TufrmMain.aImportDocBookFileExecute(Sender: TObject); begin StashTitle; if (not IMTDoc.Modified) or SaveChanges then begin ClearDocument; if udlgOpenDocBookFile.Execute then ImportDocBookFile(udlgOpenDocBookFile.FileName); end; end; function TufrmMain.ImportDocBookFile(InFile: WideString): Boolean; var TempFile: WideString; XSLFile: WideString; begin Result := False; Screen.Cursor := crHourglass; try if not WideFileExists(InFile) then Exit; //Find a temp folder location + file we can use TempFile := WideString(TempFolder + 'imt_' + UniqueIDFromTime + '.xml'); Application.ProcessMessages; //Get the location of the transformation stylesheet XSLFile := WideExtractFilePath(Application.ExeName) + 'docbook\docbook_to_' + imtSchemaFileName + '.xsl'; Application.ProcessMessages; if not WideFileExists(XSLFile) then begin WideMessageDlg(umsgUnableToFindFile.Caption + #13#10#13#10 + XSLFile, mtWarning, [mbOK], 0); Exit; end; //Do the transformation if mdhDoXSLTTransform(InFile, XSLFile, TempFile) = True then begin //Load the data from the temporary file. We set LoadAsNew to True because //we need to make sure that the temp file location is removed from the doc, //so it always generates a save-as and doesn't just save back to the temp file: OpenFile(TempFile, True); Application.ProcessMessages; Result := True; end; finally //Now delete the temp file. if FileExists(TempFile) then DeleteFile(TempFile); Screen.Cursor := crDefault; end; end; procedure TufrmMain.aShowAnnCatWindowExecute(Sender: TObject); begin ufrmAnnCat.Visible := aShowAnnCatWindow.Checked; if ufrmAnnCat.Visible then ufrmAnnCat.BringToFront; end; function TufrmMain.SaveImageAsJPEG(OutFile: WideString): Boolean; var BmpOut: TBitmap; JPGOut: TJPEGImage; CurrExt: WideString; begin Result := False; //If it's already a JPEG, then just copy it CurrExt := WideUpperCase(WideExtractFileExt(IMTDoc.ImageFilePath)); if (CurrExt = '.JPG') or (CurrExt = '.JPEG') then begin WideCopyFile(IMTDoc.ImageFilePath, OutFile, False); Result := True; end else try JPGOut := TJPEGImage.Create; try BmpOut := TBitmap.Create; try BmpOut.Assign(ImgView.Bitmap); JPGOut.CompressionQuality := 100; JPGOut.ProgressiveEncoding := True; JPGOut.Assign(BmpOut); JPGOut.SaveToFile(OutFile); finally BMPOut.Free; end; finally JPGOut.Free; end; Result := True; except //Returning false is enough end; end; procedure TufrmMain.WMDROPFILES(var Message: TWMDROPFILES); var TotalFilesDropped: integer; Buffer: Array[0..255] of Char; FName: string; //i: integer; begin TotalFilesDropped := DragQueryFile(Message.Drop, $FFFFFFFF, nil, 0); if TotalFilesDropped > 0 then begin DragQueryFile(Message.Drop, 0, @Buffer, sizeof(Buffer)); FName := String(Buffer); if FileExists(FName) then begin if Copy(FName, Length(FName)-3, 4) = '.xml' then //It's an xml file; try opening it OpenFile(FName, False) else //It's not an xml file -- see if it's an image file begin if Pos(LowerCase(ExtractFileExt(FName)), ImageExtensions) > 0 then begin if WideMessageDlg(umsgReplaceThisImage.Caption, mtConfirmation, [mbYes, mbNo], 0) = mrYes then OpenImage(FName, False, False); end; end; end; end; end; procedure TufrmMain.aTutorialExecute(Sender: TObject); begin if FileExists(ExtractFilePath(Application.ExeName) + 'tutorial\getting_started.htm') then BrowseURL('file:///' + ExtractFilePath(Application.ExeName) + 'tutorial\getting_started.htm'); end; procedure TufrmMain.ClearDialogBoxes; begin //We should only be clearing save dialogs, surely! // udlgOpenFile.FileName := ''; // udlgLoadImage.FileName := ''; udlgSaveFile.FileName := ''; udlgSaveHTMLFile.FileName := ''; udlgSaveDocBookFile.FileName := ''; // udlgOpenDocBookFile.FileName := ''; end; procedure TufrmMain.aHelpContentsExecute(Sender: TObject); begin mdhCallHelp(''); end; function TufrmMain.aeMainHelp(Command: Word; Data: Integer; var CallHelp: Boolean): Boolean; begin //Don't pass on help processing to the OS CallHelp := False; mdhCallHelp(StrPas(PAnsiChar(Data))); Result := True; end; procedure TufrmMain.aCloseFileExecute(Sender: TObject); begin StashTitle; if (not IMTDoc.Modified) or SaveChanges then begin ClearDocument; ClearDialogBoxes; end; end; procedure TufrmMain.aCreateZipPackageExecute(Sender: TObject); var TheFiles: TTntStringList; TempImageFilePath: WideString; FName: WideString; OldModified: Boolean; Succeeded: Boolean; LaunchPath: array[0..255] of Char; begin //Check whether an image exists if not (WideFileExists(IMTDoc.ImageFilePath)) then begin WideMessageDlg(umsgNoImageFileLoaded.Caption, mtWarning, [mbOK], 0); Exit; end; //Get a file name for the zip file if not ufrmZipMasterFunc.udlgSaveZip.Execute then Exit; //Get the previous modified setting OldModified := IMTDoc.Modified; //Create the string list TheFiles := TTntStringList.Create; try //Populate it with the files we'll need to create the archive //First the XML file: //Replace the image file path with a filename alone TempImageFilePath := IMTDoc.ImageFilePath; IMTDoc.ImageFilePath := WideExtractFileName(TempImageFilePath); //Create a temp file name if Length(CurrFileName) > 0 then FName := TempFolder + ExtractFileName(CurrFileName) else FName := WideChangeFileExt(ufrmZipMasterFunc.udlgSaveZip.FileName, '.xml'); //Save the file IMTDoc.SaveToXMLFile(FName, False); //Add it to the list for inclusion into the zip file TheFiles.Add(FName); //Replace the original file path IMTDoc.ImageFilePath := TempImageFilePath; //Add the image file TheFiles.Add(TempImageFilePath); //Now add the schemas TheFiles.Add(WideExtractFilePath(Application.ExeName) + 'schemas\*.*'); //Create the archive Succeeded := ufrmZipMasterFunc.ZipFiles(TheFiles, ufrmZipMasterFunc.udlgSaveZip.FileName); //Delete the temporary saved file if WideFileExists(FName) then WideDeleteFile(FName); //Set the modified setting back (it will have been changed by flipping the //image file path). IMTDoc.Modified := OldModified; finally //Free the string list FreeAndNil(TheFiles); end; if Succeeded then begin if WideMessageDlg(ufrmZipMasterFunc.umsgOpenZipFile.Caption, mtConfirmation, mbYesNoCancel, 0) = mrYes then begin StrPCopy(LaunchPath, string(ufrmZipMasterFunc.udlgSaveZip.FileName)); ShellExecute(0, 'open', LaunchPath, nil, nil, SW_SHOWNORMAL); end; end else begin WideMessageDlg(ufrmZipMasterFunc.umsgFailedToCreateZipFile.Caption, mtWarning, [mbOK], 0); end; end; procedure TufrmMain.aCreateWebViewZipExecute(Sender: TObject); var TheFiles: TTntStringList; FName: WideString; Succeeded: Boolean; LaunchPath: array[0..255] of Char; i: integer; begin //Check whether an image exists if not (WideFileExists(IMTDoc.ImageFilePath)) then begin WideMessageDlg(umsgNoImageFileLoaded.Caption, mtWarning, [mbOK], 0); Exit; end; Application.ProcessMessages; //Get a file name for the zip file if not ufrmZipMasterFunc.udlgSaveZip.Execute then Exit; Application.ProcessMessages; TheFiles := TTntStringList.Create; try //Create a Web view in the temp folder FName := WideString(TempFolder + WideExtractFileName( WideChangeFileExt( ufrmZipMasterFunc.udlgSaveZip.FileName, '.htm'))); Application.ProcessMessages; if CreateWebView(FName, TheFiles, True) = False then begin WideMessageDlg(ufrmZipMasterFunc.umsgFailedToCreateZipFile.Caption, mtWarning, [mbOK], 0); Exit; end; Application.ProcessMessages; //Add all the files to the zip //Create the archive Succeeded := ufrmZipMasterFunc.ZipFiles(TheFiles, ufrmZipMasterFunc.udlgSaveZip.FileName); Application.ProcessMessages; //Delete the temporary saved files if TheFiles.Count > 0 then for i := 0 to TheFiles.Count-1 do if WideFileExists(TheFiles[i]) then WideDeleteFile(TheFiles[i]); Application.ProcessMessages; finally FreeAndNil(TheFiles); end; //If it worked, offer to open the file if Succeeded then begin if WideMessageDlg(ufrmZipMasterFunc.umsgOpenZipFile.Caption, mtConfirmation, mbYesNoCancel, 0) = mrYes then begin StrPCopy(LaunchPath, string(ufrmZipMasterFunc.udlgSaveZip.FileName)); ShellExecute(0, 'open', LaunchPath, nil, nil, SW_SHOWNORMAL); end; end else begin WideMessageDlg(ufrmZipMasterFunc.umsgFailedToCreateZipFile.Caption, mtWarning, [mbOK], 0); end; end; procedure TufrmMain.aImportCategoriesExecute(Sender: TObject); var FName: WideString; TempIMTDoc: TIMTDoc; i: integer; CatImported: Boolean; CatNum: integer; begin //Show the file open dialog, and bail if no file selected if udlgOpenFile.Execute = False then Exit; //Bail if the file doesn't exist FName := udlgOpenFile.FileName; if not WideFileExists(FName) then begin WideMessageDlg(umsgUnableToFindFile.Caption + #13#10 + FName, mtWarning, [mbOK], 0); Exit; end; //Set the cursor to wait Screen.Cursor := crHourglass; Application.ProcessMessages; try TempIMTDoc := TIMTDoc.Create(nil); try try TempIMTDoc.LoadFromXMLFile(FName); Application.ProcessMessages; //Now iterate through the TAnnCatList... if no cats, exit if TAnnCatList(TempIMTDoc.AnnCatList).Count < 1 then Exit; CatImported := False; //for each cat... for i := 0 to TAnnCatList(TempIMTDoc.AnnCatList).Count-1 do begin Application.ProcessMessages; //check whether its id matches any in the existing IMTDoc's categories if IMTDoc.CategoriesIDList.IndexOf( TAnnCategory(TAnnCatList(TempIMTDoc.AnnCatList)[i]).ID) < 0 then begin //if it doesn't, then add it to the main list, and set a boolean that a change //has happened CatNum := IMTDoc.AnnCatList.AddCategory( TAnnCategory(TAnnCatList(TempIMTDoc.AnnCatList)[i]).ID); IMTDoc.SetCategoryProperties(CatNum, TAnnCategory(TAnnCatList(TempIMTDoc.AnnCatList)[i]).Shape, TAnnCategory(TAnnCatList(TempIMTDoc.AnnCatList)[i]).Color, TAnnCategory(TAnnCatList(TempIMTDoc.AnnCatList)[i]).Explanation, TAnnCategory(TAnnCatList(TempIMTDoc.AnnCatList)[i]).Transcriptional, TAnnCategory(TAnnCatList(TempIMTDoc.AnnCatList)[i]).ID); CatImported := True; Application.ProcessMessages; end; end; //if any changes have happened, then Application.ProcessMessages; //redisplay the categories if CatImported = True then ufrmAnnCat.InitializeCategories; except WideMessageDlg(umsgUnableToLoadFile.Caption + #13#10 + FName, mtWarning, [mbOK], 0); end; finally FreeAndNil(TempIMTDoc); end; finally //Set the cursor back Screen.Cursor := crDefault; end; end; procedure TufrmMain.aCreateThumbnailExecute(Sender: TObject); var i: integer; OutFileName: WideString; SelWidth, SelHeight: integer; Success: Boolean; LaunchPath: array[0..255] of Char; Launched: integer; begin Success := False; //default //Bail on this function if there's no image! if not(WideFileExists(IMTDoc.ImageFilePath)) then Exit; Application.ProcessMessages; //Get selection values if ufrmAnnCat.CurrAnnNum > -1 then begin SelWidth := Round(IMTDoc.IMTAnnList.Width[ufrmAnnCat.CurrAnnNum]); SelHeight := Round(IMTDoc.IMTAnnList.Height[ufrmAnnCat.CurrAnnNum]); end else begin SelWidth := 0; SelHeight := 0; end; Application.ProcessMessages; //Populate the dialog box ufrmThumbnail.SetValues(SelWidth, SelHeight, ImgView.Bitmap.Width, ImgView.Bitmap.Height); Application.ProcessMessages; //Show the thumbnail dialog, and if OK chosen if ufrmThumbnail.ShowModal = mrOK then begin Application.ProcessMessages; //Create a suitable filename suggestion for the save dialog i := 0; OutFileName := WideExtractFilePath(IMTDoc.ImageFilePath) + 'thumb_' + WideExtractFileName(IMTDoc.ImageFilePath); while WideFileExists(OutFileName) do begin inc(i); OutFileName := WideExtractFilePath(IMTDoc.ImageFilePath) + 'thumb_' + IntToStr(i) + '_' + WideExtractFileName(IMTDoc.ImageFilePath); end; Application.ProcessMessages; //Show the save dialog udlgSaveThumbnail.FileName := OutFileName; if udlgSaveThumbnail.Execute then begin OutFileName := udlgSaveThumbnail.FileName; //Invoke the thumbnail routine if ufrmThumbnail.urbThumbnailFromImage.Checked then Success := SaveResizedImageRegion(ufrmThumbnail.mseThumbnailWidth.Value, ufrmThumbnail.mseThumbnailHeight.Value, IMTDoc.ImageFilePath, OutFileName, 0, 0, ImgView.Bitmap.Width, ImgView.Bitmap.Height) else Success := SaveResizedImageRegion(ufrmThumbnail.mseThumbnailWidth.Value, ufrmThumbnail.mseThumbnailHeight.Value, IMTDoc.ImageFilePath, OutFileName, Round(IMTDoc.IMTAnnList.Left[ufrmAnnCat.CurrAnnNum]), Round(IMTDoc.IMTAnnList.Top[ufrmAnnCat.CurrAnnNum]), Round(IMTDoc.IMTAnnList.Width[ufrmAnnCat.CurrAnnNum]), Round(IMTDoc.IMTAnnList.Height[ufrmAnnCat.CurrAnnNum])); Application.ProcessMessages; //Offer to display the image. if Success then begin if WideMessageDlg(umsgViewThumbnailImage.Caption, mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin StrPCopy(LaunchPath, string(OutFileName)); Launched := ShellExecute(0, 'open', LaunchPath, nil, nil, SW_SHOWNORMAL); if Launched <= 32 then WideMessageDlg(umsgFailedToRunBrowser.Caption, mtWarning, [mbOK], 0); end; end else begin WideMessageDlg(umsgUnableToSaveThumbnail.Caption, mtError, [mbOK], 0); end; end; end; end; procedure TufrmMain.aSettingsExecute(Sender: TObject); begin ufrmSettings.Show; end; function TufrmMain.StashDirtyData: Boolean; begin Result := False; //default -- unable to stash //Stash any header changes which have been made. if ufrmTeiHeader.Visible then begin if ufrmTeiHeader.CheckXMLOK then begin IMTDoc.wsTEIHeader := ufrmTeiHeader.usmTeiHeader.Text; ueTitle.Text := IMTDoc.DocTitle; end else begin ufrmTeiHeader.BringToFront; Exit; end; end else StashTitle; //No worries here if ufrmAnnCat.ubnAnnOK.Enabled then //data is dirty begin ufrmAnnCat.ubnAnnOKClick(ufrmAnnCat.ubnAnnOK); //try stashing it if ufrmAnnCat.ubnAnnOK.Enabled then //stashing failed. Exit; //return with False. end; if ufrmCategoryProperties.Visible then begin ufrmCategoryManager.WriteNewCatDataToDoc; //Any way to check if this has worked? end; Result := True; end; procedure TufrmMain.aFindExecute(Sender: TObject); begin if StashDirtyData = False then begin //Show an error message. This will only happen if the data is actually not well-formed. WideShowMessage(umsgSaveModifiedData.Caption); Exit; end; //Set up the dialog, passing the function signatures ufrmReplaceDialog.SetUp(Find, FindAll, Replace, ReplaceAll, GoToSearchHit); //Invoke the dialog ufrmReplaceDialog.Show; end; procedure TufrmMain.GetCursorLocation(Sel: TIMTSelection); begin //Is the header editor showing? if LastFocusWin = lfwTeiHeader then begin Sel.ContType := ctHeader; Sel.ItemIndex := -1; Sel.SelStart := ufrmTeiHeader.usmTeiHeader.SelStart+1; end else //If not, is the category editor showing? begin if LastFocusWin = lfwCatProp then begin //Get the item index Sel.ItemIndex := ufrmCategoryProperties.CatNum; //Are we editing the id or the explanation? if ufrmCategoryProperties.ActiveControl = ufrmCategoryProperties.uedCategoryID then begin Sel.ContType := ctCatId; Sel.SelStart := ufrmCategoryProperties.uedCategoryID.SelStart+1; end else begin Sel.ContType := ctCatExplanation; Sel.SelStart := ufrmCategoryProperties.uedCategoryDescription.SelStart+1; end; end else begin //If not, is there a selected annotation? if ufrmAnnCat.CurrAnnNum > -1 then begin Sel.ItemIndex := ufrmAnnCat.CurrAnnNum; if ufrmAnnCat.ActiveControl = ufrmAnnCat.uedAnnTitle then begin Sel.ContType := ctAnnTitle; Sel.SelStart := ufrmAnnCat.uedAnnTitle.SelStart+1; end else begin Sel.ContType := ctAnnText; Sel.SelStart := ufrmAnnCat.usmAnnText.SelStart+1; end; end else //If not, then return the start of the document. begin Sel.ContType := ctHeader; Sel.ItemIndex := -1; Sel.SelStart := -1; end; end; end; end; procedure TufrmMain.Find(wsFind: WideString; MatchCase, WholeWordOnly, Down: Boolean); begin if StashDirtyData = False then begin //Show an error message. This will only happen if the data is actually not well-formed. WideShowMessage(umsgSaveModifiedData.Caption); Exit; end; FindNext(wsFind, MatchCase, WholeWordOnly, Down, False, ''); end; function TufrmMain.FindNext(wsFind: WideString; MatchCase, WholeWordOnly, Down: Boolean; Replace: Boolean; ReplaceWith: WideString): Boolean; var StartFrom: TIMTSelection; FoundHit: TIMTSelection; begin Result := False; if StashDirtyData = False then begin //Show an error message. This will only happen if the data is actually not well-formed. WideShowMessage(umsgSaveModifiedData.Caption); Exit; end; //First, get the position of the cursor right now. StartFrom := TIMTSelection.Create; try GetCursorLocation(StartFrom); FoundHit := TIMTSelection.Create; try if IMTDoc.FindNext(wsFind, StartFrom, MatchCase, WholeWordOnly, FoundHit, Down, True) then begin ShowSelection(FoundHit, Replace, ReplaceWith); Result := True; end else begin WideMessageDlg(umsgStringNotFound.Caption, mtInformation, [mbOK], 0); end; finally FreeAndNil(FoundHit); end; finally FreeAndNil(StartFrom); end; end; procedure TufrmMain.ShowSelection(Sel: TIMTSelection; Replace: Boolean; ReplaceWith: WideString); begin if StashDirtyData = False then begin //Show an error message. This will only happen if the data is actually not well-formed. WideShowMessage(umsgSaveModifiedData.Caption); Exit; end; Case Sel.ContType of ctHeader: begin ufrmTeiHeader.usmTeiHeader.Text := WideTrim(IMTDoc.wsTEIHeader); ufrmTeiHeader.ActiveControl := ufrmTeiHeader.usmTeiHeader; ufrmTeiHeader.Show; ufrmTeiHeader.BringToFront; ufrmTeiHeader.usmTeiHeader.SelStart := Sel.SelStart; ufrmTeiHeader.usmTeiHeader.SelLength := Sel.SelLength; if Replace then begin ufrmTeiHeader.usmTeiHeader.SelText := ReplaceWith; ufrmTeiHeader.usmTeiHeader.SelStart := Sel.SelStart; ufrmTeiHeader.usmTeiHeader.SelLength := Length(ReplaceWith); end; end; ctAnnTitle: begin ufrmAnnCat.CurrAnnNum := Sel.ItemIndex; ufrmAnnCat.ActiveControl := ufrmAnnCat.uedAnnTitle; ufrmAnnCat.Visible := True; ufrmAnnCat.BringToFront; ufrmAnnCat.uedAnnTitle.SelStart := Sel.SelStart; ufrmAnnCat.uedAnnTitle.SelLength := Sel.SelLength; if Replace then begin ufrmAnnCat.uedAnnTitle.SelText := ReplaceWith; ufrmAnnCat.uedAnnTitle.SelStart := Sel.SelStart; ufrmAnnCat.uedAnnTitle.SelLength := Length(ReplaceWith); end; end; ctAnnText: begin ufrmAnnCat.CurrAnnNum := Sel.ItemIndex; ufrmAnnCat.ActiveControl := ufrmAnnCat.usmAnnText; ufrmAnnCat.Visible := True; ufrmAnnCat.BringToFront; ufrmAnnCat.usmAnnText.SelStart := Sel.SelStart; ufrmAnnCat.usmAnnText.SelLength := Sel.SelLength; if Replace then begin ufrmAnnCat.usmAnnText.SelText := ReplaceWith; ufrmAnnCat.usmAnnText.SelStart := Sel.SelStart; ufrmAnnCat.usmAnnText.SelLength := Length(ReplaceWith); end; end; ctCatId: begin ufrmAnnCat.PopulateCategoryPropsForm(Sel.ItemIndex); ufrmCategoryProperties.ActiveControl := ufrmCategoryProperties.uedCategoryID; ufrmCategoryProperties.Show; ufrmCategoryProperties.BringToFront; ufrmCategoryProperties.uedCategoryID.SelStart := Sel.SelStart; ufrmCategoryProperties.uedCategoryID.SelLength := Sel.SelLength; if Replace then begin ufrmCategoryProperties.uedCategoryID.SelText := ReplaceWith; ufrmCategoryProperties.uedCategoryID.SelStart := Sel.SelStart; ufrmCategoryProperties.uedCategoryID.SelLength := Length(ReplaceWith); end; end; ctCatExplanation: begin ufrmAnnCat.PopulateCategoryPropsForm(Sel.ItemIndex); ufrmCategoryProperties.ActiveControl := ufrmCategoryProperties.uedCategoryDescription; ufrmCategoryProperties.Show; ufrmCategoryProperties.BringToFront; ufrmCategoryProperties.uedCategoryDescription.SelStart := Sel.SelStart; ufrmCategoryProperties.uedCategoryDescription.SelLength := Sel.SelLength; if Replace then begin ufrmCategoryProperties.uedCategoryDescription.SelText := ReplaceWith; ufrmCategoryProperties.uedCategoryDescription.SelStart := Sel.SelStart; ufrmCategoryProperties.uedCategoryDescription.SelLength := Length(ReplaceWith); end; end; end; Application.ProcessMessages; end; procedure TufrmMain.GoToSearchHit(ItemNum: integer); begin if StashDirtyData = False then begin //Show an error message. This will only happen if the data is actually not well-formed. WideShowMessage(umsgSaveModifiedData.Caption); Exit; end; if ItemNum < ufrmReplaceDialog.uslHits.Count then if ItemNum > -1 then if ufrmReplaceDialog.uslHits.Objects[ItemNum] <> nil then ShowSelection(TimtSelection(ufrmReplaceDialog.uslHits.Objects[ItemNum]), False, ''); end; procedure TufrmMain.Replace(wsFind, wsReplaceWith: WideString; var Replaced: Boolean; MatchCase, WholeWordOnly, Down: Boolean); begin if StashDirtyData = False then begin //Show an error message. This will only happen if the data is actually not well-formed. WideShowMessage(umsgSaveModifiedData.Caption); Exit; end; Replaced := FindNext(wsFind, MatchCase, WholeWordOnly, Down, True, wsReplaceWith); end; procedure TufrmMain.FindAll(wsFind: WideString; uslHits: TTntStringList; MatchCase, WholeWordOnly, Down: Boolean); var StartFrom: TIMTSelection; NewHit: TIMTSelection; StoreHit: TIMTSelection; HitFound: Boolean; HitInContext: WideString; begin if StashDirtyData = False then begin //Show an error message. This will only happen if the data is actually not well-formed. WideShowMessage(umsgSaveModifiedData.Caption); Exit; end; //Initialize: we start from the beginning of the document if working Down, or //the end if working upwards. StartFrom := TIMTSelection.Create; try if Down then begin StartFrom.ContType := ctHeader; StartFrom.ItemIndex := -1; StartFrom.SelStart := 0; StartFrom.SelLength := 0; end else begin //Otherwise, we have to find the end of the document. //Are there categories? If so, return the cat explanation of the last. if IMTDoc.AnnCatList.Count > 0 then begin StartFrom.ContType := ctCatExplanation; StartFrom.ItemIndex := IMTDoc.AnnCatList.Count-1; StartFrom.SelStart := Length(IMTDoc.AnnCatList.Explanation[IMTDoc.AnnCatList.Count-1]); StartFrom.SelLength := 0; end else //If not, are there annotations? If so, return the ann text of the last... if IMTDoc.IMTAnnList.Count > 0 then begin StartFrom.ContType := ctAnnText; StartFrom.ItemIndex := IMTDoc.IMTAnnList.Count-1; StartFrom.SelStart := Length(IMTDoc.IMTAnnList.AnnText[IMTDoc.IMTAnnList.Count-1]); StartFrom.SelLength := 0; end else begin //If not, then we're back to the header... StartFrom.ContType := ctHeader; StartFrom.ItemIndex := -1; StartFrom.SelStart := Length(IMTDoc.wsTEIHeader); StartFrom.SelLength := 0; end; end; NewHit := TIMTSelection.Create; try HitFound := IMTDoc.FindNext(wsFind, StartFrom, MatchCase, WholeWordOnly, NewHit, Down, False); while HitFound do begin //Store this hit StoreHit := TimtSelection.Create; //This will be freed by the TntStringList. NewHit.CopySelf(StoreHit); //Find the context of the hit, in the source container. HitInContext := IMTDoc.GetKWICDisplay(StoreHit, 60); //Add that element to the stringlist, along with the StoreHit object. if Length(HitInContext) > 0 then uslHits.AddObject(WideString('...') + HitInContext + WideString('...'), StoreHit); //Copy this hit as the StartFrom for the next one NewHit.CopySelf(StartFrom); //Do the next search HitFound := IMTDoc.FindNext(wsFind, StartFrom, MatchCase, WholeWordOnly, NewHit, Down, False); end; finally FreeAndNil(NewHit); end; finally FreeAndNil(StartFrom); end; end; procedure TufrmMain.ReplaceAll(wsFind, wsReplaceWith: WideString; var TotalReplacements: integer; MatchCase, WholeWordOnly, Down: Boolean); var FailedReps: integer; {Number of replacements carried out, but which were not saved because the result was an ill-formed block of XML.} begin //TODO: Finish this function. TotalReplacements := 0; //Default; nothing done yet. if Length(wsFind) < 1 then Exit; //Nothing to search for. if StashDirtyData = False then begin //Show an error message. This will only happen if the data is actually not well-formed. WideShowMessage(umsgSaveModifiedData.Caption); Exit; end; {We're starting from the beginning of the document, and trying to do replacements in each container in turn, tracking the results and the success or failure.} {First, initialize variables.} TotalReplacements := 0; FailedReps := 0; {Do the operation.} IMTDoc.FindAll(wsFind, wsReplaceWith, Down, MatchCase, WholeWordOnly, True{DoReplace}, TotalReplacements, FailedReps); {Now we need to refresh the display of everything, in case it's changed.} if (TotalReplacements > 0) then begin //If the teiHeader is showing, then refresh it if ufrmTeiHeader.Visible then ufrmTeiHeader.usmTeiHeader.Text := WideTrim(IMTDoc.wsTEIHeader); ufrmAnnCat.RefreshDisplay; if ufrmCategoryManager.Visible then ufrmCategoryManager.PopulateListBox; end; {Report results. We only need to show the message for the failed replacements; the replace dialog box will take care of reporting the successful ones.} if FailedReps > 0 then WideShowMessage(IntToStr(FailedReps) + ' ' + umsgFailedReplacements.Caption); end; //These functions taken from function TufrmMain.IsAltDown : Boolean; var State: TKeyboardState; begin { isAltDown } GetKeyboardState(State); Result := ((State[vk_Menu] and 128)<>0); end; { isAltDown } function TufrmMain.IsCtrlDown : Boolean; var State: TKeyboardState; begin { isCtrlDown } GetKeyboardState(State); Result := ((State[VK_CONTROL] and 128)<>0); end; { isCtrlDown } function TufrmMain.IsShiftDown : Boolean; var State: TKeyboardState; begin { isShiftDown } GetKeyboardState(State); Result := ((State[vk_Shift] and 128)<>0); end; { isShiftDown } procedure TufrmMain.ustImageTitleDblClick(Sender: TObject); begin // WideShowMessage(ufrmInsertTag.GetTag('My test stuff')); end; procedure TufrmMain.aInsertTagExecute(Sender: TObject); var SelText: WideString; wsTag: WideString; begin if Screen.ActiveForm.ActiveControl is TCustomEdit then begin SelText := TCustomEdit(Screen.ActiveForm.ActiveControl).SelText; wsTag := ufrmInsertTag.GetTag(SelText); if wsTag <> SelText then TCustomEdit(Screen.ActiveForm.ActiveControl).SelText := wsTag; end else if Screen.ActiveForm.ActiveControl is TSynMemo then begin SelText := TSynMemo(Screen.ActiveForm.ActiveControl).SelText; wsTag := ufrmInsertTag.GetTag(SelText); if wsTag <> SelText then TSynMemo(Screen.ActiveForm.ActiveControl).SelText := wsTag; end; end; procedure TufrmMain.TntFormActivate(Sender: TObject); begin LastFocusWin := lfwMain; end; procedure TufrmMain.TntFormDeactivate(Sender: TObject); begin LastFocusWin := lfwNone; end; procedure TufrmMain.aCheckForUpdateExecute(Sender: TObject); var Messidge: WideString; begin if BrowseURL(FFormStateSaver.UpdateURL) = False then begin Messidge := umsgUnableToBrowseSite.Caption + #13#10#13#10 + FFormStateSaver.UpdateURL + #13#10#13#10 + umsgGoToSiteManually.Caption + ' ' + umsgUrlOnClipboard.Caption; TntClipboard.AsText := FFormStateSaver.UpdateURL; WideMessageDlg(Messidge, mtWarning, [mbOK], 0); end; FFormStateSaver.UpdatePrompted := True; end; procedure TufrmMain.FitImageToWindow; var NewScale: Double; begin //Set the scale appropriately so the image is contained by the //viewport. try NewScale := Min((ImgView.Width - GetSystemMetrics(SM_CXVSCROLL)) / (ImgView.Bitmap.Width), (ImgView.Height - GetSystemMetrics(SM_CYHSCROLL)) / (ImgView.Bitmap.Height)); if NewScale < 1 then begin ImgView.Scale := NewScale; cmbScale.Text := IntToStr(Round(NewScale * 100)) + '%'; end; except end; end; function TufrmMain.GetCurrFileName: WideString; begin Result := CurrFileName; end; end.