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

📄 main.pas

📁 DELPHI编写的商场收银POS机源代码
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit main;
 
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Menus, ComCtrls, jpeg, Buttons, ToolWin, StdCtrls;

type
  TFMMAIN = class(TForm)
    MainMenu1  : TMainMenu;
    N1         : TMenuItem;
    M_B        : TMenuItem;
    SYSQUIT    : TMenuItem;
    BMAN       : TMenuItem;
    SYSSET: TMenuItem;
    SYSLOG: TMenuItem;
    Timer1: TTimer;
    StatusBar: TStatusBar;
    SYSABOUT: TMenuItem;
    BMEM: TMenuItem;
    BSUP: TMenuItem;
    N44: TMenuItem;
    BGDS: TMenuItem;
    N48: TMenuItem;
    N3: TMenuItem;
    M_INVT: TMenuItem;
    N8: TMenuItem;
    M_T: TMenuItem;
    N10: TMenuItem;
    M_FMPOSM: TMenuItem;
    M_FMPOSN: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    N19: TMenuItem;
    MTBA: TMenuItem;
    MTBB: TMenuItem;
    N24: TMenuItem;
    N39: TMenuItem;
    N40: TMenuItem;
    ACLEVER: TMenuItem;
    AARGOX: TMenuItem;
    N64: TMenuItem;
    N61: TMenuItem;
    POSAPAIDE: TMenuItem;
    N66: TMenuItem;
    N67: TMenuItem;
    N70: TMenuItem;
    N71: TMenuItem;
    N76: TMenuItem;
    N78: TMenuItem;
    N79: TMenuItem;
    N80: TMenuItem;
    N81: TMenuItem;
    N82: TMenuItem;
    N83: TMenuItem;
    M_FMPOSO: TMenuItem;
    M_FMPOSP: TMenuItem;
    BCST: TMenuItem;
    N12: TMenuItem;
    M_RPPOS1: TMenuItem;
    M_RPPOS2: TMenuItem;
    M_RPPOS3: TMenuItem;
    N20: TMenuItem;
    M_RPPOS5: TMenuItem;
    M_RPPOS6: TMenuItem;
    SYSABOUT1: TMenuItem;
    M_FMRCINB: TMenuItem;
    M_FMRCIN: TMenuItem;
    M_FMRCON: TMenuItem;
    M_FMRCONB: TMenuItem;
    M_FMRCII: TMenuItem;
    M_FMRCOI: TMenuItem;
    N23: TMenuItem;
    M_RPRCIN: TMenuItem;
    M_RPRCON: TMenuItem;
    W1: TMenuItem;
    O1: TMenuItem;
    N9: TMenuItem;
    N26: TMenuItem;
    N212311: TMenuItem;
    N33: TMenuItem;
    N35: TMenuItem;
    N43: TMenuItem;
    N53: TMenuItem;
    N210: TMenuItem;
    N310: TMenuItem;
    M_RPPOSD: TMenuItem;
    N57: TMenuItem;
    N58: TMenuItem;
    M_ACUSSET: TMenuItem;
    M_ACUS_LABEL: TMenuItem;
    N62: TMenuItem;
    M_ASQA1: TMenuItem;
    M_ASQA2: TMenuItem;
    M_ASQA3: TMenuItem;
    M_ASQA4: TMenuItem;
    M_ASQA5: TMenuItem;
    N410: TMenuItem;
    N52: TMenuItem;
    N312: TMenuItem;
    N65: TMenuItem;
    N11: TMenuItem;
    N37: TMenuItem;
    N73: TMenuItem;
    N75: TMenuItem;
    N77: TMenuItem;
    N84: TMenuItem;
    N211: TMenuItem;
    M_RPPOS7: TMenuItem;
    N86: TMenuItem;
    POSARUNLG: TMenuItem;
    BNENOMSG: TMenuItem;
    ToolBar1: TToolBar;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    ToolButton1: TToolButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    SpeedButton9: TSpeedButton;
    BTNQUT: TSpeedButton;
    Image_BG: TImage;
    BTNRPT: TSpeedButton;
    INVOICE: TMenuItem;
    DCOLLECT: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure SYSQUITClick(Sender: TObject);
    procedure SYSSETClick(Sender: TObject);
    procedure BMEMClick(Sender: TObject);
    procedure BCSTClick(Sender: TObject);
    procedure BMANClick(Sender: TObject);
    procedure BSUPClick(Sender: TObject);
    procedure BGDSClick(Sender: TObject);
    procedure M_FMRCINClick(Sender: TObject);
    procedure M_INVTClick(Sender: TObject);
    procedure SYSABOUTClick(Sender: TObject);
    procedure N19Click(Sender: TObject);
    procedure N67Click(Sender: TObject);
    procedure ACLEVERClick(Sender: TObject);
    procedure N83Click(Sender: TObject);
    procedure M_FMPOSMClick(Sender: TObject);
    procedure M_FMPOSNClick(Sender: TObject);
    procedure N78Click(Sender: TObject);
    procedure N81Click(Sender: TObject);
    procedure M_RPPOSDClick(Sender: TObject);
    procedure M_RPPOS1Click(Sender: TObject);
    procedure M_RPPOS2Click(Sender: TObject);
    procedure M_RPPOS3Click(Sender: TObject);
    procedure M_RPPOS5Click(Sender: TObject);
    procedure M_RPPOS6Click(Sender: TObject);
    procedure M_RPPOS7Click(Sender: TObject);
    procedure N39Click(Sender: TObject);
    procedure N40Click(Sender: TObject);
    procedure N211Click(Sender: TObject);
    procedure M_FMRCINBClick(Sender: TObject);
    procedure INVOICEClick(Sender: TObject);
    procedure AARGOXClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SYSLOGClick(Sender: TObject);
    procedure BTNQUTClick(Sender: TObject);
    procedure N76Click(Sender: TObject);
    procedure DCOLLECTClick(Sender: TObject);
    procedure BTNRPTClick(Sender: TObject);
  private
    { Private declarations }
    CREATE_LOGIN : BOOLEAN;
  public
    { Public declarations }
    PROCEDURE CREATE_LBDS(T_FILENAME:STRING);
  end;


var
  FMMAIN: TFMMAIN;

implementation

uses INIFILES, FILECTRL, UN_UTL, FM_UTL, DB_UTL, SYSINI,
     Mapi,


     UNBMAN, UNBMAND, //人事模块
     UNBGDS, UNBGDSD, //产品模块
     UNBMEM, UNBMEMD, //会员模块
     UNBSUP, UNBSUPD, //厂商模块
     UNBCST, UNBCSTD, //客户模块


     UNPOSM, UNPOSMD, //特价模块
     UNPOSN, UNPOSND, //组合模块


     UNRCIN, UNRCIND, //进货模块
     UNRCJN, UNRCJND, //进货退货模块


     UNRPTX, //报表主选单模块

     RPPOSDF,    //销售日报表
     RPPOS1F,    //销售记录明细表
     RPPOS2F,    //发票记录明细表
     RPPOS3F,    //会员消费记录明细表
//     RPPOS4F, RPPOS4P,                      //仓库销售计算报表
     RPPOS5F,    //会员消费计算报表
     RPPOS6F,    //产品销售计算报表
     RPPOS7F,    //礼券刷卡明细表

     RPTOP1F,    // 产品销售排行搒
     RPTOP2F,    // 会员销售排行搒
     RPTOP3F,    // 客户销售排行搒
     RPLOGF,     // 使用者登录表


     UNIVTX, //盘点主选单模块

     UNCCAW, //模彩抽奖
     UNKCLR, //历史资料清除

     UNLBDS, //标签排版程序
     UNREP1, //报表排版程序

     URCOLLECT, // 设置 资料收集器
     URCLEVER, // 设置 CLEVER
     URARGOX,  // 设置 ARGOX
     URINVOICE,  // 设置 发票机

     UNABOUT,
     LOGO,
     SYSLOG,   // LOGIN
     UNEMAIL,  // 问题响应栏

     MAIND,
     MAINS,
     MAINR,  //登录程序
     MAINU;


{$R *.DFM}


PROCEDURE TFMMAIN.CREATE_LBDS(T_FILENAME:STRING);
begin
  //设置档案  //打印标签
  IF FormExists('FRARGOX')  =FALSE THEN Application.CreateForm(TFRARGOX,  FRARGOX  );
  IF FormExists('FRCLEVER') =FALSE THEN Application.CreateForm(TFRCLEVER, FRCLEVER );
  IF FormExists('FMLBDS')   =FALSE THEN Application.CreateForm(TFMLBDS,   FMLBDS   );

  FMLBDS.HIDE;
  FMLBDS.QR_NAME := T_FILENAME;
  FMLBDS.LOAD_INI;
end;

procedure TFMMAIN.FormCreate(Sender: TObject);
VAR T : Tinifile;     // LOG FILE
    INIFILENAME: STRING;
    PATHNAME , T_PATH: STRING;
    SERVER_KIND : STRING;
    I : INTEGER;
begin
  VAR_DECLARE_INI;  //设置系统变量
  /////////////////////////////////VAR_DECLARE_ODBC; //设置 ODBC


  //INIFILENAME := _SYS_PATH_INI + 'MAIN.INI';
  //IF FileExists(INIFILENAME) = FALSE  THEN FILE_CREATE(INIFILENAME);

  //第一次激活系统
  INIFILENAME := _SYS_PATH_INI + 'START.INI';
  IF FileExists(INIFILENAME) = FALSE  THEN
     BEGIN
     FILE_CREATE(INIFILENAME);
     //检查目录是否存在
     T_PATH := ExtractFilePath(Application.EXEName)+ '\DATAIN';
     IF NOT DirectoryExists(T_PATH) THEN CreateDir(T_PATH);
     T_PATH := ExtractFilePath(Application.EXEName)+ '\DATAOUT';
     IF NOT DirectoryExists(T_PATH) THEN CreateDir(T_PATH);
     T_PATH := ExtractFilePath(Application.EXEName)+ '\INI';
     IF NOT DirectoryExists(T_PATH) THEN CreateDir(T_PATH);
     T_PATH := ExtractFilePath(Application.EXEName)+ '\LOG';
     IF NOT DirectoryExists(T_PATH) THEN CreateDir(T_PATH);
  
  
  
  
     END;
  
  
  
  
  TRY
     FMMAIND.Database.Connected := TRUE; // 连接数据库
  EXCEPT
    SHOWMESSAGE('数据库无法连接, 请设置好数据库再重新激活!');
    CLOSE;
  END;
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  //资料设置   //系统默认值 ============================================
  
  
  _SYS_CFG_DBKIND   := UNSET_READ_SIN ('_SYS_CFG_DBKIND' ); // 数据库种类
  _SYS_CFG_BARPRN   := UNSET_READ_SIN ('_SYS_CFG_BARPRN' ); // 条形码机,预设机型
  
  
  //日期值(ACCESS和SQL SEVER替换)
  IF (_SYS_CFG_DBKIND <> 1)  THEN
     BEGIN
     _DBKIND  := 'ACCESS';  // SERVER KIND (ACCESS和SQL SEVER替换)
     _DT      := '#';
     END ELSE BEGIN
     _DBKIND  := 'SQLSERVER';  // SERVER KIND (ACCESS和SQL SEVER替换)
     _DT      := '''';
     END;
  
  
  //使用者资料
  _USER_CORP_RBPST  := UNSET_READ_SME ('_SYS_CORP_RBPST' );
  _USER_CORP_NAME   := UNSET_READ_SME ('_SYS_CORP_NAME' );
  _USER_CORP_NO     := UNSET_READ_SME ('_SYS_CORP_NO' );
  _USER_CORP_TEL    := UNSET_READ_SME ('_SYS_CORP_TEL' );
  _USER_CORP_FAX    := UNSET_READ_SME ('_SYS_CORP_FAX' );
  _USER_CORP_ADDR   := UNSET_READ_SME ('_SYS_CORP_ADDR' );
  _USER_CORP_EMAIL  := UNSET_READ_SME ('_SYS_CORP_EMAIL' );
  _USER_CORP_WWW    := UNSET_READ_SME ('_SYS_CORP_WWW' );
  
  
  
  {
  
  //标签路径设置
  _QRBGDS   := UNSETREAD('SYSSET','SET_QRBGDS');
  _QRBMEM   := UNSETREAD('SYSSET','SET_QRBMEM');
  _QRBMAD   := UNSETREAD('SYSSET','SET_QRBMAD');
  
  //仓库设置
  IF UNSETREAD('SYSSET','CORP_RBPST')='' THEN UNSETWRITE('SYSSET','CORP_RBPST','A01');
  _SYS_RBPST := UNSETREAD('SYSSET','CORP_RBPST');
  
  IF UNSETREAD('SYSSET','S_VER1')='0' THEN M_B .Visible := FALSE;
  IF UNSETREAD('SYSSET','S_VER2')='0' THEN M_T .Visible := FALSE;
  IF UNSETREAD('SYSSET','S_VER3')='0' THEN BMEM.Visible := FALSE;
  IF UNSETREAD('SYSSET','S_POSM')='0' THEN M_FMPOSM.Visible := FALSE;
  IF UNSETREAD('SYSSET','S_POSN')='0' THEN M_FMPOSN.Visible := FALSE;
  IF UNSETREAD('SYSSET','S_POSO')='0' THEN M_FMPOSO.Visible := FALSE;
  IF UNSETREAD('SYSSET','S_POSP')='0' THEN M_FMPOSP.Visible := FALSE;
  
  
  //结帐 - 会员/客户
  POSA_BMENO := STRTOINTDEF(UNSETREAD('SYSSET','POSA_BMENO'),0);
  IF POSA_BMENO = 1 THEN  M_RPPOS3.Caption := '&_ 客户消费明细表';
  
  //流动客分析资料 = MENU
  IF UNSETREAD('SYSSET','SET_ACUS') ='1' THEN
     BEGIN
     ACUS_ASQA1 := UNSETREAD('ACUS','ASQA1');
     ACUS_ASQA2 := UNSETREAD('ACUS','ASQA2');
     ACUS_ASQA3 := UNSETREAD('ACUS','ASQA3');
     ACUS_ASQA4 := UNSETREAD('ACUS','ASQA4');
     ACUS_ASQA5 := UNSETREAD('ACUS','ASQA5');
     ACUS_ASQB1 := UNSETREAD('ACUS','ASQB1');
     ACUS_ASQB2 := UNSETREAD('ACUS','ASQB2');
     ACUS_ASQB3 := UNSETREAD('ACUS','ASQB3');
     ACUS_ASQB4 := UNSETREAD('ACUS','ASQB4');
     ACUS_ASQB5 := UNSETREAD('ACUS','ASQB5');
     if ACUS_ASQA1 ='' then M_ASQA1.Visible := FALSE ELSE M_ASQA1.Caption := ACUS_ASQA1;
     if ACUS_ASQA2 ='' then M_ASQA2.Visible := FALSE ELSE M_ASQA2.Caption := ACUS_ASQA2;
     if ACUS_ASQA3 ='' then M_ASQA3.Visible := FALSE ELSE M_ASQA3.Caption := ACUS_ASQA3;
     if ACUS_ASQA4 ='' then M_ASQA4.Visible := FALSE ELSE M_ASQA4.Caption := ACUS_ASQA4;
     if ACUS_ASQA5 ='' then M_ASQA5.Visible := FALSE ELSE M_ASQA5.Caption := ACUS_ASQA5;
     END;
  }
  
  
  
  
  //检查试用期//==========================================================
  IF IsCPUID_Available = FALSE THEN BEGIN SHOWMESSAGE('对不起, 此软件不适用于您的计算机!');  CLOSE;   EXIT;   END;
  IF REGISTER_KEY_CHECK('\Software\WEB')= FALSE THEN REGISTER_POS_CREATE('\Software\WEB');
  StatusBar.Panels.Items[2].Text := '计算机机种: '+GetCPUVendor;
  
  
  FMMAIN.Height := 150;
  I := UNSET_READ_SIN('_SYS_SET_MAINHT');
  IF I >=150 THEN FMMAIN.Height := I;
  T_STR := UNSET_READ_SST('_SYS_SET_MAINCR');
  IF T_STR <> '' THEN FMMAIN.COLOR := STRINGTOCOLOR(T_STR);
  FMMAIN.Caption := UNSET_READ_SME('_SYS_SET_MAINCP');
end;

procedure TFMMAIN.FormShow(Sender: TObject);
VAR I         : INTEGER;
    T_USES_DAY: REAL;
    T_BG : STRING;
begin

  IF REGISTER_KEY_VALUE_STR('\Software\WEB','SF_ID') <> REGISTER_NUMBER_POS(GetCPUID[4]) THEN
     BEGIN
     IF FormExists('FMAINR')=FALSE THEN Application.CreateForm(TFMMAINR, FMMAINR );
     FMMAINR.SHOWMODAL;
  
     //看看是否过期
     T_USES_DAY := DATE - REGISTER_KEY_VALUE_DATE('\Software\WEB','RUN_FIRST_DATE');
     {IF (T_USES_DAY > 90) OR (T_USES_DAY <  0) THEN}  // 90天限制
     if False then                                     // 无任何使用时间限制!!!
        BEGIN
        SHOWMESSAGE('本软件为标准版, '+#10#13+'若要合法并享用售后服务, 请洽本公司 !');
        CLOSE;
        EXIT;
        END;
  
     END ELSE BEGIN // 已登录完成
     IF FileExists('\SYSTEM.SYS') = FALSE  THEN FILE_CREATE('\SYSTEM.SYS');
     END;
  
  
  

⌨️ 快捷键说明

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