main.~pas

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

    FS_PX:=Left; FS_PY:=Top;
    FS_SX:=Width; FS_SY:=Height;
    FS_WasTopmost:=((GetWindowLong(Handle,GWL_EXSTYLE) AND WS_EX_TOPMOST)<>0);
    Pivot:=OuterPanel.ClientToScreen(Point(0,0));
    PX:=FS_PX-Pivot.X;
    PY:=FS_PY-Pivot.Y;
    SX:=Screen.Width +FS_SX-OuterPanel.ClientWidth;
    SY:=Screen.Height+FS_SY-OuterPanel.ClientHeight;
    ControlledResize:=true;
    SetWindowPos(Handle,HWND_TOPMOST,PX,PY,SX,SY,0);
    SetMouseVisible(false);
    SystemParametersInfo(SPI_GETSCREENSAVEACTIVE, 0, @ScreenSaverActive, 0);
    SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, 0, nil, 0);
    LEscape.Visible:=not(Core.Running) OR not(HaveVideo);
  end else begin
    LEscape.Visible:=false;
    SetMouseVisible(true);
    ControlledResize:=true;
    if FS_WasTopmost then InsertAfter:=HWND_TOPMOST
                     else InsertAfter:=HWND_NOTOPMOST;
    SetWindowPos(Handle,InsertAfter,FS_PX,FS_PY,FS_SX,FS_SY,0);
    SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, ScreenSaverActive, nil, 0);
  end;
end;

procedure TMainForm.SetCompact(Mode:boolean);
var MenuAndCaption:integer;
begin
  WindowState:=wsNormal;
  Compact:=Mode;
  BCompact.Down:=Compact;
  if Fullscreen AND not(ControlledResize) then begin
    ControlledResize:=True;
    SetFullscreen(False);
  end;
  ControlledResize:=False;
  MenuAndCaption:=MenuBar.Height+GetSystemMetrics(SM_CYCAPTION);
  if Compact then begin
    ControlPanel.Visible:=False;
    MenuBar.Visible:=False;
    SetWindowLong(Handle,GWL_STYLE,
      (DWORD(GetWindowLong(Handle,GWL_STYLE)) OR WS_POPUP) AND (NOT WS_DLGFRAME));
    ControlledResize:=true;
    SetBounds(Left,Top+MenuAndCaption,Width,Height-MenuAndCaption-ControlPanel.Height);
  end else begin
    SetWindowLong(Handle,GWL_STYLE,
      (DWORD(GetWindowLong(Handle,GWL_STYLE)) OR WS_DLGFRAME) AND (NOT WS_POPUP));
    MenuBar.Visible:=True;
    ControlPanel.Visible:=True;
    ControlledResize:=true;
    SetBounds(Left,Top-MenuAndCaption,Width,Height+MenuAndCaption+ControlPanel.Height);
  end;
end;

procedure TMainForm.FormGetMinMaxInfo(var msg:TMessage);
begin
  if Fullscreen then
    with PMinMaxInfo(msg.lParam)^.ptMaxTrackSize do begin
      X:=4095;
      Y:=4095;
    end;
  msg.Result:=0;
end;

procedure TMainForm.NextAudio;
var i,AudioIndex:integer;
begin
  if MAudio.Count<2 then exit;
  AudioIndex:=-1;
  for i:=0 to MAudio.Count-1 do
    if MAudio.Items[i].Checked then begin
      AudioIndex:=(i+1) MOD MAudio.Count;
    end;
  if AudioIndex<0 then exit;
  with MAudio.Items[AudioIndex] do begin
    Checked:=True;
    Core.AudioID:=Tag;
  end;
  Core.SendCommand('switch_audio');
  Unpaused;
end;

procedure TMainForm.NextFile(Direction:integer; ExitState:TPlaybackState);
var Index:integer;
begin
  Core.ForceStop;
  Index:=Playlist.GetNext(ExitState,Direction);
  if Index<0 then begin
    if AutoQuit then Close;
    exit;
  end;
  Playlist.NowPlaying(Index);
  DoOpen(Playlist[Index].FullURL);
