main.~pas

拍摄程序,用来控制摄像机拍摄照片。拍摄程序,用来控制摄像机拍摄照片。拍摄程序,用来控制摄像机拍摄照片。

{   MPUI, an MPlayer frontend for Windows
    Copyright (C) 2005 Martin J. Fiedler <[e-mail]>

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
}
unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, Buttons, ExtCtrls, Menus, ShellAPI, AppEvnts, StdCtrls,
  Math, plist, ImgList, Clipbrd, ToolWin;

function SetThreadExecutionState(esFlags:Cardinal):Cardinal; stdcall; external 'kernel32.dll';  
const
    ES_SYSTEM_REQUIRED  = $01;
    ES_DISPLAY_REQUIRED = $02;
const
    VK_MEDIA_NEXT_TRACK = $B0;
    VK_MEDIA_PREV_TRACK = $B1;
    VK_MEDIA_STOP       = $B2;
    VK_MEDIA_PLAY_PAUSE = $B3;

type
  TMainForm = class(TForm)
    MainMenu: TMainMenu;
    OMFile: TMenuItem;
    ControlPanel: TPanel;
    BPlay: TSpeedButton;
    BPause: TSpeedButton;
    UpdateTimer: TTimer;
    SeekBarFrame: TPanel;
    SeekBarSlider: TPanel;
    MOpenFile: TMenuItem;
    MClose: TMenuItem;
    N1: TMenuItem;
    MQuit: TMenuItem;
    OMView: TMenuItem;
    MSize50: TMenuItem;
    MSize100: TMenuItem;
    MSize200: TMenuItem;
    MFullscreen: TMenuItem;
    OMSeek: TMenuItem;
    MSeekF10: TMenuItem;
    MSeekR10: TMenuItem;
    MSeekF60: TMenuItem;
    MSeekR60: TMenuItem;
    MSeekF600: TMenuItem;
    MSeekR600: TMenuItem;
    N2: TMenuItem;
    MPause: TMenuItem;
    MPlay: TMenuItem;
    N3: TMenuItem;
    MOptions: TMenuItem;
    MOSD: TMenuItem;
    MSizeAny: TMenuItem;
    MOpenURL: TMenuItem;
    MOnTop: TMenuItem;
    OMHelp: TMenuItem;
    MAbout: TMenuItem;
    MKeyHelp: TMenuItem;
    MShowOutput: TMenuItem;
    OMExtra: TMenuItem;
    N4: TMenuItem;
    MLanguage: TMenuItem;
    BFullscreen: TSpeedButton;
    BStreamInfo: TSpeedButton;
    MAudio: TMenuItem;
    N5: TMenuItem;
    MSubtitle: TMenuItem;
    MDeinterlace: TMenuItem;
    MOpenDrive: TMenuItem;
    MNoDeint: TMenuItem;
    MSimpleDeint: TMenuItem;
    MAdaptiveDeint: TMenuItem;
    OpenDialog: TOpenDialog;
    MAspect: TMenuItem;
    MAutoAspect: TMenuItem;
    MForce43: TMenuItem;
    MForce169: TMenuItem;
    MForceCinemascope: TMenuItem;
    OuterPanel: TPanel;
    Logo: TImage;
    InnerPanel: TPanel;
    LEscape: TLabel;
    BPrev: TSpeedButton;
    BNext: TSpeedButton;
    MPrev: TMenuItem;
    MNext: TMenuItem;
    MShowPlaylist: TMenuItem;
    N6: TMenuItem;
    BStop: TSpeedButton;
    BPlaylist: TSpeedButton;
    PStatus: TPanel;
    LTime: TLabel;
    Imagery: TImageList;
    SeekBar: TPanel;
    VolFrame: TPanel;
    VolSlider: TPanel;
    BMute: TSpeedButton;
    VolImage: TImage;
    N7: TMenuItem;
    MMute: TMenuItem;
    MStreamInfo: TMenuItem;
    VolBoost: TPanel;
    BCompact: TSpeedButton;
    MCompact: TMenuItem;
    MPopup: TPopupMenu;
    MPPause: TMenuItem;
    MPPrev: TMenuItem;
    MPNext: TMenuItem;
    N8: TMenuItem;
    MPFullscreen: TMenuItem;
    MPCompact: TMenuItem;
    MPOnTop: TMenuItem;
    OSDMenu: TMenuItem;
    MNoOSD: TMenuItem;
    MDefaultOSD: TMenuItem;
    MTimeOSD: TMenuItem;
    MFullOSD: TMenuItem;
    N9: TMenuItem;
    MPQuit: TMenuItem;
    MPPlay: TMenuItem;
    MPStop: TMenuItem;
    N10: TMenuItem;
    MStop: TMenuItem;
    MPFullscreenControls: TMenuItem;
    LStatus: TLabel;
    MenuBar: TToolBar;
    MFile: TToolButton;
    MView: TToolButton;
    MSeek: TToolButton;
    MExtra: TToolButton;
    MHelp: TToolButton;
    BCamConfig: TSpeedButton;
    BRecordVideo: TSpeedButton;
    Label1: TLabel;
    Timer1: TTimer;
    SpeedButton1: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BPlayClick(Sender: TObject);
    procedure BPauseClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure UpdateTimerTimer(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure SeekBarSliderMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SeekBarSliderMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SeekBarSliderMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure SeekBarFrameMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SimulateKey(Sender: TObject);
    procedure MSizeClick(Sender: TObject);
    procedure MShowOutputClick(Sender: TObject);
    procedure MOSDClick(Sender: TObject);
    procedure MCloseClick(Sender: TObject);
    procedure MAudioClick(Sender: TObject);
    procedure MSubtitleClick(Sender: TObject);
    procedure UpdateMenus(Sender: TObject);
    procedure MDeinterlaceClick(Sender: TObject);
    procedure MOpenFileClick(Sender: TObject);
    procedure MOpenURLClick(Sender: TObject);
    procedure MOpenDriveClick(Sender: TObject);
    procedure MKeyHelpClick(Sender: TObject);
    procedure MAboutClick(Sender: TObject);
    procedure MLanguageClick(Sender: TObject);
    procedure MAspectClick(Sender: TObject);
    procedure MOptionsClick(Sender: TObject);
    procedure MPauseClick(Sender: TObject);
    procedure BPrevNextClick(Sender: TObject);
    procedure MShowPlaylistClick(Sender: TObject);
    procedure BStopClick(Sender: TObject);
    procedure SeekBarMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure VolSliderMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure VolSliderMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure VolSliderMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BMuteClick(Sender: TObject);
    procedure MStreamInfoClick(Sender: TObject);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure DisplayMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DisplayDblClick(Sender: TObject);
    procedure MPopupPopup(Sender: TObject);
    procedure OuterPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ControlPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure MPFullscreenControlsClick(Sender: TObject);
    procedure LStatusClick(Sender: TObject);
    procedure VolBoostClick(Sender: TObject);
    procedure BRecordVideoClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private declarations }
    FirstShow:boolean;
    Seeking:boolean;
    SeekMouseX,SeekBaseX:integer;
    ControlledResize:boolean;
    FS_PX,FS_PY,FS_SX,FS_SY:integer; FS_WasTopmost:boolean;
    FirstParameter:integer;
    ScreenSaverActive:Cardinal;
    FullscreenControls:boolean;
    DisableFullscreenControlsAt:Cardinal;
    ShowLogoAt:Cardinal;
    EnablePositionQueries:boolean;
    procedure OpenDroppedFile(Sender: TObject; var Done: Boolean);
    procedure FormDropFiles(var msg:TMessage); message WM_DROPFILES;
    procedure Init_MOpenDrive;
    procedure Init_MLanguage;
    procedure FormGetMinMaxInfo(var msg:TMessage); message WM_GETMINMAXINFO;
    procedure FormMove(var msg:TMessage); message WM_MOVE;
    procedure FormWantSpecialKey(var msg:TCMWantSpecialKey); message CM_WANTSPECIALKEY;
  public
    { Public declarations }
    WantCompact:boolean;
    WantFullscreen:boolean;
    AutoQuit:boolean;
    Fullscreen:boolean;
    Compact:boolean;
    procedure QueryPosition;
    procedure FixSize;
    procedure SetupStart;
    procedure SetupPlay;
    procedure SetupStop(Explicit:boolean);
    procedure UpdateSeekBar;
    procedure Unpaused;
    procedure VideoSizeChanged;
    procedure DoOpen(const URL:string);
    procedure ToggleAlwaysOnTop;
    procedure SetFullscreen(Mode:boolean);
    procedure SetCompact(Mode:boolean);
    procedure NextAudio;
    procedure NextFile(Direction:integer; ExitState:TPlaybackState);
    procedure OpenSingleItem(const URL:string);
    procedure UpdateStatus;
    procedure UpdateTime;
    procedure UpdateCaption;
    procedure SetVolumeRel(Increment:integer);
    procedure UpdateDockedWindows;
    procedure Localize;
    procedure SetFullscreenControls(Mode:boolean);
    procedure SetMouseVisible(Mode:boolean);
  end;

