syspublic.~pas

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

  False): string; //单据选择
var
  lLimitMode: Integer;
begin
  Result := '';
  lLimitMode := lMode;
  if (lMode >= STOCK_ORDER_BILL) and (lMode <= ALL_STOCK_BILL) then
    lLimitMode := ALL_STOCK_BILL
  else
    if (lMode >= SALE_ORDER_BILL) and (lMode <= ALL_SALE_BILL) then
      lLimitMode := ALL_SALE_BILL
    else
      if (lMode >= EXIST_DRAW_BILL) and (lMode <= ALL_EXIST_BILL) then
        lLimitMode := ALL_EXIST_BILL
      else
        if (lMode >= MONEY_EXPENSES_BILL) and (lMode <= ALL_MONEY_BILL) then
          lLimitMode := ALL_MONEY_BILL;

  if not CheckLimit(lLimitMode) then
  begin
    ShowMsg('对不起，你没有权限使用此功能！');
    Exit;
  end;
  if (lMode >= STOCK_ORDER_BILL) and (lMode <= ALL_MONEY_BILL) then
    Result := BillQueryShow(lMode, lSelect, bRead) //单据查询
  else
    if (lMode > STOCK_EDIT_BEGIN) and (lMode < SALE_EDIT_END) then
      Result := BillEditShow(lMode, lSelect) //进货单据、销售单据
    else
      if (lMode > EXIST_EDIT_BEGIN) and (lMode < MONEY_EDIT_END) then
        Result := ExistBillEditShow(lMode, lSelect) //库存单据//钱流单据
      else
        if lMode = ACCOUNT_VOUCHER_EDIT then
          AccountVoucherShow(lMode, 0, 0) //记账凭证
        else
          if lMode = ACCOUNT_VOUCHER_QUERY then
            AccountQueryShow(lMode, lSelect, bRead); //记账凭证查询
end;

function UpdateUnitARTotal(lTrans, lUnitID, lPeriod: Integer; dDate: TDateTime;
  dARTotal, dDoARTotal: Double): Boolean;
var
  ADOSetTmp: TADODataSet;
  sSql: string;
begin
  Result := False;
  if lUnitID <= 0 then
  begin
    if lTrans = 1 then
      RollbackTrans;
    Exit;
  end;
  ADOSetTmp := nil;
  ADOSetTmp := TADODataSet.Create(ADOSetTmp);
  sSql := ' SELECT * FROM UnitMoney M WHERE M.UnitID=' + IntToStr(lUnitID) + ' And m.Period=' + IntToStr(lPeriod);
  if not OpenDataSet(ADOSetTmp, sSql) then
  begin
    ADOSetTmp.Free;
    if lTrans = 1 then
      RollbackTrans;
    Exit;
  end;
  if ADOSetTmp.IsEmpty then
  begin
    ADOSetTmp.Insert;
    ADOSetTmp.FieldByName('UnitID').AsInteger := lUnitID;
    ADOSetTmp.FieldByName('Period').AsInteger := lPeriod;
    ADOSetTmp.FieldValues['Date'] := dDate;
    ADOSetTmp.FieldByName('ARTotal').AsFloat := dARTotal;
    ADOSetTmp.FieldByName('DoARTotal').AsFloat := dDoARTotal;
  end
  else
  begin
    ADOSetTmp.Edit;
    ADOSetTmp.FieldByName('Period').AsInteger := lPeriod;
    ADOSetTmp.FieldValues['Date'] := dDate;
    if dARTotal <> 0 then
      ADOSetTmp.FieldByName('ARTotal').AsFloat :=
        ADOSetTmp.FieldByName('ARTotal').AsFloat + dARTotal;
    if dDoARTotal <> 0 then
      ADOSetTmp.FieldByName('DoARTotal').AsFloat :=
        ADOSetTmp.FieldByName('DoARTotal').AsFloat + dDoARTotal;
  end;
  try
    ADOSetTmp.Post;
  except
    ADOSetTmp.Free;
    if lTrans = 1 then
      RollbackTrans;
    Exit;
  end;
  if ADOSetTmp.Active then
    ADOSetTmp.Close;
  ADOSetTmp.Free;
  Result := True;
end;

function UpdateStock(lTrans, lWareID, lDepotID: Integer; dNumber, dPrice,
  dTotal: Double; sStockDB: string = 'WareStock'): Boolean;
var
  ADOSetTmp: TADODataSet;
  sSql, sSql1, sSql2: string;
  lOrder: Integer;
begin
  Result := False;
  if lWareID <= 0 then
  begin
    if lTrans = 1 then
      RollbackTrans;
    exit;
  end;
  ADOSetTmp := nil;
  ADOSetTmp := TADODataSet.Create(ADOSetTmp);
  lOrder := StrToInt2(GetIniValue(frmData.ADOConnet, 'OutOrder')); //读成本算法
  if lDepotID > 0 then
    sSql1 := ' And WS.DepotID=' + IntToStr(lDepotID)
  else
    sSql1 := '';
  sSql2 := ' SELECT * FROM ' + sStockDB + ' WS WHERE WS.WareID=' + IntToStr(lWareID) + sSql1; //批次检查用
  case lOrder of
    0: sSql := ' SELECT * FROM ' + sStockDB + ' WS WHERE WS.WareID=' + IntToStr(lWareID) + sSql1;
  else
    sSql := ' SELECT * FROM ' + sStockDB + ' WS WHERE WS.Price=' +
      FloatToStr2(dPrice) + ' and WS.WareID=' + IntToStr(lWareID) + sSql1;
  end;

  if not OpenDataSet(ADOSetTmp, sSql) then
  begin
    ADOSetTmp.Free;
    if lTrans = 1 then
      RollbackTrans;
    Exit;
  end;
  if ADOSetTmp.IsEmpty then
  begin
    ADOSetTmp.Insert;
    ADOSetTmp.FieldByName('WareID').AsInteger := lWareID;
    ADOSetTmp.FieldByName('DepotID').AsInteger := lDepotID;
    ADOSetTmp.FieldByName('Number').AsFloat := dNumber;
    ADOSetTmp.FieldByName('Initial').AsInteger := 0;
    case lOrder of
      0: ;
    else
      begin
        ADOSetTmp.FieldByName('Price').AsFloat := dPrice;
        ADOSetTmp.FieldByName('Order').AsFloat := GetTableMax(sSql2, 'Order') + 1;
      end;
    end;
    //    ADOSetTmp.FieldByName('Total').AsFloat := dNumber * dPrice;
  end
  else
  begin
    ADOSetTmp.Edit;
    ADOSetTmp.FieldByName('Number').AsFloat :=
      ADOSetTmp.FieldByName('Number').AsFloat + dNumber;
    case lOrder of
      0: ;
    else
      ADOSetTmp.FieldByName('Price').AsFloat := dPrice;
    end;
    //    ADOSetTmp.FieldByName('Total').AsFloat :=
    //      ADOSetTmp.FieldByName('Total').AsFloat + dNumber * dPrice;
  end;
  try
    ADOSetTmp.Post;
  except
    ADOSetTmp.Free;
    if lTrans = 1 then
      RollbackTrans;
  end;

  if ADOSetTmp.Active then
    ADOSetTmp.Close;
  ADOSetTmp.Free;
  Result := True;
end;

function QuerySelect(lMode, lTree: Integer; sFilterID: string = ''): string;
begin
  if not CheckLimit(lMode) then
  begin
    ShowMsg('对不起，你没有权限使用此功能！');
    Exit;
  end;
  Result := ReadQueryShow(lMode, lTree, sFilterID);
end;

function PrintForm(Form1: TForm; lTitle1, lMode1: Integer; sFile1: string;
  sChart1: string = ''): Boolean;
begin
  Result := WinPrint(Form1, lTitle1, lMode1, sFile1, sChart1);
end;

function FieldToValue(sAllField, sAllValue, sField: string): string;
var
  i, j: Integer;
  s1, s2: string;
begin
  Result := '';
  i := 0;
  j := 0;
  s1 := sAllField;
  while pos(',', s1) <> 0 do
  begin
    s2 := copy(s1, 0, pos(',', s1) - 1);
    s1 := copy(s1, pos(',', s1) + 1, Length(s1));
    Inc(i);
    if (Trim(s2) = Trim(sField)) then
    begin
      j := i;
      Break;
    end;
  end;
  s1 := sAllValue;
  i := 0;
  while pos(',', s1) <> 0 do
  begin
    s2 := copy(s1, 0, pos(',', s1) - 1);
    s1 := copy(s1, pos(',', s1) + 1, Length(s1));
    inc(i);
    if i = j then
    begin
      Result := s2;
      Break;
    end;
  end;
end;

function GetCommaStrCount(sComma: string): Integer;
var
  s1, s2: string;
  i: Integer;
begin
  Result := 0;
  i := 0;
  if Trim(sComma) = '' then
    Exit;
  s1 := sComma + ',';
  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
      Inc(i);
  end;
  Result := i;
end;

function GetCommaStr(sComma: string; lBit: Integer): string;
var
  s1, s2: string;
  i: Integer;
begin
  Result := '';
  i := 0;
  if Trim(sComma) = '' then
    Exit;
  s1 := sComma + ',';
  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
      Inc(i);
      if (lBit = i) and (lBit <> 0) then
      begin
        Result := s2;
        Exit;
      end;
    end;
  end;
end;

function TrimCommaStr(sComma: string): string;
var
  s1, s2, sRet: string;
begin
  sRet := '';
  if Trim(sComma) = '' then
    Exit;
  s1 := sComma + ',';
  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 sRet = '' then
        sRet := s2
      else
        sRet := sRet + ',' + s2;
    end;
  end;
  Result := sRet;
end;

function CommaStrToSQLField(sComma: string): string;
var
  s1, s2, sRet: string;
begin
  sRet := '';
  if Trim(sComma) = '' then
    Exit;
  s1 := sComma + ',';
  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 sRet = '' then
        sRet := '[' + s2 + ']'
      else
        sRet := sRet + ',' + '[' + s2 + ']';
    end;
  end;
  Result := sRet;
end;

function StrToGridField(Grid1: TdxDBGrid; sFieldName, sCaption, sWidth: string;
  sMask: string = ''):
  Boolean;
var
  s1, s2: string;
  lCol: Integer;
begin
  Result := False;
  if (sFieldName = '') or (sCaption = '') then
    Exit;
  //显示GRID所有字段
  Grid1.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
      Grid1.CreateColumn(TdxDBGridMaskColumn);
      Grid1.Columns[lCol].FieldName := Trim(s2);
      Grid1.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
      Grid1.Columns[lCol].Caption := Trim(s2);
      Grid1.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
        Grid1.Columns[lCol].Width := StrToInt2(Trim(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(Grid1, Grid1.Columns[lCol], TdxDBGridCurrencyColumn);
        inc(lCol);
      end;
    end;
  end;
  Result := True;
end;

function StrToGridBand(dxGrid: TdxDBGrid; sCaption, sBandIndex: string):
  Boolean;
var
  i, j, k1, k2, lIndex, lWidth: Integer;
  sCap: string;
begin
  Result := False;
  k1 := 0;
  if Trim(sCaption) = '' then
    Exit;
  dxGrid.ShowBands := True;
  for i := 1 to GetCommaStrCount(sCaption) do
  begin
    sCap := GetCommaStr(sCaption, i);
    lIndex := StrToInt2(GetCommaStr(sBandIndex, i));
    if i > 1 then