mplayer.pas

这是不可多得的源代码

{*******************************************************}
{                                                       }
{       Borland Delphi Visual Component Library         }
{                                                       }
{  Copyright (c) 1995-2001 Borland Software Corporation }
{                                                       }
{*******************************************************}

unit MPlayer;

{$R-,T-,H+,X+}

interface

uses Windows, Classes, Controls, Forms, Graphics, Messages,
  MMSystem, Dialogs, SysUtils;

type
  TMPBtnType = (btPlay, btPause, btStop, btNext, btPrev, btStep, btBack,
    btRecord, btEject);
  TButtonSet = set of TMPBtnType;

  TMPGlyph = (mgEnabled, mgDisabled, mgColored);
  TMPButton = record
    Visible: Boolean;
    Enabled: Boolean;
    Colored: Boolean;
    Auto: Boolean;
    Bitmaps: array[TMPGlyph] of TBitmap;
  end;

  TMPDeviceTypes = (dtAutoSelect, dtAVIVideo, dtCDAudio, dtDAT, dtDigitalVideo, dtMMMovie,
    dtOther, dtOverlay, dtScanner, dtSequencer, dtVCR, dtVideodisc, dtWaveAudio);
  TMPTimeFormats = (tfMilliseconds, tfHMS, tfMSF, tfFrames, tfSMPTE24, tfSMPTE25,
    tfSMPTE30, tfSMPTE30Drop, tfBytes, tfSamples, tfTMSF);
  TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking,
    mpPaused, mpOpen);
  TMPNotifyValues = (nvSuccessful, nvSuperseded, nvAborted, nvFailure);
    
  TMPDevCaps = (mpCanStep, mpCanEject, mpCanPlay, mpCanRecord, mpUsesWindow);
  TMPDevCapsSet = set of TMPDevCaps;
  
  EMPNotify = procedure (Sender: TObject; Button: TMPBtnType;
    var DoDefault: Boolean) of object;
  EMPPostNotify = procedure (Sender: TObject; Button: TMPBtnType) of object;

  EMCIDeviceError = class(Exception);
  
  TMediaPlayer = class(TCustomControl)
  private
    Buttons: array[TMPBtnType] of TMPButton;
    FVisibleButtons: TButtonSet;
    FEnabledButtons: TButtonSet;
    FColoredButtons: TButtonSet;
    FAutoButtons: TButtonSet;
    Pressed: Boolean;
    Down: Boolean;
    CurrentButton: TMPBtnType;
    CurrentRect: TRect;
    ButtonWidth: Integer;
    MinBtnSize: TPoint;
    FOnClick: EMPNotify;
    FOnPostClick: EMPPostNotify;
    FOnNotify: TNotifyEvent;
    FocusedButton: TMPBtnType;
    MCIOpened: Boolean;
    FCapabilities: TMPDevCapsSet;
    FCanPlay: Boolean;
    FCanStep: Boolean;
    FCanEject: Boolean;
    FCanRecord: Boolean;
    FHasVideo: Boolean;
    FFlags: Longint;
    FWait: Boolean;
    FNotify: Boolean;
    FUseWait: Boolean;
    FUseNotify: Boolean;
    FUseFrom: Boolean;
    FUseTo: Boolean;
    FDeviceID: Word;
    FDeviceType: TMPDeviceTypes;
    FTo: Longint;
    FFrom: Longint;
    FFrames: Longint;
    FError: Longint;
    FNotifyValue: TMPNotifyValues;
    FDisplay: TWinControl;
    FDWidth: Integer;
    FDHeight: Integer;
    FElementName: string;
    FAutoEnable: Boolean;
    FAutoOpen: Boolean;
    FAutoRewind: Boolean;
    FShareable: Boolean;

    procedure LoadBitmaps;
    procedure DestroyBitmaps;
    procedure SetEnabledButtons(Value: TButtonSet);
    procedure SetColored(Value: TButtonSet);
    procedure SetVisible(Value: TButtonSet);
    procedure SetAutoEnable(Value: Boolean);
    procedure DrawAutoButtons;
    procedure DoMouseDown(XPos, YPos: Integer);
    procedure WMLButtonDown(var Message: TWMLButtonDown);
      message WM_LButtonDown;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk);
      message WM_LButtonDblClk;
    procedure WMMouseMove(var Message: TWMMouseMove);
      message WM_MouseMove;
    procedure WMLButtonUp(var Message: TWMLButtonUp);
      message WM_LButtonUp;
    procedure WMSetFocus(var Message: TWMSetFocus);
      message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMKillFocus);
      message WM_KILLFOCUS;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode);
      message WM_GETDLGCODE;
    procedure WMSize(var Message: TWMSize);
      message WM_SIZE;
    function VisibleButtonCount: Integer;
    procedure Adjust;
    procedure DoClick(Button: TMPBtnType);
    procedure DoPostClick(Button: TMPBtnType);
    procedure DrawButton(Btn: TMPBtnType; X: Integer);
    procedure CheckIfOpen;
    procedure SetPosition(Value: Longint);
    procedure SetDeviceType( Value: TMPDeviceTypes );
    procedure SetWait( Flag: Boolean );
    procedure SetNotify( Flag: Boolean );
    procedure SetFrom( Value: Longint );
    procedure SetTo( Value: Longint );
    procedure SetTimeFormat( Value: TMPTimeFormats );
    procedure SetDisplay( Value: TWinControl );
    procedure SetOrigDisplay;
    procedure SetDisplayRect( Value: TRect );
    function GetDisplayRect: TRect;
    procedure GetDeviceCaps;
    function GetStart: Longint;
    function GetLength: Longint;
    function GetMode: TMPModes;
    function GetTracks: Longint;
    function GetPosition: Longint;
    function GetErrorMessage: string;
    function GetTimeFormat: TMPTimeFormats;
    function GetTrackLength(TrackNum: Integer): Longint;
    function GetTrackPosition(TrackNum: Integer): Longint;
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Loaded; override;
    procedure AutoButtonSet(Btn: TMPBtnType); dynamic;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Paint; override;
    procedure MMNotify(var Message: TMessage); message MM_MCINOTIFY;
    procedure Click(Button: TMPBtnType; var DoDefault: Boolean); reintroduce; dynamic;
    procedure PostClick(Button: TMPBtnType); dynamic;
    procedure DoNotify; dynamic;
    procedure Updated; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Open;
    procedure Close;
    procedure Play;
    procedure Stop;
    procedure Pause; {Pause & Resume/Play}
    procedure Step;
    procedure Back;
    procedure Previous;
    procedure Next;
    procedure StartRecording;
    procedure Eject;
    procedure Save;
    procedure PauseOnly;
    procedure Resume;
    procedure Rewind;
    property TrackLength[TrackNum: Integer]: Longint read GetTrackLength;
    property TrackPosition[TrackNum: Integer]: Longint read GetTrackPosition;
    property Capabilities: TMPDevCapsSet read FCapabilities;
    property Error: Longint read FError;
    property ErrorMessage: string read GetErrorMessage;
    property Start: Longint read GetStart;
    property Length: Longint read GetLength;
    property Tracks: Longint read GetTracks;
    property Frames: Longint read FFrames write FFrames;
    property Mode: TMPModes read GetMode;
    property Position: Longint read GetPosition write SetPosition;
    property Wait: Boolean read FWait write SetWait;
    property Notify: Boolean read FNotify write SetNotify;
    property NotifyValue: TMPNotifyValues read FNotifyValue;
    property StartPos: Longint read FFrom write SetFrom;
    property EndPos: Longint read FTo write SetTo;
    property DeviceID: Word read FDeviceID;
    property TimeFormat: TMPTimeFormats read GetTimeFormat write SetTimeFormat;
    property DisplayRect: TRect read GetDisplayRect write SetDisplayRect;
  published
    property ColoredButtons: TButtonSet read FColoredButtons write SetColored
      default [btPlay, btPause, btStop, btNext, btPrev, btStep, btBack,
               btRecord, btEject];
    property Enabled;
    property EnabledButtons: TButtonSet read FEnabledButtons write SetEnabledButtons
      default [btPlay, btPause, btStop, btNext, btPrev, btStep, btBack,
               btRecord, btEject];
    property VisibleButtons: TButtonSet read FVisibleButtons write SetVisible
      default [btPlay, btPause, btStop, btNext, btPrev, btStep, btBack,
               btRecord, btEject];
    property Anchors;
    property AutoEnable: Boolean read FAutoEnable write SetAutoEnable default True;
    property AutoOpen: Boolean read FAutoOpen write FAutoOpen default False;
    property AutoRewind: Boolean read FAutoRewind write FAutoRewind default True;
    property Constraints;
    property DeviceType: TMPDeviceTypes read FDeviceType write SetDeviceType default dtAutoSelect;
    property Display: TWinControl read FDisplay write SetDisplay;
    property FileName: string read FElementName write FElementName;
    property Shareable: Boolean read FShareable write FShareable default False;
    property Visible;
    property ParentShowHint;
    property ShowHint;
    property PopupMenu;
    property TabOrder;
    property TabStop default True;
    property OnClick: EMPNotify read FOnClick write FOnClick;
    property OnContextPopup;
    property OnEnter;
    property OnExit;
    property OnPostClick: EMPPostNotify read FOnPostClick write FOnPostClick;
    property OnNotify: TNotifyEvent read FOnNotify write FOnNotify;
  end;

implementation

uses Consts;

{$R MPlayer.res}

const
  mci_Back     = $0899;  { mci_Step reverse }

  BtnStateName: array[TMPGlyph] of PChar = ('EN', 'DI', 'CL');
  BtnTypeName: array[TMPBtnType] of PChar = ('MPPLAY', 'MPPAUSE', 'MPSTOP',
    'MPNEXT', 'MPPREV', 'MPSTEP', 'MPBACK', 'MPRECORD', 'MPEJECT');

constructor TMediaPlayer.Create(AOwner: TComponent);
var
  I: TMPBtnType;
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csOpaque];
  LoadBitmaps;
  FVisibleButtons := [btPlay, btPause, btStop, btNext, btPrev, btStep,
    btBack, btRecord, btEject];
  FEnabledButtons := [btPlay, btPause, btStop, btNext, btPrev, btStep,
    btBack, btRecord, btEject];
  FColoredButtons := [btPlay, btPause, btStop, btNext, btPrev, btStep,
    btBack, btRecord, btEject];
  for I := Low(Buttons) to High(Buttons) do
  begin
    Buttons[I].Visible := True;
    Buttons[I].Enabled := True;
    Buttons[I].Colored := True;
    Buttons[I].Auto := False; {enabled/disabled dynamically}
  end;
  Width := 240;
  Height := 30;
  FocusedButton := btPlay;
  FAutoEnable := True;
  FAutoOpen := False;
  FAutoRewind := True;
  FDeviceType := dtAutoSelect; {select through file name extension}
  TabStop := True;
