{ --------------------------------------------------------------------------- }
{ AnyDAC Speed Tester - main form                                             }
{ Copyright (c) 2004 by Dmitry Arefiev (www.da-soft.com)                      }
{                                                                             }
{ All rights reserved.                                                        }
{ --------------------------------------------------------------------------- }
{$I ADSpeed.inc}

unit fADSpeedUI;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ExtCtrls, Grids, StdCtrls, Db, ActnList, ImgList, Menus, ToolWin,
  ADSpeedBase;

type
  {---------------------------------------------------------------------------}
  { TADSpeedUIFrm                                                             }
  {---------------------------------------------------------------------------}
  TADSpeedUIFrm = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    SaveDialog1: TSaveDialog;
    ActionList1: TActionList;
    actConnect: TAction;
    actTestRunSingle: TAction;
    actTestRunDS: TAction;
    actTestRunTest: TAction;
    actTestRunAll: TAction;
    actLogExport: TAction;
    Panel4: TPanel;
    MainMenu1: TMainMenu;
    est1: TMenuItem;
    Log1: TMenuItem;
    Connection1: TMenuItem;
    Help1: TMenuItem;
    Images: TImageList;
    RunSingle1: TMenuItem;
    RunDS1: TMenuItem;
    RunTest1: TMenuItem;
    RunAll1: TMenuItem;
    N1: TMenuItem;
    Export1: TMenuItem;
    Connect1: TMenuItem;
    actTestExit: TAction;
    actTestExit1: TMenuItem;
    actDisconnect: TAction;
    Disconnect1: TMenuItem;
    N2: TMenuItem;
    actLogShowErrors: TAction;
    ShowErrors1: TMenuItem;
    stbDown: TStatusBar;
    actHelpAbout: TAction;
    About1: TMenuItem;
    pnlTopFrame: TPanel;
    pnlToolbar: TPanel;
    ToolBar: TToolBar;
    ToolButton11: TToolButton;
    btnTestRun: TToolButton;
    btnTestStop: TToolButton;
    ToolButton9: TToolButton;
    Panel1: TPanel;
    Label1: TLabel;
    Panel5: TPanel;
    lvDSs: TListView;
    Splitter1: TSplitter;
    Panel6: TPanel;
    lvTests: TListView;
    Panel7: TPanel;
    Label2: TLabel;
    Panel8: TPanel;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    Panel3: TPanel;
    ToolButton6: TToolButton;
    TabSheet2: TTabSheet;
    Panel2: TPanel;
    grdResults: TStringGrid;
    Panel9: TPanel;
    ToolButton7: TToolButton;
    actTestStop: TAction;
    Stop1: TMenuItem;
    ProgressBar1: TProgressBar;
    Bevel1: TBevel;
    actEditDefinition: TAction;
    N3: TMenuItem;
    EditDefinitions1: TMenuItem;
    actGenData: TAction;
    GenerateData1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnRunAllClick(Sender: TObject);
    procedure grdResultsSetEditText(Sender: TObject; ACol, ARow: Integer;
      const AValue: String);
    procedure actLogExportExecute(Sender: TObject);
    procedure btnRunDSClick(Sender: TObject);
    procedure btnRunTestClick(Sender: TObject);
    procedure actConnectExecute(Sender: TObject);
    procedure btnRunSingleClick(Sender: TObject);
    procedure actTestRunSingleUpdate(Sender: TObject);
    procedure actOtherUpdate(Sender: TObject);
    procedure actTestRunDSUpdate(Sender: TObject);
    procedure actTestRunTestUpdate(Sender: TObject);
    procedure actTestExitExecute(Sender: TObject);
    procedure actDisconnectExecute(Sender: TObject);
    procedure actLogShowErrorsUpdate(Sender: TObject);
    procedure actLogShowErrorsExecute(Sender: TObject);
    procedure actHelpAboutExecute(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure actTestStopUpdate(Sender: TObject);
    procedure actTestStopExecute(Sender: TObject);
    procedure actTestRunAllUpdate(Sender: TObject);
    procedure actEditDefinitionExecute(Sender: TObject);
    procedure actGenDataExecute(Sender: TObject);
  private
    { Private declarations }
    FMgr: TADSpeedTestManager;
    FShowErrors: Boolean;
    procedure LoadRegInfo;
    procedure LoadTestsInfo;
    procedure LoadTestsResults(ADSInd, ATestInd: Integer);
    procedure ClearTestsResults(ADSInd, ATestInd: Integer);
    procedure ExportTestResults(const AFileName: String);
    procedure DoTestEnd(AManager: TADSpeedTestManager);
    procedure DoTestProgress(AManager: TADSpeedTestManager;
      ATest: TADSpeedCustomTest; APctDone: Integer);
    procedure DoTestError(AManager: TADSpeedTestManager; E: Exception);
    procedure DoTestStart(AManager: TADSpeedTestManager);
  public
    { Public declarations }
  end;

var
  ADSpeedUIFrm: TADSpeedUIFrm;

implementation

{$R *.DFM}

uses
  ShellAPI,
  daADStanUtil, daADStanConst, daADStanIntf, daADStanFactory, daADGUIxFormsfAbout,
  fADSpeedGenData, ADSpeedReg;

{---------------------------------------------------------------------------}
{ TADSpeedUIFrm                                                             }
{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.FormCreate(Sender: TObject);
var
  sModule, sProduct, sVersion, sVersionName, sCopyright, sInfo: String;
{$IFNDEF AnyDAC_D6}
  ModName: array[0..MAX_PATH] of Char;
{$ENDIF}
begin
{$IFDEF AnyDAC_D6}
  sModule := GetModuleName(HInstance);
{$ELSE}
  SetString(sModule, ModName, GetModuleFileName(HInstance, ModName, SizeOf(ModName)));
{$ENDIF}
  ADGetVersionInfo(sModule, sProduct, sVersion, sVersionName, sCopyright, sInfo);
  stbDown.Panels[0].Text := '';
  stbDown.Panels[1].Text := 'Version: ' + sVersion;
  stbDown.Panels[2].Text := sCopyright;
  FMgr := ADSpeedRegister;
  FMgr.OnStart := DoTestStart;
  FMgr.OnProgress := DoTestProgress;
  FMgr.OnError := DoTestError;
  FMgr.OnEnd := DoTestEnd;
{$IFDEF AnyDACSPEED_ORA}
  FMgr.ConnDefName := 'Oracle_Demo';
{$ENDIF}
{$IFDEF AnyDACSPEED_MSSQL}
  FMgr.ConnDefName := 'MSSQL_Demo';
{$ENDIF}
  FMgr.AllocTests;
  LoadRegInfo;
  LoadTestsInfo;
  if ADGetCmdParam('N', '') = '1' then
    actConnectExecute(nil);
  grdResults.Col := StrToInt(ADGetCmdParam('C', '2')) - 1;
  grdResults.Row := StrToInt(ADGetCmdParam('R', '2')) - 1;
  if ADGetCmdParam('S', '') = '1' then
    btnRunSingleClick(nil)
  else if ADGetCmdParam('D', '') = '1' then
    btnRunDSClick(nil)
  else if ADGetCmdParam('T', '') = '1' then
    btnRunTestClick(nil)
  else if ADGetCmdParam('A', '') = '1' then
    btnRunAllClick(nil);
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.FormDestroy(Sender: TObject);
begin
  ADSpeedUnRegister;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.FormResize(Sender: TObject);
begin
  with stbDown do
    Panels[0].Width := Width - (Panels[1].Width + Panels[2].Width);
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.DoTestStart(AManager: TADSpeedTestManager);
begin
  if Visible then begin
    ProgressBar1.Position := 0;
    stbDown.Panels[0].Text := 'Starting ...';
    Application.ProcessMessages;
    Application.HandleMessage;
  end;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.DoTestProgress(AManager: TADSpeedTestManager;
  ATest: TADSpeedCustomTest; APctDone: Integer);
var
  s: String;
begin
  if Visible then begin
    ProgressBar1.Position := APctDone;
    s := 'Done %' + IntToStr(APctDone);
    if (ATest is TADSpeedCustomDBTest) and
       (TADSpeedCustomDBTest(ATest).TestingDataSet <> nil) then
      s := s + '; ' + TADSpeedCustomDBTest(ATest).TestingDataSet.GetName;
    if ATest <> nil then
      s := s + '; ' + ATest.GetName;
      stbDown.Panels[0].Text := s;
    Application.ProcessMessages;
  end;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.DoTestError(AManager: TADSpeedTestManager; E: Exception);
begin
  if FShowErrors then
{$IFDEF VER140}
    if Assigned(ApplicationHandleException) then
      ApplicationHandleException(Self);
{$ELSE}
    Application.HandleException(nil);
{$ENDIF}
  stbDown.Panels[0].Text := 'Error !';
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.DoTestEnd(AManager: TADSpeedTestManager);
begin
  if Visible then begin
    ProgressBar1.Position := 100;
    stbDown.Panels[0].Text := 'Finishing ...';
    Sleep(500);
    ProgressBar1.Position := 0;
    stbDown.Panels[0].Text := '';
    Application.ProcessMessages;
  end;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.LoadRegInfo;
var
  i: Integer;
begin
  with lvTests do
    for i := 0 to FMgr.TestCount - 1 do
      with Items.Add do begin
        Caption := FMgr.TestClass[i].GetName;
        SubItems.Add(FMgr.TestClass[i].GetDescription);
      end;
  with lvDSs do
    for i := 0 to FMgr.DSCount - 1 do
      with Items.Add do begin
        Caption := FMgr.DSClass[i].GetName;
        SubItems.Add(FMgr.DSClass[i].GetDescription);
      end;
  Application.ProcessMessages;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.LoadTestsInfo;
var
  i: Integer;
begin
  with grdResults do begin
    RowCount := FMgr.TestCount + 1;
    ColCount := FMgr.DSCount + 2;
    Cells[1, 0] := 'Times';
    for i := 0 to FMgr.TestCount - 1 do begin
      Cells[0, i + 1] := FMgr.TestClass[i].GetName;
      Cells[1, i + 1] := IntToStr(FMgr.TestTimes[i]);
    end;
    for i := 0 to FMgr.DSCount - 1 do
      Cells[i + 2, 0] := FMgr.DSClass[i].GetName;
  end;
  Application.ProcessMessages;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.ClearTestsResults(ADSInd, ATestInd: Integer);
var
  i, j, i1, i2, j1, j2: Integer;
begin
  if ATestInd = -1 then begin
    i1 := 0;
    i2 := FMgr.TestCount - 1;
  end
  else begin
    i1 := ATestInd;
    i2 := ATestInd;
  end;
  if ADSInd = -1 then begin
    j1 := 0;
    j2 := FMgr.DSCount - 1;
  end
  else begin
    j1 := ADSInd;
    j2 := ADSInd;
  end;
  with grdResults do begin
    for i := i1 to i2 do
      for j := j1 to j2 do
        Cells[j + 2, i + 1] := '';
  end;
  Application.ProcessMessages;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.LoadTestsResults(ADSInd, ATestInd: Integer);
var
  i, j, i1, i2, j1, j2: Integer;
  s: String;
begin
  if ATestInd = -1 then begin
    i1 := 0;
    i2 := FMgr.TestCount - 1;
  end
  else begin
    i1 := ATestInd;
    i2 := ATestInd;
  end;
  if ADSInd = -1 then begin
    j1 := 0;
    j2 := FMgr.DSCount - 1;
  end
  else begin
    j1 := ADSInd;
    j2 := ADSInd;
  end;
  with grdResults do
    for i := i1 to i2 do
      for j := j1 to j2 do begin
        if FMgr.Tests[j, i] = nil then
          s := '---'
        else
          s := FMgr.Tests[j, i].TimeStr;
        Cells[j + 2, i + 1] := s;
      end;
  Application.ProcessMessages;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.ExportTestResults(const AFileName: String);
var
  oStr: TFileStream;
  i, j: Integer;
  s, sExt, sLine: String;

  procedure WriteStr(const AStr: String);
  begin
    if Length(AStr) > 0 then
      oStr.Write(AStr[1], Length(AStr));
    oStr.Write(C_AD_EOL[1], Length(C_AD_EOL));
  end;

  function Replace(const AStr: String; ASrc, ADest: String): String;
  var
    i: Integer;
  begin
    Result := AStr;
    while True do begin
      i := Pos(ASrc, Result);
      if i = 0 then
        Break;
      Delete(Result, i, Length(ASrc));
      Insert(ADest, Result, i);
    end;
  end;

begin
  oStr := TFileStream.Create(AFileName, fmCreate);
  try
    sExt := UpperCase(ExtractFileExt(AFileName));
    if sExt = '.CSV' then begin
      sLine := 'Tests, Times';
      for j := 0 to FMgr.DSCount - 1 do
        sLine := sLine + ',' + Replace(FMgr.DSClass[j].GetName, ',', ';');
      WriteStr(sLine);
      for i := 0 to FMgr.TestCount - 1 do begin
        sLine := FMgr.TestClass[i].GetName + ',' + IntToStr(FMgr.TestTimes[i]);
        for j := 0 to FMgr.DSCount - 1 do begin
          if FMgr.Tests[j, i] = nil then
            s := '---'
          else
            s := Replace(FMgr.Tests[j, i].TimeStr, ',', '.');
          sLine := sLine + ',' + s;
        end;
        WriteStr(sLine);
      end;
    end
    else if sExt = '.XML' then begin
      WriteStr('<?xml version="1.0" standalone="yes"?>');
      WriteStr('<tests>');
      for i := 0 to FMgr.TestCount - 1 do begin
        WriteStr('  <test Name="' + FMgr.TestClass[i].GetName + '" Times="' + IntToStr(FMgr.TestTimes[i]) + '">');
        for j := 0 to FMgr.DSCount - 1 do begin
          if FMgr.Tests[j, i] = nil then
            s := '---'
          else
            s := FMgr.Tests[j, i].TimeStr;
          WriteStr('    <dataset Name="' + FMgr.DSClass[j].GetName + '" Time="' + s + '"/>');
        end;
        WriteStr('  </test>');
      end;
      WriteStr('</tests>');
    end;
  finally
    oStr.Free;
  end;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.grdResultsSetEditText(Sender: TObject; ACol,
  ARow: Integer; const AValue: String);
begin
  if ACol = 1 then
    FMgr.TestTimes[ARow - 1] := StrToIntDef(AValue, 0);
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.actOtherUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := not FMgr.IsRunning;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.actConnectExecute(Sender: TObject);
begin
  FMgr.OpenConnections;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.actDisconnectExecute(Sender: TObject);
begin
  FMgr.CloseConnections;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.actEditDefinitionExecute(Sender: TObject);
begin
  ShellExecute(Handle, 'open', PChar(ADExpandStr('$(ADHOME)\DB\ADConnectionDefs.ini')),
    nil, nil, SW_SHOW);
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.actGenDataExecute(Sender: TObject);
begin
  TADSpeedGenDataFrm.Execute(FMgr.ConnDefName);
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.actTestRunSingleUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := (grdResults.Col >= 2) and (grdResults.Row >= 1) and
    not FMgr.IsRunning and (FMgr.ConnDef <> nil);
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.btnRunSingleClick(Sender: TObject);
var
  i, j: Integer;
begin
  i := grdResults.Col - 2;
  j := grdResults.Row - 1;
  ClearTestsResults(i, j);
  FMgr.Execute(FMgr.TestClass[j], FMgr.DSClass[i]);
  LoadTestsResults(i, j);
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.actTestRunAllUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := not FMgr.IsRunning and (FMgr.ConnDef <> nil);
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.btnRunAllClick(Sender: TObject);
begin
  ClearTestsResults(-1, -1);
  FMgr.Execute(nil, nil);
  LoadTestsResults(-1, -1);
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.actTestRunDSUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := (grdResults.Col >= 2) and not FMgr.IsRunning and
    (FMgr.ConnDef <> nil);
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.btnRunDSClick(Sender: TObject);
var
  i: Integer;
begin
  if PageControl1.ActivePageIndex = 0 then
    i := lvDSs.ItemIndex
  else
    i := grdResults.Col - 2;
  ClearTestsResults(i, -1);
  FMgr.Execute(nil, FMgr.DSClass[i]);
  LoadTestsResults(i, -1);
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.actTestRunTestUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := (grdResults.Row >= 1) and not FMgr.IsRunning and
    (FMgr.ConnDef <> nil);
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.btnRunTestClick(Sender: TObject);
var
  i: Integer;
begin
  if PageControl1.ActivePageIndex = 0 then
    i := lvTests.ItemIndex
  else
    i := grdResults.Row - 1;
  ClearTestsResults(-1, i);
  FMgr.Execute(FMgr.TestClass[i], nil);
  LoadTestsResults(-1, i);
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.actTestStopUpdate(Sender: TObject);
begin
  actTestStop.Enabled := FMgr.IsRunning;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.actTestStopExecute(Sender: TObject);
begin
  FMgr.Cancel;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.actTestExitExecute(Sender: TObject);
begin
  Close;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.actLogExportExecute(Sender: TObject);
begin
  if SaveDialog1.Execute then
    ExportTestResults(SaveDialog1.FileName);
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.actLogShowErrorsUpdate(Sender: TObject);
begin
  actLogShowErrors.Checked := FShowErrors;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.actLogShowErrorsExecute(Sender: TObject);
begin
  FShowErrors := not FShowErrors;
end;

{---------------------------------------------------------------------------}
procedure TADSpeedUIFrm.actHelpAboutExecute(Sender: TObject);
begin
  TfrmADGUIxFormsAbout.Execute;
end;

end.
