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

📄 basesetup.pas

📁 很好的文具管理软件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit BaseSetup;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls, StdCtrls, Buttons, dxtree, dxdbtree, Menus,
  Mask, DBCtrls;

type
  TFrmBaseSetup = class(TForm)
    BtnClose: TBitBtn;
    Label1: TLabel;
    PopupMenu1: TPopupMenu;
    NewItme1: TMenuItem;
    S1: TMenuItem;
    N1: TMenuItem;
    D1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    C1: TMenuItem;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Label14: TLabel;
    Label15: TLabel;
    EdtIncName: TEdit;
    BtnSaveIncName: TBitBtn;
    TabSheet2: TTabSheet;
    LBDeptName: TListBox;
    EdtDeptName: TEdit;
    BtnAdd: TBitBtn;
    BtnDel: TBitBtn;
    TabSheet3: TTabSheet;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label13: TLabel;
    dxDBTV: TdxDBTreeView;
    EdtWareNo: TDBEdit;
    EdtWareName: TDBEdit;
    EdtGuige: TDBEdit;
    CmbUnit: TDBComboBox;
    EdtPrice: TDBEdit;
    MemoGoods: TDBMemo;
    EdtID: TDBEdit;
    CmbType: TDBComboBox;
    TabSheet4: TTabSheet;
    GroupBox1: TGroupBox;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    EdtOldPwd: TEdit;
    EdtNewPwd: TEdit;
    EdtCfmPwd: TEdit;
    BitBtn1: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure EdtDeptNameChange(Sender: TObject);
    procedure LBDeptNameClick(Sender: TObject);
    procedure BtnAddClick(Sender: TObject);
    procedure BtnDelClick(Sender: TObject);
    procedure BtnSaveIncNameClick(Sender: TObject);
    procedure EdtIncNameChange(Sender: TObject);
    procedure NewItme1Click(Sender: TObject);
    procedure S1Click(Sender: TObject);
    procedure dxDBTVClick(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure C1Click(Sender: TObject);
    procedure dxDBTVDragDropTreeNode(Destination, Source: TTreeNode;
      var Accept: Boolean);
    procedure dxDBTVCustomDraw(Sender: TObject; TreeNode: TTreeNode;
      AFont: TFont; var AColor, ABkColor: TColor);
    procedure D1Click(Sender: TObject);
    procedure EdtWareNoExit(Sender: TObject);
    procedure EdtWareNameExit(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure EdtWareNameEnter(Sender: TObject);
  private
    { Private declarations }
    procedure ReadDeptName;
    procedure ReadIncName;
    procedure WriteIncName(i:integer);
    procedure ReadWareData;
    procedure DisabledAddSubItme;
    procedure EnabledAddSubItme;
    procedure ReadAllClassName;
    procedure DeleteClassAllDataFromDatabase;
    function DataRepeat(sField,sStr:string):boolean;
    function OldpasswordIsRight(sPwd:string):boolean;
  public
    { Public declarations }
  end;

var
  FrmBaseSetup: TFrmBaseSetup;
  IsChanged:boolean  =  False;
  IncNameIsEmpty:boolean  =False;
  TempGoods:string   = '' ;

implementation

uses global,dm,logo;

{$R *.dfm}

procedure TFrmBaseSetup.FormCreate(Sender: TObject);
begin
self.Caption :=SFormBaseSetup;
Label1.Caption :=sAppName;
EdtDeptName.Text :='';
BtnDel.Enabled :=False;
EdtOldPwd.Text :='';
EdtNewPwd.Text :='';
EdtCfmPwd.Text :='';
EdtOldPwd.PasswordChar :='*';
EdtNewPwd.PasswordChar :='*';
EdtCfmPwd.PasswordChar :='*';
//TreeView 的设置(注:使用第三方控件ExpressDBTree)
dxDBTV.KeyField :=sFNo;
dxDBTV.ListField :=SFGoodsName;
dxDBTV.DisplayField :=SFGoodsName;
dxDBTV.ParentField :=sFParentNo;
with FrmLogo do
  begin
    LMsg1.Caption :=sMsgLoadInfo1;
    LMsg2.Caption :=sMsgLoadInfo1;
    LMsg1.Update;
    LMsg2.Update;
  end;
ReadDeptName;      //Read department Setup
ReadIncName;       //Read IncName Setup
ReadWareData;      //Read Ware Name Setup
DisabledAddSubItme;
ReadAllClassName;
end;

procedure TFrmBaseSetup.ReadDeptName;
begin
LBDeptName.Items.Clear;
with Dm_Wjckgl.ADOQry do
begin
  close;
  sql.Text :=format(SSQLTY1,[STDept,SFDept]);
  open;
  first;
  while not eof do
  begin
    if FieldValues[SFDept]<> null then
      LBDeptName.Items.Add(FieldValues[SFDept]);
    next;
  end;
  close;
end;
end;

procedure TFrmBaseSetup.ReadIncName;
begin
EdtIncName.Text :='';
with Dm_Wjckgl.ADOQry do
begin
  close;
  sql.Text :=format(SSQLTY0,[STCompanyName]);
  open;
  first;
  if FieldValues[SFCompanyName]<> null then
    EdtIncName.Text := FieldValues[SFCompanyName];
  close;
end;
if Trim(EdtIncName.Text)='' then
   IncNameIsEmpty := true
   else
   IncNameIsEmpty := False;
end;

procedure TFrmBaseSetup.EdtDeptNameChange(Sender: TObject);
begin
//要增加的项目为空时,“增加”按钮不可用
if trim(EdtDeptName.Text)='' then
  BtnAdd.Enabled :=False
  else
  BtnAdd.Enabled :=true;
end;

procedure TFrmBaseSetup.LBDeptNameClick(Sender: TObject);
begin
//如果选择的项目不为空则“删除”按可使用
if LBDeptName.Items[LBDeptName.ItemIndex]='' then
//if (lbdeptname.ItemIndex<0 ) or (LBDeptName.ItemIndex >=LBDeptName.Items.Count) then
  BtnDel.Enabled :=False
  else
  BtnDel.Enabled :=true;
end;

procedure TFrmBaseSetup.BtnAddClick(Sender: TObject);
begin
if LBDeptName.Items.IndexOf(EdtDeptName.Text)<>-1 then
  begin
    msgbox(sMsgRepeatSaveError,STitleError,1);
    exit;
  end;
// Write to Database
try
  with DM_Wjckgl.ADOQry do
  begin
    close;
    sql.Text :=sSQLInsertDeptName;
    parameters.ParamByName('pDept').Value :=EdtDeptName.Text;
    Execsql;
  end;
  LBDeptName.Items.Add(EdtDeptName.Text);
  EdtDeptName.Text :='';
  IsChanged:=True;  //己经对基本信息进行过修改
except
  msgbox(sMsgSaveError,STitleError,1);
  EdtDeptName.SetFocus;
end;
end;

procedure TFrmBaseSetup.BtnDelClick(Sender: TObject);
begin
// Delete Confirm
if  msgbox(sMsgDeleteConfirm ,STitleConfirm ,4)=IDNo then exit;
try
  with DM_Wjckgl.ADOQry do
    begin
      close;
      sql.Text :=format(SSQLDeleteData,[STDept,STDept,LBDeptName.Items[LBDeptName.ItemIndex]]);
      execsql;
    end;
  LBDeptName.DeleteSelected;
  IsChanged:=True;  //己经对基本信息进行过修改
except
  msgbox(sMsgDeleteError,STitleError,1);
end;
end;

procedure TFrmBaseSetup.WriteIncName(i:integer);
begin
if trim(EdtIncName.Text)='' then exit;
try
with DM_Wjckgl.ADOQry do
  begin
    close;
    case i of
      0:sql.Text := sSQLUpdateIncName;
      1:sql.Text := sSqlInsertIncNmae
    end;
    parameters.ParamByName('pInc').Value :=EdtIncName.Text;
    execsql; 
  end;
  msgbox(sMsgSaveOk,STitleHint ,0);
  IncNameIsEmpty:=False;
except
  msgbox(sMsgSaveError,STitleError,1);
end;
end;

procedure TFrmBaseSetup.BtnSaveIncNameClick(Sender: TObject);
begin
// Save or alter company name
if IncNameIsEmpty then WriteIncName(1) else WriteIncName(0);
end;

procedure TFrmBaseSetup.EdtIncNameChange(Sender: TObject);
begin
if trim(EdtIncName.Text)='' then
  BtnSaveIncName.Enabled :=False
  else
  BtnSaveIncName.Enabled :=true;
end;

procedure TFrmBaseSetup.NewItme1Click(Sender: TObject);
var
  sWareType:string;
label A ;     //为使用 GOTO语句
begin
  A:
  sWareType:='';
  sWareType:=inputbox(sTitleAdd,sMsgEnterClassName,'');
  if trim(sWareType)='' then exit;
//  showmessage(copy(sWareType,Length(sWareType)-1,2));
  if copy(sWareType,Length(sWareType)-1,2)<>'类' then
    sWareType:=sWareType+'类';
  if DataRepeat(SFGoodsName,sWareType) then
    begin
      msgbox(format(sMsgClassRepeat,[sWareType]),STitleError,1);
//      exit;
      goto A;
    end; 
  with DM_Wjckgl.ADOQry do
  begin
    close;
    sql.Text :=sSQLAddClassName;
    parameters.ParamByName('pName').Value := sWareType;
    parameters.ParamByName('pNo').Value :=-1;
    parameters.ParamByName('pGG').Value :='类';
    parameters.ParamByName('pDW').Value :='类';
    parameters.ParamByName('pDJ').Value :=0;
    parameters.ParamByName('pBZ').Value :='无';
    execsql;
  end;
//  dxDBTV.Items.Add(dxDBTV.Selected,sWareType);
  CmbType.Items.Add(sWareType);
  ReadWareData;
  IsChanged:=True;  //己经对基本信息进行过修改
end;

⌨️ 快捷键说明

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