end;

procedure TMainForm.BPrevNextClick(Sender: TObject);
begin
  NextFile((Sender as TComponent).Tag,psSkipped);
end;

procedure TMainForm.MShowPlaylistClick(Sender: TObject);
begin
  if PlaylistForm.Visible
    then PlaylistForm.Hide
    else PlaylistForm.Show;
end;

procedure TMainForm.MStreamInfoClick(Sender: TObject);
begin
  if MStreamInfo.Checked
    then InfoForm.Hide
    else InfoForm.Show;
end;

procedure TMainForm.OpenSingleItem(const URL:string);
begin
  Playlist.Clear;
  Playlist.Add(URL);
  NextFile(0,psPlaying);  
end;

procedure TMainForm.BStopClick(Sender: TObject);
begin
  Core.Stop;
  Playlist.GetNext(psSkipped,0);
end;

procedure TMainForm.UpdateStatus;
begin
  case Core.Status of
    sNone:    LStatus.Caption:='';
    sOpening: LStatus.Caption:=LOCstr_Status_Opening;
    sClosing: LStatus.Caption:=LOCstr_Status_Closing;
    sPlaying: LStatus.Caption:=LOCstr_Status_Playing;
    sPaused:  LStatus.Caption:=LOCstr_Status_Paused;
    sStopped: LStatus.Caption:=LOCstr_Status_Stopped;
    sError:   LStatus.Caption:=LOCstr_Status_Error;
  end;
  if Core.Status=sError
    then LStatus.Cursor:=crHandPoint
    else LStatus.Cursor:=crDefault;
  if (Core.Status<>sPlaying) AND (Core.Status<>sPaused) then
    LTime.Caption:='';
end;

procedure TMainForm.UpdateTime;
begin
  if (Core.Status<>sPlaying) AND (Core.Status<>sPaused)
    then LTime.Caption:=''
    else LTime.Caption:=SecondsToTime(Core.SecondPos)+' / '+Core.Duration;
end;

procedure TMainForm.UpdateCaption;
begin
  if length(Core.DisplayURL)<>0
    then Caption:=Core.DisplayURL+' - '+LOCstr_Title
    else Caption:=LOCstr_Title;
end;


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

procedure TMainForm.VolSliderMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var NewX,MaxX,NewVolume:integer;
begin
  if not(ssLeft in Shift) then exit;
  NewX:=X-SeekMouseX+VolSlider.Left;
  MaxX:=VolFrame.ClientWidth-VolSlider.Width;
  if NewX<0 then NewX:=0;
  if NewX>MaxX then NewX:=MaxX;
  VolSlider.Left:=NewX;
  NewVolume:=(NewX*100+(MaxX SHR 1)) DIV MaxX;
  if NewVolume=Core.Volume then exit;
  Core.Volume:=NewVolume;
  Core.SendVolumeChangeCommand(NewVolume);
  Unpaused;
end;

procedure TMainForm.VolSliderMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  VolSlider.BevelInner:=bvRaised;
end;

procedure TMainForm.BMuteClick(Sender: TObject);
begin
  if Sender=BMute then
    Core.Mute:=BMute.Down
  else begin
    Mute:=not(Mute);
    BMute.Down:=Core.Mute;
  end;
  if not BMute.Down then
    Core.SendVolumeChangeCommand(Volume)
  else
    Core.SendCommand('mute');
  Unpaused;
end;

procedure TMainForm.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  SetVolumeRel(WheelDelta DIV 40);
end;

procedure TMainForm.UpdateDockedWindows;
begin
  if plist.Docked then begin
    PlaylistForm.ControlledMove:=True;
    PlaylistForm.Left:=Left;
    PlaylistForm.ControlledMove:=True;
    PlaylistForm.Top:=Top+Height;
  end;
  if Info.Docked then begin
    InfoForm.ControlledMove:=True;
    InfoForm.Left:=Left+Width;
    InfoForm.ControlledMove:=True;
    InfoForm.Top:=Top;
  end;
end;

procedure TMainForm.FormMove(var msg:TMessage);
begin
  msg.Result:=0;
  UpdateDockedWindows;
end;

procedure TMainForm.DisplayMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Fullscreen OR (Button<>mbLeft) then exit;
  // I love these undocumented Windows messages ... [http://keyj.s2000.ws/?p=18]
  ReleaseCapture;
  SendMessage(Handle, WM_SYSCOMMAND, SC_MOVE+2, 0);
end;

procedure TMainForm.DisplayDblClick(Sender: TObject);
begin
  SetFullscreen(not(Fullscreen));
end;

procedure TMainForm.Localize;
begin
  MPPlay.Caption:=MPlay.Caption;
  MPPause.Caption:=MPause.Caption;
  MPStop.Caption:=MStop.Caption;
  MPPrev.Caption:=MPrev.Caption;
  MPNext.Caption:=MNext.Caption;
  MPFullscreen.Caption:=MFullscreen.Caption;
  MPCompact.Caption:=MCompact.Caption;
  MPOnTop.Caption:=MOnTop.Caption;
  MPQuit.Caption:=MQuit.Caption;  
end;

procedure TMainForm.OuterPanelMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  if Fullscreen AND not(FullscreenControls) AND (Y>=OuterPanel.ClientHeight-8)
    then SetFullscreenControls(True);
end;

procedure TMainForm.SetFullscreenControls(Mode:boolean);
begin
  if not Fullscreen then exit;
  FullscreenControls:=Mode;
  if FullscreenControls then begin
    SetMouseVisible(True);
    Height:=Height-ControlPanel.Height+PStatus.Height;
    FullscreenControls:=True;
    DisableFullscreenControlsAt:=GetTickCount()+3000;
  end else begin
    Height:=Height+ControlPanel.Height-PStatus.Height;
    FullscreenControls:=False;
    SetMouseVisible(False);
  end;
end;

procedure TMainForm.SetMouseVisible(Mode:boolean);
begin
  if Mode then begin
    Logo.Cursor:=crDefault;
    InnerPanel.Cursor:=crDefault;
    OuterPanel.Cursor:=crDefault;
    //ShowCursor(true);
  end else begin
    OuterPanel.Cursor:=-1;
    InnerPanel.Cursor:=-1;
    Logo.Cursor:=-1;
    //ShowCursor(false);
  end;
end;

procedure TMainForm.ControlPanelMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  if FullscreenControls then DisableFullscreenControlsAt:=GetTickCount()+3000;
end;

procedure TMainForm.FormWantSpecialKey(var msg:TCMWantSpecialKey);
begin
  msg.Result:=1;
end;

procedure TMainForm.MPFullscreenControlsClick(Sender: TObject);
begin
  if not Fullscreen then exit;
  SetFullscreenControls(not(FullscreenControls));
  if FullscreenControls then
    DisableFullscreenControlsAt:=$FFFFFFFF;
end;

procedure TMainForm.LStatusClick(Sender: TObject);
begin
  if Core.Status=sError then begin
    LogForm.Show;
    LogForm.TheLog.ScrollBy(0,32767);
    LogForm.SetFocus;
  end;
end;

procedure TMainForm.VolBoostClick(Sender: TObject);
begin
  if Core.Volume>100 then begin
    Core.SendVolumeChangeCommand(100);
    Core.Volume:=100;
    Unpaused;
    VolBoost.Caption:='100%';
  end;
end;

procedure TMainForm.BRecordVideoClick(Sender: TObject);
var TimeStr:String;
var AYear:Word;
var AMonth:Word;
var ADay:Word;
var AHour:Word;
var AMinute:Word;
var ASecond:Word;
var AMilliSecond:Word;
var StrMonth:String;
var StrDay:String;
var StrHour:String;
var StrMinute:String;
var StrSecond:String;
var SystemTimes:TSystemTime;
begin

    BRecordVideo.Enabled :=False;
    Timer1.enabled:=True;
    Label1.Caption :='Recording...';
    Label1.Color :=clRed;

    GetLocalTime(SystemTimes);
    AYear:=SystemTimes.wYear;
    AMonth:=SystemTimes.wMonth;
    ADay:=SystemTimes.wDay;
    AHour:=SystemTimes.wHour;
    AMinute:=SystemTimes.wMinute ;
    ASecond:=SystemTimes.wSecond ;
    if AMonth<=9 then
    StrMonth:='0'+IntToStr(AMonth)
    else
    StrMonth:=IntToStr(AMonth);

    if ADay<=9 then
    StrDay:='0'+IntToStr(ADay)
    else
    StrDay:=IntToStr(ADay);

    if AHour<=9 then
    StrHour:='0'+IntToStr(AHour)
    else
    StrHour:=IntToStr(AHour);

    if AMinute<=9 then
    StrMinute:='0'+IntToStr(AMinute)
    else
    StrMinute:=IntToStr(AMinute);

    if ASecond<=9 then
    StrSecond:='0'+IntToStr(ASecond)
    else
    StrSecond:=IntToStr(ASecond);

    TimeStr:=IntToStr(AYear)+'_'+StrMonth+'_'+StrDay+'_'+StrHour+'_'+StrMinute+'_'+StrSecond+'.avi';
    TimeStr:='rtsp://192.168.0.9:7070 -ovc copy -fps 30 -endpos 0:02:30 -o '+TimeStr;
    Shellexecute(0,'open','mencoder.exe ',pChar(TimeStr),nil,SW_MINIMIZE);

end;

procedure TMainForm.Timer1Timer(Sender: TObject);

var TimeStr:String;
var AYear:Word;
var AMonth:Word;
var ADay:Word;
var AHour:Word;
var AMinute:Word;
var ASecond:Word;
var AMilliSecond:Word;
var StrMonth:String;
var StrDay:String;
var StrHour:String;
var StrMinute:String;
var StrSecond:String;
var SystemTimes:TSystemTime;


begin


    GetLocalTime(SystemTimes);
    AYear:=SystemTimes.wYear;
    AMonth:=SystemTimes.wMonth;
    ADay:=SystemTimes.wDay;
    AHour:=SystemTimes.wHour;
    AMinute:=SystemTimes.wMinute ;
    ASecond:=SystemTimes.wSecond ;
    if AMonth<=9 then
    StrMonth:='0'+IntToStr(AMonth)
    else
    StrMonth:=IntToStr(AMonth);

    if ADay<=9 then
    StrDay:='0'+IntToStr(ADay)
    else
    StrDay:=IntToStr(ADay);

    if AHour<=9 then
    StrHour:='0'+IntToStr(AHour)
    else
    StrHour:=IntToStr(AHour);

    if AMinute<=9 then
    StrMinute:='0'+IntToStr(AMinute)
    else
    StrMinute:=IntToStr(AMinute);

    if ASecond<=9 then
    StrSecond:='0'+IntToStr(ASecond)
    else
    StrSecond:=IntToStr(ASecond);

    TimeStr:=IntToStr(AYear)+'_'+StrMonth+'_'+StrDay+'_'+StrHour+'_'+StrMinute+'_'+StrSecond+'.avi';
    TimeStr:='rtsp://192.168.0.9:7070 -ovc copy -fps 30 -endpos 0:02:30 -o '+TimeStr;
    Shellexecute(0,'open','mencoder.exe ',pChar(TimeStr),nil,SW_MINIMIZE);
end;

procedure TMainForm.FormActivate(Sender: TObject);
begin
Label1.Color :=clLime;
end;

procedure TMainForm.SpeedButton1Click(Sender: TObject);
begin
Timer1.Enabled :=False;
Label1.Caption :='Recording Paused';
Label1.Color :=clLime;
BRecordVideo.Enabled :=True;
end;

end.