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

📄 dbgridpro.pas

📁 DBGrid Delphi控件,除了愿有的功能,还上增加了一些东西,值得一看
💻 PAS
字号:
unit DBGridPro;

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
  TDBGridPro = class(TCustomDBGrid)
  private
    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
      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;
     { Protected declarations }
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    { Public declarations }
  published
    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;
    { Published declarations }
  end;

procedure Register;

implementation

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

procedure TDBGridPro.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 TDBGridPro.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 TDBGridPro.CreateEditor: TInplaceEdit;
begin
  result := inherited CreateEditor;
  hInPlaceEditorWndProc := result.WindowProc;
  result.WindowProc := InPlaceEditorWndProcHook;
end;

procedure TDBGridPro.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 TDBGridPro.Destroy;
begin
  FPan.Free;
  inherited;
end;

procedure TDBGridPro.DoKeyUped(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
  i,j:integer;
  P:Tpoint;
  cl : TColumn;
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 TDBGridPro.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 TDBGridPro.InPlaceEditorWndProcHook(var msg: TMessage);
var
  m : integer;
begin
  m := msg.Msg;
  {=inherited}
  hInplaceEditorWndProc(msg);
  {如果是改变位置和大小,重新加框}
  if m=WM_WINDOWPOSCHANGED then AddBox;
end;

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

end.

⌨️ 快捷键说明

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