Census Code

{* ***** BEGIN LICENSE BLOCK *****                                            *}
{* Version: MPL 1.1                                                           *}
{*                                                                            *}
{* The contents of this file are subject to the Mozilla Public License        *}
{* Version 1.1 (the "License"); you may not use this file except in           *}
{* compliance with the License. You may obtain a copy of the License at       *}
{* http://www.mozilla.org/MPL/                                                *}
{*                                                                            *}
{* Software distributed under the License is distributed on an "AS IS" basis, *}
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License   *}
{* for the specific language governing rights and limitations under the       *}
{* License.                                                                   *}
{*                                                                            *}
{* The Original Code is Census                                                *}
{*                                                                            *}
{* The Initial Developer of the Original Code is Justin Wilkins               *}
{*                                                                            *}
{* Portions created by Justin Wilkins are Copyright (C)2001-2011              *}
{* Justin Wilkins. All Rights Reserved.                                       *}
{*                                                                            *}
{* Contributor(s):                                                            *}
{*                                                                            *}
{* ***** END LICENSE BLOCK *****                                              *}

unit dataparse;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, ExtCtrls, JvExGrids, JvStringGrid;

type
  TfrmDataSelect = class(TForm)
    memSample: TMemo;
    grdSample: TJvStringGrid;
    btnOK: TButton;
    rgSelect: TRadioGroup;
    procedure FormCreate(Sender: TObject);
    procedure TestFormat;
    function TabDataLoad(FileName: string): Boolean;
    function ContainsChar(strIn: string): Boolean;
    function NumConv(strNo: string): string;
    procedure rgSelectClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmDataSelect: TfrmDataSelect;

implementation

uses main;

{$R *.dfm}

procedure TfrmDataSelect.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
  frmDataSelect := nil;
end;

procedure TfrmDataSelect.FormCreate(Sender: TObject);
var
  intLines: Integer;
begin
  if FileExists(frmNMRun.tblRunsData.Value) then
    memSample.Lines.LoadFromFile(frmNMRun.tblRunsData.Value);
  intLines := memSample.Lines.Count;
  if ((Pos(' ', memSample.Lines[intLines - 2]) > 1) and
    (Pos(',', memSample.Lines[intLines - 2]) = 0)) then
    rgSelect.ItemIndex := 1
  else
    if ((Pos(' ', memSample.Lines[intLines - 2]) = 0) and
      (Pos(',', memSample.Lines[intLines - 2]) > 1)) then
      rgSelect.ItemIndex := 0
    else
      rgSelect.ItemIndex := -1;
  TestFormat;
end;

procedure TfrmDataSelect.TestFormat;
var
  n, m: Integer;
begin
  if rgSelect.ItemIndex = 0 then
  try
    grdSample.LoadFromCSV(frmNMRun.tblRunsData.Value, ',');
  except
    MessageDlg('An error occurred and the file could not ' +
      'be loaded.', mtError, [mbOK], 0);
    for n := 0 to grdSample.RowCount - 1 do
      for m := 0 to grdSample.ColCount - 1 do
        grdSample.Cells[m, n] := '';
  end;

  if rgSelect.ItemIndex = 1 then
  try
    TabDataLoad(frmNMRun.tblRunsData.Value);
  except
    MessageDlg('An error occurred and the file could not ' +
      'be loaded.', mtError, [mbOK], 0);
    for n := 0 to grdSample.RowCount - 1 do
      for m := 0 to grdSample.ColCount - 1 do
        grdSample.Cells[m, n] := '';
  end;
end;

function TfrmDataSelect.TabDataLoad(FileName: string): Boolean;
var
  n, m: Integer;
  lstFile: TStrings;
begin
  Result := True;
  if FileExists(FileName) then
  begin
    lstFile := TStringList.Create;
    lstFile.LoadFromFile(FileName);
    if grdSample.RowCount <> lstFile.Count then
      grdSample.RowCount := lstFile.Count;
    if Pos('#', lstFile[0]) = 1 then
      lstFile[0] := StringReplace(lstFile[0], '#', '', []);
    for n := 0 to lstFile.Count - 1 do
    begin
      frmNMRun.brkUpp.StringList.Clear;
      frmNMRun.brkUpp.BreakString := ' ';
      frmNMRun.brkUpp.BaseString := Trim(lstFile[n]);
      frmNMRun.brkUpp.BreakApart;
      if frmNMRun.grdData.ColCount <> frmNMRun.brkUpp.StringList.Count then
        grdSample.ColCount := frmNMRun.brkUpp.StringList.Count;
      try
        for m := 0 to frmNMRun.brkUpp.StringList.Count - 1 do
          if n = 0 then
            grdSample.Cells[m, n] := frmNMRun.brkUpp.StringList[m]
          else
            if (Pos(':', frmNMRun.brkUpp.StringList[m]) = 0) and
              (ContainsChar(frmNMRun.brkUpp.StringList[m]) = False) then
              grdSample.Cells[m, n] := NumConv(frmNMRun.brkUpp.StringList[m])
            else
              grdSample.Cells[m, n] := frmNMRun.brkUpp.StringList[m];
      except
        Result := False;
      end;
    end;
    lstFile.Free;
  end
  else
    MessageDlg('This file does not appear to exist. Has it been ' +
      'moved, or has a network drive been disconnected?', mtError, [mbOK], 0);
end;

procedure TfrmDataSelect.btnOKClick(Sender: TObject);
begin
  frmNMRun.grdData.Tag := rgSelect.ItemIndex;
  Close;
end;

function TfrmDataSelect.ContainsChar(strIn: string): Boolean;
var
  x: integer;
  b: Boolean;
begin
  b := False;
  for x := 1 to Length(strIn) do
    if not (StrIn[x] in ['E', 'e', '-', '+', '.', '0'..'9']) then
      b := True;
  result := b;
end;

function TfrmDataSelect.NumConv(strNo: string): string;
begin
  if Pos('NAN', strNo) = 0 then
  try
    Result := FloatToStr(StrToFloat(strNo), fs);
  except
    MessageDlg('There was a problem converting a '
      + 'number to decimal format (' + strNo + ').', mtError,
      [mbOK], 0);
    Result := '0';
  end
  else
    Result := '0';
end;

procedure TfrmDataSelect.rgSelectClick(Sender: TObject);
begin
  TestFormat;
end;

end.