Thursday, March 19, 2020

keystroke sound

uses MMSystem; procedure TForm1.Button1Click(Sender: TObject); begin PlaySound('Open', 0, SND_ALIAS or SND_ASYNC);
end;
----------------

http://www.festra.com/fp/music.htm https://wiki.freepascal.org/Multimedia_Programming https://www.schoolfreeware.com/Free_Pascal_Lazarus_App_GUI_Tutorial_10.html ... uses MMSystem; ... sndPlaySound('C:\sounds\test.wav', snd_Async or snd_NoDefault); The fail-safe way, which will allow appending paths and nonlatin file names is: sndPlaySound(pchar(UTF8ToSys('C:\sounds\test.wav')), snd_Async or snd_NoDefault);

----------------





unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Bass;

type
TForm1 = class(TForm)
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
private
StreamHandle: HSTREAM;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
if BASS_Init(-1, 44100, 0, Handle, nil) then
begin
StreamHandle := BASS_StreamCreateFile(False, PChar('c:\Windows\Media\tada.wav'), 0,
  0, 0 {$IFDEF UNICODE} or BASS_UNICODE {$ENDIF});
end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
BASS_StreamFree(StreamHandle);
BASS_Free;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
BASS_ChannelPlay(StreamHandle, True);
end;

end.

++
https://www.soundsnap.com/tags/keystroke

https://stackoverflow.com/questions/17663568/sndplaysound-or-playsound-on-keypress-playing-keyboard-sounds

https://www.un4seen.com/

https://www.thoughtco.com/intercepting-keyboard-input-1058465

https://www.swissdelphicenter.ch/en/showcode.php?id=456

https://www.thoughtco.com/how-to-hook-the-mouse-1058467


var
   Form1: TForm1;

   KBHook: HHook; {this intercepts keyboard input}
   cx, cy : integer; {track battle ship's position}

   {callback's declaration}
   function KeyboardHookProc(Code: Integer; WordParam: Word; LongParam: LongInt): LongInt; stdcall;

 implementation
 ...

procedure TForm1.FormCreate(Sender: TObject) ;
 begin
  {Set the keyboard hook so we  can intercept keyboard input}
  KBHook:=SetWindowsHookEx(WH_KEYBOARD,
            {callback >} @KeyboardHookProc,
                           HInstance,
                           GetCurrentThreadId()) ;

  {place the battle ship in  the middle of the screen}
  cx := Image1.ClientWidth div 2;
  cy := Image1.ClientHeight div 2;

  Image1.Canvas.PenPos := Point(cx,cy) ;
 end;

procedure TForm1.FormDestroy(Sender: TObject) ;
 begin
   {unhook the keyboard interception}
   UnHookWindowsHookEx(KBHook) ;
 end;

function KeyboardHookProc(Code: Integer; WordParam: Word; LongParam: LongInt) : LongInt;
 begin
  case WordParam of
   vk_Space: {erase battle ship's path}
    begin
     with Form1.Image1.Canvas do
     begin
      Brush.Color := clWhite;
      Brush.Style := bsSolid;
      Fillrect(Form1.Image1.ClientRect) ;
     end;
    end;
   vk_Right: cx := cx+1;
   vk_Left: cx := cx-1;
   vk_Up: cy := cy-1;
   vk_Down: cy := cy+1;
  end; {case}

  If cx < 2 then cx := Form1.Image1.ClientWidth-2;
  If cx > Form1.Image1.ClientWidth -2 then cx := 2;
  If cy < 2 then cy := Form1.Image1.ClientHeight -2 ;
  If cy > Form1.Image1.ClientHeight-2 then cy := 2;

  with Form1.Image1.Canvas do
  begin
   Pen.Color := clRed;
   Brush.Color := clYellow;
   TextOut(0,0,Format('%d, %d',[cx,cy])) ;
   Rectangle(cx-2, cy-2, cx+2,cy+2) ;
  end;

  Result:=0;
 {To prevent Windows from passing the keystrokes  to the target window, the Result value must  be a nonzero value.}
 end;


{-------------[mouse]----------------------}

function HookProc(nCode: Integer; MsgID: WParam; Data: LParam): LResult; stdcall;
var
    mousePoint: TPoint;
    notifyTestForm : boolean;
    MouseDirection : TMouseDirection;
 begin
    mousePoint := PMouseHookStruct(Data)^.pt;
    notifyTestForm := false;
    if (mousePoint.X = 0) then
    begin
      Windows.SetCursorPos(-2 + Screen.Width, mousePoint.y) ;
      notifyTestForm := true;
      MouseDirection := mdRight;
    end;

....


if notifyTestForm then
    begin
      PostMessage(FindWindow('TMainHookTestForm', nil), MouseHookMessage, MsgID, Integer(MouseDirection)) ;
    end;
   Result := CallNextHookEx(Hook,nCode,MsgID,Data) ;
end;


procedure TMainHookTestForm.WndProc(var Message: TMessage) ;
begin
    inherited WndProc(Message) ;

if Message.Msg = HookCommon.MouseHookMessage then
    begin
      //implementation found in the accompanying code
      Signal(TMouseDirection(Message.LParam)) ;
    end;
end;


No comments:

Post a Comment

Коментар: