Ignore:
Timestamp:
Jul 7, 2010, 4:31:10 PM (14 years ago)
Author:
Kevin Toppenberg
Message:

Upgrade to version 27

File:
1 edited

Legend:

Unmodified
Added
Removed

  • cprs/trunk/CPRS-Chart/Templates/fTemplateEditor.pas

    r456 r829  
    1818  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    1919  ExtCtrls, StdCtrls, ComCtrls, ORCtrls, Buttons, Mask, ORFn, ORNet,
    20   uTemplates, Menus, ImgList, Clipbrd, ToolWin, MenuBar, TypInfo, MSXML_TLB;
     20  uTemplates, Menus, ImgList, Clipbrd, ToolWin, MenuBar, TypInfo, MSXML_TLB, fBase508Form,
     21  VA508AccessibilityManager, VA508ImageListLabeler;
    2122
    2223type
    … …  
    2425  TTemplateTreeType = (ttShared, ttPersonal);
    2526
    26   TfrmTemplateEditor = class(TForm)
     27  TfrmTemplateEditor = class(TfrmBase508Form)
    2728    splMain: TSplitter;
    28     pnlBottom: TORAutoPanel;
     29    pnlBottom: TPanel;
    2930    btnApply: TButton;
    3031    btnCancel: TButton;
    … …  
    209210    cbxLink: TORComboBox;
    210211    lblLink: TLabel;
     212    imgLblTemplates: TVA508ImageListLabeler;
    211213    procedure btnNewClick(Sender: TObject);
    212214    procedure btnApplyClick(Sender: TObject);
    … …  
    339341      Direction, InsertAt: Integer);
    340342    procedure cbxLinkChange(Sender: TObject);
    341     procedure cbxLinkSynonymCheck(Sender: TObject; const Text: String;
    342       var IsSynonym: Boolean);
    343343    procedure reBoilKeyUp(Sender: TObject; var Key: Word;
    344344      Shift: TShiftState);
    … …  
    346346    procedure reBoilKeyDown(Sender: TObject; var Key: Word;
    347347      Shift: TShiftState);
     348    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    348349  private
    349350    FLastRect: TRect;
    … …  
    386387    FCanDoReminders: boolean;
    387388    FCanDoCOMObjects: boolean;
    388     FPersonalObjects: TStringList;
     389    //FPersonalObjects: TStringList;
    389390    FShowingTemplate: TTemplate;
    390391    FConsultServices: TStringList;
    … …  
    416417    procedure UpdateInsertsDialogs;
    417418    procedure AutoLongLines(Sender: TObject);
    418     procedure UpdatePersonalObjects;
     419    //procedure UpdatePersonalObjects;
    419420    procedure UpdateApply(Template: TTemplate);
    420421    procedure TemplateLocked(Sender: TObject);
    421422    procedure InitTrees;
     423    procedure AdjustControls4FontChange;
     424    procedure ShowGroupBoilerplate(Visible: boolean);
    422425    function GetLinkType(const ANode: TTreeNode): TTemplateLinkType;
    423426  end;
    424427
    425428procedure EditTemplates(Form: TForm; NewTemplate: boolean = FALSE; CopiedText: string = ''; Shared: boolean = FALSE);
     429
     430const
     431  TemplateEditorSplitters = 'frmTempEditSplitters';
     432  TemplateEditorSplitters2 = 'frmTempEditSplitters2';
     433
     434var
     435  tmplEditorSplitterMiddle: integer = 0;
     436  tmplEditorSplitterProperties: integer = 0;
     437  tmplEditorSplitterMain: integer = 0;
     438  tmplEditorSplitterBoil: integer = 0;
     439  tmplEditorSplitterNotes: integer = 0;
    426440
    427441implementation
    … …  
    431445uses dShared, uCore, rTemplates, fTemplateObjects, uSpell, fTemplateView,
    432446  fTemplateAutoGen, fDrawers, fTemplateFieldEditor, fTemplateFields, XMLUtils,
    433   fIconLegend, uReminders, uConst, rCore, rEventHooks, rConsults;
     447  fIconLegend, uReminders, uConst, rCore, rEventHooks, rConsults, VAUtils,
     448  rMisc, fFindingTemplates;
    434449
    435450const
    … …  
    499514      Drawers := TFrmDrawers(Form)
    500515    else
    501     if IsPublishedProp(Form, 'Drawers') then
    502       Drawers := TFrmDrawers(GetOrdProp(Form, 'Drawers'));
     516    if IsPublishedProp(Form, DrawersProperty) then
     517      Drawers := TFrmDrawers(GetOrdProp(Form, DrawersProperty));
    503518  end;
    504519
    … …  
    724739
    725740  BtnApply.Enabled := BackupDiffers;
     741  SetFormPosition(Self);
    726742end;
    727743
    … …  
    873889  end;
    874890  lblNotes.Enabled := (not reNotes.ReadOnly);
    875   if(reNotes.ReadOnly) then
    876     reNotes.Color := ReadOnlyColor
    877   else
    878     reNotes.Color := clWindow;
     891  UpdateReadOnlyColorScheme(reNotes, reNotes.ReadOnly);
    879892  cbxType.Enabled := ok;
    880893  lblType.Enabled := ok;
    … …  
    894907  lblLines.Enabled := ok;
    895908  reBoil.ReadOnly := not ok;
    896   if(ok) then
    897     reBoil.Color := clWindow
    898   else
    899     reBoil.Color := ReadOnlyColor;
     909  UpdateReadOnlyColorScheme(reBoil, not ok);
    900910  lblLink.Enabled := ok;
    901911  cbxLink.Enabled := ok;
    … …  
    937947end;
    938948
     949procedure TfrmTemplateEditor.ShowGroupBoilerplate(Visible: boolean);
     950begin
     951  pnlGroupBP.Visible := Visible;
     952  splBoil.Visible := Visible;
     953  if Visible then
     954  begin
     955    reBoil.Align := alTop;
     956    pnlGroupBP.Align := alClient;
     957    reBoil.Height := tmplEditorSplitterBoil;
     958    splBoil.Top := pnlGroupBP.Top - splBoil.Height;
     959  end
     960  else
     961  begin
     962    pnlGroupBP.Align := alBottom;
     963    reBoil.Align := alClient;
     964  end;
     965end;
     966
    939967procedure TfrmTemplateEditor.ShowInfo(Node: TTreeNode);
    940968var
    … …  
    942970  Idx: TTypeIndex;
    943971  CanDoCOM: boolean;
    944   LinkTemplate: TTemplate;
    945972  lt: TTemplateLinkType;
    946973  lts: string;
    947   i: integer;
    948974
    949975begin
    … …  
    9801006            begin
    9811007              FConsultServices := TStringList.Create;
    982               FConsultServices.Assign(LoadServiceListWithSynonyms(1));
     1008              FastAssign(LoadServiceListWithSynonyms(1), FConsultServices);
    9831009              SortByPiece(FConsultServices, U, 2);
    9841010            end;
    985             for i := 0 to FConsultServices.Count-1 do
    986             begin
    987               LinkTemplate := GetLinkedTemplate(piece(FConsultServices[i],U,1), ltConsult);
    988               if (not assigned(LinkTemplate)) or (LinkTemplate = FShowingTemplate) then
    989                 cbxLink.Items.Add(FConsultServices[i]);
    990             end;
     1011            FastAssign(FConsultServices, cbxLink.Items);
    9911012          end
    9921013          else
    … …  
    11711192      edtGap.Text := '0';
    11721193      reBoil.Clear;
    1173       pnlGroupBP.Visible := FALSE;
    1174       splBoil.Visible := FALSE;
     1194      ShowGroupBoilerplate(False);
    11751195      pnlBoilerplateResize(Self);
    11761196      pnlCOM.Visible := FALSE;
    … …  
    11961216begin
    11971217  if(pnlGroupBP.Visible) and (pnlGroupBP.Height > (pnlBoilerplate.Height-29)) then
     1218  begin
    11981219    pnlGroupBP.Height := pnlBoilerplate.Height-29;
     1220  end;
    11991221  if cbLongLines.checked then
    12001222    Max := 240
    … …  
    14491471      begin
    14501472        reBoil.ReadOnly := TRUE;
    1451         reBoil.Color := ReadOnlyColor;
     1473        UpdateReadOnlyColorScheme(reBoil, TRUE);
    14521474        UpdateInsertsDialogs;
    14531475      end;
    1454       pnlGroupBP.Visible := ItemOK;
    1455       splBoil.Visible := ItemOK;
     1476      ShowGroupBoilerplate(ItemOK);
    14561477      if(not ItemOK) and (IsReminderDialog or IsCOMObject) then
    14571478        BPOK := FALSE;
    1458       if(ItemOK) then
    1459         splBoil.Top := pnlGroupBP.Top - splBoil.Height;
    14601479      pnlBoilerplateResize(Self);
    14611480      pnlBoilerplate.Visible := BPOK;
    … …  
    14821501    frmTemplateFields := nil;
    14831502  end;
    1484   KillObj(@FPersonalObjects);
     1503  //---------- CQ #8665 - RV --------
     1504  //KillObj(@FPersonalObjects);
     1505  if (assigned(uPersonalObjects)) then
     1506  begin
     1507    KillObj(@uPersonalObjects);
     1508    uPersonalObjects.Free;
     1509    uPersonalObjects := nil;
     1510  end;
     1511  // ----  end CQ #8665 -------------
    14851512  dmodShared.OnTemplateLock := nil;
    14861513  dmodShared.InEditor := FALSE;
    … …  
    20402067end;
    20412068
     2069procedure TfrmTemplateEditor.AdjustControls4FontChange;
     2070var
     2071  x: integer;
     2072
     2073  procedure Adjust(Control: TWinControl);
     2074  begin
     2075    x := x - Control.Width - 2;
     2076    Control.Left := x;
     2077  end;
     2078
     2079begin
     2080  if FCanEditShared then
     2081  begin
     2082    x := pnlSharedBottom.Width;
     2083    Adjust(sbSHDelete);
     2084    Adjust(sbSHDown);
     2085    Adjust(sbSHUp);
     2086    cbSHHide.Width := x;
     2087  end;
     2088  x := pnlBottom.Width;
     2089  Adjust(btnApply);
     2090  Adjust(btnCancel);
     2091  Adjust(btnOK);
     2092  cbEditShared.Width := TextWidthByFont(cbEditShared.Font.Handle, cbEditShared.Caption) + 25;
     2093  cbNotes.Left := cbEditShared.Left + cbEditShared.Width + 60;
     2094  cbNotes.Width := TextWidthByFont(cbNotes.Font.Handle, cbNotes.Caption) + 25;
     2095end;
     2096
    20422097function TfrmTemplateEditor.AllowMove(ADropNode, ADragNode: TTreeNode): boolean;
    20432098var
    … …  
    22052260  MoveCopyButtons;
    22062261  tvTreeChange(FCurTree, FCurTree.Selected);
     2262  if FCanEditShared then
     2263    AdjustControls4FontChange;
    22072264end;
    22082265
    … …  
    23272384procedure TfrmTemplateEditor.btnFindClick(Sender: TObject);
    23282385var
    2329   Found: boolean;
     2386  Found: TTreeNode;
    23302387  edtSearch: TEdit;
     2388  IsNext: boolean;
    23312389  FindNext: boolean;
    23322390  FindWholeWords: boolean;
    … …  
    23342392  Tree: TTreeView;
    23352393  LastFoundNode, TmpNode: TTreeNode;
    2336   S1,S2: string;
     2394//  S1,S2: string;
    23372395
    23382396begin
    … …  
    23452403    FindCase := cbShMatchCase.Checked;
    23462404    LastFoundNode := FLastFoundShNode;
    2347     if(FSharedEmptyNodeCount > 0) then
    2348     begin
    2349       FInternalHiddenExpand := TRUE;
    2350       try
    2351         tvShared.Items.GetFirstNode.Expand(TRUE);
    2352       finally
    2353         FInternalHiddenExpand := FALSE;
    2354       end;
    2355     end;
    23562405  end
    23572406  else
    … …  
    23632412    FindCase := cbPerMatchCase.Checked;
    23642413    LastFoundNode := FLastFoundPerNode;
    2365     if(FPersonalEmptyNodeCount > 0) then
    2366     begin
    2367       FInternalHiddenExpand := TRUE;
    2368       try
    2369         tvPersonal.Items.GetFirstNode.Expand(TRUE);
    2370       finally
    2371         FInternalHiddenExpand := FALSE;
    2372       end;
    2373     end;
    23742414  end;
    23752415  if(edtSearch.text <> '') then
    23762416  begin
    2377     if((FindNext) and assigned (LastFoundNode)) then
    2378       TmpNode := LastFoundNode.GetNext
     2417    IsNext := ((FindNext) and assigned (LastFoundNode));
     2418    if IsNext then
     2419   
     2420      TmpNode := LastFoundNode
    23792421    else
    23802422      TmpNode := Tree.Items.GetFirstNode;
    2381     Found := FALSE;
    2382     if(assigned(TmpNode)) then
    2383     begin
    2384       S1 := edtSearch.Text;
    2385       if(not FindCase) then
    2386         S1 := UpperCase(S1);
    2387       while (assigned(TmpNode) and (not Found)) do
    2388       begin
    2389         S2 := TmpNode.Text;
    2390         if(not FindCase) then
    2391           S2 := UpperCase(S2);
    2392         Found := SearchMatch(S1, S2, FindWholeWords);
    2393         if(not Found) then
    2394           TmpNode := TmpNode.GetNext;
    2395       end;
    2396     end;
    2397     if(Found) then
    2398     begin
     2423    FInternalHiddenExpand := TRUE;
     2424    try
     2425      Found := FindTemplate(edtSearch.Text, Tree, Self, TmpNode,
     2426                            IsNext, not FindCase, FindWholeWords);
     2427    finally
     2428      FInternalHiddenExpand := FALSE;
     2429    end;
     2430    if Assigned(Found) then
     2431    begin
     2432      Tree.Selected := Found;
    23992433      if(Tree = tvShared) then
    2400         FLastFoundShNode := TmpNode
     2434        FLastFoundShNode := Found
    24012435      else
    2402         FLastFoundPerNode := TmpNode;
     2436        FLastFoundPerNode := Found;
    24032437      SetFindNext(Tree, TRUE);
    2404       Tree.Selected := TmpNode;
    2405     end
    2406     else
    2407     begin
    2408       if(FindNext) then
    2409         S1 := ''
    2410       else
    2411         S1 := '  "' + edtSearch.Text + '" was not Found.';
    2412       SetFindNext(Tree, FALSE);
    2413       InfoBox('Search Complete.' + S1, 'Information', MB_OK or MB_ICONINFORMATION);
    24142438    end;
    24152439  end;
    … …  
    24992523    end;
    25002524    pnlBoilerplateResize(Self);
     2525    AdjustControls4FontChange;
     2526    MoveCopyButtons;
    25012527  end;
    25022528end;
    … …  
    25162542    begin
    25172543      UpdatePersonalObjects;
    2518       if FPersonalObjects.Count > 0 then
     2544      if uPersonalObjects.Count > 0 then                                                  // -------- CQ #8665 - RV ------------
    25192545      begin
    25202546        DoIt := FALSE;
    25212547        for i := 0 to dmodShared.TIUObjects.Count-1 do
    2522           if FPersonalObjects.IndexOf(Piece(dmodShared.TIUObjects[i],U,2)) >= 0 then
     2548          if uPersonalObjects.IndexOf(Piece(dmodShared.TIUObjects[i],U,2)) >= 0 then      // -------- CQ #8665 - RV ------------
    25232549            frmTemplateObjects.cboObjects.Items.Add(dmodShared.TIUObjects[i]);
    25242550      end;
    25252551    end;
    25262552    if DoIt then
    2527       frmTemplateObjects.cboObjects.Items.Assign(dmodShared.TIUObjects);
     2553      FastAssign(dmodShared.TIUObjects, frmTemplateObjects.cboObjects.Items);
    25282554    frmTemplateObjects.Font := Font;
    25292555    frmTemplateObjects.re := reBoil;
    … …  
    26332659end;
    26342660
     2661procedure TfrmTemplateEditor.FormClose(Sender: TObject;
     2662  var Action: TCloseAction);
     2663begin
     2664  SaveUserBounds(Self);
     2665end;
     2666
    26352667procedure TfrmTemplateEditor.FormCloseQuery(Sender: TObject;
    26362668  var CanClose: Boolean);
    … …  
    26662698procedure TfrmTemplateEditor.splBoilMoved(Sender: TObject);
    26672699begin
     2700  if pnlBoilerplate.Visible and pnlGroupBP.Visible then
     2701    tmplEditorSplitterBoil := reBoil.Height;
     2702  if pnlNotes.Visible then
     2703    tmplEditorSplitterNotes := pnlNotes.Height;
    26682704  pnlBoilerplateResize(Self);
    26692705end;
    … …  
    31053141procedure TfrmTemplateEditor.mbMainResize(Sender: TObject);
    31063142begin
    3107   pnlMenu.Width := mbMain.Width + 3;
     3143  pnlMenu.Width := mbMain.Width + 4;
     3144  mbMain.Width := pnlMenu.Width - 3;
    31083145end;
    31093146
    … …  
    31793216  dmodShared.LoadTIUObjects;
    31803217  UpdatePersonalObjects;
    3181   GetAutoGenText(AName, AText, FPersonalObjects);
     3218  GetAutoGenText(AName, AText, uPersonalObjects);   // -------- CQ #8665 - RV ------------
    31823219  if(AName <> '') and (AText <> '') then
    31833220  begin
    … …  
    32743311  pnlNotes.Visible := cbNotes.Checked;
    32753312  splNotes.Visible := cbNotes.Checked;
    3276   splNotes.Top := pnlNotes.Top-3;
     3313  if cbNotes.Checked then
     3314  begin
     3315    pnlNotes.Height := tmplEditorSplitterNotes;
     3316    pnlNotes.Top := pnlBottom.Top - pnlNotes.Height;
     3317    splNotes.Top := pnlNotes.Top-3;
     3318  end;
    32773319  pnlBoilerplateResize(Self);
    32783320end;
    … …  
    33973439            if (Flds.Count > 0) then begin
    33983440              ExpandEmbeddedFields(Flds);
    3399               Flds.Assign(ExportTemplateFields(Flds));
     3441              FastAssign(ExportTemplateFields(Flds), Flds);
    34003442              for i := 0 to Flds.Count-1 do
    34013443                Flds[i] := '  ' + Flds[i];
    3402               Tmpl.AddStrings(Flds);
     3444              FastAddStrings(Flds, Tmpl);
    34033445            end; {if}
    34043446            Tmpl.Add('</'+XMLHeader+'>');
    … …  
    37043746            FUpdating := FALSE;
    37053747          end;
    3706           ShowMessage('Can not assign a Reminder Dialog to a Reason for Request');
     3748          ShowMsg('Can not assign a Reminder Dialog to a Reason for Request');
    37073749        end
    37083750        else
    … …  
    37903832end;
    37913833
    3792 procedure TfrmTemplateEditor.UpdatePersonalObjects;
     3834(*procedure TfrmTemplateEditor.UpdatePersonalObjects;
    37933835var
    37943836  i: integer;
    … …  
    38033845    FPersonalObjects.Sorted := TRUE;
    38043846  end;
    3805 end;
     3847end;*)
    38063848
    38073849(*function TfrmTemplateEditor.ModifyAllowed(const Node: TTreeNode): boolean;
    … …  
    38753917begin
    38763918  Resync([TTemplate(Sender)]);
    3877   ShowMessage(Format(TemplateLockedText, [TTemplate(Sender).PrintName]));
     3919  ShowMsg(Format(TemplateLockedText, [TTemplate(Sender).PrintName]));
    38783920end;
    38793921
    … …  
    40744116  try
    40754117    case TTemplateLinkType(pnlLink.Tag) of
    4076       ltTitle:     tmpSL.Assign(SubSetOfAllTitles(StartFrom, Direction));
     4118      ltTitle:     FastAssign(SubSetOfAllTitles(StartFrom, Direction), tmpSL);
    40774119//      ltConsult:
    40784120      ltProcedure:
    40794121        begin
    4080           tmpSL.Assign(SubSetOfProcedures(StartFrom, Direction));
     4122          FastAssign(SubSetOfProcedures(StartFrom, Direction), tmpSL);
    40814123          for i := 0 to tmpSL.Count-1 do
    40824124          begin
    … …  
    40964138var
    40974139  Template,LinkTemplate: TTemplate;
     4140  update: boolean;
    40984141
    40994142begin
    … …  
    41044147    if assigned(Template) and Template.CanModify then
    41054148    begin
     4149      update := true;
    41064150      if cbxLink.ItemIEN > 0 then
    41074151      begin
    … …  
    41094153        if (assigned(LinkTemplate) and (LinkTemplate <> Template)) then
    41104154        begin
    4111           ShowMessage(GetLinkName(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag)) +
     4155          ShowMsg(GetLinkName(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag)) +
    41124156                      ' is already assigned to another template.');
    4113           cbxLink.ItemIndex := -1;
     4157          cbxLink.SelectByID(Template.LinkIEN);
     4158          update := False;
     4159        end
     4160        else
     4161        begin
     4162          Template.FileLink := ConvertFileLink(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag));
     4163          if Template.LinkName <> '' then
     4164            edtName.Text := copy(Template.LinkName,1,edtName.MaxLength);
    41144165        end;
    4115         Template.FileLink := ConvertFileLink(cbxLink.ItemID, TTemplateLinkType(pnlLink.tag));
    4116         if Template.LinkName <> '' then
    4117           edtName.Text := copy(Template.LinkName,1,edtName.MaxLength);
    41184166      end
    41194167      else
    41204168        Template.FileLink := '';
    4121       UpdateApply(Template);
    4122     end;
    4123   end;
    4124 end;
    4125 
    4126 procedure TfrmTemplateEditor.cbxLinkSynonymCheck(Sender: TObject;
    4127   const Text: String; var IsSynonym: Boolean);
    4128 var
    4129   LinkTemplate: TTemplate;
    4130   var IEN: string;
    4131 
    4132 begin
    4133   IsSynonym := FALSE;
    4134   if pnlLink.Visible and assigned(FShowingTemplate) then
    4135   begin
    4136     IEN := Piece(Text,#9,30);
    4137     if IEN <> '' then
    4138     begin
    4139       LinkTemplate := GetLinkedTemplate(IEN, TTemplateLinkType(pnlLink.Tag));
    4140       IsSynonym := (assigned(LinkTemplate) and (LinkTemplate <> FShowingTemplate));
    4141     end
    4142     else
    4143       IsSynonym := FALSE;
     4169      if update then
     4170        UpdateApply(Template);
     4171    end;
    41444172  end;
    41454173end;
Note: See TracChangeset for help on using the changeset viewer.