summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--extras/tiopf/gui/tiLogToGUI.pas372
-rw-r--r--extras/tiopf/gui/tiRtfReport.pas9
2 files changed, 376 insertions, 5 deletions
diff --git a/extras/tiopf/gui/tiLogToGUI.pas b/extras/tiopf/gui/tiLogToGUI.pas
new file mode 100644
index 00000000..5f789bb2
--- /dev/null
+++ b/extras/tiopf/gui/tiLogToGUI.pas
@@ -0,0 +1,372 @@
+{
+ Log to a window above the application's main form, but only if
+ the -lv parameter is passed on the command line
+
+ This in normally controlled by the tiLogReg unit.
+}
+unit tiLogToGUI;
+
+{$mode objfpc}{$H+}
+
+interface
+uses
+ Classes, SysUtils,
+ gfx_widget, gui_form, gui_memo, gui_menu, gui_panel, gui_button, fpgfx,
+ tiLog;
+
+type
+ TtiLogToGUI = class(TtiLogToCacheAbs)
+ private
+ FForm: TfpgForm;
+ FMemoLog: TfpgMemo;
+ FToolBar: TfpgPanel;
+ FPopupMenu: TfpgPopupMenu;
+ FSeveritySubMenu: TfpgPopupMenu;
+ FLogMenuItem: TfpgMenuItem;
+ FViewLogMenuItem: TfpgMenuItem;
+ FWordWrapMenuItem: TfpgMenuItem;
+ function GetFormParent: TfpgWidget;
+ procedure SetFormParent(const AValue: TfpgWidget);
+ function CreateForm: TfpgForm;
+ procedure FormClearMenuItemClick(Sender: TObject);
+ procedure FormWordWrapMenuItemClick(Sender: TObject);
+ procedure FormLogMenuItemClick(Sender: TObject);
+ procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+ procedure FormLogLevelMenuItemClick(Sender: TObject);
+ procedure FormLogLevelButtonClick(Sender: TObject);
+ procedure DoViewLogFile(Sender: TObject);
+ procedure DoOnPopup(Sender: TObject);
+ procedure WriteToMemo(const AMessage: string);
+ protected
+ procedure WriteToOutput; override;
+ procedure SetSevToLog(const AValue: TtiSevToLog); override;
+ public
+ constructor Create; override;
+ destructor Destroy; override;
+ property FormParent: TfpgWidget read GetFormParent; // write SetFormParent;
+ procedure Log(const ADateTime, AThreadID, AMessage: string; ASeverity: TtiLogSeverity); override;
+ end;
+
+
+implementation
+uses
+ gfxbase,
+ tiUtils,
+ tiGUIUtils,
+ tiCommandLineParams,
+ tiGUIConstants,
+ tiDialogs;
+
+
+{ TtiLogToGUI }
+
+constructor TtiLogToGUI.Create;
+begin
+ // GUI output must be synchronized with the main thread.
+ inherited CreateSynchronized;
+ FForm := CreateForm;
+ ThrdLog.Resume;
+end;
+
+destructor TtiLogToGUI.Destroy;
+begin
+// writeln('>> TtiLogToGUI.Destroy');
+ FForm := nil;
+ inherited Destroy;
+// writeln('<< TtiLogToGUI.Destroy');
+end;
+
+function TtiLogToGUI.CreateForm: TfpgForm;
+var
+ lMenuItem: TfpgMenuItem;
+ lLogSev: TtiLogSeverity;
+ lToolButton: TfpgButton;
+ x: integer;
+begin
+ FForm := TfpgForm.Create(fpgApplication);
+ FForm.WindowPosition := wpUser;
+ FForm.Top := 10;
+ FForm.Left := 10;
+ FForm.Height := 150;
+ FForm.Width := fpgApplication.ScreenWidth - 20;
+ FForm.WindowTitle := 'Application event log - ' + ApplicationName;
+ FForm.OnCloseQuery := @FormCloseQuery;
+
+ FPopupMenu := TfpgPopupMenu.Create(FForm);
+ FPopupMenu.Name := 'PopupMenu';
+ FPopupMenu.BeforeShow := @DoOnPopup;
+
+ FToolBar := TfpgPanel.Create(FForm);
+ FToolBar.Name := 'ToolBar';
+ FToolBar.SetPosition(0, 0, FForm.Width, 29);
+ FToolBar.Text := '';
+ FToolBar.Align := alTop;
+ FToolBar.TabOrder := 1;
+
+ FMemoLog := TfpgMemo.Create(FForm);
+ FMemoLog.Name := 'MemoLog';
+ FMemoLog.Top := 29;
+ FMemoLog.Align := alClient;
+ FMemoLog.FontDesc := '#Edit2'; // monospaced font
+ FMemoLog.PopupMenu := FPopupMenu;
+// FMemoLog.ReadOnly := True;
+// FMemoLog.ScrollBars := ssBoth;
+ FMemoLog.TabOrder := 0;
+// FMemoLog.WordWrap := False;
+ FMemoLog.Lines.Clear;
+
+ FViewLogMenuItem := FPopupMenu.AddMenuItem('View log file', '', @DoViewLogFile);
+ FViewLogMenuItem.Name := 'Viewlogfile1';
+
+ lMenuItem := FPopupMenu.AddMenuItem('-', '', nil);
+ lMenuItem.Name := 'N1';
+
+ lMenuItem := FPopupMenu.AddMenuItem('Clear', '', @FormClearMenuItemClick);
+ lMenuItem.Name := 'ClearMenuItem';
+
+ FWordWrapMenuItem := FPopupMenu.AddMenuItem('Word wrap', '', @FormWordWrapMenuItemClick);
+ FWordWrapMenuItem.Name := 'WordWrapMenuItem';
+ FWordWrapMenuItem.Enabled := False;
+
+ FLogMenuItem := FPopupMenu.AddMenuItem('Log', '', @FormLogMenuItemClick);
+ FLogMenuItem.Name := 'LogMenuItem';
+
+ FSeveritySubMenu := TfpgPopupMenu.Create(FForm);
+ FSeveritySubMenu.Name := 'SeveritySubMenu';
+ for lLogSev := Low(TtiLogSeverity) to High(TtiLogSeverity) do
+ begin
+ lMenuItem := FSeveritySubMenu.AddMenuItem(cTILogSeverityStrings[lLogSev], '', @FormLogLevelMenuItemClick);
+ lMenuItem.Tag := Ord(lLogSev);
+ end;
+ FLogMenuItem.SubMenu := FSeveritySubMenu;
+
+ x := 0;
+ for lLogSev := Low(TtiLogSeverity) to High(TtiLogSeverity) do
+ begin
+ lToolButton := TfpgButton.Create(FToolBar);
+ lToolButton.SetPosition(x, 0, 50, 30);
+ lToolButton.Text := cTILogSeverityStrings[lLogSev];
+ lToolButton.Tag := Ord(lLogSev);
+ lToolButton.AllowDown := True;
+ lToolButton.AllowAllUp := True;
+ lToolButton.Down := lLogSev in GLog.SevToLog;
+ lToolButton.OnClick := @FormLogLevelButtonClick;
+ lToolButton.Focusable := False;
+ Inc(x, 50);
+ end;
+
+ Result := FForm;
+end;
+
+function TtiLogToGUI.GetFormParent: TfpgWidget;
+begin
+ result := FForm.Parent;
+end;
+
+procedure TtiLogToGUI.Log(const ADateTime, AThreadID, AMessage: string; ASeverity: TtiLogSeverity);
+begin
+ if Terminated then
+ Exit; //==>
+ if not FForm.HasHandle then
+ FForm.Show;
+ inherited Log(ADateTime, AThreadID, AMessage, ASeverity);
+end;
+
+procedure TtiLogToGUI.SetFormParent(const AValue: TfpgWidget);
+begin
+ {$Note This is untested!!! }
+ FForm.Parent := AValue;
+ FForm.Align := alClient;
+ FForm.WindowAttributes := FForm.WindowAttributes + [waBorderless];
+// FForm.BorderStyle := bsNone;
+end;
+
+procedure TtiLogToGUI.SetSevToLog(const AValue: TtiSevToLog);
+var
+ i: integer;
+ lLogSev: TtiLogSeverity;
+begin
+ // Let parent perform important task(s)
+ inherited;
+ // All we do here is reflect any changes to LogSeverity in the visual controls
+ for i := 0 to FToolBar.ComponentCount - 1 do
+ begin
+ lLogSev := TtiLogSeverity(FToolBar.Components[i].Tag);
+ if FToolBar.Components[i] is TfpgButton then
+ TfpgButton(FToolBar.Components[i]).Down := lLogSev in AValue;
+ end;
+end;
+
+procedure TtiLogToGUI.WriteToMemo(const AMessage: string);
+var
+ i: integer;
+ LLine: string;
+ LCount: integer;
+begin
+ LCount := tiNumToken(AMessage, CrLf);
+ if LCount = 1 then
+ FMemoLog.Lines.Add(tiTrimTrailingWhiteSpace(AMessage))
+ else
+ for i := 1 to LCount do
+ begin
+ LLine := tiTrimTrailingWhiteSpace(tiToken(AMessage, CrLf, i));
+ FMemoLog.Lines.Add(LLine);
+ end;
+end;
+
+procedure TtiLogToGUI.WriteToOutput;
+var
+ i: integer;
+ LLogEvent: TtiLogEvent;
+ LPosStart: integer;
+ LPosEnd: integer;
+const
+ ciMaxLineCount = 200;
+begin
+ if ThrdLog.Terminated then
+ Exit; //==>
+
+ inherited WriteToOutput;
+
+ if ListWorking.Count > ciMaxLineCount * 2 then
+ begin
+ FMemoLog.Lines.Clear;
+ LPosStart := ListWorking.Count - 1 - ciMaxLineCount;
+ LPosEnd := ListWorking.Count - 1;
+ end else
+ begin
+ if FMemoLog.Lines.Count > ciMaxLineCount then
+ begin
+ for i := 0 to ciMaxLineCount div 2 do
+ FMemoLog.Lines.Delete(0);
+ //{$IFDEF MSWINDOWS}
+ //SendMessage(FMemoLog.handle, WM_VSCROLL, SB_Bottom, 0);
+ //{$ENDIF MSWINDOWS}
+ end;
+ LPosStart := 0;
+ LPosEnd := ListWorking.Count - 1;
+ end;
+
+ for i := LPosStart to LPosEnd do begin
+ if ThrdLog.Terminated then
+ Break; //==>
+ LLogEvent := TtiLogEvent(ListWorking.Items[i]);
+ WriteToMemo(LLogEvent.AsLeftPaddedString);
+ end;
+
+ ListWorking.Clear;
+end;
+
+procedure TtiLogToGUI.FormClearMenuItemClick(Sender: TObject);
+begin
+ FMemoLog.Lines.Clear;
+end;
+
+procedure TtiLogToGUI.FormWordWrapMenuItemClick(Sender: TObject);
+begin
+ //FMemoLog.WordWrap := not FMemoLog.WordWrap;
+ //FWordWrapMenuItem.Checked := FMemoLog.WordWrap;
+ //if FMemoLog.WordWrap then
+ //FMemoLog.ScrollBars := ssVertical
+ //else
+ //FMemoLog.ScrollBars := ssBoth;
+end;
+
+procedure TtiLogToGUI.FormLogMenuItemClick(Sender: TObject);
+var
+ i: integer;
+begin
+ //for i := 0 to FLogMenuItem.Count - 1 do
+ //FLogMenuItem.Items[i].Checked := TtiLogSeverity(FLogMenuItem.Items[i].Tag) in GLog.SevToLog;
+end;
+
+procedure TtiLogToGUI.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+begin
+// CanClose := False;
+ //FForm.WindowState := wsMinimized;
+end;
+
+procedure TtiLogToGUI.FormLogLevelMenuItemClick(Sender: TObject);
+var
+ lLogSev: TtiLogSeverity;
+ lLogChecked: boolean;
+ i: integer;
+ lFound: boolean;
+begin
+ if not (Sender is TfpgMenuItem) then
+ Exit; //==>
+
+ lLogSev := TtiLogSeverity(TfpgWidget(Sender).Tag);
+ //TfpgMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;
+ //lLogChecked := TMenuItem(Sender).Checked;
+
+ lFound := False;
+ i := FToolBar.ComponentCount-1;
+ while (i > 0) and not lFound do
+ begin
+ if FToolBar.Components[i] is TfpgButton then
+ begin
+ lFound := TfpgButton(FToolBar.Components[i]).Tag = TfpgWidget(Sender).Tag;
+ if lFound then
+ begin
+ TfpgButton(FToolbar.Components[i]).Down := not TfpgButton(FToolbar.Components[i]).Down;
+ lLogChecked := TfpgButton(FToolbar.Components[i]).Down;
+ end;
+ end;
+// FToolBar.Buttons[TMenuItem(Sender).Tag].Down := lLogChecked;
+ end;
+
+ if lLogChecked then
+ GLog.SevToLog := GLog.SevToLog + [lLogSev]
+ else
+ GLog.SevToLog := GLog.SevToLog - [lLogSev];
+end;
+
+procedure TtiLogToGUI.FormLogLevelButtonClick(Sender: TObject);
+var
+ lLogSev: TtiLogSeverity;
+ lLogChecked: boolean;
+begin
+ if not (Sender is TfpgButton) then
+ Exit; //==>
+
+ lLogSev := TtiLogSeverity(TfpgWidget(Sender).Tag);
+ lLogChecked := TfpgButton(Sender).Down;
+ if lLogChecked then
+ GLog.SevToLog := GLog.SevToLog + [lLogSev]
+ else
+ GLog.SevToLog := GLog.SevToLog - [lLogSev];
+end;
+
+procedure TtiLogToGUI.DoViewLogFile(Sender: TObject);
+var
+ sl: TStringList;
+begin
+ if (GLog.LogToFileName <> '') and
+ (FileExists(GLog.LogToFileName)) then
+ begin
+ sl := TStringList.Create;
+ try
+ sl.LoadFromFile(GLog.LogToFilename);
+ tiShowStringList(sl, GLog.LogToFilename);
+// tiEditFile(GLog.LogToFileName);
+ finally
+ sl.Free;
+ end;
+ end;
+end;
+
+procedure TtiLogToGUI.DoOnPopup(Sender: TObject);
+begin
+ FViewLogMenuItem.Visible:=
+ (GLog.LogToFileName <> '') and
+ (FileExists(GLog.LogToFileName));
+end;
+
+
+//initialization
+ //if gCommandLineParams.IsParam(csLogVisual) then
+ //GLog.RegisterLog(TtiLogToGUI);
+
+end.
+
diff --git a/extras/tiopf/gui/tiRtfReport.pas b/extras/tiopf/gui/tiRtfReport.pas
index dfceb5f8..af0d15bf 100644
--- a/extras/tiopf/gui/tiRtfReport.pas
+++ b/extras/tiopf/gui/tiRtfReport.pas
@@ -1,18 +1,17 @@
{
Revision history:
-
- 05-07-2005: First release by Marius Ellen (mariusellen@home.nl)
+ 2005-07-05: First release by Marius Ellen (mariusellen@home.nl)
2007-04-18: Ported to Free Pascal and fpGUI by Graeme Geldenhuys (graemeg@gmail.com)
Purpose:
- Create reports with Rtf documents with access to dataset and framework objects.
+ Create reports with RTF documents with access to dataset and framework objects.
ToDo:
Better exception handling. (saw some unexpected errors while parsing)
corrupting the resulting rtf.
- Show errors when trying to past eof in a tiPerObjList (its now ignored)
- Suppress null dates (0 date are displayed as xx-xx-1899)
+ Show errors when trying to past eof in a TtiObjectList (its now ignored)
+ Suppress null dates (0 date are displayed as 1899-xx-xx)
And if anybody got ideas for this section, please email them!
}