Changeset 473 for cprs/branches/tmg-cprs/CPRS-Chart/fFrame.pas

Timestamp:

Aug 8, 2008, 8:34:55 PM (16 years ago)

Author:

Kevin Toppenberg

Message:

Added Colorful Tabs, Changable Tab positions, Demographics translation enabled

File:

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

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

@@ -250 +250 @@
     procedure mnuViewInformationClick(Sender: TObject);
     procedure EditDemographicsClick(Sender: TObject);
+    procedure tabPageDrawTab(Control: TCustomTabControl; TabIndex: Integer;
+      const Rect: TRect; Active: Boolean);
   private
     //kt Begin Mod (change Consts to Vars) 7/17/2007
@@ -319 +321 @@
     procedure ClearPatient;
     procedure ChangeFont(NewFontSize: Integer);
+    procedure LoadTabColors(INIFile : TIniFile; ColorsList : TStringList);  //kt added 8/8/08
+    procedure SaveTabColors(INIFile : TIniFile; ColorsList : TStringList);
     //procedure CreateTab(var AnInstance: TObject; AClass: TClass; ATabID: integer; ALabel: string);
     procedure CreateTab(ATabID: integer; ALabel: string);
@@ -361 +365 @@
     procedure HandleCCOWError(AMessage: string);
     procedure SetupVars;
+    procedure DrawTab(Control: TCustomTabControl; TabIndex: Integer;
+                      const Rect: TRect; Color : TColor; Active: Boolean); //kt added 8/8/08
   public
     EnduringPtSelSplitterPos: integer;
@@ -393 +399 @@
   frmFrame: TfrmFrame;
   uTabList: TStringList;
+  uTabColorsList : TStringList;  //kt added 8/8/08
   uRemoteType : string;
   FlaggedPTList: TStringList;
@@ -424 +431 @@
   , CCOW_const
   {$ENDIF}
-  , fPtDemoEdit;
+  , fPtDemoEdit
+  , fOptionsOther;
 
 var                                 //  RV 05/11/04
@@ -720 +728 @@
   i : integer;  //kt added 6/29/07
   CPRSChartINI: TINIFile;  //elh 6/23/08
+  tempPosition : TTabPosition; //kt
 begin
   //kt 6/29/07  Begin modification -------------------
@@ -800 +809 @@
   Application.OnDeActivate := AppDeActivated;
 
-  // load language ini settings
+  // load language ini settings   //elh added
   CPRSChartINI := TINIFile.Create(ExtractFilePath(ParamStr(0)) + 'CPRSChart.ini');  // Read from INI  elh  6/23/08
   LangManager.LanguageID := CPRSChartINI.ReadInteger('Options','Language',1033);
-  CPRSChartINI.Free;
+  tempPosition := TTabPosition(CPRSChartINI.ReadInteger('TAB_POSITION','Tab Location',0));
+  if tempPosition > tpRight then tempPosition := tpBottom;
+  fOptionsOther.SetTabPosition(tempPosition);
+  //kt -- end mod --
 
   //frmFrame.Caption := TX_IN_USE + MixedCase(User.Name) + '  (' + RPCBrokerV.Server + ')';  //kt added
   //frmFrame.RenameTabs;  //Resets names of tabs to correct translation  //kt
-  
 
   // create initial core objects
@@ -897 +908 @@
   RemoteReports := TRemoteReportList.Create;
   uTabList := TStringList.Create;
+  uTabColorsList := TStringList.Create;  //kt added 8/8/08
   FlaggedPTList := TStringList.Create;
   HasFlag  := False;
@@ -934 +946 @@
   end;
   //kt replace later... CreateTab(CT_IMAGES,   'Images');   //kt  8/19/05
+  LoadTabColors(CPRSChartINI,uTabColorsList);  //kt added 8/8/08
 
   ShowHideChartTabMenus(mnuViewChart);
@@ -971 +984 @@
 //  if WindowState = wsMinimized then WindowState := wsNormal;
   SetFormMonitoring(true);
+  CPRSChartINI.Free;  //kt added 8/8/08
 end;
 
