张志峰的博客

水滴石川,积少成多。

导航

【借鉴】delphi paintbox 滚轮

Posted on 2011-07-19 14:06  ╰★张志峰★╮  阅读(988)  评论(0编辑  收藏  举报

1.在窗体的public里写procedure WmMouseSheel(var   msg:TWMMOUSEWHEEL);message   WM_MOUSEWHEEL;函数。
具体的实现部分如下:

  procedure   TMapChildFrm.WmMouseSheel(var   msg:   TWMMOUSEWHEEL);
var
  pt: TPoint;
begin
  GetCursorPos(pt);         //{这是获取的相对于屏幕的坐标}
  pt := ScreenToClient(pt); //{转换成本地坐标}

  if (pt.X>ScrollBox1.Left)
  and(pt.X<ScrollBox1.Left+paintbox1.Width)
  and(pt.y>ScrollBox1.Top)
  and(pt.y<ScrollBox1.Top+paintbox1.Height) then
  begin
    if   msg.WheelDelta>0   then
    begin
      Zoom(@drawdata, 2);
      AutoFillMap;
      repaint;
    end
    else
    begin
      Zoom(@drawdata, 1 / 2);
      AutoFillMap;
      repaint;
    end;
  end;
end;(已实践)

2.继承paintbox,写个滚轮事件。(未实践);