uglobal.pas

简单易用的按件按时计工资管理系统

unit uGlobal;

interface
uses
  Dialogs, Controls, SysUtils, Variants, Forms, DB, DBClient, dxExEdtr, dxCntner,
  dxTL, dxDBCtrl, dxDBGrid, Inifiles, Graphics, Windows, Classes, StdCtrls,
  DateUtils, FMTBcd, dxGrClms, Math;
type
  TBrowserType = (btSingle, btMasterDetail);
  TExportType = (etXls, etCSV, etTxt, etHtm, etXML); //数据导出的类型（xls，cvs，txt，html，xml）
  TOrderState=(osEdit, osAppend);
  TRoundRange = -37..37;                          //四舍五入函数的第二个参数(精度)的数据类型,加强了限制

function CheckDataSet(DataSet: TDataSet): Boolean;
function CheckDataSource(DataSource: TDataSource): Boolean;
procedure EmptyTable(ADS: TClientDataSet);

procedure SetCellAutoWidth(Cell: TDxDBGrid);

function IsNumerField(pField: TField): Boolean;

procedure Pub_GetSegmentSQL(var pSQL: string; var pRowNum: Integer; const pEveryTimeCount: integer);
procedure Pub_Login;
procedure Pub_ExportData(Cell: TDxDBGrid);

function GetSysIniFileName: string;
function GetHistoryPath: string;
function GetUserPath: string;
function GetOrderHisFileName(AorderType: string): string;
function GetOrderHisFileNamePop(AorderType: string): string;
function SectionExists(const IniFileName, Section: string): boolean;

{下面操作,只针对单表查询}
function IncludeFieldName(const pSql, pFieldName: string): boolean;
procedure AnalyseSelect(const pSql: string; var pSelect, pFields, pFrom, pTables, pWhere: string); //分解SQL语句
function GetSaveSQL(const pSQL: string): string;
function GetAllFieldsSelect(const pSQL: string): string; //去掉不存在的字段
function GetRecordCount(const pSQL: string): integer;

procedure OpenWaitingDlg(const pMsg: string = ''; pCancel: Boolean = False);
procedure CloseWaitingDlg;
function FormatSql(Value: string): string;

function TransIconToBmp(AIcon: TIcon): Graphics.TBitmap;
procedure GrayBmp1(Bitmap: Graphics.TBitmap);
procedure GrayBmp2(Bitmap: Graphics.TBitmap; Value: integer);
procedure FullBmp(Canvas: TCanvas; Bmp: Graphics.TBitmap; Width, Height: integer);
procedure Emboss(ABitmap: Graphics.TBitmap; AMount: Integer);

function HtmlHelpA(hwndcaller: Longint; lpHelpFile: string; wCommand: Longint; dwData: string): cardinal; stdcall; external 'hhctrl.ocx'


procedure SetFieldValue(DataSet: TdataSet; Field, Val: string);
function GetFirstDayOfMonth(pDate: TDateTime): TDateTime;
procedure ComSetFieldFormat(pField: TField; pDisplayFormat: string = '');
procedure CreateCellCols(Cell: TDxDBGrid; ACDS:TClientDataSet);
procedure AddCheckColumn(Cell: TDxDBGrid; pFieldName: string);
function CheckCanNotEmptyField(DataSet: TdataSet; pFieldName: string):Boolean;

