utilities.pas

企业进销存管理系统

    iPos := Pos('FORM',UpperCase(TQuery(DataSet).SQL.Text));
    if iPos = 0 then begin
      showmessage('Query 语法错误');
      Exit;
    end;
    iWherePos := Pos('WHERE',UpperCase(TQuery(DataSet).SQL.Text));

    Result := Copy(UpperCase(TQuery(DataSet).SQL.Text),iPos,iWherePos);
  end;

  function Get_Query: TQuery;
  begin
    Result := TQuery.Create(nil);
    try
      Result.DatabaseName := DataSet.DatabaseName;
      Result.SessionName := DataSet.SessionName;
      if DataSet is TTable then
      begin
        Result.SQL.Add(' SELECT '+Item_Field+
                       ' FROM '+TTable(DataSet).TableName+' Ta'+
                       ' WHERE '+Item_Field+' LIKE '''+GetMainString+'%'' '+
                       ' ORDER BY '+Item_Field) ;
        AddUserLog(' SELECT '+Item_Field+
                      ' FROM '+TTable(DataSet).TableName+' Ta'+
                       ' WHERE '+Item_Field+' LIKE '''+GetMainString+'%'' '+
                       ' ORDER BY '+Item_Field);
      end

      else
      begin
        Result.SQL.ADD(' SELECT '+Item_Field+
                       ' FROM '+GetQuery_TableName+
                       ' WHERE '+Item_Field+' LIKE '''+GetMainString+'%'' '+
                       ' ORDER BY '+Item_Field);
         AddUserLog(' SELECT '+Item_Field+
                       ' FROM '+GetQuery_TableName+
                       ' WHERE '+Item_Field+' LIKE '''+GetMainString+'%'' '+
                       ' ORDER BY '+Item_Field);

      end;

    except
      Result.Free;
      Raise;
    end;
  end;

begin
  if ODay=0 then
    oDay := now;
  if DataSet = nil then begin
    showmessage('无指定资料表');
    Exit;
  end;

  if DataSet is TTable then
    if not (DataSet.State in [dsEdit,dsInsert]) then begin
      showmessage('资料表不是在编辑或是新增的状态');
      Exit;
    end;

  try
    try
      xQuery := Get_Query;
      xQuery.Open;

      if IsInsert then begin
        iCount := 1;
        while not xQuery.Eof do begin
          if GetItemNumber<>iCount then begin
            DataSet[Item_Field] := GetMainString+GetNewItemNumber(iCount);
            Exit;
          end;

          inc(iCount) ;
          if iCount > GetMaxNumber then begin
            ShowMessage('产生自动编号时发生溢位状况,请洽程式设计人员');
            Exit;
          end;

          xQuery.Next;
        end;
      end
      else begin
        xQuery.Last;
        iCount := GetItemNumber+1;
        if iCount > GetMaxNumber then begin
            ShowMessage('产生自动编号时发生溢位状况,请洽程式设计人员');
            Exit;
          end;
      end;
        DataSet[Item_Field] := GetMainString+GetNewItemNumber(iCount);

    except
      ShowMessage('在产生自动编号时发生错误');
      raise;
    end;
  finally
    xQuery.Free;
  end;
end;

procedure Auto_Item_Number1(DataSet: TDBDataSet;Item_Field: string; FirstWord: string='X';
              IsInsert: Boolean=True;ODay: TDate=0;
              ifChina: Boolean=True;ifYMD: string='YM';item :integer=4;NumYY :integer=2;
              ifLine :string='');
var
  xQuery: TQuery;
  iCount: Integer;
  function GetMainString:string;
  var
    yy,mm,dd: Word;
  begin
    //针对不同的编号格式,取得其主要的编排格式
    DecodeDate(ODay,yy,mm,dd);
    Result := FirstWord;
    if ifchina then begin
       if ifYMD ='YM' then
          case NumYY of
            2: Result := Result + Copy(IntToStr(yy),3,2) + Copy(IntToStr(mm+100),2,2) + ifLine;
            4: Result := Result + IntToStr(yy) + Copy(IntToStr(mm+100),2,2) + ifLine;
          end;
       if ifYMD ='YMD' then
          case NumYY of
            2: Result := Result + Copy(IntToStr(yy),3,2) + Copy(IntToStr(mm+100),2,2) + Copy(IntToStr(dd+100),2,2) + ifLine;
            4: Result := Result + IntToStr(yy) + Copy(IntToStr(mm+100),2,2) + Copy(IntToStr(dd+100),2,2) + ifLine;
          end;
       if ifYMD ='Y' then
          case NumYY of
            2: Result := Result + Copy(IntToStr(yy),3,2) + ifLine;
            4: Result := Result + IntToStr(yy) + ifLine;
          end ;
    end;
    if not ifchina then begin
       if ifYMD ='YM' then
          case NumYY of
            2: Result := Result + Copy(IntToStr(yy-1911+100),2,2) + Copy(IntToStr(mm+100),2,2) +ifLine;
            3: Result := Result + Copy(IntToStr(yy-911),2,3) + Copy(IntToStr(mm+100),2,2) +ifLine;
          end;
       if ifYMD ='YMD' then
          case NumYY of
            2: Result := Result + Copy(IntToStr(yy-1911+100),2,2) + Copy(IntToStr(mm+100),2,2) + Copy(IntToStr(dd+100),2,2)+ifLine;
            3: Result := Result + Copy(IntToStr(yy-911),2,3) + Copy(IntToStr(mm+100),2,2) + Copy(IntToStr(dd+100),2,2)+ifLine;
          end;
       if ifYMD ='Y' then
          case NumYY of
            2: Result := Result + Copy(IntToStr(yy-1911+100),2,2) +ifLine;
            3: Result := Result + Copy(IntToStr(yy-911),2,3) +ifLine;
          end;
    end;
  end;

  function GetItemNumber: Integer;
  begin
    Result := 0;
    if (xQuery.RecordCount <> 0) then
       result :=StrToInt(Copy(xQuery.Fields[0].AsString,length(xQuery.Fields[0].AsString)-item+1,item));
  end;

  function GetNewItemNumber(i: Integer): string;
  begin
    result := Copy(floatToStr(i+power(10,item)),2,item);
  end;

  function GetMaxNumber:Integer;
  begin
    Result := 0;
    result := Round(power(10,item)-1);
  end;

  function GetQuery_TableName: string; //取得Query元件的资料表名称
  var
    iPos: Integer;
    iWherePos: Integer;
  begin
    iPos := Pos('FORM',UpperCase(TQuery(DataSet).SQL.Text));
    if iPos = 0 then begin
      showmessage('Query 语法错误');
      Exit;
    end;
    iWherePos := Pos('WHERE',UpperCase(TQuery(DataSet).SQL.Text));

    Result := Copy(UpperCase(TQuery(DataSet).SQL.Text),iPos,iWherePos);
  end;

  function Get_Query: TQuery;
  begin
    Result := TQuery.Create(nil);
    try
      Result.DatabaseName := DataSet.DatabaseName;
      Result.SessionName := DataSet.SessionName;
      if DataSet is TTable then
        Result.SQL.Add(' SELECT '+Item_Field+
                       ' FROM '+TTable(DataSet).TableName+' Ta'+
                       ' WHERE '+Item_Field+' LIKE "'+GetMainString+'%" '+
                       ' ORDER BY '+Item_Field)
      else
        Result.SQL.ADD(' SELECT '+Item_Field+
                       ' FROM '+GetQuery_TableName+
                       ' WHERE '+Item_Field+' LIKE "'+GetMainString+'%" '+
                       ' ORDER BY '+Item_Field);
    except
      Result.Free;
      Raise;
    end;
  end;

begin
  ifYMD := UpperCase(ifYMD);
  if (ifYMD<>'Y') and (ifYMD<>'YM') and (ifYMD<>'YMD') then begin
     showmessage('自动变号叁数错误,请联系程式设计师!');
     exit;
  end;
  if ifchina then
     if (NumYY<>2) and (NumYY<>4) then begin
        showmessage('自动变号叁数错误,请联系程式设计师!');
        exit;
     end;
  if not ifchina then
     if (NumYY<>2) and (NumYY<>3) then begin
        showmessage('自动变号叁数错误,请联系程式设计师!');
        exit;
     end;

  if ODay=0 then
    oDay := now;
  if DataSet = nil then begin
    showmessage('无指定资料表');
    Exit;
  end;

  if DataSet is TTable then
    if not (DataSet.State in [dsEdit,dsInsert]) then begin
      showmessage('资料表不是在编辑或是新增的状态');
      Exit;
    end;

  try
    try
      xQuery := Get_Query;
      xQuery.Open;

      if IsInsert then begin
        iCount := 1;
        while not xQuery.Eof do begin
          if GetItemNumber<>iCount then begin
            DataSet[Item_Field] := GetMainString+GetNewItemNumber(iCount);
            Exit;
          end;

          inc(iCount) ;
          if iCount > GetMaxNumber then begin
            ShowMessage('产生自动编号时发生溢位状况,请洽程式设计人员');
            Exit;
          end;

          xQuery.Next;
        end;
      end
      else begin
        xQuery.Last;
        iCount := GetItemNumber+1;
        if iCount > GetMaxNumber then begin
            ShowMessage('产生自动编号时发生溢位状况,请洽程式设计人员');
            Exit;
          end;
      end;
        DataSet[Item_Field] := GetMainString+GetNewItemNumber(iCount);

    except
      ShowMessage('在产生自动编号时发生错误');
      raise;
    end;
  finally
    xQuery.Free;
  end;
end;


//取回资料丢回TStringlist ,适合於非db栏位
function select_text(xCaption: string;sSQL: string;xDataBaseName: string;iFindKey, iColWidth: array of Integer):TStringList;
var
  i: Integer;
begin
  Result := nil;
  Select_Form := TSelect_Form.Create(Application);
  try
    with Select_Form,Select_Form.Query1 do begin
      DatabaseName := xDataBaseName;
      Caption := xCaption;
      SQL.Clear;
      SQL.Add(sSQL);
      Open;

      if Length(iColWidth) > 0 then
      begin
        for i:=0 to High(iColWidth) do
          if iColWidth[i]=0 then
            DBGrid1.Columns[i].Visible := False
          else
            DBGrid1.Columns[i].Width := iColWidth[i];
      end;

      if NOT Query1.CanModify then
        begin
          DBNavPlus1.VisibleButtons:=[nbFirst, nbPrior, nbNext, nbLast];
          DBNavPlus1.Width:=Trunc(DBNavPlus1.Width/2);
        end;
      {
      if IsEmpty then
      begin
        R_OkMessage(['资料库中查无资料,无法选取资料'],'',MB_ICNONERROR);
        Result := nil;
        Exit;
      end;
      }

      if ShowModal = mrOk then begin
        Result := TStringList.Create;
        for i := 0 to High(iFindKey) do
          Result.Add(Query1.fields[iFindKey[i]].AsString);//将要取回的资料存入Tstringlist中
      end;//end of showmodal

    end;//end of with
  finally
    Select_Form.Free;
  end;//end of try
end;

//取回资料丢回资料库指定栏位
function Select_Data(xDataSource: TDataSource;xCaption: string; sSQL: string; sDataBaseName: string;sreturn:array of string;iFindKey,iColWidth: array of Integer): Boolean;
var
  i:Integer;
  PStream: TStream;
begin
  Result := False;
  pStream := nil;
  Select_Form := TSelect_Form.Create(Application);
  try
    with Select_form,Select_Form.Query1 do begin
      DatabaseName := sDataBaseName;
      Caption := xCaption;
      SQl.Clear;
      SQL.Add(sSQL);
      Open;

      if Length(iColWidth) > 0 then
      begin
        for i:=0 to High(iColWidth) do
          if iColWidth[i]=0 then
            DBGrid1.Columns[i].Visible := False
          else
            DBGrid1.Columns[i].Width := iColWidth[i];
      end;

      if NOT Query1.CanModify then
        begin
          DBNavPlus1.VisibleButtons:=[nbFirst, nbPrior, nbNext, nbLast];
          DBNavPlus1.Width:=Trunc(DBNavPlus1.Width/2);
        end;
      {if IsEmpty then begin
        R_OkMessage(['资料库中查无资料,无法选取资料'],'','警告');
        Exit;
      end; }
      if ShowModal = mrok then begin
        Result := True;
        if xDataSource.DataSet.CanModify then
        begin
          if (xDataSource.DataSet.State = dsBrowse) then
            xDatasource.DataSet.Edit
        end
        else
          begin
            xDatasource.DataSet.Locate(sreturn[0],Query1.fields[iFindKey[0]].value,[]);
            Exit;
          end;
        for i := 0 to High(iFindKey) do begin
          if (xdatasource.DataSet as TDataSet).FieldByName(sreturn[i]).DataType = ftblob then begin
            if not Query1.fields[iFindKey[i]].IsNull then