Changeset 541 for cprs/branches/tmg-cprs/CPRS-Chart/fDrawers.pas

Timestamp:

Aug 12, 2009, 7:14:16 PM (15 years ago)

Author:

Kevin Toppenberg

Message:

TMG Ver 1.1 Added HTML Support, better demographics editing

File:

• cprs/branches/tmg-cprs/CPRS-Chart/fDrawers.pas (modified) (16 diffs)

cprs/branches/tmg-cprs/CPRS-Chart/fDrawers.pas

@@ -11 +11 @@
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   ExtCtrls, StdCtrls, Buttons, ORCtrls, ComCtrls, ImgList, uTemplates,
+  TMGHTML2, rHTMLTools, StrUtils, //kt added uses on this line. 8/09
   Menus, ORClasses, ORFn, DKLang;
 
 type
+  THTMLModeSwitcher = procedure(HTMLMode : boolean; Quiet : boolean) of object;  //kt 8/09
   TDrawer = (odNone, odTemplates, odEncounter, odReminders, odOrders);
   TDrawers = set of TDrawer;
@@ -114 +116 @@
     FindNextText     : string;  //kt
     //kt End Mod -------------------
+    FHtmlEditControl: THtmlObj;            //kt 8/09
+    FHtmlModeSwitcher : THTMLModeSwitcher; //kt 8/09
     FOpenToNode: string;
     FOldMouseUp: TMouseEvent;
@@ -155 +159 @@
     procedure ReloadTemplates;
     procedure SetRichEditControl(const Value: TRichEdit);
+    procedure SetHTMLEditControl(const Value: THtmlObj);                   //kt 8/09
     procedure CheckAsk;
     procedure FontChanged(Sender: TObject);
@@ -167 +172 @@
     procedure AddTemplateNode(const tmpl: TTemplate; const Owner: TTreeNode = nil);
     procedure MoveCaret(X, Y: integer);
+    procedure MoveHTMLCaret(X, Y: integer);                                //kt 8/09
     procedure NewRECDragDrop(Sender, Source: TObject; X, Y: Integer);
     procedure NewRECDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState;
                              var Accept: Boolean);
+    procedure NewRECHTMLDragDrop(Sender, Source: TObject; X, Y: Integer);  //kt 8/09
+    procedure NewRECHTMLDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState;
+                             var Accept: Boolean);                         //kt 8/09
     procedure InsertText;
     procedure SetSplitter(const Value: TSplitter);
@@ -175 +184 @@
     procedure SetSplitterActive(Active: boolean);
     function EnableDrawer(Drawer: TDrawer; EnableIt: boolean): boolean;
-    function InsertOK(Ask: boolean): boolean;
+    //kt 8/09 function InsertOK(Ask: boolean): boolean;
+    function InsertOK(Ask: boolean; TemplateIsHTML : boolean = false): boolean;  //kt 8/09
     procedure OpenToNode(Path: string = '');
     property FindNext: boolean read FFindNext write SetFindNext;
@@ -196 +206 @@
     procedure ResetTemplates;
     property RichEditControl: TRichEdit read FRichEditControl write SetRichEditControl;
+    property HTMLEditControl : THtmlObj read FHtmlEditControl write SetHTMLEditControl; //kt 8/09
+    property HTMLModeSwitcher : THTMLModeSwitcher read FHtmlModeSwitcher write FHtmlModeSwitcher; //kt 8/09
     property NewNoteButton: TButton read FNewNoteButton write FNewNoteButton;
     property Splitter: TSplitter read FSplitter write SetSplitter;
@@ -202 +214 @@
     property DefTempPiece: integer read FDefTempPiece write FDefTempPiece;
     property TheOpenDrawer: TDrawer read FOpenDrawer;
+    function HTMLEditActive : boolean;  //kt 8/09
   published
     property Align: TAlign read GetAlign write SetAlign;
@@ -218 +231 @@
 uses fTemplateView, uCore, rTemplates, fTemplateEditor, dShared, uReminders,
   fReminderDialog, RichEdit, fRptBox, Clipbrd, fTemplateDialog, fIconLegend,
+  Inifiles,  //kt 8/09
   uAccessibleTreeView, uAccessibleTreeNode;
 
@@ -846 +860 @@
 end;
 
+procedure TfrmDrawers.SetHTMLEditControl(const Value: THtmlObj);
+//kt added this function 8/09
+begin
+  if (FHtmlEditControl <> Value) then begin
+    if (assigned(FHtmlEditControl)) then begin
+      FHtmlEditControl.OnDragDrop := FOldDragDrop;
+      FHtmlEditControl.OnDragOver := FOldDragOver;
+    end;
+    FHtmlEditControl := Value;
+    if (assigned(FHtmlEditControl)) then begin
+      FOldDragDrop := FHtmlEditControl.OnDragDrop;
+      FOldDragOver := FHtmlEditControl.OnDragOver;
+      FHtmlEditControl.OnDragDrop := NewRECHTMLDragDrop;
+      FHtmlEditControl.OnDragOver := NewRECHTMLDragOver;
+    end;
+  end;
+end;
+
+function TfrmDrawers.HTMLEditActive : boolean;
+//kt added this function 8/09
+begin
+  if assigned(FHtmlEditControl) then begin
+    Result := FHtmlEditControl.Active;
+  end else Result := false;
+end;
 
 procedure TfrmDrawers.MoveCaret(X, Y: integer);
@@ -857 +896 @@
 end;
 
+procedure TfrmDrawers.MoveHTMLCaret(X, Y: integer);
+//kt added entire function 8/09
+var   pt: TPoint;
+begin
+  FHtmlEditControl.SetFocus;
+  pt := Point(x, y);
+  FHTMLEditControl.MoveCaretToPos(pt);
+end;
 
 procedure TfrmDrawers.NewRECDragDrop(Sender, Source: TObject; X,
@@ -889 +936 @@
 end;
 
+procedure TfrmDrawers.NewRECHTMLDragDrop(Sender, Source: TObject; X, Y: Integer);
+//kt added function 8/09
+//NOTE: I think this can be combined with NewRECDragDrop, but must fix MoveCaret
+begin
+  if (Source = tvTemplates) then begin
+    MoveHTMLCaret(X, Y);
+    InsertText;
+  end else if(assigned(FOldDragDrop)) then begin
+    FOldDragDrop(Sender, Source, X, Y);
+  end;
+end;
+
+procedure TfrmDrawers.NewRECHTMLDragOver(Sender, Source: TObject;
+                                     X, Y: Integer; State: TDragState;
+                                     var Accept: Boolean);
+//kt added function 8/09
+begin
+  Accept := FALSE;
+  if (Source = tvTemplates) then begin
+    if (assigned(FDragNode))
+    and (TTemplate(FDragNode.Data).RealType in [ttDoc, ttGroup]) then begin
+      Accept := TRUE;
+      MoveHTMLCaret(X, Y);
+    end;
+  end else if (assigned(FOldDragOver)) then begin
+    FOldDragOver(Sender, Source, X, Y, State, Accept);
+  end;
+end;
+
 procedure TfrmDrawers.InsertText;
 var
@@ -894 +970 @@
   txt, DocInfo: string;
   Template: TTemplate;
+  TemplateIsHTML : boolean; //kt 8/09
 
 begin
   DocInfo := '';
-  if InsertOK(TRUE) and (dmodShared.TemplateOK(tvTemplates.Selected.Data)) then
-  begin
+  //kt if InsertOK(TRUE) and (dmodShared.TemplateOK(tvTemplates.Selected.Data)) then begin
+  if (dmodShared.TemplateOK(tvTemplates.Selected.Data)) then begin  //kt
     Template := TTemplate(tvTemplates.Selected.Data);
+    TemplateIsHTML := rHTMLTools.IsHTML(Template.Text); //kt
+    if not InsertOK(TRUE,TemplateIsHTML) then exit;  //kt
     Template.TemplatePreviewMode := FALSE;
     if Template.IsReminderDialog then
@@ -908 +987 @@
         txt := Template.COMObjectText('', DocInfo)
       else
+        uTemplates.bUsingHTMLMode := HTMLEditActive; //kt 8/09  Will be used in TTemplate.GetText
         txt := Template.Text;
       if(txt <> '') then
@@ -913 +993 @@
 //      CheckBoilerplate4Fields(txt, 'Template: ' + Template.PrintName);  <-- original line.  //kt 7/15/2007
         CheckBoilerplate4Fields(txt, DKLangConstW('fDrawers_Templatex') + Template.PrintName); //kt added 7/15/2007
-        BeforeLine := SendMessage(FRichEditControl.Handle, EM_EXLINEFROMCHAR, 0, FRichEditControl.SelStart);
-        FRichEditControl.SelText := txt;
-        FRichEditControl.SetFocus;
-        SendMessage(FRichEditControl.Handle, EM_SCROLLCARET, 0, 0);
-        AfterTop := SendMessage(FRichEditControl.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
-        SendMessage(FRichEditControl.Handle, EM_LINESCROLL, 0, -1 * (AfterTop - BeforeLine));
+        if HTMLEditActive then begin  //kt added block 8/09
+          //FHtmlEditControl.InsertTextAtCaret(txt);
+          FHtmlEditControl.SelText := txt;
+          FHtmlEditControl.SetFocus;
+        end else begin  //kt original below  8/09
+          BeforeLine := SendMessage(FRichEditControl.Handle, EM_EXLINEFROMCHAR, 0, FRichEditControl.SelStart);
+          FRichEditControl.SelText := txt;
+          FRichEditControl.SetFocus;
+          SendMessage(FRichEditControl.Handle, EM_SCROLLCARET, 0, 0);
+          AfterTop := SendMessage(FRichEditControl.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
+          SendMessage(FRichEditControl.Handle, EM_LINESCROLL, 0, -1 * (AfterTop - BeforeLine));
+        end;  //kt 8/09
       end;
     end;
@@ -1497 +1583 @@
 end;
 
-function TfrmDrawers.InsertOK(Ask: boolean): boolean;
-
-  function REOK: boolean;
-  begin
-    Result := assigned(FRichEditControl) and
-              FRichEditControl.Visible and
-              FRichEditControl.Parent.Visible;
-  end;
-
-begin
-  Result := REOK;
+
+//kt 8/09 function TfrmDrawers.InsertOK(Ask: boolean): boolean;
+function TfrmDrawers.InsertOK(Ask: boolean; TemplateIsHTML : boolean): boolean;  //kt 8/09
+
+  function EditControlOK: boolean;   //kt 8/09 renamed.  Was REOK
+  begin
+    if HTMLEditActive then begin  //kt added this part 8/09
+      Result := assigned(FHtmlEditControl) and
+                FHtmlEditControl.Visible and
+                TWinControl(FHtmlEditControl).Parent.Visible;
+    end else begin  //kt original below.
+      Result := assigned(FRichEditControl) and
+                FRichEditControl.Visible and
+                FRichEditControl.Parent.Visible and
+                FRichEditControl.Parent.Parent.Visible;   //kt added last line
+    end;
+  end;
+
+begin
+  Result := EditControlOK;  //kt renamed function.
   if (not ask) and (not Result) and (assigned(FNewNoteButton)) then
     Result := TRUE
@@ -1515 +1610 @@
   begin
     FNewNoteButton.Click;
-    Result := REOK;
+    if TemplateIsHTML and Assigned(FHtmlModeSwitcher) then begin  //kt 8/09
+      FHtmlModeSwitcher(TemplateIsHTML, true);                    //kt 8/09
+      FHtmlEditControl.MoveCaretToEnd;                            //kt 8/09
+    end;                                                          //kt 8/09
+    Result := EditControlOK;  //kt 8/09  Renamed function.
   end;
 end;