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);
----------------
++
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;
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
Коментар: