mydbgrid.pas

双击数据窗口标题时,以该列排序(默认升序),再次双击反序排列 保存数据列出现的顺序及列的宽度

unit MyDBGrid;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, DBGrids, inifiles;

type
  TMyDBGrid = class(TDBGrid)
  private
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
{----------------------------------------------------------
 1．参数的含义：
 * posx 是控件左端的位置;
 * posy 是控件顶端的位置;
 * wd   是控件的宽度;
 * ht   是控件的高度;
 * bc   是控件的背景颜色;
 * fs   是字的大小;
 * fc   是字的颜色;
 * fstl 是字的字体，包括Bold,Italic,Underline & StrikeOut;
 2．使用说明：
 * 所有整型变量，-1代表缺省;
 * 所有字符串变量，''代表缺省；
 * 对于字体，分别用0——未选；
                   1——选中
   来表示，位置顺序为：Bold,Italic,Underline, StrikeOut
   例如：1010——Bold & Underline,
         0110——Italic & Underline;
 -----------------------------------------------------------}
    procedure SetMyPosition( var posx , posy : integer);
    procedure SetMyShape   ( var wd ,   ht   : integer; var bc : string);
    procedure SetMyFont    ( var fs : integer; var fc, fstl : string);

    procedure ReadShapeFile;   // 读取Grid窗口上次外貌信息
    procedure WriteShapeFile;  // 写入Grid窗口本次外貌信息
  published
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('MyStandard', [TMyDBGrid]);
end;

{ TMyDBGrid }


{ TMyDBGrid }


procedure TMyDBGrid.SetMyFont(var fs: integer; var fc, fstl: string);
var
  Styles : TFontStyles;
begin
  if fs   <> -1 then font.Size  := fs;
  if fc   <> '' then font.Color := TColor(fc);
  if fstl <> '' then begin
    Styles := [];
    case StrToInt(fstl) of
      0000 : Styles := Styles + [];
      0001 : Styles := Styles + [fsStrikeOut];
      0010 : Styles := Styles + [fsUnderline];
      0011 : Styles := Styles + [fsUnderline,fsStrikeOut];
      0100 : Styles := Styles + [fsItalic];
      0101 : Styles := Styles + [fsItalic,fsStrikeOut];
      0110 : Styles := Styles + [fsItalic,fsUnderline];
      0111 : Styles := Styles + [fsItalic,fsUnderline,fsStrikeOut];
      1000 : Styles := Styles + [fsBold];
      1001 : Styles := Styles + [fsBold,fsStrikeOut];
      1010 : Styles := Styles + [fsBold,fsUnderline];
      1011 : Styles := Styles + [fsBold,fsUnderline,fsStrikeOut];
      1100 : Styles := Styles + [fsBold,fsItalic];
      1101 : Styles := Styles + [fsBold,fsItalic];
      1110 : Styles := Styles + [fsBold,fsItalic,fsUnderline];
      1111 : Styles := Styles + [fsBold,fsItalic,fsUnderline,fsStrikeOut];
    end;
    font.Style := Styles;
  end;
end;

procedure TMyDBGrid.SetMyPosition(var posx, posy: integer);
begin
  if posx <> -1 then left       := posx;
  if posy <> -1 then top        := posy;
end;

procedure TMyDBGrid.SetMyShape(var wd, ht: integer; var bc: string);
begin
  if wd   <> -1 then width      := wd;
  if ht   <> -1 then height     := ht;
  if bc   <> '' then color      := TColor(bc);
end;

procedure TMyDBGrid.ReadShapeFile;
var
  i : integer;
  inifile : tinifile ;
  filepath : string;
begin
  filepath := 'g:\NewFile\app.ini'; 
  inifile:=tinifile.Create( filepath );
  if inifile.SectionExists(datasource.dataset.name) then
  begin
    for i:=0 to fieldcount-1 do
    begin
      fields[i].Index:=inifile.ReadInteger(datasource.dataset.name,fields[i].name+'.index',fields[i].index);
      fields[i].DisplayWidth:=inifile.ReadInteger(datasource.dataset.name,fields[i].name+'.width',fields[i].displaywidth);
    end;
  end;
  inifile.Free;
end;

procedure TMyDBGrid.WriteShapeFile;
var
  i : integer;
  inifile : tinifile;
  filepath : string;
begin
  filepath := 'g:\NewFile\app.ini';
  inifile:=tinifile.Create( filepath );

  for i:=0 to fieldcount-1 do
  begin
    inifile.writeInteger(datasource.dataset.name,fields[i].name+'.index',fields[i].index);
    inifile.writeInteger(datasource.dataset.name,fields[i].name+'.width',fields[i].displaywidth);
  end;
  inifile.Free;
end;

end.