procedure SetPayItemColumnsInfo(Cell: TDxDBGrid);
procedure SetAllColumnsCanEdit(Cell: TDxDBGrid;pCanEdit:Boolean=False);
function FormatFloat_Ex(const AValue: Extended; const ADigit: TRoundRange = 2): Extended;
function GetFieldSumValue(pDataSet: TclientdataSet; pField: string): Double;
const
  CS_MainTitle = '良方数据查询';
  CS_NotLoginMsg = '（未登录）';
  CS_ConnectFail = '登录失败';
  CS_InitDataWaiting = '正在初始化系统数据，请稍候...';
  CS_MasterIniSectionExt = '_Master';
  CS_DetailIniSectionExt = '_Detail';

  CS_Section_Config = 'Config';
  CS_Indent_EveryTimeCount = 'EveryTimeCount';
  CS_Indent_PopupEveryTimeCount = 'PopupEveryTimeCount';
  CS_Indent_GetAllHintCount = 'GetAllHintCount';
  CS_Ident_ShowFuncRemoteLog = 'ShowFuncRemoteLog ';
  CS_Ident_CustSQLCanEdit = 'CustSQLCanEdit';

  CS_DateTimeFormat = 'YYYY-MM-DD';
  CS_SQLLink_AND = ' AND ';
  CS_SQLLink_WHERE = ' WHERE ';
  CS_SQLLink_FROM = ' FROM ';

  CS_RemoteLog_SQLBegin = '>';

  CS_ModuleCode: array[0..7] of string = (
    '100', //基础数据查询
    '101', //权限数据查询
    '102', //采购数据查询
    '103', //销售数据查询
    '104', //仓库数据查询
    '105', //账务数据查询
    '107', //GSP数据查询
    '108'); //报警数据查询

  CS_ModuleName: array[0..7] of string = (
    '基础数据查询',
    '权限数据查询',
    '采购数据查询',
    '销售数据查询',
    '仓库数据查询',
    '账务数据查询',
    'GSP数据查询',
    '报警数据查询');

  CS_ColName_MasterNo = 'COL_MasterNO';
  CS_ColName_DetailNo = 'COL_DetailNO';
  CS_FieldName_RowNum = 'Row_Num';
  CS_KeyField = 'FID';
  CS_FldName_ID = 'FID'; //编号
  CS_FldName_Code = 'FCODE'; //代码
  CS_FldName_Name = 'FNAME';
  CS_FldName_Field = 'FFIELD';
  CS_FldName_GoodsID = 'FGOODS_ID'; //药品编号
  CS_FldName_GoodsName = 'FGOODS_NAME'; //药品名称
  CS_FldName_GoodsCode = 'FGOODS_CODE'; //药品代码

  CS_FldName_Date = 'FDate';
  CS_FldName_CustID = 'FCust_ID';
  CS_FldName_OrderID = 'FOrder_ID';
  CS_FldName_StockID = 'FStock_ID';
  CS_FldName_BatchNo = 'FBATCH_NO'; //药品的批号
  CS_FldName_BlockNO = 'FBLOCK_NO'; //药品的批次
  CS_FldName_State = 'FState';


  CS_ColName_No = 'COL_NO';
  CS_FldName_Selected = 'FSELECTED'; //是否选中的标记
  CS_Default_Yes = '1';
  CS_Default_No = '0';

  {确定选择方案}
  CS_SelType_All = '0';
  CS_SelType_Selected1 = '1';
  CS_SelType_Selected2 = '2';
  CS_SelType_Selected3 = '3';

  CS_DefVal_Yes = '1';
  CS_DefVal_No = '0';

  {选择目标表的类型}
  CS_TableType_Header = '1';
  CS_TableType_Body = '2';
  CS_TableType_HeaderVW = '3';
  CS_TableType_BodyVW = '4';
  CS_TableType_ALL = '5';

  //基础信息
  CS_OrderType_Cust = '100001001'; //客商
  CS_OrderType_Goods = '104106001'; //药品
  CS_OrderType_Storage = '100009001'; //仓位
  CS_OrderType_StockGoods = '104022001'; //库存药品总览表

  CS_DefStr_Periods: array[0..9] of string = ('当天',
    '近二天',
    '近三天',
    '近一周',
    '近二周',
    '近一月',
    '近六周',
    '近二月',
    '全部',
    '自定义');

  CS_FONT_NAME = '宋体';
  CI_FONT_SIZE = 9;

  CS_ConnStr = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;Persist Security Info=False';
  CS_KeyFieldName='主键';
  CS_OrderIDFieldName='单号';
  CS_SelectFieldName='选择';
  CS_MasterDetailFieldName='主表主键';
  CS_OrderDateFieldName='单据日期';
  CS_PriceFieldName='单价';
  CS_QtyFieldName='数量';
  CS_AmtFieldName='应付工资';
  CS_ItemAmtFieldName='工资';
  CS_RateFieldName='比例';
  CS_EmpIDFieldName='员工主键';
  CS_EmpNameFieldName='姓名';
  CS_TeamIDFieldName='所属组主键';
  CS_TeamNameFieldName='组名';
  CS_NoteFieldName = '备注';

  CS_Table_PayMaster='工资计算单主表';
  CS_Table_PayDetail='工资计算单明细表';
  CS_View_PayMaster='工资计算单主表视图';
  CS_View_PayDetail='工资计算单明细表视图';
  CS_Table_OrderType='单据类型表';
  CS_Table_Employee='员工';
  CS_Table_Team='组';
  CS_View_Employee='员工视图';


  CI_MaxFloatPrecision = 18;   //Delphi里浮点数的最大精度(Extended类型) 不超过18;
  CI_Default_FloatRoundRange =2;
  CI_Default_FloatValue =0.00;
var
  Pub_EveryTimeCount: integer = 500;
  Pub_PopupEveryTimeCount: integer = 50;
  Pub_GetAllHintCount: integer = 5000;
  Pub_ShowFuncRemoteLog: Boolean = False;
  Pub_CustSQLCanEdit: boolean = False;
  Pub_CanNotLogin: boolean = False;
  Pub_LinkTitle: string = CS_NotLoginMsg;
  Pub_ServerName, Pub_ClientName, Pub_UserName: string;
  HaveLogin: boolean = False;
  FirstLogin: boolean = True;

  Pub_KeyFieldValue:string;

implementation

uses uDM, uWaitingDlg, uExportDlg;

function CheckDataSet(DataSet: TDataSet): Boolean;
begin
  Result := False;
  if DataSet = nil then Exit;
  if not DataSet.Active then Exit;
  Result := True;
end;

function CheckDataSource(DataSource: TDataSource): Boolean;
begin
  Result := False;
  if (DataSource = nil) or (DataSource.DataSet = nil) then Exit;
  if not DataSource.DataSet.Active then Exit;
  Result := True;
end;

procedure EmptyTable(ADS: TClientDataSet);
begin
  ADS.DisableControls;
  try
    if not CheckDataSet(ADS) then exit;
    if ADS.IsEmpty then exit;
    while (not ADS.Eof) or (not ADS.Bof) do
      ADS.Delete;
  finally
    ADS.EnableControls;
  end;
end;

procedure SetCellAutoWidth(Cell: TDxDBGrid);
{设置每列的宽度为最合适的宽度}
var
  i: Integer;
begin
  with Cell do
  begin
    for i := 0 to Cell.ColumnCount - 1 do
      Cell.ApplyBestFit(Cell.Columns[i]);
  end;
end;

procedure Pub_GetSegmentSQL(var pSQL: string; var pRowNum: Integer; const pEveryTimeCount: integer);
const
  cSegmentSQL = ' select * from ( select RowNum Row_Num, t.* from (%s) t where RowNum<=%d)  where Row_Num >=%d ';
  //cSegmentSQL = ' select RowNum Row_Num, t.* from (%s) t where RowNum<=%d and RowNum >=%d ';
var
  iEveryTimeCount: integer;
begin
  iEveryTimeCount := pEveryTimeCount;
  if pEveryTimeCount <= 0 then
    iEveryTimeCount := Pub_EveryTimeCount;
  pSQL := Format(cSegmentSQL, [pSQL, pRowNum + iEveryTimeCount, pRowNum + 1]);
  pRowNum := pRowNum + iEveryTimeCount;
end;

function IsNumerField(pField: TField): Boolean;
begin
  Result := False;
  if pField = nil then Exit;
  case pField.DataType of
    ftSmallInt, ftInteger,
      ftWord, ftBytes,
      ftAutoInc, ftLargeint,
      ftFloat, ftCurrency, ftBCD: Result := True
  else Exit;
  end;
end;

procedure Pub_Login;
var
  sDBFileName, sConnectString:string;

begin
  sDBFileName:=ExtractFilePath(Application.ExeName ) + 'DB.MDB';
  sConnectString:=Format(CS_ConnStr,[sDBFileName]);
  with DM do
  begin
    OpenWaitingDlg('正在连接数据库,请稍候...');
    try
      HaveLogin := SetConnect(sConnectString);
      if not HaveLogin then
        Showmessage('连接数据库失败，请检查数据库文件是否存在！');
    finally
      CloseWaitingDlg;
    end;
  end;

  {with TfmDBLogin.Create(nil) do
  begin
    try
      while ShowModal = mrOK do
      begin
        HaveLogin := False;
        try
          with DM do
          begin
            OpenWaitingDlg('正在尝试登录,请稍候...');
            try
              HaveLogin := SetConnect(ConnectString);
              if not HaveLogin then
                continue;
            finally
              CloseWaitingDlg;
            end;
          end;
          SaveConfig;
          Pub_LinkTitle := '(登录：' + ConnectCaption + ')';
          Pub_UserName := edtUser.Text;
          Pub_ServerName := edtHost.Text;
          break;
        except
          on E: Exception do
          begin
            Pub_LinkTitle := CS_NotLoginMsg;
            continue;
          end;
        end;
      end;
    finally
      free;
    end;
  end;}

end;

procedure Pub_ExportData(Cell: TDxDBGrid);
begin
  if Pub_ExportDlg = nil then
    Pub_ExportDlg := TExportDlg.Create(Application);
  Pub_ExportDlg.MasterGrid := nil;
  if CheckDataSource(Cell.DataSource) then
    Pub_ExportDlg.MasterGrid := Cell;

  if (Pub_ExportDlg.MasterGrid <> nil) then
    Pub_ExportDlg.ShowModal;
end;

function GetSysIniFileName: string;
begin
  Result := ExtractFilePath(Application.ExeName) + CS_MainTitle + '.ini';

end;

function GetHistoryPath: string;
begin
  Result := ExtractFilePath(Application.ExeName) + 'History\';
end;

function GetUserPath: string;
begin
  Result := GetHistoryPath + Pub_UserName + '\';
end;

function GetOrderHisFileName(AorderType: string): string;
begin
  Result := GetUserPath + AorderType + '.ini';
end;

function GetOrderHisFileNamePop(AorderType: string): string;
begin
  Result := GetUserPath + AorderType + '_Popup.ini';
end;

function SectionExists(const IniFileName, Section: string): boolean;
begin
  Result := False;
  if (not FileExists(IniFileName)) or (Trim(Section) = '') then exit;
  with TInifile.Create(IniFileName) do
  begin
    try
      Result := SectionExists(Section);
    finally
      Free;
    end;
  end;
end;

function IncludeFieldName(const pSql, pFieldName: string): boolean;
var
  sSql, sFieldName: string;
  p: integer;
  c: char;
begin
  Result := False;
  if (Trim(pSql) = '') or (Trim(pFieldName) = '') then
    exit;
  sFieldName := UpperCase(Trim(pFieldName));
  sSql := UpperCase(Trim(pSql));
  p := pos(sFieldName, sSql);
  while p > 0 do
  begin
    c := sSql[p + length(sFieldName)];
    if (c = #9) or (c = ' ') or (c = ',') then
    begin
      Result := True;
      break;
    end else
    begin
      sSql := copy(sSql, p + length(sFieldName), length(sSql));
      p := pos(sFieldName, sSql);
    end;
  end;

end;

procedure AnalyseSelect(const pSql: string; var pSelect, pFields, pFrom, pTables, pWhere: string);
var
  sSQL: string;
  p: integer;
begin
  sSQL := UpperCase(pSQL);
  p := pos('SELECT', sSQL);
  if p = 0 then exit;
  pSelect := copy(sSQL, 1, p + length('SELECT')) + ' ';

  sSQL := copy(sSQL, p + length('SELECT'), length(sSQL));
  p := pos('FROM', sSQL);
  if p = 0 then exit;
  pFields := ' ' + copy(sSQL, 1, p - 1) + ' ';
  pFrom := CS_SQLLink_FROM;

  sSQL := copy(sSQL, p + length('FROM'), length(sSQL));
  p := pos('WHERE', sSQL);
  if p = 0 then
  begin
    pTables := sSQL;
  end else
  begin
    pTables := ' ' + copy(sSQL, 1, p - 1) + ' ';
    pWhere := ' ' + copy(sSQL, p, length(sSQL));
  end;

end;

function GetSaveSQL(const pSQL: string): string;
var
  sSelect, sFields, sFrom, sTables, sWhere: string;
begin
  Result := pSQL;
  AnalyseSelect(pSQL, sSelect, sFields, sFrom, sTables, sWhere);
  Result := sSelect + ' * ' + sFrom + sTables + ' Where (1=2)';

end;

function GetAllFieldsSelect(const pSQL: string): string;
var
  sSelect, sFields, sFrom, sTables, sWhere, sTemp: string;
  i: integer;
  vData: OleVariant;
begin
  Result := pSQL;
  AnalyseSelect(pSQL, sSelect, sFields, sFrom, sTables, sWhere);

  if copy(Trim(sTables), length(Trim(sTables)), 1) = '.' then
  begin
    Result := '';
    exit;
  end;

  if (sSelect <> '') and (sTables <> '') then