mplayer.pas

这是不可多得的源代码

end;

procedure TMediaPlayer.WMSize(var Message: TWMSize);
var
  Count: Integer;
  MinSize: TPoint;
  W, H: Integer;
begin
  inherited;
  if not (csUpdating in ComponentState) then
  begin
    { check for minimum size }
    Count := VisibleButtonCount;
    MinSize.X := Count * (MinBtnSize.X - 1) + 1;
    MinSize.Y := MinBtnSize.Y;
    ButtonWidth := ((Width - 1) div Count) + 1;

    W := Count * (ButtonWidth - 1) + 1;
    if W < MinSize.X then W := MinSize.X;
    if Height < MinSize.Y then H := MinSize.Y
    else H := Height;

    if (W <> Width) or (H <> Height) then
      SetBounds(Left, Top, W, H);

    Message.Result := 0;
  end;
end;

procedure TMediaPlayer.DrawButton(Btn: TMPBtnType; X: Integer);
var
  IsDown: Boolean;
  BX, BY: Integer;
  TheGlyph: TMPGlyph;
  Bitmap: TBitmap;
  R: TRect;
begin
  IsDown := Down and (Btn = CurrentButton);
  with Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := clBtnFace;
    Pen.Color := clWindowFrame;
    Pen.Width := 1;
    Rectangle(X, 0, X + ButtonWidth, Height);

    { draw button beveling }
    if IsDown then
    begin
      Pen.Color := clBtnShadow;
      MoveTo(X + 1, Height - 2);
      LineTo(X + 1, 1);
      LineTo(X + ButtonWidth - 1, 1);
    end
    else
    begin
      Pen.Color := clBtnHighlight;
      MoveTo(X + 1, Height - 2);
      LineTo(X + 1, 1);
      LineTo(X + ButtonWidth - 1, 1);
      Pen.Color := clBtnShadow;
      MoveTo(X + 2, Height - 2);
      LineTo(X + ButtonWidth - 2, Height - 2);
      LineTo(X + ButtonWidth - 2, 1);
    end;

    {which bitmap logic - based on Enabled, Colored, and AutoEnable}
    if Enabled or (csDesigning in ComponentState) then
    begin  {Enabled only affects buttons at runtime}
      if FAutoEnable and not (csDesigning in ComponentState) then
      begin  {AutoEnable only affects buttons at runtime}
        if Buttons[Btn].Auto then {is button available, based on device state}
        begin
          TheGlyph := mgEnabled;
          if Buttons[Btn].Colored then
            TheGlyph := mgColored;
        end
        else TheGlyph := mgDisabled;  {button is not available}
      end
      else  {when not AutoEnabled or at design-time, check Enabled}
      begin
        if Buttons[Btn].Enabled then
        begin
          TheGlyph := mgEnabled;
          if Buttons[Btn].Colored then
            TheGlyph := mgColored;
        end
        else TheGlyph := mgDisabled;
      end;
    end
    else TheGlyph := mgDisabled; {main switch set to disabled}

    Bitmap := Buttons[Btn].Bitmaps[TheGlyph];
    BX := (ButtonWidth div 2) - (Bitmap.Width div 2);
    BY := (Height div 2) - (Bitmap.Height div 2);
    if IsDown then
    begin
      Inc(BX);
      Inc(BY);
    end;
    BrushCopy(Bounds(X + BX, BY, Bitmap.Width, Bitmap.Height),
      Bitmap, Rect(0, 0, Bitmap.Width, Bitmap.Height), clOlive);
  end;

  if (GetFocus = Handle) and (Btn = FocusedButton) then
  begin
    R := Bounds(X, 0, ButtonWidth, Height);
    InflateRect(R, -3, -3);
    if IsDown then OffsetRect(R, 1, 1);
    DrawFocusRect(Canvas.Handle, R);
  end;
end;

procedure TMediaPlayer.Paint;
var
  X: Integer;
  I: TMPBtnType;
begin
  with Canvas do
  begin
    Brush.Style := bsClear;
    Pen.Color := clWindowFrame;
    Pen.Width := 1;
    Rectangle(0, 0, Width, Height);

    X := 0;
    for I := Low(Buttons) to High(Buttons) do
    begin
      if Buttons[I].Visible then
      begin
        DrawButton(I, X);
        Inc(X, ButtonWidth - 1);
      end;
    end;
  end;
end;

{AutoEnable=True, enable/disable button set based on button passed (pressed)}
procedure TMediaPlayer.AutoButtonSet(Btn: TMPBtnType);
begin
  case Btn of
    btPlay:
    begin
      FAutoButtons := FAutoButtons - [btPlay,btRecord];
      FAutoButtons := FAutoButtons + [btStop,btPause];
    end;
    btPause:
    begin
      if FCanPlay then Include(FAutoButtons,btPlay);
      if FCanRecord then Include(FAutoButtons,btRecord);
    end;
    btStop:
    begin
      if FCanPlay then Include(FAutoButtons,btPlay);
      if FCanRecord then Include(FAutoButtons,btRecord);
      FAutoButtons := FAutoButtons - [btStop,btPause];
    end;
    btNext:
    begin
      if FCanPlay then Include(FAutoButtons,btPlay);
      if FCanRecord then Include(FAutoButtons,btRecord);
      FAutoButtons := FAutoButtons - [btStop,btPause];
    end;
    btPrev:
    begin
      if FCanPlay then Include(FAutoButtons,btPlay);
      if FCanRecord then Include(FAutoButtons,btRecord);
      FAutoButtons := FAutoButtons - [btStop,btPause];
    end;
    btStep:
    begin
      if FCanPlay then Include(FAutoButtons,btPlay);
      if FCanRecord then Include(FAutoButtons,btRecord);
      FAutoButtons := FAutoButtons - [btStop,btPause];
    end;
    btBack:
    begin
      if FCanPlay then Include(FAutoButtons,btPlay);
      if FCanRecord then Include(FAutoButtons,btRecord);
      FAutoButtons := FAutoButtons - [btStop,btPause];
    end;
    btRecord:
    begin
      FAutoButtons := FAutoButtons - [btPlay,btRecord];
      FAutoButtons := FAutoButtons + [btStop,btPause];
    end;
    btEject: {without polling no way to determine when CD is inserted}
    begin
      if FCanPlay then Include(FAutoButtons,btPlay);
      if FCanRecord then Include(FAutoButtons,btRecord);
      FAutoButtons := FAutoButtons - [btStop,btPause];
    end;
  end;
end;
      
procedure TMediaPlayer.DoMouseDown(XPos, YPos: Integer);
var
  I: TMPBtnType;
  X: Integer;
begin
  {which button was clicked}
  X := 0;
  for I := Low(Buttons) to High(Buttons) do
  begin
    if Buttons[I].Visible then
    begin
      if (XPos >= X) and (XPos <= X + ButtonWidth) then
      begin
        if FAutoEnable then
          if Buttons[I].Auto then Break
          else Exit;
        if Buttons[I].Enabled then Break
        else Exit;
      end;
      Inc(X, ButtonWidth - 1);
    end;
  end;
  CurrentButton := I;
  if CurrentButton <> FocusedButton then
  begin
    FocusedButton := CurrentButton;
    Paint;
  end;
  CurrentRect := Rect(X, 0, X + ButtonWidth, Height);
  Pressed := True;
  Down := True;
  DrawButton(I, X);
  MouseCapture := True;
end;

procedure TMediaPlayer.WMLButtonDown(var Message: TWMLButtonDown);
begin
  DoMouseDown(Message.XPos, Message.YPos);
end;

procedure TMediaPlayer.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  DoMouseDown(Message.XPos, Message.YPos);
end;

procedure TMediaPlayer.WMMouseMove(var Message: TWMMouseMove);
var
  P: TPoint;
begin
  if Pressed then
  begin
    P := Point(Message.XPos, Message.YPos);
    if PtInRect(CurrentRect, P) <> Down then
    begin
      Down := not Down;
      DrawButton(CurrentButton, CurrentRect.Left);
    end;
  end;
end;

procedure TMediaPlayer.DoClick(Button: TMPBtnType);
var
  DoDefault: Boolean;
begin
  DoDefault := True;
  Click(CurrentButton, DoDefault);
  if DoDefault then
  begin
    case CurrentButton of
      btPlay: Play;
      btPause: Pause;
      btStop: Stop;
      btNext: Next;
      btPrev: Previous;
      btStep: Step;
      btBack: Back;
      btRecord: StartRecording;
      btEject: Eject;
    end;
    DoPostClick(CurrentButton);
  end;
end;

procedure TMediaPlayer.DoPostClick(Button: TMPBtnType);
begin
  PostClick(CurrentButton);
end;

procedure TMediaPlayer.WMLButtonUp(var Message: TWMLButtonUp);
begin
  MouseCapture := False;
  if Pressed and Down then
  begin
    Down := False;
    DrawButton(CurrentButton, CurrentRect.Left);  {raise button before calling code}
    DoClick(CurrentButton);
    if FAutoEnable and (FError = 0) and MCIOpened then
    begin
      AutoButtonSet(CurrentButton);
      DrawAutoButtons;
    end;
  end;
  Pressed := False;
end;

procedure TMediaPlayer.WMSetFocus(var Message: TWMSetFocus);
begin
  Paint;
end;

procedure TMediaPlayer.WMKillFocus(var Message: TWMKillFocus);
begin
  Paint;
end;

procedure TMediaPlayer.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  Message.Result := DLGC_WANTARROWS;
end;

procedure TMediaPlayer.KeyDown(var Key: Word; Shift: TShiftState);
var
  NewFocus: TMPBtnType;
begin
  case Key of
    VK_RIGHT:
      begin
        NewFocus := FocusedButton;
        repeat
          if NewFocus < High(Buttons) then
            NewFocus := Succ(NewFocus);
        until (NewFocus = High(Buttons)) or (Buttons[NewFocus].Visible);
        if NewFocus <> FocusedButton then
        begin
          FocusedButton := NewFocus;
          Invalidate;
        end;
      end;
    VK_LEFT:
      begin
        NewFocus := FocusedButton;
        repeat
          if NewFocus > Low(Buttons) then
            NewFocus := Pred(NewFocus);
        until (NewFocus = Low(Buttons)) or (Buttons[NewFocus].Visible);
        if NewFocus <> FocusedButton then
        begin
          FocusedButton := NewFocus;
          Invalidate;
        end;
      end;
    VK_SPACE:
      begin
        if Buttons[FocusedButton].Enabled then
        begin
          CurrentButton := FocusedButton;
          DoClick(CurrentButton);
          if FAutoEnable then
          begin
            AutoButtonSet(CurrentButton);
            DrawAutoButtons;
          end;
        end;
      end;
  end;
end;

{MCI message generated when Notify=True, and MCI command completes}
procedure TMediaPlayer.MMNotify(var Message: TMessage);
begin
  if FAutoEnable and (Mode = mpStopped) then
  begin {special AutoEnable case for when Play and Record finish}
    if FCanPlay then Include(FAutoButtons,btPlay);
    if FCanRecord then Include(FAutoButtons,btRecord);
    FAutoButtons := FAutoButtons - [btStop,btPause];
    DrawAutoButtons;
  end;
  case Message.WParam of
    mci_Notify_Successful: FNotifyValue := nvSuccessful;
    mci_Notify_Superseded: FNotifyValue := nvSuperseded;
    mci_Notify_Aborted: FNotifyValue := nvAborted;
    mci_Notify_Failure: FNotifyValue := nvFailure;
  end;
  DoNotify;
end;

{for MCI Commands to make sure device is open, else raise exception}
procedure TMediaPlayer.CheckIfOpen;
begin
  if not MCIOpened then raise EMCIDeviceError.CreateRes(@sNotOpenErr);
end;

procedure TMediaPlayer.Click(Button: TMPBtnType; var DoDefault: Boolean);
begin
  if Assigned(FOnCLick) then FOnClick(Self, Button, DoDefault);
end;

procedure TMediaPlayer.PostClick(Button: TMPBtnType);
begin
  if Assigned(FOnPostCLick) then FOnPostClick(Self, Button);
end;