Практическая работа №2. Работа с Active-X компонентами.
Цель работы: Работа с компонентом Active-X.
Краткие теоретические сведения: Active-X описывает структуру платформонезависимых программных объектов.
Формулировка задания: В среде Delphi создать проигрыватель Media Player с помощью компонента MainMenu,WindowsMediaPlayer.
Выполнение задания:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, OleCtrls, WMPLib_TLB;
type
TForm1 = class(TForm)
MediaPlayer: TWindowsMediaPlayer;
MainMenu: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
OpenDialogs: TOpenDialog;
N5: TMenuItem;
N6: TMenuItem;
procedure N2Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N6Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.N2Click(Sender: TObject);
begin
if OpenDialogs.Execute then
MediaPlayer.URL:=OpenDialogs.FileName;
end;
procedure TForm1.N4Click(Sender: TObject);
begin
Self.Close;
end;
procedure TForm1.N5Click(Sender: TObject);
begin
if MediaPlayer.PlayState=wmppsPlaying then
MediaPlayer.Controls.Stop
Else
MediaPlayer.Controls.Play;
end;
procedure TForm1.N6Click(Sender: TObject);
begin
if MediaPlayer.PlayState=wmppsPlaying then
MediaPlayer.Controls.Pause;
end;
end.
Практическая работа №2. Создание лазерного проигрывателя
Цель работы: Работа с компонентами MediaPlayer, ProgressBar, Timer, StringGrid и StatusBar.
Краткие теоритические сведения: MediaPlayer выполняет функции плейера с кнопками Play, Stop, Pause и так далее. ProgressBar показывает процесс проигрывания трека на диске. Timer следит за процессом проигрывания, когда заканчивается трек, он переключает на следующий. StringGrid выводит список песен. StatusBar выводит любую информацию, поясняющую процесс работы программы(номер трека, время звучания, название песни и исполнитель.
Формулировка задания: В среде Delphi создать лазерный проигрыватель, используя
компоненты MediaPlayer, ProgressBar, Timer(время), StringGrid, StatusBar, кнопка «закрыть» (для выхода из программы).
Выполнение задания:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, MPlayer, ComCtrls, StdCtrls, MMSystem, ExtCtrls, Grids;
const
WM_SCANCD=WM_USER+1;
WM_UNKNOWNCD=WM_USER+2;
type
TPlayerStatus= (NoDisk, InsertingDisk, Played, Paused, Stopped);
TMPForm = class(TForm)
Player: TMediaPlayer;
Button1: TButton;
ProgressBar: TProgressBar;
Author: TLabel;
Album: TLabel;
Status: TStatusBar;
Songs: TStringGrid;
Timer1: TTimer;
Timer2: TTimer;
procedure Button1Click(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
Trk, Min, Sec: word; //Oar и его длительность (мин., сек.)
CD: TStringList; //Описание дисков
CurStatus: TPlayerStatus; //Текущий статус CD-ROM
procedure ClearSongsList;
procedure EmptyIndicat;
procedure InitProgressBar;
procedure ScanCD (var Msg: TMessage); message WM_SCANCD;
procedure UnknownCD (var Msg: TMessage); message WM_UNKNOWNCD;
public
procedure AddSongsToList (Sng: TStringGrid);
end;
var
MPForm: TMPForm;
implementation
{$R *.dfm}
procedure TMPForm.ClearSongsList;
{Очистить список строк}
begin
with Songs do
begin
RowCount:=1; Cells[0,0]:=''; Cells[1,0]:=''; Cells[2,0]:='';
end;
Author.Caption:='';Album.Caption:='';
end;
procedure TMPForm.EmptyIndicat;
{Очистить строку статуса}
begin
Status.Panels[0].Text:='00';Status.Panels[1].Text:='00:00';
Status.Panels[2].Text:='';
ProgressBar.Position:=0;ProgressBar.Max:=100;
end;
procedure TMPForm.InitProgressBar;
{Настройка индикатора звучания трека}
var Len: longint;
begin
with Player, ProgressBar do
if (StartPos>0) AND (StartPos<=Tracks) then
begin
Len:= TrackLength [StartPos]; Position:=0;
Max:= MCI_MSF_MINUTE(Len)*60+MCI_MSF_SECOND(Len);
Status.Panels [2].Text:=Songs.Cells [2, StartPos - 1];
end;
end;
procedure TMPForm.ScanCD (var Msg: TMessage);
begin
end;
procedure TMPForm.UnknownCD (var Msg: TMessage);
begin
end;
procedure TMPForm.Button1Click(Sender: TObject);
begin
Close;
end;
procedure TMPForm.Timer2Timer(Sender: TObject);
begin
with Player, Status do
begin
Trk:= MCI_TMSF_TRACK (Position);
Min:= MCI_TMSF_MINUTE (Position);
Sec:= MCI_TMSF_SECOND (Position);
if (Min=0) AND (Sec=0) AND (Mode=mpPlaying) then
begin
InitProgressBar; Songs.Row:= Trk-1;
end;
ProgressBar.Position:=Min*60 + Sec;
Panels[0].Text:=Format('%.2d',[Trk]);
Panels[1].Text:=Format('%.2d:%.2d',[Min, Sec]);
end;
end;
procedure TMPForm.AddSongsToList(Sng:TStringGrid);
var I:longint;
M,S:word;
begin
with Sng do
begin
RowCount:=Player.Tracks;
for I:=1 to Player.Tracks do
begin
M:= MCI_MSF_MINUTE (Player.TrackLength [I]);
S:= MCI_MSF_SECOND (Player.TrackLength [I]);
Cells [0,I-1]:=Format('%.2d',[I]);
Cells[1,I-1]:=Format('%.2d:%.2d',[M,S]);
Cells [2,I-1]:='';
end;
Row:=0;
end;
end;
procedure TMPForm.Timer1Timer(Sender: TObject);
begin
with Player, Status do
case Mode of
mpOpen: CurStatus:=NoDisk;//Открыт(нет диска)
mpStopped: if CurStatus=NoDisk then //Диск есть, но не играет
CurStatus:=InsertingDisk
else if CurStatus <> Paused then
CurStatus:=Stopped;
mpPlaying:
begin //Играет
CurStatus:=Played;
if Songs.RowCount=1 then
AddSongsToList (Songs);
end;
end;
Timer2.Enabled:= CurStatus <> NoDisk;
case CurStatus of
NoDisk: begin
ClearSongsList;
EmptyIndicat;
end;
InsertingDisk: begin
AddSongsToList (Songs);
SendMessage (Handle, WM_SCANCD, 0, 0);
end;
end;
end;
end.
Практическая работа №3. Создание видео проигрывателя
Цель работы: Научиться работать с компонентом MediaPlayer, SpeedButton, DimAvi, OpenDialog.
Краткие теоритические сведения: TMediaPlayer позволяет управлять воспроизведением видео-файла(воспроизвести, приостановить, остановить, перемотать и т.д.). С помощью компонента OpenDialog можно открывать файлы, формат которых задается в свойстве «Filter».
Формулировка задания: В среде Delphi создать видеопроигрыватель, используя компоненты MediaPlayer, SpeedButton, DimAvi, OpenDialog.
Выполнение задания:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, MPlayer, Buttons;
type
TForm1 = class(TForm)
MediaPlayer: TMediaPlayer;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
OpenDialog: TOpenDialog;
procedure FormCreate(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure MediaPlayerNotify(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
MediaPlayer.Display:=Form1;
SpeedButton1.GroupIndex:=1;
SpeedButton1.AllowAllUp:=True;
end;
procedure DimAvi(f: string; var w,h:integer);
var
fst:TFileStream;
header: record
RIFF:array[1..4] of char;
nu1: array[1..5] of LongInt;
AVIH:array[1..4] of char;
nu2:array[1..9] of LongInt;
Width: LongInt;
Height:LongInt;
end;
begin
fst:=TFileStream.Create(f,fmOpenRead);
fst.Read(header,sizeof(header));
w:=header.Width;
h:=header.Height;
fst.Destroy
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
var
top,left:integer;//
width,height:integer;//
mw,mh:integer;//
kh,kw:real;//
k:real;//
begin
OpenDialog.Title:='Выбор клипа';
if not OpenDialog.Execute
then exit;
DimAvi(OpenDialog.FileName,width,height);
mh:=SpeedButton1.Top-10;
mw:=Form1.ClientWidth;
if mh>height
then kh:=1
else
kh:=mh/height;
if mw>width
then kw:=1
else
kw:=mw/width;
if kw<kh
then k:=kw
else k:=kh;
width:=Round(width*k);
height:=Round(height*k);
left:=(Form1.ClientWidth-width) div 2;
top:=10;
MediaPlayer.FileName:=OpenDialog.FileName;
MediaPlayer.Open;
MediaPlayer.DisplayRect:=Rect(left,top,width,height);
SpeedButton1.Enabled:=True;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if SpeedButton1.Down then
begin
MediaPlayer.Play;
SpeedButton1.Hint:='Stop';
end
else begin
MediaPlayer.Stop;
SpeedButton1.Hint:='Play';
end;
end;
procedure TForm1.MediaPlayerNotify(Sender: TObject);
begin
if (MediaPlayer.Mode=mpStopped)
and SpeedButton1.Down
then
SpeedButton1.Down:=False;//
end;
end.
Практическая работа №4. Разработка синтезатора звуков
Цель работы: Разработать программу синтезатора звуков. Научиться работать с компонентами TShape, ListBox, TrackBar.
Краткие теоретические сведения: Компонент TShape может выступать в роли клавиш синтезатора. ListBox, в данном случае, позволяет выбрать тип звучания мелодий. TrackBar можно использовать как регулятор громкости.
Формулировка задания: В среде Delphi разработать звуковой синтезатор, на форме которого расположены компоненты TShape(клавиши), TListBox(список типов звучания), TTrackBar(регулятор громкости).
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, ComCtrls, MMSystem,jpeg, ExtCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
MainMenu1: TMainMenu;
TrackBar1: TTrackBar;
Label1: TLabel;
Timer1: TTimer;
About1: TMenuItem;
Skins: TMenuItem;
help: TMenuItem;
N3: TMenuItem;
ShC3: TShape;
ShD3: TShape;
ShE3: TShape;
ShF3: TShape;
ShD4: TShape;
ShA3: TShape;
ShE4: TShape;
ShEb3: TShape;
ShC4: TShape;
ShC5: TShape;
ShB4: TShape;
ShG3: TShape;
ShG4: TShape;
ShEb4: TShape;
ShA4: TShape;
ShB3: TShape;
ShF4: TShape;
ShDb4: TShape;
ShH3: TShape;
ShAb3: TShape;
ShGb3: TShape;
ShAb4: TShape;
ShH4: TShape;
ShGb4: TShape;
ShDb3: TShape;
procedure TrackBar1Change(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure Label1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure ShC3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShD3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShC3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShD3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShDb3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShDb3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShEb3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShEb3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShE3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShE3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShF3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShF3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShGb3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShGb3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShG3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShG3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShAb3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShAb3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShA3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShA3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShH3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShH3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShB3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShB3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShC4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShC4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShDb4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShDb4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShD4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShD4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShEb4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShEb4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShE4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShE4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShF4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShF4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShGb4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShGb4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShG4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShG4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShAb4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShAb4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShA4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShA4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShH4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShH4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShB4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShB4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShC5MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShC5MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
bm:TBitMap; MIDIDevices:TStringList; Form1:TForm1; hMidi,t,no,midimsg,n,n2:integer;
vel:integer=127;
BelKlavNag:TColor=$00CFCFCF;BelKlav:TColor=$00E9E9E9;ChorKlavNag:TColor=$001B1B1B;
ChorKlav:TColor=$00373737;
skin:string='skins/marble2.bmp';
NoFlags:array[0..24] of boolean;
Instruments:array [0..127] of String=( 'AcousticGrandPano', 'BrightAcousticPiano',
'ElectricGrandPiano','HonkyTonkPiano','ElectricPiano1','ElectricPiano2','Harpsichord',
'Clavinet','Celesta','Glockenspiel','MusicBox','Vibraphone', 'Marimba','Xylophone',
'TubularBells','Dulcimer','DrawbarOrgan',
'PercussiveOrgan','RockOrgan','ChurchOrgan','ReedOrgan','Accordion', 'Harmonica', 'TangoAccordion',
'AcousticNylonGuitar', ' AcousticSteelGuitar', 'JazzElectricGuitar', 'CleanElectricGuitar', 'MutedElectricGuitar',
'OverdrivenGuitar', 'DistortionGuitar',
'GuitarHarmonics', 'AcousticBass', 'FingeredElectricBass', 'PickedElectricBass', 'FretlessBass', 'SlapBass1',
'SlapBass2','SynthBass1', 'SynthBass2', 'Violin', 'Viola', 'Cello', 'Contrabass', 'TremoloStrings', 'PizzicatoStrings',
'OrchestralHarp','Timpani', 'StringEnsemble1', 'StringEnsemble2', 'SynthStrings1', 'SynthStrings2', 'ChoirAahs', 'VoiceOohs',
'SynthVoice','OrchestraHit', 'Trumpet', 'Trombone','Tuba', 'MutedTrumpet', 'FrenchHorn', 'BrassSection', 'SynthBrass1',
'SynthBrass2','SopranoSax', 'AltoSax', 'TenorSax', 'BaritoneSax', 'Oboe', 'EnglishHorn', 'Bassoon', 'Clarinet', 'Piccolo', 'Flute',
'Recorder','PanFlute', 'BlownBottle', 'Shakuhachi', 'Whistle', 'Ocarina', 'SquareLead', 'SawtoothLead', 'CalliopeLead',
'ChiffLead','CharangLead', 'VoiceLead', 'FifthsLead', 'BassandLead', 'NewAgePad', 'WarmPad', 'PolySynthPad',
'ChoirPad', 'BowedPad','MetallicPad', 'HaloPad', 'SweepPad', 'SynthFXRain', 'SynthFXSoundtrack', 'SynthFXCrystal',
'SynthFXAtmosphere', 'SynthFXBrightness',
'SynthFXGoblins', 'SynthFXEchoes', 'SynthFXSciFi', 'Sitar', 'Banjo', 'Shamisen', 'Koto', 'Kalimba', 'Bagpipe',
'Fiddle', 'Shanai','TinkleBell', 'Agogo', 'SteelDrums', 'Woodblo','TaikoDrum', 'MelodicTom', 'SynthDrum', 'ReverseCymbal',
'GuitarFretNoise','BreathNoise', 'Seashore', 'BirdTweet', 'TelephoneRing', 'Helicopter', 'Applause', 'Gunshot');
implementation
{$R *.dfm}
procedure GetMIDIOutDevices(Devices: TStrings);
var
i, DNum: Integer;
Caps: TMIDIOUTCAPSA;
begin
DNum := MIDIOutGetNumDevs;
for i := 0 to DNum - 1 do
begin
MIDIOutGetDevCaps(i, @Caps, SizeOf(TMIDIOutCapsA));
Devices.Add(string(Caps.szPname));
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
Var i,ii:integer;
nit:string;
begin
for ii:=0 to 24 do
Begin
NoFlags[ii]:=true;
end;
midiOutOpen(@hmidi, 0, 0, 0, 0);
Form1.KeyPreview:= true;
form1.Label1.Caption:=floattostr(vel);
for i:=0 to 127 do
begin
nit:=(FloatToStr(i)+'.'+Instruments[i]);
ListBox1.Items.add(FloatToStr(i)+'.'+Instruments[i]);
begin
MIDIDevices:=TStringList.Create;
try
GetMIDIOutDevices(MIDIDevices);
Finally
MIDIDevices.Free;
end;
midimsg := $C0+$100*101; //указываем, каким инструментом его сыграть
midiOutShortMsg (hmidi, midimsg);
midimsg := $90 + ((48) * $100) + ((80) * $10000) + 0;
midiOutShortMsg (hmidi, midimsg);
midimsg := $90 + ((60) * $100) + ((80) * $10000) + 0;
midiOutShortMsg (hmidi, midimsg);
midimsg := $90 + ((67) * $100) + ((80) * $10000) + 0;
midiOutShortMsg (hmidi, midimsg);
midimsg := $90 + ((74) * $100) + ((80) * $10000) + 0;
midiOutShortMsg (hmidi, midimsg);
end;
end;
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
Var
i: integer; vel:integer;
begin
for i:=0 to 127 do
begin
if TrackBar1.Position=i then
vel:=127-i;
Form1.Label1.Caption:=FloatToStr(vel);
end;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
Var ni:integer;
begin
ni:=ListBox1.ItemIndex;
midimsg:=$C0+$100*ni;
midiOutShortMsg(hmidi, midimsg);
end;
procedure TForm1.Label1Click(Sender: TObject);
var vel:integer;
begin
Form1.Label1.Caption:=FloatToStr(vel);
end;
procedure TForm1.N3Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if key='a' then begin no:=60; ShC3.Brush.Color:=BelKlavNag; end;
if key='w' then begin no:=61; ShDb3.Brush.Color:=ChorKlavNag; end;
if key='s' then begin no:=62; ShD3.Brush.Color:=BelKlavNag;end;
if key='e' then begin no:=63; ShEb3.Brush.Color:=ChorKlavNag;end;
if key='d' then begin no:=64; ShE3.Brush.Color:=BelKlavNag;end;
if key='f' then begin no:=65; ShF3.Brush.Color:=BelKlavNag;end;
if key='t' then begin no:=66; ShGb3.Brush.Color:=ChorKlavNag;end;
if key='g' then begin no:=67; ShG3.Brush.Color:=BelKlavNag;end;
if key='y' then begin no:=68; ShAb3.Brush.Color:=ChorKlavNag;end;
if key='h' then begin no:=69; ShA3.Brush.Color:=BelKlavNag;end;
if key='u' then begin no:=70; ShH3.Brush.Color:=ChorKlavNag;end;
if key='j' then begin no:=71; ShB3.Brush.Color:=BelKlavNag;end;
if key='k' then begin no:=72; ShC4.Brush.Color:=BelKlavNag;end;
if key='o' then begin no:=73; ShDb4.Brush.Color:=ChorKlavNag;end;
if key='l' then begin no:=74; ShD4.Brush.Color:=BelKlavNag;end;
if key='p' then begin no:=75; ShEb4.Brush.Color:=ChorKlavNag;end;
if key='A' then begin no:=72; ShC4.Brush.Color:=BelKlavNag;end;
if key='W' then begin no:=73; ShDb4.Brush.Color:=ChorKlavNag;end;
if key='S' then begin no:=74; ShD4.Brush.Color:=BelKlavNag;end;
if key='E' then begin no:=75; ShEb4.Brush.Color:=ChorKlavNag;end;
if key='D' then begin no:=76; ShE4.Brush.Color:=BelKlavNag;end;
if key='F' then begin no:=77; ShF4.Brush.Color:=BelKlavNag;end;
if key='T' then begin no:=78; ShGb4.Brush.Color:=ChorKlavNag;end;
if key='G' then begin no:=79; ShG4.Brush.Color:=BelKlavNag;end;
if key='Y' then begin no:=80; ShAb4.Brush.Color:=ChorKlavNag;end;
if key='H' then begin no:=81; ShA4.Brush.Color:=BelKlavNag;end;
if key='U' then begin no:=82; ShH4.Brush.Color:=ChorKlavNag;end;
if key='J' then begin no:=83; ShB4.Brush.Color:=BelKlavNag;end;
if key='K' then begin no:=84; ShC5.Brush.Color:=BelKlavNag;end;
if (NoFlags[no-60]=true) and ((key='a') or (key='w') or (key='s') or
(key='e') or (key='d') or (key='f') or (key='t') or (key='g') or
(key='y') or (key='h') or (key='u') or (key='j') or (key='k') or (key='o')
or (key='l') or (key='p') or (key='A') or (key='W') or (key='S') or (key='E')
or (key='D') or (key='F') or (key='T') or (key='G') or (key='Y') or (key='H')
or (key='U') or (key='J') or (key='K')) then
begin
NoFlags[no-60]:=false;
midimsg := $90 + ((no) * $100) + ((vel) * $10000) + 0;
midiOutShortMsg (hmidi, midimsg);
end;
end;
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=ord('A') then begin NoFlags[0]:=true; NoFlags[12]:=true;
n:=60;n2:=72;ShC3.Brush.Color:=BelKlav;ShC4.Brush.Color:=BelKlav;end;
if key=ord('W') then begin NoFlags[1]:=true; NoFlags[13]:=true;
n:=61;n2:=73;ShDb3.Brush.Color:=ChorKlav;ShDb4.Brush.Color:=ChorKlav;end;
if key=ord('S') then begin NoFlags[2]:=true; NoFlags[14]:=true;
n:=62;n2:=74;ShD3.Brush.Color:=BelKlav;ShD4.Brush.Color:=BelKlav;end;
if key=ord('E') then begin NoFlags[3]:=true; NoFlags[15]:=true;
n:=63;n2:=75;ShEb3.Brush.Color:=ChorKlav;ShEb4.Brush.Color:=ChorKlav;end;
if key=ord('D') then begin NoFlags[4]:=true; NoFlags[16]:=true;
n:=64;n2:=76;ShE3.Brush.Color:=BelKlav;ShE4.Brush.Color:=BelKlav;end;
if key=ord('F') then begin NoFlags[5]:=true; NoFlags[17]:=true;
n:=65;n2:=77;ShF3.Brush.Color:=BelKlav;ShF4.Brush.Color:=BelKlav;end;
if key=ord('T') then begin NoFlags[6]:=true; NoFlags[18]:=true;
n:=66;n2:=78;ShGb3.Brush.Color:=ChorKlav;ShGb4.Brush.Color:=ChorKlav;end;
if key=ord('G') then begin NoFlags[7]:=true; NoFlags[19]:=true;
n:=67;n2:=79;ShG3.Brush.Color:=BelKlav;ShG4.Brush.Color:=BelKlav;end;;
if key=ord('Y') then begin NoFlags[8]:=true; NoFlags[20]:=true;
n:=68;n2:=80;ShAb3.Brush.Color:=ChorKlav;ShAb4.Brush.Color:=ChorKlav;end;
if key=ord('H') then begin NoFlags[9]:=true; NoFlags[21]:=true;
n:=69;n2:=81;ShA3.Brush.Color:=BelKlav;ShA4.Brush.Color:=BelKlav;end;
if key=ord('U') then begin NoFlags[10]:=true; NoFlags[22]:=true;
n:=70;n2:=82;ShH3.Brush.Color:=ChorKlav;ShH4.Brush.Color:=ChorKlav;end;
if key=ord('J') then begin NoFlags[11]:=true; NoFlags[23]:=true;
n:=71;n2:=83;ShB3.Brush.Color:=BelKlav;ShB4.Brush.Color:=BelKlav;end;
if key=ord('K') then begin NoFlags[12]:=true; NoFlags[24]:=true;
n:=72;n2:=84;ShC4.Brush.Color:=BelKlav;ShC5.Brush.Color:=BelKlav;end;
if key=ord('O') then begin NoFlags[13]:=true; n:=73; ShDb4.Brush.Color:=ChorKlav;end;
if key=ord('L') then begin NoFlags[14]:=true; n:=74;ShD4.Brush.Color:=BelKlav;end;
if key=ord('P') then begin NoFlags[15]:=true; n:=75;ShEb4.Brush.Color:=ChorKlav;end;
midimsg := $80 + ((n) * $100) +0 ;
midiOutShortMsg (hmidi, midimsg);
midimsg := $80 + ((n2) * $100) +0 ;
midiOutShortMsg (hmidi, midimsg);
end;
procedure TForm1.ShC3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShC3.Brush.Color:=BelKlavNag;midiOutShortMsg (hmidi, $3C90+((vel) * $10000));
end;
procedure TForm1.ShC3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShC3.Brush.Color:=BelKlav; midiOutShortMsg(hmidi,$3C80);
end;
procedure TForm1.ShD3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShD3.Brush.Color:=BelKlavNag;midiOutShortMsg (hmidi, $3E90+((vel) * $10000));
end;
procedure TForm1.ShD3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShD3.Brush.Color:=BelKlav; midiOutShortMsg(hmidi,$3E80);
end;
procedure TForm1.ShDb3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShDb3.Brush.Color:=ChorKlavNag; midiOutShortMsg (hmidi, $3D90+((vel) * $10000));
end;
procedure TForm1.ShDb3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShDb3.Brush.Color:=ChorKlav; midiOutShortMsg(hmidi,$3D80);
end;
procedure TForm1.ShEb3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShEb3.Brush.Color:=ChorKlavNag; midiOutShortMsg (hmidi, $3F90+((vel) * $10000));
end;
procedure TForm1.ShEb3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShEb3.Brush.Color:=ChorKlav; midiOutShortMsg(hmidi,$3F80);
end;
procedure TForm1.ShE3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShE3.Brush.Color:=BelKlavNag; midiOutShortMsg (hmidi, $4090+((vel) * $10000));
end;
procedure TForm1.ShE3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShE3.Brush.Color:=BelKlav; midiOutShortMsg(hmidi,$4080);
end;
procedure TForm1.ShF3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShF3.Brush.Color:=BelKlavNag; midiOutShortMsg (hmidi, $4190+((vel) * $10000));
end;
procedure TForm1.ShF3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShF3.Brush.Color:=BelKlav; midiOutShortMsg(hmidi,$4180);
end;
procedure TForm1.ShGb3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShGb3.Brush.Color:=ChorKlavNag; midiOutShortMsg (hmidi, $4290+((vel) * $10000));
end;
procedure TForm1.ShGb3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShGb3.Brush.Color:=ChorKlav; midiOutShortMsg(hmidi,$4280);
end;
procedure TForm1.ShG3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShG3.Brush.Color:=BelKlavNag; midiOutShortMsg (hmidi, $4390+((vel) * $10000));
end;
procedure TForm1.ShG3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShG3.Brush.Color:=BelKlav; midiOutShortMsg(hmidi,$4380);
end;
procedure TForm1.ShAb3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShAb3.Brush.Color:=ChorKlavNag; midiOutShortMsg (hmidi, $4490+((vel) * $10000));
end;
procedure TForm1.ShAb3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShAb3.Brush.Color:=ChorKlav; midiOutShortMsg(hmidi,$4480);
end;
procedure TForm1.ShA3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShA3.Brush.Color:=BelKlavNag; midiOutShortMsg (hmidi, $4590+((vel) * $10000));
end;
procedure TForm1.ShA3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShA3.Brush.Color:=BelKlav; midiOutShortMsg(hmidi,$4580);
end;
procedure TForm1.ShH3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShH3.Brush.Color:=ChorKlavNag;
midiOutShortMsg (hmidi, $4690+((vel) * $10000));
end;
procedure TForm1.ShH3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShH3.Brush.Color:=ChorKlav; midiOutShortMsg(hmidi,$4680) ;
end;
procedure TForm1.ShB3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShB3.Brush.Color:=BelKlavNag;
midiOutShortMsg (hmidi, $4790+((vel) * $10000));
end;
procedure TForm1.ShB3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShB3.Brush.Color:=BelKlav; midiOutShortMsg(hmidi,$4780);
end;
procedure TForm1.ShC4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShC4.Brush.Color:=BelKlavNag;midiOutShortMsg (hmidi, $4890+((vel) * $10000));
end;
procedure TForm1.ShC4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShC4.Brush.Color:=BelKlav; midiOutShortMsg(hmidi,$4880);
end;
procedure TForm1.ShDb4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShDb4.Brush.Color:=ChorKlavNag;
midiOutShortMsg (hmidi, $4990+((vel) * $10000));
end;
procedure TForm1.ShDb4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShDb4.Brush.Color:=ChorKlav; midiOutShortMsg(hmidi,$4980);
end;
procedure TForm1.ShD4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShD4.Brush.Color:=BelKlavNag;
midiOutShortMsg (hmidi, $4A90+((vel) * $10000));
end;
procedure TForm1.ShD4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShD4.Brush.Color:=BelKlav; midiOutShortMsg(hmidi,$4A80);
end;
procedure TForm1.ShEb4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShEb4.Brush.Color:=ChorKlavNag;
midiOutShortMsg (hmidi, $4B90+((vel) * $10000));
end;
procedure TForm1.ShEb4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShEb4.Brush.Color:=ChorKlav; midiOutShortMsg(hmidi,$4B80);
end;
procedure TForm1.ShE4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShE4.Brush.Color:=BelKlavNag;
midiOutShortMsg (hmidi, $4C90+((vel) * $10000));
end;
procedure TForm1.ShE4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShE4.Brush.Color:=BelKlav; midiOutShortMsg(hmidi,$4C80) ;
end;
procedure TForm1.ShF4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShF4.Brush.Color:=BelKlavNag;midiOutShortMsg (hmidi, $4D90+((vel) * $10000));
end;
procedure TForm1.ShF4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShF4.Brush.Color:=BelKlav; midiOutShortMsg(hmidi,$4D80)
end;
procedure TForm1.ShGb4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShGb4.Brush.Color:=ChorKlavNag; midiOutShortMsg (hmidi, $4E90+((vel) * $10000));
end;
procedure TForm1.ShGb4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShGb4.Brush.Color:=ChorKlav; midiOutShortMsg(hmidi,$4E80) ;
end;
procedure TForm1.ShG4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShG4.Brush.Color:=BelKlavNag;midiOutShortMsg (hmidi, $4F90+((vel) * $10000));
end;
procedure TForm1.ShG4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShG4.Brush.Color:=BelKlav; midiOutShortMsg(hmidi,$4F80);
end;
procedure TForm1.ShAb4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShAb4.Brush.Color:=ChorKlavNag; midiOutShortMsg (hmidi, $5090+((vel) * $10000));
end;
procedure TForm1.ShAb4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShAb4.Brush.Color:=ChorKlav; midiOutShortMsg(hmidi,$5080);
end;
procedure TForm1.ShA4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShA4.Brush.Color:=BelKlavNag;midiOutShortMsg (hmidi, $5190+((vel) * $10000));
end;
procedure TForm1.ShA4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShA4.Brush.Color:=BelKlav; midiOutShortMsg(hmidi,$5180);
end;
procedure TForm1.ShH4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShH4.Brush.Color:=ChorKlavNag; midiOutShortMsg (hmidi, $5290+((vel) * $10000));
end;
procedure TForm1.ShH4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShH4.Brush.Color:=ChorKlav; midiOutShortMsg(hmidi,$5280) ;
end;
procedure TForm1.ShB4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShB4.Brush.Color:=BelKlavNag;midiOutShortMsg (hmidi, $5390+((vel) * $10000));
end;
procedure TForm1.ShB4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShB4.Brush.Color:=BelKlav; midiOutShortMsg(hmidi,$5380);
end;
procedure TForm1.ShC5MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShC5.Brush.Color:=BelKlavNag;midiOutShortMsg (hmidi, $5490+((vel) * $10000));
end;
procedure TForm1.ShC5MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ShC5.Brush.Color:=BelKlav; midiOutShortMsg(hmidi,$5480);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
midimsg := $80 + ((48) * $100) + 0;
midiOutShortMsg (hmidi, midimsg);
midimsg := $80 + ((60) * $100) + 0;
midiOutShortMsg (hmidi, midimsg);
midimsg := $80 + ((67) * $100) + 0;
midiOutShortMsg (hmidi, midimsg);
midimsg := $80 + ((74) * $100) + 0;
midiOutShortMsg (hmidi, midimsg);
midimsg := $C0+$100*00; //указываем, каким инструментом его сыграть
midiOutShortMsg (hmidi, midimsg);
Form1.Timer1.Enabled:=false;
end;
end.