@@ -1066 +1080 @@
   if URL='<!HIDE!>' then begin
     SetATabVisibility(ATabID, false);
-  end else begin
+  end else if URL<>'<!NOCHANGE!>' then begin
     SetATabVisibility(ATabID, true, TabLabel);
     tempFrmWebTab := TfrmWebTab(frmWebTabs[WebTabNum-1]);
@@ -1145 +1159 @@
 procedure TfrmFrame.FormDestroy(Sender: TObject);
 { free core objects used by CPRS }
+var
+  CPRSChartINI: TINIFile;  //kt 8/8/08
+
 begin
   Application.OnActivate := FOldActivate;
@@ -1150 +1167 @@
   FNextButtonBitmap.Free;
   uTabList.Free;
+  //kt --- 8/8/08 start mod ---
+  CPRSChartINI := TINIFile.Create(ExtractFilePath(ParamStr(0)) + 'CPRSChart.ini');
+  CPRSChartINI.WriteInteger('Options','Language',LangManager.LanguageID);
+  SaveTabColors(CPRSChartINI,uTabColorsList);
+  uTabColorsList.Free;
+  CPRSChartINI.WriteInteger('TAB_POSITION','Tab Location',integer(tabPage.TabPosition));
+  //kt --- end mod ---
+
   FlaggedPTList.Free;
   RemoteSites.Free;
@@ -3718 +3743 @@
       tabPage.Tabs.Add(ALabel);
     end;
+  if uTabColorsList.IndexOf(ALabel) < 0 then                    //kt added 8/8/08
+    uTabColorsList.Add(ALabel);  //will put colors in later...  //kt
+end;
+
+procedure TfrmFrame.LoadTabColors(INIFile : TIniFile; ColorsList : TStringList);
+//kt added 8/8/08  Entire function
+var i : integer;
+    sValue : string;
+    value : longword;
+begin
+  value :=0;
+  for i := 0 to ColorsList.Count-1 do begin
+    sValue := INIFile.ReadString('TAB_COLORS',ColorsList.Strings[i],IntToStr($00FFFF));
+    try
+      value := StrToInt(sValue)
+    except
+      on EConvertError do value := $00FFFF;
+    end;
+    ColorsList.Objects[i] := pointer(value);
+  end;
+end;
+
+procedure TfrmFrame.SaveTabColors(INIFile : TIniFile; ColorsList : TStringList);
+//kt added 8/8/08  Entire function
+var i : integer;
+begin
+  for i := 0 to ColorsList.Count-1 do begin
+    INIFile.WriteInteger('TAB_COLORS',ColorsList.Strings[i],longword(ColorsList.Objects[i]));
+  end;
 end;
 
@@ -4830 +4884 @@
 
 procedure TfrmFrame.EditDemographicsClick(Sender: TObject);
-//kt added Function 12/15/07, 6/6/08 
+//kt added Function 12/15/07, 6/6/08
 var  EditResult: integer;
 begin
@@ -4837 +4891 @@
 end;
 
+procedure TfrmFrame.tabPageDrawTab(Control: TCustomTabControl; TabIndex: Integer;
+                                   const Rect: TRect; Active: Boolean);
+var ALabel : string;
+    colorIndex : Integer;
+    color : TColor;
+begin
+  ALabel := TTabControl(Control).Tabs[TabIndex];
+  colorIndex := uTabColorsList.IndexOf(ALabel);
+  if colorIndex < 0 then color := clYellow
+  else color := TColor(uTabColorsList.Objects[colorIndex]);
+  DrawTab(Control,TabIndex,Rect,color,Active);
+end;
+
+procedure TfrmFrame.DrawTab(Control: TCustomTabControl; TabIndex: Integer;
+                           const Rect: TRect; Color : TColor; Active: Boolean);
+  var
+    oRect         : TRect;
+    sCaption,temp : String;
+    iTop          : Integer;
+    iLeft         : Integer;
+    i             : integer;
+    TabControl    : TTabControl;
+    lf            : TLogFont;  //Windows native font structure
+    tf            : TFont;
+    Degrees       : integer;
+    inactiveColor     : TColor;
+
+    (*
+    function DecRed(Color : TColor; Amount : byte) : TColor;
+    var red : longWord;
+    begin
+      red := (Color and $0000FF);
+      if red > Amount then red := red - Amount
+      else red := 0;
+      Result := (Color and $FFFF00) or red;
+    end;
+
+    function DecGreen(Color : TColor; Amount : byte) : TColor;
+    var green : longWord;
+    begin
+      green := (Color and $00FF00);
+      green := green shr 8;
+      if green > Amount then green := green - Amount
+      else green := 0;
+      green := green shl 8;
+      Result := (Color and $FF00FF) or green;
+    end;
+
+    function DecBlue(Color : TColor; Amount : byte) : TColor;
+    var blue : longWord;
+    begin
+      blue := (Color and $FF0000);
+      blue := blue shr 16;
+      if blue > Amount then blue := blue - Amount
+      else blue := 0;
+      blue := blue shl 16;
+      Result := (Color and $00FFFF) or blue;
+    end;
+
+   function Darken(Color : TColor; Amount : byte) : TColor;
+   begin
+     result:= DecRed(Color, Amount);
+     result := DecBlue(result,Amount);
+     result := DecGreen(result,Amount);
+   end;
+   *)
+
+  var
+    DecAmount : Byte;
+
+  begin
+    oRect    := Rect;
+    //DecAmount := 50;
+    //inactiveColor := Darken(Color,DecAmount);
+    inactiveColor := Color;
+
+    TabControl := TTabControl(Control);
+    if TabControl.Tabs.Count=0 then exit;
+    sCaption := TabControl.Tabs.Strings[TabIndex];
+    for i := 1 to length(temp) do begin
+      if temp[i] <> '&' then sCaption := sCaption + temp[i];
+    end;
+
+    Control.Canvas.Font.Name := 'Tahoma';
+    if Active then Control.Canvas.Font.Style := Control.Canvas.Font.Style + [fsBold];
+    if Active then Control.Canvas.Font.Color := clBlack
+    else Control.Canvas.Font.Color := clWhite;
+
+    if (TabControl.TabPosition = tpLeft) or (TabControl.TabPosition = tpRight) then begin
+
+      if (TabControl.TabPosition = tpLeft) then begin
+        iTop     := Rect.Bottom-4;
+        if Active then iTop := iTop - 2;
+        iLeft    := Rect.Left + 1;
+        Degrees  := 90;
+      end else begin
+        iTop     := Rect.Top  + 4;
+        if Active then iTop := iTop + 2;
+        iLeft    := Rect.Right - 2;
+        Degrees  := 270;
+      end;
+      tf := TFont.Create;
+      try
+        tf.Assign(Control.Canvas.Font);
+        GetObject(tf.Handle, sizeof(lf), @lf);
+        lf.lfEscapement := 10 * Degrees;  //degrees of desired rotation
+        lf.lfHeight := Control.Canvas.Font.Height - 2;
+        tf.Handle := CreateFontIndirect(lf);
+        Control.Canvas.Font.Assign(tf);
+      finally
+        tf.Free;
+      end;
+
+    end else begin
+      iTop     := Rect.Top  + ((Rect.Bottom - Rect.Top  - Control.Canvas.TextHeight(sCaption)) div 2) + 1;
+      iLeft    := Rect.Left + ((Rect.Right  - Rect.Left - Control.Canvas.TextWidth (sCaption)) div 2) + 1;
+    end;
+
+    if Active then begin
+      //Control.Canvas.Brush.Color := TColor($0000FFFF);  //Bright yellow
+      Control.Canvas.Brush.Color := Color;
+      Control.Canvas.FillRect(Rect);
+    end else begin
+      //Control.Canvas.Brush.Color := TColor($000079EFE8);  //dull yellow
+      Control.Canvas.Brush.Color := inactiveColor;
+      Control.Canvas.FillRect(Rect);
+    end;
+    Control.Canvas.TextOut(iLeft,iTop,sCaption);
+  end;
+
+
+
+
 initialization