end;

destructor TMediaPlayer.Destroy;
var
  GenParm: TMCI_Generic_Parms;
begin
  if FDeviceID <> 0 then
    mciSendCommand( FDeviceID, mci_Close, mci_Wait, Longint(@GenParm));
  DestroyBitmaps;
  inherited Destroy;
end;

procedure TMediaPlayer.Loaded;
begin
  inherited Loaded;
  if (not (csDesigning in ComponentState)) and FAutoOpen then
    Open;
end;

procedure TMediaPlayer.LoadBitmaps;
var
  I: TMPBtnType;
  J: TMPGlyph;
  ResName: array[0..40] of Char;
begin
  MinBtnSize := Point(0, 0);
  for I := Low(Buttons) to High(Buttons) do
  begin
    for J := Low(TMPGlyph) to High(TMPGlyph) do
    begin
      Buttons[I].Bitmaps[J] := TBitmap.Create;
      Buttons[I].Bitmaps[J].Handle := LoadBitmap(HInstance,
        StrFmt(ResName, '%s_%s', [BtnStateName[J], BtnTypeName[I]]));
      if MinBtnSize.X < Buttons[I].Bitmaps[J].Width then
        MinBtnSize.X := Buttons[I].Bitmaps[J].Width;
      if MinBtnSize.Y < Buttons[I].Bitmaps[J].Height then
        MinBtnSize.Y := Buttons[I].Bitmaps[J].Height;
    end;
  end;
  Inc(MinBtnSize.X, 2 * 4);
  Inc(MinBtnSize.Y, 2 * 2);
end;

procedure TMediaPlayer.DestroyBitmaps;
var
  I: TMPBtnType;
  J: TMPGlyph;
begin
  for I := Low(Buttons) to High(Buttons) do
    for J := Low(TMPGlyph) to High(TMPGlyph) do
      Buttons[I].Bitmaps[J].Free;
end;


procedure TMediaPlayer.SetAutoEnable(Value: Boolean);
begin
  if Value <> FAutoEnable then
  begin
    FAutoEnable := Value;
    if FAutoEnable then
      DrawAutoButtons  {paint buttons based on current state of device}
    else
      SetEnabledButtons(FEnabledButtons);  {paint buttons based on Enabled}
  end;
end;

procedure TMediaPlayer.SetEnabledButtons(Value: TButtonSet);
var
  I: TMPBtnType;
begin
  FEnabledButtons := Value;
  for I := Low(Buttons) to High(Buttons) do
    Buttons[I].Enabled := I in FEnabledButtons;
  Invalidate;
end;

procedure TMediaPlayer.DrawAutoButtons;
var
  I: TMPBtnType;
begin
  for I := Low(Buttons) to High(Buttons) do
    Buttons[I].Auto := I in FAutoButtons;
  Invalidate;
end;

procedure TMediaPlayer.SetColored(Value: TButtonSet);
var
  I: TMPBtnType;
begin
  FColoredButtons := Value;
  for I := Low(Buttons) to High(Buttons) do
    Buttons[I].Colored := I in FColoredButtons;
  Invalidate;
end;

procedure TMediaPlayer.SetVisible(Value: TButtonSet);
var
  I: TMPBtnType;
begin
  FVisibleButtons := Value;
  for I := Low(Buttons) to High(Buttons) do
    Buttons[I].Visible := I in FVisibleButtons;
  if csUpdating in ComponentState then
  begin
    ButtonWidth := ((Width - 1) div VisibleButtonCount) + 1;
    Invalidate;
  end
  else Adjust;
end;

function TMediaPlayer.VisibleButtonCount: Integer;
var
  I: TMPBtnType;
begin
  Result := 0;
  for I := Low(Buttons) to High(Buttons) do
    if Buttons[I].Visible then Inc(Result);
  if Result = 0 then Inc(Result);
end;

procedure TMediaPlayer.Adjust;
var
  Count: Integer;
begin
  Count := VisibleButtonCount;
  Width := Count * (ButtonWidth - 1) + 1;
  Invalidate;