mmcstdlg.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: [phone]               =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/index.html               =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 20.10.98 - 16:34:15 $                                        =}
{========================================================================}
unit MMCstDlg;

{$I COMPILER.INC}

interface

uses
{$IFDEF WIN32}
  Windows,
{$ELSE}
  WinProcs,
  WinTypes,
{$ENDIF}
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  CommDlg,
  ExtCtrls,
  MMObj,
  MMWave,
  MMWavOut,
  MMPCMSup,
  MMWaveIO,
  MMRiff,
  MMMulDiv,
  MMUtils,
  MMString,
  MMACMDlg,
  MMADCvt,
  MMDIB;

type
  {$IFNDEF WIN32}
  POpenFilenameA = ^TOpenFilenameA;
  TOpenFilenameA = record
    lStructSize: Longint;
    hWndOwner: HWnd;
    hInstance: THandle;
    lpstrFilter: PChar;
    lpstrCustomFilter: PChar;
    nMaxCustFilter: Longint;
    nFilterIndex: Longint;
    lpstrFile: PChar;
    nMaxFile: Longint;
    lpstrFileTitle: PChar;
    nMaxFileTitle: Longint;
    lpstrInitialDir: PChar;
    lpstrTitle: PChar;
    Flags: Longint;
    nFileOffset: Word;
    nFileExtension: Word;
    lpstrDefExt: PChar;
    lCustData: Longint;
    lpfnHook: function (Wnd: HWnd; Msg, wParam: Word; lParam: Longint): Word;
    lpTemplateName: PChar;
  end;
  {$ENDIF}

  TSelChangeEvent= procedure(Sender : TObject; Filename: String) of Object;
  TFileOKEvent   = procedure(Sender : TObject; Filename: String; var IsOk: Boolean) of Object;
  TCommandEvent  = procedure(Sender : TObject; Wnd,Parent,cmd: Integer) of Object;

  {-- TMMCustomOpenDialog -----------------------------------------------------}
  TMMCustomOpenDialog = class(TMMCommonDialog)
  private
    FHwnd         : Hwnd;            { Window handle for hook }
    FTemplateName : String;          { Dialog template name }
    FHistoryList  : TStrings;
    FOptions      : TOpenOptions;
    FFilter       : String;
    FFilterIndex  : Integer;
    FInitialDir   : String;
    FTitle        : String;
    FDefaultExt   : String;
    FFileName     : TFileName;
    FFiles        : TStrings;
    FTempFiles    : TStringList;
    {$IFNDEF DELPHI4}
    FSizing       : Boolean;
    {$ENDIF}

    { Custom event handlers }
    FOnCreate     : TNotifyEvent;
    FOnDestroy    : TNotifyEvent;
    FOnFileOK     : TFileOkEvent;
    FOnSelChange  : TSelChangeEvent;
    FOnCommand    : TCommandEvent;

    procedure SetHistoryList(Value: TStrings);
    procedure SetInitialDir(const Value: string);

  protected
    function  DoExecute(Func: Pointer): Bool;

    procedure DoCreate; dynamic;
    procedure DoDestroy; dynamic;
    procedure DoFileOK(FName: String; var IsOk: Boolean);dynamic;
    procedure DoSelChanged(FName: String);dynamic;
    procedure DoCommand(Wnd,Parent: Hwnd; cmd: Integer); dynamic;

    property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
    property OnFileOK: TFileOKEvent read FOnFileOK write FOnFileOK;
    property OnSelChange: TSelChangeEvent read FOnSelChange write FOnSelChange;
    property OnCommand: TCommandEvent read FOnCommand write FOnCommand;

    property DefaultExt: string read FDefaultExt write FDefaultExt;
    property FileName: TFileName read FFileName write FFileName;
    property Filter: String read FFilter write FFilter;
    property FilterIndex: Integer read FFilterIndex write FFilterIndex default 1;
    property HistoryList: TStrings read FHistoryList write SetHistoryList;
    property InitialDir: string read FInitialDir write SetInitialDir;
    property Options: TOpenOptions read FOptions write FOptions default [];
    property Title: string read FTitle write FTitle;
    property TemplateName: string read FTemplateName write FTemplateName;
    {$IFNDEF DELPHI4}
    property EnableSizing: Boolean read FSizing write FSizing default False;
    {$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function  Execute: Boolean; override;

    property  Files: TStrings read FFiles;
    property  Wnd: HWnd read FHWnd write FHWnd;
  end;

  {-- TMMWaveOpenDialog -------------------------------------------------------}
  TMMWaveOpenDialog = class(TMMCustomOpenDialog)
  private
    FWaveFile    : TMMWaveFile;
    FADPCMConvert: TMMADPCMConverter;
    FWaveOut     : TMMWaveOut;
    FDeviceID    : integer;
    FTimer       : TTimer;
    FData        : Pointer;
    FForeColor   : TColor;
    FColor       : TColor;
    FLocatorColor: TColor;
    FPreview     : Boolean;
    FAutoPlay    : Boolean;
    FUpdating    : Boolean;
    FOldPos      : Longint;
    FScopeWnd    : HWND;
    FScopeDefProc: TFarProc;
    FScopeOldProc: Longint;
    FDIBWnd      : HWND;
    FDIBDefProc  : TFarProc;
    FDIBOldProc  : Longint;

    procedure WaveOutStart(Sender: TObject);
    procedure WaveOutStop(Sender: TObject);
    procedure TimerExpired(Sender: TObject);
    procedure UpdateWave;
    procedure UpdatePlayParams;
    procedure DrawLocator(var OldPos: Longint; NewPos: Longint);
    procedure CreatePCMData(DC: HDC; aRect: TRect);
    procedure DrawPCMData(DC: HDC; aRect: TRect);
    procedure DrawDISP(DC: HDC; aRect: TRect);
    procedure ScopeWndHookProc(var Message: TMessage);
    procedure DIBWndHookProc(var Message: TMessage);

  protected
    procedure DoCreate;override;
    procedure DoDestroy;override;
    procedure DoFileOK(FName: String; var IsOk: Boolean);override;
    procedure DoSelChanged(FName: String);override;
    procedure DoCommand(Wnd,Parent: Hwnd; cmd: Integer);override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;

  published
    property OnFileOK: TFileOKEvent read FOnFileOK write FOnFileOK;

    property FileName;
    property Filter;
    property FilterIndex;
    property InitialDir;
    property Title;

    {$IFNDEF DELPHI4}
    property EnableSizing;
    {$ENDIF}
    property Options;
    property Color: TColor read FColor write FColor default clBlack;
    property ForeColor: TColor read FForeColor write FForeColor default clLime;
    property LocatorColor: TColor read FLocatorColor write FLocatorColor default clRed;
    property Preview: Boolean read FPreview write FPreview default False;
    property AutoPlay: Boolean read FAutoPlay write FAutoPlay default False;
    property DeviceID: integer read FDeviceID write FDeviceID default -1;
  end;

  {-- TMMWaveSaveDialog -------------------------------------------------------}
  TMMWaveSaveDialog = class(TMMWaveOpenDialog)
  public
    constructor Create(AOwner: TComponent); override;
    function Execute: Boolean; override;
  end;

  {-- TMMPictureOpenDialog ----------------------------------------------------}
  TMMPictureOpenDialog = class(TMMCustomOpenDialog)
  private
    FBitmap      : TBitmap;
    FPicture     : TPicture;
    FPreview     : Boolean;
    FColor       : TColor;
    FHookWnd     : HWND;
    FDefProc     : TFarProc;
    FOldProc     : Longint;
    FLastFile    : string;

    procedure UpdatePicture;
    procedure DrawPicture(DC: HDC; aRect: TRect);
    procedure WndHookProc(var Message: TMessage);

  protected
    procedure DoCreate;override;
    procedure DoDestroy;override;
    procedure DoFileOK(FName: String; var IsOk: Boolean);override;
    procedure DoSelChanged(FName: String);override;
    procedure DoCommand(Wnd,Parent: Hwnd; cmd: Integer);override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;

  published
    property OnFileOK: TFileOKEvent read FOnFileOK write FOnFileOK;

    property DefaultExt;
    property FileName;
    property Filter;
    property FilterIndex default 1;
    property InitialDir;
    property Title;
    property Options;
    property Color: TColor read FColor write FColor default clWindow;
    property Preview: Boolean read FPreview write FPreview default False;
  end;

  {-- TMMPictureSaveDialog ----------------------------------------------------}
  TMMPictureSaveDialog = class(TMMPictureOpenDialog)
  public
    constructor Create(AOwner: TComponent); override;
    function Execute: Boolean; override;
  end;

implementation

{$IFDEF WIN32}
   {$R MMCSTDLG.D32}
{$ELSE}
   {$R MMCSTDLG.D16}
{$ENDIF}

type
   TDisplayRec = packed record
      LeftMin : SmallInt;
      LeftMax : SmallInt;
      RightMin: SmallInt;
      RightMax: SmallInt;
   end;
   PDisplayData = ^TDisplayData;
   TDisplayData = array[0..0] of TDisplayRec;

const
     lst1 = $0460; { FileListBox ID  }
     lst2 = $0461; { DirListBox ID   }
     cmb2 = $0471; { DriveListBox ID }
     BT_PLAY    = 1000;
     CB_PREVIEW = 1001;
     CB_AUTOPLAY= 1002;
     LT_FORMAT  = 1003;
     ST_SCOPE   = 1004;
     ST_DIB     = 1005;

     ST_PICTURE = 1000;   { Preview window for Picture Dialog }

     Obj: TMMCustomOpenDialog = nil;

const
  HookCtl3D: Boolean = False;
  DialogTitle: PChar = nil;

var
  CD_LBSelCh: Word;
  CD_ShareVi: Word;
  CD_FileOK : Word;

procedure InitDialogs;
begin
   CD_LBSelCh := RegisterWindowMessage(LBSelChString);
   CD_ShareVi := RegisterWindowMessage(ShareViString);
   CD_FileOK  := RegisterWindowMessage(FileOKString);
end;

{-- Center the given window on the screen -------------------------------------}
procedure CenterWindow(Wnd: HWnd);
var
  Rect: TRect;
begin
   GetWindowRect(Wnd, Rect);
   SetWindowPos(Wnd, 0,
         (GetSystemMetrics(SM_CXSCREEN) - Rect.Right + Rect.Left) div 2,
         (GetSystemMetrics(SM_CYSCREEN) - Rect.Bottom + Rect.Top) div 3,
         0, 0, SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOZORDER);
end;

{$IFNDEF WIN32}
function TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool;
type
  TDialogFunc = function(var DialogData): Bool;
var
  ActiveWindow: HWnd;
  WindowList: Pointer;
begin
  ActiveWindow := GetActiveWindow;
  WindowList := DisableTaskWindows(0);
  try
    Result := TDialogFunc(DialogFunc)(DialogData);
  finally
    EnableTaskWindows(WindowList);
    SetActiveWindow(ActiveWindow);
  end;
end;
{$ENDIF}

{------------------------------------------------------------------------------}
function ExtractFileName_A(P: PChar; var S: String): PChar;
var
   Separator: Char;
begin
   Separator := #0;
   Result := P;
   while (Result[0] <> #0) and (Result[0] <> Separator) do Inc(Result);
   SetString(S, P, Result - P);
   if Result[0] = Separator then Inc(Result);
end;

{------------------------------------------------------------------------------}
function ExtractFileName_B(P: PChar; var S: string): PChar;
var
   Separator: Char;
begin
   Separator := '"';
   Result := P;
   while (Result[0] <> #0) and (Result[0] <> Separator) do Inc(Result);
   SetString(S, P, Result - P);
   while (Result[0] = Separator) or (Result[0] = ' ') do inc(Result);
end;

{------------------------------------------------------------------------------}
procedure ExtractFileNames(P: PChar; FileList: TStringList);
var
   DirName, FileName: string;
begin
   FileList.Clear;
   P := ExtractFileName_A(P, DirName);
   P := ExtractFileName_A(P, FileName);
   if FileName = '' then
      FileList.Add(DirName)
   else
     repeat
       if (FileName[1] <> '\') and ((Length(FileName) <= 3) or
          (FileName[2] <> ':') or (FileName[3] <> '\')) then
           FileName := CheckPath(DirName,True) + FileName;
       FileList.Add(FileName);
       P := ExtractFileName_A(P, FileName);
     until FileName = '';
end;

{------------------------------------------------------------------------------}
function FindLastFileName(FName: string): string;
var
   DirName, FileName: string;
   Buf,P: PChar;

begin
   Result := '';
   if (FName <> '') then
   begin
      Buf := StrAlloc(8192);
      try
         P := Buf;
         StrPCopy(P, FName);
         P := ExtractFileName_B(P, DirName);
         if DirName[Length(DirName)] = '\' then SetLength(DirName, Length(DirName)-1);
         P := ExtractFileName_B(P, FileName);
         if FileName = '' then
            Result := DirName
         else
         repeat
            if (FileName[1] <> '\') and ((Length(FileName) <= 3) or
               (FileName[2] <> ':') or (FileName[3] <> '\')) then
               FileName := CheckPath(DirName,True) + FileName;

            Result := FileName;
            P := ExtractFileName_B(P, FileName);
         until FileName = '';
      finally
         StrDispose(Buf);
      end;
   end;
end;

{------------------------------------------------------------------------------}
{ Explorer hook. Centers the dialog on the screen in response to
  the WM_INITDIALOG message also distributes events}
{$IFDEF WIN32}
function ExplorerHook(Wnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UINT;stdcall;
{$ELSE}
function ExplorerHook(Wnd: HWnd; Msg, WParam: Word; LParam: Longint): Word; export;
{$ENDIF}
const
   BufSize = 8192;
var
   Parent: HWnd;
   ofn : ^TOpenFileName;
   Len: Integer;
   FName: String;
   aResult: Boolean;
   Buf: PChar;
   i: integer;

begin
   Result := 0;
   try
      Parent := GetParent(Wnd);
      case Msg of
        WM_INITDIALOG:
        begin
           if HookCtl3D then
           begin
              Subclass3DDlg(Wnd, CTL3D_ALL);
              SetAutoSubClass(True);
           end;
           {$IFDEF WIN32}
           if not NewStyleControls then
           {$ENDIF}
           CenterWindow(Wnd);

           ofn := Pointer(LParam);    {remember object pointer }
           obj := Pointer(ofn^.lCustData);