mmcstdlg.pas

一套及时通讯的原码

           obj.FHWnd := Wnd;
           obj.DoCreate;
           Result := 1;
        end;

        WM_Destroy:
        begin
           {clean up }
           if assigned(obj) then
           begin
              obj.DoDestroy;
              obj.FHWND := 0;
              obj := nil;
           end;
           if HookCtl3D then SetAutoSubClass(False);
        end;

        WM_CTLCOLOR:
           if HookCtl3D and (@Ctl3DCtlColorEx <> nil) then
            Result := Ctl3DCtlColorEx(Wnd, Msg, WParam, LParam);

        {$IFDEF WIN32}
        { route notifications }
        WM_NOTIFY:
        begin
           { Center after INIT if requested }
           if (POFNotify(LParam)^.hdr.code = CDN_INITDONE) then
              CenterWindow(GetWindowLong(Wnd, GWL_HWNDPARENT));

           if assigned(obj) then
           begin
              { Dispatch each event }
              if (POFNotify(LParam)^.hdr.code = CDN_FILEOK) then
              begin
                 aResult := True;
                 if (ofAllowMultiSelect in obj.FOptions) then
                 begin
                    ExtractFileNames(POFNotify(LParam).lpOFN.lpstrFile, obj.FTempFiles);
                    for i := 0 to obj.FTempFiles.Count-1 do
                    begin
                       obj.DoFileOK(obj.FTempFiles[i],aResult);
                       if not aResult then break;
                    end
                 end
                 else
                 begin
                    SetString(FName, POFNotify(LParam).lpOFN.lpstrFile,
                              StrLen(POFNotify(LParam).lpOFN.lpstrFile));
                              obj.DoFileOK(FName,aResult);
                 end;
                 Result := ord(not aResult);
                 SetWindowLong(Wnd, DWL_MSGRESULT, ord(not aResult));
              end;

              if (POFNotify(LParam)^.hdr.code = CDN_SELCHANGE) then
              begin
                 Buf := StrAlloc(BufSize);
                 try
                    Len := SendMessage(GetParent(Wnd),CDM_GETFILEPATH,BufSize,LongInt(Buf));
                    SetString(FName,Buf,Len-1);
                    obj.DoSelChanged(FName);
                 finally
                    StrDispose(Buf);
                 end;
              end;
           end;
        end;
        {$ENDIF}

        { dispatch WM_COMMAND }
        WM_COMMAND:
           if assigned(obj) then obj.DoCommand(Wnd,Parent,LOWORD(WParam));

        {$IFNDEF WIN32}
        WM_NCACTIVATE,
        WM_NCPAINT,
        WM_SETTEXT:
           if HookCtl3D and (@Ctl3DDlgFramePaint <> nil) then
           begin
              { The following fixes a Ctrl3D bug under Windows NT }
              if (GetWinFlags and $4000 <> 0) and (Msg = WM_SETTEXT) and
                 (DialogTitle <> nil) then
                 LParam := Longint(DialogTitle);
              SetWindowLong(Wnd, DWL_MSGRESULT, Ctl3DDlgFramePaint(Wnd, Msg,
                            WParam, LParam));
              Result := 1;
           end;
        {$ENDIF}
        else
        {$IFDEF WIN32}
        if not NewStyleControls then
        {$ENDIF}
        begin
           if (Msg = CD_FILEOK) then
           begin
              if assigned(obj) then
              begin
                 aResult := True;
                 if (ofAllowMultiSelect in obj.FOptions) then
                 begin
                    ExtractFileNames(POpenFileNameA(LParam)^.lpstrFile, obj.FTempFiles);
                    for i := 0 to obj.FTempFiles.Count-1 do
                    begin
                       obj.DoFileOK(obj.FTempFiles[i],aResult);
                       if not aResult then break;
                    end;
                 end
                 else
                 begin
                    FName := StrPas(POpenFileNameA(LParam)^.lpstrFile);
                    obj.DoFileOK(FName,aResult);
                 end;
                 Result := ord(not aResult);
                 SetWindowLong(Wnd, DWL_MSGRESULT, ord(not aResult));
              end;
           end;
           if (Msg = CD_LBSelCh) then
           begin
              if (wParam = lst1) and assigned(obj) then
              begin
                 Buf := StrAlloc(BufSize);
                 try
                    Len := SendDlgItemMessage(Wnd,lst1, LB_GETTEXT, LoWord(lParam), Longint(Buf));
                    if (Len <> LB_Err) then
                    begin
                       FName := ExpandUNCFileName(StrPas(Buf));
                       obj.DoSelChanged(FName);
                    end;
                 finally
                    StrDispose(Buf);
                 end;
              end;
           end;
        end;
      end;

   except
      Application.HandleException(nil);
   end;
