mainfrm.pas

PC机控制系统程序

{
=====================================================================
* 软件名称：PC与数控机床通信程序
* 单元名称：主程序
* 单元作者：彭为 ([e-mail])
* 备    注：用到了线程进行发送
* 开发平台：PWin2000 SERVER + Delphi 7.0
* 兼容测试：PWin9X/2000/XP + Delphi 6/7
* 采用控件：Raize 3.12 ,SPCOMM
* 修改记录：V1.0  by pengwei
=====================================================================
}
unit Mainfrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, RzButton, ComCtrls, RzPanel,
  ActnList, Menus, ImgList, RzBorder, RzPrgres, RzEdit, RzTabs, iniFiles,
  ShellAPi,

  Grids, RzBckgnd, DB, ADODB, RzLabel, DBGrids;

const
  MP_QUERY = '11111';
  MP_REFUSE = '22222';
  MP_ACCEPT = '33333';
  MP_NEXTWILLBEDATA = '44444';
  MP_DATA = '55555';
  MP_ABORT = '66666';
  MP_OVER = '77777';
  MP_CHAT = '88888';
  MP_END = '99999';
  MP_FILEPROPERTY = '00000';
type
  TStatus = (stReady, stNotReady, stTimeOut, stSend, stRecv);

  TMain = class(TForm)
    stb1: TStatusBar;
    ImageList1: TImageList;
    MainMenu1: TMainMenu;
    ActionList1: TActionList;
    N4: TMenuItem;
    F11: TMenuItem;
    N7: TMenuItem;
    S1: TMenuItem;
    pgcmain: TRzPageControl;
    TabSheet2: TRzTabSheet;
    ChooseServer: TAction;
    ChooseComm: TAction;
    RzToolbar1: TRzToolbar;
    FileHelp: TAction;
    FileABOUT: TAction;
    Fileexit: TAction;
    N2: TMenuItem;
    ServiceStart: TAction;
    ServiceStop: TAction;
    BtnUtilities: TRzToolButton;
    RzSpacer2: TRzSpacer;
    BtnImport: TRzToolButton;
    BtnExport: TRzToolButton;
    COMMConfig: TAction;
    COMMImport: TAction;
    COMMExport: TAction;
    Connection: TADOConnection;
    Query: TADOQuery;
    Table: TADOTable;
    DataSource1: TDataSource;
    Panel1: TPanel;
    Splitter1: TSplitter;
    RzLabel1: TRzLabel;
    FileNew: TAction;
    FileSave: TAction;
    FileDelete: TAction;
    BtnPreviewPreviousPage: TRzToolButton;
    BtnPreviewNextPage: TRzToolButton;
    BtnRecycle: TRzToolButton;
    FileSaveAs: TAction;
    PopupMenu1: TPopupMenu;
    N3: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    RzSpacer6: TRzSpacer;
    BtnInformation: TRzToolButton;
    FileInfo: TAction;
    N11: TMenuItem;
    DBGrid1: TDBGrid;
    RichEdit1: TRichEdit;
    procedure FileExitExecute(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure Comm1ReceiveError(Sender: TObject; EventMask: Cardinal);
    procedure FileHelpExecute(Sender: TObject);
    procedure CommConfigExecute(Sender: TObject);
    procedure SetErrorstr(Errorstr: string);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure TableAfterScroll(DataSet: TDataSet);
    procedure COMMImportExecute(Sender: TObject);
    procedure COMMExportExecute(Sender: TObject);
    procedure FileNewExecute(Sender: TObject);
    procedure FileSaveExecute(Sender: TObject);
    procedure FileDeleteExecute(Sender: TObject);
    procedure TableBeforeScroll(DataSet: TDataSet);
    procedure FileSaveAsExecute(Sender: TObject);
    procedure FileInfoExecute(Sender: TObject);
    procedure GridEditDblClick(Sender: TObject);

  private
    { Private declarations }
  public
    SaveFilename: string;
    property ErrorStr: string write SetErrorStr;
    function getNewfilename: string;
    { Public declarations }
  end;

var
  Main: TMain;

implementation

uses ConfigFrm, Include, ExportFrm, ImportFrm, FileNew, SaveAs, FileInfo;

{$R *.dfm}

procedure TMain.FileExitExecute(Sender: TObject);
begin
  Close;
end;

procedure TMain.N7Click(Sender: TObject);
begin
  WinAbout(sMainCaption, sCopyright);
end;

procedure TMain.Comm1ReceiveError(Sender: TObject; EventMask: Cardinal);
begin
  ShowMsg(sErrReceive1);
end;

procedure TMain.FileHelpExecute(Sender: TObject);
var
  helpFilepath: string;
begin
  helpFilepath := ExtractFileDir(Application.Exename) + '\Readme.htm';
  if not fileexists(helpFilepath) then
  begin
    showmSg('帮助文件没找到！请确认安装目录是否存在Readme.htm文件');
    exit;
  end;
  ShellExecute(handle, nil, pchar(helpFilepath), nil, nil, sw_showNormal);
end;

procedure TMain.CommConfigExecute(Sender: TObject);
begin
  Config.ShowForm;
end;

procedure TMain.SetErrorstr(Errorstr: string);
begin
  stb1.Panels[1].Text := Errorstr;
end;

procedure TMain.FormCreate(Sender: TObject);
begin
  Caption := sMainCaption;
  Connection.ConnectionString := '';
  Connection.Close;
  Connection.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='
    +
    ExtractFilePath(ParamStr(0)) + 'Server.mdb;Persist Security Info=False';
  try
    Connection.Open; //打开连接
  except
    MessageBox(Application.Handle, PChar(sOpenDataError), PChar(sTitleErr),
      MB_OK + MB_IconERROR);
    Application.Terminate;
  end; // try/except
  ServiceStart.Execute; //启动服务

  Table.Open;
end;

procedure TMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if
    MessageBox(Self.Handle, PChar(sInfoClose), PChar(sTitleAsk), MB_YESNO +
    MB_DEFBUTTON2 + MB_ICONWARNING + MB_TASKMODAL) = IDNO then
    Abort;
end;

function TMain.getNewfilename: string;
var
  NewGuid: TGUID;
begin
  CoCreateGUID(NewGUID);
  Result := Config.ReceivedPath + '\' + GUIDToString(NewGuid);
end;

procedure TMain.TableAfterScroll(DataSet: TDataSet);
var
  FileName: string;
begin
  FileName := Table.FieldByName('Filename').AsString;
  if FileExists(FileName) then
  begin
    RichEdit1.Visible := True;
    COMMExport.Enabled := True;
    FileDelete.Enabled := True;
    FileInfo.Enabled := True;
    Application.ProcessMessages;
    RichEdit1.Lines.LoadFromFile(Filename);
  end
  else
  begin
    COMMExport.Enabled := False;
    FileDelete.Enabled := True;
    FileInfo.Enabled := False;
    RichEdit1.Visible := False;
  end;
end;

procedure TMain.COMMImportExecute(Sender: TObject);
begin
  Import.showForm;
end;

procedure TMain.COMMExportExecute(Sender: TObject);
begin
  FileSave.Execute;
  ExportData.showForm(Table.FieldByName('id').AsInteger);
end;

procedure TMain.FileNewExecute(Sender: TObject);
begin
  FileNewFrm.showForm;
end;

procedure TMain.FileSaveExecute(Sender: TObject);
var
  FileName: string;
begin
  FileName := Table.FieldByName('FileName').AsString;
  if FileExists(FileName) then
  begin
    RichEdit1.Lines.SaveToFile(FileName);
  end;
end;

procedure TMain.FileDeleteExecute(Sender: TObject);
var
  FileName: string;
begin
  FileName := Table.FieldByName('Filename').AsString;
  if FileExists(FileName) then
  begin
    if MessageBox(Self.Handle, PChar(sDeleteFile), PChar(sTitleAsk), MB_YESNO +
      MB_DEFBUTTON2 + MB_ICONWARNING + MB_TASKMODAL) = idNo then
      Exit;
    FileSetAttr(FileName, 0); //修改文件属性为普通属性值
    DeleteFile(FileName); //删除文件
    Table.Delete;
  end
  else
    Table.Delete;
end;

procedure TMain.TableBeforeScroll(DataSet: TDataSet);
var
  FileName: string;
begin
  FileName := Table.FieldByName('Filename').AsString;
  if FileExists(FileName) then
  begin
    Application.ProcessMessages;
    RichEdit1.Lines.SaveToFile(Filename);
  end;
end;

procedure TMain.FileSaveAsExecute(Sender: TObject);
var
  id: Integer;
begin
  id := Table.FieldByName('id').AsInteger;
  SaveAsFrm.showForm(id);
end;

procedure TMain.FileInfoExecute(Sender: TObject);
var
  id: Integer;
begin
  id := Table.FieldByName('id').AsInteger;
  FileinfoFrm.showForm(id);
end;

procedure TMain.GridEditDblClick(Sender: TObject);
begin
  FileInfo.Execute;
end;

end.