⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 audioimage.pas

📁 用于CD/DVD烧录的Delphi源码,包括source和demo
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{-----------------------------------------------------------------------------
 Unit Name: AudioImage
 Author:    Paul Fisher / Andrew Semack
 Purpose:   to create a CD image of audio wave files
 History:
-----------------------------------------------------------------------------}

unit AudioImage;

interface

uses
  CustomImage, Windows, Contnrs, SysUtils, Messages, Classes, mmSystem,
    WaveUtils,MP3Convert;

type
  TCDTrack = class(TMemoryStream)      //TMemoryStream
  private
    fDirty: Boolean;
    fValid: Boolean;
    fDataSize: DWORD;
    fDataOffset: DWORD;
    fData: Pointer;
    fWaveFormat: PWaveFormatEx;
    fOnChange: TNotifyEvent;
    FTrackFileName: string;
    FTrackName: string;
    FSectorSize: Integer;
    FSectorCount: Integer;
    function GetValid: Boolean;
    function GetData: Pointer;
    function GetDataSize: DWORD;
    function GetDataOffset: DWORD;
    function GetLength: DWORD;
    function GetBitRate: DWORD;
    function GetPeakLevel: Integer;
    function GetPCMFormat: TPCMFormat;
    function GetWaveFormat: PWaveFormatEx;
    function GetAudioFormat: string;
    procedure SetSectorSize(Sector: Integer);
  protected
    function Realloc(var NewCapacity: Longint): Pointer; override;
    function UpdateDetails: Boolean; virtual;
    function MSecToByte(MSec: DWORD): DWORD;
    procedure DoChange;
    property Dirty: Boolean read fDirty;
    function ConvertTo(const pTargetWaveFormat: PWaveFormatEx): Boolean;    
  public
    constructor Create; virtual;
    destructor Destroy; override;
    function Equals(Track: TCDTrack): Boolean;
    function SameFormat(Track: TCDTrack): Boolean;
    procedure Crop;
    function Invert: Boolean;
    function ChangeVolume(Percent: Integer): Boolean;
    function ConvertToPCM(TargetFormat: TPCMFormat): Boolean;
    function MP3Convert(FromMP3toPCM : Boolean): Boolean;
    function ConvertToMP3(TargetFormat: TPCMFormat): Boolean;
    function ConvertFromMP3(TargetFormat: TPCMFormat): Boolean;
    function Delete(Pos: DWORD; Len: DWORD): Boolean;
    function Insert(Pos: DWORD; Wave: TCDTrack): Boolean;
    function InsertSilence(Pos: DWORD; Len: DWORD): Boolean;
    function Write(const Buffer; Count: Longint): Longint; override;
    property TrackName: string read FTrackName write FTrackName;
    property TrackFileName: string read FTrackFileName write FTrackFileName;
    property Valid: Boolean read GetValid;
    property Data: Pointer read GetData;
    property DataSize: DWORD read GetDataSize;
    property DataOffset: DWORD read GetDataOffset;
    property PCMFormat: TPCMFormat read GetPCMFormat;
    property WaveFormat: PWaveFormatEx read GetWaveFormat;
    property AudioFormat: string read GetAudioFormat;
    property Length: DWORD read GetLength; // in milliseconds
    property BitRate: DWORD read GetBitRate; // in kbps
    property PeakLevel: Integer read GetPeakLevel; // in percent
    property OnChange: TNotifyEvent read fOnChange write fOnChange;
    property SectorCount: integer read FSectorCount;
    property SectorSize: integer write SetSectorSize;
  end;

  // TTrack item
  TCDTrackItem = class
  private
    FName: string;
    FCDTrack: TCDTrack;
    FTag: Integer;
    FWavFileName : String;
    FSongTitle : String;     //TITLE "How Precious"
    FPreGap : Integer;
    FPostGap : Integer;
    FTrackIndex : Integer;
    //procedure ReadData(Stream: TStream);
    //procedure WriteData(Stream: TStream);
  protected
    function GetDisplayName: string;
  public
    constructor Create;
    destructor Destroy; override;
    procedure LoadWaveFile(Filename: string);
    procedure SaveWaveFile(Filename: string);
  published
    property WavFileName : String read FWavFileName write FWavFileName;
    property CDTrack: TCDTrack read FCDTrack write FCDTrack;
    property Name: string read fName write fName;
    property DisplayName: string read GetDisplayName;
    property SongTitle : String read FSongTitle write FSongTitle;
    //cue file stuff
    property TrackIndex : Integer read FTrackIndex write FTrackIndex default 0;
    property PreGap : Integer read FPreGap write FPreGap default 0;
    property PostGap : Integer read FPostGap write FPostGap default 0;
    property Tag: Integer read fTag write fTag default 0;
  end;

  PCDTrackItem = ^TCDTrackItem;


type
  TAudioImage = class(TCustomImage)
  private
    FTrackList: TClassList;
    FLastError: string;
    FCUESheet : TStringlist;
    FPerformer : String;
    FSongwriter : String;
    function GetItem(Index: Integer): TCDTrackItem;
    procedure SetItem(Index: Integer; Value: TCDTrackItem);
  protected
    procedure EmptyTrackList;
    procedure CreateCUEFile(TrackID : Integer);
    function GetCUESheet : TStringlist;
  public
    constructor Create;
    destructor Destroy; override;
    function GetLastError: string;
    function Add: TCDTrackItem;
    function Insert(Index: Integer): TCDTrackItem;
    function TrackCount: Integer;
    procedure ClearAllTracks;
    property CUESheet : TStringlist read GetCUESheet;
    property Performer : String read FPerformer write FPerformer;
    property Songwriter : String read FSongwriter write FSongwriter;
    property Tracks[Index: Integer]: TCDTrackItem read GetItem write SetItem;
      default;
  end;

implementation

uses covertfuncs;


{ TCDTrack }

constructor TCDTrack.Create;
begin
  inherited Create;
  fDirty := False;
  fWaveFormat := nil;
end;

destructor TCDTrack.Destroy;
begin
  if Assigned(fWaveFormat) then
    FreeMem(fWaveFormat);
  inherited Destroy;
end;

procedure TCDTrack.SetSectorSize(Sector: Integer);
var
  DataSize: Integer;
begin
  FSectorSize := Sector;
  DataSize := GetDataSize;
  if (DataSize mod FSectorSize) > 0 then
    FSectorCount := (DataSize div FSectorSize) + 1
  else // bigger so add on a full sector!
    FSectorCount := (DataSize div FSectorSize);
end;

function TCDTrack.Realloc(var NewCapacity: Integer): Pointer;
begin
  Result := inherited Realloc(NewCapacity);
  if not Dirty then
    DoChange;
end;

function TCDTrack.Write(const Buffer; Count: Integer): Longint;
begin
  Result := inherited Write(Buffer, Count);
  if not Dirty then
    DoChange;
end;

procedure TCDTrack.DoChange;
begin
  fDirty := True;
  if Assigned(fOnChange) then
    fOnChange(Self);
end;

function TCDTrack.MSecToByte(MSec: DWORD): DWORD;
begin
  with fWaveFormat^ do
    Result := MulDiv(nAvgBytesPerSec, MSec, 1000)
      and ($FFFFFFFF shl (nChannels * wBitsPerSample div 16));
end;

function TCDTrack.UpdateDetails: Boolean;
begin
  if fDirty then
  begin
    fValid := False;
    fDirty := False;
    if Assigned(fWaveFormat) then
    begin
      FreeMem(fWaveFormat);
      fWaveFormat := nil;
    end;
    if GetStreamWaveAudioInfo(Self, fWaveFormat, fDataSize, fDataOffset) then
    begin
      fData := Pointer(DWORD(Memory) + fDataOffset);
      fValid := True;
    end;
  end;
  Result := fValid;
end;

function TCDTrack.GetAudioFormat: string;
begin
  if UpdateDetails then
    Result := GetWaveAudioFormat(fWaveFormat)
  else
    Result := '';
end;

function TCDTrack.GetBitRate: DWORD;
begin
  if UpdateDetails then
    Result := GetWaveAudioBitRate(fWaveFormat)
  else
    Result := 0;
end;

function TCDTrack.GetPeakLevel: Integer;
begin
  if PCMFormat <> nonePCM then
    Result := GetWaveAudioPeakLevel(fData, fDataSize, fWaveFormat.wBitsPerSample)
  else
    Result := -1;
end;

function TCDTrack.GetLength: DWORD;
begin
  if UpdateDetails then
    Result := GetWaveAudioLength(fWaveFormat, fDataSize)
  else
    Result := 0;
end;

function TCDTrack.GetData: Pointer;
begin
  if UpdateDetails then
    Result := fData
  else
    Result := nil;
end;

function TCDTrack.GetDataSize: DWORD;
begin
  if UpdateDetails then
    Result := fDataSize
  else
    Result := 0;
end;

function TCDTrack.GetDataOffset: DWORD;
begin
  if UpdateDetails then
    Result := fDataOffset
  else
    Result := 0;
end;

function TCDTrack.GetValid: Boolean;
begin
  Result := UpdateDetails;
end;

function TCDTrack.GetPCMFormat: TPCMFormat;
begin
  if UpdateDetails then
    Result := GetPCMAudioFormat(fWaveFormat)
  else
    Result := nonePCM;
end;

function TCDTrack.GetWaveFormat: PWaveFormatEx;
begin
  if UpdateDetails then
    Result := fWaveFormat
  else
    Result := nil;
end;

function TCDTrack.Equals(Track: TCDTrack): Boolean;
begin
  if Valid = Track.Valid then
    if fValid and Track.fValid then
      Result :=
        (fDataSize = Track.fDataSize) and
        (fWaveFormat^.cbSize = Track.fWaveFormat^.cbSize) and
        CompareMem(fWaveFormat, Track.fWaveFormat,
        SizeOf(TWaveFormatEx) + fWaveFormat^.cbSize) and
        CompareMem(fData, Track.fData, fDataSize)
    else
      Result :=
        (Size = Track.Size) and
        CompareMem(Memory, Track.Memory, Size)
  else
    Result := False;
end;

function TCDTrack.SameFormat(Track: TCDTrack): Boolean;
begin
  if Valid and Track.Valid then
    Result :=
      (fWaveFormat^.cbSize = Track.fWaveFormat^.cbSize) and
      CompareMem(fWaveFormat, Track.fWaveFormat,
      SizeOf(TWaveFormatEx) + fWaveFormat^.cbSize)
  else
    Result := False;
end;

procedure TCDTrack.Crop;
begin
  Size := DataOffset + DataSize;
end;

function TCDTrack.Invert: Boolean;
begin
  Result := False;
  if PCMFormat <> nonePCM then
  begin
    InvertWaveAudio(fData, fDataSize, fWaveFormat.wBitsPerSample);
    Result := True;
  end;
end;

function TCDTrack.ChangeVolume(Percent: Integer): Boolean;
begin
  Result := False;
  if PCMFormat <> nonePCM then
  begin
    ChangeWaveAudioVolume(fData, fDataSize, fWaveFormat.wBitsPerSample,
      Percent);
    Result := True;
  end;
end;

function TCDTrack.ConvertTo(const pTargetWaveFormat: PWaveFormatEx): Boolean;
var
  NewData: Pointer;
  NewDataSize: DWORD;
  ckInfo, ckData: TMMCKInfo;
  mmIO: HMMIO;
begin
  Result := False;
  if Valid then
  begin
    if (fWaveFormat.cbSize <> pTargetWaveFormat^.cbSize) or
      not CompareMem(fWaveFormat, pTargetWaveFormat, SizeOf(TWaveFormatEx) +
        fWaveFormat.cbSize) then
    begin
      if ConvertWaveFormat(fWaveFormat, fData, fDataSize, pTargetWaveFormat,
        NewData, NewDataSize) then
      try
        mmIO := CreateStreamWaveAudio(Self, pTargetWaveFormat, ckInfo, ckData);
        try
          mmioWrite(mmIO, NewData, NewDataSize);
        finally
          CloseWaveAudio(mmio, ckInfo, ckData);
        end;
        Result := True;
      finally
        ReallocMem(NewData, 0);
      end;
    end
    else
      Result := True;
  end;
end;

function TCDTrack.ConvertToPCM(TargetFormat: TPCMFormat): Boolean;
var
  NewWaveFormat: TWaveFormatEx;
begin
  Result := False;
  if TargetFormat <> nonePCM then
  begin
    SetPCMAudioFormatS(@NewWaveFormat, TargetFormat);
    Result := ConvertTo(@NewWaveFormat);
  end;
end;



⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -