syspublic.~pas

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

      dxGrid.Bands.Add;
    dxGrid.Bands[i - 1].Caption := sCap;
    if i = 1 then
      lWidth := -dxGrid.Columns[0].Width
    else
      lWidth := 0; //去0列
    if lIndex > 0 then
    begin
      k2 := lIndex + k1 - 1;
      for j := k1 to k2 do
      begin
        dxGrid.Columns[j].BandIndex := i - 1;
        lWidth := dxGrid.Columns[j].Width + lWidth;
      end;
      k1 := k2 + 1;
      dxGrid.Bands[i - 1].Width := lWidth;
    end;
  end;
  Result := True;
end;

function SaverQueryGrid_(dxGrid: TdxDBGrid; sTable, sFieldList: string;
  sIDField: string = 'ID'): Boolean;
var //sFieldType[1]=1为字符,0为数字,2为日期
  tsList: array of TStrings;
  DataSet: TDataSet;
  i, j, lStrCount: Integer;
  sSql, sSet, sValue, sIncID, sTmp, sFieldType: string;
begin
  sIncID := 'ID,' + sFieldList;
  sFieldType := '';
  lStrCount := GetCommaStrCount(sIncID);
  DataSet := dxGrid.DataLink.DataSet;
  DataSet.ControlsDisabled;
  DataSet.First;
  SetLength(tsList, lStrCount + 1);
  for i := 1 to lStrCount do
    tsList[i] := TStringList.Create; //初始化数组

  for i := 1 to lStrCount - 1 do
  begin
    sTmp := GetFieldType(DataSet.FieldByName(GetCommaStr(sFieldList, i)));
    if sTmp = 'Str' then
      sTmp := '1'
    else
      if sTmp = 'Date' then
        sTmp := '2'
      else
        sTmp := '0';
    if sFieldType = '' then
      sFieldType := sTmp
    else
      sFieldType := sFieldType + ',' + sTmp;
  end;

  while not DataSet.Eof do
  begin
    for i := 1 to lStrCount do //数组付值
      tsList[i].Add(DataSet.FieldByName(GetCommaStr(sIncID, i)).AsString);
    DataSet.Next;
  end;
  DataSet.Close;
  sFieldList := CommaStrToSQLField(sFieldList);
  for i := 0 to tsList[1].Count - 1 do
  begin
    sValue := '';
    sSet := '';
    sSql := 'SELECT * FROM ' + sTable + ' WHERE ' + sIDField + '=' +
      tsList[1].Strings[i];
    if GetDataSetEmpty(sSql) then
    begin
      for j := 1 to lStrCount do
      begin
        if Trim(tsList[j + 1].Strings[i]) = '' then
          tsList[j + 1].Strings[i] := '0';
        sTmp := tsList[j + 1].Strings[i];
        if GetCommaStr(sFieldType, j) = '1' then
        begin
          sTmp := '''' + sTmp + ''''; //是否是字符型
          if Trim(tsList[j + 1].Strings[i]) = '0' then
            tsList[j + 1].Strings[i] := '''''';
        end
        else
          if
            GetCommaStr(sFieldType, j) = '2' then
            sTmp := '#' + sTmp + '#'; //是否是日期型

        if sValue = '' then
          sValue := sTmp
        else
          sValue := sValue + ',' + sTmp;
      end;
      sSql := 'INSERT INTO ' + sTable + ' (' + sFieldList + ')VALUES(' + sValue
        +
        ')';
    end
    else
    begin
      for j := 1 to lStrCount - 1 do
      begin
        sTmp := tsList[j + 1].Strings[i];
        if GetCommaStr(sFieldType, j) = '1' then
          sTmp := '''' + sTmp + '''' //是否是字符型
        else
          if GetCommaStr(sFieldType, j) = '2' then
            sTmp := '#' + sTmp + '#'; //是否是日期型

        if sSet = '' then
          sSet := GetCommaStr(sFieldList, j) + '=' + sTmp
        else
          sSet := sSet + ',' + GetCommaStr(sFieldList, j) + '=' + sTmp;
      end;
      sSql := 'Update ' + sTable + ' Set ' + sSet + ' Where ' + sIDField + '=' +
        tsList[1].Strings[i];
    end;
    ExecSql(sSql);
  end;
  DataSet.EnableControls;
  DataSet.Open;
  Result := True;
end;

function StrToTreeField(Tree1: TdxDBTreeList; sFieldName, sCaption, sWidth:
  string; sMask: string = ''): Boolean;
var
  s1, s2: string;
  lCol: Integer;
begin
  Result := False;
  if (Tree1 = nil) or (sCaption = '') then
    Exit;
  //显示GRID所有字段
  Tree1.DestroyColumns;
  s1 := sFieldName + ',';
  lCol := 0;
  while pos(',', s1) <> 0 do
  begin
    s2 := copy(s1, 0, pos(',', s1) - 1);
    s1 := copy(s1, pos(',', s1) + 1, Length(s1));
    if Trim(s2) <> '' then
    begin
      Tree1.CreateColumn(TdxDBTreeListMaskColumn);
      Tree1.Columns[lCol].FieldName := Trim(s2);
      Tree1.Columns[lCol].Visible := False;
      inc(lCol);
    end;
  end;
  //显示GRID所有字段标题
  s1 := sCaption + ',';
  lCol := 0;
  while pos(',', s1) <> 0 do
  begin
    s2 := copy(s1, 0, pos(',', s1) - 1);
    s1 := copy(s1, pos(',', s1) + 1, Length(s1));
    if Trim(s2) <> '' then
    begin
      Tree1.Columns[lCol].Caption := Trim(s2);
      Tree1.Columns[lCol].Visible := True;
      inc(lCol);
    end;
  end;
  //显示GRID所有字段宽度
  if sWidth <> '' then
  begin
    s1 := sWidth + ',';
    lCol := 0;
    while pos(',', s1) <> 0 do
    begin
      s2 := copy(s1, 0, pos(',', s1) - 1);
      s1 := copy(s1, pos(',', s1) + 1, Length(s1));
      if Trim(s2) <> '' then
      begin
        Tree1.Columns[lCol].Width := StrToInt2(s2);
        inc(lCol);
      end;
    end;
  end;
  //设置显示格式
  if sMask <> '' then
  begin
    s1 := sMask + ',';
    lCol := 0;
    while pos(',', s1) <> 0 do
    begin
      s2 := copy(s1, 0, pos(',', s1) - 1);
      s1 := copy(s1, pos(',', s1) + 1, Length(s1));
      if Trim(s2) <> '' then
      begin
        if Trim(s2) = '$' then
          ChangColumnType(Tree1, Tree1.Columns[lCol],
            TdxDBTreeListCurrencyColumn);
        inc(lCol);
      end;
    end;
  end;
  Result := True;
end;

function CalcRowSummary(dxGrid: TCustomdxDBTreeListControl; sSumField: string;
  sRetField: string = ''; lMult: integer = 0; bPost: Boolean = True): Double;
var
  i: Integer;
  sField: string;
  dSum: Double;
begin
  if TADODataSet(dxGrid.DataSource.DataSet).LockType = ltReadOnly then
  begin
    Result := 0;
    Exit;
  end;

  if lMult = 1 then
    dSum := 1
  else
    dSum := 0;
  sSumField := TrimCommaStr(sSumField);
  for i := 1 to GetCommaStrCount(sSumField) do
  begin
    sField := GetCommaStr(sSumField, i);
    if lMult = 0 then
      dSum := dSum + dxGrid.DataLink.DataSet.FieldByName(sField).AsFloat
    else
      if lMult = 1 then
        dSum := dSum * dxGrid.DataLink.DataSet.FieldByName(sField).AsFloat;
  end;
  if Trim(sRetField) <> '' then
  begin
    dxGrid.DataLink.DataSet.Edit;
    dxGrid.DataLink.DataSet.FieldByName(Trim(sRetField)).AsFloat := dSum;
    if bPost then
      dxGrid.DataLink.DataSet.Post;
  end;
  Result := dSum;
end;

procedure AddCalcField(ADOSet1: TADODataSet; sFieldName: string; sMode: Char =
  'D');
var
  NewField: TField;
  i: integer;
begin
  case sMode of
    'S': NewField := TStringField.Create(ADOSet1);
    //创建一个TStringField类型的字段
    'T': NewField := TDateTimeField.Create(ADOSet1);
    'D', 'F': NewField := TFloatField.Create(ADOSet1);
    'I': NewField := TIntegerField.Create(ADOSet1);
    'M': NewField := TMemoField.Create(ADOSet1);
    'C': NewField := TCurrencyField.Create(ADOSet1);
    'V': NewField := TVariantField.Create(ADOSet1);
    'O': NewField := TObjectField.Create(ADOSet1);
    'B': NewField := TBooleanField.Create(ADOSet1);
  else
    Exit;
  end;
  ADOSet1.Close;
  for i := 0 to ADOSet1.Fields.Count - 1 do
    ADOSet1.Fields[0].Free; //释放所有的静态字段
  //根据FieldDefs的字段信息动态的生成静态字段
  for i := 0 to ADOSet1.FieldDefs.Count - 1 do
    ADOSet1.FieldDefs.Items[i].CreateField(ADOSet1);
  //NewField.Size:=5;
  NewField.FieldName := sFieldName;
  NewField.FieldKind := fkCalculated; //设置这个这字段为计算字段
  NewField.DataSet := ADOSet1; //把这个字段加到DataSet上
  ADOSet1.Open;
end;

function SetGridSummary(Grid1: TdxDBGrid; sSumField: string): Boolean;
var
  sSum, sFiled, sCaption: string;
  i: Integer;
begin
  //设置合计栏
  sCaption := '合  计';
  if lGB23_BIG5 = 1 then
    sCaption := GBtoBIG5(sCaption);

  sSum := TrimCommaStr(sSumField);
  for i := 1 to GetCommaStrCount(sSum) do
  begin
    sFiled := GetCommaStr(sSum, i);
    if i = 1 then
    begin
      Grid1.ColumnByFieldName(sFiled).SummaryFooterType := cstCount;
      Grid1.ColumnByFieldName(sFiled).SummaryFooterFormat := sCaption;
    end
    else
      Grid1.ColumnByFieldName(sFiled).SummaryFooterType := cstSum;
  end;
  Result := True;
end;

function TableToStrings2(DataSet: TADODataSet; var sField1, sField2, sField3:
  string; sSpl: string): Boolean;
var
  sField1S, sField2S, sField3S: string;
begin
  Result := True;
  sField1S := '';
  sField2S := '';
  sField3S := '';
  if not DataSet.Active then
    exit;

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

function GetFieldType(fField: TField): string;
var
  s1: string;
begin
  case fField.DataType of
    ftSmallint, ftInteger, ftWord, ftFloat, ftCurrency, ftBCD: s1 := 'Int';
    ftBoolean: s1 := 'Bool';
    ftDate, ftTime, ftDateTime: s1 := 'Date';
    ftWideString, ftString: s1 := 'Str';
    ftUnknown: s1 := 'Unk';
  end;
  Result := s1;
end;

function CheckDataSetColValue(DataSet: TDataSet; sField: string; vValue: Variant): Integer;
var
  lRec: Integer;
  SavePlace: TBookmark;
begin
  Result := 0;
  lRec := 0;
  with DataSet do
  begin
    if not Active then
      Exit;
    DisableControls;
    SavePlace := GetBookmark;
    First;
    while not Eof do
    begin
      if (FieldByName(sField).AsVariant = vValue) or
        (FieldByName(sField).AsVariant = NULL) then
      begin
        lRec := RecNo;
        Break;
      end;
      Next;
    end;
    GotoBookmark(SavePlace);
    FreeBookmark(SavePlace);
    EnableControls;
  end;
  Result := lRec;
end;

function CheckMinusWareStock(DataSet: TDataSet; sWareID: string): Integer;
var
  lRec: Integer;
  SavePlace: TBookmark;
  sSQL: string;
begin
  Result := 0;
  lRec := 0;
  with DataSet do
  begin
    if not Active then
      Exit;
    DisableControls;
    SavePlace := GetBookmark;
    First;
    while not Eof do
    begin
      sSQL := 'SELECT SumNumber FROM (SELECT Sum(Number)AS SumNumber FROM WareStock WHERE ' +
        ' WareID=' + FieldByName(sWareID).asString + ') WHERE (SumNumber-' + FieldByName('Number').asString + ')>=0';
      if GetDataSetEmpty(sSQL) then
      begin
        lRec := RecNo;
        Break;
      end;
      Next;
    end;
    GotoBookmark(SavePlace);
    FreeBookmark(SavePlace);
    EnableControls;
  end;
  Result := lRec;
end;

function TableToStrings(sSql: string; var sField1, sField2, sField3: string;
  sSpl: string): Boolean;
var
  ADOSetTmp: TADODataSet;
  sField1S, sField2S, sField3S: string;
begin
  Result := True;
  sField1S := '';