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

📄 core.pas

📁 拍摄程序,用来控制摄像机拍摄照片。拍摄程序,用来控制摄像机拍摄照片。拍摄程序,用来控制摄像机拍摄照片。
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  if FirstChance then begin
    SendCommand('quit');
    FirstChance:=false;
    if WaitForSingleObject(ClientProcess,1000)<>WAIT_TIMEOUT then exit;
  end;
  Terminate;
end;

procedure SendCommand(Command:string);
var Dummy:cardinal;
begin
  if (ClientProcess=0) OR (WritePipe=0) then exit;
  Command:=Command+#10;
  WriteFile(WritePipe,Command[1],length(Command),Dummy,nil);
end;

procedure SendVolumeChangeCommand(Volume:integer);
begin
  if Mute then exit; 
  LastVolume:=Volume;
  if SoftVol then Volume:=Volume DIV 10;
  SendCommand('volume '+IntToStr(Volume)+' 1');
end;

procedure SetOSDLevel(Level:integer);
begin
  if Level<0 then OSDLevel:=OSDLevel+1
             else OSDLevel:=Level;
  OSDLevel:=OSDLevel AND 3;
  SendCommand('osd '+IntToStr(OSDLevel));
end;

procedure Restart;
var LastPos,LastOSD:integer;
begin
  if not Running then exit;
  LastPos:=PercentPos;
  LastOSD:=OSDLevel;
  ForceStop;
  Sleep(50); // wait for the processing threads to finish
  Application.ProcessMessages;
  Start;
  SendCommand('seek '+IntToStr(LastPos)+' 1');
  SetOSDLevel(LastOSD);
  MainForm.QueryPosition;
end;

////////////////////////////////////////////////////////////////////////////////



procedure HandleInputLine(Line:string);
var r,i,j,p:integer; c:char;

  procedure SubMenu_Add(Menu:TMenuItem; ID,SelectedID:integer; Handler:TNotifyEvent);
  var j:integer; Item:TMenuItem;
  begin
    with MainForm.MAudio do
      for j:=0 to Menu.Count-1 do
        if Menu.Items[j].Tag=ID then exit;
    Item:=TMenuItem.Create(Menu);
    with Item do begin
      Caption:=IntToStr(ID);
      Tag:=ID;
      GroupIndex:=$0A;
      RadioItem:=true;
      if ID=SelectedID then Checked:=true else
      if (SelectedID<0) AND (Menu.Count=0) then Checked:=true;
      OnClick:=Handler;
    end;
    Menu.Add(Item);
    Menu.Enabled:=true;
  end;

  procedure SubMenu_SetLang(Menu:TMenuItem; ID:integer; Lang:string);
  var j:integer;
  begin
    with MainForm.MAudio do
      for j:=0 to Menu.Count-1 do
        with Menu.Items[j] do
          if Tag=ID then begin
            Caption:=IntToStr(ID)+' ('+Lang+')';
            exit;
          end;
  end;

  function CheckNativeResolutionLine:boolean;
  begin
    Result:=false;
    if Copy(Line,1,5)<>'VO: [' then exit;
    p:=Pos(' => ',Line); if p=0 then exit; Delete(Line,1,p+3);
    p:=Pos(#32,Line);    if p=0 then exit; SetLength(Line,p-1);
    p:=Pos('x',Line);    if p=0 then exit;
    Val(Copy(Line,1,p-1),i,r); if (r<>0) OR (i<16) OR (i>=4096) then exit;
    Val(Copy(Line,p+1,5),j,r); if (r<>0) OR (j<16) OR (j>=4096) then exit;
    NativeWidth:=i; NativeHeight:=j;
    MainForm.VideoSizeChanged;
    Status:=sPlaying; MainForm.UpdateStatus;
    Result:=true;
  end;

  function CheckNoAudio:boolean;
  begin
    Result:=false;
    if Line<>'Audio: no sound' then exit;
    HaveAudio:=false;
    Result:=true;
  end;

  function CheckNoVideo:boolean;
  begin
    Result:=false;
    if Line<>'Video: no video' then exit;
    HaveVideo:=false;
    Result:=true;
  end;

  function CheckStartPlayback:boolean;
  begin
    Result:=false;
    if Line<>'Starting playback...' then exit;
    MainForm.SetupPlay;
    if not(HaveVideo) then begin
      Status:=sPlaying; MainForm.UpdateStatus;
    end;
    Result:=true;
  end;

  function CheckAudioID:boolean;
  begin
    Result:=false;
    if Copy(Line,1,12)='ID_AUDIO_ID=' then begin
      Val(Copy(Line,13,9),i,r);
      if (r=0) AND (i>=0) AND (i<8191) then begin
        SubMenu_Add(MainForm.MAudio,i,AudioID,MainForm.MAudioClick);
        Result:=true;
      end;
    end;
  end;

  function CheckAudioLang:boolean;
  var s:string; p:integer;
  begin
    Result:=false;
    if Copy(Line,1,7)='ID_AID_' then begin
      s:=Copy(Line,8,20);
      p:=Pos('_LANG=',s);
      if p<=0 then exit;
      Val(Copy(s,1,p-1),i,r);
      if (r=0) AND (i>=0) AND (i<256) then begin
       SubMenu_SetLang(MainForm.MAudio,i,copy(s,p+6,8));
        Result:=true;
      end;
    end;
  end;

  function CheckSubID:boolean;
  begin
    Result:=false;
    if Copy(Line,1,15)='ID_SUBTITLE_ID=' then begin
      Val(Copy(Line,16,9),i,r);
      if (r=0) AND (i>=0) AND (i<256) then begin
        SubMenu_Add(MainForm.MSubtitle,i,SubID,MainForm.MSubtitleClick);
        Result:=true;
      end;
    end;
  end;

  function CheckSubLang:boolean;
  var s:string; p:integer;
  begin
    Result:=false;
    if Copy(Line,1,7)='ID_SID_' then begin
      s:=Copy(Line,8,20);
      p:=Pos('_LANG=',s);
      if p<=0 then exit;
      Val(Copy(s,1,p-1),i,r);
      if (r=0) AND (i>=0) AND (i<256) then begin
        SubMenu_SetLang(MainForm.MSubtitle,i,copy(s,p+6,8));
        Result:=true;
      end;
    end;
  end;

  function CheckLength:boolean;
  var f:real;
  begin
    Result:=(Copy(Line,1,10)='ID_LENGTH=');
    if Result then begin
      Val(Copy(Line,11,10),f,r);
      if r=0 then Duration:=SecondsToTime(round(f));
    end;
  end;

  function CheckFileFormat:boolean;
  begin
    p:=length(Line)-21;
    Result:=(p>0) AND (Copy(Line,p,22)=' file format detected.');
    if Result then
      StreamInfo.FileFormat:=Copy(Line,1,p-1);
  end;

  function CheckDecoder:boolean;
  begin
    Result:=(Copy(Line,1,8)='Opening ') AND (Copy(Line,13,12)='o decoder: [');
    if not Result then exit;
    p:=Pos('] ',Line); Result:=(p>24);
    if not Result then exit;
    if Copy(Line,9,4)='vide' then
      StreamInfo.Video.Decoder:=Copy(Line,p+2,length(Line))
    else if Copy(Line,9,4)='audi' then
      StreamInfo.Audio.Decoder:=Copy(Line,p+2,length(Line))
    else Result:=false;
  end;

  function CheckCodec:boolean;
  begin
    Result:=(Copy(Line,1,9)='Selected ') AND (Copy(Line,14,10)='o codec: [');
    if not Result then exit;
    p:=Pos(' (',Line); Result:=(p>23);
    if not Result then exit;
    if Copy(Line,10,4)='vide' then
      StreamInfo.Video.Codec:=Copy(Line,p+2,length(Line)-p-2)
    else if Copy(Line,10,4)='audi' then
      StreamInfo.Audio.Codec:=Copy(Line,p+2,length(Line)-p-2)
    else Result:=false;
  end;

  function CheckICYInfo:boolean;
  var P:integer;
  begin
    Result:=False;
    if Copy(Line,1,10)<>'ICY Info: ' then exit;
    P:=Pos('StreamTitle=''',Line); if P<10 then exit;
    Delete(Line,1,P+12);
    P:=Pos(''';',Line); if P<1 then exit;
    SetLength(Line,P-1);
    if length(Line)=0 then exit;
    P:=0; while (P<9)
            AND (length(StreamInfo.ClipInfo[P].Key)>0)
            AND (StreamInfo.ClipInfo[P].Key<>'Title')
          do inc(P);
    StreamInfo.ClipInfo[P].Key:='Title';
    if StreamInfo.ClipInfo[P].Value<>Line then begin
      StreamInfo.ClipInfo[P].Value:=Line;
      InfoForm.UpdateInfo;
    end;
  end;

begin
  // Time position indicators are "first-class citizens", because they
  // make up for 99.999% of all traffic. So we have to handle them *FAST*!
  if (length(Line)>7) then begin
    if Line[1]=^J then j:=4 else j:=3;
    if ((Line[j-2]='A') OR (Line[j-2]='V')) AND (Line[j-1]=':') then begin
      p:=0;
      for i:=0 to 3 do begin
        c:=Line[i+j];
        case c of
          '-': begin p:=-1; break; end;
          '0'..'9': p:=p*10+ord(c)-48;
        end;
      end;
      if p<>SecondPos then begin
        SecondPos:=p;
        MainForm.UpdateTime;
      end;
      exit;
    end;
  end;
  // normal line handling: check for "cache fill"
  Line:=Trim(Line);
  if (length(Line)>=18) AND (Line[11]=':') AND (Line[18]='%') AND (Copy(Line,1,10)='Cache fill') then begin
    if Copy(Line,12,6)=LastCacheFill then exit;
    MainForm.LStatus.Caption:=Line;
    if (Copy(LogForm.TheLog.Lines[LogForm.TheLog.Lines.Count-1],1,11)='Cache fill:') then
      LogForm.TheLog.Lines[LogForm.TheLog.Lines.Count-1]:=Line;
    Sleep(0);  // "yield"
    exit;
  end;
  // check percent_position indicator (hidden from log)
  if Copy(Line,1,21)='ANS_PERCENT_POSITION=' then begin
    Val(Copy(Line,22,4),i,r);
    if (r=0) AND (i>=0) AND (i<=100) then begin
      PercentPos:=i;
      MainForm.UpdateSeekBar;
    end;
    exit;
  end;
  // suppress repetitive lines
  if (length(Line)>0) AND (Line=LastLine) then begin
    inc(LineRepeatCount);
    exit;
  end;
  if LineRepeatCount=1 then
    LogForm.AddLine(Line)
  else if LineRepeatCount>1 then
    LogForm.AddLine('(last message repeated '+IntToStr(LineRepeatCount)+' times)');
  LastLine:=Line;
  LineRepeatCount:=0;
  // add line to log and check for special patterns
  LogForm.AddLine(Line);
  if not CheckNativeResolutionLine then
  if not CheckNoAudio then
  if not CheckNoVideo then
  if not CheckStartPlayback then
  if not CheckAudioID then
  if not CheckAudioLang then
  if not CheckSubID then
  if not CheckSubLang then
  if not CheckLength then
  if not CheckFileFormat then
  if not CheckDecoder then
  if not CheckCodec then
  if not CheckICYInfo then  // modifies Line, should be last
  ;
  // check for generic ID_ pattern
  if Copy(Line,1,3)='ID_' then begin
    p:=Pos('=',Line);
    HandleIDLine(Copy(Line,4,p-4), Trim(Copy(Line,p+1,length(Line))));
  end;
end;


////////////////////////////////////////////////////////////////////////////////

procedure HandleIDLine(ID, Content: string);
var AsInt,r:integer; AsFloat:real;
begin with StreamInfo do begin
  // convert to int and float
  val(Content,AsInt,r);
  if r<>0 then begin
    val(Content,AsFloat,r);
    if r<>0 then begin
      AsInt:=0; AsFloat:=0;
    end else AsInt:=trunc(AsFloat);
  end else AsFloat:=AsInt;

  // handle some common ID fields
       if ID='FILENAME'      then FileName:=Content
  else if ID='VIDEO_BITRATE' then Video.Bitrate:=AsInt
  else if ID='VIDEO_WIDTH'   then Video.Width:=AsInt
  else if ID='VIDEO_HEIGHT'  then Video.Height:=AsInt
  else if ID='VIDEO_FPS'     then Video.FPS:=AsFloat
  else if ID='VIDEO_ASPECT'  then Video.Aspect:=AsFloat
  else if ID='AUDIO_BITRATE' then Audio.Bitrate:=AsInt
  else if ID='AUDIO_RATE'    then Audio.Rate:=AsInt
  else if ID='AUDIO_NCH'     then Audio.Channels:=AsInt
  else if (ID='DEMUXER') AND (length(FileFormat)=0) then FileFormat:=Content
  else if (ID='VIDEO_FORMAT') AND (length(Video.Decoder)=0) then Video.Decoder:=Content
  else if (ID='VIDEO_CODEC') AND (length(Video.Codec)=0) then Video.Codec:=Content
  else if (ID='AUDIO_FORMAT') AND (length(Audio.Decoder)=0) then Audio.Decoder:=Content
  else if (ID='AUDIO_CODEC') AND (length(Audio.Codec)=0) then Audio.Codec:=Content
  else if (ID='LENGTH') AND (AsFloat>0.001) then begin
    AsFloat:=Frac(AsFloat);
    if (AsFloat>0.0009) then begin
      str(AsFloat:0:3, PlaybackTime);
      PlaybackTime:=SecondsToTime(AsInt) + Copy(PlaybackTime,2,20);
    end else
      PlaybackTime:=SecondsToTime(AsInt);
  end else if (Copy(ID,1,14)='CLIP_INFO_NAME') AND (length(ID)=15) then begin
    r:=Ord(ID[15])-Ord('0');
    if (r>=0) AND (r<=9) then ClipInfo[r].Key:=Content;
  end else if (Copy(ID,1,15)='CLIP_INFO_VALUE') AND (length(ID)=16) then begin
    r:=Ord(ID[16])-Ord('0');
    if (r>=0) AND (r<=9) then ClipInfo[r].Value:=Content;
  end;
end; end;


procedure ResetStreamInfo;
var i:integer;
begin with StreamInfo do begin
  FileName:='';
  FileFormat:='';
  PlaybackTime:='';
  with Video do begin
    Decoder:=''; Codec:='';
    Bitrate:=0; Width:=0; Height:=0; FPS:=0.0; Aspect:=0.0;
  end;
  with Audio do begin
    Decoder:=''; Codec:='';
    Bitrate:=0; Rate:=0; Channels:=0;
  end;
  for i:=0 to 9 do
    with ClipInfo[i] do begin
      Key:=''; Value:='';
    end;
end; end;

begin
  DecimalSeparator:='.';
  NativeWidth:=0; NativeHeight:=0;
  MediaURL:=''; DisplayURL:=''; FirstOpen:=true;
  AudioID:=-1; SubID:=-1; OSDLevel:=1;
  Deinterlace:=0; Aspect:=0; Postproc:=1;
  AudioOut:=3; AudioDev:=0;
  ReIndex:=false; SoftVol:=false; PriorityBoost:=true;
  Params:='';
  Duration:='';
  Status:=sNone;
  Volume:=100; Mute:=False;
  LastVolume:=-1;
  ResetStreamInfo;
end.

⌨️ 快捷键说明

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