wj_xt_shezlj.pas

来自「完整的公司合同管理系统,基于ACSESS数据库开发,无须安装任何其他插件.附带源」· PAS 代码 · 共 94 行

unit WJ_XT_SHEZLJ;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, DB, ADODB, FileCtrl;

type
  TfrmWJ_XT_SHEZLJ = class(TForm)
    GroupBox1: TGroupBox;
    DirectoryListBox1: TDirectoryListBox;
    DriveComboBox1: TDriveComboBox;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Edit1: TEdit;
    ADOTable1: TADOTable;
    procedure BitBtn2Click(Sender: TObject);
    procedure DriveComboBox1Change(Sender: TObject);
    procedure DirectoryListBox1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure GetNowLoc;
    procedure GetLoc;
    procedure SetData;
  end;
  procedure SetFileSaveLocation;
var
  frmWJ_XT_SHEZLJ: TfrmWJ_XT_SHEZLJ;

implementation
uses pdm;
{$R *.dfm}
procedure SetFileSaveLocation;
begin
  Application.CreateForm(TfrmWJ_XT_SHEZLJ,frmWJ_XT_SHEZLJ);
  with frmWJ_XT_SHEZLJ do
       begin
            GetNowLoc;
            if ShowModal=mrok then
               SetData;
       end;

end;

procedure TfrmWJ_XT_SHEZLJ.GetLoc;
begin
  Edit1.Text := DirectoryListBox1.Directory;
end;

procedure TfrmWJ_XT_SHEZLJ.GetNowLoc;
begin
  with ADOTable1 do
       begin
            Open;
            Edit1.Text := FieldByName('Dir').AsString ;
            DirectoryListBox1.Directory := FieldByName('Dir').AsString;
            Close;
       end;

end;

procedure TfrmWJ_XT_SHEZLJ.SetData;
begin
  with ADOTable1 do
       begin
            Open;
            Edit;
            FieldByName('Dir').AsString := Edit1.Text+'\';
            Post;
            Close;
       end;
       application.MessageBox('路径设置成功！','提示',MB_OK+MB_ICONINFORMATION);
end;

procedure TfrmWJ_XT_SHEZLJ.BitBtn2Click(Sender: TObject);
begin
  close;
end;

procedure TfrmWJ_XT_SHEZLJ.DriveComboBox1Change(Sender: TObject);
begin
  GetLoc;
end;

procedure TfrmWJ_XT_SHEZLJ.DirectoryListBox1Change(Sender: TObject);
begin
  GetLoc;
end;

end.