Ignore:
Timestamp:
Jun 23, 2019, 3:15:29 PM (5 years ago)
Author:
chronos
Message:
  • Modified: Use DpiControls package for High DPI support.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/highdpi/Packages/CevoComponents/Sound.pas

    r174 r178  
    44
    55uses
    6   Messages, SysUtils, Classes, Graphics, Controls, Forms, fgl, FileUtil,
    7   StringTables, Directories
    8   {$IFDEF WINDOWS}, MMSystem, Windows{$ENDIF}
    9   {$IFDEF LINUX}, Process, AsyncProcess{$ENDIF};
     6  Messages, SysUtils, Classes, Graphics, Controls, Forms, fgl
     7  {$IFDEF WINDOWS}, MMSystem, Windows{$ENDIF};
    108
    119type
    12   TPlayStyle = (psAsync, psSync);
    13 
    1410  TSoundPlayer = class(TForm)
    1511  private
    … …  
    1915  end;
    2016
    21   { TSound }
     17function PrepareSound(FileName: string): integer;
     18procedure PlaySound(FileName: string);
    2219
     20implementation
     21
     22{$R *.lfm}
     23
     24type
    2325  TSound = class
    24   private
    25     PlayCommand: string;
    26     {$IFDEF LINUX}
    27     SoundPlayerAsyncProcess: TAsyncProcess;
    28     SoundPlayerSyncProcess: TProcess;
    29     {$ENDIF}
    30     function GetNonWindowsPlayCommand: string;
    3126  public
    32     FDeviceID: Word;
     27    FDeviceID: word;
    3328    FFileName: string;
    34     PlayStyle: TPlayStyle;
    3529    constructor Create(const FileName: string);
    3630    destructor Destroy; override;
    … …  
    4034  end;
    4135
    42 function PrepareSound(FileName: string): Integer;
    43 procedure PlaySound(FileName: string);
    44 function Play(Item: string; Index: Integer = -1): Boolean;
    45 procedure PreparePlay(Item: string; Index: Integer = -1);
    46 
    47 const
    48   // sound modes
    49   smOff = 0;
    50   smOn = 1;
    51   smOnAlt = 2;
    52 
    53 var
    54   Sounds: TStringTable;
    55   SoundMode: Integer;
    56   SoundPlayer: TSoundPlayer;
    57   SoundList: TFPGObjectList<TSound>;
    58   PlayingSound: TSound;
    59 
    60 
    61 implementation
    62 
    63 {$R *.lfm}
    64 
    65 resourcestring
    66   SUnableToPlay = 'PlayStyle=%s: Unable to play %s Message:%s';
    67   SPlayCommandNotWork = 'The play command %s does not work on your system';
    6836
    6937constructor TSound.Create(const FileName: string);
    … …  
    7341{$ENDIF}
    7442begin
    75   PlayStyle := psAsync;
    76   FFileName := FileName;
    7743  {$IFDEF WINDOWS}
    7844  FDeviceID := 0;
    79   if FileExists(FFileName) then begin
     45  FFileName := FileName;
     46  if FileExists(FFileName) then
     47  begin
    8048    OpenParm.dwCallback := 0;
    8149    OpenParm.lpstrDeviceType := 'WaveAudio';
    … …  
    8553    FDeviceID := OpenParm.wDeviceID;
    8654  end
    87   {$ENDIF}
    88   {$IFDEF LINUX}
    89   PlayCommand := GetNonWindowsPlayCommand;
    90   FDeviceID := 1;
    9155  {$ENDIF}
    9256end;
    … …  
    9862    mciSendCommand(FDeviceID, MCI_CLOSE, MCI_WAIT, 0);
    9963  {$ENDIF}
    100   {$IFDEF LINUX}
    101   FreeAndNil(SoundPlayerSyncProcess);
    102   FreeAndNil(SoundPlayerAsyncProcess);
    103   {$ENDIF}
    10464  inherited Destroy;
    10565end;
    106 
    107 function TSound.GetNonWindowsPlayCommand: string;
    108 begin
    109   Result := '';
    110   // Try play
    111   if (FindDefaultExecutablePath('play') <> '') then
    112     Result := 'play';
    113   // Try aplay
    114   if (result = '') then
    115     if (FindDefaultExecutablePath('aplay') <> '') then
    116       Result := 'aplay -q';
    117   // Try paplay
    118   if (Result = '') then
    119     if (FindDefaultExecutablePath('paplay') <> '') then
    120       Result := 'paplay';
    121   // Try mplayer
    122   if (Result = '') then
    123     if (FindDefaultExecutablePath('mplayer') <> '') then
    124       Result := 'mplayer -really-quiet';
    125   // Try CMus
    126   if (Result = '') then
    127     if (FindDefaultExecutablePath('CMus') <> '') then
    128       Result := 'CMus';
    129   // Try pacat
    130   if (Result = '') then
    131     if (FindDefaultExecutablePath('pacat') <> '') then
    132       Result := 'pacat -p';
    133   // Try ffplay
    134   if (Result = '') then
    135     if (FindDefaultExecutablePath('ffplay') <> '') then
    136       result := 'ffplay -autoexit -nodisp';
    137   // Try cvlc
    138   if (Result = '') then
    139     if (FindDefaultExecutablePath('cvlc') <> '') then
    140       result := 'cvlc -q --play-and-exit';
    141   // Try canberra-gtk-play
    142   if (Result = '') then
    143     if (FindDefaultExecutablePath('canberra-gtk-play') <> '') then
    144       Result := 'canberra-gtk-play -c never -f';
    145   // Try Macintosh command?
    146   if (Result = '') then
    147     if (FindDefaultExecutablePath('afplay') <> '') then
    148       Result := 'afplay';
    149 end;
    150 
    15166
    15267procedure TSound.Play(HWND: DWORD);
    … …  
    15469var
    15570  PlayParm: TMCI_Play_Parms;
    156 {$ENDIF}
    157 {$IFDEF LINUX}
    158 var
    159   L: TStringList;
    160   I: Integer;
    16171{$ENDIF}
    16272begin
    … …  
    16878  end
    16979  {$ENDIF}
    170   {$IFDEF LINUX}
    171   // How to play in Linux? Use generic Linux commands
    172   // Use asyncprocess to play sound as SND_ASYNC
    173   // proceed if we managed to find a valid command
    174   if PlayCommand <> '' then begin
    175     L := TStringList.Create;
    176     try
    177       L.Delimiter := ' ';
    178       L.DelimitedText := PlayCommand;
    179       if PlayStyle = psASync then begin
    180         if SoundPlayerAsyncProcess = nil then
    181           SoundPlayerAsyncProcess := TAsyncProcess.Create(nil);
    182         SoundPlayerAsyncProcess.CurrentDirectory := ExtractFileDir(FFilename);
    183         SoundPlayerAsyncProcess.Executable := FindDefaultExecutablePath(L[0]);
    184         SoundPlayerAsyncProcess.Parameters.Clear;
    185         for I := 1 to L.Count - 1 do
    186           SoundPlayerAsyncProcess.Parameters.Add(L[I]);
    187         SoundPlayerAsyncProcess.Parameters.Add(FFilename);
    188         try
    189           SoundPlayerAsyncProcess.Execute;
    190         except
    191           On E: Exception do
    192             E.CreateFmt(SUnableToPlay, ['paASync', FFilename, E.Message]);
    193         end;
    194         PlayingSound := nil;
    195       end else begin
    196         if SoundPlayerSyncProcess = nil then
    197           SoundPlayerSyncProcess := TProcess.Create(nil);
    198         SoundPlayerSyncProcess.CurrentDirectory := ExtractFileDir(FFilename);
    199         SoundPlayerSyncProcess.Executable := FindDefaultExecutablePath(L[0]);
    200         SoundPlayersyncProcess.Parameters.Clear;
    201         for I := 1 to L.Count - 1 do
    202           SoundPlayerSyncProcess.Parameters.Add(L[I]);
    203         SoundPlayerSyncProcess.Parameters.Add(FFilename);
    204         try
    205           SoundPlayerSyncProcess.Execute;
    206           SoundPlayersyncProcess.WaitOnExit;
    207         except
    208           On E: Exception do
    209             E.CreateFmt(SUnableToPlay, ['paSync', FFilename, E.Message]);
    210         end;
    211         PlayingSound := nil;
    212       end;
    213     finally
    214       L.Free;
    215     end;
    216   end
    217   else
    218     raise Exception.CreateFmt(SPlayCommandNotWork, [PlayCommand]);
    219   {$ENDIF}
    22080end;
    22181
    … …  
    22484  {$IFDEF WINDOWS}
    22585  mciSendCommand(FDeviceID, MCI_STOP, 0, 0);
    226   {$ENDIF}
    227   {$IFDEF LINUX}
    228   if SoundPlayerSyncProcess <> nil then SoundPlayerSyncProcess.Terminate(1);
    229   if SoundPlayerAsyncProcess <> nil then SoundPlayerAsyncProcess.Terminate(1);
    23086  {$ENDIF}
    23187end;
    … …  
    23793  {$ENDIF}
    23894end;
     95
     96
     97var
     98  SoundPlayer: TSoundPlayer;
     99  SoundList: TFPGObjectList<TSound>;
     100  PlayingSound: TSound;
    239101
    240102{$IFDEF WINDOWS}
    … …  
    249111{$ENDIF}
    250112
    251 function PrepareSound(FileName: string): Integer;
     113function PrepareSound(FileName: string): integer;
    252114begin
    253115  Result := 0;
    254   while (Result < SoundList.Count) and (SoundList[result].FFileName <> FileName) do
    255     Inc(Result);
    256   if Result = SoundList.Count then begin
    257     // First time this sound is played
     116  while (result < SoundList.Count) and (SoundList[result].FFileName <> FileName) do
     117    inc(result);
     118  if result = SoundList.Count then begin
     119    // first time this sound is played
    258120    SoundList.Add(TSound.Create(FileName));
    259121    Result := SoundList.Count - 1;
    … …  
    263125procedure PlaySound(FileName: string);
    264126begin
    265   if PlayingSound <> nil then Exit;
     127  if PlayingSound <> nil then
     128    exit;
    266129  if SoundPlayer = nil then
    267130    Application.CreateForm(TSoundPlayer, SoundPlayer);
    … …  
    271134  else
    272135    PlayingSound.Play(SoundPlayer.Handle);
    273 end;
    274 
    275 function Play(Item: string; Index: Integer = -1): Boolean;
    276 {$IFNDEF DEBUG}
    277 var
    278   WavFileName: string;
    279 {$ENDIF}
    280 begin
    281   Result := False;
    282 {$IFNDEF DEBUG}
    283   if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then
    284   begin
    285     Result := True;
    286     Exit;
    287   end;
    288   WavFileName := Sounds.Lookup(Item, Index);
    289   Assert(WavFileName[1] <> '[');
    290   Result := (WavFileName <> '') and (WavFileName[1] <> '[') and (WavFileName <> '*');
    291   if Result then
    292     // SndPlaySound(pchar(HomeDir+'Sounds' +DirectorySeparator+WavFileName+'.wav'),SND_ASYNC)
    293     PlaySound(HomeDir + 'Sounds' + DirectorySeparator + WavFileName);
    294 {$ENDIF}
    295 end;
    296 
    297 procedure PreparePlay(Item: string; Index: Integer = -1);
    298 {$IFNDEF DEBUG}
    299 var
    300   WavFileName: string;
    301 {$ENDIF}
    302 begin
    303 {$IFNDEF DEBUG}
    304   if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then
    305     Exit;
    306   WavFileName := Sounds.Lookup(Item, Index);
    307   Assert(WavFileName[1] <> '[');
    308   if (WavFileName <> '') and (WavFileName[1] <> '[') and (WavFileName <> '*') then
    309     PrepareSound(HomeDir + 'Sounds' + DirectorySeparator + WavFileName);
    310 {$ENDIF}
    311136end;
    312137
    … …  
    325150  end;
    326151  FreeAndNil(SoundList);
    327   if Sounds <> nil then
    328     FreeAndNil(Sounds);
    329152end;
    330153
Note: See TracChangeset for help on using the changeset viewer.