diff options
| -rw-r--r-- | extras/tiopf/gui/tiLogToGUI.pas | 372 | ||||
| -rw-r--r-- | extras/tiopf/gui/tiRtfReport.pas | 9 |
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! } |