mmprops.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Tel.: [phone]                   =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.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.01.1998 - 18:00:00 $                                      =}
{========================================================================}
unit MMProps;

{$I COMPILER.INC}

interface

uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    Messages,
    Classes,
    Controls,
    Forms,
    MMObj,
    MMUtils,
    MMSystem;

type
   EMMPropertiesError = class(Exception);
   EMMJoystickError = class(Exception);

   {-- TMMPropertiesDialog ----------------------------------------------}
   TMMPropertiesDialog = class(TMMNonVisualComponent)
   protected
     function ParentHnd: THandle;
   public
     function Execute: Boolean; virtual; abstract;
   end;
   
   TMMPropertySheets = (psAll,psAudio,psVideo,psMidi,psCDAudio);

   {-- TMMProperties ----------------------------------------------------}
   TMMProperties = class(TMMPropertiesDialog)
   private
     FSheets: TMMPropertySheets;
     FTitle : String;

   public
     constructor Create(AOwner: TComponent); override;

     function Execute: Boolean; override;

   published
     property Sheets: TMMPropertySheets read FSheets write FSheets default psAudio;
     property Title: String read FTitle write FTitle;
   end;

   {-- TMMJoystickProperties --------------------------------------------}
   TMMJoystickProperties = class(TMMPropertiesDialog)
   public
     function Execute: Boolean; override;
   end;

implementation

{-- TMMPropertiesDialog ----------------------------------------------}
function TMMPropertiesDialog.ParentHnd: THandle;
begin
  {$IFDEF BUILD_ACTIVEX}
  ParentHnd := Handle;
  {$ELSE}
  if Assigned(Owner) and (Owner is TWinControl) then
    ParentHnd := TWinControl(Owner).Handle
  else
    ParentHnd := 0;
  {$ENDIF}
end;

type
  TCplApplet              = function(Wnd, Msg: Integer; P1, P2: Longint): Integer; stdcall;
  TShowMMCPLPropertySheet = procedure(Wnd: Integer; Page, PageText, WinText: PChar); stdcall;

  TCPINFO = record
    idIcon,
    idName,
    idInfo,
    lData  : Integer;
  end;

  TNewCpInfo = record
    dwSize        : Longint;
    dwFlags       : Longint;
    dwHelpContext : Longint;
    lData         : Longint;
    hIcon         : HIcon;
    szName        : array[0..31] of Char;
    szInfo        : array[0..63] of Char;
    szHelpFile    : array[0..127] of Char;
  end;

const
     CPL_INIT        = 1;
     CPL_GETCOUNT    = 2;
     CPL_INQUIRE     = 3;
     CPL_SELECT      = 4;
     CPL_DBLCLK      = 5;
     CPL_STOP        = 6;
     CPL_EXIT        = 7;
     CPL_NEWINQUIRE  = 8;

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

   FSheets := psAudio;
   FTitle := LoadResStr(IDS_AUDIOPROPERTIES);

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

{-- TMMPropertys -------------------------------------------------------}
function TMMProperties.Execute: Boolean;
const
  Tabs: array[TMMPropertySheets] of PChar = ('','Audio','Video','Midi','CDAudio');
  Names: array[TMMPropertySheets] of PChar = ('','Audio','Video','Midi','Audio-CD');
var
  CplApplet              : TCplApplet;
  ShowMMCPLPropertySheet : TShowMMCPLPropertySheet;
  Lib                    : THandle;
  Info                   : TNewCpInfo;
  ErrorMode              : Cardinal;

begin
  Result := False;

  if not NewStyleControls then
     raise EMMPropertiesError.Create(LoadResStr(IDS_NOTSUPPORTED));

  @CPLApplet := nil;
  ErrorMode := SetErrorMode(SEM_NoOpenFileErrorBox);
  try
     Lib := LoadLibrary('MMSYS.CPL');
     if (Lib >= HINSTANCE_ERROR) then
     begin
        if (FSheets = psAll) then
        begin
           @CplApplet:= GetProcAddress(Lib, 'CPlApplet');
           if assigned(CplApplet) then
           begin
              if CPLApplet(ParentHnd, CPL_INIT, 0, 0) <> 0 then
              begin
                 Info.dwSize:= SizeOf(Info);
                 CPLApplet(ParentHnd, CPL_INQUIRE, 0, Longint(@Info));
                 CPLApplet(ParentHnd, CPL_DBLCLK, 0, Info.lData);
                 CPLApplet(ParentHnd, CPL_EXIT, 0, 0);
                 Result := True;
              end;
           end
        end
        else
        begin
           @ShowMMCPLPropertySheet := GetProcAddress(Lib, 'ShowMMCPLPropertySheet');
           if Assigned(ShowMMCPLPropertySheet) then
           begin
              ShowMMCPLPropertySheet(ParentHnd, Tabs[FSheets], Names[FSheets],PChar(FTitle));
              Result := True;
           end;
        end;
     end;

  finally
     FreeLibrary(Lib);
     SetErrorMode(ErrorMode);
  end;
end;

{== TMMJoystickPropertys ================================================}
function TMMJoystickProperties.Execute: Boolean;
var
  CplApplet              : TCplApplet;
  Lib                    : THandle;
  Info                   : TNewCpInfo;
  ErrorMode              : Cardinal;

begin
  Result := False;
  if (joyGetNumDevs = 0) then
     raise EMMJoystickError.Create(LoadResStr(IDS_NOJOYSTICK));

  if not NewStyleControls then
     raise EMMJoystickError.Create(LoadResStr(IDS_NOTSUPPORTED));

  ErrorMode := SetErrorMode(SEM_NoOpenFileErrorBox);
  try
     Lib := LoadLibrary('JOY.CPL');
     if (Lib >= HINSTANCE_ERROR) then
     begin
        @CplApplet:= GetProcAddress(Lib, 'CPlApplet');
        if assigned(CplApplet) then
        begin
           if CPLApplet(ParentHnd, CPL_INIT, 0, 0) <> 0 then
           begin
              Info.dwSize:= SizeOf(Info);
              CPLApplet(ParentHnd, CPL_INQUIRE, 0, Longint(@Info));
              CPLApplet(ParentHnd, CPL_DBLCLK, 0, Info.lData);
              CPLApplet(ParentHnd, CPL_EXIT, 0, 0);
              Result := True;
           end;
        end;
     end;

  finally
     FreeLibrary(Lib);
     SetErrorMode(ErrorMode);
  end;

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

end.