mainfrm.pas

jvcl driver development envionment

{******************************************************************

                       JEDI-VCL Demo

 Copyright (C) 2002 Project JEDI

 Original author:

 You may retrieve the latest version of this file at the JEDI-JVCL
 home page, located at http://jvcl.sourceforge.net

 The contents of this file are used with permission, 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/MPL-1_1Final.html

 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.

******************************************************************}

{$I jvcl.inc}

unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ImgList, StdActns, ActnList, Menus, ExtCtrls, ComCtrls, JvStatusBar,
  JvComCtrls, JvSurveyIntf, JvDialogs, StdCtrls, JvListView, HTTPApp,
  JvComponent, JvImageSquare {$IFDEF COMPILER6_UP}, HTTPProd, JvExComCtrls{$ENDIF};

type
  TfrmMain = class(TForm)
    Panel1: TPanel;
    Splitter1: TSplitter;
    sbStatus: TJvStatusBar;
    tvItems: TJvTreeView;
    mmMain: TMainMenu;
    File1: TMenuItem;
    Help1: TMenuItem;
    alMain: TActionList;
    acOpen: TAction;
    acSaveReport: TAction;
    acExit: TAction;
    acAddResponse: TAction;
    acOpen1: TMenuItem;
    acSaveAs1: TMenuItem;
    N1: TMenuItem;
    acExit1: TMenuItem;
    acAbout: TAction;
    acHelp: TAction;
    il16: TImageList;
    About1: TMenuItem;
    N4: TMenuItem;
    Help2: TMenuItem;
    Add2: TMenuItem;
    acPrintPreview: TAction;
    N5: TMenuItem;
    Print1: TMenuItem;
    N6: TMenuItem;
    OpenSurveyDialog: TJvOpenDialog;
    PrinterSetupDialog: TPrinterSetupDialog;
    PrintDialog: TPrintDialog;
    SaveReportDialog: TJvSaveDialog;
    acLoadReport: TAction;
    LoadReport1: TMenuItem;
    N7: TMenuItem;
    ppPrintPreview: TPageProducer;
    Panel2: TPanel;
    nbDetails: TNotebook;
    lvGlobalStats: TListView;
    lvItemStats: TJvListView;
    reFreeForm: TRichEdit;
    il24: TImageList;
    View1: TMenuItem;
    acComments: TAction;
    Comments1: TMenuItem;
    acDupeWarning: TAction;
    acDupeWarning1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure acOpenExecute(Sender: TObject);
    procedure acExitExecute(Sender: TObject);
    procedure tvItemsCollapsing(Sender: TObject; Node: TTreeNode;
      var AllowCollapse: Boolean);
    procedure tvItemsChange(Sender: TObject; Node: TTreeNode);
    procedure acAddResponseExecute(Sender: TObject);
    procedure acPrinterSettingsExecute(Sender: TObject);
    procedure acPrintPreviewExecute(Sender: TObject);
    procedure acAboutExecute(Sender: TObject);
    procedure acSaveReportExecute(Sender: TObject);
    procedure acLoadReportExecute(Sender: TObject);
    procedure ppPrintPreviewHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: string; TagParams: TStrings;
      var ReplaceText: string);
    procedure alMainUpdate(Action: TBasicAction; var Handled: Boolean);
    procedure acCommentsExecute(Sender: TObject);
    procedure acDupeWarningExecute(Sender: TObject);
  private
    FFilename: string;
    FResponses: TStringlist;
    FCurrentItem: IJvSurveyItem;
    FSurvey: IJvSurvey;
    procedure LoadView;
    procedure LoadData(Node: TTreeNode);
    function GetResponseValue(item: IJvSurveyItem; Index: integer): integer;
    function AddItem(Parent: TTreeNode; item: IJvSurveyItem): TTreeNode;
    procedure AddResponses(item: IJvSurveyItem; Index: integer; const SurveyTaker: IJvSurveyTaker);
    procedure LoadFromFile(const Filename: string; ClearResponses: boolean);
    procedure LoadFromResponse(const Filename: string);
    procedure SaveReport(const Filename: string; Format: TJvSurveyFileFormat);
    property Filename: string read FFilename write FFilename;
    function GetReportHTMLContent: string;
    function GetReportHTMLSummary: string;
    procedure UpdateStatusBar;
  public
  end;

var
  frmMain: TfrmMain;
resourcestring
  SOpenSurveyTitle = 'Open Survey...';
  SAddUserResponseTitle = 'Add User Response File(s)';

implementation

uses
  JvSurveyUtils, JclStrings, Math, JvSimpleXML, JvJCLUtils, CommentsFrm;

{$R *.dfm}

resourcestring
  SFmtInvalidResponseFile =
    'The file "%s" is not compatible with the currently loaded survey: please select another response file.';
  SFmtResponseAlreadyLoaded = 'Responses from the file "%s" or user "%s" has already been added to the report.';
  SFmtUnmatchedSurveyType = 'SurveyTypes does not match (index %d)';
  SFmtResponse = '%0:s\nResponse from %1:s:\n%0:s\n\n%2:s\n\n';
  SFmtComment = '%0:s\nComments from %1:s:\n%0:s\n\n%2:s\n\n';
  SFmtTemplateNotFound = 'Unable to find print template (%s)';
  SAboutText = 'JEDI Surveyor Reporter, version 1.0';
  SAboutTitle = 'About Reporter...';

  SFmtHTMLTableSurveySummary =
    '<table class="TableSurveySummary">' +
    '<tr class="TRSurveySummary"><th class="THSurveySummary">Title</th><th class="THSurveySummary">ReleaseDate</th>' +
    '<th class="THSurveySummary">ExpiryDate</th><th class="THSurveySummary">Responses</th><th class="THSurveySummary">Questions</th></tr>' +
    '<tr class="TRSurveySummary"><td class="TDSurveySummary">%s</td><td class="TDSurveySummary">%s&nbsp;</td>' +
    '<td class="TDSurveySummary">%s</td><td class="TDSurveySummary">%d</td><td class="TDSurveySummary">%d</td></tr></table>';
  SHTMLNoItemsToDisplay =
    '<h4>There are no items in this survey: nothing to display</h4>';
  SFmtHTMLTableSurveyItemHeader =
    '<h4>Item #%d</h4><table class="TableSurveyItemHeader"><tr class="TRSurveyItemHeader">' +
    '<th class="THSurveyItemHeader">Title</th>' +
    '<th class="THSurveyItemHeader">Description</th>' +
    '<th class="THSurveyItemHeader">Type</th></tr>' +
    '<tr class="TRSurveyItemHeader">' +
    '<td class="TDSurveyItemHeader">%s&nbsp;</td>' +
    '<td class="TDSurveyItemHeader">%s&nbsp;</td>' +
    '<td class="TDSurveyItemHeader">%s&nbsp;</td></tr><tr><td colspan="3">';
  SFmtHTMLTableSurveyItemDetail =
    '<table class="TableSurveyItemDetail">' +
    '<tr class="TRSurveyItemDetail"><th  class="THSurveyItemDetail">Responses</th></tr>' +
    '<tr class="TRSurveyItemDetail"><td class="TDSurveyItemDetail">%s&nbsp;</td></tr></table>';
  SFmtHTMLTableSurveyItemFooter = '</td></tr></table>';
  STableSurveyItemDetail =
    '<table class="TableSurveyItemDetail"><tr class="TRSurveyItemDetail">' +
    '<th class="THSurveyItemDetail">Choices</th><th class="THSurveyItemDetail">Responses</th></tr>';
  SFmtHTMLTRSurveyItemDetail = '<tr  class="TRSurveyItemDetail"><td  class="TDSurveyItemDetail">%s&nbsp;</td>' +
    '<td  class="TDSurveyItemDetail">%s&nbsp;</td></tr>';
  SHTMLSpacer = '&nbsp;';
  SHTMLTableEnd = '</table>';
  STableCommentHeader = '<table class="TableSurveyItemDetail"><tr colspan="3" class="TRSurveyItemDetail"><th class="THSurveyItemDetail">Comments</th></tr>';
  SFmtTableCommentDetail = '<tr colspan="3" class="TRSurveyItemDetail"><td class="TDSurveyItemDetail">%s</td></tr>';

const
  cSurveyItemImageIndex = 22;
  cDelimChar = '=';
  cDelimLength = 60;
  cReportFileExt = '.jsr';
  cPrintReportExt = '.htm';
  cPrintTemplate = 'Data\SurveyTemplate.htt';

function MakeString(Ch: char; Count: integer): string;
begin
  SetLength(Result, Count);
  if Count > 0 then
    FillChar(Result[1], Count, Ch);
end;

procedure TfrmMain.LoadFromFile(const Filename: string; ClearResponses: boolean);
var
  i: integer;
begin
  FSurvey.LoadFromFile(Filename);
  self.Filename := Filename;
  // clear any responses added to survey (but no to report)
  if ClearResponses then
  begin
    FResponses.Clear;
    for i := 0 to FSurvey.Items.Count - 1 do
      FSurvey.Items[i].Responses := '';
  end
  else
    // load any previous survey takers already added to the report
    FResponses.CommaText := FSurvey.SurveyTaker.ID;
  LoadView;
  SaveReportDialog.Filename := ChangeFileExt(Filename, cReportFileExt);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FSurvey := CreateSurvey;
  FResponses := TStringlist.Create;
  FResponses.Sorted := acDupeWarning.Checked;
  nbDetails.PageIndex := 0;
end;

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  FResponses.Free;
  FSurvey := nil;
end;

procedure TfrmMain.LoadView;
var
  N: TTreeNode;
  i: integer;
begin
  N := tvItems.Items.GetFirstNode;
  if N <> nil then
    N.DeleteChildren;
  N.Data := Pointer(FSurvey);
  for i := 0 to FSurvey.Items.Count - 1 do
    AddItem(N, FSurvey.Items[i]);
  LoadData(N);
  tvItems.FullExpand;
end;

function TfrmMain.AddItem(Parent: TTreeNode;
  item: IJvSurveyItem): TTreeNode;
begin
  Result := tvItems.Items.AddChildObject(Parent,
    item.Title, Pointer(item));
  Result.ImageIndex := cSurveyItemImageIndex;
  Result.SelectedIndex := Result.ImageIndex;
end;

procedure TfrmMain.acOpenExecute(Sender: TObject);
begin
  OpenSurveyDialog.Filter := SSurveyFileFilter;
  OpenSurveyDialog.Filename := Filename;
  OpenSurveyDialog.Title := SOpenSurveyTitle;
  if OpenSurveyDialog.Execute then
    LoadFromFile(OpenSurveyDialog.Filename, true);
end;

procedure TfrmMain.acExitExecute(Sender: TObject);
begin
  Close;
end;

function TfrmMain.GetResponseValue(item: IJvSurveyItem;
  Index: integer): integer;
var
  S: TStringlist;
begin
  Result := 0;
  if item.SurveyType = stFreeForm then Exit;
  S := TStringlist.Create;
  try
    S.Text := DecodeResponse(item.Responses, item.SurveyType);
    if (Index < 0) or (Index >= S.Count) then Exit;
    Result := StrToIntDef(S[Index], 0);
  finally
    S.Free;
  end;
end;

procedure TfrmMain.LoadData(Node: TTreeNode);
var
  li: TListItem;
  S: TStringlist;
  i: integer;
begin
  FCurrentItem := nil;
  if (Node = nil) or not FileExists(Filename) then Exit;
  if Node.Parent = nil then // root
  begin
    nbDetails.PageIndex := 0;
    lvGlobalStats.Items[0].SubItems[0] := FSurvey.Title;
    lvGlobalStats.Items[1].SubItems[0] := DateToStr(FSurvey.ReleaseDate);
    lvGlobalStats.Items[2].SubItems[0] := DateToStr(FSurvey.ExpiryDate);
    lvGlobalStats.Items[3].SubItems[0] := IntToStr(FResponses.Count);
    lvGlobalStats.Items[4].SubItems[0] := IntToStr(FSurvey.Items.Count);
  end
  else if Node.Data <> nil then // item
  begin
    FCurrentItem := IJvSurveyItem(Node.Data);
    lvItemStats.Items.Clear;
    if FCurrentItem.SurveyType <> stFreeForm then
    begin
      S := TStringlist.Create;
      try
        S.Text := DecodeChoice(FCurrentItem.Choices, FCurrentItem.SurveyType);
        for i := 0 to S.Count - 1 do
        begin