|
p align="left"> Приложение А (продолжение) begin video.AVIFile.FileName := opendialog.FileName; video.Caption := ExtractFileName(opendialog.FileName); video.AVIFile.OpenFile; video.AVIControl.FreeStreams; video.AVIControl.AddFile(video.AVIFile); video.AVIDisplay.Refresh; video.Icon.Handle := ExtractassociatedIcon(0,PChar(opendialog.FileName),Idx); end; end else if OpenDialog.Execute then begin IncPlayList := False; WaveOut.Stop; if not LoadFile(OpenDialog.FileName) then MessageDlg('Итс файл из нот карренли',mtWarning, [mbOK],0); SetFileParams; end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.btnCloseClick(Sender: TObject); begin if (MessageDlg('ВЫ дестительно хотите выйте из программы??', mtConfirmation, [mbYes, mbNo], 0) = mrYes) then Close; end; procedure TMainForm.btnMenuClick(Sender: TObject); var P: TPoint; begin P := ButtonPanel.ClientToScreen(Point(btnMenu.Left,btnMenu.Top+btnMenu.Height)); PopupMenu.Popup(P.X,P.Y); end; procedure TMainForm.btnPlayClick(Sender: TObject); begin if (PlayList.Count = 0) then begin btnOpenClick(nil); Refresh; end; IncPlayList := False; if (PlayList.Count > 0) then begin if not (wosPlay in WaveOut.State) then begin SelectFile(PlayIndex); WaveOut.Start; end else if (wosPause in WaveOut.State) then WaveOut.Restart else begin WaveOut.Stop; WaveOut.Start; end; end; Приложение А (продолжение) IncPlayList := True; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.btnPauseClick(Sender: TObject); begin if (wosPlay in WaveOut.State) then begin if (wosPause in WaveOut.State) then WaveOut.Restart else WaveOut.Pause; end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.btnStopClick(Sender: TObject); begin IncPlayList := False; WaveOut.Stop; end; //предыдущая композиция procedure TMainForm.btnPrevClick(Sender: TObject); begin IncPlayList := False; if (PlayIndex > 0) then begin dec(PlayIndex); if (wosPlay in WaveOut.State) then begin WaveOut.Stop; SelectFile(PlayIndex); WaveOut.Start; end else SelectFile(PlayIndex); end; IncPlayList := True; end; ////следующая композиция procedure TMainForm.btnNextClick(Sender: TObject); begin IncPlayList := False; if (PlayIndex < PlayList.Count-1) then begin inc(PlayIndex); if (wosPlay in WaveOut.State) then begin WaveOut.Stop; SelectFile(PlayIndex); WaveOut.Start; end else SelectFile(PlayIndex); end; IncPlayList := True; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.GaugeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var aPos: Longint; Приложение А (продолжение) begin if (wosOpen in WaveOut.State) then begin Seeking := True; WaveOut.Pause; if not MpegFile.Empty then begin with Gauge do aPos := MulDiv(X-BevelExtend,MpegFile.Frames,(Width-2*BevelExtend)-1); if aPos >= MpegFile.Frames then begin WaveOut.Stop; exit; end else begin MpegFile.Position := aPos; CurTime := MpegFile.Position*MpegFile.TimePerFrame; end; end else begin with Gauge do aPos := MulDiv(X-BevelExtend,WaveFile.Wave.DataSize,(Width-2*BevelExtend)-1); if aPos > WaveFile.Wave.DataSize then begin WaveOut.Stop; exit; end else begin WaveFile.Wave.Position := aPos; CurTime := WaveFile.Wave.Position; end; end; WaveOut.Reset; WaveOut.Restart; OldTime := 0; Seeking := False; end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.btnSkipLClick(Sender: TObject); begin if (wosPlay in WaveOut.State) then begin Seeking := True; WaveOut.Pause; if not MpegFile.Empty then begin MpegFile.Position := MpegFile.Position-(5000 div MpegFile.TimePerFrame); CurTime := MpegFile.Position*MpegFile.TimePerFrame; end else begin WaveFile.Wave.Position := WaveFile.Wave.Position-5000; CurTime := WaveFile.Wave.Position; end; WaveOut.Reset; WaveOut.Restart; OldTime := 0; Seeking := False; end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.btnSkipRClick(Sender: TObject); Приложение А (продолжение) begin if (wosPlay in WaveOut.State) then begin if not MpegFile.Empty then begin if MpegFile.Position+(5000 div MpegFile.TimePerFrame) > MpegFile.Frames then WaveOut.Stop; end else begin if WaveFile.Wave.Position+5000 > WaveFile.Wave.DataSize then WaveOut.Stop; end; Seeking := True; WaveOut.Pause; if not MpegFile.Empty then begin MpegFile.Position := MpegFile.Position+(5000 div MpegFile.TimePerFrame); CurTime := MpegFile.Position*MpegFile.TimePerFrame; end else begin WaveFile.Wave.Position := WaveFile.Wave.Position+5000; CurTime := WaveFile.Wave.Position; end; WaveOut.Reset; WaveOut.Restart; OldTime := 0; Seeking := False; end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.btnDecVolumeClick(Sender: TObject); var Volume,L,R: Longint; begin if (wosOpen in WaveOut.State) then begin WaveOutGetVolume(WaveOut.Handle,@Volume); L := LoWord(Volume); R := HiWord(Volume); L := Max(L - 5000,0); R := Max(R - 5000,0); Volume := (R shl 16) + L; WaveOutSetVolume(WaveOut.Handle,Volume); end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.btnIncVolumeClick(Sender: TObject); var Volume,L,R: Longint; begin if (wosOpen in WaveOut.State) then begin WaveOutGetVolume(WaveOut.Handle,@Volume); L := LoWord(Volume); R := HiWord(Volume); L := Min(L + 5000,$FFFF); R := Min(R + 5000,$FFFF); Volume := (R shl 16) + L; WaveOutSetVolume(WaveOut.Handle,Volume); Приложение А (продолжение) end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.btnPlayListClick(Sender: TObject); var wasPlaying: Boolean; begin with TPlayListEditor.Create(Self) do try if ShowModal = mrOK then begin IncPlayList := False; wasPlaying := (wosPlay in WaveOut.State); WaveOut.Stop; PlayList.Assign(TempPlayList); PlayListName := ListName; PlayIndex := 0; SelectFile(0); if wasPlaying then btnPlayClick(nil); end; finally Free; end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.MMPanelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Button = mbLeft) then begin Dragging := True; DragStart := TControl(Sender).ClientToScreen(Point(X,Y)); end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.MMPanelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Button = mbLeft) then Dragging := False; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.MMPanelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var Diff: TPoint; begin if Dragging then begin Diff := TControl(Sender).ClientToScreen(Point(X,Y)); Diff := Point(Diff.X-DragStart.X,Diff.Y-DragStart.Y); SetBounds(Left+Diff.X,Top+Diff.Y,Width,Height); DragStart.X := DragStart.X+Diff.X; DragStart.Y := DragStart.Y+Diff.Y; end; end; {-- TMainForm -----------------------------------------------------------} procedure TMainForm.Info1Click(Sender: TObject); begin autor.show; end; {-- TMainForm -----------------------------------------------------------} Приложение А (продолжение) procedure TMainForm.DrawLevelBar(Sender: TObject; DIB: TMMDIBCanvas; Rect: TRect; nSpots,Peak: integer); begin with DIB,Rect do begin if Sender = MMSpectrum1 then begin DIB_CopyDIBBits(MMSpectrum1.DIBCanvas.BackSurface,Left,Bottom-nSpots,Right-Left-1,Bottom,0,Bottom-nSpots); DIB_CopyDIBBits(MMSpectrum1.DIBCanvas.BackSurface,Left,Bottom-Peak,Right-Left-1,2,0,Bottom-Peak); end else if Sender = MMLevel1 then
Страницы: 1, 2, 3, 4, 5, 6, 7, 8
| 
