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

📄 mainfrm.pas

📁 jvcl driver development envionment
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{******************************************************************

                       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.

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

unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ExtCtrls, StdCtrls, Menus, StdActns, ActnList, ImgList,
  JvPageScroller, JvComCtrls, JvStatusBar, JvDateTimePicker, JvCombobox, JvLinkLabel,
  JvEdit, JvSurveyIntf, JvDialogs, JvImage, JvCheckBox, JvValidateEdit,
  JvRichEdit, JvExExtCtrls, JvExStdCtrls, JvExComCtrls;

type
  TfrmMain = class(TForm)
    Panel1: TPanel;
    Splitter1: TSplitter;
    JvStatusBar1: TJvStatusBar;
    tvItems: TJvTreeView;
    nbDetails: TNotebook;
    Label1: TLabel;
    edTitle: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    edHREF: TEdit;
    Label4: TLabel;
    edRecipientName: TEdit;
    Label5: TLabel;
    edRecipientEMail: TEdit;
    dtpReleaseDate: TJvDateTimePicker;
    Label6: TLabel;
    lblExpDate: TLabel;
    dtpExpirationDate: TJvDateTimePicker;
    Label8: TLabel;
    edItemTitle: TEdit;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    cbItemType: TJvComboBox;
    reItemChoices: TJvRichEdit;
    reItemDescription: TJvRichEdit;
    mmMain: TMainMenu;
    File1: TMenuItem;
    Edit7: TMenuItem;
    Help1: TMenuItem;
    alMain: TActionList;
    acOpen: TAction;
    acSave: TAction;
    acNew: TAction;
    acSaveAs: TAction;
    acExit: TAction;
    acAdd: TAction;
    acDelete: TAction;
    acMoveUp: TAction;
    acMoveDown: TAction;
    acCopy: TEditCopy;
    acCut: TEditCut;
    acPaste: TEditPaste;
    acSelectAll: TEditSelectAll;
    acUndo: TEditUndo;
    acNew1: TMenuItem;
    acOpen1: TMenuItem;
    acSave1: TMenuItem;
    acSaveAs1: TMenuItem;
    N1: TMenuItem;
    acExit1: TMenuItem;
    Undo1: TMenuItem;
    N2: TMenuItem;
    Cut1: TMenuItem;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    N3: TMenuItem;
    SelectAll1: TMenuItem;
    acAbout: TAction;
    acHelp: TAction;
    il16: TImageList;
    About1: TMenuItem;
    N4: TMenuItem;
    Help2: TMenuItem;
    popTree: TPopupMenu;
    Add1: TMenuItem;
    Delete1: TMenuItem;
    N5: TMenuItem;
    MoveUp1: TMenuItem;
    MoveDown1: TMenuItem;
    Items1: TMenuItem;
    Add2: TMenuItem;
    Delete2: TMenuItem;
    N6: TMenuItem;
    MoveUp2: TMenuItem;
    MoveDown2: TMenuItem;
    Label14: TLabel;
    edID: TJvValidateEdit;
    OpenSurveyDialog: TJvOpenDialog;
    SaveSurveyDialog: TJvSaveDialog;
    acPrev: TAction;
    acNext: TAction;
    Panel2: TPanel;
    lblPage: TLabel;
    JvImage1: TJvImage;
    Previous1: TMenuItem;
    Next1: TMenuItem;
    N7: TMenuItem;
    reDescription: TJvRichEdit;
    chkRequired: TJvCheckBox;
    acCopyItem: TAction;
    acPreview: TAction;
    N8: TMenuItem;
    Preview1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure acOpenExecute(Sender: TObject);
    procedure acSaveExecute(Sender: TObject);
    procedure acExitExecute(Sender: TObject);
    procedure tvItemsChanging(Sender: TObject; Node: TTreeNode;
      var AllowChange: Boolean);
    procedure tvItemsChange(Sender: TObject; Node: TTreeNode);
    procedure tvItemsCollapsing(Sender: TObject; Node: TTreeNode;
      var AllowCollapse: Boolean);
    procedure acPrevExecute(Sender: TObject);
    procedure acNextExecute(Sender: TObject);
    procedure alMainUpdate(Action: TBasicAction; var Handled: Boolean);
    procedure acAddExecute(Sender: TObject);
    procedure acMoveUpExecute(Sender: TObject);
    procedure acMoveDownExecute(Sender: TObject);
    procedure acDeleteExecute(Sender: TObject);
    procedure acNewExecute(Sender: TObject);
    procedure acSaveAsExecute(Sender: TObject);
    procedure SurveyChanged(Sender: TObject);
    procedure nbDetailsPageChanged(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure acAboutExecute(Sender: TObject);
    procedure acCopyItemExecute(Sender: TObject);
    procedure acPreviewExecute(Sender: TObject);
    procedure WMUser1(var Msg:TMessage);message WM_USER + 1;
  private
    FModified: boolean;
    FFilename: string;
    procedure SetModified(const Value: boolean);
  private
    FSurvey: IJvSurvey;
    FLastNode: TTreeNode;
    procedure SaveData(Node: TTreeNode);
    procedure LoadData(Node: TTreeNode);

    function CheckSave: boolean;
    procedure CreateEverything;
    procedure LoadSettings;
    procedure SaveSettings;
    procedure FreeEverything;

    procedure Clear;
    procedure LoadView;
    function AddItem(Parent: TTreeNode; Item: IJvSurveyItem): TTreeNode;

    procedure LoadFromFile(const Filename: string);
    function SaveFile: boolean;
    procedure SaveToFile(const Filename: string;Format:TJvSurveyFileFormat);
    procedure UpdateStatus;
    property Filename: string read FFilename write FFilename;
    property Modified: boolean read FModified write SetModified;
  public
  end;

var
  frmMain: TfrmMain;

resourcestring
  SPageCaptionGlobal = 'General Survey Settings';
  SPageCaptionItem = 'Survey Item Settings';
  SModified = 'Modified';
  SReady = 'Ready';
  SSavePromptText = 'Save changes to current survey?';
  SSurveyModifiedCaption = 'Survey modified';
  SNewItemTitle = 'New item';
  SItemCopy     = ' (copy)';
  SSurveyorNotFoundFmt = 'Unable to find JEDI Surveyor (%s). Please fix and try again.';
  SAboutText = 'JEDI Surveyor Builder, version 1.0';
  SAboutTitle = 'About Builder...';

const
  cSurveyItemImageIndex = 22;

implementation
uses
  JvSurveyUtils, JclMiscel;

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  CreateEverything;
  LoadSettings;
  // set Modified to false after all updates are finished
  PostMessage(Handle,WM_USER + 1, 0, 0);
end;

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if CheckSave then
  begin
    SaveSettings;
    FreeEverything;
  end
  else
    CanClose := false;
end;

procedure TfrmMain.CreateEverything;
begin
  FSurvey := CreateSurvey;
end;

procedure TfrmMain.FreeEverything;
begin
  FSurvey := nil;
end;

procedure TfrmMain.LoadFromFile(const Filename: string);
begin
  if not CheckSave then Exit;
  Clear;
  FSurvey.LoadFromFile(Filename);
  self.Filename := Filename;
  LoadView;
  Modified := false;
  UpdateStatus;
end;

procedure TfrmMain.LoadSettings;
begin
  dtpReleaseDate.Date := Date;
  dtpExpirationDate.Date := Date;
end;

procedure TfrmMain.SaveSettings;
begin

end;

procedure TfrmMain.SaveToFile(const Filename: string;Format:TJvSurveyFileFormat);
var
  N: TTreeNode;
  i: integer;
begin
  // DONE: update ID's of survey items
  // and reset response
  N := tvItems.Items.GetFirstNode;
  if N <> nil then
    N := N.getFirstChild;
  i := 1;
  while Assigned(N) do
  begin
    if N.Data <> nil then
    begin
      IJvSurveyItem(N.Data).ID := i;
      IJvSurveyItem(N.Data).Responses := '';
      Inc(i);
    end;
    N := N.getNextSibling;
  end;
  FSurvey.SurveyTaker.ID := '';
  FSurvey.SurveyTaker.UserName := '';
  FSurvey.SurveyTaker.MailAddress := '';
  FSurvey.SurveyTaker.Notes := '';
  FSurvey.SaveToFile(Filename,Format);
  self.Filename := Filename;
  Modified := false;
  UpdateStatus;
end;

function TfrmMain.CheckSave: boolean;
begin
  Result := true;
  if Modified then
    case MessageBox(GetFocus, PChar(SSavePromptText), PChar(SSurveyModifiedCaption), MB_YESNOCANCEL) of
      IDYES:
        Result := SaveFile;
      IDNO: ;
      IDCANCEL:
        Result := false;
    end;
end;

procedure TfrmMain.acOpenExecute(Sender: TObject);
begin
  OpenSurveyDialog.Filename := Filename;
  if OpenSurveyDialog.Execute then
    LoadFromFile(OpenSurveyDialog.Filename);
end;

procedure TfrmMain.acSaveExecute(Sender: TObject);
begin
  SaveData(tvItems.Selected);
  SaveFile;
end;

function TfrmMain.SaveFile: boolean;
const
  aFormat: array [1..3] of TJvSurveyFileFormat = (ffBinary,ffText,ffText);
begin
  Result := true;

⌨️ 快捷键说明

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