利用函数指针给VCL控件增加自定义事件

    在使用VCL控件进行开发的过程中，有些控件没有Windows中的标准事件，如TTrackBar就没有鼠标左键按下及抬起事件，如果要给这些控件增加这些事件，可有几种方法，一是利用继承，实际上是自写控件，从TTrackBar继承出一个控件，在该控件中增加自定义的事件（如果不是WIndows标准事件，需自行触发，可利用SendMessage)，但这种方法在我们只想增加一两个自定义事件时，有些杀鸡用牛刀的感觉；二是重载窗体的WndProc方法，但这种方式似乎行不通，因为得不到VCL控件的Handle值，控件的Handle只在WMCommand这样的函数中出现，但WMCommand方法是TCustomForm的非虚私有方法，这样就无法重载WMCommand；三是利用函数指针模拟事件，该方法简单有效，此文就是利用第三种方法

 

     场景：在做媒体播放器时，使用TTrackBar来进行进度控制及显示，当鼠标左键在TTrackBar控件上按下时，应停止播放，当拖动进度完毕鼠标左键抬起时继续播放，进度显示利用TTimer组件根据TMediaPlayer的位置不断更新TTrackBar控件的进度，细节就不说了。

 

主要代码片断如下：

type
  TForm2 = class(TForm)

   .....

  private
    FTrackBar_LBUTTONDOWNUP_WndProc:  TWndMethod;
    procedure   TrackBarWndProc(var  Message:  TMessage);

 

 

procedure TForm2.cxButton7Click(Sender: TObject);
begin
    MediaPlayer1.Open;
    TrackBar1.Max:= MediaPlayer1.Length;
    MediaPlayer1.Play;
    Timer1.Enabled := true;
end;

 

procedure TForm2.FormCreate(Sender: TObject);
begin
    FTrackBar_LBUTTONDOWNUP_WndProc :=  TrackBar1.WindowProc;
    TrackBar1.WindowProc  := TrackBarWndProc;
end;

 

 

procedure TForm2.Timer1Timer(Sender: TObject);
begin
  if MediaPlayer1.Mode = mpPlaying then
    TrackBar1.Position := MediaPlayer1.Position;
end

 

 

procedure TForm2.TrackBar1Change(Sender: TObject);
begin
    if MediaPlayer1.Mode <> mpPlaying then
       MediaPlayer1.Position := TrackBar1.Position ;
end;

 

procedure TForm2.TrackBarWndProc(var Message: TMessage);
begin
    case Message.Msg of
        WM_LBUTTONDOWN:
        begin
          MediaPlayer1.Pause;
          Timer1.Enabled := false;
        end;
        WM_LBUTTONUP:
        begin
          MediaPlayer1.Play;
          Timer1.Enabled := true;
        end;
    end;
    FTrackBar_LBUTTONDOWNUP_WndProc(Message);
end;

 

该代码在CodeGear RAD Studio 2007上编译运行正常