同步滚动组件Delphi [英] Synchronized Scrolling Components Delphi

查看：186
本文介绍了同步滚动组件Delphi的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我正在尝试同步一个VCL Forms应用程序中两个TDBGrid组件的滚动，我有困难拦截每个网格组件的WndProc没有一些堆栈问题。我已经尝试在滚动事件下发送WM_VSCROLL消息，但这仍然导致错误的操作。它需要单击滚动条，以及突出显示单元格，或向上或向下鼠标按钮。整个想法是让彼此相邻的两个网格显示一种匹配的对话框。



尝试 / p> 

  SendMessage（gridX.Handle，WM_VSCROLL，SB_LINEDOWN，0）;

另外 

 程序TForm1.GridXCustomWndProc（var Msg：TMessage）; 
 begin 
 Msg.Result：= CallWindowProc（POldWndProc，gridX.Handle，Msg.Msg，Msg.wParam，Msg.lParam）; 
 
 if（Msg.Msg = WM_VSCROLL）then 
 begin 
 gridY.SetActiveRow（gridX.GetActiveRow）; 
 gridY.Perform（Msg.Msg，Msg.wParam，Msg.lParam）; 
 SetScrollPos（gridY.Handle，SB_VERT，HIWORD（Msg.wParam），True）; 
结束
结束

和 

 程序TForm1.GridxCustomWndProc（var Msg：TMessage）; 
 begin 
 if（Msg.Msg = WM_VSCROLL）then 
 begin 
 gridY.SetActiveRow（gridX.GetActiveRow）; 
 gridY.Perform（Msg.Msg，Msg.wParam，Msg.lParam）; 
 SetScrollPos（gridY.Handle，SB_VERT，HIWORD（Msg.wParam），True）; 
结束
继承WndProc（Msg）; 
结束

第一个只是一个临时解决方案，第二个结果是无效内存读取，第三个结果是堆栈溢出。所以这些解决方案似乎都不适合我。我会喜欢一些关于如何完成这项任务的投入！感谢提前。



更新：解决方案



  private 
 [...] 
 GridXWndProc，GridXSaveWndProc：指针; 
 GridYWndProc，GridYSaveWndProc：指针; 
程序GridXCustomWndProc（var Msg：TMessage）; 
程序GridYCustomWndProc（var Msg：TMessage）; 
 
 procedure TForm1.FormCreate（Sender：TObject）; 
 begin 
 GridXWndProc：= classes.MakeObjectInstance（GridXCustomWndProc）; 
 GridXSaveWndProc：=指针（GetWindowLong（GridX.Handle，GWL_WNDPROC））; 
 SetWindowLong（GridX.Handle，GWL_WNDPROC，LongInt（GridXWndProc））; 
 
 GridYWndProc：= classes.MakeObjectInstance（GridYCustomWndProc）; 
 GridYSaveWndProc：=指针（GetWindowLong（GridY.Handle，GWL_WNDPROC））; 
 SetWindowLong（GridY.Handle，GWL_WNDPROC，LongInt（GridYWndProc））; 
结束
 
程序TForm1.GridXCustomWndProc（var Msg：TMessage）; 
 begin 
 Msg.Result：= CallWindowProc（GridXSaveWndProc，GridX.Handle，Msg.Msg，Msg.WParam，Msg.LParam）; 
 case Msg.Msg 
 WM_KEYDOWN：
 begin 
 case TWMKey（Msg）.CharCode of VK_UP，VK_DOWN，VK_PRIOR，VK_NEXT：
 GridY.Perform（Msg。消息，帕帕姆女士，帕拉姆女士）; 
结束
结束
 WM_VSCROLL：
 GridY.Perform（Msg.Msg，Msg.WParam，Msg.LParam）; 
 WM_HSCROLL：
 GridY.Perform（Msg.Msg，Msg.WParam，Msg.LParam）; 
 WM_MOUSEWHEEL：
 begin 
 ActiveControl：= GridY; 
 GridY.Perform（Msg.Msg，Msg.WParam，Msg.LParam）; 
结束
 WM_DESTROY：
 begin 
 SetWindowLong（GridX.Handle，GWL_WNDPROC，Longint（GridXSaveWndProc））; 
 Classes.FreeObjectInstance（GridXWndProc）; 
结束
结束
结束
 
 procedure TForm1.GridXMouseDown（Sender：TObject; Button：TMouseButton; Shift：TShiftState; X，Y：Integer）; 
 begin 
 GridY.SetActiveRow（GridX.GetActiveRow）; 
结束
 
程序TForm1.GridYCustomWndProc（var Msg：TMessage）; 
 begin 
 Msg.Result：= CallWindowProc（GridYSaveWndProc，GridY.Handle，Msg.Msg，Msg.WParam，Msg.LParam）; 
 case Msg.Msg 
 WM_KEYDOWN：
 begin 
 case TWMKey（Msg）.CharCode of VK_UP，VK_DOWN，VK_PRIOR，VK_NEXT：
 GridX.Perform（Msg。消息，帕帕姆女士，帕拉姆女士）; 
结束
结束
 WM_VSCROLL：
 GridX.Perform（Msg.Msg，Msg.WParam，Msg.LParam）; 
 WM_HSCROLL：
 GridX.Perform（Msg.Msg，Msg.WParam，Msg.LParam）; 
 WM_MOUSEWHEEL：
 begin 
 ActiveControl：= GridX; 
 GridX.Perform（Msg.Msg，Msg.WParam，Msg.LParam）; 
结束
 WM_DESTROY：
 begin 
 SetWindowLong（GridY.Handle，GWL_WNDPROC，Longint（GridYSaveWndProc））; 
 Classes.FreeObjectInstance（GridYWndProc）; 
结束
结束
结束
 
 procedure TForm1.GridYMouseDown（Sender：TObject; Button：TMouseButton; Shift：TShiftState; X，Y：Integer）; 
 begin 
 GridX.SetActiveRow（GridY.GetActiveRow）; 
结束

感谢 - Sertac Akyuz的解决方案。当使用网格集成到VCL表单应用程序中时，它们将在滚动中相互模仿，并突出显示所选记录。

解决方案

可能正在为两个网格实现消息覆盖。 GridX滚动GridY，然后GridY滚动GridX，依次... SO。您可以通过用标记围绕块来保护表面滚动代码。

 键入
 TForm1 = class（TForm）
 [..] 
 private 
 FNoScrollGridX，FNoScrollGridY：Boolean; 
 [...] 
 
程序TForm1.GridXCustomWndProc（var Msg：TMessage）; 
 begin 
 Msg.Result：= CallWindowProc（POldWndProc，gridX.Handle，Msg.Msg，Msg.wParam，Msg.lParam）; 
 
如果（Msg.Msg = WM_VSCROLL）然后
开始
如果不是FNoScrollGridX然后
开始
 FNoScrollGridX：= True 
 gridY.SetActiveRow （gridX.GetActiveRow）; 
 gridY.Perform（Msg.Msg，Msg.wParam，Msg.lParam）; 
 // SetScrollPos（gridY.Handle，SB_VERT，HIWORD（Msg.wParam），True）; 
结束
 FNoScrollGridX：= False; 
结束
结束

GridY的类似代码。 BTW，你不需要SetScrollPos。


编辑： 

  TForm1 = class 
 [..] 
 private 
 GridXWndProc，GridXSaveWndProc：Pointer; 
 GridYWndProc，GridYSaveWndProc：指针; 
程序GridXCustomWndProc（var Msg：TMessage）; 
程序GridYCustomWndProc（var Msg：TMessage）; 
 [..] 
 
程序TForm1.FormCreate（发件人：TObject）; 
 begin 
 [..] 
 
 GridXWndProc：= classes.MakeObjectInstance（GridXCustomWndProc）; 
 GridXSaveWndProc：=指针（GetWindowLong（GridX.Handle，GWL_WNDPROC））; 
 SetWindowLong（GridX.Handle，GWL_WNDPROC，LongInt（GridXWndProc））; 
 
 GridYWndProc：= classes.MakeObjectInstance（GridYCustomWndProc）; 
 GridYSaveWndProc：=指针（GetWindowLong（GridY.Handle，GWL_WNDPROC））; 
 SetWindowLong（GridY.Handle，GWL_WNDPROC，LongInt（GridYWndProc））; 
结束
 
程序TForm1.GridXCustomWndProc（var Msg：TMessage）; 
 begin 
 Msg.Result：= CallWindowProc（GridXSaveWndProc，GridX.Handle，
 Msg.Msg，Msg.WParam，Msg.LParam）; 
 
 case Msg.Msg 
 WM_KEYDOWN：
 begin 
 case TWMKey（Msg）.CharCode of 
 VK_UP，VK_DOWN，VK_PRIOR，VK_NEXT：
 GridY.Perform（Msg.Msg，Msg.WParam，Msg.LParam）; 
结束
结束
 WM_VSCROLL：GridY.Perform（Msg.Msg，Msg.WParam，Msg.LParam）; 
 WM_MOUSEWHEEL：
 begin 
 ActiveControl：= GridY; 
 GridY.Perform（Msg.Msg，Msg.WParam，Msg.LParam）; 
结束
 WM_DESTROY：
 begin 
 SetWindowLong（GridX.Handle，GWL_WNDPROC，Longint（GridXSaveWndProc））; 
 Classes.FreeObjectInstance（GridXWndProc）; 
结束
结束
结束
 
程序TForm1.GridYCustomWndProc（var Msg：TMessage）; 
 begin 
 Msg.Result：= CallWindowProc（GridYSaveWndProc，GridY.Handle，
 Msg.Msg，Msg.WParam，Msg.LParam）; 
 
 case Msg.Msg 
 WM_KEYDOWN：
 begin 
 case TWMKey（Msg）.CharCode of 
 VK_UP，VK_DOWN，VK_PRIOR，VK_NEXT：
 GridX.Perform（Msg.Msg，Msg.WParam，Msg.LParam）; 
结束
结束
 WM_VSCROLL：GridX.Perform（Msg.Msg，Msg.WParam，Msg.LParam）; 
 WM_MOUSEWHEEL：
 begin 
 ActiveControl：= GridX; 
 GridY.Perform（Msg.Msg，Msg.WParam，Msg.LParam）; 
结束
 WM_DESTROY：
 begin 
 SetWindowLong（GridY.Handle，GWL_WNDPROC，Longint（GridYSaveWndProc））; 
 Classes.FreeObjectInstance（GridYWndProc）; 
结束
结束
结束


I am trying to synchronize the scrolling of two TDBGrid components in a VCL Forms application, I am having difficulties intercepting the WndProc of each grid component without some stack issues. I have tried sending WM_VSCROLL messages under scrolling events but this still results in the incorrect operation. It needs to work for clicking the scrollbar, as well as highlighting a cell, or an up or down mouse button. The whole idea is to have two grids next to each other displaying a sort of matching dialog.

Tried

SendMessage( gridX.Handle, WM_VSCROLL, SB_LINEDOWN, 0 );

Also

procedure TForm1.GridXCustomWndProc( var Msg: TMessage );
begin
Msg.Result := CallWindowProc( POldWndProc, gridX.Handle, Msg.Msg, Msg.wParam, Msg.lParam );

   if ( Msg.Msg = WM_VSCROLL ) then 
   begin
      gridY.SetActiveRow( gridX.GetActiveRow );
      gridY.Perform( Msg.Msg, Msg.wParam, Msg.lParam );
      SetScrollPos( gridY.Handle, SB_VERT, HIWORD( Msg.wParam ), True );
   end;
end;

And

procedure TForm1.GridxCustomWndProc( var Msg: TMessage );
begin
   if ( Msg.Msg = WM_VSCROLL ) then 
   begin
      gridY.SetActiveRow( gridX.GetActiveRow );
      gridY.Perform( Msg.Msg, Msg.wParam, Msg.lParam );
      SetScrollPos( gridY.Handle, SB_VERT, HIWORD( Msg.wParam ), True );
   end;
   inherited WndProc( Msg );
end;

The First is only a temporary solution, the second results in invalid memory reads, and the third results in a stack overflow. So none of these solutions seems to work for me. I'd love some input on how to accomplish this task! Thanks in advance.

UPDATE: Solution

  private
    [...]
    GridXWndProc, GridXSaveWndProc: Pointer;
    GridYWndProc, GridYSaveWndProc: Pointer;
    procedure GridXCustomWndProc( var Msg: TMessage );
    procedure GridYCustomWndProc( var Msg: TMessage );

procedure TForm1.FormCreate(Sender: TObject);
begin
  GridXWndProc := classes.MakeObjectInstance( GridXCustomWndProc );
  GridXSaveWndProc := Pointer( GetWindowLong( GridX.Handle, GWL_WNDPROC ) );
  SetWindowLong( GridX.Handle, GWL_WNDPROC, LongInt( GridXWndProc ) );

  GridYWndProc := classes.MakeObjectInstance( GridYCustomWndProc );
  GridYSaveWndProc := Pointer( GetWindowLong( GridY.Handle, GWL_WNDPROC ) );
  SetWindowLong( GridY.Handle, GWL_WNDPROC, LongInt( GridYWndProc ) );
end;

procedure TForm1.GridXCustomWndProc( var Msg: TMessage );
begin
   Msg.Result := CallWindowProc( GridXSaveWndProc, GridX.Handle, Msg.Msg, Msg.WParam, Msg.LParam );
   case Msg.Msg of
      WM_KEYDOWN:
      begin
         case TWMKey( Msg ).CharCode of VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT:
            GridY.Perform( Msg.Msg, Msg.WParam, Msg.LParam );
         end;
      end;
      WM_VSCROLL:
         GridY.Perform( Msg.Msg, Msg.WParam, Msg.LParam );
      WM_HSCROLL:
         GridY.Perform( Msg.Msg, Msg.WParam, Msg.LParam );
      WM_MOUSEWHEEL:
      begin
         ActiveControl := GridY;
         GridY.Perform( Msg.Msg, Msg.WParam, Msg.LParam );
      end;
      WM_DESTROY:
      begin
         SetWindowLong( GridX.Handle, GWL_WNDPROC, Longint( GridXSaveWndProc ) );
         Classes.FreeObjectInstance( GridXWndProc );
      end;
  end;
end;

