frm_main.~pas

站长您好

function TFrmMain.SetQuerySql(SqlStr, UserField: string; OperateDate: string):
  string;
var
  Stemp: string;
begin
  if UserField = '' then
  else
  begin
    if RightsGrade = '' then
    begin
      SqlStr := SqlStr + ' and ' + UserField + '=''' + LoginId + '''';
    end
    else
    begin
      Stemp := RightsGrade + ',''' + LoginId + '''';
      SqlStr := SqlStr + ' and ' + UserField + ' in (' + Stemp + ')';
    end;
  end;

  if OperateDate = '' then
  else
  begin
    SqlStr := SqlStr + ' and ' + OperateDate + '>=''' + DateStart + '''';
  end;

  Result := SqlStr;
end;

procedure TFrmMain.InsStr(var Sql: string; Value1: integer; Value2: string);
begin
  Sql := Sql + ' ' + IntTostr(Value1) + ' ' + Value2;
  if Value2 = '' then Sql := Sql + ')';
end;

procedure TFrmMain.InsStr(var Sql: string; Value1: real; Value2: string);
begin
  Sql := Sql + ' ' + floatTostr(Value1) + ' ' + Value2;
  if Value2 = '' then Sql := Sql + ')';
end;

procedure TFrmMain.InsStr(var Sql: string; Value1: string);
begin
  if Sql = '' then
    Sql := Sql + 'Insert Into ' + Value1 + ' Values ( '
  else
    Sql := Sql + ' ' + FrmMain.FullStrYh(Value1);

end;

procedure TFrmMain.UpStr(var Sql: string; Value, Value1, Value2: string);
begin
  Value1 := FrmMain.FullStrYh(Value1);
  if (Value2 = '') or (Value2 = ',') then
  begin
    if uppercase(value1) = 'NULL' then
      Sql := Sql + ' ' + Value + ' =null' + Value2
    else
      Sql := Sql + ' ' + Value + ' =''' + Value1 + ''' ' + Value2
  end
  else
    if Value2 = 'w' then
      Sql := Sql + ' Where ' + Value + '''' + FrmMain.FullStrYh(value1) + ''''
    else
      Sql := Sql + ' ' + Value2 + ' ' + Value + '''' + FrmMain.FullStrYh(value1)
        + '''';
end;

procedure TFrmMain.UpStr(var Sql: string; Value: string);
begin
  if Length(Sql) = 0 then
    Sql := 'Update ' + Value + ' Set'
  else
    Sql := Sql + ' ' + Value;
end;

procedure TFrmMain.UpStr(var Sql: string; Value: string; value1: integer;
  Value2: string);
begin
  if (Value2 = '') or (Value2 = ',') then
    Sql := Sql + ' ' + Value + ' = ' + intTostr(value1) + ' ' + Value2
  else
    if Value2 = 'w' then
      Sql := Sql + ' Where ' + Value + IntTostr(value1)
    else
      Sql := Sql + ' ' + Value2 + ' ' + Value + IntTOstr(value1);
end;

procedure TFrmMain.UpStr(var Sql: string; Value: string; value1: real;
  Value2: string);
begin
  if (Value2 = '') or (Value2 = ',') then
    Sql := Sql + ' ' + Value + ' = ' + floatTostr(value1) + ' ' + Value2
  else
    if Value2 = 'w' then
      Sql := Sql + ' Where ' + Value + floatTostr(value1)
    else
      Sql := Sql + ' ' + Value2 + ' ' + Value + floatTOstr(value1);
end;

procedure TFrmMain.SelStr(var Sql: string; Value, value1: string);
begin
  if Sql = '' then
    Sql := 'Select ' + Value + ' ' + value1
  else
    if Value1 = '' then
      Sql := Sql + ' ' + value
    else
      Sql := Sql + ' ' + value + ' ' + value1;
end;

procedure TFrmMain.SelStr(var Sql: string; Value, value1, value2: string);
begin
  if Value2 = 'f1' then
    Sql := Sql + ' From ' + Value + value1
  else
    if Value2 = 'f' then
      Sql := Sql + ' ' + Value + value1
    else
      if Value2 = 'w' then
        Sql := Sql + ' Where ' + value + '''' + Value1 + ''''
      else
        Sql := Sql + ' ' + value2 + ' ' + value + '''' + Value1 + '''';
end;

procedure TFrmMain.SelStr(var Sql: string; Value: string; value1: integer;
  value2: string);
begin
  if Value2 = 'w' then
    Sql := Sql + ' Where ' + value + intTostr(Value1)
  else
    Sql := Sql + ' ' + value2 + ' ' + value + IntTostr(Value1);
end;

function TFrmMain.TestTextNumber(str: string; NumberType: string): Boolean;
var
  i: integer;
  Ilen: integer;
  StrPchar: Pchar;
  ipos1, ipos2: integer;
begin
  Str := Trim(Str);
  Result := True;
  //等到字符串的字符个数
  Ilen := Length(str);
  if copy(str, 1, 1) = '-' then
    str := copy(str, 2, ilen - 1);
  if trim(Str) = '' then
  begin
    Result := False;
    exit;
  end;
  StrPchar := Pchar(str);
  Ilen := Length(str);
  Ipos1 := pos('.', str);
  Ipos2 := pos('.', copy(str, ipos1 + 1, ilen - ipos1));

  if Ipos2 = 0 then
  else
  begin
    result := false;
    exit;
  end;
  //通过判断字符是否为阿科瑟码中所代表的数值。来判断是否为数值。
  for i := 0 to ilen - 1 do
  begin
    if ((strpchar[i] >= chr(48)) and (strpchar[i] <= chr(57))) or (strpchar[i] =
      '.') then
    begin
      if (strpchar[i] = '.') and (uppercase(numbertype) = 'INTEGER') then
      begin
        result := false;
        exit;
      end;
    end
    else
    begin
      result := false;
      exit;
    end;
  end;
end;

function TFrmMain.GetCode(Prefix: string): string;
var
  TpQuery: TAdoQuery;
  i: integer;
  TpPrefix, TpCurrentNum, TpLength, TpFormat, TpCreateCode: string;
begin
  //得到将要生成编号的属性
  TpQuery := TAdoQuery.Create(self);
  TpQuery.Connection := UseDb;
  TpQuery.SQL.Text :=
    'Select CurrentNum,Length,Format From CreateCode Where Prefix=''' +
    Sql(UpperCase(Trim(Prefix))) + '''';
  TpQuery.Open;
  if RecordCount(TpQuery) = 0 then
  begin
    Showmessage('前缀为''' + UpperCase(Trim(Prefix)) +
      '''的编号记录不存在,请先在''自' + Char(#13) + Char(#13) +
      '动编号数据表设置''维护中设置此前缀编号.');
    TpQuery.Close;
    Result := '';
    Exit;
  end;
  TpPrefix := UpperCase(Trim(Prefix));
  TpCurrentNum := IntToStr(StrToInt(TpQuery.fieldbyname('CurrentNum').AsString)
    + 1);
  TpLength := TpQuery.fieldbyname('Length').AsString;
  TpFormat := TpQuery.fieldbyname('Format').AsString;
  TpCreateCode := TpCurrentNum;
  TpQuery.Close;
  //判断将要生成的值是否越界
  if Length(TpCurrentNum) > StrToInt(TpLength) then
  begin
    Showmessage('将要生成的编号''' + TpCurrentNum + '''长度已大于所规定的长度'''
      + TpLength + '''!');
    Result := '';
    Exit;
  end;
  //生成编号值,如:001
  for i := Length(TpCurrentNum) + 1 to StrToInt(TpLength) do
  begin
    TpCreateCode := '0' + TpCreateCode;
  end;
  //如果为'一般编号'则按一般编号规则,如:P001
  if TpFormat = '一般编号' then
  begin
    TpCreateCode := TpPrefix + TpCreateCode;
  end;
  //如果为'日期编号'则按日期编号规则,如:P20021028001
  if TpFormat = '日期编号' then
  begin
    TpCreateCode := TpPrefix +
      FrmMain.DateToCode(FrmMain.GetStdDateStr(DateToStr(Date))) + TpCreateCode;
  end;
  //修改数据库当前编号值
  TpQuery.SQL.Text := 'Update CreateCode Set CurrentNum=''' + Sql(TpCurrentNum)
    +
    ''',CreateCode=''' + Sql(TpCreateCode) + ''' Where Prefix=''' + Sql(TpPrefix)
    +
    '''';
  TpQuery.ExecSQL;
  TpQuery.Close;
  Result := TpCreateCode;
  TpQuery.Destroy;
end;

procedure TFrmMain.PrintListView(ListView: TListView);
var
  i, j, n: integer;
begin
  //检测打印数据
  if ListView.Items.Count = 0 then
  begin
    showmessage('当前没有可打印数据!');
    exit;
  end;

  //打开Excel表格
  if messagedlg('确认是否将表格内容导入到Excel中?', mtconfirmation, [mbyes,
    mbno], 0) = mryes then
  else
    exit;
  while IsObjectActive('Excel.Application') do
  begin
    try
      ExcelWorksheet1.Disconnect;
      ExcelWorkbook1.Disconnect;
      ExcelApplication1.Disconnect;
      ExcelApplication1.Quit;
    except
    end;
  end;
  try
    //创建一个excel对象，然后倒入数据。
    ExcelApplication1 := TExcelApplication.Create(self);
    ExcelApplication1.Connect;
  except
    MessageDlg('Excel may not be installed', mtError, [mbOk], 0);
    Abort;
  end;
  ExcelApplication1.Visible[0] := True;
  ExcelApplication1.Caption := 'Excel Application';
  ExcelApplication1.Workbooks.Add(Null, 0);
  ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
  ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _Worksheet);

  //添加Excel标题
  for i := 0 to ListView.Columns.Count - 1 do
  begin
    ExcelWorksheet1.Cells.Item[1, i + 1] := ListView.Column[i].Caption;
  end;

  //添加Excel内容
  n := 1;
  for i := 0 to ListView.Items.Count - 1 do
  begin
    n := n + 1;
    for j := -1 to ListView.Columns.Count - 2 do
    begin
      if j = -1 then
        ExcelWorksheet1.Cells.Item[n, j + 2] := ListView.Items[i].Caption
      else
        ExcelWorksheet1.Cells.Item[n, j + 2] := ListView.Items[i].SubItems[j];
    end;
  end;
end;

procedure TFrmMain.DelDbRecord(Lv: TListView; Table, KeyFields, LvColumnIndexs:
  string; LbCount: TLabel);
var
  i, j: integer;
  TpQuery: TAdoQuery;
  DelStr: string;
  Conditions: string;
  TpKeyFields, TpLvColumnIndexs: TStringList;
begin
  //检测是否选中记录
  if Lv.Items.Count = 0 then
  begin
    showmessage('当前没有可以删除的记录!');
    exit;
  end;
  if Lv.SelCount = 0 then
  begin
    showmessage('请选择所要删除的记录!');
    exit;
  end;
  //得到删除条件
  TpKeyFields := TStringList.Create;
  TpLvColumnIndexs := TStringList.Create;
  TpKeyFields.CommaText := KeyFields;
  TpLvColumnIndexs.CommaText := LvColumnIndexs;
  //将选中的记录全部删除
  if messagedlg('确认是否删除所选记录?', mtconfirmation, [mbyes, mbno], 0) =
    mryes then
  else
    exit;
  TpQuery := TAdoQuery.Create(self);
  TpQuery.Connection := UseDb;
  for i := Lv.Items.Count - 1 downto 0 do
  begin
    if Lv.Items[i].Selected then
    begin
      Conditions := '';
      for j := 0 to TpKeyFields.Count - 1 do
      begin
        if TpLvColumnIndexs[j] = '-1' then
          Conditions := Conditions + '(' + TpKeyFields[j] + '=' + '''' +
            FrmMain.Sql(Lv.Items[i].Caption) + ''')' + 'and';
        if TpLvColumnIndexs[j] <> '-1' then
          Conditions := Conditions + '(' + TpKeyFields[j] + '=' + '''' +
            FrmMain.Sql(Lv.Items[i].SubItems[StrToInt(TpLvColumnIndexs[j])]) +
          ''')'
            + 'and';
      end;
      Conditions := Copy(Conditions, 1, Length(Conditions) - 3);
      TpQuery.SQL.Text := 'delete from ' + Table + ' where ' + Conditions;
      TpQuery.ExecSQL;
      TpQuery.Close;
      Lv.Items[i].Delete;
    end;
  end;
  TpQuery.Destroy;
  TpKeyFields.Destroy;
  TpLvColumnIndexs.Destroy;
  LbCount.Caption := '[共' + IntToStr(Lv.Items.Count) + '条记录]';
end;

procedure TFrmMain.AddData(var Lv: TListView; var Query: TAdoQuery);
var
  QueryCount: integer;
  Counter: integer;
  LItem: TListItem;
  FieldCount: integer;
  FieldCounter: integer;
begin
  if Query.Active then
  begin
    //判断数据的数量
    QueryCount := RecordCount(Query);
    //从数据集合的第一条数据开始
    Query.First;
    //字段的个数。
    FieldCount := Query.FieldCount;
    if FieldCount = 1 then
    begin
      for Counter := 1 to QueryCount do
      begin
        //加入数据
        LItem := LV.Items.Add;
        LITem.Caption := Query.Fields[0].asstring;
        //更新listview
        litem.Update;
        //下一条记录
        Query.Next;
      end;
    end
    else
    begin
      for Counter := 1 to QueryCount do
      begin
        //多个数据字段的情况，先添加索引字段。
        LItem := LV.Items.Add;
        LITem.Caption := Query.Fields[0].asstring;
        for FieldCounter := 1 to FieldCount - 1 do
        begin
          //添加其他数据字段值。
          LITem.SubItems.Add(Query.Fields[FieldCounter].asstring);
        end;
        litem.Update;
        Query.Next;
      end;
    end;
  end;
end;

{更新LISTVIEW}

procedure TFrmMain.RefeshOne(TVarArray: array of string; VarCount: integer;
  var Lv: TListView);
var