Changeset 488 for cprs/branches/GUI-config/MainU.pas

Timestamp:

Sep 11, 2008, 4:34:46 PM (17 years ago)

Author:

Kevin Toppenberg

Message:

Added debug log form

File:

• cprs/branches/GUI-config/MainU.pas (modified) (13 diffs)

cprs/branches/GUI-config/MainU.pas

@@ -81 +81 @@
     BasicUsersGrid: TStringGrid;
     MainMenu: TMainMenu;
-    File1: TMenuItem;
-    Exit1: TMenuItem;
+    FileMenu: TMenuItem;
+    ExitMenuItem: TMenuItem;
     AboutMenu: TMenuItem;
     CloneBtn: TBitBtn;
@@ -148 +148 @@
     procedure btnUsersApplyClick(Sender: TObject);
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
-    procedure Exit1Click(Sender: TObject);
+    procedure ExitMenuItemClick(Sender: TObject);
     procedure UserPageControlDrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean);
     procedure AboutMenuClick(Sender: TObject);
@@ -207 +207 @@
     CachedWPField : TStringList;
     FVisibleGridIdx : integer;
+    procedure ShowDebugClick(Sender: TObject);    
+    function FindParam(Param : string) : string;
     function GetCurrentUserName : string;
     procedure SetCursorImage(Cursor : TCursor);
@@ -247 +249 @@
     CurrentUserName: string;
     LastSelTreeNode : TTreeNode;
+    DebugMode : boolean;
     function GetUserLine(CurrentUserData : TStringList; Grid : TStringGrid; ARow:integer) :integer;
     function GetLineInfo(Grid : TStringGrid; CurrentUserData : TStringList; ARow: integer) : tFileEntry;
@@ -280 +283 @@
   frmSplash, Trpcb  , LookupU, SubfilesU, SetSelU, SelDateTimeU, PostU,
   FMErrorU, AboutU, PleaseWaitU, EditTextU, CreateTemplateU, SkinFormU,
-  BatchAddU;
+  BatchAddU, DebugU;
 
 {$R *.dfm}
@@ -289 +292 @@
   var tempMenu,tempSubMenu : TMenuItem;    
   begin
+    DebugMode := (FindParam('debug')='enable');
+    if DebugMode then begin
+      DebugForm.show;
+      tempMenu := TMenuItem.Create(FileMenu);
+      tempMenu.Caption := '&Show Debug Log';
+      tempMenu.OnClick := ShowDebugClick;
+      FileMenu.Add(tempMenu);
+    end;  
     {$IFDEF USE_SKINS} 
+    DebugForm.Memo.Lines.Add('Adding Menus');
     tempMenu := TMenuItem.Create(MainMenu);
     tempMenu.Caption := '&Appearance';
@@ -299 +311 @@
     {$ENDIF}
 
+    DebugForm.Memo.Lines.Add('Showing Splash');
     SplashForm.show;
   
@@ -313 +326 @@
     CachedWPField := TStringList.Create;  
   
+    DebugForm.Memo.Lines.Add('Adding Grid Info');
     AddGridInfo(BasicUsersGrid,CurrentUserData,true,LoadUserData,'200',btnUsersApply,btnUsersRevert);
     AddGridInfo(AdvancedUsersGrid,CurrentUserData,false,LoadUserData,'200',btnUsersApply,btnUsersRevert);    
@@ -322 +336 @@
 
     MainForm.Visible := false;
+    DebugForm.Memo.Lines.Add('Trying to connect to server');
     if not ORNet.ConnectToServer(RPC_CONTEXT) then begin
+      DebugForm.Memo.Lines.Add('Failed connection.  Closing.');
       Close; 
       Exit;
     end;
+    DebugForm.Memo.Lines.Add('Connected to server!');
     Application.ProcessMessages;
     LastSelTreeNode := nil;  
@@ -332 +349 @@
     BasicTemplate.Sorted := false;
     
+    DebugForm.Memo.Lines.Add('Initializing Combo Boxes');
     InitORCombobox(PatientORComboBox,'A');
     InitORCombobox(FileORComboBox,'A');
@@ -347 +365 @@
     {$IFDEF USE_SKINS} 
     if SkinForm.cbSkinAtStartup.Checked then begin
+      DebugForm.Memo.Lines.Add('Activating Skins');
       SkinForm.ActivateCurrentSkin;    
     end;
     {$ENDIF}
     
-    self.Visible := true;
+    self.Visible := true;    
     SplashForm.Hide;  
-  end;
-
+    DebugForm.Memo.Lines.Add('Done Initializing.');    
+  end;
+
+  function TMainForm.FindParam(Param : string) : string;
+  //Searches command line parameters for Param.  If found, then value returned.
+  //Case insensitive
+  //Must be in 'param=value' format, i.e. must have '='
+  var  i : integer;
+       tempS : string;    
+  begin
+    Result := '';
+    Param := LowerCase(Param);
+    for i := 1 to ParamCount do begin
+      tempS := LowerCase (ParamStr(i));
+      if Pos(Param,tempS)>0 then Result := Piece(tempS,'=',2);
+    end;
+  end;  
+
+  
   procedure TMainForm.AddGridInfo(Grid: TStringGrid; 
                                   Data : TStringList; 
@@ -1536 +1572 @@
   end;
 
-  procedure TMainForm.Exit1Click(Sender: TObject);
+  procedure TMainForm.ExitMenuItemClick(Sender: TObject);
   begin
        Close;
@@ -1970 +2006 @@
   end;
 
+  procedure TMainForm.ShowDebugClick(Sender: TObject);
+  begin
+    DebugForm.Show;
+  end;
+  
   procedure TMainForm.ChangeSkinClick(Sender: TObject);
   var result : TModalResult;