⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mainfrm.pas

📁 jvcl driver development envionment
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  if (Filename = '') then
    Result := acSaveAs.Execute
  else
    SaveToFile(Filename,aFormat[SaveSurveyDialog.FilterIndex]);
end;

procedure TfrmMain.Clear;
begin
  tvItems.Items.GetFirstNode.DeleteChildren;
  nbDetails.PageIndex := 0;
  // DONE: clear edits etc
  LoadData(nil);
  Modified := true;
end;

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

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

procedure TfrmMain.tvItemsChanging(Sender: TObject; Node: TTreeNode;
  var AllowChange: Boolean);
begin
  SaveData(tvItems.Selected);
end;

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

procedure TfrmMain.LoadData(Node: TTreeNode);
var
  item: IJvSurveyItem;
  tmp: boolean;
begin
  nbDetails.PageIndex := 0;
  tmp := Modified;
  try
    if (Node = nil) then // empty
    begin
      edTitle.Text := '';
      edID.Value := 1;
      reDescription.Lines.Text := '';
      edHREF.Text := '';
      edRecipientName.Text := '';
      edRecipientEMail.Text := '';
      dtpReleaseDate.DateTime := Date;
      dtpExpirationDate.DateTime := Date;
    end
    else if (Node.Parent = nil) and (Node.Data <> nil) then // root
    begin
      edTitle.Text := FSurvey.Title;
      edID.Value := FSurvey.ID;
      reDescription.Lines.Text := StringReplace(StringReplace(FSurvey.Description, #13#10, ' ', [rfReplaceAll]), '<br>',
        #13#10, [rfReplaceAll]);
      edHREF.Text := FSurvey.ResultHRef;
      edRecipientName.Text := FSurvey.Recipient;
      edRecipientEMail.Text := FSurvey.RecipientMail;
      dtpReleaseDate.DateTime := FSurvey.ReleaseDate;
      dtpExpirationDate.DateTime := FSurvey.ExpiryDate;
      nbDetails.PageIndex := 0;
    end
    else if Node.Data <> nil then
    begin
      item := IJvSurveyItem(Node.Data);
      edItemTitle.Text := item.Title;
      reItemDescription.Lines.Text := item.Description;
      cbItemType.ItemIndex := Ord(item.SurveyType);
      chkRequired.Checked := item.Required;
      //      reItemChoices.Lines.CommaText := item.Choices;
      reItemChoices.Lines.Text := DecodeChoice(item.Choices, item.SurveyType);
      nbDetails.PageIndex := 1;
    end;
  finally
    Modified := tmp;
  end;
  FLastNode := Node;
end;

procedure TfrmMain.SaveData(Node: TTreeNode);
var
  item: IJvSurveyItem;
begin
  if (Node <> FLastNode) or not Modified then Exit;
  if (Node = nil) then
    // do nothing
  else if (Node.Parent = nil) and (Node.Data <> nil) then // root
  begin
    if Node = nil then Exit;
    FSurvey.Title := edTitle.Text;
    FSurvey.ID := edID.Value;
    FSurvey.Description := StringReplace(reDescription.Lines.Text, #13#10, '<br>', [rfReplaceAll]);
    FSurvey.ResultHRef := edHREF.Text;
    FSurvey.Recipient := edRecipientName.Text;
    FSurvey.RecipientMail := edRecipientEMail.Text;
    FSurvey.ReleaseDate := dtpReleaseDate.DateTime;
    FSurvey.ExpiryDate := dtpExpirationDate.DateTime;
  end
  else if Node.Data <> nil then
  begin
    item := IJvSurveyItem(Node.Data);
    item.Title := edItemTitle.Text;
    item.Required := chkRequired.Checked;
    Node.Text := item.Title;
    item.Description := reItemDescription.Lines.Text;
    item.SurveyType := TJvSurveyType(cbItemType.ItemIndex);
    item.Choices := EncodeChoice(reItemChoices.Lines.Text, item.SurveyType);
  end;
end;

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

procedure TfrmMain.acPrevExecute(Sender: TObject);
begin
  tvItems.Selected := tvItems.Selected.getPrev;
end;

procedure TfrmMain.acNextExecute(Sender: TObject);
begin
  tvItems.Selected := tvItems.Selected.GetNext;
end;

procedure TfrmMain.alMainUpdate(Action: TBasicAction;
  var Handled: Boolean);
begin
  acMoveUp.Enabled := (tvItems.Selected <> nil) and (tvItems.Selected.getPrevSibling <> nil);
  acMoveDown.Enabled := (tvItems.Selected <> nil) and (tvItems.Selected.getNextSibling <> nil);
  acPrev.Enabled := (tvItems.Selected <> nil) and (tvItems.Selected.getPrev <> nil);
  acNext.Enabled := (tvItems.Selected <> nil) and (tvItems.Selected.getNext <> nil);
  acDelete.Enabled := (tvItems.Selected <> nil) and (tvItems.Selected.Parent <> nil);
  acCopyItem.Enabled := (tvItems.Selected <> nil) and (tvItems.Selected.Parent <> nil) and (tvItems.Focused);
  if acCopyItem.Enabled then
    acCopy.ShortCut := 0
  else
    acCopy.ShortCut := acCopyItem.ShortCut;
end;

procedure TfrmMain.acAddExecute(Sender: TObject);
var
  item: IJvSurveyItem;
begin
  item := FSurvey.Items.Add;
  item.Title := SNewItemTitle;
  tvItems.Selected := AddItem(tvItems.Items.GetFirstNode, item);
  Modified := true;
end;

procedure TfrmMain.acMoveUpExecute(Sender: TObject);
begin
  tvItems.Selected.MoveTo(tvItems.Selected.getPrevSibling, naInsert);
  Modified := true;
end;

procedure TfrmMain.acMoveDownExecute(Sender: TObject);
begin
  tvItems.Selected.getNextSibling.MoveTo(tvItems.Selected, naInsert);
  Modified := true;
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;
  Modified := true;
end;

procedure TfrmMain.acDeleteExecute(Sender: TObject);
var
  N: TTreeNode;
  item:IJvSurveyItem;
  i:integer;
begin
  N := tvItems.Selected.GetNext;
  if N = nil then
    N := tvItems.Selected.GetPrev;
  item := IJvSurveyItem(tvItems.Selected.Data);
  tvItems.Selected.Data := nil;
  for i := 0 to FSurvey.Items.Count - 1 do
    if FSurvey.Items[i] = item then
    begin
      FSurvey.Items.Delete(i);
      Break;
    end;
  tvItems.Selected.Delete;
  tvItems.Selected := N;
  Modified := true;
end;

procedure TfrmMain.acNewExecute(Sender: TObject);
begin
  if not CheckSave then Exit;
  Clear;
  Filename := '';
  Modified := false;
end;

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

procedure TfrmMain.UpdateStatus;
begin
  JvStatusBar1.Panels[0].Text := Filename;
  if Modified then
    JvStatusBar1.Panels[1].Text := SModified
  else
    JvStatusBar1.Panels[1].Text := SReady;
end;

procedure TfrmMain.SetModified(const Value: boolean);
begin
  FModified := Value;
  UpdateStatus;
end;

procedure TfrmMain.SurveyChanged(Sender: TObject);
begin
  Modified := true;
end;

procedure TfrmMain.nbDetailsPageChanged(Sender: TObject);
begin
  case nbDetails.PageIndex of
    0:
      lblPage.Caption := SPageCaptionGlobal;
    1:
      lblPage.Caption := SPageCaptionItem;
  end;
end;

procedure TfrmMain.FormResize(Sender: TObject);
var
  tmp: boolean;
begin
  tmp := Modified;
  try
    with dtpReleaseDate do
      SetBounds(8, Top, nbDetails.ClientWidth div 2 - 16, Height);
    with dtpExpirationDate do
      SetBounds(dtpReleaseDate.Left + dtpReleaseDate.Width + 8, Top, dtpReleaseDate.Width + 10, Height);
    lblExpDate.Left := dtpExpirationDate.Left;
    reDescription.WordWrap := reDescription.Height > edTitle.Height;
  finally
    Modified := tmp;
  end;
end;

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

procedure TfrmMain.acCopyItemExecute(Sender: TObject);
var item1,item2:IJvSurveyItem;
begin
  item1 := IJvSurveyItem(tvItems.Selected.Data);
  if item1 <> nil then
  begin
    item2 := FSurvey.Items.Add;
    item2.ID := FSurvey.Items.Count;
    item2.Title := item1.Title + SItemCopy;
    item2.Description := item1.Description;
    item2.Required    := item1.Required;
    item2.SurveyType  := item1.SurveyType;
    item2.Choices     := item1.Choices;
    item2.Responses   := item1.Responses;
    tvItems.Selected := AddItem(tvItems.Items.GetFirstNode,item2);
    if tvItems.Selected <> nil then
      tvItems.Selected.MakeVisible;
  end;
end;

procedure TfrmMain.acPreviewExecute(Sender: TObject);
var S:string;
begin
  S := ExtractFilePath(Application.ExeName) + 'js.exe';
  if not FileExists(S) then
  begin
    ShowMessageFmt(SSurveyorNotFoundFmt,[S]);
    Exit;
  end;
  if SaveFile then
    WinExec32AndWait(S + ' ' + Filename, SW_SHOWNORMAL);
end;

procedure TfrmMain.WMUser1(var Msg: TMessage);
begin
  Modified := false;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -