当前位置:编程学习 > Delphi >>

delphi dbgrid 滚动条拖动

delphi 中怎么实现拖动dbgrid滚动条的同时,dbgrid的网格也跟着变化。谢谢
追问:

怎么实现dbgird里的内容也跟着走啊 我现在是 只有松手时dbgird才变化,怎么实现同时变化啊 谢谢

答案:

拖动dbgrid滚动条的时候,关联的数据库记录位置会发生变化,会触发数据控件的AfterScroll事件,在这个事件中处理dbgrid表格就可以了

delphi dbgrid确实是个BUG,不过有第三方控件的~~~

或者在窗体上添加一个ApplicationEvent控件,然后在它的OnMessage事件里写以下代码:
procedure TForm1.ApplicationEvents1Message(var Msg:tagMSG;var Handled:Boolean);
begin
if(DBGrid1.Focused)And(Msg.message=WM_MOUSEWHEEL)then
begin
if Msg.wParam>0 then
SendMessage(DBGrid1.Handle, WM_KEYDOWN, VK_UP, 0)
else
SendMessage(DBGrid1.Handle, WM_KEYDOWN, VK_DOWN, 0);
Handled := True;
end;
end;

这样就能正常使用了~~~

给你个我一直使用的单元:

//////////////////////////////////////////

unit uDBGridEx;

interface

uses
 Windows, Forms, Classes, Messages, DBGrids;

type
 TDBGridEx = class(TComponent)
 private
  D: TDBGrid;
  F: TWndMethod;
 protected
  procedure DBGridProc(var Message:TMessage);virtual;
 Public
  constructor Create(AOwner: TComponent; DBGrid: TDBGrid);reintroduce;
  destructor Destroy; override;
 end;

procedure WiseDBGrid(DBGrid: TDBGrid);overload;
procedure WiseDBGrid(AForm: TForm; DBGrid: TDBGrid);overload;

implementation

procedure WiseDBGrid(DBGrid: TDBGrid);overload;
begin
 TDBGridEx.Create(Application, DBGrid);
end;

procedure WiseDBGrid(AForm: TForm; DBGrid: TDBGrid);overload;
begin
 TDBGridEx.Create(AForm, DBGrid);
end;

{ TDBGridEx }

constructor TDBGridEx.Create(AOwner: TComponent; DBGrid: TDBGrid);
begin
 inherited Create(AOwner);
 F := DBGrid.WindowProc;
 D := DBGrid;
 D.WindowProc := DBGridProc;
end;

procedure TDBGridEx.DBGridProc(var Message: TMessage);
var
 si: TScrollInfo;
 Par: WPARAM;
begin
 case Message.Msg of
  WM_MOUSEWHEEL: //鼠标中键
   begin
    FillChar(si,SizeOf(si),0);
    si.cbSize := SizeOf(si); //拿全部信息
    si.fMask := SIF_TRACKPOS or SIF_RANGE or SIF_POS or SIF_PAGE;
    with TWMMouseWheel(Message) do begin
     GetScrollInfo(D.Handle, SB_VERT, si); // 拿滚动条相关信息
     if WheelDelta <0 then  //小于 0 则表示向下滚动
      begin
       if Keys = MK_CONTROL then //按下CTRL键,则翻页滚动.
        Par := SB_PAGEDOWN
       else Par := SB_LINEDOWN;  //不按特殊键,则单行滚动
       D.Perform(WM_VSCROLL,Par,0);
      end
     else begin
      if Keys = MK_CONTROL then  //同上,只是滚动方向相反
       Par := SB_PAGEUP
      else Par := SB_LINEUP;
      D.Perform(WM_VSCROLL,Par,0);
     end;
    end;
   end;
  WM_VSCROLL: //纵向滚动条
   begin
    with TWMVScroll(Message) do
    begin
     case ScrollCode of
      SB_THUMBTRACK:
       D.Perform(WM_VSCROLL,SB_THUMBPOSITION,Pos)
     end;
    end;
   end;
  end;         
 F(Message);
end;

destructor TDBGridEx.Destroy;
begin
 if (D <> nil) then D.WindowProc := F;
 inherited Destroy;
end;

end.
//////////////////////////////////////////////////////////

放个DBGrid1, 加载大量数据, 然后试试看效果如果, 支持翻页滚动(按住CTRL键).

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, Grids, DBGrids, DB, ADODB;

type
 TForm1 = class(TForm)
  ADOConnection1: TADOConnection;
  ADOTable1: TADOTable;
  DataSource1: TDataSource;
  DBGrid1: TDBGrid;
  procedure FormCreate(Sender: TObject);
 private
  { Private declarations }
 public
  { Public declarations }
 end;

var
 Form1: TForm1;

implementation

uses uDBGridEx;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 TDBGridEx.Create(Application, DBGrid1);
end;

end.

给你这个我一直使用的单元:

建个工程,放个DBGrid1加载大量数据用下边的代码试试效果, 看看能否达到你的要求吧.

//////////////////////////////////////////////////////////////////////////

unit uDBGridEx;

interface

uses
  Windows, Forms, Classes, Messages, DBGrids;

type
  TDBGridEx = class(TComponent)
  private
    D: TDBGrid;
    F: TWndMethod;
  protected
    procedure DBGridProc(var Message:TMessage);virtual;
  Public
    constructor Create(AOwner: TComponent; DBGrid: TDBGrid);reintroduce;
    destructor Destroy; override;
  end;

procedure WiseDBGrid(DBGrid: TDBGrid);overload;
procedure WiseDBGrid(AForm: TForm; DBGrid: TDBGrid);overload;

implementation

procedure WiseDBGrid(DBGrid: TDBGrid);overload;
begin
  TDBGridEx.Create(Application, DBGrid);
end;

procedure WiseDBGrid(AForm: TForm; DBGrid: TDBGrid);overload;
begin
  TDBGridEx.Create(AForm, DBGrid);
end;

{ TDBGridEx }

constructor TDBGridEx.Create(AOwner: TComponent; DBGrid: TDBGrid);
begin
  inherited Create(AOwner);
  F := DBGrid.WindowProc;
  D := DBGrid;
  D.WindowProc := DBGridProc;
end;

procedure TDBGridEx.DBGridProc(var Message: TMessage);
var
  si: TScrollInfo;
  Par: WPARAM;
begin
  case Message.Msg of
    WM_MOUSEWHEEL: //鼠标中键
      begin
        FillChar(si,SizeOf(si),0);
        si.cbSize := SizeOf(si); //拿全部信息
        si.fMask := SIF_TRACKPOS or SIF_RANGE or SIF_POS or SIF_PAGE;
        with TWMMouseWheel(Message) do begin
          GetScrollInfo(D.Handle, SB_VERT, si);  // 拿滚动条相关信息
          if WheelDelta <0 then    //小于 0 则表示向下滚动
            begin
              if Keys = MK_CONTROL then  //按下CTRL键,则翻页滚动.
                Par := SB_PAGEDOWN
              else Par := SB_LINEDOWN;   //不按特殊键,则单行滚动
              D.Perform(WM_VSCROLL,Par,0);
            end
          else begin
            if Keys = MK_CONTROL then    //同上,只是滚动方向相反
              Par := SB_PAGEUP
            else Par := SB_LINEUP;
            D.Perform(WM_VSCROLL,Par,0);
          end;
        end;
      end;
    WM_VSCROLL:  //纵向滚动条
      begin
        with TWMVScroll(Message) do
        begin
          case ScrollCode of
            SB_THUMBTRACK:
        

上一个:VB 和 Delphi 的区别
下一个:Delphi 菱行代码问题

CopyRight © 2012 站长网 编程知识问答 www.zzzyk.com All Rights Reserved
部份技术文章来自网络,