syspublic.~pas

进销存管理 编译环境Delphi7+Win2000 用到的控件 ReportMachine2.6 InfoPower4000Pro_vcl7 RxLib2.7 SkinEngine 3

function MsgBox(Text, Caption: string; Flags: Longint = MB_OK): Integer;
//返回Windows\system目录
function GetSystemDir: string;
//返回执行文件路径
function GetExePath: string;
//返回执行文件名称
function GetExecFileName: string;
//设置账套文件路径
function SetDataPathName(sPath, sName: string): Boolean;
//返回账套文件路径
function GetDataPathName: string;
//返回文本文件有多少行
function LoadTxtFileCount(sFile: string): Integer;
//读文本文件的一行
function LoadTxtFileRow(sFile: string; lRow: Integer): string;
//发SMTP邮件
function SmtpSendMail(FromAddress, ToAddress, ASubject, MsgBody: string): Boolean;
//注册ID菜单
function RegisryIE_Menu: Boolean;
//注册关联文件
function RegFileJoint(sCaption, sFile, sExeFile: string): Boolean;
//返回汉字的拼音
function GetPY(sHZ: string): string;
//返回汉字的拼音1
function GetPY1(sHZ: string): string;
//返回字符串类型HZ,Str,Int,PY,Date
function GetStringType(sText: string): string;
//压缩Access数据库
function CompactDatabase(sDBFile: string): Boolean;
//启用账套
function SetStartAccount(bStart: Boolean = True): Boolean;
//压缩账套
function CompactAccountDataBase: Boolean;
//返回ADO连接旧Access串
function GetConnectionStringOld(sSource: string): string;
//返回ADO连接Access串
function GetConnectionString(sSource: string): string;
//返回ADO连接SQLServer串
function GetSQLConnectionString(sServer, sData, sUser, sPass: string): string;
//系统起动初始化
procedure ControlInitialize;
//保存操作日志
function SaveOperateLog(sTitle: string): Boolean;
//转换为可显示加密串
function StringToDisplay(mString: string): string;
//转换为不可显示加密串
function DisplayToString(mDisplay: string): string;
//字符串加密
function StringEncrypt(mStr: string; mKey: string): string;
//字符串解密
function StringDecrypt(mStr: string; mKey: string): string;
//模拟系统按键;
procedure SendKey(const mKey: Word; mShiftState: TShiftState; mCount: Integer = 1);
//样式TO字符串
function LookAndFeelToString(dxLook: TdxLookAndFeel): string;
//字符串TO样式
function StringToLookAndFeel(sLook: string): TdxLookAndFeel;
//打开DataSet
function OpenDataSetEx(ADOConnet: TADOConnection; DataSet: TADODataSet; szSql: string): Boolean;
//打开DataSet(默认ADOConnet)
function OpenDataSet(DataSet: TADODataSet; szSql: string): Boolean;
//返回数据库条数
function GetDataSetCount(sSql: string): Integer;
//反回数据库条数高级
function GetDataSetCountEx(ADOConnet: TADOConnection; sSql: string): Integer;
//返回数据库是否为空
function GetDataSetEmpty(sSql: string): Boolean;
//返回数据库是否为空高级
function GetDataSetEmptyEx(ADOConnet: TADOConnection; sSql: string): Boolean;
//复制单据反回新单据ID
function CopyBill(lBillMode, lType, lBillID: Integer): Integer;
//拷贝文件
function CopyFileEx(sSou, sTar: string): Boolean;
//得到所有子目录列表
function GetAllSubDir(Directory: string; var RetList: TStringList): Boolean;
//得到所有子目录文件列表
function GetAllDirFile(Directory: string; var RetList: TStringList): Boolean;
//发送一个消息
procedure SendMsg(hWnd, Msg, wParam: Integer; lParam: Integer = 0);
//压缩一个目录
function ZipDir(sDir, sFile: string): Boolean;
//解压一个目录
function UnZipDir(sFile, sDir: string): Boolean;
//是否在程序调试
function GetIsDebug: Boolean;
//以Bat方式执行一个文件
function ExecBatFile(sFile: string): Boolean;
//执行一个文件
function ExecFile(sFile: string): Boolean;
//删除目录或文件
function DelDir(sDir: string): Boolean;
//拷贝目录或文件
function CopyDir(sSources, sNew: string): Boolean;
//移动目录或文件
function MoveDir(sSources, sNew: string): Boolean;
//重命名目录或文件
function RenDir(sSources, sNew: string): Boolean;
//复制元件
function CopyComponent(mSource: TComponent; mParent: TComponent; mOwner: TComponent): Boolean;
//另存资源
function ResSave(sPath, sRcName: string): boolean;
//另存主数据库
function ResSaveMainDB(sPath, sRcName, sFileName: string): boolean;
//得到Access2000的密码
function GetAccess2000Password(FilePath: string): string;
//捕获屏幕
procedure SnapScreen(mStream: TMemoryStream);
//平埔图片
function DrawCanvasJpg(Img: TImage; sFile: string): Boolean;
//执行计算器
procedure WinExecCalc;
//打开Html帮助文件
function HtmlHelp(strFile: string): HWND;
//计算双单位
function GetTwoUnit(sUnit1, sUnit2: string; dQty1, dScale: Double; var dQty2: Double): string;
//得到发票类型
function GetBaseInvoiceType: string;
//DataSet查找定位
function DataSetLocate(DataSet: TADODataSet; sField: string; vValue: Variant): Boolean;
//EDIT为空检查
function CheckEditEmpty(lMsg: Integer; Form1: TForm; AsLabel, AsEdit: array of string): Boolean;
//主机域名解析为IP地址
function HostToIP(Name: string): string;
//IP地址解析为主机域名
function IPToHost(IPAddr: string): string;
//得到本机名称
function GetLocalHost: string;
//得到系统安装信息
function GetAllSystemInfo: string;
//得到分区序列号
function GetDiskSerial(sDisk: string): string;
//得到硬盘的序列号
function GetIDESerial: string;
//得到主板的序列号(win9x)
function GetMainboardSerial: string;
//得到计算机名称
function GetPCName: string;
//生成注册机器码
function MakeComputerCode: string;
//得到0-9,a-b之间的标准字符
function GetStandardStr(sStr: string): string;
//生成注册号
function MakeRegisterCode(sName, sPcCode: string): string;
//设置所有编辑控件风格
function SetControlStyle(lMode: Integer; cColor: TColor): Integer;
//得到SkinEngine方案文件
function GetSkinEngineFile: string;
//设置SkinEngine方案文件
function SetSkinEngineFile(sFile: string): Boolean;
//内码转换GB2321ToBIG5
function SetGB23ToBIG5(frmForm: TForm): Boolean;
//得到当前焦点控件
function GetFocusedComponent(frmForm: TForm): TComponent;
//设置Panel内控件的焦点
function SetPanelFocused(frmForm: TForm; ksPanel: TSeSkinPanel): string;
//设置控件为SkinEngine风格
function SetSkinEngine(frmForm: TForm): Boolean;
//读注册表值
function GetRegValue(sItem: string): string;
//写注册表值
function SetRegValue(sItem, sValue: string): Boolean;
//表格列配置
function SetCol(sCaption: string; Grid: TdxDBGrid; lInit: Integer): Boolean;
//表格存列宽
function SetColWidth(sCaption: string; Grid: TdxDBGrid): Boolean;
//读饼图设置
function ReadChartSetup(lMode: Integer): string;
//写饼图设置
function WriteChartSetup(lMode: Integer; sChart: string): Boolean;
//数据集倒数据集
procedure DataSetImport(DSSou, DSNew: TDataSet);
//数据集倒数据集
procedure DataSetInput(DataSetSou, DataSetNew: TDataSet; sFieldSou, sFieldNew, sConst: string);
//前导0格式输出
function Format00Str(const count, num: integer): string;
//String转换Int
function StrToInt2(s: string): Integer;
//String转换Float
function StrToFloat2(sStr: string): Double;
//Float转换String
function FloatToStr2(dFloat: Double; sFormat: string = FORMAT_4): string;
//String转换Boolean
function StrToBool2(sStr: string): Boolean;
//向MEMO中当前光标处插入字符串
function MemoAddStart(Memo: TdxMemo; sSpl: string): Boolean;
//事务处理
function BeginTrans: Integer;
procedure CommitTrans;
procedure RollbackTrans;
//恢复SQL数据
function RestoreSQLDB(sDBName, sBak, sMdf, sLdf: string): string;
//DATE转换String
function DateToStr2(Date: TDateTime): string;
//初始化单据配置库
function InitialBillSetup(lMode: Integer): Boolean;
//系统初始化
procedure SystemInitialize;
//系统关闭
procedure SystemClose;

implementation

uses MainWindow, UserLimitForm, DiskSerialNumber, BaseInfo, Base2Info,
  BillQuery, PrintForm, BillEdit, BillSetup, ColSetupForm, DBData, AccountQuery,
  GB2312ToBIG5, DelphiHtmlHelp, LoginForm, FindPublic, FilterPublic, registry,
  IMCode, ReadQuery, RadioGroupForm, DateForm,
  ExistBillEdit, AgentDialog, Base1Info, AccountVoucher;

function LoginShow(sMode: string): Boolean;
begin
  Result := LoginFromShow(sMode);
  if Result then
  begin
    SetStartAccountMenu(frmMainWindow.dxBarManager1);
    if bStartAccount then
      SetMainMenu(frmMainWindow.dxBarManager1);
  end;
end;

function UpdateSoftVar: Boolean;
var
  sSql, sDBVer: string;
begin
  Result := False;
  sDBVer := GetIniValue(frmData.ADOConnet, 'SoftVersion');
  if SOFTWARE_VERSION_NUM <= StrToInt2(sDBVer) then Exit;
  //-------------------版本升级-------------------------------------------------
  sSql := 'DELETE FROM BillSetup';
  ExecSql(sSql);
  sSql := 'UPDATE Ware SET SeedCount=0';
  ExecSql(sSql);
  //-------------------版本升级-------------------------------------------------
  SetIniValue(frmData.ADOConnet, 'SoftVersion', sDBVer);
  Result := True;
end;

function SysReset: Boolean;
begin
  Result := SysResetShow;
end;

function GetDate(var tStartDate, tEndDate: TDateTime): Boolean;
begin
  Result := DateFormShow(tStartDate, tEndDate);
end;

function GetOS: string;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    Result := 'NT'
  else
    Result := '9x';
end;

function SetHeaderCenter(Grid1: TdxDBGrid; ACanvas: TCanvas; ARect: TRect;
  AText: string): Boolean;
var
  X, Y: Integer;
begin
  with ACanvas do
  begin
    Font.Size := 11;
    ARect.Top := ARect.Top - (ARect.Bottom - ARect.Top);
    X := ARect.Left + (ARect.Right - ARect.Left - TextWidth(AText)) div 2;
    Y := ARect.Top + (ARect.Bottom - ARect.Top - TextHeight(AText)) div 2;
    Brush.Color := Grid1.HeaderColor;
    Font.Style := Grid1.Font.Style;
    Font.Color := Grid1.HeaderFont.Color;
    TextRect(ARect, X, Y, AText);
    DrawEdge(Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
    DrawEdge(Handle, ARect, BDR_RAISEDOUTER, BF_BOTTOMRIGHT);
    Result := True;
  end;
end;

function SetBandCenter(Grid1: TdxDBGrid; ABand: TdxTreeListBand; ACanvas:
  TCanvas; ARect: TRect; AText: string): Boolean;
var
  X, Y: Integer;
begin
  with ACanvas do
  begin
    Font.Size := 11;
    X := ARect.Left + (ARect.Right - ARect.Left - TextWidth(AText)) div 2;
    Y := ARect.Top + (ARect.Bottom - ARect.Top - TextHeight(AText)) div 2;
    Brush.Color := Grid1.BandColor;
    Font.Style := Grid1.Font.Style;
    Font.Color := Grid1.BandFont.Color;
    TextRect(ARect, X, Y, AText);
    DrawEdge(Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
    DrawEdge(Handle, ARect, BDR_RAISEDOUTER, BF_BOTTOMRIGHT);
    Result := True;
  end;
end;

function SetEditRead(Form1: TForm; bRead: Boolean): Boolean; //设置控件只读
var
  lCom: Integer;
  edtTemp: TdxInplaceTextEdit;
begin
  edtTemp := nil;
  for lCom := 0 to Form1.ComponentCount - 1 do
  begin
    if Form1.Components[lCom] is TdxInplaceTextEdit then
      edtTemp := TdxInplaceTextEdit(Form1.Components[lCom]);
    if (edtTemp <> nil) and edtTemp.Visible then
      TdxEdit(edtTemp).ReadOnly := bRead;
  end;
  Result := true;
end;

function BaseSelect(lMode, lSelect: Integer; sFilter: string; lParentMode:
  Integer = 0; lOneRet: Integer = 0; sPlusSQL: string = ''): string; //资料选择
var
  lCheck: Integer;
  sSql: string;
begin
  Result := '';
  case lMode of
    BASE_STOCK_ORDER: lCheck := BASE_WARE; //如果是批次选择就看它有没有商品的权限
  else
    lCheck := lMode;
  end;

  if not CheckLimit(lCheck) then
  begin
    ShowMsg('对不起，你没有权限使用此功能！');
    Exit;
  end;

  sSql := 'SELECT * FROM BaseInfo WHERE Mode=' + IntToStr(lMode);
  case lMode of
    BASE_AREA:
      Result := BaseInfoShow(sSql, 'Name1', '地区名称', '', '基础资料-地区',
        sFilter, lMode, lSelect);
    BASE_DEPT:
      Result := BaseInfoShow(sSql, 'Name1,Name2', '部门名称,说明', '',
        '基础资料-部门', sFilter, lMode, lSelect);
    BASE_EMPLOYE_SORT:
      Result := BaseInfoShow(sSql, 'Name1,Name2', '类别名称,说明', '',
        '基础资料-员工类别', sFilter, lMode, lSelect);
    BASE_LEARNING:
      Result := BaseInfoShow(sSql, 'Name1', '学历名称', '', '基础资料-学历',
        sFilter, lMode, lSelect);
    BASE_WARE_SORT:
      Result := BaseInfoShow(sSql, 'Name1,Name2', '类别名称,说明', '',
        '基础资料-商品分类', sFilter, lMode, lSelect);
    BASE_WARE_UNIT:
      Result := BaseInfoShow(sSql, 'Name1,Name2', '计量单位,说明', '',
        '基础资料-商品单位', sFilter, lMode, lSelect);
    BASE_INCOME_TYPE:
      Result := BaseInfoShow(sSql, 'Name1,Name2,Name3', '付款方式,银行,说明',
        '',
        '基础资料-收付款方式', sFilter, lMode, lSelect);
    BASE_CURRENCY_STYLE:
      Result := BaseInfoShow(sSql, 'Name1,Name2,Name3',
        '币种名称,对人民币汇率,说明', '', '基础资料-外币种类', sFilter, lMode,
        lSelect);
    BASE_INCOME_SORT:
      Result := BaseInfoShow(sSql, 'Name1,Name2,Name3', '名称,说明,收入支出',
        '核算收入,核算支出', '基础资料-收入支出类别', sFilter, lMode, lSelect);
    BASE_CASH_BANK:
      Result := BaseInfoShow(sSql, 'Name1,Name2,Name3',
        '账户名称,银行全名,银行账号', '', '基础资料-现金银行', sFilter, lMode,
        lSelect);
    BASE_FIXED_SORT:
      Result := BaseInfoShow(sSql, 'Name1,Name2', '类别名称,说明', '',
        '基础资料-固定资产类别', sFilter, lMode, lSelect);
    BASE_FIXED_MODE:
      Result := BaseInfoShow(sSql, 'Name1,Name2,Name3',
        '方式名称,说明,增减方式',
        '固定资产增加,固定资产减少', '基础资料-固定资产增减方式', sFilter,
        lMode,
        lSelect);
    BASE_FIXED_USE:
      Result := BaseInfoShow(sSql, 'Name1,Name2,Name3',
        '使用状况名称,说明,是否计提折旧', '计提折旧,不计提折旧',
        '基础资料-固定资产使用状况', sFilter, lMode, lSelect);
    BASE_WAGE_KIND:
      Result := BaseInfoShow(sSql, 'Name1', '工种', '', '基础资料-计件工种',
        sFilter, lMode, lSelect);
    BASE_CHANGE_TYPE:
      Result := BaseInfoShow(sSql, 'Name1,Name2', '类型名称,说明', '',
        '基础资料-库存变动类型', sFilter, lMode, lSelect);
    BASE_NARRATE:
      Result := BaseInfoShow(sSql, 'Name1', '说明、摘要', '',
        '基础资料-说明摘要', sFilter, lMode, lSelect);
    BASE_STOCK_ORDER:
      begin
        sSql := ' SELECT Ws.ID,0 as TreeParent, W.UserCode, W.Name, WS.Number, WS.Price,'
          +
          ' Sum(WS.Number*WS.Price) AS SumTotal, WS.Order' +
          ' FROM Ware AS W INNER JOIN WareStock AS WS ON W.ID = WS.WareID' +
          ' WHERE W.ID=' + sFilter +
          ' GROUP BY Ws.ID,W.UserCode, W.Name, WS.Number, WS.Price, WS.Order';
        Result := Base1InfoShow(sSql,
          'Order,UserCode,Name,Number,Price,SumTotal',
          '批次,商品编号,名称,数量,单价,金额', 'WareStock', 'Order',
          '库存商品批次选择', lMode, lSelect);
      end;
    BASE_CLIENT, BASE_PROVIDE, BASE_EMPLOYE, BASE_WARE, BASE_DEPOT,
      BASE_FIXED_ADD, BASE_FIXED_DEC, BASE_SUBJECT, BASE_WAGE_PROCEDURE,
      BASE_WAGE_ITEM:
      begin
        Result := Base2InfoShow(lMode, lSelect, sFilter, False, lParentMode, lOneRet, sPlusSQL);
      end;
  else
    ShowMsg('内部参数出错,请与开发商联系！');
  end;
end;

function BillSelect(lMode: Integer; lSelect: Integer = 0; bRead: Boolean =