⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 maindemo_.pas

📁 toi co the nghe nhac bang choung trinh nay phgan 2
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{(((((((((((((((((((((((((((((((((((((((O))))))))))))))))))))))))))))))))))))))}
{                                                                              }
{                             TActiveMovie main demo                           }
{                          Copyright (c) 2003 Datastead                        }
{                               All rights reserved.                           }
{                                                                              }
{                          contact: support@Datastead.com                      }
{                        support: http://www.Datastead.com                     }
{                                                                              }
{(((((((((((((((((((((((((((((((((((((((O))))))))))))))))))))))))))))))))))))))}

unit MainDemo_;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, Buttons, ExtCtrls, AMovie;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    SpeedButton1: TSpeedButton;
    Button2: TButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    TrackBar1: TTrackBar;
    Label1: TLabel;
    Label2: TLabel;
    TrackBar4: TTrackBar;
    Label3: TLabel;
    Button3: TButton;
    TrackBar2: TTrackBar;
    OpenDialog1: TOpenDialog;
    Button4: TButton;
    RadioGroup1: TRadioGroup;
    TrackBar6: TTrackBar;
    TrackBar7: TTrackBar;
    Label14: TLabel;
    GroupBox4: TGroupBox;
    CheckBox1: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox4: TCheckBox;
    ActiveMovie1: TActiveMovie;
    CheckBox5: TCheckBox;
    Label15: TLabel;
    BitBtn1: TBitBtn;
    Button5: TButton;
    CheckBox6: TCheckBox;
    GroupBox5: TGroupBox;
    Edit2: TEdit;
    UpDown1: TUpDown;
    Edit3: TEdit;
    UpDown2: TUpDown;
    Label16: TLabel;
    Label17: TLabel;
    TrackBar3: TTrackBar;
    Label18: TLabel;
    TrackBar5: TTrackBar;
    Label19: TLabel;
    StatusBar1: TStatusBar;
    Button6: TButton;
    GroupBox1: TGroupBox;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label4: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    SpeedButton7: TSpeedButton;
    procedure Button1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure TrackBar2Change(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure TrackBar4Change(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure CheckBox3Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TrackBar3Change(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure ActiveMovie1PositionChange(Sender: TObject; OldTimePosition,
      NewTimePosition: Double; OldFramePosition,
      NewFramePosition: Cardinal);
    procedure TrackBar5Change(Sender: TObject);
    procedure TrackBar7Change(Sender: TObject);
    procedure TrackBar6Change(Sender: TObject);
    procedure CheckBox4Click(Sender: TObject);
    procedure CheckBox5Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure ActiveMovie1OpenStateChange(Sender: TObject; OldState,
      NewState: Integer);
    procedure CheckBox6Click(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure Edit3Change(Sender: TObject);
    procedure ActiveMovie1Error(Sender: TObject; ErrorCode: Integer;
      ErrorMessage: String);
    procedure Button6Click(Sender: TObject);
    procedure ActiveMovie1FullScreenKeyPress(Sender: TObject; Key: Word;
      Shift: TShiftState);
    procedure SpeedButton7Click(Sender: TObject);
  private
    procedure SetAnchorsIfNotD3OrBCB3;
  public
  end;

var
  Form1: TForm1;
  StillForm: TForm = nil;
  StillImage: TImage;

implementation

{$R *.DFM}

//------------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
//------------------------------------------------------------------------------
begin
   SetAnchorsIfNotD3OrBCB3;

   if FileExists ('demo.mpeg') then begin
      Edit1.Text := ExpandFileName ('demo.mpeg');
   end;
   CheckBox2.Checked := ActiveMovie1.ShowControls;
   CheckBox3.Checked := ActiveMovie1.DisplayLogo;
   CheckBox4.Checked := ActiveMovie1.AutoStart;
   CheckBox5.Checked := ActiveMovie1.ShowScrollBars;
   CheckBox6.Checked := ActiveMovie1.Visible;
   TrackBar1Change (Self);
end;

//------------------------------------------------------------------------------
procedure TForm1.ActiveMovie1PositionChange(Sender: TObject;
  OldTimePosition, NewTimePosition: Double; OldFramePosition,
  NewFramePosition: Cardinal);
//------------------------------------------------------------------------------
begin
   // DON'T FORGET TO CHECK IF TOTALTIME > 0 to divide by TotalTime, because this value
   // may be 0 if the total time is unknown (e.g. with stream medias, like web radios).
   if ActiveMovie1.TotalTime > 0 then begin
      if TrackBar5.Tag = 0 then begin
         TrackBar5.Tag := 1;
         TrackBar5.Position := Trunc (NewTimePosition * TrackBar5.Max / ActiveMovie1.TotalTime);
         TrackBar5.Tag := 0;
      end;
   end;
end;

//------------------------------------------------------------------------------
procedure TForm1.ActiveMovie1OpenStateChange(Sender: TObject; OldState,
  NewState: Integer);
//------------------------------------------------------------------------------
begin
   if NewState = nsOpen then begin
      BitBtn1.Enabled := True;
   end
   else begin
      BitBtn1.Enabled := False;
   end;
end;

//------------------------------------------------------------------------------
procedure TForm1.ActiveMovie1Error(Sender: TObject; ErrorCode: Integer;
  ErrorMessage: String);
//------------------------------------------------------------------------------
begin
   {$IFNDEF VER100}
   StatusBar1.Color := clRed;
   {$ENDIF}
   Windows.Beep (500, 300);
   {$IFNDEF VER100}
   StatusBar1.ParentColor := True;
   {$ENDIF}
   StatusBar1.SimpleText  := ' ' + Format (' Error %08x: %s', [ErrorCode, ErrorMessage]);
end;

//------------------------------------------------------------------------------
procedure TForm1.ActiveMovie1FullScreenKeyPress(Sender: TObject; Key: Word; Shift: TShiftState);
//------------------------------------------------------------------------------
const
   F2 = 113; F3 = 114; F4 = 115; F5 = 116; F6 = 117; F7 = 118; F8 = 119; F11 = 122; F12 = 123;
   UP = true; DOWN = false;
var
   VolumeStep: Integer;
begin
   With ActiveMovie1 do begin
      VolumeStep := 100;
      case Key of
         F2: Play;
         F3: Pause;
         F4: Stop;
         F5: FastForward2 (10);
         F6: FastReverse2 (10);
         F7: Rate := Rate + 0.2;
         F8: begin
                if Rate > 0.6 then begin
                   Rate := Rate - 0.2;
                end;
             end;
         F11: if (Volume + VolumeStep) <= 0 then Volume := Volume + VolumeStep else Volume := 0; // MAX
         F12: if (Volume + VolumeStep) > -10000 then Volume := Volume - VolumeStep else Volume := - 10000; // MIN
      end;
   end;
end;

//------------------------------------------------------------------------------
procedure TForm1.BitBtn1Click(Sender: TObject);
//------------------------------------------------------------------------------
begin
   if not assigned (StillForm) then begin
      Application.CreateForm (TForm, StillForm);
      StillForm.HorzScrollBar.Visible := false;
      StillForm.VertScrollBar.Visible := false;
      StillForm.Position := poDefault;
      StillForm.FormStyle := fsStayOnTop;
      StillImage := TImage.Create (StillForm);
      StillImage.Parent := StillForm;
   end;

   if ActiveMovie1.CaptureFrameToImage (StillImage) then begin
      StillForm.ClientWidth := StillImage.Width;
      StillForm.ClientHeight := StillImage.Height;
      StillForm.Show;
   end;
end;

//------------------------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
//------------------------------------------------------------------------------
begin
   ActiveMovie1.FileName := Edit1.Text;
   ActiveMovie1.Open;
end;

//------------------------------------------------------------------------------
procedure TForm1.Button2Click(Sender: TObject);
//------------------------------------------------------------------------------
begin
   ActiveMovie1.Close;
end;

//------------------------------------------------------------------------------

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -