mainfrm.pas

jvcl driver development envionment

          if S[i] = '' then Continue;
          li := lvItemStats.Items.Add;
          li.Caption := S[i];
          li.SubItems.Add(IntToStr(GetResponseValue(FCurrentItem, i)));
        end;
      finally
        S.Free;
      end;
      nbDetails.PageIndex := 1;
    end
    else
    begin
      nbDetails.PageIndex := 2;
      reFreeForm.Lines.Text := DecodeString(FCurrentItem.Responses);
    end;
  end;
  UpdateStatusBar;
end;

procedure TfrmMain.tvItemsCollapsing(Sender: TObject; Node: TTreeNode;
  var AllowCollapse: Boolean);
begin
  AllowCollapse := false;
end;

procedure TfrmMain.tvItemsChange(Sender: TObject; Node: TTreeNode);
begin
  LoadData(Node);
end;

procedure TfrmMain.acAddResponseExecute(Sender: TObject);
var
  i: integer;
begin
  OpenSurveyDialog.Filter := SResponseFileFilter;
//  OpenSurveyDialog.Filename := Filename;
  OpenSurveyDialog.Title := SAddUserResponseTitle;
  OpenSurveyDialog.Options := OpenSurveyDialog.Options + [ofAllowMultiSelect];
  if OpenSurveyDialog.Execute then
  begin
    for i := 0 to OpenSurveyDialog.Files.Count - 1 do
      LoadFromResponse(OpenSurveyDialog.Files[i]);
    LoadData(tvItems.Selected);
  end;
  OpenSurveyDialog.Options := OpenSurveyDialog.Options - [ofAllowMultiSelect];
end;

procedure TfrmMain.LoadFromResponse(const Filename: string);
var
  ASurvey: IJvSurvey;
  i: integer;
begin
  ASurvey := CreateSurvey;
  ASurvey.LoadFromFile(Filename);
  if ASurvey.ID <> FSurvey.ID then
    raise
      Exception.CreateFmt(SFmtInvalidResponseFile, [Filename]);
  if (FResponses.IndexOf(ASurvey.SurveyTaker.ID) > -1) and acDupeWarning.Checked then
    ShowMessageFmt(SFmtResponseAlreadyLoaded, [Filename, ASurvey.SurveyTaker.ID])
  else
  begin
    FResponses.Add(ASurvey.SurveyTaker.ID);
    for i := 0 to ASurvey.Items.Count - 1 do
      AddResponses(ASurvey.Items[i], i, ASurvey.SurveyTaker);
  end;
end;

procedure TfrmMain.AddResponses(item: IJvSurveyItem; Index: integer; const SurveyTaker: IJvSurveyTaker);
var
  S, tmp: string;


  function Decode(S: WideString): TList;
  var
    ST: TStringlist;
    i: integer;
  begin
    Result := TList.Create;
    ST := TStringlist.Create;
    try
      StrTokenToStrings(S, cRecordSeparator, ST);
      for i := 0 to ST.Count - 1 do
        Result.Add(Pointer(StrToIntDef(ST[i], 0)));
    finally
      ST.Free;
    end;
  end;

  procedure MergeResponses(item1, item2: IJvSurveyItem);
  var
    S1, S2: TList;
    i: integer;
    tmp: string;
  begin
    S1 := Decode(item1.Responses);
    S2 := Decode(item2.Responses);
    S1.Count := Max(S1.Count, S2.Count);
    S2.Count := Max(S1.Count, S2.Count);
    for i := 0 to S2.Count - 1 do
      S1[i] := Pointer(integer(S1[i]) + integer(S2[i]));
    tmp := '';
    for i := 0 to S1.Count - 1 do
      tmp := tmp + IntToStr(integer(S1[i])) + cRecordSeparator;
    if MyAnsiLastChar(tmp) = cRecordSeparator then
      SetLength(tmp, Length(tmp) - 1);
    item1.Responses := tmp;
    S1.Free;
    S2.Free;
  end;
begin
  if (Index < 0) or (Index >= FSurvey.Items.Count) then Exit;
  if (FSurvey.Items[Index].SurveyType <> item.SurveyType) then
    raise Exception.CreateFmt(SFmtUnmatchedSurveyType, [Index]);
  if FSurvey.Items[Index].SurveyType = stFreeForm then
  begin
    S := trim(FSurvey.Items[Index].Responses);
    tmp := Format(SFmtResponse, [MakeString(cDelimChar, cDelimLength), SurveyTaker.UserName, trim(item.Responses)]);
    if (S = '') and (trim(item.Comments) <> '') then
      S := tmp
    else if trim(item.Responses) <> '' then
      S := S + tmp;
    FSurvey.Items[Index].Responses := S;
  end
  else
    MergeResponses(FSurvey.Items[Index], item);
  //add comments
  S := trim(FSurvey.Items[Index].Comments);
  tmp := Format(SFmtComment, [MakeString(cDelimChar, cDelimLength), SurveyTaker.UserName, trim(item.Comments)]);
  if (S = '') and (trim(item.Comments) <> '') then
    S := tmp
  else if trim(item.Comments) <> '' then
    S := S + tmp;
  FSurvey.Items[Index].Comments := S;
end;

procedure TfrmMain.acPrinterSettingsExecute(Sender: TObject);
begin
  PrinterSetupDialog.Execute;
end;

procedure TfrmMain.acPrintPreviewExecute(Sender: TObject);
var
  S: string;
begin
  S := ExtractFilePath(Application.ExeName) + cPrintTemplate;
  if not FileExists(S) then
    raise Exception.CreateFmt(SFmtTemplateNotFound, [S]);
  ppPrintPreview.HTMLFile := S;
  // generate and save report HTML file
  with TStringlist.Create do
  try
    Text := ppPrintPreview.Content;
    S := ChangeFileExt(S, cPrintReportExt);
    SaveToFile(S);
    // open in browser
    OpenObject(S);
  finally
    Free;
  end;
end;

procedure TfrmMain.acAboutExecute(Sender: TObject);
begin
  Windows.MessageBox(GetActiveWindow, PChar(SAboutText), PChar(SAboutTitle), MB_OK or MB_ICONINFORMATION);
end;

procedure TfrmMain.acSaveReportExecute(Sender: TObject);
const
  aFormat: array[1..3] of TJvSurveyFileFormat = (ffBinary, ffText, ffText);
begin
  if SaveReportDialog.Execute then
    SaveReport(SaveReportDialog.Filename, aFormat[SaveReportDialog.FilterIndex]);
end;

procedure TfrmMain.SaveReport(const Filename: string; Format: TJvSurveyFileFormat);
//var
//  i: integer;
//  X: TJvSimpleXML;
//  elem:TJvSimpleXMLElem;
begin
  FSurvey.SurveyTaker.UserName := '';
  FSurvey.SurveyTaker.MailAddress := '';
  // save all loaded respones as  a comma-separated lsit
  FSurvey.SurveyTaker.ID := FResponses.CommaText;
  FSurvey.SaveToFile(Filename, Format);
end;

procedure TfrmMain.acLoadReportExecute(Sender: TObject);
begin
  OpenSurveyDialog.Filter := SReportFileFilter;
  OpenSurveyDialog.FileName := SaveReportDialog.Filename;
  if OpenSurveyDialog.Execute then
    LoadFromFile(OpenSurveyDialog.Filename, false);
end;

function TfrmMain.GetReportHTMLSummary: string;
begin
  Result := Format(SFmtHTMLTableSurveySummary,
    [FSurvey.Title, DateToStr(FSurvey.ReleaseDate), DateToStr(FSurvey.ExpiryDate),
    FResponses.Count, FSurvey.Items.Count]);
end;

function TfrmMain.GetReportHTMLContent: string;
var
  i, j: integer;
  C, R: TStringlist;
  function ConvertCRLFToBR(const S: string): string;
  begin
    Result := StringReplace(S, '\n', '<br>', [rfReplaceAll]);
    Result := StringReplace(Result, #13#10, '<br>', [rfReplaceAll]);
  end;
begin
  if FSurvey.Items.Count = 0 then
  begin
    Result := SHTMLNoItemsToDisplay;
    Exit;
  end;
  C := TStringlist.Create;
  R := TStringlist.Create;
  try
    for i := 0 to FSurvey.Items.Count - 1 do
    begin
      FSurvey.Items[i].SortResponses;
      // TODO: add comments
      Result := Result + Format(SFmtHTMLTableSurveyItemHeader,
        [i + 1, FSurvey.Items[i].Title, FSurvey.Items[i].Description, EncodeType(FSurvey.Items[i].SurveyType)]);
      C.Text := DecodeChoice(FSurvey.Items[i].Choices, FSurvey.Items[i].SurveyType);
      R.Text := DecodeResponse(FSurvey.Items[i].Responses, FSurvey.Items[i].SurveyType);
      if FSurvey.Items[i].SurveyType = stFreeForm then
        Result := Result + Format(SFmtHTMLTableSurveyItemDetail, [ConvertCRLFToBR(R.Text)])
      else
      begin
        while C.Count > R.Count do
          R.Add(SHTMLSpacer);
        Result := Result + STableSurveyItemDetail;
        for j := 0 to C.Count - 1 do
          Result := Result + Format(SFmtHTMLTRSurveyItemDetail, [ConvertCRLFToBR(C[j]), ConvertCRLFToBR(R[j])]);
        Result := Result + SHTMLTableEnd;
      end;
      C.Text := ConvertCRLFToBR(FSurvey.Items[i].Comments);
      if C.Count > 0 then
      begin
        Result := Result + STableCommentHeader;
        for j := 0 to C.Count - 1 do
          Result := Result + Format(SFmtTableCommentDetail,[ConvertCRLFToBR(C[j])]);
        Result := Result + SHTMLTableEnd;
      end;
      Result := Result + SFmtHTMLTableSurveyItemFooter;
    end;
  finally
    R.Free;
    C.Free;
  end;
end;

procedure TfrmMain.ppPrintPreviewHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: string; TagParams: TStrings; var ReplaceText: string);
begin
  if AnsiSameText(TagString, 'SURVEYTITLE') then // DO NOT LOCALIZE
    ReplaceText := FSurvey.Title
  else if AnsiSameText(TagString, 'SURVEYSUMMARY') then // DO NOT LOCALIZE
    ReplaceText := GetReportHTMLSummary
  else if AnsiSameText(TagString, 'SURVEYCONTENT') then // DO NOT LOCALIZE
    ReplaceText := GetReportHTMLContent;
end;

procedure TfrmMain.alMainUpdate(Action: TBasicAction;
  var Handled: Boolean);
const
  // TODO: localize
  cRequired: array[boolean] of PChar = ('  Optional', '  Required');
  cType: array[TJvSurveyType] of PChar = ('  Exclusive', '  Multiple', '  Free Form');
begin
  sbStatus.Panels[0].Width := Canvas.TextWidth(FFilename) + 8;
  if sbStatus.Panels[0].Width < 100 then
    sbStatus.Panels[0].Width := 100;
  sbStatus.Panels[0].Text := '  ' + FFilename;
  if FCurrentItem <> nil then
  begin
    acComments.Enabled := true;
    sbStatus.Panels[1].Text := cType[FCurrentItem.SurveyType];
    sbStatus.Panels[2].Text := cRequired[FCurrentItem.Required];
  end
  else
  begin
    acComments.Enabled := false;
    sbStatus.Panels[1].Text := '';
    sbStatus.Panels[2].Text := '';
  end;
end;

procedure TfrmMain.UpdateStatusBar;
begin
  alMain.UpdateAction(nil);
end;

procedure TfrmMain.acCommentsExecute(Sender: TObject);
begin
  TfrmComments.Comments(FCurrentItem.Title, FCurrentItem.Comments);
end;

procedure TfrmMain.acDupeWarningExecute(Sender: TObject);
begin
  acDupeWarning.Checked := not acDupeWarning.Checked;
  FResponses.Sorted := acDupeWarning.Checked;
end;

end.