Personal Computer World 1995 May/pcw-0595.bin/demos/databeck/wsounds/setup.dir/wswsrc.exe/PLAYDLG.PAS

Pascal/Delphi Source File | 1992-12-02 | 6KB | 229 lines

unit PlayDlg;

interface

uses WinTypes, WinProcs, WinDos, WObjects, Strings, MMSystem;

(*{$R PlayDlg.RES}*)

const
  dn_PlayDlg = 'PlayDlg';

  id_FName = 400;
  id_FPath = 401;
  id_FList = 402;
  id_DList = 403;
  id_Play  = 404;
  id_Normal= 405;
  id_Loop  = 406;
  id_Stop  = 407;

const
  fsFileSpec = fsFileName + fsExtension;

type
  PPlayDialog = ^TPlayDialog;
  TPlayDialog = object(TDialog)
    Caption: PChar;
    FilePath: PChar;
    PathName: array[0..fsPathName] of Char;
    Extension: array[0..fsExtension] of Char;
    FileSpec: array[0..fsFileSpec] of Char;
    constructor Init(AParent: PWindowsObject; AName, AFilePath: PChar);
    function CanClose: Boolean; virtual;
    procedure SetupWindow; virtual;
    procedure HandleFName(var Msg: TMessage); virtual id_First + id_FName;
    procedure HandleFList(var Msg: TMessage); virtual id_First + id_FList;
    procedure HandleDList(var Msg: TMessage); virtual id_First + id_DList;
    procedure HandlePlay (var Msg: TMessage); virtual id_First + id_Play;
    procedure HandleNormal (var Msg: TMessage); virtual id_First + id_Normal;
    procedure HandleLoop (var Msg: TMessage); virtual id_First + id_Loop;
    procedure HandleStop (var Msg : TMessage); virtual id_First + id_Stop;
  private
    procedure SelectFileName;
    procedure UpdateFileName;
    function UpdateListBoxes: Boolean;
  end;

implementation

function GetFileName(FilePath: PChar): PChar;
var
  P: PChar;
begin
  P := StrRScan(FilePath, '\');
  if P = nil then P := StrRScan(FilePath, ':');
  if P = nil then GetFileName := FilePath else GetFileName := P + 1;
end;

function GetExtension(FilePath: PChar): PChar;
var
  P: PChar;
begin
  P := StrScan(GetFileName(FilePath), '.');
  if P = nil then GetExtension := StrEnd(FilePath) else GetExtension := P;
end;

function HasWildCards(FilePath: PChar): Boolean;
begin
  HasWildCards := (StrScan(FilePath, '*') <> nil) or
    (StrScan(FilePath, '?') <> nil);
end;

{ TPlayDialog }

constructor TPlayDialog.Init(AParent: PWindowsObject;
  AName, AFilePath: PChar);
begin
  TDialog.Init(AParent, AName);
  Caption := nil;
  FilePath := AFilePath;
end;

function TPlayDialog.CanClose: Boolean;
var
  PathLen: Word;
begin
{
  CanClose := False;
  GetDlgItemText(HWindow, id_FName, PathName, fsPathName + 1);
  FileExpand(PathName, PathName);
  PathLen := StrLen(PathName);
  if (PathName[PathLen - 1] = '\') or HasWildCards(PathName) or
    (GetFocus = GetDlgItem(HWindow, id_DList)) then
  begin
    if PathName[PathLen - 1] = '\' then
      StrLCat(PathName, FileSpec, fsPathName);
    if not UpdateListBoxes then
    begin
      MessageBeep(0);
      SelectFileName;
    end;
    Exit;
  end;
  StrLCat(StrLCat(PathName, '\', fsPathName), FileSpec, fsPathName);
  if UpdateListBoxes then Exit;
  PathName[PathLen] := #0;
  if GetExtension(PathName)[0] = #0 then
    StrLCat(PathName, Extension, fsPathName);
  AnsiLower(StrCopy(FilePath, PathName));
  }
  CanClose := True;
end;

procedure TPlayDialog.SetupWindow;
begin
  SendDlgItemMessage(HWindow, id_FName, em_LimitText, fsPathName, 0);
  CheckRadioButton(HWindow, id_Normal, id_Loop, id_Normal);
  if Caption <> nil then SetWindowText(HWindow, Caption);
  StrLCopy(PathName, FilePath, fsPathName);
  StrLCopy(Extension, GetExtension(PathName), fsExtension);
  if HasWildCards(Extension) then Extension[0] := #0;
  if not UpdateListBoxes then
  begin
    StrCopy(PathName, '*.*');
    UpdateListBoxes;
  end;
  SelectFileName;
end;

procedure TPlayDialog.HandleFName(var Msg: TMessage);
begin
  if Msg.LParamHi = en_Change then
    EnableWindow(GetDlgItem(HWindow, id_Ok),
      SendMessage(Msg.LParamLo, wm_GetTextLength, 0, 0) <> 0);
end;

procedure TPlayDialog.HandleFList(var Msg: TMessage);
begin
  case Msg.LParamHi of
    lbn_SelChange, lbn_DblClk:
      begin
        DlgDirSelect(HWindow, PathName, id_FList);
        UpdateFileName;
        if Msg.LParamHi = lbn_DblClk then HandlePlay(Msg);
      end;
    lbn_KillFocus:
      SendMessage(Msg.LParamLo, lb_SetCurSel, Word(-1), 0);
  end;
end;

procedure TPlayDialog.HandleDList(var Msg: TMessage);
begin
  case Msg.LParamHi of
    lbn_SelChange, lbn_DblClk:
      begin
        DlgDirSelect(HWindow, PathName, id_DList);
        StrCat(PathName, FileSpec);
        if Msg.LParamHi = lbn_DblClk then
          UpdateListBoxes else
          UpdateFileName;
      end;
    lbn_KillFocus:
      SendMessage(Msg.LParamLo, lb_SetCurSel, Word(-1), 0);
  end;
end;

procedure TPlayDialog.HandlePlay (var Msg: TMessage);
BEGIN
   if (IsDlgButtonChecked(HWindow, id_Loop) <> 0) THEN
      SndPlaySound(PathName,SND_Async OR SND_Loop)
   ELSE
      SndPlaySound(PathName,SND_Async)
   END;

procedure TPlayDialog.HandleNormal(var Msg: TMessage);
BEGIN
   CheckRadioButton(HWindow, id_Normal, id_Loop, id_Normal);
   END;

procedure TPlayDialog.HandleLoop (var Msg: TMessage);
BEGIN
   CheckRadioButton(HWindow, id_Normal, id_Loop, id_Loop);
   END;

procedure TPlayDialog.HandleStop(var Msg: TMessage);
BEGIN
   SndPlaySound(NIL,SND_Async)
   END;

procedure TPlayDialog.SelectFileName;
begin
  SendDlgItemMessage(HWindow, id_FName, em_SetSel, 0, $7FFF0000);
  SetFocus(GetDlgItem(HWindow, id_FName));
end;

procedure TPlayDialog.UpdateFileName;
begin
  SetDlgItemText(HWindow, id_FName, AnsiLower(PathName));
  SendDlgItemMessage(HWindow, id_FName, em_SetSel, 0, $7FFF0000);
end;

function TPlayDialog.UpdateListBoxes: Boolean;
var
  Result: Integer;
  Path: array[0..fsPathName] of Char;
begin
  UpdateListBoxes := False;
  if GetDlgItem(HWindow, id_FList) <> 0 then
  begin
    StrCopy(Path, PathName);
    Result := DlgDirList(HWindow, Path, id_FList, id_FPath, 0);
    if Result <> 0 then DlgDirList(HWindow, '*.*', id_DList, 0, $C010);
  end else
  begin
    StrLCopy(Path, PathName, GetFileName(PathName) - PathName);
    StrLCat(Path, '*.*', fsPathName);
    Result := DlgDirList(HWindow, Path, id_DList, id_FPath, $C010);
  end;
  if Result <> 0 then
  begin
    StrLCopy(FileSpec, GetFileName(PathName), fsFileSpec);
    StrCopy(PathName, FileSpec);
    UpdateFileName;
    UpdateListBoxes := True;
  end;
end;

end.