📄 mainfrm.pas
字号:
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 + -