Subversion Repositories spacemission

Rev

Blame | Last modification | View Log | RSS feed

  1. unit DXMidiEdit;
  2. //(c)2007 Jaro Benes
  3. //All Rights Reserved
  4.  
  5. {
  6. Complex application for users of unDelphiX as component editor:
  7.  
  8. Supported:
  9.  a) load existing midi file and store it into rersource.
  10.  b) allow do play.
  11.  
  12. }
  13. interface
  14.                          
  15. uses
  16.   Windows, SysUtils, Classes, Forms, Dialogs, Controls, StdCtrls, ExtCtrls,
  17.   Buttons, ComCtrls, Graphics, DXSounds;  
  18.  
  19. type
  20.  
  21.   {  TDelphiXWaveEditForm  }
  22.  
  23.   TDelphiXMidiEditForm = class(TForm)
  24.     Bevel2: TBevel;
  25.     OKButton: TButton;
  26.     CancelButton: TButton;
  27.     SaveDialog: TSaveDialog;
  28.     OpenDialog: TOpenDialog;
  29.     ClearButton: TButton;
  30.     SaveButton: TButton;
  31.     LoadButton: TButton;
  32.     Panel1: TPanel;
  33.     LengthLabel: TLabel;
  34.     SizeLabel: TLabel;
  35.     filenamelabel: TLabel;
  36.     SizeValueLabel: TLabel;
  37.     DXSound1: TDXSound;
  38.     DXMusic1: TDXMusic;
  39.     btnPlay: TBitBtn;
  40.     btnStop: TBitBtn;
  41.     procedure btnStopClick(Sender: TObject);
  42.     procedure btnPlayClick(Sender: TObject);
  43.     procedure OKButtonClick(Sender: TObject);
  44.     procedure CancelButtonClick(Sender: TObject);
  45.     procedure LoadButtonClick(Sender: TObject);
  46.     procedure SaveButtonClick(Sender: TObject);
  47.     procedure ClearButtonClick(Sender: TObject);
  48.     procedure FormShow(Sender: TObject);
  49.     procedure FormDestroy(Sender: TObject);
  50.     procedure FormCreate(Sender: TObject);
  51.   private
  52.     FChanged: Boolean;
  53.     FMidiFileName: string;
  54.     FPlaying: Boolean;
  55.     T: TMusicListCollectionItem;
  56.     procedure UpDateData;
  57.     procedure SetPlaying(const Value: Boolean);
  58.   public
  59.     MidiData: string;
  60.     property MidiFileName: string read FMidiFileName write FMidiFileName;
  61.     property Playing: Boolean read FPlaying write SetPlaying;
  62.   end;
  63.  
  64. var
  65.   DelphiXMidiEditForm: TDelphiXMidiEditForm;
  66.  
  67. implementation
  68.  
  69. uses DXConsts;
  70.  
  71. {$R *.DFM}
  72.  
  73. procedure TDelphiXMidiEditForm.FormDestroy(Sender: TObject);
  74. begin
  75.   if Playing then T.Stop;
  76. end;
  77.  
  78. procedure TDelphiXMidiEditForm.FormShow(Sender: TObject);
  79. begin
  80.   if Length(MidiData) <> 0 then begin
  81.     T := DXMusic1.Midis.Add;
  82.     T.Midi.MusicData := MidiData;
  83. //    if FileExists(MidiFileName) then
  84. //      T.LoadFromFile(MidiFileName);
  85.   end;
  86.   filenamelabel.Caption := MidiFileName;
  87.   SizeValueLabel.Caption := Format('%d bytes', [Length(MidiData)]);
  88.   UpDateData;
  89. end;
  90.  
  91. procedure TDelphiXMidiEditForm.OKButtonClick(Sender: TObject);
  92. begin
  93.   if FChanged then
  94.   begin
  95.     Tag := 1;
  96.   end;
  97.   Close;
  98. end;
  99.  
  100. procedure TDelphiXMidiEditForm.CancelButtonClick(Sender: TObject);
  101. begin
  102.   Close;
  103. end;
  104.  
  105. procedure TDelphiXMidiEditForm.ClearButtonClick(Sender: TObject);
  106. begin
  107.   if Playing then Playing := False;
  108.   SetLength(MidiData, 0);
  109.   MidiFileName := '';
  110.   filenamelabel.Caption := '';
  111.   SizeValueLabel.Caption := '';
  112.   DXMusic1.Midis.Clear;
  113.   FChanged := True;
  114.   UpdateData;
  115. end;
  116.  
  117. procedure TDelphiXMidiEditForm.LoadButtonClick(Sender: TObject);
  118. begin
  119.   if OpenDialog.Execute then
  120.   begin
  121.     if Playing then Playing := False;
  122.     MidiFileName := OpenDialog.FileName;
  123.     filenamelabel.Caption := ExtractFileName(MidiFileName);
  124.     T := DXMusic1.Midis.Add;
  125.     T.LoadFromFile(MidiFileName);
  126.     MidiData := T.Midi.MusicData;
  127.     SizeValueLabel.Caption := Format('%d bytes', [T.Size]);
  128.     FChanged := True;
  129.     UpdateData;
  130.   end;
  131. end;
  132.  
  133. procedure TDelphiXMidiEditForm.SaveButtonClick(Sender: TObject);
  134. var
  135.   F: file;
  136. begin
  137.   if SaveDialog.Execute then
  138.   begin
  139.     if Playing then Playing := False;
  140.     if Length(MidiData) = 0 then Exit;
  141.     if FChanged then
  142.     begin
  143.       if AnsiCompareFileName(MidiFileName, SaveDialog.FileName)=0 then Exit;
  144.     end;
  145.     AssignFile(F, SaveDialog.FileName);
  146.     Rewrite(F,1);
  147.     try
  148.       BlockWrite(F, MidiData[1], Length(MidiData));
  149.     finally
  150.       CloseFile(F);
  151.     end;
  152.   end;
  153. end;
  154.  
  155. procedure TDelphiXMidiEditForm.UpDateData;
  156. begin
  157.   if Length(mididata) > 0 then begin
  158.     SaveButton.Enabled := True;
  159.     ClearButton.Enabled := True;
  160.     btnPlay.Enabled := True;
  161.   end
  162.   else begin
  163.     SaveButton.Enabled := False;
  164.     ClearButton.Enabled := False;
  165.     btnPlay.Enabled := false;
  166.   end
  167. end;
  168.  
  169. procedure TDelphiXMidiEditForm.FormCreate(Sender: TObject);
  170. begin
  171.   Tag := 0;
  172.   FPlaying := False;
  173. end;
  174.  
  175. procedure TDelphiXMidiEditForm.SetPlaying(const Value: Boolean);
  176. begin
  177.   if not Value then T.Stop;
  178.   FPlaying := Value;
  179. end;
  180.  
  181. procedure TDelphiXMidiEditForm.btnPlayClick(Sender: TObject);
  182. begin
  183.   FPlaying := True;
  184.   T.Play;
  185. end;
  186.  
  187. procedure TDelphiXMidiEditForm.btnStopClick(Sender: TObject);
  188. begin
  189.   if Playing then Playing := False;
  190. end;
  191.  
  192. end.
  193.