开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
MMCstDlg.pas
资源名称：qqdelphiprog.rar　[点击查看]
上传用户：hylc_2004
上传日期：2014-01-23
资源大小：46800k
文件大小：57k
源码类别：

Delphi控件源码

开发平台：

Delphi

MMCstDlg.pas：源码内容
  1. {========================================================================}
  2. {=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
  3. {========================================================================}
  4. {=                          All Rights Reserved                         =}
  5. {========================================================================}
  6. {=  D 01099 Dresden             = Fax.: +49(0)351-8037944               =}
  7. {=  Loewenstr.7a                = info@swiftsoft.de                     =}
  8. {========================================================================}
  9. {=  Actual versions on http://www.swiftsoft.de/index.html               =}
  10. {========================================================================}
  11. {=  This code is for reference purposes only and may not be copied or   =}
  12. {=  distributed in any format electronic or otherwise except one copy   =}
  13. {=  for backup purposes.                                                =}
  14. {=                                                                      =}
  15. {=  No Delphi Component Kit or Component individually or in a collection=}
  16. {=  subclassed or otherwise from the code in this unit, or associated   =}
  17. {=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
  18. {=  without express permission from SwiftSoft.                          =}
  19. {=                                                                      =}
  20. {=  For more licence informations please refer to the associated        =}
  21. {=  HelpFile.                                                           =}
  22. {========================================================================}
  23. {=  $Date: 20.10.98 - 16:34:15 $                                        =}
  24. {========================================================================}
  25. unit MMCstDlg;
  27. {$I COMPILER.INC}
  29. interface
  31. uses
  32. {$IFDEF WIN32}
  33.   Windows,
  34. {$ELSE}
  35.   WinProcs,
  36.   WinTypes,
  37. {$ENDIF}
  38.   Messages,
  39.   SysUtils,
  40.   Classes,
  41.   Graphics,
  42.   Controls,
  43.   Forms,
  44.   Dialogs,
  45.   CommDlg,
  46.   ExtCtrls,
  47.   MMObj,
  48.   MMWave,
  49.   MMWavOut,
  50.   MMPCMSup,
  51.   MMWaveIO,
  52.   MMRiff,
  53.   MMMulDiv,
  54.   MMUtils,
  55.   MMString,
  56.   MMACMDlg,
  57.   MMADCvt,
  58.   MMDIB;
  60. type
  61.   {$IFNDEF WIN32}
  62.   POpenFilenameA = ^TOpenFilenameA;
  63.   TOpenFilenameA = record
  64.     lStructSize: Longint;
  65.     hWndOwner: HWnd;
  66.     hInstance: THandle;
  67.     lpstrFilter: PChar;
  68.     lpstrCustomFilter: PChar;
  69.     nMaxCustFilter: Longint;
  70.     nFilterIndex: Longint;
  71.     lpstrFile: PChar;
  72.     nMaxFile: Longint;
  73.     lpstrFileTitle: PChar;
  74.     nMaxFileTitle: Longint;
  75.     lpstrInitialDir: PChar;
  76.     lpstrTitle: PChar;
  77.     Flags: Longint;
  78.     nFileOffset: Word;
  79.     nFileExtension: Word;
  80.     lpstrDefExt: PChar;
  81.     lCustData: Longint;
  82.     lpfnHook: function (Wnd: HWnd; Msg, wParam: Word; lParam: Longint): Word;
  83.     lpTemplateName: PChar;
  84.   end;
  85.   {$ENDIF}
  87.   TSelChangeEvent= procedure(Sender : TObject; Filename: String) of Object;
  88.   TFileOKEvent   = procedure(Sender : TObject; Filename: String; var IsOk: Boolean) of Object;
  89.   TCommandEvent  = procedure(Sender : TObject; Wnd,Parent,cmd: Integer) of Object;
  91.   {-- TMMCustomOpenDialog -----------------------------------------------------}
  92.   TMMCustomOpenDialog = class(TMMCommonDialog)
  93.   private
  94.     FHwnd         : Hwnd;            { Window handle for hook }
  95.     FTemplateName : String;          { Dialog template name }
  96.     FHistoryList  : TStrings;
  97.     FOptions      : TOpenOptions;
  98.     FFilter       : String;
  99.     FFilterIndex  : Integer;
  100.     FInitialDir   : String;
  101.     FTitle        : String;
  102.     FDefaultExt   : String;
  103.     FFileName     : TFileName;
  104.     FFiles        : TStrings;
  105.     FTempFiles    : TStringList;
  106.     {$IFNDEF DELPHI4}
  107.     FSizing       : Boolean;
  108.     {$ENDIF}
  110.     { Custom event handlers }
  111.     FOnCreate     : TNotifyEvent;
  112.     FOnDestroy    : TNotifyEvent;
  113.     FOnFileOK     : TFileOkEvent;
  114.     FOnSelChange  : TSelChangeEvent;
  115.     FOnCommand    : TCommandEvent;
  117.     procedure SetHistoryList(Value: TStrings);
  118.     procedure SetInitialDir(const Value: string);
  120.   protected
  121.     function  DoExecute(Func: Pointer): Bool;
  123.     procedure DoCreate; dynamic;
  124.     procedure DoDestroy; dynamic;
  125.     procedure DoFileOK(FName: String; var IsOk: Boolean);dynamic;
  126.     procedure DoSelChanged(FName: String);dynamic;
  127.     procedure DoCommand(Wnd,Parent: Hwnd; cmd: Integer); dynamic;
  129.     property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
  130.     property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
  131.     property OnFileOK: TFileOKEvent read FOnFileOK write FOnFileOK;
  132.     property OnSelChange: TSelChangeEvent read FOnSelChange write FOnSelChange;
  133.     property OnCommand: TCommandEvent read FOnCommand write FOnCommand;
  135.     property DefaultExt: string read FDefaultExt write FDefaultExt;
  136.     property FileName: TFileName read FFileName write FFileName;
  137.     property Filter: String read FFilter write FFilter;
  138.     property FilterIndex: Integer read FFilterIndex write FFilterIndex default 1;
  139.     property HistoryList: TStrings read FHistoryList write SetHistoryList;
  140.     property InitialDir: string read FInitialDir write SetInitialDir;
  141.     property Options: TOpenOptions read FOptions write FOptions default [];
  142.     property Title: string read FTitle write FTitle;
  143.     property TemplateName: string read FTemplateName write FTemplateName;
  144.     {$IFNDEF DELPHI4}
  145.     property EnableSizing: Boolean read FSizing write FSizing default False;
  146.     {$ENDIF}
  147.   public
  148.     constructor Create(AOwner: TComponent); override;
  149.     destructor Destroy; override;
  151.     function  Execute: Boolean; override;
  153.     property  Files: TStrings read FFiles;
  154.     property  Wnd: HWnd read FHWnd write FHWnd;
  155.   end;
  157.   {-- TMMWaveOpenDialog -------------------------------------------------------}
  158.   TMMWaveOpenDialog = class(TMMCustomOpenDialog)
  159.   private
  160.     FWaveFile    : TMMWaveFile;
  161.     FADPCMConvert: TMMADPCMConverter;
  162.     FWaveOut     : TMMWaveOut;
  163.     FDeviceID    : integer;
  164.     FTimer       : TTimer;
  165.     FData        : Pointer;
  166.     FForeColor   : TColor;
  167.     FColor       : TColor;
  168.     FLocatorColor: TColor;
  169.     FPreview     : Boolean;
  170.     FAutoPlay    : Boolean;
  171.     FUpdating    : Boolean;
  172.     FOldPos      : Longint;
  173.     FScopeWnd    : HWND;
  174.     FScopeDefProc: TFarProc;
  175.     FScopeOldProc: Longint;
  176.     FDIBWnd      : HWND;
  177.     FDIBDefProc  : TFarProc;
  178.     FDIBOldProc  : Longint;
  180.     procedure WaveOutStart(Sender: TObject);
  181.     procedure WaveOutStop(Sender: TObject);
  182.     procedure TimerExpired(Sender: TObject);
  183.     procedure UpdateWave;
  184.     procedure UpdatePlayParams;
  185.     procedure DrawLocator(var OldPos: Longint; NewPos: Longint);
  186.     procedure CreatePCMData(DC: HDC; aRect: TRect);
  187.     procedure DrawPCMData(DC: HDC; aRect: TRect);
  188.     procedure DrawDISP(DC: HDC; aRect: TRect);
  189.     procedure ScopeWndHookProc(var Message: TMessage);
  190.     procedure DIBWndHookProc(var Message: TMessage);
  192.   protected
  193.     procedure DoCreate;override;
  194.     procedure DoDestroy;override;
  195.     procedure DoFileOK(FName: String; var IsOk: Boolean);override;
  196.     procedure DoSelChanged(FName: String);override;
  197.     procedure DoCommand(Wnd,Parent: Hwnd; cmd: Integer);override;
  199.   public
  200.     constructor Create(AOwner: TComponent); override;
  201.     destructor  Destroy; override;
  203.   published
  204.     property OnFileOK: TFileOKEvent read FOnFileOK write FOnFileOK;
  206.     property FileName;
  207.     property Filter;
  208.     property FilterIndex;
  209.     property InitialDir;
  210.     property Title;
  212.     {$IFNDEF DELPHI4}
  213.     property EnableSizing;
  214.     {$ENDIF}
  215.     property Options;
  216.     property Color: TColor read FColor write FColor default clBlack;
  217.     property ForeColor: TColor read FForeColor write FForeColor default clLime;
  218.     property LocatorColor: TColor read FLocatorColor write FLocatorColor default clRed;
  219.     property Preview: Boolean read FPreview write FPreview default False;
  220.     property AutoPlay: Boolean read FAutoPlay write FAutoPlay default False;
  221.     property DeviceID: integer read FDeviceID write FDeviceID default -1;
  222.   end;
  224.   {-- TMMWaveSaveDialog -------------------------------------------------------}
  225.   TMMWaveSaveDialog = class(TMMWaveOpenDialog)
  226.   public
  227.     constructor Create(AOwner: TComponent); override;
  228.     function Execute: Boolean; override;
  229.   end;
  231.   {-- TMMPictureOpenDialog ----------------------------------------------------}
  232.   TMMPictureOpenDialog = class(TMMCustomOpenDialog)
  233.   private
  234.     FBitmap      : TBitmap;
  235.     FPicture     : TPicture;
  236.     FPreview     : Boolean;
  237.     FColor       : TColor;
  238.     FHookWnd     : HWND;
  239.     FDefProc     : TFarProc;
  240.     FOldProc     : Longint;
  241.     FLastFile    : string;
  243.     procedure UpdatePicture;
  244.     procedure DrawPicture(DC: HDC; aRect: TRect);
  245.     procedure WndHookProc(var Message: TMessage);
  247.   protected
  248.     procedure DoCreate;override;
  249.     procedure DoDestroy;override;
  250.     procedure DoFileOK(FName: String; var IsOk: Boolean);override;
  251.     procedure DoSelChanged(FName: String);override;
  252.     procedure DoCommand(Wnd,Parent: Hwnd; cmd: Integer);override;
  254.   public
  255.     constructor Create(AOwner: TComponent); override;
  256.     destructor  Destroy; override;
  258.   published
  259.     property OnFileOK: TFileOKEvent read FOnFileOK write FOnFileOK;
  261.     property DefaultExt;
  262.     property FileName;
  263.     property Filter;
  264.     property FilterIndex default 1;
  265.     property InitialDir;
  266.     property Title;
  267.     property Options;
  268.     property Color: TColor read FColor write FColor default clWindow;
  269.     property Preview: Boolean read FPreview write FPreview default False;
  270.   end;
  272.   {-- TMMPictureSaveDialog ----------------------------------------------------}
  273.   TMMPictureSaveDialog = class(TMMPictureOpenDialog)
  274.   public
  275.     constructor Create(AOwner: TComponent); override;
  276.     function Execute: Boolean; override;
  277.   end;
  279. implementation
  281. {$IFDEF WIN32}
  282.    {$R MMCSTDLG.D32}
  283. {$ELSE}
  284.    {$R MMCSTDLG.D16}
  285. {$ENDIF}
  287. type
  288.    TDisplayRec = packed record
  289.       LeftMin : SmallInt;
  290.       LeftMax : SmallInt;
  291.       RightMin: SmallInt;
  292.       RightMax: SmallInt;
  293.    end;
  294.    PDisplayData = ^TDisplayData;
  295.    TDisplayData = array[0..0] of TDisplayRec;
  297. const
  298.      lst1 = $0460; { FileListBox ID  }
  299.      lst2 = $0461; { DirListBox ID   }
  300.      cmb2 = $0471; { DriveListBox ID }
  301.      BT_PLAY    = 1000;
  302.      CB_PREVIEW = 1001;
  303.      CB_AUTOPLAY= 1002;
  304.      LT_FORMAT  = 1003;
  305.      ST_SCOPE   = 1004;
  306.      ST_DIB     = 1005;
  308.      ST_PICTURE = 1000;   { Preview window for Picture Dialog }
  310.      Obj: TMMCustomOpenDialog = nil;
  312. const
  313.   HookCtl3D: Boolean = False;
  314.   DialogTitle: PChar = nil;
  316. var
  317.   CD_LBSelCh: Word;
  318.   CD_ShareVi: Word;
  319.   CD_FileOK : Word;
  321. procedure InitDialogs;
  322. begin
  323.    CD_LBSelCh := RegisterWindowMessage(LBSelChString);
  324.    CD_ShareVi := RegisterWindowMessage(ShareViString);
  325.    CD_FileOK  := RegisterWindowMessage(FileOKString);
  326. end;
  328. {-- Center the given window on the screen -------------------------------------}
  329. procedure CenterWindow(Wnd: HWnd);
  330. var
  331.   Rect: TRect;
  332. begin
  333.    GetWindowRect(Wnd, Rect);
  334.    SetWindowPos(Wnd, 0,
  335.          (GetSystemMetrics(SM_CXSCREEN) - Rect.Right + Rect.Left) div 2,
  336.          (GetSystemMetrics(SM_CYSCREEN) - Rect.Bottom + Rect.Top) div 3,
  337.          0, 0, SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOZORDER);
  338. end;
  340. {$IFNDEF WIN32}
  341. function TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool;
  342. type
  343.   TDialogFunc = function(var DialogData): Bool;
  344. var
  345.   ActiveWindow: HWnd;
  346.   WindowList: Pointer;
  347. begin
  348.   ActiveWindow := GetActiveWindow;
  349.   WindowList := DisableTaskWindows(0);
  350.   try
  351.     Result := TDialogFunc(DialogFunc)(DialogData);
  352.   finally
  353.     EnableTaskWindows(WindowList);
  354.     SetActiveWindow(ActiveWindow);
  355.   end;
  356. end;
  357. {$ENDIF}
  359. {------------------------------------------------------------------------------}
  360. function ExtractFileName_A(P: PChar; var S: String): PChar;
  361. var
  362.    Separator: Char;
  363. begin
  364.    Separator := #0;
  365.    Result := P;
  366.    while (Result[0] <> #0) and (Result[0] <> Separator) do Inc(Result);
  367.    SetString(S, P, Result - P);
  368.    if Result[0] = Separator then Inc(Result);
  369. end;
  371. {------------------------------------------------------------------------------}
  372. function ExtractFileName_B(P: PChar; var S: string): PChar;
  373. var
  374.    Separator: Char;
  375. begin
  376.    Separator := '"';
  377.    Result := P;
  378.    while (Result[0] <> #0) and (Result[0] <> Separator) do Inc(Result);
  379.    SetString(S, P, Result - P);
  380.    while (Result[0] = Separator) or (Result[0] = ' ') do inc(Result);
  381. end;
  383. {------------------------------------------------------------------------------}
  384. procedure ExtractFileNames(P: PChar; FileList: TStringList);
  385. var
  386.    DirName, FileName: string;
  387. begin
  388.    FileList.Clear;
  389.    P := ExtractFileName_A(P, DirName);
  390.    P := ExtractFileName_A(P, FileName);
  391.    if FileName = '' then
  392.       FileList.Add(DirName)
  393.    else
  394.      repeat
  395.        if (FileName[1] <> '') and ((Length(FileName) <= 3) or
  396.           (FileName[2] <> ':') or (FileName[3] <> '')) then
  397.            FileName := CheckPath(DirName,True) + FileName;
  398.        FileList.Add(FileName);
  399.        P := ExtractFileName_A(P, FileName);
  400.      until FileName = '';
  401. end;
  403. {------------------------------------------------------------------------------}
  404. function FindLastFileName(FName: string): string;
  405. var
  406.    DirName, FileName: string;
  407.    Buf,P: PChar;
  409. begin
  410.    Result := '';
  411.    if (FName <> '') then
  412.    begin
  413.       Buf := StrAlloc(8192);
  414.       try
  415.          P := Buf;
  416.          StrPCopy(P, FName);
  417.          P := ExtractFileName_B(P, DirName);
  418.          if DirName[Length(DirName)] = '' then SetLength(DirName, Length(DirName)-1);
  419.          P := ExtractFileName_B(P, FileName);
  420.          if FileName = '' then
  421.             Result := DirName
  422.          else
  423.          repeat
  424.             if (FileName[1] <> '') and ((Length(FileName) <= 3) or
  425.                (FileName[2] <> ':') or (FileName[3] <> '')) then
  426.                FileName := CheckPath(DirName,True) + FileName;
  428.             Result := FileName;
  429.             P := ExtractFileName_B(P, FileName);
  430.          until FileName = '';
  431.       finally
  432.          StrDispose(Buf);
  433.       end;
  434.    end;
  435. end;
  437. {------------------------------------------------------------------------------}
  438. { Explorer hook. Centers the dialog on the screen in response to
  439.   the WM_INITDIALOG message also distributes events}
  440. {$IFDEF WIN32}
  441. function ExplorerHook(Wnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UINT;stdcall;
  442. {$ELSE}
  443. function ExplorerHook(Wnd: HWnd; Msg, WParam: Word; LParam: Longint): Word; export;
  444. {$ENDIF}
  445. const
  446.    BufSize = 8192;
  447. var
  448.    Parent: HWnd;
  449.    ofn : ^TOpenFileName;
  450.    Len: Integer;
  451.    FName: String;
  452.    aResult: Boolean;
  453.    Buf: PChar;
  454.    i: integer;
  456. begin
  457.    Result := 0;
  458.    try
  459.       Parent := GetParent(Wnd);
  460.       case Msg of
  461.         WM_INITDIALOG:
  462.         begin
  463.            if HookCtl3D then
  464.            begin
  465.               Subclass3DDlg(Wnd, CTL3D_ALL);
  466.               SetAutoSubClass(True);
  467.            end;
  468.            {$IFDEF WIN32}
  469.            if not NewStyleControls then
  470.            {$ENDIF}
  471.            CenterWindow(Wnd);
  473.            ofn := Pointer(LParam);    {remember object pointer }
  474.            obj := Pointer(ofn^.lCustData);
  475.            obj.FHWnd := Wnd;
  476.            obj.DoCreate;
  477.            Result := 1;
  478.         end;
  480.         WM_Destroy:
  481.         begin
  482.            {clean up }
  483.            if assigned(obj) then
  484.            begin
  485.               obj.DoDestroy;
  486.               obj.FHWND := 0;
  487.               obj := nil;
  488.            end;
  489.            if HookCtl3D then SetAutoSubClass(False);
  490.         end;
  492.         WM_CTLCOLOR:
  493.            if HookCtl3D and (@Ctl3DCtlColorEx <> nil) then
  494.             Result := Ctl3DCtlColorEx(Wnd, Msg, WParam, LParam);
  496.         {$IFDEF WIN32}
  497.         { route notifications }
  498.         WM_NOTIFY:
  499.         begin
  500.            { Center after INIT if requested }
  501.            if (POFNotify(LParam)^.hdr.code = CDN_INITDONE) then
  502.               CenterWindow(GetWindowLong(Wnd, GWL_HWNDPARENT));
  504.            if assigned(obj) then
  505.            begin
  506.               { Dispatch each event }
  507.               if (POFNotify(LParam)^.hdr.code = CDN_FILEOK) then
  508.               begin
  509.                  aResult := True;
  510.                  if (ofAllowMultiSelect in obj.FOptions) then
  511.                  begin
  512.                     ExtractFileNames(POFNotify(LParam).lpOFN.lpstrFile, obj.FTempFiles);
  513.                     for i := 0 to obj.FTempFiles.Count-1 do
  514.                     begin
  515.                        obj.DoFileOK(obj.FTempFiles[i],aResult);
  516.                        if not aResult then break;
  517.                     end
  518.                  end
  519.                  else
  520.                  begin
  521.                     SetString(FName, POFNotify(LParam).lpOFN.lpstrFile,
  522.                               StrLen(POFNotify(LParam).lpOFN.lpstrFile));
  523.                               obj.DoFileOK(FName,aResult);
  524.                  end;
  525.                  Result := ord(not aResult);
  526.                  SetWindowLong(Wnd, DWL_MSGRESULT, ord(not aResult));
  527.               end;
  529.               if (POFNotify(LParam)^.hdr.code = CDN_SELCHANGE) then
  530.               begin
  531.                  Buf := StrAlloc(BufSize);
  532.                  try
  533.                     Len := SendMessage(GetParent(Wnd),CDM_GETFILEPATH,BufSize,LongInt(Buf));
  534.                     SetString(FName,Buf,Len-1);
  535.                     obj.DoSelChanged(FName);
  536.                  finally
  537.                     StrDispose(Buf);
  538.                  end;
  539.               end;
  540.            end;
  541.         end;
  542.         {$ENDIF}
  544.         { dispatch WM_COMMAND }
  545.         WM_COMMAND:
  546.            if assigned(obj) then obj.DoCommand(Wnd,Parent,LOWORD(WParam));
  548.         {$IFNDEF WIN32}
  549.         WM_NCACTIVATE,
  550.         WM_NCPAINT,
  551.         WM_SETTEXT:
  552.            if HookCtl3D and (@Ctl3DDlgFramePaint <> nil) then
  553.            begin
  554.               { The following fixes a Ctrl3D bug under Windows NT }
  555.               if (GetWinFlags and $4000 <> 0) and (Msg = WM_SETTEXT) and
  556.                  (DialogTitle <> nil) then
  557.                  LParam := Longint(DialogTitle);
  558.               SetWindowLong(Wnd, DWL_MSGRESULT, Ctl3DDlgFramePaint(Wnd, Msg,
  559.                             WParam, LParam));
  560.               Result := 1;
  561.            end;
  562.         {$ENDIF}
  563.         else
  564.         {$IFDEF WIN32}
  565.         if not NewStyleControls then
  566.         {$ENDIF}
  567.         begin
  568.            if (Msg = CD_FILEOK) then
  569.            begin
  570.               if assigned(obj) then
  571.               begin
  572.                  aResult := True;
  573.                  if (ofAllowMultiSelect in obj.FOptions) then
  574.                  begin
  575.                     ExtractFileNames(POpenFileNameA(LParam)^.lpstrFile, obj.FTempFiles);
  576.                     for i := 0 to obj.FTempFiles.Count-1 do
  577.                     begin
  578.                        obj.DoFileOK(obj.FTempFiles[i],aResult);
  579.                        if not aResult then break;
  580.                     end;
  581.                  end
  582.                  else
  583.                  begin
  584.                     FName := StrPas(POpenFileNameA(LParam)^.lpstrFile);
  585.                     obj.DoFileOK(FName,aResult);
  586.                  end;
  587.                  Result := ord(not aResult);
  588.                  SetWindowLong(Wnd, DWL_MSGRESULT, ord(not aResult));
  589.               end;
  590.            end;
  591.            if (Msg = CD_LBSelCh) then
  592.            begin
  593.               if (wParam = lst1) and assigned(obj) then
  594.               begin
  595.                  Buf := StrAlloc(BufSize);
  596.                  try
  597.                     Len := SendDlgItemMessage(Wnd,lst1, LB_GETTEXT, LoWord(lParam), Longint(Buf));
  598.                     if (Len <> LB_Err) then
  599.                     begin
  600.                        FName := ExpandUNCFileName(StrPas(Buf));
  601.                        obj.DoSelChanged(FName);
  602.                     end;
  603.                  finally
  604.                     StrDispose(Buf);
  605.                  end;
  606.               end;
  607.            end;
  608.         end;
  609.       end;
  611.    except
  612.       Application.HandleException(nil);
  613.    end;
  614. end;
  616. {== TMMCustomOpenDialog =======================================================}
  617. constructor TMMCustomOpenDialog.Create(AOwner: TComponent);
  618. begin
  619.    inherited Create(AOwner);
  621.    FHistoryList := TStringList.Create;
  622.    FFiles       := TStringList.Create;
  623.    FTempFiles   := TStringList.Create;
  624.    FFilterIndex := 1;
  625.    {$IFNDEF DELPHI4}
  626.    FSizing      := False;
  627.    {$ENDIF}
  629.    ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
  630.    if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
  631. end;
  633. {-- TMMCustomOpenDialog -------------------------------------------------------}
  634. destructor TMMCustomOpenDialog.Destroy;
  635. begin
  636.    FFiles.Free;
  637.    FTempFiles.Free;
  638.    FHistoryList.Free;
  640.    inherited Destroy;
  641. end;
  643. {-- TMMCustomOpenDialog -------------------------------------------------------}
  644. function TMMCustomOpenDialog.DoExecute(Func: Pointer): Bool;
  645. const
  646.     {$IFNDEF DELPHI4}
  647.     OFN_ENABLESIZING    = $00800000;
  648.     {$ENDIF}
  649.     {$IFNDEF DELPHI6}
  650.     OFN_DONTADDTORECENT = $02000000;
  651.     OFN_FORCESHOWHIDDEN = $10000000;
  652.     {$ENDIF}
  654.     {$IFDEF WIN32}
  655.     {$IFDEF DELPHI6}
  656.     MultiSelectBufferSize = High(Word) - 16;
  657.     {$ELSE}
  658.     MultiSelectBufferSize = 8192;
  659.     {$ENDIF}
  660.     OpenOptions: array [TOpenOption] of DWORD = (
  661.     OFN_READONLY, OFN_OVERWRITEPROMPT, OFN_HIDEREADONLY,
  662.     OFN_NOCHANGEDIR, OFN_SHOWHELP, OFN_NOVALIDATE, OFN_ALLOWMULTISELECT,
  663.     OFN_EXTENSIONDIFFERENT, OFN_PATHMUSTEXIST, OFN_FILEMUSTEXIST,
  664.     OFN_CREATEPROMPT, OFN_SHAREAWARE, OFN_NOREADONLYRETURN,
  665.     OFN_NOTESTFILECREATE, OFN_NONETWORKBUTTON, OFN_NOLONGNAMES,
  666.     OFN_EXPLORER, OFN_NODEREFERENCELINKS
  667.     {$IFDEF DELPHI4}
  668.     ,OFN_ENABLEINCLUDENOTIFY,
  669.     OFN_ENABLESIZING
  670.     {$ENDIF}
  671.     {$IFDEF DELPHI6}
  672.     ,OFN_DONTADDTORECENT,
  673.     OFN_FORCESHOWHIDDEN
  674.     {$ENDIF}
  675.     );
  676.     {$ELSE}
  677.     MultiSelectBufferSize = 1000;
  678.     OpenOptions: array [TOpenOption] of Longint = (
  679.     OFN_READONLY, OFN_OVERWRITEPROMPT, OFN_HIDEREADONLY,
  680.     OFN_NOCHANGEDIR, OFN_SHOWHELP, OFN_NOVALIDATE, OFN_ALLOWMULTISELECT,
  681.     OFN_EXTENSIONDIFFERENT, OFN_PATHMUSTEXIST, OFN_FILEMUSTEXIST,
  682.     OFN_CREATEPROMPT, OFN_SHAREAWARE, OFN_NOREADONLYRETURN,
  683.     OFN_NOTEXTFILECREATE);
  684.     {$ENDIF}
  686. var
  687.   OpenFilename: TOpenFilename;
  688.   Option: TOpenOption;
  689.   CDefaultExt: array[0..3] of Char;
  690.   CInitialDir: array[0..79] of Char;
  691.   CTitle: array[0..79] of Char;
  692.   CFilter: array[0..1023] of Char;
  693.   CTemplate: array[0..257] of Char;
  694.   S: string;
  696.   function StrFilterCopy(P: PChar; const S: string): PChar;
  697.   begin
  698.     Result := nil;
  699.     if S <> '' then
  700.     begin
  701.       {$IFDEF WIN32}
  702.       { Because StrPCopy truncates 256 characters }
  703.       Result := StrCopy(P,PChar(S));
  704.       {$ELSE}
  705.       Result := StrPCopy(P, S);
  706.       {$ENDIF}
  708.       while P^ <> #0 do
  709.       begin
  710.         if P^ = '|' then P^ := #0;
  711.         Inc(P);
  712.       end;
  713.       Inc(P);
  714.       P^ := #0;
  715.     end;
  716.   end;
  718. begin
  719.    FFiles.Clear;
  720.    FillChar(OpenFileName, SizeOf(OpenFileName), 0);
  721.    with OpenFilename do
  722.    try
  723.      lStructSize := SizeOf(TOpenFilename);
  724.      hInstance := {$IFDEF DELPHI3}SysInit.HInstance{$ELSE}System.HInstance{$ENDIF};
  725.      lpstrFilter := StrFilterCopy(CFilter, FFilter);
  726.      nFilterIndex := FFilterIndex;
  727.      if ofAllowMultiSelect in FOptions then
  728.         nMaxFile := MultiSelectBufferSize
  729.      else
  730.         {$IFDEF WIN32}
  731.         nMaxFile := MAX_PATH;
  732.         {$ELSE}
  733.         nMaxFile := sizeof(TFileName);
  734.         {$ENDIF}
  735.      GetMem(lpstrFile, nMaxFile + 2);
  736.      FillChar(lpstrFile^, nMaxFile + 2, 0);
  737.      StrPCopy(lpstrFile, FFileName);
  738.      lpstrInitialDir := StrPLCopy(CInitialDir, FInitialDir,
  739.                                   SizeOf(CInitialDir) - 1);
  740.      lpstrTitle := StrPLCopy(CTitle, FTitle, SizeOf(CTitle) - 1);
  741.      if Length(FTitle) > 0 then DialogTitle := lpstrTitle;
  742.      { Always enable hook }
  743.      Flags := OFN_ENABLEHOOK;
  744.      for Option := Low(Option) to High(Option) do
  745.      if Option in FOptions then
  746.         Flags := Flags or OpenOptions[Option];
  747.      {$IFDEF WIN32}
  748.      if NewStyleControls then
  749.      begin
  750.         Flags := Flags or OFN_EXPLORER;
  751.         {$IFNDEF DELPHI4}
  752.         if FSizing then Flags := Flags or OFN_ENABLESIZING;
  753.         {$ENDIF}
  754.      end
  755.      else
  756.         Flags := Flags and not OFN_EXPLORER;
  757.      {$ENDIF}
  758.      lpstrDefExt := StrPCopy(CDefaultExt, FDefaultExt);
  759.      { add custom callback }
  760.      lpfnHook := ExplorerHook;
  762. {$IFDEF WIN32}
  763.      if NewStyleControls then
  764.         HookCtl3D := False
  765.      else
  766. {$ENDIF}
  767.         HookCtl3D := Ctl3D;
  769.      { add custom resource  }
  770.      if FTemplateName <> '' then
  771.      begin
  772.         lpTemplateName:= StrPLCopy(CTemplate, FTemplateName, SizeOf(CTemplate)-1);
  773.         Flags := Flags or OFN_ENABLETEMPLATE;
  774. {$IFDEF WIN32}
  775.         if not NewStyleControls then
  776.            StrLCat(lpTemplateName,'OLD',SizeOf(CTemplate)-1);
  777. {$ENDIF}
  778.      end;
  780.      {$IFDEF WIN32}
  781.      {$IFDEF TRIAL}
  782.      {$DEFINE _HACK2}
  783.      {$I MMHACK.INC}
  784.      {$ENDIF}
  785.      {$ENDIF}
  787.      { allow callback to find object }
  788.      lCustData:=LongInt(Self);
  789.      hWndOwner := Application.Handle;
  790.      Result := TaskModalDialog(Func, OpenFileName);
  791.      DialogTitle := nil;
  792.      if Result then
  793.      begin
  794.         if ofAllowMultiSelect in FOptions then
  795.         begin
  796.            ExtractFileNames(lpstrFile,TStringList(FFiles));
  797.            FFileName := FFiles[0];
  798.         end
  799.         else
  800.         begin
  801.            ExtractFileName_A(lpstrFile, S);
  802.            FFileName := S;
  803.            FFiles.Add(FFileName);
  804.         end;
  805.         if (Flags and OFN_EXTENSIONDIFFERENT) <> 0 then
  806.             Include(FOptions, ofExtensionDifferent)
  807.         else
  808.             Exclude(FOptions, ofExtensionDifferent);
  809.         if (Flags and OFN_READONLY) <> 0 then
  810.             Include(FOptions, ofReadOnly)
  811.         else
  812.             Exclude(FOptions, ofReadOnly);
  813.         FFilterIndex := nFilterIndex;
  814.      end;
  816.    finally
  817.      if lpstrFile <> nil then FreeMem(lpstrFile, nMaxFile + 2);
  818.    end;
  819. end;
  821. {-- TMMCustomOpenDialog -------------------------------------------------------}
  822. procedure TMMCustomOpenDialog.SetHistoryList(Value: TStrings);
  823. begin
  824.    {$IFDEF WIN32}
  825.    {$IFDEF TRIAL}
  826.    {$DEFINE _HACK1}
  827.    {$I MMHACK.INC}
  828.    {$ENDIF}
  829.    {$ENDIF}
  831.    FHistoryList.Assign(Value);
  832. end;
  834. {-- TMMCustomOpenDialog -------------------------------------------------------}
  835. procedure TMMCustomOpenDialog.SetInitialDir(const Value: string);
  836. var
  837.   L: Integer;
  838. begin
  839.    L := Length(Value);
  840.    if (L > 1) and (Value[L] = '') and (Value[L - 1] <> ':') then Dec(L);
  841.    FInitialDir := Copy(Value, 1, L);
  843.    {$IFDEF WIN32}
  844.    {$IFDEF TRIAL}
  845.    {$DEFINE _HACK3}
  846.    {$I MMHACK.INC}
  847.    {$ENDIF}
  848.    {$ENDIF}
  849. end;
  851. {-- TMMCustomOpenDialog -------------------------------------------------------}
  852. function TMMCustomOpenDialog.Execute: Boolean;
  853. begin
  854.    Result := DoExecute(@GetOpenFileName);
  855. end;
  857. {-- TMMCustomOpenDialog -------------------------------------------------------}
  858. procedure TMMCustomOpenDialog.DoCreate;
  859. begin
  860.    if assigned(FOnCreate) then
  861.       FOnCreate(Self);
  862. end;
  864. {-- TMMCustomOpenDialog -------------------------------------------------------}
  865. procedure TMMCustomOpenDialog.DoDestroy;
  866. begin
  867.    if assigned(FOnDestroy) then
  868.       FOnDestroy(Self);
  869. end;
  871. {-- TMMCustomOpenDialog -------------------------------------------------------}
  872. procedure TMMCustomOpenDialog.DoFileOK(FName: String; var IsOk: Boolean);
  873. begin
  874.    if assigned(FOnFileOK) then
  875.       FOnFileOK(Self,FName,IsOK);
  876. end;
  878. {-- TMMCustomOpenDialog -------------------------------------------------------}
  879. procedure TMMCustomOpenDialog.DoSelChanged(FName: String);
  880. begin
  881.    if assigned(FOnSelChange) then
  882.       FOnSelChange(Self,FName);
  883. end;
  885. {-- TMMCustomOpenDialog -------------------------------------------------------}
  886. procedure TMMCustomOpenDialog.DoCommand(Wnd,Parent: Hwnd; cmd: Integer);
  887. begin
  888.    if assigned(FOnCommand) then
  889.       FOnCommand(Self,Wnd,Parent,cmd);
  890. end;
  892. {== TMMWaveOpenDialog =========================================================}
  893. constructor TMMWaveOpenDialog.Create(AOwner: TComponent);
  894. begin
  895.    inherited Create(AOwner);
  897.    Options := Options + [ofHideReadOnly];
  898.    {$IFDEF WIN32}
  899.    Options := Options + [ofNoNetworkButton];
  900.    {$ENDIF}
  901.    FPreview := False;
  902.    FAutoPlay:=False;
  903.    FDeviceID:= -1;
  904.    FUpdating := False;
  905.    FColor := clBlack;
  906.    FForeColor := clLime;
  907.    FLocatorColor := clRed;
  908.    FData := nil;
  909.    Title := LoadResStr(IDS_WAVEOPEN);
  910.    DefaultExt:= 'wav';
  911.    Filter := LoadResStr(IDS_WAVEFILTER);
  912.    FScopeWnd := 0;
  913.    FDIBWnd := 0;
  914.    {$IFNDEF WIN32}
  915.    if _WINNT_ then
  916.       TemplateName := 'CustomWaveOpenDlgNT'
  917.    else
  918.    {$ENDIF}
  919.       TemplateName := 'CustomWaveOpenDlg';
  920. end;
  922. {-- TMMWaveOpenDialog ---------------------------------------------------------}
  923. destructor TMMWaveOpenDialog.Destroy;
  924. begin
  925.    DoDestroy;
  927.    inherited Destroy;
  928. end;
  930. {-- TMMWaveOpenDialog ---------------------------------------------------------}
  931. procedure TMMWaveOpenDialog.DoCreate;
  932. var
  933.    aRect: TRect;
  934.    aBuf: array[0..20] of Char;
  936. begin
  937.    if (FScopeWnd = 0) then
  938.    begin
  939.       FScopeWnd := GetDlgItem(Wnd,ST_SCOPE);
  940.       FScopeDefProc := Pointer(GetWindowLong(FScopeWnd,GWL_WNDPROC));
  941.       FScopeOldProc := SetWindowLong(FScopeWnd,GWL_WNDPROC,
  942.                        Longint(MakeObjectInstance(ScopeWndHookProc)));
  943.    end;
  945.    if (FDIBWnd = 0) then
  946.    begin
  947.       FDIBWnd := GetDlgItem(Wnd,ST_DIB);
  948.       FDIBDefProc := Pointer(GetWindowLong(FDIBWnd,GWL_WNDPROC));
  949.       FDIBOldProc := SetWindowLong(FDIBWnd,GWL_WNDPROC,
  950.                      Longint(MakeObjectInstance(DIBWndHookProc)));
  951.    end;
  953.    if (FData = nil) then
  954.    begin
  955.       { alloc the data buffer for the scope data }
  956.       {$IFDEF WIN32}
  957.       Windows.GetClientRect(FScopeWnd, aRect);
  958.       {$ELSE}
  959.       WinProcs.GetClientRect(FScopeWnd, aRect);
  960.       {$ENDIF}
  961.       FData := GlobalAllocPtr(GPTR, (aRect.Right-aRect.Left)*sizeOf(TDisplayRec));
  963.       { now create some components }
  964.       FWaveFile := TMMWaveFile.Create(Self);
  965.       FWaveFile.Wave.TimeFormat := tfByte;
  966.       FWaveFile.Wave.IOBufferSize := 4*32768;
  968.       FADPCMConvert := TMMADPCMConverter.Create(Self);
  969.       FADPCMConvert.Input := FWaveFile;
  971.       FWaveOut := TMMWaveOut.Create(Self);
  972.       FWaveOut.Input := FADPCMConvert;
  973.       FWaveOut.OnStart := WaveOutStart;
  974.       FWaveOut.OnStop := WaveOutStop;
  975.       FWaveOut.BufferSize := 32768;
  976.       FWaveOut.NumBuffers := 10;
  977.       FWaveOut.TimeFormat := tfByte;
  978.       if FWaveOut.NumDevs > 0 then
  979.          FWaveOut.DeviceID := FDeviceId
  980.       else EnableWindow(GetDlgItem(Wnd,CB_AutoPlay), False);
  981.       FTimer := TTimer.Create(Self);
  982.       FTimer.Enabled := False;
  983.       FTimer.Interval := 50;
  984.       FTimer.OnTimer := TimerExpired;
  985.    end;
  987.    EnableWindow(GetDlgItem(Wnd,BT_Play), False);
  988.    EnableWindow(GetDlgItem(Wnd,CB_PREVIEW), False);
  989.    SetDlgItemText(Wnd,CB_PREVIEW,StrPCopy(aBuf,LoadResStr(IDS_PREVIEW)));
  990.    SendDlgItemMessage(Wnd,CB_PREVIEW, BM_SETCHECK, Ord(FPReview), 0);
  991.    SendDlgItemMessage(Wnd,CB_AUTOPLAY, BM_SETCHECK, Ord(FAutoPlay), 0);
  993.    {$IFDEF WIN32}
  994.    if not NewStyleControls then
  995.    {$ENDIF}
  996.    begin
  997.       { TODO: hier Texte im Dialog lokalisieren !!!
  998.        oder gleich englische Resource verwenden }
  999.    end;
  1001.    inherited DoCreate;
  1002. end;
  1004. {-- TMMWaveOpenDialog ---------------------------------------------------------}
  1005. procedure TMMWaveOpenDialog.DoDestroy;
  1006. begin
  1007.    if (FData <> nil) then
  1008.    begin
  1009.       { free the data buffer }
  1010.       GlobalFreePtr(FData);
  1011.       FData := nil;
  1012.    end;
  1014.    if (FWaveOut <> nil) then
  1015.    begin
  1016.       FWaveOut.Close;
  1017.       FWaveOut.Free;
  1018.       FWaveOut := nil;
  1019.    end;
  1021.    if (FADPCMConvert <> nil) then
  1022.    begin
  1023.       FADPCMConvert.Close;
  1024.       FADPCMConvert.Free;
  1025.       FADPCMConvert := nil;
  1026.    end;
  1028.    if (FWaveFile <> nil) then
  1029.    begin
  1030.       FWaveFile.Wave.FreeWave;
  1031.       FWaveFile.Free;
  1032.       FWaveFile := nil;
  1033.    end;
  1035.    if (FTimer <> nil) then
  1036.    begin
  1037.       FTimer.Free;
  1038.       FTimer := nil;
  1039.    end;
  1041.    if (FScopeWnd <> 0) then
  1042.    begin
  1043.       FreeObjectInstance(Pointer(SetWindowLong(FScopeWnd,GWL_WNDPROC,FScopeOldProc)));
  1044.       FScopeWnd := 0;
  1045.    end;
  1047.    if (FDIBWnd <> 0) then
  1048.    begin
  1049.       FreeObjectInstance(Pointer(SetWindowLong(FDIBWnd,GWL_WNDPROC,FDIBOldProc)));
  1050.       FDIBWnd := 0;
  1051.    end;
  1053.    inherited DoDestroy;
  1054. end;
  1056. {-- TMMWaveOpenDialog ---------------------------------------------------------}
  1057. procedure TMMWaveOpenDialog.DoFileOK(FName: String; var IsOk: Boolean);
  1058. begin
  1059.    if not (Self is TMMWaveSaveDialog) then
  1060.    begin
  1061.       IsOK := wioIsWaveFile(FName, RIFF_FILE);
  1062.       if not IsOK then
  1063.          MessageDlg(LoadResStr(IDS_WAVEINVALID), mtError, [mbOK], 0)
  1064.       else
  1065.          inherited DoFileOK(FName, IsOK);
  1066.    end
  1067.    else inherited DoFileOK(FName, IsOK);
  1068. end;
  1070. {-- TMMWaveOpenDialog ---------------------------------------------------------}
  1071. procedure TMMWaveOpenDialog.DoSelChanged(FName: String);
  1072. var
  1073.    LastName: String;
  1075. begin
  1076.    if assigned(FWaveFile) then
  1077.    begin
  1078.       LastName := FindLastFileName(FName);
  1079.       if (LastName <> FWaveFile.Wave.FileName) then
  1080.       begin
  1081.          FWaveOut.Close;
  1082.          if wioIsWaveFile(LastName, RIFF_FILE) then
  1083.          begin
  1084.             FWaveFile.Wave.FileName := LastName;
  1085.             FADPCMConvert.Enabled := FADPCMConvert.CanConvert;
  1086.          end
  1087.          else
  1088.             FWaveFile.Wave.FreeWave;
  1090.          FUpdating := True;
  1091.          { make sure the item is first selected, then update }
  1092.          KillTimer(FScopeWnd,99);
  1093.          SetTimer(FScopeWnd,99,50,nil);
  1094.       end;
  1095.    end;
  1097.    inherited DoSelChanged(FName);
  1098. end;
  1100. {-- TMMWaveOpenDialog ---------------------------------------------------------}
  1101. procedure TMMWaveOpenDialog.DoCommand(Wnd,Parent: Hwnd; cmd: Integer);
  1102. begin
  1103.    if (Wnd = FHWnd) then
  1104.    begin
  1105.       if (cmd = BT_Play) and (FWaveOut.NumDevs > 0) then
  1106.       begin
  1107.          if not (wosPlay in FWaveOut.State) then
  1108.          begin
  1109.             if not FWaveFile.Wave.Empty and
  1110.                FWaveOut.QueryDevice(FWaveOut.DeviceID,FWaveOut.PWaveFormat) then
  1111.             try
  1112.                FWaveOut.Start;
  1113.             except
  1114.                { don't raise a exception here }
  1115.             end;
  1116.          end
  1117.          else FWaveOut.Close;
  1118.       end
  1119.       else if (cmd = CB_PREVIEW) then
  1120.       begin
  1121.          FPreview := SendDlgItemMessage(Wnd, CB_PREVIEW, BM_GetCheck, 0, 0)<> 0;
  1122.          if FPreview then FWaveOut.Close;
  1123.          UpdateWave;
  1124.       end
  1125.       else if (cmd = CB_AUTOPLAY) then
  1126.       begin
  1127.          FAutoPlay := SendDlgItemMessage(Wnd, CB_AUTOPLAY, BM_GetCheck, 0, 0)<> 0;
  1128.          if FAutoPlay then
  1129.          begin
  1130.             if not (wosPlay in FWaveOut.State) and
  1131.                not FWaveFile.Wave.Empty and
  1132.                FWaveOut.QueryDevice(FWaveOut.DeviceID,FWaveOut.PWaveFormat) then
  1133.             try
  1134.                FWaveOut.Start;
  1135.             except
  1136.                { don't raise a exception here }
  1137.             end;
  1138.          end
  1139.          else FWaveOut.Close;
  1140.       end;
  1141.    end;
  1143.    inherited DoCommand(Wnd,Parent,cmd);
  1144. end;
  1146. {-- TMMWaveOpenDialog ---------------------------------------------------------}
  1147. procedure TMMWaveOpenDialog.WaveOutStart(Sender: TObject);
  1148. begin
  1149.    FOldPos := -1;
  1150.    FTimer.Enabled := True;
  1151.    SetDlgItemText(Wnd,BT_PLAY,'Stop');
  1152. end;
  1154. {-- TMMWaveOpenDialog ---------------------------------------------------------}
  1155. procedure TMMWaveOpenDialog.WaveOutStop(Sender: TObject);
  1156. begin
  1157.    FTimer.Enabled := False;
  1158.    DrawLocator(FOldPos,-1);
  1159.    SetDlgItemText(Wnd,BT_PLAY,'Play');
  1160. end;
  1162. {-- TMMWaveOpenDialog ---------------------------------------------------------}
  1163. procedure TMMWaveOpenDialog.DrawLocator(var OldPos: Longint; NewPos: Longint);
  1164. Var
  1165.    OldPen: HPen;
  1166.    OldMode: integer;
  1167.    DC: HDC;
  1168.    aRect: TRect;
  1169.    X: integer;
  1171. begin
  1172.    if not FPreview or (FWaveFile.Wave.FormatTag <> 1) then exit;
  1174.    {$IFDEF WIN32}
  1175.    Windows.GetClientRect(FScopeWnd, aRect);
  1176.    {$ELSE}
  1177.    WinProcs.GetClientRect(FScopeWnd, aRect);
  1178.    {$ENDIF}
  1179.    InflateRect(aRect, -2, -2);
  1180.    DC := GetDC(FScopeWnd);
  1181.    try
  1182.       OldPen := SelectObject(DC,CreatePen(PS_SOLID,1,ColorToRGB(FLocatorColor)));
  1183.       try
  1184.           OldMode := SetROP2(DC, R2_XORPEN);
  1185.           try
  1186.               if (OldPos <> -1) then
  1187.               begin
  1188.                  { clear old locator }
  1189.                  X := MulDiv32(aRect.Right-aRect.Left,OldPos,FWaveFile.Wave.DataSize);
  1190.                  MoveToEx(DC,aRect.Left+X,aRect.Top, nil);
  1191.                  LineTo(DC,aRect.Left+X,aRect.Bottom-1);
  1192.               end;
  1194.               { draw new locator }
  1195.               if (NewPos <> -1) then
  1196.               begin
  1197.                  X := MulDiv32(aRect.Right-aRect.Left,NewPos,FWaveFile.Wave.DataSize);
  1198.                  MoveToEx(DC,aRect.Left+X,aRect.Top, nil);
  1199.                  LineTo(DC,aRect.Left+X,aRect.Bottom-1);
  1200.               end;
  1201.               OldPos := NewPos;
  1203.           finally
  1204.             SetROP2(DC, OldMode);
  1205.           end;
  1207.       finally
  1208.           DeleteObject(SelectObject(DC,OldPen));
  1209.       end;
  1211.    finally
  1212.       ReleaseDC(FScopeWnd,DC);
  1213.    end;
  1214. end;
  1216. {-- TMMWaveOpenDialog ---------------------------------------------------------}
  1217. procedure TMMWaveOpenDialog.TimerExpired(Sender: TObject);
  1218. begin
  1219.    if (wosPlay in FWaveOut.State) then
  1220.       DrawLocator(FOldPos,FWaveOut.Position);
  1221. end;
  1223. {-- TMMWaveOpenDialog ---------------------------------------------------------}
  1224. procedure TMMWaveOpenDialog.DrawDISP(DC: HDC; aRect: TRect);
  1225. var
  1226.    ParentDC: HDC;
  1227.    aBitmap: TBitmap;
  1228.    R: TRect;
  1229.    lpDisp: PDISP;
  1230.    hBM: HBITMAP;
  1231.    Clr: Longint;
  1233. begin
  1234.    with FWaveFile.Wave, aRect do
  1235.    begin
  1236.       aBitmap := TBitmap.Create;
  1237.       with aBitmap, aBitmap.Canvas do
  1238.       try
  1239.          aBitmap.Width := aRect.Right-aRect.Left;
  1240.          aBitmap.Height := aRect.Bottom-aRect.Top;
  1241.          R := Rect(0,0,aBitmap.Width,aBitmap.Height);
  1242.          { find the right background color }
  1243.          ParentDC := GetDC(Wnd);
  1244.          clr := GetPixel(ParentDC,0,0);
  1245.          ReleaseDC(Wnd, ParentDC);
  1246.          { clear background }
  1248.          Brush.Color := clr;{ clBtnFace; }
  1249.          FillRect(R);
  1251.          if (FileName <> '') then
  1252.          begin
  1253.             lpDisp := PWaveIOInfo^.lpDisp^.pHead;
  1254.             while (lpDisp <> nil) do
  1255.             begin
  1256.                if (lpDisp^.cfid = CF_DIB) then break;
  1257.                lpDisp := lpDisp^.pNext;
  1258.             end;
  1260.             if (lpDisp <> nil) then
  1261.             begin
  1262.                InflateRect(R, -2, -2);
  1263.                { Frame3D(Canvas,R,clBtnShadow,clBtnHighLight,1);
  1264.                  Frame3D(Canvas,R,clWindowFrame,cl3DLight,1); }
  1265.                DIB_Display(PDIB(lpDisp^.lpChunk),Canvas.Handle, R);
  1266.             end
  1267.             else
  1268.             begin
  1269.                InflateRect(R, -2, -2);
  1270.                hBM := LoadBitmap(HInstance, 'BMP_WAVE');
  1271.                DrawTransparentBitmap(Canvas.Handle, hBM,
  1272.                                      R.Left,R.Top,
  1273.                                      GetTransparentColor(hBM));
  1274.                DeleteObject(hBM);
  1275.             end;
  1276.          end;
  1277.          BitBlt(DC,aRect.Left,aRect.Top,aRect.Right-aRect.Left,
  1278.                 aRect.Bottom-aRect.Top,
  1279.                 aBitmap.Canvas.Handle, 0,0,SRCCOPY);
  1280.       finally
  1281.          aBitmap.Free;
  1282.       end;
  1283.    end;
  1284. end;
  1286. {-- TMMWaveOpenDialog ---------------------------------------------------------}
  1287. procedure TMMWaveOpenDialog.CreatePCMData(DC: HDC; aRect: TRect);
  1288. var
  1289.    i,aWidth,aHeight,Y1: integer;
  1290.    aResult,Bytes: Longint;
  1291.    ReadBuffer: PChar;
  1292.    Data: PDisplayData;
  1293.    Canvas: TCanvas;
  1295. begin
  1296.    InflateRect(aRect, -2, -2);
  1297.    aWidth := aRect.Right-aRect.Left;
  1298.    aHeight := aRect.Bottom-aRect.Top;
  1299.    FillChar(FData^, aWidth*sizeOf(TDisplayRec),0);
  1300.    if not FWaveFile.Wave.Empty and FPreview then
  1301.    with FWaveFile.Wave do
  1302.    begin
  1303.       Canvas := TCanvas.Create;
  1304.       with Canvas, aRect do
  1305.       try
  1306.          Handle := DC;
  1307.          Brush.Color := FColor;
  1308.          FillRect(aRect);
  1310.          Bytes := Max(DataSize div aWidth and not 3,4);
  1311.          ReadBuffer := GlobalAllocPtr(GHND, Bytes);
  1312.          try
  1313.             OpenFile;
  1314.             Position := 0;
  1315.             Data:= FData;
  1316.             Screen.Cursor := crHourGlass;
  1317.             Pen.Color := FForeColor;
  1318.             MoveTo(Left,Top+(aHeight div 2));
  1319.             i := 0;
  1320.             while (i < aWidth) do
  1321.             begin
  1322.                aResult := ReadDataBytes(ReadBuffer, Bytes);
  1323.                if aResult <= 0 then break;
  1325.                pcmFindMinMax(PWaveFormat,ReadBuffer, aResult,
  1326.                              Data^[i].LeftMin,
  1327.                              Data^[i].LeftMax,
  1328.                              Data^[i].RightMin,
  1329.                              Data^[i].RightMax);
  1331.                if (BitLength = 8) then
  1332.                begin
  1333.                   Data^[i].LeftMin := (Word(Data^[i].LeftMin) shl 8) xor $8000;
  1334.                   Data^[i].LeftMax := (Word(Data^[i].LeftMax) shl 8) xor $8000;
  1335.                   Data^[i].RightMin:= (Word(Data^[i].RightMin) shl 8) xor $8000;
  1336.                   Data^[i].RightMax:= (Word(Data^[i].RightMax) shl 8) xor $8000;
  1337.                end;
  1339.                Brush.Color := FColor;
  1340.                FillRect(Rect(Left+i,Top,Left+i+1,Bottom));
  1341.                Y1 := MulDiv32(Min(Data^[i].LeftMin,Data^[i].RightMin)+ Long($7FFF),aHeight,$FFFF);
  1342.                LineTo(Left+i, Bottom-Y1-1);
  1343.                Y1 := MulDiv32(Max(Data^[i].LeftMax,Data^[i].RightMax)+ Long($7FFF),aHeight,$FFFF);
  1344.                LineTo(Left+i, Bottom-Y1-1);
  1345.                Brush.Color := FLocatorColor;
  1346.                if (i < aWidth-1) and (DataSize > 1024*2048) then
  1347.                   FillRect(Rect(Left+i+1,Top,Left+i+2,Bottom));
  1348.                {$IFDEF WIN32}
  1349.                GDIFlush;
  1350.                {$ENDIF}
  1351.                inc(i);
  1352.             end;
  1354.             if (i < aWidth-1) then
  1355.             begin
  1356.                if (i > 0) then dec(i);
  1357.                MoveTo(Left+i, Top+(aHeight div 2));
  1358.                LineTo(Right, Top+(aHeight div 2));
  1359.             end;
  1361.          finally
  1362.             CloseFile;
  1363.             GlobalFreePtr(ReadBuffer);
  1364.             Screen.Cursor := crDefault;
  1365.          end;
  1367.       finally
  1368.          Canvas.Handle := 0;
  1369.          Canvas.Free;
  1370.       end;
  1371.    end;
  1372. end;
  1374. {-- TMMWaveOpenDialog ---------------------------------------------------------}
  1375. procedure TMMWaveOpenDialog.DrawPCMData(DC: HDC; aRect: TRect);
  1376. var
  1377.    i,Y1,aHeight: integer;
  1378.    R: TRect;
  1379.    Data: PDisplayData;
  1380.    aBitmap: TBitmap;
  1382. begin
  1383.    with FWaveFile.Wave do
  1384.    begin
  1385.       aBitmap := TBitmap.Create;
  1386.       with aBitmap.Canvas, R do
  1387.       try
  1388.          aBitmap.Width := aRect.Right-aRect.Left;
  1389.          aBitmap.Height := aRect.Bottom-aRect.Top;
  1390.          R := Rect(0,0,aBitmap.Width,aBitmap.Height);
  1391.          { clear background }
  1392.          Brush.Color := FColor;
  1393.          FillRect(R);
  1394.          Frame3D(aBitmap.Canvas,R,clBtnShadow,clBtnHighLight,1);
  1395.          Frame3D(aBitmap.Canvas,R,clWindowFrame,cl3DLight,1);
  1396.          FOldPos := -1;
  1397.          if (FileName = '') or not FPreview or
  1398.             (FormatTag <> 1) or (DataSize <= 0) then
  1399.          begin
  1400.             { only draw a horizontal line }
  1401.             Pen.Color := clGray;
  1402.             MoveTo(Left+5, Top+(Bottom-Top) div 2);
  1403.             LineTo((Right-Left)-5,Top+(Bottom-Top) div 2);
  1404.          end
  1405.          else if not FUpdating then
  1406.          begin
  1407.             Data := FData;
  1408.             Pen.Color := FForeColor;
  1410.             aHeight := Bottom-Top;
  1412.             Y1 := MulDiv32(Min(Data^[0].LeftMin,Data^[0].RightMin) + Long($7FFF),aHeight,$FFFF);
  1413.             MoveTo(Left, Top+aHeight-Y1-1);
  1414.             Y1 := MulDiv32(Max(Data^[0].LeftMax,Data^[0].RightMax) + Long($7FFF),aHeight,$FFFF);
  1415.             LineTo(Left, Top+aHeight-Y1-1);
  1416.             i := 0;
  1417.             while i < Right-Left do
  1418.             begin
  1419.                Y1 := MulDiv32(Min(Data^[i].LeftMin,Data^[i].RightMin) + Long($7FFF),aHeight,$FFFF);
  1420.                LineTo(Left+i, Bottom-Y1-1);
  1421.                Y1 := MulDiv32(Max(Data^[i].LeftMax,Data^[i].RightMax) + Long($7FFF),aHeight,$FFFF);
  1422.                LineTo(Left+i, Bottom-Y1-1);
  1423.                inc(i);
  1424.             end;
  1425.             LineTo(Left+i, Bottom-Y1-1);
  1426.          end;
  1427.          BitBlt(DC,aRect.Left,aRect.Top,aRect.Right-aRect.Left,
  1428.                 aRect.Bottom-aRect.Top,
  1429.                 aBitmap.Canvas.Handle,0,0,SRCCOPY);
  1431.       finally
  1432.          aBitmap.Free;
  1433.       end;
  1434.    end;
  1435. end;
  1437. {-- TMMWaveOpenDialog ---------------------------------------------------------}
  1438. procedure TMMWaveOpenDialog.UpdatePlayParams;
  1439. begin
  1440.    if not FWaveFile.Wave.Empty and (FWaveOut.PWaveFormat <> nil) then
  1441.    begin
  1442.       { adjust the buffersize for best results }
  1443.       case Word(FWaveOut.PWaveFormat^.nSamplesPerSec) of
  1444.            00000..15000: FWaveOut.BufferSize := 512;
  1445.            15001..24000: FWaveOut.BufferSize := 1024;
  1446.            24001..32000: FWaveOut.BufferSize := 2048;
  1447.            32001..48000: FWaveOut.BufferSize := 3072;
  1448.       end;
  1450.       case FWaveOut.PWaveFormat^.wBitsPerSample of
  1451.               1: FWaveOut.BufferSize := FWaveOut.BufferSize div 16;
  1452.            2..4: FWaveOut.BufferSize := FWaveOut.BufferSize div 8;
  1453.            5..7: FWaveOut.BufferSize := FWaveOut.BufferSize div 4;
  1454.           9..16: FWaveOut.BufferSize := FWaveOut.BufferSize * 2;
  1455.       end;
  1456.    end;
  1457. end;
  1459. {-- TMMWaveOpenDialog ---------------------------------------------------------}
  1460. procedure TMMWaveOpenDialog.UpdateWave;
  1461. Label CheckDevice;
  1462. var
  1463.    aBuf: array[0..256] of Char;
  1464.    Format,FormatName,Size: String;
  1465.    aRect: TRect;
  1466.    DC: HDC;
  1468. begin
  1469.    {$IFDEF WIN32}
  1470.    Windows.GetClientRect(FDIBWnd, aRect);
  1471.    {$ELSE}
  1472.    WinProcs.GetClientRect(FDIBWnd, aRect);
  1473.    {$ENDIF}
  1474.    DC := GetDC(FDIBWnd);
  1475.    try
  1476.       DrawDISP(DC, aRect);
  1477.    finally
  1478.       ReleaseDC(FDIBWnd,DC);
  1479.    end;
  1481.    EnableWindow(GetDlgItem(Wnd,CB_PREVIEW), False);
  1483.    with FWaveFile.Wave do
  1484.    if (FileName = '') then
  1485.    begin
  1486.       Format := LoadResStr(IDS_WAVEUNKNOWN);
  1487.       SetDlgItemText(Wnd,LT_FORMAT,StrPCopy(aBuf, Format));
  1488.       EnableWindow(GetDlgItem(Wnd,BT_Play), False);
  1489.       {$IFDEF WIN32}
  1490.       Windows.GetClientRect(FScopeWnd, aRect);
  1491.       {$ELSE}
  1492.       WinProcs.GetClientRect(FScopeWnd, aRect);
  1493.       {$ENDIF}
  1494.       InvalidateRect(FScopeWnd, @aRect, False);
  1495.    end
  1496.    else
  1497.    begin
  1498.       acmGetFormatDescription(PWaveFormat,FormatName,Format);
  1500.       Size := '; ' + IntToStr(FileSize div 1024) + ' KB';
  1501.       SetDlgItemText(Wnd,LT_FORMAT,StrPCopy(aBuf, FormatName+'; '+Format+Size));
  1503.       {$IFDEF WIN32}
  1504.       Windows.GetClientRect(FScopeWnd, aRect);
  1505.       {$ELSE}
  1506.       WinProcs.GetClientRect(FScopeWnd, aRect);
  1507.       {$ENDIF}
  1509.       if (FormatTag = 1) and (DataSize > 0) then
  1510.       begin
  1511.          EnableWindow(GetDlgItem(Wnd,CB_PREVIEW), True);
  1513.          if FPreview then
  1514.          begin
  1515.             DC := GetDC(FScopeWnd);
  1516.             try
  1517.                CreatePCMData(DC,aRect);
  1518.             finally
  1519.                ReleaseDC(FScopeWnd, DC);
  1520.             end;
  1521.             goto CheckDevice;
  1522.          end;
  1523.       end;
  1524.       InvalidateRect(FScopeWnd, @aRect, False);
  1526. CheckDevice:
  1528.       if (FWaveOut.NumDevs > 0) and not FWaveFile.Wave.Empty and
  1529.           FWaveOut.QueryDevice(FWaveOut.DeviceID,FWaveOut.PWaveFormat) and
  1530.           not (wosPlay in FWaveOut.State) then
  1531.       begin
  1532.          UpdatePlayParams;
  1533.          EnableWindow(GetDlgItem(Wnd,BT_Play), True);
  1534.          if FAutoPlay then
  1535.          try
  1536.             FWaveOut.Start;
  1537.          except
  1538.             { don't raise a exception here }
  1539.          end;
  1540.       end
  1541.       else EnableWindow(GetDlgItem(Wnd,BT_Play), False);
  1542.    end;
  1543. end;
  1545. {-- TMMWaveOpenDialog ---------------------------------------------------------}
  1546. procedure TMMWaveOpenDialog.ScopeWndHookProc(var Message: TMessage);
  1547. var
  1548.    DC: HDC;
  1549.    Paint: TPaintStruct;
  1550.    aRect: TRect;
  1552. begin
  1553.    with Message do
  1554.    begin
  1555.       if (Msg = WM_Paint) then
  1556.       begin
  1557.          DC := BeginPaint(FScopeWnd,Paint);
  1558.          {$IFDEF WIN32}
  1559.          Windows.GetClientRect(FScopeWnd,aRect);
  1560.          {$ELSE}
  1561.          WinProcs.GetClientRect(FScopeWnd,aRect);
  1562.          {$ENDIF}
  1563.          DrawPCMData(DC,aRect);
  1564.          EndPaint(FScopeWnd, Paint);
  1565.       end
  1566.       else if (Msg = WM_TIMER) then
  1567.       begin
  1568.          KillTimer(FScopeWnd,wParam);
  1569.          FUpdating := False;
  1570.          UpdateWave;
  1571.       end
  1572.       else Result := CallWindowProc(FScopeDefProc,FScopeWnd,Msg,wParam,lParam);
  1573.    end;
  1574. end;
  1576. {-- TMMWaveOpenDialog ---------------------------------------------------------}
  1577. procedure TMMWaveOpenDialog.DIBWndHookProc(var Message: TMessage);
  1578. var
  1579.    DC: HDC;
  1580.    Paint: TPaintStruct;
  1581.    aRect: TRect;
  1583. begin
  1584.    with Message do
  1585.    begin
  1586.       if (Msg = WM_Paint) then
  1587.       begin
  1588.          DC := BeginPaint(FDIBWnd,Paint);
  1589.          {$IFDEF WIN32}
  1590.          Windows.GetClientRect(FDIBWnd,aRect);
  1591.          {$ELSE}
  1592.          WinProcs.GetClientRect(FDIBWnd,aRect);
  1593.          {$ENDIF}
  1594.          DrawDISP(DC,aRect);
  1595.          EndPaint(FDIBWnd, Paint);
  1596.       end
  1597.       else Result := CallWindowProc(FDIBDefProc,FDIBWnd,Msg,wParam,lParam);
  1598.    end;
  1599. end;
  1601. {== TMMWaveSaveDialog =========================================================}
  1602. constructor TMMWaveSaveDialog.Create(aOwner: TComponent);
  1603. begin
  1604.    inherited Create(aOwner);
  1606.    Title := LoadResStr(IDS_WAVESAVE);
  1607. end;
  1609. {-- TMMWaveSaveDialog ---------------------------------------------------------}
  1610. function TMMWaveSaveDialog.Execute: Boolean;
  1611. begin
  1612.    Result := DoExecute(@GetSaveFileName);
  1613. end;
  1615. {== TMMPictureOpenDialog ======================================================}
  1616. constructor TMMPictureOpenDialog.Create(AOwner: TComponent);
  1617. begin
  1618.    inherited Create(AOwner);
  1620.    Options := Options + [ofHideReadOnly];
  1621.    {$IFDEF WIN32}
  1622.    Options := Options + [ofNoNetworkButton];
  1623.    {$ENDIF}
  1624.    FBitmap := TBitmap.Create;
  1625.    FPicture := TPicture.Create;
  1626.    FPreview := False;
  1627.    FColor := clWindow;
  1628.    FLastFile := '';
  1630.    Title := LoadResStr(IDS_PICTUREOPEN);
  1631.    DefaultExt := GraphicExtension(TGraphic);
  1632.    Filter := GraphicFilter(TGraphic);
  1633.    FilterIndex := 1;
  1634.    FHookWnd := 0;
  1636.    {$IFNDEF WIN32}
  1637.    if _WINNT_ then
  1638.       TemplateName := 'CustomPictureOpenDlgNT'
  1639.    else
  1640.    {$ENDIF}
  1641.       TemplateName := 'CustomPictureOpenDlg';
  1642. end;
  1644. {-- TMMPictureOpenDialog ------------------------------------------------------}
  1645. destructor TMMPictureOpenDialog.Destroy;
  1646. begin
  1647.    FBitmap.Free;
  1648.    FPicture.Free;
  1650.    inherited Destroy;
  1651. end;
  1653. {-- TMMPictureOpenDialog ------------------------------------------------------}
  1654. procedure TMMPictureOpenDialog.DoCreate;
  1655. var
  1656.    aBuf: array[0..20] of Char;
  1658. begin
  1659.    if (FHookWnd = 0) then
  1660.    begin
  1661.       FHookWnd := GetDlgItem(Wnd,ST_PICTURE);
  1662.       FDefProc := Pointer(GetWindowLong(FHookWnd,GWL_WNDPROC));
  1663.       FOldProc := SetWindowLong(FHookWnd,GWL_WNDPROC,
  1664.                   Longint(MakeObjectInstance(WndHookProc)));
  1665.    end;
  1667.    SetDlgItemText(Wnd,CB_PREVIEW,StrPCopy(aBuf,LoadResStr(IDS_PREVIEW)));
  1668.    SendDlgItemMessage(Wnd,CB_PREVIEW, BM_SETCHECK, Ord(FPReview), 0);
  1669.    {$IFDEF WIN32}
  1670.    if not NewStyleControls then
  1671.    {$ENDIF}
  1672.    begin
  1673.       { TODO: hier Texte im Dialog lokalisieren !!!
  1674.        oder gleich englische Resource verwenden }
  1675.    end;
  1677.    inherited DoCreate;
  1678. end;
  1680. {-- TMMPictureOpenDialog ------------------------------------------------------}
  1681. procedure TMMPictureOpenDialog.DoDestroy;
  1682. begin
  1683.    if (FHookWnd <> 0) then
  1684.    begin
  1685.       FreeObjectInstance(Pointer(SetWindowLong(FHookWnd,GWL_WNDPROC,FOldProc)));
  1686.       FHookWnd := 0;
  1687.    end;
  1689.    inherited DoDestroy;
  1690. end;
  1692. {-- TMMPictureOpenDialog ------------------------------------------------------}
  1693. procedure TMMPictureOpenDialog.DoFileOK(FName: String; var IsOk: Boolean);
  1694. begin
  1695.    { TODO: hier Format pr黤en ? }
  1696.    inherited DoFileOK(FName, IsOK);
  1697. end;
  1699. {-- TMMPictureOpenDialog ------------------------------------------------------}
  1700. procedure TMMPictureOpenDialog.DoSelChanged(FName: String);
  1701. var
  1702.    LastName: string;
  1704. begin
  1705.    if assigned(FPicture) then
  1706.    begin
  1707.       if (FName <> '') then
  1708.       begin
  1709.          LastName := FindLastFileName(FName);
  1710.          if (LastName <> FLastFile) and FileExists(LastName) then
  1711.          begin
  1712.             try
  1713.                FPicture.LoadFromFile(LastName);
  1714.                FLastFile := LastName;
  1715.             except
  1716.                FPicture.Bitmap.Handle := 0;
  1717.                FPicture.Icon.Handle := 0;
  1718.                FPicture.Metafile.Handle := 0;
  1719.                FLastFile := '';
  1720.             end;
  1721.             UpdatePicture;
  1722.          end;
  1723.       end
  1724.       else if (FLastFile <> '') then
  1725.       begin
  1726.          FPicture.Bitmap.Handle := 0;
  1727.          FPicture.Icon.Handle := 0;
  1728.          FPicture.Metafile.Handle := 0;
  1729.          FLastFile := '';
  1730.          UpdatePicture;
  1731.       end;
  1732.    end;
  1734.    inherited DoSelChanged(FName);
  1735. end;
  1737. {-- TMMPictureOpenDialog ------------------------------------------------------}
  1738. procedure TMMPictureOpenDialog.DoCommand(Wnd,Parent: Hwnd; cmd: Integer);
  1739. begin
  1740.    if (Wnd = FHWnd) then
  1741.    begin
  1742.       if (cmd = CB_PREVIEW) then
  1743.       begin
  1744.          FPreview := SendDlgItemMessage(Wnd, CB_PREVIEW, BM_GetCheck, 0, 0)<> 0;
  1745.          UpdatePicture;
  1746.       end;
  1747.    end;
  1749.    inherited DoCommand(Wnd,Parent,cmd);
  1750. end;
  1752. {-- TMMPictureOpenDialog ------------------------------------------------------}
  1753. procedure TMMPictureOpenDialog.DrawPicture(DC: HDC; aRect: TRect);
  1754. const
  1755.    Space = 5;
  1756. var
  1757.    aCanvas: TCanvas;
  1758.    oldPal: HPalette;
  1759.    Factor: Float;
  1760.    iWidth,iHeight: integer;
  1762. begin
  1763.    with FPicture, aRect do
  1764.    begin
  1765.       aCanvas := TCanvas.Create;
  1766.       with aCanvas do
  1767.       try
  1768.          Handle := DC;
  1769.          { clear background }
  1770.          Brush.Color := clWindow;
  1771.          FillRect(aRect);
  1772.          Frame3D(aCanvas,aRect,clBtnShadow,clBtnHighLight,1);
  1773.          Frame3D(aCanvas,aRect,clWindowFrame,cl3DLight,1);
  1774.          if (Graphic <> nil) and not Graphic.Empty and FPreview then
  1775.          begin
  1776.             iWidth := FPicture.Width;
  1777.             iHeight := FPicture.Height;
  1779.             if (Graphic is TIcon) or (Graphic is TMetaFile) then
  1780.             begin
  1781.                if (iWidth < (Right-Left)-2*Space) and
  1782.                   (iHeight < (Bottom-Top)-2*Space) then
  1783.                begin
  1784.                   aRect := Bounds(((Right-Left) - iWidth) div 2,
  1785.                                   ((Bottom-Top) - iHeight) div 2,
  1786.                                     iWidth, iHeight);
  1787.                end;
  1788.                aCanvas.StretchDraw(aRect,Graphic);
  1789.             end
  1790.             else if (Graphic is TBitmap) then
  1791.             begin
  1792.                OldPal := SelectPalette(Handle,Bitmap.Palette,False);
  1793.                RealizePalette(Handle);
  1795.                if (iWidth < (Right-Left)-2*Space) and
  1796.                   (iHeight < (Bottom-Top)-2*Space) then
  1797.                begin
  1798.                   aRect := Bounds(((Right-Left) - iWidth) div 2,
  1799.                                   ((Bottom-Top) - iHeight) div 2,
  1800.                                     iWidth, iHeight);
  1801.                end
  1802.                else if (iWidth > iHeight) then
  1803.                begin
  1804.                   Factor := ((Right-Left)-2*Space)/iWidth;
  1805.                   iHeight := Trunc(iHeight * Factor);
  1806.                   aRect.Top := Top+((Bottom-Top)-iHeight) div 2;
  1807.                   aRect.Bottom := Top + iHeight;
  1808.                   aRect.Left := Left+Space;
  1809.                   aRect.Right := Right-Space;
  1810.                end
  1811.                else
  1812.                begin
  1813.                   Factor := ((Bottom-Top)-2*Space)/iHeight;
  1814.                   iWidth := Trunc(iWidth * Factor);
  1815.                   aRect.Left := Left+((Right-Left)-iWidth) div 2;
  1816.                   aRect.Right := Left + iWidth;
  1817.                   aRect.Top := aRect.Top + Space;
  1818.                   aRect.Bottom := Bottom - Space;
  1819.                end;
  1820.                aCanvas.StretchDraw(aRect,Graphic);
  1821.                SelectPalette(Handle, OldPal, False);
  1822.                RealizePalette(Handle);
  1823.             end;
  1824.          end;
  1826.       finally
  1827.          aCanvas.Handle := 0;
  1828.          aCanvas.Free;
  1829.       end;
  1830.    end;
  1831. end;
  1833. {-- TMMPictureOpenDialog ------------------------------------------------------}
  1834. Procedure TMMPictureOpenDialog.UpdatePicture;
  1835. var
  1836.    aRect: TRect;
  1838. begin
  1839.    {$IFDEF WIN32}
  1840.    Windows.GetClientRect(FHookWnd, aRect);
  1841.    {$ELSE}
  1842.    WinProcs.GetClientRect(FHookWnd, aRect);
  1843.    {$ENDIF}
  1844.    InvalidateRect(FHookWnd, @aRect, False);
  1845. end;
  1847. {-- TMMPictureOpenDialog ------------------------------------------------------}
  1848. procedure TMMPictureOpenDialog.WndHookProc(var Message: TMessage);
  1849. var
  1850.    DC: HDC;
  1851.    Paint: TPaintStruct;
  1852.    aRect: TRect;
  1854. begin
  1855.    with Message do
  1856.    begin
  1857.       if (Msg = WM_Paint) then
  1858.       begin
  1859.          DC := BeginPaint(FHookWnd,Paint);
  1860.          {$IFDEF WIN32}
  1861.          Windows.GetClientRect(FHookWnd,aRect);
  1862.          {$ELSE}
  1863.          WinProcs.GetClientRect(FHookWnd,aRect);
  1864.          {$ENDIF}
  1865.          DrawPicture(DC,aRect);
  1866.          EndPaint(FHookWnd, Paint);
  1867.       end
  1868.       else Result := CallWindowProc(FDefProc,FHookWnd,Msg,wParam,lParam);
  1869.    end;
  1870. end;
  1872. {== TMMPictureSaveDialog ======================================================}
  1873. constructor TMMPictureSaveDialog.Create(aOwner: TComponent);
  1874. begin
  1875.    inherited Create(aOwner);
  1877.    Title := LoadResStr(IDS_PICTURESAVE);
  1878. end;
  1880. {-- TMMPictureSaveDialog ------------------------------------------------------}
  1881. function TMMPictureSaveDialog.Execute: Boolean;
  1882. begin
  1883.    Result := DoExecute(@GetSaveFileName);
  1884. end;
  1886. initialization
  1887.    {$IFDEF WIN32}
  1888.    if not NewStyleControls then
  1889.    {$ENDIF}
  1890.    InitDialogs;
  1891. end.