unit dlgAnnCat; { [dlgAnnCat] [1.2] 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 "[dlgAnnCat.pas] and [dldAnnCat.dfm]". The Initial Developer of the Original Code is Martin Holmes (Victoria, BC, Canada, "http://www.mholmes.com/"). Copyright (C) 2005-2008 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, Spring 2006; updated several times. This unit provides a GUI for browsing, selecting and configuring annotations and annotation categories. It links in to a TIMTDocument object, which is the currently-loaded document in the main application window, and it displays the titles of annotations sorted by category, as well as allowing the user to set the properties of individual categories. Dependencies: TntUnicodeControls (Troy Wolbrink) TIntegerList (evgenij at vikarina / Ray Konopka) FormState for saving size/position etc. JEDI JCL and JVCL (Project JEDI) UniSynEdit (Maël Hörz) } interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, TntStdCtrls, ComCtrls, TntForms, TntClasses, TntComCtrls, ExtCtrls, TntExtCtrls, IMTDocument, Buttons, TntButtons, mdhTranslate, FormState, ImgList, ToolWin, JvExStdCtrls, JvCombobox, JvColorCombo, CheckLst, TntCheckLst, TntDialogs, AnnotationCategories, Annotation, IconsIncluder, dlgCategoryProperties, IMTDocGlobals, IntList, jclUnicode, Menus, TntMenus, AppEvnts, XMLUtilities, SynEditHighlighter, SynHighlighterXML, SynEdit, SynMemo, TntSysUtils; type TSetSelectedLayerProc = procedure(AnnNum: integer) of Object; type TufrmAnnCat = class(TTntForm, ITranslationOperations) ustbAnnCat: TTntStatusBar; usplHorizontal: TTntSplitter; utbrAnnCat: TTntToolBar; upnTop: TTntPanel; usplVertical: TTntSplitter; upnCategories: TTntPanel; ulbmsgTotalCategories: TTntLabel; ulbmsgTotalAnnotations: TTntLabel; upnAnnotations: TTntPanel; ubnCategoryProperties: TTntButton; ugbAnnotations: TTntGroupBox; usbUp: TTntSpeedButton; usbDown: TTntSpeedButton; uclbAnnotations: TTntCheckListBox; ucbShowAnnotations: TTntCheckBox; upnBottom: TTntPanel; ugbAnnotation: TTntGroupBox; ulbCategory: TTntLabel; ulbmsgCreateNewCategory: TTntLabel; ulbAnnTitle: TTntLabel; ulbAnnText: TTntLabel; ulbmsgAnnTitle: TTntLabel; ulbmsgAnnText: TTntLabel; ulbmsgUniqueNewCatID: TTntLabel; ubnAnnCancel: TTntBitBtn; ubnAnnOK: TTntBitBtn; utbAddAnnotation: TTntToolButton; umsgConfirmDeleteAnnotation: TTntLabel; umsgAnnDataChanged: TTntLabel; ulbmsgCategoryHasAnns: TTntLabel; ulbmsgConfirmDeleteCategory: TTntLabel; upopCategories: TTntPopupMenu; upopDeleteCategory: TTntMenuItem; utbDeleteAnnotations: TTntToolButton; utbSep1: TTntToolButton; utnAddNewCategory: TTntToolButton; utbCategoryManager: TTntToolButton; umnEditCategory: TTntMenuItem; aeAnnCat: TApplicationEvents; utbCloneAnnotation: TTntToolButton; ulbmsgAnnTitleNotWellFormed: TTntLabel; ulbmsgAnnTextNotWellFormed: TTntLabel; ulbmsgCannotSaveIllFormedData: TTntLabel; uscrCategories: TTntScrollBox; usbAllCategories: TTntSpeedButton; ulbmsgChangeXmlID: TTntLabel; ulbmsgProvideValidXmlID: TTntLabel; ulbmsgNotAValidUniqueID: TTntLabel; usmAnnText: TSynMemo; xmlhlAnnText: TSynXMLSyn; upopAnnEdit: TTntPopupMenu; upopEditUndo: TTntMenuItem; N1: TTntMenuItem; upopEditCut: TTntMenuItem; upopEditCopy: TTntMenuItem; upopEditPaste: TTntMenuItem; upopEditDelete: TTntMenuItem; N2: TTntMenuItem; upopEditSelectAll: TTntMenuItem; N3: TTntMenuItem; upopFind: TTntMenuItem; upopInsertTag: TTntMenuItem; ucbCategory: TTntComboBox; uedAnnTitle: TTntEdit; ubnID: TTntButton; utbPopupMenu: TTntToolButton; utbSep2: TTntToolButton; //This calls a secret function added for friends of Marjorie Burghart, which //allows you to load a graphic into the annotation text field. procedure usmAnnTextKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure uedAnnTitleEnter(Sender: TObject); procedure usmAnnTextEnter(Sender: TObject); procedure usmAnnTextChange(Sender: TObject); procedure TntFormActivate(Sender: TObject); procedure ubnIDClick(Sender: TObject); procedure uclbAnnotationsDblClick(Sender: TObject); procedure usbDownClick(Sender: TObject); procedure usbUpClick(Sender: TObject); procedure aeAnnCatIdle(Sender: TObject; var Done: Boolean); procedure umnEditCategoryClick(Sender: TObject); procedure upopDeleteCategoryClick(Sender: TObject); procedure upopCategoriesPopup(Sender: TObject); procedure ucbShowAnnotationsClick(Sender: TObject); procedure uclbAnnotationsClickCheck(Sender: TObject); procedure ubnAnnOKClick(Sender: TObject); procedure ubnAnnCancelClick(Sender: TObject); procedure uclbAnnotationsClick(Sender: TObject); procedure usbCategoryPropertiesClick(Sender: TObject); procedure ucbCategoryChange(Sender: TObject); procedure uedAnnTitleChange(Sender: TObject); procedure usbAllCategoriesClick(Sender: TObject); procedure TntFormDestroy(Sender: TObject); procedure TntFormCreate(Sender: TObject); private FFormStateSaver: TFormStateSaver; fCurrCatID: WideString; function GetCurrSel: integer; procedure SetCurrSel(const Value: integer); procedure AddSelection(const Value: integer); procedure StashAnnotationData; procedure StashCategoryProperties; procedure DisplayCategory; procedure DisableCategoryInfo; procedure PopulateAnnList; procedure SetCurrCatID(const Value: WideString); procedure DoMultiAnnotationDisplay; procedure SaveMultiAnnotationData; procedure DisplayCurrSel; procedure EmptyAnnotationDisplay; procedure DisplaySingleAnnotationData(AnnNum: integer); function GetHasSelection: Boolean; procedure UpdateGroupVisibleCheckbox; function CreateNewCategory: integer; function CheckWellFormed: integer; procedure ResetListBoxSelectionsToCurrSel; { Private declarations } public IMTDoc: TIMTDoc; //Pointer to the main form's IMTDoc //Following procedural type holds a pointer to the main form's method for setting //the selected layer. This is used to select the layer even when the originating //action is in the main form itself, to keep concerns separate. It's a kind of //callback function in that case. SetSelectedLayerProc: TSetSelectedLayerProc; UpdatingDisplay: Boolean; SelectedList: TIntegerList; procedure Clear; procedure InitializeCategories; procedure PopulateCategoryPropsForm(CatNum: integer); procedure CategoryIDChanged(OldCatID, NewCatID: WideString); function AddNewCategory: integer; //this adds a new category to the list //without changing anything else. function DeleteCategory(CatNum: integer): Boolean; procedure AfterLoadingTranslation; function CheckSaved: Boolean; procedure RefreshDisplay; function AddAnnotation: integer; function CloneCurrentAnnotation: integer; function DeleteSelectedAnnotations: Boolean; { Public declarations } published property CurrAnnNum: integer read GetCurrSel write SetCurrSel; property HasSelection: Boolean read GetHasSelection; property CurrCatID: WideString read fCurrCatID write SetCurrCatID; end; var ufrmAnnCat: TufrmAnnCat; implementation uses Main; {$R *.dfm} { TufrmAnnCat } procedure TufrmAnnCat.AfterLoadingTranslation; begin //Write the Create new category string into the right place in the //combo box: ucbCategory.Items[0] := ulbmsgCreateNewCategory.Caption; end; procedure TufrmAnnCat.ResetListBoxSelectionsToCurrSel; var i: integer; begin if uclbAnnotations.Items.Count > 0 then for i := 0 to uclbAnnotations.Items.Count-1 do uclbAnnotations.Selected[i] := (SelectedList.IndexOf(integer(uclbAnnotations.Items.Objects[i])) > -1); end; procedure TufrmAnnCat.SetCurrSel(const Value: integer); begin if not CheckSaved then begin //We can't change selection, so we need to make sure the list box is //still showing the current selection. ResetListBoxSelectionsToCurrSel; Exit; end; UpdatingDisplay := True; SelectedList.Clear; if IMTDoc.IMTAnnList.IndexInRange(Value) then SelectedList.Add(Value); DisplayCurrSel; UpdatingDisplay := False; end; procedure TufrmAnnCat.AddSelection(const Value: integer); begin if SelectedList.Count < 1 then begin SetCurrSel(Value); Exit; end; if not CheckSaved then begin ResetListBoxSelectionsToCurrSel; Exit; end; UpdatingDisplay := True; SelectedList.Add(Value); DisplayCurrSel; UpdatingDisplay := False; end; procedure TufrmAnnCat.DisplayCurrSel; var i, j: integer; FoundAnn: Boolean; begin UpdatingDisplay := True; if SelectedList.Count < 1 then //We're setting it to no selection at all begin //First, deselect any selections in the list box if uclbAnnotations.Items.Count > 0 then for i := 0 to uclbAnnotations.Items.Count-1 do uclbAnnotations.Selected[i] := False; //Clear and disable all the annotation data fields EmptyAnnotationDisplay; //Deselect any layer that's selected on the image SetSelectedLayerProc(-1); end else //We have at least one selection begin //The first selected element is the crucial one. //Let's do a sanity check first: if not IMTDoc.IMTAnnList.IndexInRange(SelectedList[0]) then begin //the first element is an invalid selection, so deselect everything SelectedList.Clear; DisplayCurrSel; //recursive call, but this time the above code will be triggered. Exit; //all done. end; //So we know the first element is a valid annotation number. //First we should clear all current selections in the listbox. uclbAnnotations.ClearSelection; //If the wrong category is loaded, then we need to change that if (Length(CurrCatID) > 0) //it's not showing All and (CurrCatID <> IMTDoc.IMTAnnList.CategoryID[SelectedList[0]]) then //it's showing the wrong category CurrCatID := IMTDoc.IMTAnnList.CategoryID[SelectedList[0]]; //Now we need to find the first selection in the listbox. FoundAnn := False; if uclbAnnotations.Items.Count > 0 then for i := 0 to uclbAnnotations.Items.Count-1 do if integer(uclbAnnotations.Items.Objects[i]) = SelectedList[0] then begin uclbAnnotations.Selected[i] := True; FoundAnn := True; end; if not FoundAnn then begin //If we didn't find it, then we need to get its category and load that category CurrCatID := IMTDoc.IMTAnnList.CategoryID[SelectedList[0]]; //Setting this will trigger another iteration through this function, this time with //success, hopefully. Exit; end; //If we did find it, then we need to look at each of the other selections for i := SelectedList.Count-1 downto 1 do begin //Search for it in the current category list FoundAnn := False; if uclbAnnotations.Count > 0 then for j := 0 to uclbAnnotations.Count-1 do if integer(uclbAnnotations.Items.Objects[j]) = SelectedList[i] then begin FoundAnn := True; uclbAnnotations.Selected[j] := True; end; if FoundAnn = False then //it wasn't in the list, so remove it SelectedList.Delete(i); end; //Now, see how many selections remain if SelectedList.Count < 1 then begin //This is really a sanity check SetSelectedLayerProc(-1); end else begin if SelectedList.Count = 1 then begin //We've ended up with only one selection //Now we can select that layer in the main window SetSelectedLayerProc(SelectedList[0]); //and display the annotation data for editing DisplaySingleAnnotationData(SelectedList[0]); end else begin //We have multiple selections, so deselect any selection in the main window SetSelectedLayerProc(-1); //and show a merged set of annotation data. DoMultiAnnotationDisplay; end; end; end; UpdatingDisplay := False; end; procedure TufrmAnnCat.EmptyAnnotationDisplay; begin ucbCategory.ItemIndex := -1; uedAnnTitle.Text := ''; ubnID.Hint := ''; usmAnnText.Text := ''; ucbCategory.Enabled := False; uedAnnTitle.Enabled := False; ubnID.Enabled := False; usmAnnText.Enabled := False; ubnAnnOK.Enabled := False; ubnAnnCancel.Enabled := False; end; procedure TufrmAnnCat.StashCategoryProperties; var CatNum: integer; OldCatID, NewCatID: WideString; begin //First, get the category number CatNum := IMTDoc.AnnCatList.FindCategoryNumFromID(CurrCatID); //Sanity check if CatNum < 0 then Exit; //Grab the properties OldCatID := CurrCatID; NewCatID := WideTrim(ufrmCategoryProperties.uedCategoryID.Text); //Set the properties IMTDoc.SetCategoryProperties(CatNum, ufrmCategoryProperties.SelectedShape, ufrmCategoryProperties.jvcolcmbCatColor.ColorValue, ufrmCategoryProperties.uedCategoryDescription.Text, ufrmCategoryProperties.ucbTranscriptional.Checked, NewCatID); //Next, we need to know if the catid has changed if OldCatID <> NewCatID then CategoryIDChanged(OldCatID, NewCatID); end; procedure TufrmAnnCat.CategoryIDChanged(OldCatID, NewCatID: WideString); begin //if so, then set the updating flag UpdatingDisplay := True; //rebuild all the category buttons etc InitializeCategories; //display the category if necessary if CurrCatID = OldCatID then CurrCatID := NewCatID; //display the current selection DisplayCurrSel; //reset the updating flag UpdatingDisplay := False; end; procedure TufrmAnnCat.StashAnnotationData; var i: integer; begin //NOTE: Well-formedness checking is done elsewhere, before this function is invoked. if CurrAnnNum > -1 then //Simple case -- only one selected item begin //Save the data into the object structure IMTDoc.IMTAnnList.CategoryID[CurrAnnNum] := ucbCategory.Items[ucbCategory.ItemIndex]; IMTDoc.IMTAnnList.AnnText[CurrAnnNum] := usmAnnText.Text; //Annotation title also needs to be updated in the ann list if it's changed if IMTDoc.IMTAnnList.AnnTitle[CurrAnnNum] <> uedAnnTitle.Text then begin IMTDoc.IMTAnnList.AnnTitle[CurrAnnNum] := uedAnnTitle.Text; if uclbAnnotations.Items.Count > 0 then for i := 0 to uclbAnnotations.Items.Count-1 do if integer(uclbAnnotations.Items.Objects[i]) = CurrAnnNum then uclbAnnotations.Items[i] := uedAnnTitle.Text; end; end else begin if SelectedList.Count > 1 then SaveMultiAnnotationData; end; if not UpdatingDisplay then DisplayCurrSel; end; procedure TufrmAnnCat.TntFormCreate(Sender: TObject); begin FFormStateSaver := TFormStateSaver.Create(Self, True, True, False, False, False, False, False, False, False); UpdatingDisplay := False; IMTDoc := nil; //default; this will be set by main form SetSelectedLayerProc := nil; //default; this will be set by main form uclbAnnotations.MultiSelect := True; //for some reason not available in Property Editor! SelectedList := TIntegerList.Create; SelectedList.Sorted := True; SelectedList.Duplicates := dupIgnore; end; procedure TufrmAnnCat.TntFormDestroy(Sender: TObject); begin FreeAndNil(FFormStateSaver); FreeAndNil(SelectedList); end; procedure TufrmAnnCat.usbAllCategoriesClick(Sender: TObject); var i: integer; begin if not CheckSaved then begin //Don't change the category at all -- redisplay the old one DisplayCategory; Exit; end; if Sender is TTntSpeedButton then begin //Deselect everything if the first selection is not in the new category if TTntSpeedButton(Sender).Name <> 'usbAllCategories' then begin if SelectedList.Count > 0 then for i := SelectedList.Count-1 downto 0 do if IMTDoc.IMTAnnList.CategoryID[SelectedList[i]] <> TTntSpeedButton(Sender).Caption then SelectedList.Delete(i); CurrCatID := TTntSpeedButton(Sender).Caption; ubnCategoryProperties.Enabled := True; end else begin CurrCatID := ''; ubnCategoryProperties.Enabled := False; end; end; end; procedure TufrmAnnCat.uedAnnTitleChange(Sender: TObject); begin if UpdatingDisplay then Exit; ubnAnnOK.Enabled := True; ubnAnnCancel.Enabled := True; end; function TufrmAnnCat.CreateNewCategory: integer; var NewCatID: WideString; NewCatNum: integer; begin Result := -1; //default: failure ufrmCategoryProperties.CatNum := -1; ufrmCategoryProperties.uedCategoryID.Text := ulbmsgUniqueNewCatID.Caption; ufrmCategoryProperties.uedCategoryDescription.Text := ''; ufrmCategoryProperties.uedCategoryID.SelectAll; if ufrmCategoryProperties.ShowModal = mrOK then begin //Add the new category NewCatNum := IMTDoc.AnnCatList.AddCategory(ufrmCategoryProperties.uedCategoryID.Text); //Now, the uniqueness enforcing functionality of the AnnCatList may have //modified the category ID we provided, so we need to retrieve it again. NewCatID := IMTDoc.AnnCatList.ID[NewCatNum]; //Set the properties IMTDoc.SetCategoryProperties(NewCatNum, ufrmCategoryProperties.SelectedShape, ufrmCategoryProperties.jvcolcmbCatColor.ColorValue, ufrmCategoryProperties.uedCategoryDescription.Text, ufrmCategoryProperties.ucbTranscriptional.Checked, NewCatID); Result := NewCatNum; end; end; procedure TufrmAnnCat.ucbCategoryChange(Sender: TObject); var NewCatID: WideString; NewCatNum: integer; i: integer; begin if UpdatingDisplay then Exit; if IMTDoc = nil then Exit; if ucbCategory.ItemIndex = 0 then //User is creating a new category begin NewCatNum := CreateNewCategory; if NewCatNum > -1 then begin //Get the CatID NewCatID := IMTDoc.AnnCatList.ID[NewCatNum]; //Set the updating flag UpdatingDisplay := True; //Set any selected annotations to the new category if SelectedList.Count > 0 then for i := 0 to SelectedList.Count-1 do IMTDoc.IMTAnnList.CategoryID[SelectedList[i]] := NewCatID; //rebuild all the category buttons etc InitializeCategories; //display the category CurrCatID := NewCatID; //display the current selection DisplayCurrSel; //reset the updating flag UpdatingDisplay := False; end; end else begin //If just changing cat, this annotation data has changed and is unsaved ubnAnnOK.Enabled := True; ubnAnnCancel.Enabled := True; end; end; procedure TufrmAnnCat.DisplayCategory; var UpdateStatus: Boolean; FoundButton: Boolean; i: integer; CatNum: integer; begin if IMTDoc = nil then Exit; //Record the prevailing update status (in case this is called from another function //which has already set it) UpdateStatus := UpdatingDisplay; //Set the flag to true UpdatingDisplay := True; //Unpress any button which is down, and press the button we're after FoundButton := False; for i := 0 to uscrCategories.ControlCount-1 do if uscrCategories.Controls[i] is TTntSpeedButton then begin if TTntSpeedButton(uscrCategories.Controls[i]).Caption = fCurrCatID then begin TTntSpeedButton(uscrCategories.Controls[i]).Down := True; FoundButton := True; end else TTntSpeedButton(uscrCategories.Controls[i]).Down := False; end; //If the CatID is not an empty string, and if there's a button with that caption... if FoundButton then begin //...put that category information into the category properties dialog CatNum := IMTDoc.AnnCatList.FindCategoryNumFromID(fCurrCatID); PopulateCategoryPropsForm(CatNum); //Enable the category properties button so the category can be edited ubnCategoryProperties.Enabled := True; end else begin //Otherwise, press the All button... usbAllCategories.Down := True; //...hide (or disable???) the category info group box DisableCategoryInfo; end; PopulateAnnList; //Originally, I had planned that: //...if the current annotation is in the annlist //...select it in the annotation list //...and display its information. //However, the calling function can do this by calling DisplayCurrSel. //Reset the updating flag to what it was before we entered the function UpdatingDisplay := UpdateStatus; end; procedure TufrmAnnCat.PopulateCategoryPropsForm(CatNum: integer); begin ufrmCategoryProperties.uedCategoryID.Text := IMTDoc.AnnCatList.ID[CatNum]; ufrmCategoryProperties.uedCategoryDescription.Text := IMTDoc.AnnCatList.Explanation[CatNum]; ufrmCategoryProperties.ucbTranscriptional.Checked := IMTDoc.AnnCatList.Transcriptional[CatNum]; ufrmCategoryProperties.jvcolcmbCatColor.ColorValue := IMTDoc.AnnCatList.Color[CatNum]; ufrmCategoryProperties.SelectedShape := IMTDoc.AnnCatList.Shape[CatNum]; ufrmCategoryProperties.CatNum := CatNum; end; procedure TufrmAnnCat.DisableCategoryInfo; begin //remove data ufrmCategoryProperties.Hide; ufrmCategoryProperties.uedCategoryID.Text := ''; ufrmCategoryProperties.uedCategoryDescription.Text := ''; //Disable access button ubnCategoryProperties.Enabled := False; end; procedure TufrmAnnCat.PopulateAnnList; var UpdateStatus: Boolean; i: integer; function AddAnnToList(Index: integer): Boolean; begin Result := False; try with TIMTAnnotation(IMTDoc.IMTAnnList[Index]) do if (fCurrCatID = '') or (CategoryID = fCurrCatID) then begin uclbAnnotations.AddItem(AnnTitle, Pointer(Index)); uclbAnnotations.Checked[uclbAnnotations.Count-1] := Showing; Result := True; end; except end; end; begin if IMTDoc = nil then Exit; //Stash the current update status so we can restore it later UpdateStatus := UpdatingDisplay; UpdatingDisplay := True; uclbAnnotations.Clear; if IMTDoc.IMTAnnList.Count > 0 then begin for i := 0 to IMTDoc.IMTAnnList.Count-1 do AddAnnToList(i); end; //Now see if we can select/display the current annotation DisplayCurrSel; UpdateGroupVisibleCheckbox; UpdatingDisplay := UpdateStatus; end; procedure TufrmAnnCat.usbCategoryPropertiesClick(Sender: TObject); var CatNum: integer; begin CatNum := IMTDoc.AnnCatList.FindCategoryNumFromID(fCurrCatID); PopulateCategoryPropsForm(CatNum); if ufrmCategoryProperties.ShowModal = mrOK then StashCategoryProperties; end; function TufrmAnnCat.CheckSaved: Boolean; begin Result := False; //default if (SelectedList.Count > 0) then begin //There are selected annotations if ubnAnnOK.Enabled then //data is dirty begin case WideMessageDlg(umsgAnnDataChanged.Caption, mtConfirmation, mbYesNoCancel, 0) of mrYes: begin //Check if the data is well-formed before saving it case CheckWellFormed of //If data is OK or has been fixed, or if user wants to save bad data, save and return true mrYes: begin StashAnnotationData; ubnAnnOK.Enabled := False; ubnAnnCancel.Enabled := False; Result := True; Exit; end; //If data is bad, and user wants to fix it, bail mrCancel: begin Result := False; Exit; end; mrNo: begin Result := False; Exit; end; end; end; mrNo: begin Result := True; Exit; end; mrCancel: begin Result := False; //redundant, but clearer {DisplayCurrSel;} //this should set any selection back to what it was. //BUG! It also replaces dirty data with clean from model! //It seems we shouldn't do it, but look out for any //unexpected side-effects of this. Exit; end; end;//end of case statement end else begin Result := True; //data is not dirty Exit; end; end else begin //There's no selected annotation in the list, so we might as well bail Result := True; Exit; end; Result := True; end; procedure TufrmAnnCat.RefreshDisplay; var OldCatID: WideString; begin //This would be triggered when an annotation //or category is deleted or changed. OldCatID := CurrCatID; InitializeCategories; CurrCatID := OldCatID; end; procedure TufrmAnnCat.SetCurrCatID(const Value: WideString); begin fCurrCatID := Value; DisplayCategory; end; procedure TufrmAnnCat.InitializeCategories; var UpdateStatus: Boolean; i: integer; CurrTop: integer; procedure AddButton(CatID: WideString); var NewBtn: TTntSpeedButton; begin NewBtn := TTntSpeedButton.Create(uscrCategories); NewBtn.Parent := uscrCategories; NewBtn.GroupIndex := 1; //Put them all in the same group NewBtn.OnClick := usbAllCategoriesClick; NewBtn.SetBounds(usbAllCategories.Left, CurrTop, usbAllCategories.Width, usbAllCategories.Height); NewBtn.Anchors := [akLeft, akTop, akRight]; NewBtn.Caption := CatID; NewBtn.PopupMenu := upopCategories; //Set bounds again in case it's triggered a scrollbar Application.ProcessMessages; NewBtn.SetBounds(usbAllCategories.Left, CurrTop, usbAllCategories.Width, usbAllCategories.Height); CurrTop := CurrTop + NewBtn.Height; end; begin UpdateStatus := UpdatingDisplay; UpdatingDisplay := True; //First, clear out any previous category buttons if uscrCategories.ComponentCount > 0 then for i := uscrCategories.ComponentCount-1 downto 0 do if uscrCategories.Components[i] is TTntSpeedButton then if TTntSpeedButton(uscrCategories.Components[i]).Name <> 'usbAllCategories' then TTntSpeedButton(uscrCategories.Components[i]).Free; //Next, clear out each of the category dropdowns (with the exception of the first, //which is the Create New option if ucbCategory.Items.Count > 1 then for i := ucbCategory.Items.Count-1 downto 1 do ucbCategory.Items.Delete(i); //Now go through the category list and create more buttons CurrTop := usbAllCategories.Top + usbAllCategories.Height; if IMTDoc.AnnCatList.Count > 0 then for i := 0 to IMTDoc.AnnCatList.Count-1 do begin AddButton(IMTDoc.AnnCatList.ID[i]); ucbCategory.Items.Add(IMTDoc.AnnCatList.ID[i]); end; UpdatingDisplay := UpdateStatus; CurrCatID := ''; end; procedure TufrmAnnCat.uclbAnnotationsClick(Sender: TObject); begin if uclbAnnotations.SelCount > 1 then AddSelection(integer(uclbAnnotations.Items.Objects[uclbAnnotations.ItemIndex])) else SetCurrSel(integer(uclbAnnotations.Items.Objects[uclbAnnotations.ItemIndex])); end; procedure TufrmAnnCat.ubnAnnCancelClick(Sender: TObject); begin //What's happening here is that an edit is being abandoned, so //we need to reload the original data from the model. DisplayCurrSel; end; procedure TufrmAnnCat.DoMultiAnnotationDisplay; var i: integer; UpdateStatus: Boolean; CatID: WideString; begin //First, check that this makes sense if SelectedList.Count < 2 then Exit; UpdateStatus := UpdatingDisplay; //First, disable the edit boxes and empty them //TODO: when multi-editing of these fields is allowed, this will have //to be changed EmptyAnnotationDisplay; CatID := IMTDoc.IMTAnnList.CategoryID[SelectedList[0]]; for i := 1 to SelectedList.Count-1 do begin if IMTDoc.IMTAnnList.CategoryID[SelectedList[i]] <> CatID then CatID := ''; end; if Length(CatID) > 0 then ucbCategory.ItemIndex := ucbCategory.Items.IndexOf(CatID) else ucbCategory.ItemIndex := -1; //Now we enable the dropdown category combo so it can be changed for all. //TODO: if editing of anntitle and anntext in multiple-select mode is to be //allowed, this will have to be added here. ucbCategory.Enabled := True; UpdatingDisplay := UpdateStatus; end; procedure TufrmAnnCat.SaveMultiAnnotationData; var i: integer; UpdateStatus: Boolean; begin UpdateStatus := UpdatingDisplay; if SelectedList.Count > 0 then begin for i := 0 to SelectedList.Count-1 do begin //Right now we are only going to support changing the category for //multiple annotations. Later we'll look at the ann title and text, but //it seems unlikely that users will want to set them to identical. IMTDoc.IMTAnnList.CategoryID[integer(SelectedList[i])] := ucbCategory.Text; end; //Now, if items have been reset to a category which is different from that //currently displayed, then we have to change to displaying that category. DoMultiAnnotationDisplay; end; UpdatingDisplay := UpdateStatus; end; procedure TufrmAnnCat.ubnAnnOKClick(Sender: TObject); begin if CheckWellFormed = mrYes then begin StashAnnotationData; ubnAnnOK.Enabled := False; ubnAnnCancel.Enabled := False; end; end; procedure TufrmAnnCat.DisplaySingleAnnotationData(AnnNum: integer); begin //Sanity check if IMTDoc.IMTAnnList.IndexInRange(AnnNum) then with TIMTAnnotation(IMTDoc.IMTAnnList[AnnNum]) do begin ucbCategory.ItemIndex := ucbCategory.Items.IndexOf(CategoryID); uedAnnTitle.Text := AnnTitle; ubnID.Hint := XmlID; usmAnnText.Text := AnnText; //Enable editing of these fields. ucbCategory.Enabled := True; uedAnnTitle.Enabled := True; ubnID.Enabled := True; usmAnnText.Enabled := True; //Disable the OK and cancel buttons because the data is clean ubnAnnOK.Enabled := False; ubnAnnCancel.Enabled := False; end; end; function TufrmAnnCat.GetCurrSel: integer; begin if SelectedList.Count <> 1 then //No selection or multiple selection Result := -1 else Result := SelectedList[0]; end; function TufrmAnnCat.AddAnnotation: integer; var AnnNum: integer; begin Result := -1; if not CheckSaved then Exit; if not Visible then Show; AnnNum := IMTDoc.AddAnnotation; //Set the title of the annotation to our default string. IMTDoc.IMTAnnList.AnnTitle[AnnNum] := ulbmsgAnnTitle.Caption; //Set the text of the annotation to our default string. IMTDoc.IMTAnnList.AnnText[AnnNum] := ulbmsgAnnText.Caption; IMTDoc.AnnShowing[AnnNum] := True; IMTDoc.CreatePositionedLayer(AnnNum); if Length(CurrCatID) > 0 then IMTDoc.IMTAnnList.CategoryID[AnnNum] := CurrCatID else //All cats are showing, so begin //See if the current selection has one if SelectedList.Count > 0 then IMTDoc.IMTAnnList.CategoryID[AnnNum] := IMTDoc.IMTAnnList.CategoryID[SelectedList[0]] else //there's no particular category that's appropriate, so use the first one IMTDoc.IMTAnnList.CategoryID[AnnNum] := IMTDoc.AnnCatList.ID[0]; end; //Now select the new annotation CurrAnnNum := AnnNum; //Return the new ann num Result := AnnNum; end; function TufrmAnnCat.DeleteSelectedAnnotations: Boolean; var Messidge: WideString; i: integer; begin Result := False; //default if not Visible then Show; if SelectedList.Count < 1 then Exit; Messidge := ''; for i := 0 to SelectedList.Count-1 do begin Messidge := Messidge + #13#10#9 + IMTDoc.IMTAnnList.AnnTitle[SelectedList[i]]; end; Messidge := WideFormat(umsgConfirmDeleteAnnotation.Caption, [Messidge+#13#10]); if WideMessageDlg(Messidge, mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin for i := SelectedList.Count-1 downto 0 do begin IMTDoc.DeleteAnnotation(SelectedList[i]); end; SelectedList.Clear; //Now, because we've deleted items, we need to rebuild the list in the list box PopulateAnnList; DisplayCurrSel; Result := True; end; end; function TufrmAnnCat.GetHasSelection: Boolean; begin Result := (SelectedList.Count > 0); end; procedure TufrmAnnCat.uclbAnnotationsClickCheck(Sender: TObject); begin if uclbAnnotations.ItemIndex > -1 then begin IMTDoc.AnnShowing[integer(uclbAnnotations.Items.Objects[uclbAnnotations.ItemIndex])] := uclbAnnotations.Checked[uclbAnnotations.ItemIndex]; CurrAnnNum := -1; UpdateGroupVisibleCheckbox; end; end; procedure TufrmAnnCat.ucbShowAnnotationsClick(Sender: TObject); var i: integer; begin {This control represents the combined states of all the listbox items. If after clicking, it's grayed, then we should set it to Checked instead. It has to have AllowGrayed so that it can be gray when there are some checked and some unchecked in the annotation list, but when it's clicked itself, it needs to set to one state or the other. The cycle is Unchecked to Grayed to Checked, so if we're at Grayed, we can just move on to Checked. } if ucbShowAnnotations.State = cbGrayed then begin ucbShowAnnotations.State := cbChecked; ucbShowAnnotations.Checked := True; end; {Now work through the visible annotations, setting them to visible or invisible as appropriate, and setting their checkbox at the same time.} if uclbAnnotations.Items.Count > 0 then begin for i := 0 to uclbAnnotations.Items.Count-1 do begin IMTDoc.AnnShowing[integer(uclbAnnotations.Items.Objects[i])] := ucbShowAnnotations.Checked; uclbAnnotations.Checked[i] := ucbShowAnnotations.Checked; end; end; end; procedure TufrmAnnCat.UpdateGroupVisibleCheckbox; begin {This is messy, because changing the state of the checkbox seems to trigger its click event. We need to ensure that doesn't happen to avoid looping behaviour.} //Unassign the click event. ucbShowAnnotations.OnClick := nil; //Set the checked value (different from State! if State is not unchecked, the //Checked should be true. ucbShowAnnotations.Checked := (ucbShowAnnotations.State <> cbUnchecked); //Now set the state, which is a visual representation. ucbShowAnnotations.State := IMTDoc.VisibleState(CurrCatID); //Now reassign the click event. ucbShowAnnotations.OnClick := ucbShowAnnotationsClick; end; function TufrmAnnCat.AddNewCategory: integer; begin Result := CreateNewCategory; if Result > -1 then begin UpdatingDisplay := True; InitializeCategories; DisplayCurrSel; UpdatingDisplay := False; end; end; function TufrmAnnCat.DeleteCategory(CatNum: integer): Boolean; var IntList: TIntegerList; CatID: WideString; Messidge: WideString; begin Result := False; //default IntList := TIntegerList.Create; try CatID := IMTDoc.AnnCatList.ID[CatNum]; if IMTDoc.ListAnnsForCatID(IntList, CatID) > 0 then begin //Cannot delete a category which has annotations associated with it. Messidge := WideFormat(ulbmsgCategoryHasAnns.Caption, [IntList.Count]); WideShowMessage(Messidge); end else begin if WideMessageDlg(ulbmsgConfirmDeleteCategory.Caption, mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin //Delete the category from the list IMTDoc.AnnCatList.DeleteCategory(CatNum); Result := True; //Rebuild the UI UpdatingDisplay := True; InitializeCategories; if CurrCatID = CatID then CurrCatID := ''; DisplayCurrSel; UpdatingDisplay := False; end; end; finally FreeAndNil(IntList); end; end; procedure TufrmAnnCat.upopCategoriesPopup(Sender: TObject); begin //Stash a reference to the category number upopCategories.Tag := -1; if upopCategories.PopupComponent is TTntSpeedButton then upopCategories.Tag := IMTDoc.AnnCatList.FindCategoryNumFromID(TTntSpeedButton(upopCategories.PopupComponent).Caption); end; procedure TufrmAnnCat.upopDeleteCategoryClick(Sender: TObject); begin DeleteCategory(upopCategories.Tag); end; procedure TufrmAnnCat.umnEditCategoryClick(Sender: TObject); var CatNum: integer; OldCatID: WideString; NewCatID: WideString; begin CatNum := upopCategories.Tag; OldCatID := IMTDoc.AnnCatList.ID[CatNum]; //Now populate the properties form ufrmAnnCat.PopulateCategoryPropsForm(CatNum); //Show it for editing if ufrmCategoryProperties.ShowModal = mrOK then begin NewCatID := WideTrim(ufrmCategoryProperties.uedCategoryID.Text); //Set the properties. This will automatically trigger redraws in the image layers //if necessary... IMTDoc.SetCategoryProperties(CatNum, ufrmCategoryProperties.SelectedShape, ufrmCategoryProperties.jvcolcmbCatColor.ColorValue, ufrmCategoryProperties.uedCategoryDescription.Text, ufrmCategoryProperties.ucbTranscriptional.Checked, NewCatID); //...but it won't update the ufrmAnnCat UI, so we need to figure out whether //anything significant to that UI has changed. At this point, that means the //categoryid. if OldCatID <> NewCatID then begin CategoryIDChanged(OldCatID, NewCatID); end; end; end; procedure TufrmAnnCat.Clear; begin //This assumes the doc itself is clear; if it still retains categories, //then of course they'll show up, but that's what we want for new docs with //retained categories. InitializeCategories; CurrCatID := ''; CurrAnnNum := -1; end; procedure TufrmAnnCat.aeAnnCatIdle(Sender: TObject; var Done: Boolean); var i: integer; CanMoveUp, CanMoveDown: Boolean; begin {Determine whether the up and down buttons should be enabled, based on whether there's a meaningful movement that can be made with them. In the case of multiple-selection, even if one or more selections can't be moved (because they're stacked at the top or bottom of the list already), as long as there's at least one selection which can be moved without running into another selection, then we should enable that operation.} CanMoveUp := False; CanMoveDown := False; if uclbAnnotations.Items.Count > 0 then for i := 0 to uclbAnnotations.Items.Count-1 do begin if uclbAnnotations.Selected[i] then begin if i > 0 then if not uclbAnnotations.Selected[i-1] then CanMoveUp := True; if i < (uclbAnnotations.Items.Count-1) then if not uclbAnnotations.Selected[i+1] then CanMoveDown := True; end; end; usbUp.Enabled := CanMoveUp; usbDown.Enabled := CanMoveDown; end; procedure TufrmAnnCat.usbUpClick(Sender: TObject); var i, j: integer; OldAnnNum, NewAnnNum: integer; begin {This moves items in the list by swapping them with preceding items. It can swap any item if the contiguous item is not selected. Because it's moving items up, it works from the top down. Therefore it starts from 1 (the second item). It does each operation in turn, then refreshes the display. There is probably a way to stack up the operations and do them all before updating the display, and we'll come back to that later:} //TODO: Look again at making multiple swaps take place before doing an update. //First a sanity check if SelectedList.Count < 1 then Exit; if uclbAnnotations.Items.Count > 1 then for i := 1 to uclbAnnotations.Items.Count-1 do if uclbAnnotations.Selected[i] then if not uclbAnnotations.Selected[i-1] then begin //Get the numbers of annotations which will be swapped. OldAnnNum := integer(uclbAnnotations.Items.Objects[i]); NewAnnNum := integer(uclbAnnotations.Items.Objects[i-1]); //Do the swap in the annotation list IMTDoc.IMTAnnList.SwapPositions(OldAnnNum, NewAnnNum); //Now update the selected list to match for j := 0 to SelectedList.Count-1 do if SelectedList[j] = OldAnnNum then SelectedList[j] := NewAnnNum; //Rebuild the display PopulateAnnList; DisplayCurrSel; end; end; procedure TufrmAnnCat.usbDownClick(Sender: TObject); var i, j: integer; OldAnnNum, NewAnnNum: integer; begin {This function is the mirror-image of the one above; see notes above.} //TODO: Look again at making multiple swaps take place before doing an update. //First a sanity check if SelectedList.Count < 1 then Exit; if uclbAnnotations.Items.Count > 1 then for i := uclbAnnotations.Items.Count-2 downto 0 do if uclbAnnotations.Selected[i] then if not uclbAnnotations.Selected[i+1] then begin //Get the numbers of annotations which will be swapped. OldAnnNum := integer(uclbAnnotations.Items.Objects[i]); NewAnnNum := integer(uclbAnnotations.Items.Objects[i+1]); //Do the swap in the annotation list IMTDoc.IMTAnnList.SwapPositions(OldAnnNum, NewAnnNum); //Now update the selected list to match for j := 0 to SelectedList.Count-1 do if SelectedList[j] = OldAnnNum then SelectedList[j] := NewAnnNum; //Rebuild the display PopulateAnnList; DisplayCurrSel; end; end; procedure TufrmAnnCat.uclbAnnotationsDblClick(Sender: TObject); begin uclbAnnotationsClick(Sender); IMTDoc.ScrollAnnToCenter(integer(uclbAnnotations.Items.Objects[uclbAnnotations.ItemIndex])); end; function TufrmAnnCat.CloneCurrentAnnotation: integer; var NewAnn: integer; begin Result := -1; // = failure if not Visible then Show; //Sanity check: must be only one selection if CurrAnnNum < 0 then Exit; if not CheckSaved then Exit; try //Create a new annotation NewAnn := IMTDoc.AddAnnotation; IMTDoc.AnnShowing[NewAnn] := True; //Clone the properties of the current selection to the new one IMTDoc.IMTAnnList.CloneAnnotation(CurrAnnNum, NewAnn); //Create the layer for it IMTDoc.CreatePositionedLayer(NewAnn); //Now select the new annotation CurrAnnNum := NewAnn; Result := NewAnn; except end; end; function TufrmAnnCat.CheckWellFormed: integer; var WellFormed: Boolean; IsTitleOK, IsTextOK: Boolean; begin Result := mrYes;//default return //TODO: Put this back, with an appropriate boolean variable? // if FAppClosing then // Exit; //This function checks the well-formedness of the annotation title and text IsTitleOK := ufrmXMLUtilities.IsWellFormedXMLFragment(uedAnnTitle.Text); if IsTitleOK = False then begin case WideMessageDlg(ulbmsgAnnTitleNotWellFormed.Caption, mtWarning, mbYesNoCancel, 0) of mrYes: begin uedAnnTitle.Text := ufrmXMLUtilities.FixImproperlyNestedTags(uedAnnTitle.Text); IsTitleOK := ufrmXMLUtilities.IsWellFormedXMLFragment(uedAnnTitle.Text); end; mrCancel: begin Result := mrCancel; Exit; end; end; //end case end; IsTextOK := ufrmXMLUtilities.IsWellFormedXMLFragment(usmAnnText.Text); if IsTextOK = False then begin case WideMessageDlg(ulbmsgAnnTextNotWellFormed.Caption, mtWarning, mbYesNoCancel, 0) of mrYes: begin usmAnnText.Text := ufrmXMLUtilities.FixImproperlyNestedTags(usmAnnText.Text); IsTextOK := ufrmXMLUtilities.IsWellFormedXMLFragment(usmAnnText.Text); end; mrCancel: begin Result := mrCancel; Exit; end; end; //end case end; if (IsTitleOK and IsTextOK) then Result := mrYes else begin Result := mrNo; WideMessageDlg(ulbmsgCannotSaveIllFormedData.Caption, mtWarning, [mbOK], 0); end; end; procedure TufrmAnnCat.ubnIDClick(Sender: TObject); var OldID, ProposedID, NewID: WideString; begin OldID := IMTDoc.IMTAnnList.XmlID[CurrAnnNum]; ProposedID := OldID; if WideInputQuery(ulbmsgChangeXmlID.Caption, ulbmsgProvideValidXmlID.Caption, ProposedID) then if ProposedID <> OldID then begin NewID := ProposedID; ufrmXMLUtilities.MakeXMLNCName(NewID); if (NewID = ProposedID) and (IMTDoc.IMTAnnList.IDIsUnique(NewID, CurrAnnNum)) then begin IMTDoc.IMTAnnList.XmlID[CurrAnnNum] := NewID; ubnID.Hint := NewID; end else WideShowMessage(ulbmsgNotAValidUniqueID.Caption); end; end; procedure TufrmAnnCat.TntFormActivate(Sender: TObject); begin ufrmMain.LastFocusWin := lfwAnnCat; if (Left + Width) < 50 then Left := 0; if (Top + Height) < 50 then Top := 0; end; procedure TufrmAnnCat.usmAnnTextChange(Sender: TObject); begin if UpdatingDisplay then Exit; ubnAnnOK.Enabled := True; ubnAnnCancel.Enabled := True; end; procedure TufrmAnnCat.usmAnnTextEnter(Sender: TObject); begin //We need to see if this just contains the default content, and if it does, //we need to remove it and put the cursor inside the

tag. if usmAnnText.Text = ulbmsgAnnText.Caption then begin usmAnnText.Text := '

'; usmAnnText.SelStart := 3; end; end; procedure TufrmAnnCat.uedAnnTitleEnter(Sender: TObject); begin {If the text box contains the default text, then select it to make it easy to replace.} if uedAnnTitle.Text = ulbmsgAnnTitle.Caption then uedAnnTitle.Text := ''; end; procedure TufrmAnnCat.usmAnnTextKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var FName: WideString; ShortFName: WideString; RelFName: WideString; GraphicTags: WideString; i: integer; begin if (ssCtrl in Shift) and (Key = 71) then begin //Add ofAllowMultiSelect to Options ufrmMain.udlgLoadImage.Options := ufrmMain.udlgLoadImage.Options + [ofAllowMultiSelect]; if ufrmMain.udlgLoadImage.Execute then begin GraphicTags := ''; if ufrmMain.udlgLoadImage.Files.Count > 0 then for i := 0 to ufrmMain.udlgLoadImage.Files.Count-1 do begin FName := ufrmMain.udlgLoadImage.Files[i]; ShortFName := WideExtractFileName(FName); RelFName := WideExtractRelativePath(ufrmMain.GetCurrFileName, FName); RelFName := StringReplace(RelFName, '\', '/', [rfReplaceAll]); if (ssShift in Shift) then GraphicTags := GraphicTags + WideString('') else GraphicTags := GraphicTags + WideString(''); GraphicTags := GraphicTags + WideString(#13#10); end; usmAnnText.SelText := GraphicTags; end; //Remove ofAllowMultiSelect from Options. ufrmMain.udlgLoadImage.Options := ufrmMain.udlgLoadImage.Options - [ofAllowMultiSelect]; end; end; end.