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

📄 mainunit.pas

📁 企业经营管理系统开发-商品销售管理系统,包括销售流程的前台和后台.
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, Registry, Menus, ExtCtrls, XPMan, DB, DBTables, shellapi,
  ToolWin, ImgList;

type
  TMainForm = class(TForm)
    StatusBar_main: TStatusBar;
    MainMenu_main: TMainMenu;
    Menu_file: TMenuItem;
    N12: TMenuItem;
    Menu_file_exit: TMenuItem;
    Menu_bassmessage: TMenuItem;
    Menu_bassmessage_admin: TMenuItem;
    Menu_bassmessage_goods: TMenuItem;
    Menu_data: TMenuItem;
    Menu_data_daysell: TMenuItem;
    Menu_data_jhlr: TMenuItem;
    N4: TMenuItem;
    Menu_data_jhth: TMenuItem;
    Menu_data_xsth: TMenuItem;
    N8: TMenuItem;
    Menu_data_depotjh: TMenuItem;
    Menu_data_depotth: TMenuItem;
    Menu_ywcx: TMenuItem;
    Menu_ywcx_xscx: TMenuItem;
    Menu_ywcx_ywyxstj: TMenuItem;
    Menu_ywcx_scxstj: TMenuItem;
    Menu_ywcx_cpxstj: TMenuItem;
    Menu_ywcx_jhcx: TMenuItem;
    Menu_ywcx_scjhtj: TMenuItem;
    Menu_ywcx_ckjhtj: TMenuItem;
    Menu_ywcx_kczk: TMenuItem;
    Menu_ywcx_sckcsptj: TMenuItem;
    Menu_ywcx_sclskccx: TMenuItem;
    Menu_ywcx_scspjxcmx: TMenuItem;
    N6: TMenuItem;
    Menu_ywcx_spfb: TMenuItem;
    Menu_chart: TMenuItem;
    Menu_chart_ywyxs: TMenuItem;
    Menu_chart_scxs: TMenuItem;
    Menu_chart_spxs: TMenuItem;
    Menu_chart_jh: TMenuItem;
    Menu_chart_th: TMenuItem;
    Menu_chart_kczk: TMenuItem;
    N17: TMenuItem;
    Menu_chart_all: TMenuItem;
    Menu_file_setup: TMenuItem;
    Menu_file_data: TMenuItem;
    Menu_file_data_backup: TMenuItem;
    menu_file_data_resume: TMenuItem;
    Menu_file_rights: TMenuItem;
    Panel_main: TPanel;
    Menu_bassmessage_user: TMenuItem;
    Menu_bassmessage_depot: TMenuItem;
    Query_menu: TQuery;
    menu_file_about: TMenuItem;
    ToolBar1: TToolBar;
    Panel1: TPanel;
    ImageList1: TImageList;
    TB_backup: TToolButton;
    TB_GoodsInfo: TToolButton;
    TB_DepotInfo: TToolButton;
    TB_daysell: TToolButton;
    TB_YWYxsfx: TToolButton;
    TB_lskc: TToolButton;
    TB_spxstj: TToolButton;
    TB_jxcmx: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    TB_spfb: TToolButton;
    TB_about: TToolButton;
    ToolButton16: TToolButton;
    Menu_ywcx_thcx: TMenuItem;
    Menu_ywcx_scthtj: TMenuItem;
    Menu_ywcx_ckthtj: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Menu_file_setupClick(Sender: TObject);
    procedure Menu_file_rightsClick(Sender: TObject);
    procedure Menu_file_data_backupClick(Sender: TObject);
    procedure Menu_bassmessage_adminClick(Sender: TObject);
    procedure Menu_bassmessage_goodsClick(Sender: TObject);
    procedure Menu_data_daysellClick(Sender: TObject);
    procedure Menu_bassmessage_userClick(Sender: TObject);
    procedure Menu_data_jhlrClick(Sender: TObject);
    procedure Menu_ywcx_ywyxstjClick(Sender: TObject);
    procedure Menu_chart_ywyxsClick(Sender: TObject);
    procedure Menu_chart_scxsClick(Sender: TObject);
    procedure Menu_bassmessage_depotClick(Sender: TObject);
    procedure Menu_data_depotjhClick(Sender: TObject);
    procedure Menu_data_depotthClick(Sender: TObject);
    procedure Menu_data_jhthClick(Sender: TObject);
    procedure Menu_data_xsthClick(Sender: TObject);
    procedure Menu_ywcx_scxstjClick(Sender: TObject);
    procedure Menu_ywcx_cpxstjClick(Sender: TObject);
    procedure Menu_ywcx_scjhtjClick(Sender: TObject);
    procedure Menu_ywcx_ckjhtjClick(Sender: TObject);
    procedure Menu_ywcx_sckcsptjClick(Sender: TObject);
    procedure Menu_ywcx_sclskccxClick(Sender: TObject);
    procedure Menu_ywcx_scspjxcmxClick(Sender: TObject);
    procedure Menu_ywcx_spfbClick(Sender: TObject);
    procedure Menu_file_exitClick(Sender: TObject);
    procedure menu_file_aboutClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Panel_mainConstrainedResize(Sender: TObject; var MinWidth,
      MinHeight, MaxWidth, MaxHeight: Integer);
    procedure Panel_mainMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure TB_aboutClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;
  S_name: string;     //公司名称
  S_username: string; //公司联系人
  S_cotel: string;    //公司电话
  S_address: string;  //公司地址
  S_autosave: string; //1-自动保存数据,0或其它-手工保存数据
  S_savedays: string; //数据自动保存天数
  S_RegTree: string;  //注册表路径
  I_countdate: integer; //默认结算日期
  CPXSGL: string;     //系统数据库
  USERRIGHTS: string; //权限
  USERRIGHTSNAME: string; //权限名
  USERNAME: string;   //操作员
implementation

uses SetupFormUnit, LoginUnit, LogoUnit, FunctionUnit, RightManageUnit,
  BackUpUnit, OperInfoUnit, GoodsInfoUnit, DaySellUnit, YWYInfoUnit,
  BuyGoodsUnit, QueryYWYSellUnit, ChartSaleUnit, ChartSaleSCUnit,
  DepotInfoUnit, DepotjhUnit, DepotthUnit, scjhUnit, scthUnit, xsthUnit,
  QueryscSellUnit, QueryspSellUnit, QueryscjhUnit, QueryckjhUnit,
  QuerylskccxUnit, QuerysckctjUnit, QueryspjxcUnit, QueryspfbUnit,
  AboutUnit, PrograssUnit;

{$R *.dfm}


procedure TMainForm.FormCreate(Sender: TObject);
var
  reg: TRegistry;
  NumSec: SmallInt;
  StartTime: TDateTime;
label Systemsetup;
begin
  S_RegTree := '\Software\SPXS\SPXSGL'; //设定系统注册表位置
  numsec := 1; //延时1秒
  StartTime := now;
  repeat
    application.ProcessMessages;
  until Now > StartTime + NumSec * (1 / 24 / 60 / 60);

  Systemsetup: //重新设置信息时的入口
  reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  try
    if (Reg.OpenKey(S_RegTree, False)) = False then
    begin
             // 如果注册表中没有信息则创建初始化信息
             //打开公司信息设置窗口
      Application.CreateForm(TSetupForm, SetupForm);
      with SetupForm do
      begin
        sb_stop.Visible := true;
        Caption := Caption + '(初始化设置)';
        showmodal;
        free;
      end;
    end;
    Reg.OpenKey(S_RegTree, True);
    S_name := reg.ReadString('Coname');
    S_username := reg.ReadString('username');
    S_cotel := reg.ReadString('Cotel');
    S_address := reg.ReadString('address');
    S_autosave := reg.Readstring('autosave');
    S_savedays := reg.Readstring('savedays');
    CPXSGL := reg.ReadString('Datapath');
    if CPXSGL = '【系统默认】' then
    begin
      CPXSGL := ExtractFileDir(Application.ExeName);
      if (StrLen(PChar(CPXSGL)) <> 3) then
        CPXSGL := CPXSGL + '\DATA\'
      else
        CPXSGL := CPXSGL + 'DATA\';
    end;
    if (trim(s_name) = '') then
    begin
      reg.DeleteKey(S_RegTree);
      reg.CloseKey;
      reg.Free;
      halt;
    end;
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
   //检测数据库
  if not DirectoryExists(CPXSGL) then //指定目录不存在
  begin
    messagedlg('指定数据库目录路径不存在,尝试调用默认数据库目录!', mtWarning, [mbok], 0);
    CPXSGL := ExtractFileDir(Application.ExeName);
    if (StrLen(PChar(CPXSGL)) <> 3) then
      CPXSGL := CPXSGL + '\DATA\'
    else
      CPXSGL := CPXSGL + 'DATA\';
    if not DirectoryExists(CPXSGL) then
    begin
      messagedlg('系统在尝试默认数据库目录后发现:' + #13 + #13 + '系统默认数据库目录不存在或名称不对!'
        + #13 + #13 + '系统将终止运行,请重新进行系统设置。', mtError, [mbok], 0);
      Application.CreateForm(TSetupForm, SetupForm);
      with SetupForm do
      begin
        sb_stop.Visible := true;
        Caption := Caption + '(初始化设置)';
        showmodal;
        free;
      end;
      goto Systemsetup;
    end
    else
    begin
      messagedlg('系统正在尝试调用默认数据库目录。' + #13 + #13 + '此信息在下次启动系统可能还会出现!'
        + #13 + #13 + '要想解决此问题,请在进入系统后重新进行系统设置。', mtInformation, [mbok], 0);
    end;
  end;

  self.Caption := Application.Title + ' - ' + S_name + '【' + CPXSGL + '】';
  application.HintPause := 500;
  StatusBar_main.Panels.Items[1].Text := '版权所有 ';
  StatusBar_main.Panels.Items[2].Text := '现在时间:' + DateTimeToStr(now);
end;

procedure TMainForm.Menu_file_setupClick(Sender: TObject);
begin
  if not Checkrights(USERRIGHTS, '系统设置') then
  begin
    messagedlg(Errormsg0006 + '0007', mterror, [mbok], 0);
    exit;
  end;
  application.CreateForm(TSetupForm, SetupForm);
  SetupForm.showmodal;
  SetupForm.Free;

end;

procedure TMainForm.Menu_file_rightsClick(Sender: TObject);
begin
  if not Checkrights(USERRIGHTS, '高级') then
  begin
    messagedlg(Errormsg0006 + '0007', mterror, [mbok], 0);
    exit;
  end;
  application.CreateForm(TRightManageForm, RightManageForm);
  RightManageForm.showmodal;
  RightManageForm.free;
end;

procedure TMainForm.Menu_file_data_backupClick(Sender: TObject);
begin
  if not Checkrights(USERRIGHTS, '高级') then
  begin
    messagedlg(Errormsg0006 + '0007', mterror, [mbok], 0);
    exit;
  end;
  application.CreateForm(TBackUpForm, BackUpForm);
  BackUpForm.ShowModal;
  BackUpForm.free;
end;

procedure TMainForm.Menu_bassmessage_adminClick(Sender: TObject);
begin
  if Checkrights(USERRIGHTS, '查看') then
  begin
    Application.CreateForm(TOperInfoForm, OperInfoForm);
    OperInfoForm.showmodal;
    OperInfoForm.free;
  end
  else
    messagedlg(Errormsg0006 + '0007', mterror, [mbok], 0);
end;

//调用商品信息查询窗口
procedure TMainForm.Menu_bassmessage_goodsClick(Sender: TObject);
begin
  if not Checkrights(USERRIGHTS, '查看') then
  begin
    messagedlg(Errormsg0006 + '0007', mterror, [mbok], 0);
    exit;
  end;
  application.CreateForm(TGoodsInfoForm, GoodsInfoForm);
  GoodsInfoForm.showmodal;
  GoodsInfoForm.free;
end;

procedure TMainForm.Menu_data_daysellClick(Sender: TObject);
//调用日销售数据录入窗口
begin
  if not Checkrights(USERRIGHTS, '增加') then
  begin
    messagedlg(Errormsg0006 + '0007', mterror, [mbok], 0);
    exit;
  end;
  application.CreateForm(TDaySellForm, DaySellForm);
  //将窗口嵌入主窗体的panel中
  DaySellForm.Dock(panel_main, BoundsRect);
  DaySellForm.show;
end;

procedure TMainForm.Menu_bassmessage_userClick(Sender: TObject);
begin
  if not Checkrights(USERRIGHTS, '查看') then
  begin
    messagedlg(Errormsg0006 + '0007', mterror, [mbok], 0);
    exit;
  end;
  application.CreateForm(TYWYInfoForm, YWYInfoForm);
  YWYInfoForm.showmodal;
  YWYInfoForm.free;
end;

procedure TMainForm.Menu_data_jhlrClick(Sender: TObject);
begin
  if not Checkrights(USERRIGHTS, '增加') then
  begin
    messagedlg(Errormsg0006 + '0007', mterror, [mbok], 0);
    exit;
  end;
  application.CreateForm(TscjhForm, scjhForm);

  scjhForm.Dock(panel_main, BoundsRect);
  scjhForm.show;
end;

procedure TMainForm.Menu_ywcx_ywyxstjClick(Sender: TObject);
begin
  if not Checkrights(USERRIGHTS, '查看') then
  begin

⌨️ 快捷键说明

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