syspublic.~pas

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

  sField2S := '';
  sField3S := '';
  if sSql = '' then
    Exit;

  ADOSetTmp := TADODataSet.Create(nil);
  ADOSetTmp.LockType := ltReadOnly;
  OpenDataSet(ADOSetTmp, sSql);

  if ADOSetTmp.IsEmpty then
    Result := False
  else
    while not ADOSetTmp.Eof do
    begin
      if sField1 <> '' then
        sField1S := sField1S + Trim(ADOSetTmp.FieldByName(sField1).AsString) +
          sSpl;
      if sField2 <> '' then
        sField2S := sField2S + Trim(ADOSetTmp.FieldByName(sField2).AsString) +
          sSpl;
      if sField3 <> '' then
        sField3S := sField3S + Trim(ADOSetTmp.FieldByName(sField3).AsString) +
          sSpl;
      ADOSetTmp.Next;
    end;
  sField1 := sField1S;
  sField2 := sField2S;
  sField3 := sField3S;

  if ADOSetTmp.Active then
    ADOSetTmp.Close;
  ADOSetTmp.Free;
end;

function GridFieldToStrings(dxTree: TCustomdxDBTreeListControl; sSpl: string):
  string;
var
  i, j: Integer;
begin
  Result := '';
  j := 0;
  for i := 0 to dxTree.ColumnCount - 1 do
  begin
    if dxTree.Columns[i].Visible then
    begin
      if j = 0 then
        Result := dxTree.Columns[i].FieldName
      else
        Result := Result + sSpl + dxTree.Columns[i].FieldName;
      j := 1;
    end;
  end;
end;

function GridNameToStrings(dxTree: TCustomdxDBTreeListControl; sSpl: string):
  string;
var
  i, j: Integer;
begin
  Result := '';
  j := 0;
  for i := 0 to dxTree.ColumnCount - 1 do
  begin
    if dxTree.Columns[i].Visible then
    begin
      if j = 0 then
        Result := dxTree.Columns[i].Caption
      else
        Result := Result + sSpl + dxTree.Columns[i].Caption;
      j := 1;
    end;
  end;
end;

function GridTitleToField(dxGrid: TCustomdxDBTreeListControl; sTit: string):
  string;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to dxGrid.ColumnCount - 1 do
  begin
    if Trim(dxGrid.Columns[i].Caption) = sTit then
    begin
      Result := dxGrid.Columns[i].FieldName;
      Break;
    end;
  end;
end;

function GridFieldToTitle(dxGrid: TCustomdxDBTreeListControl; sField: string):
  string;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to dxGrid.ColumnCount - 1 do
  begin
    if Trim(dxGrid.Columns[i].FieldName) = sField then
    begin
      Result := dxGrid.Columns[i].Caption;
      Break;
    end;
  end;
end;

function SetControlStyle(lMode: Integer; cColor: TColor): Integer;
begin
  with frmData.StyleController do
  begin
    case lMode of
      STYLE_FLAT:
        begin
          BorderColor := cColor;
          BorderStyle := xbsFlat;
          Shadow := true;
        end;
      STYLE_3D:
        begin
          BorderColor := cColor;
          BorderStyle := xbs3D;
          Shadow := False;
        end;
      STYLE_WEB:
        begin
          BorderColor := cColor;
          BorderStyle := xbsSingle;
          Shadow := False;
        end;
    end;
  end;
  Result := lMode;
end;

function GetBillShort(lMode: Integer): string;
begin
  case lMode of
    STOCK_ORDER_EDIT: Result := 'JHD';
    STOCK_FORMAL_EDIT: Result := 'JH';
    STOCK_MONEY_EDIT: Result := 'JHF';
    STOCK_BACK_EDIT: Result := 'JHT';
    SALE_ORDER_EDIT: Result := 'XSD';
    SALE_FORMAL_EDIT: Result := 'XS';
    SALE_MONEY_EDIT: Result := 'XSF';
    SALE_READY_EDIT: Result := 'XSX';
    SALE_BACK_EDIT: Result := 'XST';
    SALE_POS_EDIT: Result := 'LS';

    EXIST_DRAW: Result := 'LL';
    EXIST_RETURN: Result := 'TL';
    EXIST_ENTER_DEPOT: Result := 'JC';
    EXIST_CHECK_LIST: Result := 'PD';
    EXIST_CHANGE_PRICE: Result := 'TJ';
    EXIST_EXCHANGE: Result := 'DB';
    EXIST_ASSEMBLY: Result := 'ZZ';
    EXIST_OTHER: Result := 'BD';
    MONEY_EXPENSES: Result := 'FY';
    MONEY_INCOME: Result := 'SR';
    MONEY_DEPOSIT: Result := 'YH';
  else
    Result := '';
  end;
end;

function FindPublic(Grid1: TCustomdxDBTreeListControl; var sText: string; var
  lFiled: Integer): Boolean;
begin
  Result := FindPublicShow(Grid1, sText, lFiled);
end;

function FilterPublic(Grid1: TCustomdxDBTreeListControl): Boolean;
begin
  Result := FilterPublicShow(Grid1);
end;

function GetTableNoExists(sTab, sField: string): Integer;
var
  ADOSetTmp: TADODataSet;
  sSql: string;
  lMax, lTmp: Integer;
begin
  sSql := 'SELECT ' + sField + ' FROM ' + sTab + ' Order By [' + sField + ']';
  lMax := 0;
  ADOSetTmp := TADODataSet.Create(nil);
  ADOSetTmp.LockType := ltReadOnly;
  OpenDataSet(ADOSetTmp, sSql);
  while not ADOSetTmp.Eof do
  begin
    lTmp := ADOSetTmp.FieldByName(sField).AsInteger;
    if lMax = 0 then
      lMax := lTmp;
    if lMax < lTmp then
      Break;
    ADOSetTmp.Next;
    inc(lMax);
  end;
  ADOSetTmp.Free;
  Result := lMax;
end;

function GetCells(dxGrid: TCustomdxTreeList; lCol, lRow: Integer): string;
begin
  Result := dxGrid.Items[lRow].Strings[lCol];
end;

function CalcColSummary(dxGrid: TCustomdxDBTreeListControl; sFiled: string;
  SumType: TdxSummaryType = cstSum): string;
var
  i, lCol: Integer;
  dSum, dOne: Double;
begin
  dSum := 0;
  Result := '';
  lCol := dxGrid.ColumnByFieldName(sFiled).Index;
  for i := 0 to dxGrid.Count - 1 do
  begin
    dOne := StrToFloat2(GetCells(dxGrid, lCol, i));
    case SumType of
      cstSum: dSum := dSum + dOne;
      cstMin:
        if dSum < dOne then
          dSum := dOne;
      cstMax:
        if dSum > dOne then
          dSum := dOne;
    end;
  end;
  Result := FloatToStr2(dSum, FORMAT_2);
end;

function CalcColumnSummary(dxColumn: TdxDBTreeListColumn): string;
var
  i: Integer;
  dSum, dOne: Double;
  SumType: TdxSummaryType;
  dxGrid: TCustomdxDBTreeListControl;
begin
  dSum := 0;
  Result := '';
  dxGrid := dxColumn.ATreeList;
  SumType := dxColumn.SummaryFooterType;
  case SumType of
    cstNone: Exit;
    cstCount:
      begin
        if dxColumn.SummaryFooterFormat <> '' then
        begin
          Result := dxColumn.SummaryFooterFormat;
          Exit;
        end;
        dSum := dxGrid.Count - 1;
      end;
    cstSum, cstMin, cstMax:
      for i := 0 to dxGrid.Count - 1 do
      begin
        dOne := StrToFloat2(GetCells(dxGrid, dxColumn.Index, i));
        case SumType of
          cstSum: dSum := dSum + dOne;
          cstMin:
            if dSum < dOne then
              dSum := dOne;
          cstMax:
            if dSum > dOne then
              dSum := dOne;
        end;
      end;
  else
    Exit;
  end;
  Result := FloatToStr2(dSum);
end;

function GetTableSum(sTab, sField: string): Double;
var
  ADOSetTmp: TADODataSet;
  sSql: string;
  dSum: Double;
begin
  sSql := 'SELECT Sum(' + sField + ')as SumValue FROM ' + sTab;
  dSum := 0;
  ADOSetTmp := TADODataSet.Create(nil);
  ADOSetTmp.LockType := ltReadOnly;
  OpenDataSet(ADOSetTmp, sSql);
  if not ADOSetTmp.IsEmpty then
    dSum := ADOSetTmp.FieldByName('SumValue').AsFloat;
  Result := dSum;
  ADOSetTmp.Free;
end;

function GetTableMax(sSQL, sField: string): Double;
var
  ADOSetTmp: TADODataSet;
  dMax, dTmp: Double;
begin
  dMax := 0;
  ADOSetTmp := TADODataSet.Create(nil);
  ADOSetTmp.LockType := ltReadOnly;
  OpenDataSet(ADOSetTmp, sSql);
  while not ADOSetTmp.Eof do
  begin
    dTmp := ADOSetTmp.FieldByName(sField).AsFloat;
    if dTmp > dMax then
      dMax := dTmp;
    ADOSetTmp.Next;
  end;
  Result := dMax;
  ADOSetTmp.Free;
end;

function GetTableMin(sSQL, sField: string): Double;
var
  ADOSetTmp: TADODataSet;
  dMin, dTmp: Double;
begin
  dMin := 0;
  ADOSetTmp := TADODataSet.Create(nil);
  ADOSetTmp.LockType := ltReadOnly;
  OpenDataSet(ADOSetTmp, sSql);
  while not ADOSetTmp.Eof do
  begin
    dTmp := ADOSetTmp.FieldByName(sField).AsFloat;
    if dTmp < dMin then
      dMin := dTmp;
    ADOSetTmp.Next;
  end;
  Result := dMin;
  ADOSetTmp.Free;
end;

function GetAutoSerial(lMode, lSave: Integer): string;
var
  sSP, sNum, sUser, sExp: string;
begin
  sSP := GetIniValue(frmData.ADOConnet, 'BillSerialSp');
  sNum := GetIniValue(frmData.ADOConnet, 'BillSerialNum');
  sUser := GetIniValue(frmData.ADOConnet, 'BillSerialUser');
  sExp := GetIniValue(frmData.ADOConnet, 'BillSerialExp');
  Result := GetAutoSerial2(lMode, lSave, sSP, sNum, sUser, sExp);
end;

function GetAutoSerial2(lMode, lSave: Integer; sSP, sNum, sUser, sExp: string): string;
var
  sSql, sShort, sYY, sMM, sDD, sSerial: string;
  function GetAddDBNumber: Integer;
  var
    ADOSetTmp: TADODataSet;
    sNum1: string;
  begin
    if sNum = '' then
      sNum1 := '01'
    else
      sNum1 := sNum;
    ADOSetTmp := TADODataSet.Create(nil);
    sSql := ' SELECT * FROM SysDef where Mode=' + InttoStr(lMode);
    OpenDataSet(ADOSetTmp, sSql);

    if ADOSetTmp.IsEmpty then
    begin
      ADOSetTmp.Append;
      ADOSetTmp.FieldByName('Number').AsInteger := StrToInt2(sNum1);
      ADOSetTmp.FieldByName('Mode').AsInteger := lMode;
    end
    else
    begin
      ADOSetTmp.Edit;
      ADOSetTmp.FieldByName('Number').AsInteger := ADOSetTmp.FieldByName('Number').AsInteger + 1;
    end;
    if lSave = 1 then
      ADOSetTmp.Post;
    Result := ADOSetTmp.FieldByName('Number').AsInteger;
    if ADOSetTmp.Active then
      ADOSetTmp.Close;
    ADOSetTmp.Free;
  end;
begin
  Result := '';
  sShort := GetBillShort(lMode);
  sYY := FormatDateTime('yyyy', SYSStartDate);
  sMM := FormatDateTime('mm', SYSStartDate);
  sDD := FormatDateTime('dd', SYSStartDate);
  sSerial := Format00Str(Length(sNum), GetAddDBNumber);
  if sExp = '' then
  begin
    Result := sShort + sYY + sMM + sDD + sSerial;
    Exit;
  end;

  sExp := StringReplace(sExp, '单据简拼', sShort, [rfReplaceAll]);
  sExp := StringReplace(sExp, '年', sYY, [rfReplaceAll]);
  sExp := StringReplace(sExp, '月', sMM, [rfReplaceAll]);
  sExp := StringReplace(sExp, '日', sDD, [rfReplaceAll]);
  sExp := StringReplace(sExp, '自增序号', sSerial, [rfReplaceAll]);
  sExp := StringReplace(sExp, '自定义', sUser, [rfReplaceAll]);
  sExp := StringReplace(sExp, '分割符', sSP, [rfReplaceAll]);
  sExp := StringReplace(sExp, '+', '', [rfReplaceAll]);

  Result := sExp;
end;

procedure UpdateICCount(sDB: string; lParID: Integer);
var
  sSql: string;
  lCount: Integer;
begin
  if (sDB = '') or (lParID <= 0) then Exit;
  sSql := 'SELECT ID FROM ' + sDB + ' where TreeParent=' + IntToStr(lParID);
  lCount := GetDataSetCount(sSql);
  sSql := ' Update ' + sDB + ' Set SeedCount=' + IntToStr(lCount) + ' where ID=' + IntToStr(lParID);
  ExecSql(sSql);
end;

f