home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 1995 May / pcw-0595.bin / demos / databeck / wsounds / setup.dir / wswsrc.exe / SCANDLG.PAS < prev    next >
Pascal/Delphi Source File  |  1992-12-03  |  8KB  |  301 lines
  1. unit ScanDlg;
  2.  
  3. interface
  4.  
  5. uses WinTypes, WinProcs, WinDos, WObjects, Strings, MMSystem, DataObj,
  6.      TakeDlg, ShowRDlg, WAVEIO;
  7.  
  8. const
  9.   dn_ScanDlg = 'ScanDlg';
  10.  
  11.   id_FPath   = 501;
  12.   id_FList   = 502;
  13.   id_DList   = 503;
  14.   id_TakeOne = 504;
  15.   id_TakeAll = 505;
  16.   id_SubScan = 506;
  17.   id_GoAhead = 507;
  18.   id_Play    = 508;
  19.   id_Display = 509;
  20. const
  21.   fsFileSpec = fsFileName + fsExtension;
  22.  
  23. type
  24.   PScanDlg = ^TScanDlg;
  25.   TScanDlg = object(TDialog)
  26.     sbscan : BOOL;
  27.     Caption: PChar;
  28.     FileName: PChar;
  29.     FilePath: PChar;
  30.     PathName: array[0..fsPathName] of Char;
  31.     Extension: array[0..fsExtension] of Char;
  32.     FileSpec: array[0..fsFileSpec] of Char;
  33.     constructor Init(AParent: PWindowsObject; AName, AFilePath: PChar);
  34.     function CanClose: Boolean; virtual;
  35.     procedure SetupWindow; virtual;
  36.     {procedure HandleFName(var Msg: TMessage); virtual id_First + id_FName;}
  37.     procedure HandleFList(var Msg: TMessage); virtual id_First + id_FList;
  38.     procedure HandleDList(var Msg: TMessage); virtual id_First + id_DList;
  39.     procedure HandleTakeOne (var Msg: TMessage); virtual id_First + id_TakeOne;
  40.     procedure HandlePlay (var Msg: TMessage); virtual id_First + id_Play;
  41.     procedure HandleTakeAll (var Msg: TMessage); virtual id_First + id_TakeAll;
  42.     procedure HandleSubScan(var Msg: TMessage); virtual id_First + id_SubScan;
  43.     {procedure HandleStop (var Msg : TMessage); virtual id_First + id_Stop;}
  44.     procedure RefreshDisplay;
  45.     Destructor Done;virtual;
  46.   private
  47.     procedure SelectFileName;
  48.     procedure UpdateFileName;
  49.     function UpdateListBoxes: Boolean;
  50.   end;
  51.  
  52. implementation
  53.  
  54. function GetFileName(FilePath: PChar): PChar;
  55. var
  56.   P: PChar;
  57. begin
  58.   P := StrRScan(FilePath, '\');
  59.   if P = nil then P := StrRScan(FilePath, ':');
  60.   if P = nil then GetFileName := FilePath else GetFileName := P + 1;
  61. end;
  62.  
  63. function GetExtension(FilePath: PChar): PChar;
  64. var
  65.   P: PChar;
  66. begin
  67.   P := StrScan(GetFileName(FilePath), '.');
  68.   if P = nil then GetExtension := StrEnd(FilePath) else GetExtension := P;
  69. end;
  70.  
  71. function HasWildCards(FilePath: PChar): Boolean;
  72. begin
  73.   HasWildCards := (StrScan(FilePath, '*') <> nil) or
  74.     (StrScan(FilePath, '?') <> nil);
  75. end;
  76.  
  77. { TScanDlg }
  78.  
  79. constructor TScanDlg.Init(AParent: PWindowsObject;
  80.   AName, AFilePath: PChar);
  81. begin
  82.   TDialog.Init(AParent, AName);
  83.   Caption := nil;
  84.   FilePath := AFilePath;
  85.   {WriteLn(FilePath);}
  86.   WaveSelectColl := New(PWaveCollection, Init(20,5));
  87.   sbscan := FALSE;
  88. end;
  89.  
  90. function TScanDlg.CanClose: Boolean;
  91. var
  92.   PathLen: Word;
  93. begin
  94. {
  95.   CanClose := False;
  96.   GetDlgItemText(HWindow, id_FName, PathName, fsPathName + 1);
  97.   FileExpand(PathName, PathName);
  98.   PathLen := StrLen(PathName);
  99.   if (PathName[PathLen - 1] = '\') or HasWildCards(PathName) or
  100.     (GetFocus = GetDlgItem(HWindow, id_DList)) then
  101.   begin
  102.     if PathName[PathLen - 1] = '\' then
  103.       StrLCat(PathName, FileSpec, fsPathName);
  104.     if not UpdateListBoxes then
  105.     begin
  106.       MessageBeep(0);
  107.       SelectFileName;
  108.     end;
  109.     Exit;
  110.   end;
  111.   StrLCat(StrLCat(PathName, '\', fsPathName), FileSpec, fsPathName);
  112.   if UpdateListBoxes then Exit;
  113.   PathName[PathLen] := #0;
  114.   if GetExtension(PathName)[0] = #0 then
  115.     StrLCat(PathName, Extension, fsPathName);
  116.   AnsiLower(StrCopy(FilePath, PathName));
  117.   }
  118.   CanClose := True;
  119. end;
  120.  
  121. procedure TScanDlg.SetupWindow;
  122. begin
  123.   {SendDlgItemMessage(HWindow, id_FName, em_LimitText, fsPathName, 0);}
  124.   {CheckRadioButton(HWindow, id_Normal, id_Loop, id_Normal);}
  125.   if Caption <> nil then SetWindowText(HWindow, Caption);
  126.   StrLCopy(PathName, FilePath, fsPathName);
  127.   StrLCopy(Extension, GetExtension(PathName), fsExtension);
  128.   if HasWildCards(Extension) then Extension[0] := #0;
  129.   if not UpdateListBoxes then
  130.   begin
  131.     StrCopy(PathName, '*.*');
  132.     UpdateListBoxes;
  133.   end;
  134.   SelectFileName;
  135.   RefreshDisplay;
  136. end;
  137.  
  138. {
  139. procedure TScanDlg.HandleFName(var Msg: TMessage);
  140. begin
  141.   if Msg.LParamHi = en_Change then
  142.     EnableWindow(GetDlgItem(HWindow, id_Ok),
  143.       SendMessage(Msg.LParamLo, wm_GetTextLength, 0, 0) <> 0);
  144. end;
  145. }
  146.  
  147. procedure TScanDlg.HandleFList(var Msg: TMessage);
  148. begin
  149.   case Msg.LParamHi of
  150.     lbn_SelChange, lbn_DblClk:
  151.       begin
  152.         DlgDirSelect(HWindow, PathName, id_FList);
  153.         UpdateFileName;
  154.         if Msg.LParamHi = lbn_DblClk then HandleTakeOne(Msg);
  155.         {HandlePlay(Msg);}
  156.       end;
  157.     lbn_KillFocus:
  158.       SendMessage(Msg.LParamLo, lb_SetCurSel, Word(-1), 0);
  159.   end;
  160. end;
  161.  
  162. procedure TScanDlg.HandleDList(var Msg: TMessage);
  163. begin
  164.   case Msg.LParamHi of
  165.     lbn_SelChange, lbn_DblClk:
  166.       begin
  167.         DlgDirSelect(HWindow, PathName, id_DList);
  168.         StrCat(PathName, FileSpec);
  169.         if Msg.LParamHi = lbn_DblClk then
  170.           UpdateListBoxes else
  171.           UpdateFileName;
  172.       end;
  173.     lbn_KillFocus:
  174.       SendMessage(Msg.LParamLo, lb_SetCurSel, Word(-1), 0);
  175.   end;
  176. end;
  177.  
  178. procedure TScanDlg.HandleTakeOne(var Msg: TMessage);
  179. VAR
  180.    Dummy : DirStr;
  181.    DirInfo: TSearchrec;
  182.  
  183. begin
  184.    getCurDir(Dummy,0);
  185.    {GetDlgItemText(HWindow, ID_FPath, Dummy, fsPathName +1 );}
  186.    if Dummy[StrLen(Dummy)-1] <> '\' then StrCat (Dummy,'\');
  187.    WD_ReadOneFile(HWindow,Dummy, Pathname, 0,WaveSelectColl);
  188.    RefreshDisplay;
  189.    end;
  190.  
  191. procedure TScanDlg.HandleTakeAll(var Msg: TMessage);
  192. VAR
  193.    Dummy : DirStr;
  194.    P     : PChar;
  195.    LDialog : PShowRDlg;
  196. BEGIN
  197.    getCurDir(Dummy,0);
  198.    {GetDlgItemText(HWindow, ID_FPath, Dummy, fsPathName +1 );}
  199.    IF StrLen(Dummy)>= 4 then StrCat (Dummy,'\');
  200.    IF sbscan = TRUE Then
  201.     Begin
  202.       LDialog := New(PShowRDlg, Init(@self, dn_ShowRDlg,WaveSelectColl, Dummy,1));
  203.       IF Application^.ExecDialog(LDialog) = ID_OK THEN
  204.          BEGIN
  205.            END;
  206.       End
  207.    Else
  208.     Begin
  209.      LDialog := New(PShowRDlg, Init(@self, dn_ShowRDlg,WaveSelectColl, Dummy,0));
  210.       IF Application^.ExecDialog(LDialog) = ID_OK THEN
  211.          BEGIN
  212.            END;
  213.     End;
  214.    {
  215.    WriteLn(' List all files from the selection list: ');
  216.    WD_ListAll(WAVESelectColl);}
  217.    RefreshDisplay;
  218.    end;
  219.  
  220. procedure TScanDlg.HandlePlay (var Msg: TMessage);
  221. BEGIN
  222.    SndPlaySound(PathName,SND_Async)
  223.    END;
  224.  
  225. procedure TScanDlg.HandleSubScan(var Msg: TMessage);
  226. BEGIN
  227.  IF sbscan = FALSE Then
  228.   Begin
  229.    sbScan := TRUE;
  230.   End
  231.   Else
  232.    Begin
  233.     sbScan := FALSE;
  234.  End;
  235. END;
  236.  
  237. {
  238. procedure TScanDlg.HandleStop(var Msg: TMessage);
  239. BEGIN
  240.    TScanDlg.EndDlg(0);
  241.    END;
  242. }
  243.  
  244. procedure TScanDlg.SelectFileName;
  245. begin
  246.   {SendDlgItemMessage(HWindow, id_FName, em_SetSel, 0, $7FFF0000);}
  247.   {SetFocus(GetDlgItem(HWindow, id_FName));}
  248. end;
  249.  
  250.  
  251. procedure TScanDlg.UpdateFileName;
  252. begin
  253.   {
  254.   SetDlgItemText(HWindow, id_FName, AnsiLower(PathName));
  255.   SendDlgItemMessage(HWindow, id_FName, em_SetSel, 0, $7FFF0000);
  256.   }
  257. end;
  258.  
  259. function TScanDlg.UpdateListBoxes: Boolean;
  260. var
  261.   Result: Integer;
  262.   Path: array[0..fsPathName] of Char;
  263. begin
  264.   UpdateListBoxes := False;
  265.   if GetDlgItem(HWindow, id_FList) <> 0 then
  266.   begin
  267.     StrCopy(Path, PathName);
  268.     Result := DlgDirList(HWindow, Path, id_FList, id_FPath, 0);
  269.     if Result <> 0 then DlgDirList(HWindow, '*.*', id_DList, 0, $C010);
  270.   end else
  271.   begin
  272.     StrLCopy(Path, PathName, GetFileName(PathName) - PathName);
  273.     StrLCat(Path, '*.*', fsPathName);
  274.     Result := DlgDirList(HWindow, Path, id_DList, id_FPath, $C010);
  275.   end;
  276.   if Result <> 0 then
  277.   begin
  278.     StrLCopy(FileSpec, GetFileName(PathName), fsFileSpec);
  279.     StrCopy(PathName, FileSpec);
  280.     UpdateFileName;
  281.     UpdateListBoxes := True;
  282.   end;
  283. end;
  284.  
  285.  
  286. Procedure TScanDlg.RefreshDisplay;
  287. Var out : array[0..5] of char;
  288. Begin
  289.  Str (WaveSelectColl^.Count:4,out);
  290.  SetDlgItemText(HWindow, id_Display,out);
  291. End;
  292.  
  293.  
  294. Destructor TScanDlg.Done;
  295. BEGIN
  296.    TDialog.Done;
  297.    {Dispose(WaveSelectColl, Done);}
  298.    End;
  299.  
  300. end.
  301.