end;

{== TMMCustomOpenDialog =======================================================}
constructor TMMCustomOpenDialog.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);

   FHistoryList := TStringList.Create;
   FFiles       := TStringList.Create;
   FTempFiles   := TStringList.Create;
   FFilterIndex := 1;
   {$IFNDEF DELPHI4}
   FSizing      := False;
   {$ENDIF}

   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;

{-- TMMCustomOpenDialog -------------------------------------------------------}
destructor TMMCustomOpenDialog.Destroy;
begin
   FFiles.Free;
   FTempFiles.Free;
   FHistoryList.Free;

   inherited Destroy;
end;

{-- TMMCustomOpenDialog -------------------------------------------------------}
function TMMCustomOpenDialog.DoExecute(Func: Pointer): Bool;
const
    {$IFNDEF DELPHI4}
    OFN_ENABLESIZING    = $00800000;
    {$ENDIF}
    {$IFNDEF DELPHI6}
    OFN_DONTADDTORECENT = $02000000;
    OFN_FORCESHOWHIDDEN = $10000000;
    {$ENDIF}

    {$IFDEF WIN32}
    {$IFDEF DELPHI6}
    MultiSelectBufferSize = High(Word) - 16;
    {$ELSE}
    MultiSelectBufferSize = 8192;
    {$ENDIF}
    OpenOptions: array [TOpenOption] of DWORD = (
    OFN_READONLY, OFN_OVERWRITEPROMPT, OFN_HIDEREADONLY,
    OFN_NOCHANGEDIR, OFN_SHOWHELP, OFN_NOVALIDATE, OFN_ALLOWMULTISELECT,
    OFN_EXTENSIONDIFFERENT, OFN_PATHMUSTEXIST, OFN_FILEMUSTEXIST,
    OFN_CREATEPROMPT, OFN_SHAREAWARE, OFN_NOREADONLYRETURN,
    OFN_NOTESTFILECREATE, OFN_NONETWORKBUTTON, OFN_NOLONGNAMES,
    OFN_EXPLORER, OFN_NODEREFERENCELINKS
    {$IFDEF DELPHI4}
    ,OFN_ENABLEINCLUDENOTIFY,
    OFN_ENABLESIZING
    {$ENDIF}
    {$IFDEF DELPHI6}
    ,OFN_DONTADDTORECENT,
    OFN_FORCESHOWHIDDEN
    {$ENDIF}
    );
    {$ELSE}
    MultiSelectBufferSize = 1000;
    OpenOptions: array [TOpenOption] of Longint = (
    OFN_READONLY, OFN_OVERWRITEPROMPT, OFN_HIDEREADONLY,
    OFN_NOCHANGEDIR, OFN_SHOWHELP, OFN_NOVALIDATE, OFN_ALLOWMULTISELECT,
    OFN_EXTENSIONDIFFERENT, OFN_PATHMUSTEXIST, OFN_FILEMUSTEXIST,
    OFN_CREATEPROMPT, OFN_SHAREAWARE, OFN_NOREADONLYRETURN,
    OFN_NOTEXTFILECREATE);
    {$ENDIF}

var
  OpenFilename: TOpenFilename;
  Option: TOpenOption;
  CDefaultExt: array[0..3] of Char;
  CInitialDir: array[0..79] of Char;
  CTitle: array[0..79] of Char;
  CFilter: array[0..1023] of Char;
  CTemplate: array[0..257] of Char;
  S: string;

  function StrFilterCopy(P: PChar; const S: string): PChar;
  begin
    Result := nil;
    if S <> '' then
    begin
      {$IFDEF WIN32}
      { Because StrPCopy truncates 256 characters }
      Result := StrCopy(P,PChar(S));
      {$ELSE}
      Result := StrPCopy(P, S);
      {$ENDIF}

      while P^ <> #0 do
      begin
        if P^ = '|' then P^ := #0;
        Inc(P);
      end;
      Inc(P);
      P^ := #0;
    end;
  end;

begin
   FFiles.Clear;
   FillChar(OpenFileName, SizeOf(OpenFileName), 0);
   with OpenFilename do
   try
     lStructSize := SizeOf(TOpenFilename);
     hInstance := {$IFDEF DELPHI3}SysInit.HInstance{$ELSE}System.HInstance{$ENDIF};
     lpstrFilter := StrFilterCopy(CFilter, FFilter);
     nFilterIndex := FFilterIndex;
     if ofAllowMultiSelect in FOptions then
        nMaxFile := MultiSelectBufferSize
     else
        {$IFDEF WIN32}
        nMaxFile := MAX_PATH;
        {$ELSE}
        nMaxFile := sizeof(TFileName);
        {$ENDIF}
     GetMem(lpstrFile, nMaxFile + 2);
     FillChar(lpstrFile^, nMaxFile + 2, 0);
     StrPCopy(lpstrFile, FFileName);
     lpstrInitialDir := StrPLCopy(CInitialDir, FInitialDir,
                                  SizeOf(CInitialDir) - 1);
     lpstrTitle := StrPLCopy(CTitle, FTitle, SizeOf(CTitle) - 1);
     if Length(FTitle) > 0 then DialogTitle := lpstrTitle;
     { Always enable hook }
     Flags := OFN_ENABLEHOOK;
     for Option := Low(Option) to High(Option) do
     if Option in FOptions then
        Flags := Flags or OpenOptions[Option];
     {$IFDEF WIN32}
     if NewStyleControls then
     begin
        Flags := Flags or OFN_EXPLORER;
        {$IFNDEF DELPHI4}
        if FSizing then Flags := Flags or OFN_ENABLESIZING;
        {$ENDIF}
     end
     else
        Flags := Flags and not OFN_EXPLORER;
     {$ENDIF}
     lpstrDefExt := StrPCopy(CDefaultExt, FDefaultExt);
     { add custom callback }
     lpfnHook := ExplorerHook;

{$IFDEF WIN32}
     if NewStyleControls then
        HookCtl3D := False
     else
{$ENDIF}
        HookCtl3D := Ctl3D;

     { add custom resource  }
     if FTemplateName <> '' then
     begin
        lpTemplateName:= StrPLCopy(CTemplate, FTemplateName, SizeOf(CTemplate)-1);
        Flags := Flags or OFN_ENABLETEMPLATE;
{$IFDEF WIN32}
        if not NewStyleControls then
           StrLCat(lpTemplateName,'OLD',SizeOf(CTemplate)-1);
{$ENDIF}
     end;

     {$IFDEF WIN32}
     {$IFDEF TRIAL}
     {$DEFINE _HACK2}
     {$I MMHACK.INC}
     {$ENDIF}
     {$ENDIF}

     { allow callback to find object }
     lCustData:=LongInt(Self);
     hWndOwner := Application.Handle;
     Result := TaskModalDialog(Func, OpenFileName);
     DialogTitle := nil;
     if Result then
     begin
        if ofAllowMultiSelect in FOptions then
        begin
           ExtractFileNames(lpstrFile,TStringList(FFiles));
           FFileName := FFiles[0];
        end
        else
        begin
           ExtractFileName_A(lpstrFile, S);
           FFileName := S;
           FFiles.Add(FFileName);
        end;
        if (Flags and OFN_EXTENSIONDIFFERENT) <> 0 then
            Include(FOptions, ofExtensionDifferent)
        else
            Exclude(FOptions, ofExtensionDifferent);
        if (Flags and OFN_READONLY) <> 0 then
            Include(FOptions, ofReadOnly)
        else
            Exclude(FOptions, ofReadOnly);
        FFilterIndex := nFilterIndex;
     end;

   finally
     if lpstrFile <> nil then FreeMem(lpstrFile, nMaxFile + 2);
   end;
end;

{-- TMMCustomOpenDialog -------------------------------------------------------}
procedure TMMCustomOpenDialog.SetHistoryList(Value: TStrings);
begin
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}

   FHistoryList.Assign(Value);
end;

{-- TMMCustomOpenDialog -------------------------------------------------------}
procedure TMMCustomOpenDialog.SetInitialDir(const Value: string);
var
  L: Integer;
begin
   L := Length(Value);
   if (L > 1) and (Value[L] = '\') and (Value[L - 1] <> ':') then Dec(L);
   FInitialDir := Copy(Value, 1, L);

   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK3}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMCustomOpenDialog -------------------------------------------------------}
function TMMCustomOpenDialog.Execute: Boolean;
begin
   Result := DoExecute(@GetOpenFileName);
end;

{-- TMMCustomOpenDialog -------------------------------------------------------}
procedure TMMCustomOpenDialog.DoCreate;
begin
   if assigned(FOnCreate) then
      FOnCreate(Self);
end;

{-- TMMCustomOpenDialog -------------------------------------------------------}
procedure TMMCustomOpenDialog.DoDestroy;
begin
   if assigned(FOnDestroy) then
      FOnDestroy(Self);
end;

{-- TMMCustomOpenDialog -------------------------------------------------------}
procedure TMMCustomOpenDialog.DoFileOK(FName: String; var IsOk: Boolean);
begin
   if assigned(FOnFileOK) then
      FOnFileOK(Self,FName,IsOK);
end;

{-- TMMCustomOpenDialog -------------------------------------------------------}
procedure TMMCustomOpenDialog.DoSelChanged(FName: String);
begin
   if assigned(FOnSelChange) then
      FOnSelChange(Self,FName);
end;

{-- TMMCustomOpenDialog -------------------------------------------------------}
procedure TMMCustomOpenDialog.DoCommand(Wnd,Parent: Hwnd; cmd: Integer);
begin
   if assigned(FOnCommand) then
      FOnCommand(Self,Wnd,Parent,cmd);
end;

{== TMMWaveOpenDialog =========================================================}
constructor TMMWaveOpenDialog.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);

   Options := Options + [ofHideReadOnly];
   {$IFDEF WIN32}
   Options := Options + [ofNoNetworkButton];
   {$ENDIF}
   FPreview := False;
   FAutoPlay:=False;
   FDeviceID:= -1;
   FUpdating := False;
   FColor := clBlack;
   FForeColor := clLime;
   FLocatorColor := clRed;
   FData := nil;
   Title := LoadResStr(IDS_WAVEOPEN);
   DefaultExt:= 'wav';
   Filter := LoadResStr(IDS_WAVEFILTER);
   FScopeWnd := 0;
   FDIBWnd := 0;
   {$IFNDEF WIN32}
   if _WINNT_ then
      TemplateName := 'CustomWaveOpenDlgNT'
   else
   {$ENDIF}
      TemplateName := 'CustomWaveOpenDlg';
end;

{-- TMMWaveOpenDialog ---------------------------------------------------------}
destructor TMMWaveOpenDialog.Destroy;
begin
   DoDestroy;

   inherited Destroy;
end;

{-- TMMWaveOpenDialog ---------------------------------------------------------}
procedure TMMWaveOpenDialog.DoCreate;
var
   aRect: TRect;
   aBuf: array[0..20] of Char;

begin
   if (FScopeWnd = 0) then
   begin
      FScopeWnd := GetDlgItem(Wnd,ST_SCOPE);
      FScopeDefProc := Pointer(GetWindowLong(FScopeWnd,GWL_WNDPROC));
      FScopeOldProc := SetWindowLong(FScopeWnd,GWL_WNDPROC,
                       Longint(MakeObjectInstance(ScopeWndHookProc)));
   end;

   if (FDIBWnd = 0) then
   begin
      FDIBWnd := GetDlgItem(Wnd,ST_DIB);
      FDIBDefProc := Pointer(GetWindowLong(FDIBWnd,GWL_WNDPROC));