⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 asdbgrid.pas

📁 delphi + mssql + 控件 2008.02.25
💻 PAS
字号:
unit ASDBGrid;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Grids, DBGrids, ExtCtrls,
  richEdit, DBCtrls, DB;
type
  TCurCell = Record {当前焦点Cell的位置}
  X : integer; {有焦点Cell的ColumnIndex}
  Y : integer; {有焦点Cell所在的纪录的纪录号}
  tag : integer; {最近进入该Cell后是否弹出了下拉列表}
  r : TRect; {没有使用 }
end;

type
  TAutoSizeDBGrid = class(TDBGrid)
  private
    { Private declarations }
    hr,hc1 : HWND; {创建空心区域的Region Handle}
    FPan : TPanel; {显示黑框用的Panel}
    hInplaceEditorWndProc : TWndMethod; {编辑框原来的WindowProc}
    {勾挂到编辑框的WindowProc}
    procedure InPlaceEditorWndProcHook(var msg : TMessage);
    procedure AddBox; {显示边框}
    {实现TCustomDBGrid的OnDrawColumnCell事件}
    procedure DoOwnDrawColumnCell(Sender: TObject; const Rect: TRect;
          DataCol: Integer; Column: TColumn; State: TGridDrawState);
    {处理键盘事件}
    procedure DoKeyUped(Sender: TObject; var Key: Word; Shift: TShiftState);
  protected
    { Protected declarations }
    curCell : TCurCell; {记录当前有焦点的Cell}
    FOwnDraw : boolean; {代替TCustomDBGrid.DefaultDrawing}
    FOnDraw : TDrawColumnCellEvent; {代替TCustomDBGrid.OnDrawColumnCell}
    function CreateEditor : TInplaceEdit; override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure DefaultDrawColumnCell(const Rect: TRect;DataCol: Integer;
          Column: TColumn; State: TGridDrawState); overload;
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;

    function DBGridAutoSize(mDBGrid: TDBGrid; mOffset: Integer = 20): Boolean;
    function Max(const int1:integer;const int2:integer):integer;

  published
    { Published declarations }
    property Align;
    property Anchors;
    property BiDiMode;
    property BorderStyle;
    property Color;
    property Columns stored False; //StoreColumns;
    property Constraints;
    property Ctl3D;
    property DataSource;
    property OwnDraw : boolean read FOwnDraw write FOwnDraw default false;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FixedColor;
    property Font;
    property ImeMode;
    property ImeName;
    property Options;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property TitleFont;
    property Visible;
    property OnCellClick;
    property OnColEnter;
    property OnColExit;
    property OnColumnMoved;
    property OnDrawDataCell; { obsolete }
    property OnOwnDrawColumnCell : TDrawColumnCellEvent read FOnDraw write FOnDraw;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEditButtonClick;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyup;
    property OnKeyPress;
    property OnKeyDown;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
    property OnTitleClick;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Data Controls', [TAutoSizeDBGrid]);
end;

{ TDBGridPro }

procedure TAutoSizeDBGrid.AddBox;
var
   p,p1 : TRect;
begin
   GetWindowRect(InPlaceEditor.Handle,p);
   GetWindowRect(FPan.Handle,p1);
   if (p.Left=p1.Left) and (p.Top=p1.Top) and (p.Right=p1.Right) and (p.Bottom=p1.Bottom) then exit;
   if hr<>0 then DeleteObject(hr);
   if hc1<>0 then DeleteObject(hc1);
   {创建内外两个Region}
   hr := CreateRectRgn(0,0,p.Right-p.Left+4,p.Bottom-p.Top+4);
   hc1:= CreateRectRgn(2,2,p.Right-p.Left+2,p.Bottom-p.Top+2);
   {组合成空心Region}
   CombineRgn(hr,hc1,hr,RGN_XOR);
   SetWindowRgn(FPan.Handle,hr,true);
   FPan.Parent := InPlaceEditor.Parent;
   FPan.ParentWindow := InPlaceEditor.ParentWindow;
   FPan.Height := InPlaceEditor.Height+4;
   FPan.Left := InPlaceEditor.Left-2;
   FPan.Top :=InPlaceEditor.Top-2;
   FPan.Width := InPlaceEditor.Width+4;
   FPan.BringToFront;
end;

constructor TAutoSizeDBGrid.Create(AOwner: TComponent);
begin
  inherited;
  {创建作为边框的Panel}
  FPan := TPanel.Create(nil);
  FPan.Parent := Self;
  FPan.Height := 0;
  FPan.Color := 0;
  FPan.Ctl3D := false;
  FPan.BevelInner := bvNone;
  FPan.BevelOuter := bvNone;
  FPan.Visible := true;
  DefaultDrawing := false;
  OnDrawColumnCell := DoOwnDrawColumnCell;
  OnOwnDrawColumnCell := nil;
  curCell.X := -1;
  curCell.Y := -1;
  curCell.tag := 0;
  hr := 0;
  hc1 := 0;
end;

function TAutoSizeDBGrid.CreateEditor: TInplaceEdit;
begin
  result := inherited CreateEditor;
  hInPlaceEditorWndProc := result.WindowProc;
  result.WindowProc := InPlaceEditorWndProcHook;
end;

procedure TAutoSizeDBGrid.DefaultDrawColumnCell(const Rect: TRect;
       DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
   {如果要画焦点,就让DBGrid进入编辑状态}
   if (gdFocused in State) then
     begin
       EditorMode := true;
       AddBox;
       {如果是进入一个新的Cell,全选其中的字符}
       if (curCell.X <> DataCol) or (curCell.Y <> DataSource.DataSet.RecNo) then
          begin
            curCell.X := DataCol;
            curCell.Y := DataSource.DataSet.RecNo;
            curCell.tag := 0;
            GetWindowRect(InPlaceEditor.Handle,curCell.r);
            SendMessage(InPlaceEditor.Handle,EM_SETSEL,0,1000);
          end;
     end
     else {正常显示状态的Cell}
     TCustomDBGrid(Self).DefaultDrawColumnCell(Rect,DataCol,Column,State);
end;

destructor TAutoSizeDBGrid.Destroy;
begin
   FPan.Free;
   inherited;
end;

procedure TAutoSizeDBGrid.DoKeyUped(Sender: TObject; var Key: Word;
     Shift: TShiftState);
var
  cl : TColumn;
  p : TPOINT;
  i,j :integer;

begin
  cl := Columns[SelectedIndex];
  case Key of
  VK_RETURN:
   begin
   {一个Column为下拉类型,如果:
   1 该Column的按钮类型为自动类型
   2 该Column的PickList非空,或者其对应的字段是lookup类型}
   if (cl.ButtonStyle=cbsAuto) and ((cl.PickList.Count>0) or (cl.Field.FieldKind=fkLookup))
       and (curCell.tag = 0) and not (ssShift in Shift) then
         begin
           {把回车转换成Alt+向下弹出下拉列表}
           Key := 0;
           Shift := [ ];
           keybd_event(VK_MENU,0,0,0);
           keybd_event(VK_DOWN,0,0,0);
           keybd_event(VK_DOWN,0,KEYEVENTF_KEYUP,0);
           keybd_event(VK_MENU,0,KEYEVENTF_KEYUP,0);
           curCell.tag := 1;
           exit;
         end;
   {否则转换成Tab}
   Key := 0;
   keybd_event(VK_TAB,0,0,0);
   keybd_event(VK_TAB,0,KEYEVENTF_KEYUP,0);
   end;
     VK_RIGHT :
       begin
        {获得编辑框中的文字长度}
        i := GetWindowTextLength(InPlaceEditor.Handle);
        {获得编辑框中的光标位置}
        GetCaretPos(p);
        p.X := p.X + p.Y shr 16;
        j := SendMessage(InPlaceEditor.Handle,EM_CHARFROMPOS,0,p.X);
         if (i=j) then {行末位置}
           begin
            Key := 0;
            keybd_event(VK_TAB,0,0,0);
            keybd_event(VK_TAB,0,KEYEVENTF_KEYUP,0);
           end;
       end;
     VK_LEFT :
       begin
         GetCaretPos(p);
         p.X := p.X + p.Y shr 16;
          if SendMessage(InPlaceEditor.Handle,EM_CHARFROMPOS,0,p.X)=0 then
            begin {行首位置}
             Key := 0;
             keybd_event(VK_SHIFT,0,0,0);
             keybd_event(VK_TAB,0,0,0);
             keybd_event(VK_TAB,0,KEYEVENTF_KEYUP,0);
             keybd_event(VK_SHIFT,0,KEYEVENTF_KEYUP,0);
            end;
       end
   else
   begin {记录用户是否作了修改}
     if (Columns[SelectedIndex].PickList.Count>0) and (curCell.tag = 0) then
     if SendMessage(InPlaceEditor.Handle,EM_GETMODIFY,0,0)=1 then
     curCell.tag := 1;
   end;
   end;
end;

procedure TAutoSizeDBGrid.DoOwnDrawColumnCell(Sender: TObject; const Rect: TRect;
     DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
   if FOwnDraw=false then DefaultDrawColumnCell(Rect,DataCol,Column,State);
   if @OnOwnDrawColumnCell<>nil then OnOwnDrawColumnCell(Sender,Rect,DataCol,
   Column,State);
end;

procedure TAutoSizeDBGrid.InPlaceEditorWndProcHook(var msg: TMessage);
var
  m : integer;
begin
  m := msg.Msg;
  {=inherited}
  hInplaceEditorWndProc(msg);
  {如果是改变位置和大小,重新加框}
  if m=WM_WINDOWPOSCHANGED then AddBox;
end;

procedure TAutoSizeDBGrid.KeyUp(var Key: Word; Shift: TShiftState);
begin
  inherited;
  DoKeyUped(Self,Key,Shift);
end;

function TAutoSizeDBGrid.Max(const int1:integer;const int2:integer):integer;
begin
  Result:=int2;
  if int1>int2 then
  begin
    Result:=int1;
  end;
end;

function TAutoSizeDBGrid.DBGridAutoSize(mDBGrid: TDBGrid; mOffset: Integer = 20): Boolean;
var
  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
    else
      mOffset := 20;
  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
    begin
       mDBGrid.Columns[I].Width:= Max(mDBGrid.Columns[I].Field.Tag,mDBGrid.Canvas.TextWidth(mDBGrid.Columns[I].Title.Caption)) + mOffset;
       mDBGrid.Columns[I].Alignment:=taCenter;
       mDBGrid.Columns[I].Title.Alignment:=taCenter;
    end
    else
    begin
      mDBGrid.Columns[I].Width:= mDBGrid.Canvas.TextWidth(mDBGrid.Columns[I].Title.Caption) + mOffset;
      mDBGrid.Columns[I].Alignment:=taCenter;
      mDBGrid.Columns[I].Title.Alignment:=taCenter;
    end;
    mDBGrid.Refresh;
  end;
  Result := True;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -