main.~pas

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

  end else if not(Core.Running) AND not(Logo.Visible) AND (Now>ShowLogoAt) then
    Logo.Visible:=True;
end;

procedure TMainForm.QueryPosition;
begin
  Core.SendCommand('get_percent_pos'); Unpaused;
end;

procedure TMainForm.FixSize;
var SX,SY,NX,NY:integer;
begin
  if not InnerPanel.Visible then exit;
  if (NativeHeight=0) OR (NativeWidth=0) then begin
    InnerPanel.Align:=alClient;
    exit;
  end else
    InnerPanel.Align:=alNone;
  SX:=OuterPanel.ClientWidth;
  SY:=OuterPanel.ClientHeight;
  NY:=SY; NX:=NativeWidth*SY DIV NativeHeight;
  if NX>SX then begin NX:=SX; NY:=NativeHeight*SX DIV NativeWidth; end;
  with InnerPanel do begin
    Left:=(SX-NX) DIV 2;
    Top:=(SY-NY) DIV 2;
    Width:=NX;
    Height:=NY;
  end;
end;

procedure TMainForm.FormResize(Sender: TObject);
var CX,CY:integer;
begin
  if SeekBarSlider.Visible then UpdateSeekBar;
  FixSize;
  CX:=OuterPanel.ClientWidth;
  CY:=OuterPanel.ClientHeight;
  Logo.Left:=(CX-120) DIV 2;
  Logo.Top:=(CY-100) DIV 2;
  LEscape.Left:=(CX-LEscape.Width) DIV 2;
  LEscape.Top:=Max(Logo.Top+Logo.Height,CY*3 DIV 4);
  UpdateDockedWindows;
  if ControlledResize then
    ControlledResize:=false
  else if not MSizeAny.Checked then
    MSizeAny.Checked:=true;
end;

procedure TMainForm.SetupStart;
var PLI:integer;
begin
  BPlay.Enabled:=true;
  BPlay.Down:=true;
  BStop.Enabled:=true;
  SeekBarSlider.Visible:=true;
  SeekBarSlider.Left:=0;
  EnablePositionQueries:=true;
  BPause.Enabled:=true;
  BPause.Down:=false;
  BStreamInfo.Enabled:=true;
  PLI:=Playlist.GetCurrent;
  BPrev.Enabled:=(PLI>0) OR Playlist.Shuffle;
  BNext.Enabled:=(PLI+1<Playlist.Count) OR Playlist.Shuffle;
end;

procedure TMainForm.SetupPlay;
begin
  InnerPanel.Visible:=HaveVideo;
  Logo.Visible:=not(HaveVideo);
  LEscape.Visible:=not(HaveVideo) AND Fullscreen;
  Seeking:=false;
  if HaveVideo then FixSize;
  BMute.Enabled:=HaveAudio;
  BPause.Enabled:=true;
  UpdateTime;
  InfoForm.UpdateInfo;
end;

procedure TMainForm.SetupStop(Explicit:boolean);
var PLI:integer;
begin
  BPlay.Down:=false;
  BPlay.Enabled:=(Playlist.Count>0);
  BStop.Enabled:=false;
  SeekBarSlider.Visible:=false;
  EnablePositionQueries:=false;
  InnerPanel.Visible:=false;
  BPause.Enabled:=false;
  BPause.Down:=false;
  BStreamInfo.Enabled:=false;
  if Explicit then ShowLogoAt:=GetTickCount()+1500;
  LEscape.Visible:=Fullscreen;
  PLI:=Playlist.GetCurrent;
  BPrev.Enabled:=(Status=sError) AND ((PLI>0) OR Playlist.Shuffle);
  BNext.Enabled:=(Status=sError) AND ((PLI+1<Playlist.Count) OR Playlist.Shuffle);
end;

procedure TMainForm.FormShow(Sender: TObject);
var i:integer; FileName:string;
begin
  UpdateDockedWindows;
  if FirstShow then begin
    FirstShow:=false;
    ActivateLocale(DefaultLocale);
    with MLanguage do
      for i:=0 to Count-1 do
        if Items[i].Tag=CurrentLocale then
          Items[i].Checked:=true;
    Application.ProcessMessages;
    if ParamStr(FirstParameter)<>'' then begin
      Playlist.Clear();
      FileName:=ParamStr(FirstParameter);
      for i:=FirstParameter+1 to ParamCount do
        FileName:=FileName+' '+ParamStr(i);
      Playlist.Add(FileName);
      Application.OnIdle:=OpenDroppedFile;
    end else if AutoPlay then begin
      Playlist.Add('.');
      if Playlist.Count>0 then
        Application.OnIdle:=OpenDroppedFile;
    end;
  end;
  DragAcceptFiles(Handle,true);
end;

procedure TMainForm.FormHide(Sender: TObject);
begin
  DragAcceptFiles(Handle,false);
end;

procedure TMainForm.FormDropFiles(var msg:TMessage);
var hDrop:THandle;
    i,DropCount:integer;
    fnbuf:array[0..1024]of char;
begin
  hDrop:=msg.wParam;
  DropCount:=DragQueryFile(hDrop,cardinal(-1),nil,0);
  Playlist.Clear;
  for i:=0 to DropCount-1 do begin
    DragQueryFile(hDrop,i,@fnbuf[0],1024);
    Playlist.Add(fnbuf);
  end;
  DragFinish(hDrop);
  Application.OnIdle:=OpenDroppedFile;
  msg.Result:=0;
end;

procedure TMainForm.OpenDroppedFile(Sender: TObject; var Done: Boolean);
begin
  Done:=true;
  Application.OnIdle:=nil;
  NextFile(0,psPlaying);
end;

procedure TMainForm.UpdateSeekBar;
begin
  if Seeking then exit;
  SeekBarSlider.Left:=(SeekBarFrame.ClientWidth-SeekBarSlider.Width)*PercentPos DIV 100;
end;

procedure TMainForm.SeekBarSliderMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button<>mbLeft then exit;
  Seeking:=true;
  SeekBarSlider.BevelInner:=bvLowered;
  SeekMouseX:=X; SeekBaseX:=SeekBarSlider.Left;
end;

procedure TMainForm.SeekBarSliderMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var MaxPos:integer;
begin
  if Button<>mbLeft then exit;
  Seeking:=false;
  SeekBarSlider.BevelInner:=bvRaised;
  MaxPos:=SeekBarFrame.ClientWidth-SeekBarSlider.Width;
  SendCommand('seek '+IntToStr((SeekBarSlider.Left*100+(MaxPos SHR 1)) DIV MaxPos)+' 1');
  QueryPosition;
  Unpaused;
end;

procedure TMainForm.SeekBarSliderMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var NewX,MaxX:integer;
begin
  if not(ssLeft in Shift) OR not(Seeking) then exit;
  NewX:=X-SeekMouseX+SeekBarSlider.Left;
  MaxX:=SeekBarFrame.ClientWidth-SeekBarSlider.Width;
  if NewX<0 then NewX:=0;
  if NewX>MaxX then NewX:=MaxX;
  SeekBarSlider.Left:=NewX;
end;

procedure TMainForm.SeekBarFrameMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var MaxPos:integer;
begin
  if not SeekBarSlider.Visible then exit;
  dec(X,SeekBarSlider.Width DIV 2);
  MaxPos:=SeekBarFrame.ClientWidth-SeekBarSlider.Width;
  SendCommand('seek '+IntToStr((X*100+(MaxPos SHR 1)) DIV MaxPos)+' 1');
  QueryPosition;
  Unpaused;
end;

procedure TMainForm.SeekBarMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var P:TPoint;
begin
  P:=SeekBarFrame.ScreenToClient(SeekBar.ClientToScreen(Point(X,Y)));
  SeekBarFrameMouseDown(Sender,Button,Shift,P.X,P.Y);
end;

procedure TMainForm.Unpaused;
begin
  BPause.Down:=false;
  if Core.Running then EnablePositionQueries:=true;
  if Core.Status=sPaused then begin Core.Status:=sPlaying; UpdateStatus; end;
end;

procedure TMainForm.SimulateKey(Sender: TObject);
var Key:word;
begin
  Key:=(Sender as TComponent).Tag;
  FormKeyDown(Sender,Key,[]);
end;

procedure TMainForm.VideoSizeChanged;
var SX,SY,PX,PY:integer;
begin
  if MSizeAny.Checked OR (NativeWidth=0) OR (NativeHeight=0) OR Fullscreen then begin
    FixSize;
    exit;
  end;
  SX:=NativeWidth; SY:=NativeHeight;
  if MSize50.Checked then begin SX:=SX DIV 2; SY:=SY DIV 2; end;
  if MSize200.Checked then begin SX:=SX*2; SY:=SY*2; end;
  SX:=Width-OuterPanel.ClientWidth+SX;
  SY:=Height-OuterPanel.ClientHeight+SY;
  PX:=Left; PY:=Top;
  ControlledResize:=true;
  InnerPanel.Visible:=true;
  SetBounds(PX,PY,SX,SY);
  if WantFullscreen then begin
    SetFullscreen(True);
    WantFullscreen:=False;
  end;
end;

procedure TMainForm.MSizeClick(Sender: TObject);
begin
  if Fullscreen then exit;
  (Sender as TMenuItem).Checked:=True;
  VideoSizeChanged;
end;

procedure TMainForm.MShowOutputClick(Sender: TObject);
begin
  LogForm.Show;
end;

procedure TMainForm.MOSDClick(Sender: TObject);
begin
  with Sender as TMenuItem do
    SetOSDLevel(Tag);
  Unpaused;
end;

procedure TMainForm.ToggleAlwaysOnTop;
var IsTopmost:HWND;
begin
  if Fullscreen then begin
    FS_WasTopmost:=not(FS_WasTopmost);
    exit;
  end;
  if (GetWindowLong(Handle,GWL_EXSTYLE) AND WS_EX_TOPMOST)=0
    then IsTopmost:=HWND_TOPMOST
    else IsTopmost:=HWND_NOTOPMOST;
  SetWindowPos(Handle,IsTopmost,0,0,0,0,SWP_NOMOVE OR SWP_NOSIZE);
end;

procedure TMainForm.MCloseClick(Sender: TObject);
begin
  Stop;
  MediaURL:='';
  BPlay.Enabled:=false;
end;

procedure TMainForm.MAudioClick(Sender: TObject);
begin
  AudioID:=(Sender as TMenuItem).Tag;
  Core.Restart;
  (Sender as TMenuItem).Checked:=True;
end;

procedure TMainForm.MSubtitleClick(Sender: TObject);
begin
  SubID:=(Sender as TMenuItem).Tag;
  Core.Restart;
  (Sender as TMenuItem).Checked:=True;
end;

procedure TMainForm.UpdateMenus(Sender: TObject);
begin
  case Core.Deinterlace of
    0:MNoDeint.Checked:=true;
    1:MSimpleDeint.Checked:=true;
    2:MAdaptiveDeint.Checked:=true;
  end;
  case Core.Aspect of
    0:MAutoAspect.Checked:=true;
    1:MForce43.Checked:=true;
    2:MForce169.Checked:=true;
    3:MForceCinemascope.Checked:=true;
  end;
  MKeyHelp.Checked:=HelpForm.Visible;
  MPlay.Enabled:=BPlay.Enabled;
  MPause.Enabled:=BPause.Enabled;
  MStop.Enabled:=BStop.Enabled;
  MPrev.Enabled:=BPrev.Enabled;
  MNext.Enabled:=BNext.Enabled;
  MPlay.Checked:=BPlay.Down;
  MPause.Checked:=BPause.Down;
  MOnTop.Checked:=((GetWindowLong(Handle,GWL_EXSTYLE) AND WS_EX_TOPMOST)<>0);
  MMute.Checked:=BMute.Down;
end;

procedure TMainForm.MPopupPopup(Sender: TObject);
var i:integer;
begin
  MPPlay.Enabled:=BPlay.Enabled;
  MPPause.Enabled:=BPause.Enabled;
  MPStop.Enabled:=BStop.Enabled;
  MPPrev.Enabled:=BPrev.Enabled;
  MPNext.Enabled:=BNext.Enabled;
  MPPlay.Checked:=BPlay.Down;
  MPPause.Checked:=BPause.Down;
  MPFullscreen.Checked:=Fullscreen;
  MPFullscreenControls.Enabled:=Fullscreen;
  MPFullscreenControls.Checked:=FullscreenControls;
  MPCompact.Checked:=Compact;
  if Fullscreen then
    MPOnTop.Checked:=FS_WasTopmost
  else
    MPOnTop.Checked:=((GetWindowLong(Handle,GWL_EXSTYLE) AND WS_EX_TOPMOST)<>0);
  OSDMenu.Enabled:=Core.Running AND HaveVideo;
  for i:=0 to OSDMenu.Count-1 do
    if OSDMenu.Items[i].Tag=OSDLevel then begin
      OSDMenu.Items[i].Checked:=true;
      break;
    end;
end;

procedure TMainForm.MDeinterlaceClick(Sender: TObject);
begin
  Core.Deinterlace:=(Sender as TMenuItem).Tag;
  Core.Restart;
end;

procedure TMainForm.MAspectClick(Sender: TObject);
begin
  Core.Aspect:=(Sender as TMenuItem).Tag;
  Core.Restart;
end;

procedure TMainForm.MOpenFileClick(Sender: TObject);
begin
  with OpenDialog do begin
    Options:=Options-[ofAllowMultiSelect];
    if Execute then
      OpenSingleItem(FileName);
  end;
end;

procedure TMainForm.MOpenURLClick(Sender: TObject);
var s:string;
begin
  s:=Trim(Clipboard.AsText);
  if (Pos(^M,s)>0) OR (Pos(^J,s)>0) OR (Pos(^I,s)>0) OR
     ((Pos('//',s)=0) AND (Pos('\\',s)=0) AND (Pos(':',s)=0))
     then s:='';
  if InputQuery(LOCstr_OpenURL_Caption,LOCstr_OpenURL_Prompt,s)
    then OpenSingleItem(s);
end;

procedure TMainForm.Init_MOpenDrive;
var Mask:cardinal; Name:array[0..3]of char; Drive:char;
    Item:TMenuItem;
begin
  Name:='@:\';
  Mask:=GetLogicalDrives();
  for Drive:='A' to 'Z' do
    if (Mask AND (1 SHL (Ord(Drive)-65)))<>0 then begin
      Name[0]:=Drive;
      if GetDriveType(Name)=DRIVE_CDROM then begin
        Item:=TMenuItem.Create(MOpenDrive);
        with Item do begin
          Caption:=Drive+':';
          Tag:=Ord(Drive);
          OnClick:=MOpenDriveClick;
        end;
        MOpenDrive.Add(Item);
        MOpenDrive.Enabled:=true;
      end;
    end;
end;

procedure TMainForm.MOpenDriveClick(Sender: TObject);
begin
  OpenSingleItem(char((Sender as TMenuItem).Tag)+':'); 
end;

procedure TMainForm.MKeyHelpClick(Sender: TObject);
begin
  if HelpForm.Visible then HelpForm.Close else HelpForm.Show;
end;

procedure TMainForm.MAboutClick(Sender: TObject);
begin
  AboutForm.Show;
end;

procedure TMainForm.Init_MLanguage;
var i:integer; Item:TMenuItem;
begin
  MLanguage.Clear;
  for i:=0 to High(Locales) do begin
    Item:=TMenuItem.Create(MLanguage);
    with Item do begin
      Caption:=Locales[i].Name;
      GroupIndex:=$70;
      RadioItem:=true;
      AutoCheck:=true;
      Tag:=i;
      OnClick:=MLanguageClick;
    end;
    MLanguage.Add(Item);
  end;
end;

procedure TMainForm.MLanguageClick(Sender: TObject);
begin
  ActivateLocale((Sender as TMenuItem).Tag);
end;

procedure TMainForm.MOptionsClick(Sender: TObject);
begin
  OptionsForm.Show;
end;

procedure TMainForm.MPauseClick(Sender: TObject);
begin
  BPause.Down:=not(BPause.Down);
  BPauseClick(nil);
end;

procedure TMainForm.SetFullscreen(Mode:boolean);
var Pivot:TPoint;
    PX,PY,SX,SY:integer;
    InsertAfter:THandle;
begin
  WindowState:=wsNormal;
  Fullscreen:=Mode;
  FullscreenControls:=False;
  BFullscreen.Down:=Fullscreen;
  if Compact AND not(ControlledResize) then begin
    ControlledResize:=True;
    SetCompact(False);
  end;
  ControlledResize:=False;
  if Fullscreen then begin