procedure TForm1.GridXMouseDown( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
   GridY.SetActiveRow( GridX.GetActiveRow );
end;

procedure TForm1.GridYCustomWndProc( var Msg: TMessage );
begin
   Msg.Result := CallWindowProc( GridYSaveWndProc, GridY.Handle, Msg.Msg, Msg.WParam, Msg.LParam );
   case Msg.Msg of
      WM_KEYDOWN:
      begin
         case TWMKey( Msg ).CharCode of VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT:
            GridX.Perform( Msg.Msg, Msg.WParam, Msg.LParam );
         end;
      end;
      WM_VSCROLL:
         GridX.Perform( Msg.Msg, Msg.WParam, Msg.LParam );
      WM_HSCROLL:
         GridX.Perform( Msg.Msg, Msg.WParam, Msg.LParam );
      WM_MOUSEWHEEL:
      begin
         ActiveControl := GridX;
         GridX.Perform( Msg.Msg, Msg.WParam, Msg.LParam );
      end;
      WM_DESTROY:
      begin
         SetWindowLong( GridY.Handle, GWL_WNDPROC, Longint( GridYSaveWndProc ) );
         Classes.FreeObjectInstance( GridYWndProc );
      end;
   end;
end;

procedure TForm1.GridYMouseDown( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
   GridX.SetActiveRow( GridY.GetActiveRow );
end;

Thanks to - Sertac Akyuz for the solution. When integrated into a VCL forms application using grids, they will mimmic each other in scrolling, and highlighting the selected record.

解决方案

You are probably implementing the message override for both of the grids. GridX scrolls GridY, which in turn scrolls GridX, which in turn ... SO. You can protect the superficial scrolling code by surrounding the block with flags.

type
  TForm1 = class(TForm)
    [..] 
  private
    FNoScrollGridX, FNoScrollGridY: Boolean;
    [..]

procedure TForm1.GridXCustomWndProc( var Msg: TMessage );
begin
  Msg.Result := CallWindowProc(POldWndProc, gridX.Handle, Msg.Msg, Msg.wParam, Msg.lParam );

  if ( Msg.Msg = WM_VSCROLL ) then 
  begin
    if not FNoScrollGridX then
    begin
      FNoScrollGridX := True
      gridY.SetActiveRow( gridX.GetActiveRow );
      gridY.Perform( Msg.Msg, Msg.wParam, Msg.lParam );
//      SetScrollPos( gridY.Handle, SB_VERT, HIWORD( Msg.wParam ), True );
    end;
    FNoScrollGridX := False;
  end;
end;

Similiar code for the GridY. BTW, you shouln't need the SetScrollPos.

edit:

TForm1 = class(TForm)
  [..]
private
  GridXWndProc, GridXSaveWndProc: Pointer;
  GridYWndProc, GridYSaveWndProc: Pointer;
  procedure GridXCustomWndProc(var Msg: TMessage);
  procedure GridYCustomWndProc(var Msg: TMessage);
  [..]

procedure TForm1.FormCreate(Sender: TObject);
begin
  [..]

  GridXWndProc := classes.MakeObjectInstance(GridXCustomWndProc);
  GridXSaveWndProc := Pointer(GetWindowLong(GridX.Handle, GWL_WNDPROC));
  SetWindowLong(GridX.Handle, GWL_WNDPROC, LongInt(GridXWndProc));

  GridYWndProc := classes.MakeObjectInstance(GridYCustomWndProc);
  GridYSaveWndProc := Pointer(GetWindowLong(GridY.Handle, GWL_WNDPROC));
  SetWindowLong(GridY.Handle, GWL_WNDPROC, LongInt(GridYWndProc));
end;

procedure TForm1.GridXCustomWndProc(var Msg: TMessage);
begin
  Msg.Result := CallWindowProc(GridXSaveWndProc, GridX.Handle,
      Msg.Msg, Msg.WParam, Msg.LParam);

  case Msg.Msg of
    WM_KEYDOWN:
      begin
        case TWMKey(Msg).CharCode of
          VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT:
            GridY.Perform(Msg.Msg, Msg.WParam, Msg.LParam);
        end;
      end;
    WM_VSCROLL: GridY.Perform(Msg.Msg, Msg.WParam, Msg.LParam);
    WM_MOUSEWHEEL:
      begin
        ActiveControl := GridY;
        GridY.Perform(Msg.Msg, Msg.WParam, Msg.LParam);
      end;
    WM_DESTROY:
      begin
        SetWindowLong(GridX.Handle, GWL_WNDPROC, Longint(GridXSaveWndProc));
        Classes.FreeObjectInstance(GridXWndProc);
      end;
  end;
end;

procedure TForm1.GridYCustomWndProc(var Msg: TMessage);
begin
  Msg.Result := CallWindowProc(GridYSaveWndProc, GridY.Handle,
      Msg.Msg, Msg.WParam, Msg.LParam);

  case Msg.Msg of
    WM_KEYDOWN:
      begin
        case TWMKey(Msg).CharCode of
          VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT:
            GridX.Perform(Msg.Msg, Msg.WParam, Msg.LParam);
        end;
      end;
    WM_VSCROLL: GridX.Perform(Msg.Msg, Msg.WParam, Msg.LParam);
    WM_MOUSEWHEEL:
      begin
        ActiveControl := GridX;
        GridY.Perform(Msg.Msg, Msg.WParam, Msg.LParam);
      end;
    WM_DESTROY:
      begin
        SetWindowLong(GridY.Handle, GWL_WNDPROC, Longint(GridYSaveWndProc));
        Classes.FreeObjectInstance(GridYWndProc);
      end;
  end;
end;

这篇关于同步滚动组件Delphi的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文
相关文章
Delphi最新文章
热门教程
热门工具
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