[JVCL-Checkins] CVS: jvcl/examples/JvShellHookDemo JvShellHookDemo.dpr,NONE,1.1 JvShellHookDemo.res,NONE,1.1 MainFrm.dfm,NONE,1.1 MainFrm.pas,NONE,1.1

[Peter T. <pe...@us...>]

Update of /cvsroot/jvcl/jvcl/examples/JvShellHookDemo
In directory sc8-pr-cvs1:/tmp/cvs-serv10182/examples/JvShellHookDemo

Added Files:
	JvShellHookDemo.dpr JvShellHookDemo.res MainFrm.dfm 
	MainFrm.pas 
Log Message:
Demo for JvShellHook

--- NEW FILE: JvShellHookDemo.dpr ---
program JvShellHookDemo;

uses
  Forms,
  MainFrm in 'MainFrm.pas' {frmMain},
  JvShellHook in '..\..\source\JvShellHook.pas';

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TfrmMain, frmMain);
  Application.Run;
end.

--- NEW FILE: JvShellHookDemo.res ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: MainFrm.dfm ---
object frmMain: TfrmMain
  Left = 333
  Top = 148
  Width = 559
  Height = 332
  Hint = 
    'Try opening and closing programs, move focus between application' +
    's etc.'#13#10#13#10'If your keyboard has extra buttons for opening mail pr' +
    'ograms, '#13#10'raising/lowering the volume etc, try pressing those to' +
    ' see the messages'#13#10'being intercepted.'#13#10#13#10'If the Active checkbox ' +
    'is grayed out, this means your system doesn'#39't support '#13#10'the Regi' +
    'sterShellHookWindow/DeregisterShellHookWindow functions.'#13#10
  Caption = 'JvShellHook Demo'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Shell Dlg 2'
  Font.Style = []
  FormStyle = fsStayOnTop
  OldCreateOrder = False
  Position = poDesktopCenter
  ShowHint = True
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  DesignSize = (
    551
    305)
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 8
    Width = 59
    Height = 13
    Caption = '&Messages:'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Shell Dlg 2'
    Font.Style = [fsBold]
    ParentFont = False
  end
  object btnClear: TButton
    Left = 443
    Top = 259
    Width = 75
    Height = 25
    Anchors = [akRight, akBottom]
    Caption = '&Clear'
    TabOrder = 3
    OnClick = btnClearClick
  end
  object chkActive: TCheckBox
    Left = 16
    Top = 249
    Width = 97
    Height = 17
    Anchors = [akLeft, akBottom]
    Caption = '&Active'
    TabOrder = 1
    OnClick = chkActiveClick
  end
  object chkNoRedraw: TCheckBox
    Left = 16
    Top = 272
    Width = 121
    Height = 17
    Anchors = [akLeft, akBottom]
    Caption = 'Don'#39't show &redraws'
    Checked = True
    State = cbChecked
    TabOrder = 2
  end
  object lvMessages: TListView
    Left = 8
    Top = 32
    Width = 534
    Height = 207
    Anchors = [akLeft, akTop, akRight, akBottom]
    BorderStyle = bsNone
    Columns = <
      item
        Caption = 'Message'
        Width = 200
      end
      item
        Caption = 'wParam'
        Width = 100
      end
      item
        Caption = 'lParam'
        Width = 100
      end
      item
        AutoSize = True
        Caption = 'Result'
      end>
    ColumnClick = False
    HideSelection = False
    ReadOnly = True
    RowSelect = True
    TabOrder = 0
    ViewStyle = vsReport
    OnResize = lvMessagesResize
  end
end

--- NEW FILE: MainFrm.pas ---
unit MainFrm;
{$I JVCL.INC}
interface

uses
  Windows, Messages, SysUtils, {$IFDEF COMPILER6_UP}Variants, {$ENDIF}Classes, Graphics, Controls, Forms,
  Dialogs, JvShellHook, StdCtrls, ComCtrls;

type
  TfrmMain = class(TForm)
    btnClear: TButton;
    Label1: TLabel;
    chkActive: TCheckBox;
    chkNoRedraw: TCheckBox;
    lvMessages: TListView;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure chkActiveClick(Sender: TObject);
    procedure lvMessagesResize(Sender: TObject);
  private
    { Private declarations }
    procedure DoShellMessage(Sender: TObject; var Message: TMessage);
  public
    { Public declarations }
    SH: TJvShellHookComponent;
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  SH := TJvShellHookComponent.Create(self);
  SH.OnShellMessage := DoShellMessage;
  chkActive.Enabled := InitJvShellHooks;
  {$IFDEF COMPILER6_UP}
    lvMessages.BorderStyle := bsNone;
    lvMessages.BevelKind := bkFlat;
    lvMessages.BevelInner := bvNone;
  {$ELSE}
    lvMessages.BorderStyle := bsSingle;
  {$ENDIF}
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  SH.Free;
end;

procedure TfrmMain.btnClearClick(Sender: TObject);
begin
  lvMessages.Items.Clear;
end;

function GetAppCommand(lParam: integer): string;
var tmp: string;
begin
  case GET_APPCOMMAND_LPARAM(lParam) of
    APPCOMMAND_BROWSER_BACKWARD: tmp := 'APPCOMMAND_BROWSER_BACKWARD';
    APPCOMMAND_BROWSER_FORWARD: tmp := 'APPCOMMAND_BROWSER_FORWARD';
    APPCOMMAND_BROWSER_REFRESH: tmp := 'APPCOMMAND_BROWSER_REFRESH';
    APPCOMMAND_BROWSER_STOP: tmp := 'APPCOMMAND_BROWSER_STOP';
    APPCOMMAND_BROWSER_SEARCH: tmp := 'APPCOMMAND_BROWSER_SEARCH';
    APPCOMMAND_BROWSER_FAVORITES: tmp := 'APPCOMMAND_BROWSER_FAVORITES';
    APPCOMMAND_BROWSER_HOME: tmp := 'APPCOMMAND_BROWSER_HOME';
    APPCOMMAND_VOLUME_MUTE: tmp := 'APPCOMMAND_VOLUME_MUTE';
    APPCOMMAND_VOLUME_DOWN: tmp := 'APPCOMMAND_VOLUME_DOWN';
    APPCOMMAND_VOLUME_UP: tmp := 'APPCOMMAND_VOLUME_UP';
    APPCOMMAND_MEDIA_NEXTTRACK: tmp := 'APPCOMMAND_MEDIA_NEXTTRACK';
    APPCOMMAND_MEDIA_PREVIOUSTRACK: tmp := 'APPCOMMAND_MEDIA_PREVIOUSTRACK';
    APPCOMMAND_MEDIA_STOP: tmp := 'APPCOMMAND_MEDIA_STOP';
    APPCOMMAND_MEDIA_PLAY_PAUSE: tmp := 'APPCOMMAND_MEDIA_PLAY_PAUSE';
    APPCOMMAND_LAUNCH_MAIL: tmp := 'APPCOMMAND_LAUNCH_MAIL';
    APPCOMMAND_LAUNCH_MEDIA_SELECT: tmp := 'APPCOMMAND_LAUNCH_MEDIA_SELECT';
    APPCOMMAND_LAUNCH_APP1: tmp := 'APPCOMMAND_LAUNCH_APP1';
    APPCOMMAND_LAUNCH_APP2: tmp := 'APPCOMMAND_LAUNCH_APP2';
    APPCOMMAND_BASS_DOWN: tmp := 'APPCOMMAND_BASS_DOWN';
    APPCOMMAND_BASS_BOOST: tmp := 'APPCOMMAND_BASS_BOOST';
    APPCOMMAND_BASS_UP: tmp := 'APPCOMMAND_BASS_UP';
    APPCOMMAND_TREBLE_DOWN: tmp := 'APPCOMMAND_TREBLE_DOWN';
    APPCOMMAND_TREBLE_UP: tmp := 'APPCOMMAND_TREBLE_UP';
    APPCOMMAND_MICROPHONE_VOLUME_MUTE: tmp := 'APPCOMMAND_MICROPHONE_VOLUME_MUTE';
    APPCOMMAND_MICROPHONE_VOLUME_DOWN: tmp := 'APPCOMMAND_MICROPHONE_VOLUME_DOWN';
    APPCOMMAND_MICROPHONE_VOLUME_UP: tmp := 'APPCOMMAND_MICROPHONE_VOLUME_UP';
    APPCOMMAND_HELP: tmp := 'APPCOMMAND_HELP';
    APPCOMMAND_FIND: tmp := 'APPCOMMAND_FIND';
    APPCOMMAND_NEW: tmp := 'APPCOMMAND_NEW';
    APPCOMMAND_OPEN: tmp := 'APPCOMMAND_OPEN';
    APPCOMMAND_CLOSE: tmp := 'APPCOMMAND_CLOSE';
    APPCOMMAND_SAVE: tmp := 'APPCOMMAND_SAVE';
    APPCOMMAND_PRINT: tmp := 'APPCOMMAND_PRINT';
    APPCOMMAND_UNDO: tmp := 'APPCOMMAND_UNDO';
    APPCOMMAND_REDO: tmp := 'APPCOMMAND_REDO';
    APPCOMMAND_COPY: tmp := 'APPCOMMAND_COPY';
    APPCOMMAND_CUT: tmp := 'APPCOMMAND_CUT';
    APPCOMMAND_PASTE: tmp := 'APPCOMMAND_PASTE';
    APPCOMMAND_REPLY_TO_MAIL: tmp := 'APPCOMMAND_REPLY_TO_MAIL';
    APPCOMMAND_FORWARD_MAIL: tmp := 'APPCOMMAND_FORWARD_MAIL';
    APPCOMMAND_SEND_MAIL: tmp := 'APPCOMMAND_SEND_MAIL';
    APPCOMMAND_SPELL_CHECK: tmp := 'APPCOMMAND_SPELL_CHECK';
    APPCOMMAND_DICTATE_OR_COMMAND_CONTROL_TOGGLE: tmp := 'APPCOMMAND_DICTATE_OR_COMMAND_CONTROL_TOGGLE';
    APPCOMMAND_MIC_ON_OFF_TOGGLE: tmp := 'APPCOMMAND_MIC_ON_OFF_TOGGLE';
    APPCOMMAND_CORRECTION_LIST: tmp := 'APPCOMMAND_CORRECTION_LIST';
    APPCOMMAND_MEDIA_PLAY: tmp := 'APPCOMMAND_MEDIA_PLAY';
    APPCOMMAND_MEDIA_PAUSE: tmp := 'APPCOMMAND_MEDIA_PAUSE';
    APPCOMMAND_MEDIA_RECORD: tmp := 'APPCOMMAND_MEDIA_RECORD';
    APPCOMMAND_MEDIA_FAST_FORWARD: tmp := 'APPCOMMAND_MEDIA_FAST_FORWARD';
    APPCOMMAND_MEDIA_REWIND: tmp := 'APPCOMMAND_MEDIA_REWIND';
    APPCOMMAND_MEDIA_CHANNEL_UP: tmp := 'APPCOMMAND_MEDIA_CHANNEL_UP';
    APPCOMMAND_MEDIA_CHANNEL_DOWN: tmp := 'APPCOMMAND_MEDIA_CHANNEL_DOWN';
  else
    tmp := Format('Unknown ($%.8x)', [lParam]);
  end;
  Result := Format('HSHELL_APPCOMMAND: %s', [tmp]);
end;

procedure TfrmMain.DoShellMessage(Sender: TObject; var Message: TMessage);
var S: string;
begin
  with Message do
  begin
    case wParam of
      HSHELL_WINDOWCREATED: S := 'HSHELL_WINDOWCREATED';
      HSHELL_WINDOWDESTROYED: S := 'HSHELL_WINDOWDESTROYED';
      HSHELL_ACTIVATESHELLWINDOW: S := 'HSHELL_ACTIVATESHELLWINDOW';
      HSHELL_WINDOWACTIVATED:
      begin
        S := 'HSHELL_WINDOWACTIVATED';
        if lParam = Application.Handle then
          S := S + ' (this)';
      end;
      HSHELL_GETMINRECT: S := 'HSHELL_GETMINRECT';
      HSHELL_REDRAW:
        if chkNoRedraw.Checked then Exit else S := 'HSHELL_REDRAW';
      HSHELL_TASKMAN: S := 'HSHELL_TASKMAN';
      HSHELL_LANGUAGE: S := 'HSHELL_LANGUAGE';
      HSHELL_SYSMENU: S := 'HSHELL_SYSMENU';
      HSHELL_ENDTASK: S := 'HSHELL_ENDTASK';
      HSHELL_ACCESSIBILITYSTATE: S := 'HSHELL_ACCESSIBILITYSTATE';
      HSHELL_WINDOWREPLACED: S := 'HSHELL_WINDOWREPLACED';
      HSHELL_WINDOWREPLACING: S := 'HSHELL_WINDOWREPLACING';
      HSHELL_FLASH: S := 'HSHELL_FLASH';
      HSHELL_RUDEAPPACTIVATED: S := 'HSHELL_RUDEAPPACTIVATED';
      HSHELL_APPCOMMAND: S := GetAppCommand(lParam);
    else
      S := Format('Unknown command ($%.8x)', [wParam]);
    end;
    with lvMessages.Items.Add do
    begin
      Caption := S;
      SubItems.Add(IntToStr(wParam));
      SubItems.Add(IntToStr(lParam));
      SubItems.Add(IntToStr(Result));
      MakeVisible(false);
      Selected := true;
      Focused := true;
    end;
  end;
end;

procedure TfrmMain.chkActiveClick(Sender: TObject);
begin
  SH.Active := chkActive.Checked;
end;                 
                         
procedure TfrmMain.lvMessagesResize(Sender: TObject);
begin
  lvMessages.Columns[3].Width := -2;
end;

end.