var
  MainForm: TMainForm;

implementation
uses Locale, Core, Config, Log, URL, Help, About, Options, Info;

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);
  function CheckOption(OPTN:string):boolean; begin
    OPTN:=LowerCase(OPTN); Result:=False;
    if OPTN='-fs' then begin WantFullscreen:=True; Result:=True; end;
    if OPTN='-compact' then begin WantCompact:=True; Result:=True; end;
    if OPTN='-autoquit' then begin AutoQuit:=True; Result:=True; end;
  end;
begin
//AllocConsole;
  randomize();
{$IFDEF VER150}
  // some fixes for Delphi>=7 VCLs
  OuterPanel.ParentBackground:=False;
  InnerPanel.ParentBackground:=False;
  PStatus.ParentBackground:=False;
  SeekBar.ParentBackground:=False;
{$ENDIF}
  EnablePositionQueries:=false;
  FirstShow:=true;
  Seeking:=false;
  WantFullscreen:=false;
  WantCompact:=false;
  AutoQuit:=false;
  Core.Init;
  Config.Load(HomeDir+'autorun.inf');
  Config.Load(HomeDir+DefaultFileName);
  Init_MOpenDrive;
  Init_MLanguage;
  with Logo do ControlStyle:=ControlStyle+[csOpaque];
  with InnerPanel do ControlStyle:=ControlStyle+[csOpaque];
  FirstParameter:=1;
  while CheckOption(ParamStr(FirstParameter)) do inc(FirstParameter);
  Fullscreen:=false; Compact:=False;
  FullscreenControls:=false;
  ControlledResize:=true;
  ShowLogoAt:=0;
  if WantCompact then SetCompact(True);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  Core.ForceStop;
end;

procedure TMainForm.DoOpen(const URL:string);
begin
  Core.ForceStop;
  Sleep(50); // wait for the processing threads to finish
  Application.ProcessMessages;  // let the VCL process the finish messages
  Core.MediaURL:=MakeURL(URL,Core.DisplayURL);
  UpdateCaption;
  Core.FirstOpen:=true;
  Core.Start;
end;

procedure TMainForm.BPlayClick(Sender: TObject);
begin
  BPlay.Down:=Core.Running;
  if Core.Running AND BPause.Down then begin
    SendCommand('pause');
    Unpaused;
  end else if not Core.Running then
    NextFile(0,psPlaying);
end;

procedure TMainForm.BPauseClick(Sender: TObject);
begin
  if not Core.Running then begin
    BPause.Down:=false; exit;
  end;
  BPause.Down:=True;
  EnablePositionQueries:=False;
  if Core.Status=sPaused then begin
    SendCommand('frame_step');
  end else begin
    SendCommand('pause');
    Core.Status:=sPaused;
    UpdateStatus;
  end;
end;


procedure TMainForm.SetVolumeRel(Increment:integer);
begin
  if (Core.Volume>100) OR ((Core.Volume=100) AND (Increment>0))
    then Increment:=Increment*10 DIV 3;  // bigger volume change steps if >100%
  inc(Core.Volume, Increment);
  if Core.Volume<0 then Core.Volume:=0;
  if (Core.Volume>100) AND not(Core.SoftVol) then Core.Volume:=100;
  if Core.Volume>9999 then Core.Volume:=9999;
  Core.SendVolumeChangeCommand(Core.Volume);
  Unpaused;
  if Core.Volume>100 then begin
    VolBoost.Visible:=True;
    VolBoost.Caption:=IntToStr(Core.Volume)+'%';
  end else begin
    VolBoost.Visible:=False;
    VolSlider.Left:=Core.Volume*(VolFrame.ClientWidth-VolSlider.Width) DIV 100;
  end;
end;


procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
  procedure HandleCommand(const Command:string); begin
    Core.SendCommand(Command);
    Unpaused;
  end;
  procedure HandleSeekCommand(const Command:string); begin
    HandleCommand(Command);
    QueryPosition;
  end;
begin
  if Key=VK_ESCAPE then begin
    if Fullscreen then Key:=Ord('F')
    else if Compact then Key:=Ord('C');
  end;
if ssCtrl in Shift then begin
  case Key of
    Ord('0'):   HandleCommand('speed_set 1.0');
    VK_DIVIDE:  HandleCommand('speed_mult 0.9090909');
    VK_MULTIPLY:HandleCommand('speed_mult 1.1');
    Ord('O'):   MOpenFileClick(nil);
    Ord('L'):   MOpenURLClick(nil);
    Ord('W'):   MCloseClick(nil);
  end;
end else if ssAlt in Shift then begin
  case Key of
    Ord('0'):   MSizeAny.Checked:=True;
    Ord('1'):   MSizeClick(MSize50);
    Ord('2'):   MSizeClick(MSize100);
    Ord('3'):   MSizeClick(MSize200);
    Ord('4'):   MFile.CheckMenuDropdown;
    Ord('5'):   MView.CheckMenuDropdown;
    Ord('6'):   MSeek.CheckMenuDropdown;
    Ord('7'):   MExtra.CheckMenuDropdown;
    Ord('8'):   MHelp.CheckMenuDropdown;
    VK_F4:      Close;
    VK_RETURN:  SetFullscreen(not(Fullscreen));
  end;
end else begin
  case Key of
    VK_RIGHT:   HandleSeekCommand('seek +10');
    VK_LEFT:    HandleSeekCommand('seek -10');
    VK_UP:      HandleSeekCommand('seek +60');
    VK_DOWN:    HandleSeekCommand('seek -60');
    VK_PRIOR:   HandleSeekCommand('seek +600');
    VK_NEXT:    HandleSeekCommand('seek -600');
    VK_SUBTRACT:HandleCommand('audio_delay 0.100');
    VK_ADD:     HandleCommand('audio_delay -0.100');
    Ord('M'):   BMuteClick(nil);
    Ord('9'):   SetVolumeRel(-3);
    Ord('0'):   SetVolumeRel(+3);
    VK_DIVIDE:  SetVolumeRel(-3);
    VK_MULTIPLY:SetVolumeRel(+3);
    Ord('O'):   begin SetOSDLevel(-1); Unpaused; end;
    Ord('1'):   HandleCommand('contrast -1');
    Ord('2'):   HandleCommand('contrast +1');
    Ord('3'):   HandleCommand('brightness -1');
    Ord('4'):   HandleCommand('brightness +1');
    Ord('5'):   HandleCommand('hue -1');
    Ord('6'):   HandleCommand('hue +1');
    Ord('7'):   HandleCommand('saturation -1');
    Ord('8'):   HandleCommand('saturation +1');
    Ord('D'):   HandleCommand('frame_drop');
    Ord('F'):   SetFullscreen(not(Fullscreen));
    Ord('C'):   SetCompact(not(Compact));
    Ord('T'):   ToggleAlwaysOnTop;
    Ord('S'):   HandleCommand('screenshot');
    Ord('L'):   MShowPlaylistClick(nil);
    191:        NextAudio;
    Ord('Q'):   Close;
    VK_RETURN:  BPlayClick(nil);
    Ord('P'),VK_SPACE:if BPause.Down then BPlayClick(nil) else MPauseClick(nil);   
    VK_TAB:     MPFullscreenControlsClick(nil);
    VK_MEDIA_PLAY_PAUSE:if Core.Running then MPauseClick(nil) else BPlayClick(nil);
    VK_MEDIA_STOP:      if BStop.Enabled then BStopClick(nil);
    VK_MEDIA_PREV_TRACK:if BPrev.Enabled then BPrevNextClick(BPrev);
    VK_MEDIA_NEXT_TRACK:if BNext.Enabled then BPrevNextClick(BNext);
  end;
end;
  Key:=0;
end;

procedure TMainForm.UpdateTimerTimer(Sender: TObject);
var Now:Cardinal;
begin
  Now:=GetTickCount();
  if EnablePositionQueries then QueryPosition;
  if FullscreenControls AND (Now>=DisableFullscreenControlsAt) then
    SetFullscreenControls(False);
  if Core.Running then begin
    if HaveVideo then SetThreadExecutionState(ES_DISPLAY_REQUIRED)
                 else SetThreadExecutionState(ES_SYSTEM_REQUIRED);