dbfunctions.pas

万能数据库查看程序 万能数据库查看程序

unit DBFunctions;

interface

uses  Dialogs,StrUtils,Windows, SysUtils, Variants, Classes, Graphics, Controls, Forms,Grids, DBGrids,DBTables,DBClient,DB, ADODB, Math,ComObj,ActiveX;


//公共变量过程声明
procedure DBGrid1TitleSort(Column:TColumn);  //让DBGrid组件的标题能进行对DBGrid内的数据对行排序
function  DBGridRecordSize(mColumn:TColumn):Boolean;
function  DBGridAutoSize(mDBGrid:TDBGrid;mOffset:Integer=8):Boolean;//让DBGrid1控件能自动调节字段的宽度
function  DBGridToHtml(mDBGrid:TDBGrid;mStrings:TStrings;mCaption:TCaption=''):Boolean; //把DBGrid组件内的数据导出到HTML文件
function  DBGridToTxt(mDBGrid:TDBGrid;mStrings:TStrings;symbol:string=' ';mCaption:TCaption=''):Boolean; //把DBGrid组件内的数据内容导出到TXT文本文件


implementation


//////////////////////让DBGrid组件的标题能进行对DBGrid内的数据对行排序////////////
  procedure DBGrid1TitleSort(Column:TColumn);
    var
       s,cFieldName:string;
       SqlStr,TempStr: string;
       i:integer;
       DataSet:TDataSet;
     procedure setTitle;
       var ii:integer;cStr:string;c:TColumn;
       begin
         for ii:=0 to TDBGrid(Column.Grid).Columns.Count-1 do
           begin
             c:=TDBGrid(Column.Grid).Columns[ii];
             cStr:=c.Title.Caption;
             if (pos('▲',cStr)=1) or (pos('▼',cStr)=1) then begin Delete(cStr,1,2); c.Title.Caption:=cStr; end;
           end;
       end;
    begin
      setTitle;
      DataSet:=Column.Grid.DataSource.DataSet;
      if Column.Field.FieldKind=fkLookup then cFieldName:=Column.Field.KeyFields
        else if Column.Field.FieldKind=fkCalculated then cFieldName:=Column.Field.KeyFields
        else cFieldName:=Column.FieldName;
      ////=================================AdoDataSet=====================
      if DataSet is TCustomADODataSet then
      begin
        s:=TCustomADODataSet(DataSet).Sort;
        if s='' then
          begin s:=cFieldName; Column.Title.Caption:='▲'+Column.Title.Caption;
          end else
          begin
            if Pos(cFieldName,s)<>0 then
              begin
                i:=Pos('DESC',s);
                if i<=0 then
                  begin s:=s+' DESC'; Column.Title.Caption:='▼'+Column.Title.Caption;
                  end else
                  begin Column.Title.Caption:='▲'+Column.Title.Caption; Delete(s,i,4); end;
              end else
              begin s:=cFieldName; Column.Title.Caption:='▲'+Column.Title.Caption;  end;
          end;
        TCustomADODataSet(DataSet).Sort:=s;  /////=================================AdoDataSet==================
      end else if (DataSet is TQuery) or (DataSet is TTable) then
      begin
      while Pos(cFieldName,';')<>0 do cFieldName:=copy(cFieldName,1,Pos(cFieldName,';')-1)+ ','+ copy(cFieldName,Pos(cFieldName,';')+1,100);
      with TQuery(TDBGrid(Column.Grid).DataSource.DataSet) do
        begin  ////=================================BDEQuery=====================
          SqlStr:=Trim(UpperCase(Sql.Text));
          if RightStr(SqlStr,1)=';' then begin SqlStr:=LeftStr(SqlStr,length(Sqlstr)-1);  end;
          //if pos(cFieldName,SqlStr)=0 then exit;
          if (pos('ORDER',SqlStr)=0) or (pos('ASC',SqlStr)=0) then begin TempStr:=' Order By '+cFieldName+' Asc';    end
             else begin   TempStr:= ' Order By '+cFieldName+' Desc';      end;
          if pos('ORDER',SqlStr)<>0 then SqlStr:=Copy(SqlStr,1,pos('ORDER',SqlStr)-1);
          SqlStr:=SqlStr+TempStr+';';
          Active:=False;
          Sql.Clear;
          Sql.Text:=SqlStr;
          Prepare;
          Open;
        end;   ////=================================BDEQuery=====================
      end else if DataSet is TClientDataSet then  /////////============================Clientdataset==================
      begin
          if TClientDataSet(DataSet).indexfieldnames<>'' then
          begin
            i:=TClientDataSet(DataSet).IndexDefs.IndexOf('i'+Column.FieldName);
            if i=-1 then
            begin
              with TClientDataSet(DataSet).IndexDefs.AddIndexDef do
              begin
                Name:='i'+Column.FieldName;
                Fields:=Column.FieldName;
                DescFields:=Column.FieldName;
              end;
            end;
            TClientDataSet(DataSet).IndexFieldNames:='';
            TClientDataSet(DataSet).IndexName:='i'+Column.FieldName;
            Column.Title.Caption:='▼'+Column.Title.Caption;
          end else
          begin
            TClientDataSet(DataSet).IndexName:='';
            TClientDataSet(DataSet).IndexFieldNames:=column.fieldname;
            Column.Title.Caption:='▲'+Column.Title.Caption;
          end; /////////============================Clientdataset======================
      end;
  end; //////////////////////让DBGrid组件的标题能进行对DBGrid内的数据对行排序////////////


/////////////让DBGrid1控件能自动调节字段的宽度（数据网格自动适应宽度）
//用法:用DBGrid的DBGrid1DrawColumnCell事件调用DBGridRecordSize(Column); 然后调用DBGridAutoSize(DBGrid1)即可
  function  DBGridRecordSize(mColumn:TColumn):Boolean;      //uses Math;
    begin /// 返回DBGrid控件字段宽度的过程
      Result:=False;
      if not Assigned(mColumn.Field) then Exit;
      mColumn.Field.Tag:=Max(mColumn.Field.Tag,
      TDBGrid(mColumn.Grid).Canvas.TextWidth(mColumn.Field.DisplayText));
      Result:=True;
    end; // DBGridRecordSize
  function  DBGridAutoSize(mDBGrid:TDBGrid;mOffset:Integer=8):Boolean;
  var //调整数据网格自动适应宽度     mOffset为让自动放松的百分比
    I:Integer;
    begin
      Result:=False;
      if not Assigned(mDBGrid) then Exit;
      if not Assigned(mDBGrid.DataSource) then Exit;
      if not Assigned(mDBGrid.DataSource.DataSet) then Exit;
      if not mDBGrid.DataSource.DataSet.Active then Exit;
      for I:=0 to mDBGrid.Columns.Count - 1 do begin
        if not mDBGrid.Columns[I].Visible then Continue;
          if Assigned(mDBGrid.Columns[I].Field) then mDBGrid.Columns[I].Width:=Max(mDBGrid.Columns[I].Field.Tag,
          mDBGrid.Canvas.TextWidth(mDBGrid.Columns[I].Title.Caption)) + mOffset
          else mDBGrid.Columns[I].Width:=mDBGrid.Canvas.TextWidth(mDBGrid.Columns[I].Title.Caption) + mOffset;
      mDBGrid.Refresh;
    end;
    Result:=True;
  end; /////////////让DBGrid1控件能自动调节字段的宽度（数据网格自动适应宽度）//////////////////


///////////////////////把DBGrid组件内的数据内容导出到HTML网页文件//////////////////////////////
//用法:DBGridToHtml(DBGrid1,Date,Table);DBGrid1为DBGrid控件,Date为一个TSrings的变量,Table为HTML文件的标题。导出到文件:Date.SaveToFile(FileName);  FileName为要导出文件的路径及文件名
  function  ColorToHtml(mColor:TColor):string;
    begin
      Application.ProcessMessages;
      mColor:=ColorToRGB(mColor);
      Result:=Format('#%.2x%.2x%.2x',[GetRValue(mColor), GetGValue(mColor), GetBValue(mColor)]);
    end; { ColorToHtml }
  function  StrToHtml(mStr:string; mFont:TFont =nil):string;
    var
      vLeft, vRight:string;
    begin
      Application.ProcessMessages;
      Result:=mStr;
      Result:=StringReplace(Result, '&', '&AMP;', [rfReplaceAll]);
      Result:=StringReplace(Result, '<', '&LT;', [rfReplaceAll]);
      Result:=StringReplace(Result, '>', '&GT;', [rfReplaceAll]);
      if Result ='' then Result:='-';
      if not Assigned(mFont) then Exit;
      vLeft:=Format('<FONT FACE="%s" COLOR="%s">',[mFont.Name, ColorToHtml(mFont.Color)]);vRight:='</FONT>';
      if fsBold in mFont.Style then begin
      vLeft:=vLeft + '<B>';
      vRight:='</B>' + vRight;
      end;
      if fsItalic in mFont.Style then begin
      vLeft:=vLeft + '<I>';
      vRight:='</I>' + vRight;
      end;
      if fsUnderline in mFont.Style then begin
      vLeft:=vLeft + '<U>';
      vRight:='</U>' + vRight;
      end;
      if fsStrikeOut in mFont.Style then begin
      vLeft:=vLeft + '<S>';
      vRight:='</S>' + vRight;
      end;
      Result:=vLeft + Result + vRight;
    end; { StrToHtml }
  function  DBGridToHtml(mDBGrid:TDBGrid;mStrings:TStrings;mCaption:TCaption=''):Boolean;
    const
      cAlignText:array[TAlignment] of string =('LEFT', 'RIGHT', 'CENTER');
    var
      vColFormat:string;
      vColText:string;
      vAllWidth:Integer;
      vWidths:array of Integer;
      vBookmark:string;
      I, J:Integer;
    begin
      Application.ProcessMessages;
      Result:=False;
      if not Assigned(mStrings) then Exit;
      if not Assigned(mDBGrid) then Exit;
      if not Assigned(mDBGrid.DataSource) then Exit;
      if not Assigned(mDBGrid.DataSource.DataSet) then Exit;
      if not mDBGrid.DataSource.DataSet.Active then Exit;
      vBookmark:=mDBGrid.DataSource.DataSet.Bookmark;
      mDBGrid.DataSource.DataSet.DisableControls;