mainplay.pas

unit Video interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, stdctrl

var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  Reg.OpenKey('\play2000\vcd', True);
  playdlg.EditText.Top := StrToInt(Reg.ReadString('top'));

  playdlg.EditText.left := StrToInt(Reg.ReadString('left'));
  playdlg.EditText.Height := StrToInt(Reg.ReadString('Height'));
  playdlg.EditText.Width := StrToInt(Reg.ReadString('Width'));

  Reg.CloseKey;
  Reg.Free;
end;

procedure TMainForm.vcdpanelMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  vcdpanel.Perform(WM_SYSCOMMAND, $F012, 0);
end;

procedure TMainForm.VcdSizeClick(Sender: TObject);
begin
  playdlg.VCD.Visible := False;
  playdlg.Video1.Visible := False;
  playdlg.EditText.AutoSize := False;
  playdlg.EditText.Caption := '';
  playdlg.EditText.Visible := True;
  playdlg.BringToFront;
end;

procedure TMainForm.VcdSavePosClick(Sender: TObject);
begin
  WriteVcdReg;
  ReadVcdReg;
  playdlg.EditText.Visible := False;
  playdlg.BringToFront;
end;

procedure TMainForm.VrShadowButton1Click(Sender: TObject);
var
  Reg: TRegistry;
  Loopp: Boolean;
  i: integer;
begin
  Loopp := True;
  i := 1;
  while Loopp do
    begin
      if i = Tabgrid.rowcount then
        Loopp := False
      else
        begin
          if Tabgrid.cells[1, i] = '' then
            begin
              Tabgrid.RemoveRows(i, 1);
              i := 0;
            end;
        end;
      i := i + 1;
    end;
  if TabGrid.RowCount = 1 then
    MessageDlg('节目表不能为空!', mtError, [mbOK], 0)
  else
    begin
      TabGrid.SaveToCSV(Path + 'ctab\' + IntToStr(TabNum.Value) + '.Tab');
      Reg := TRegistry.Create;
      Reg.RootKey := HKEY_CURRENT_USER;
      Reg.OpenKey('\play2000\runtab', True);
      Reg.WriteString('run', IntToStr(TabNum.Value));
      Reg.CloseKey;
      Reg.Free;
      N28Click(Self);
      btnPlay.Enabled := True;
      btnStep.Enabled := True
    end;
end;

procedure TMainForm.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  Stepdr: Integer;
begin
  with playdlg do
    begin
      if (EditText.Visible = True) then
        begin
          EditText.AutoSize := False;
          if ssshift in Shift then
            Stepdr := 10
          else
            Stepdr := 1;
          case key of
            38: edittext.Height := edittext.Height - Stepdr;
            40: edittext.Height := edittext.Height + Stepdr;
            39: edittext.width := edittext.Width + Stepdr;
            37: edittext.width := edittext.width - Stepdr;
          end;
        end;

      if (EditText.Visible = True) then
        begin
          EditText.AutoSize := False;
          if ssCtrl in Shift then
            Stepdr := 10
          else
            Stepdr := 1;
          case key of
            38: edittext.top := edittext.top - Stepdr;
            40: edittext.top := edittext.top + Stepdr;
            39: edittext.left := edittext.left + Stepdr;
            37: edittext.left := edittext.left - Stepdr;
          end;
        end;

    end;
end;

procedure TMainForm.VCD4Click(Sender: TObject);
begin
  VCD4.Checked := not VCD4.Checked;
  VCD3.Checked := not VCD3.Checked;
  vcdpanel.visible := not vcdpanel.visible;
end;

procedure TMainForm.Video1Click(Sender: TObject);
var
  DrvList: TStrings;
begin
  ComboBox1.Clear;
  playdlg.Video1.DriverOpen := false;
  drvList := GetDriverList;
  Combobox1.Items := drvList;
  ReadVideoReg;
  drvList.Clear;
  drvList.Free;
  playdlg.video1.DriverIndex := combobox1.ItemIndex;
  Video1.Checked := not Video1.Checked;
  n44.Checked := not n44.Checked;
  videopanel.visible := not videopanel.visible;
end;

procedure TMainForm.VideoSourceClick(Sender: TObject);
begin
  playdlg.Video1.DlgVSource;
end;

procedure TMainForm.VideoFormatClick(Sender: TObject);
begin
  playdlg.video1.DlgVFormat;
end;

procedure TMainForm.VrShadowButton4Click(Sender: TObject);
begin
  playdlg.video1.DlgVDisplay;
end;

procedure TMainForm.ReadVideoReg;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  Reg.OpenKey('\play2000\video', True);
  playdlg.video1.Top := StrToInt(Reg.ReadString('top'));
  playdlg.video1.left := StrToInt(Reg.ReadString('left'));
  playdlg.video1.Height := StrToInt(Reg.ReadString('Height'));
  playdlg.video1.Width := StrToInt(Reg.ReadString('Width'));
  ComboBox1.ItemIndex := StrToInt(Reg.ReadString('driver'));
  Reg.CloseKey;
  Reg.Free;
end;

procedure TMainForm.WriteVideoReg;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey('\Play2000\video', True) then
      begin
        Reg.WriteString('top', IntToStr(playdlg.edittext.Top));
        Reg.WriteString('Left', IntToStr(playdlg.edittext.Left));
        Reg.WriteString('Width', IntToStr(playdlg.edittext.Width));
        Reg.WriteString('Height', IntToStr(playdlg.edittext.Height));
        Reg.WriteString('driver', inttostr(combobox1.Itemindex));
      end;
  finally
    Reg.CloseKey;
    Reg.Free;
  end;

end;

procedure TMainForm.btnVideoPlayClick(Sender: TObject);
begin
  btnVideoPlay.Enabled := False;
  btnVideoStop.enabled := True;
  playdlg.video1.visible := True;
  playdlg.video1.PreviewScaleToWindow := True;
  playdlg.Video1.VideoOverlay := True;
  playdlg.Video1.DriverOpen := True;
end;

procedure TMainForm.VideoSaveClick(Sender: TObject);
begin
  WriteVideoReg;
  ReadVideoReg;
  playdlg.EditText.Visible := False;
  playdlg.BringToFront;
end;

procedure TMainForm.btnVideoStopClick(Sender: TObject);
begin
  btnVideoPlay.Enabled := true;
  btnVideoStop.enabled := False;
  playdlg.video1.visible := False;
  playdlg.Video1.DriverOpen := False;
end;

procedure TMainForm.btnVideoSizeClick(Sender: TObject);
begin
  playdlg.VCD.Visible := False;
  playdlg.Video1.Visible := False;
  playdlg.EditText.AutoSize := False;
  playdlg.EditText.Caption := '';
  playdlg.EditText.Visible := True;
  playdlg.BringToFront;
end;

procedure TMainForm.videopanelMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  videopanel.Perform(wm_syscommand, $F012, 0);
end;

procedure TMainForm.VrUserLed1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  vruserled1.Active := True;
end;

procedure TMainForm.VrUserLed1MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  playdlg.edittext.Top := 0;
  playdlg.edittext.Left := 0;
  playdlg.edittext.Width := LedWidth;
  playdlg.edittext.Height := LedHeight;
  VrUserLed1.active := False;
end;

procedure TMainForm.VrUserLed2MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  vruserled2.active := True;
end;

procedure TMainForm.VrUserLed2MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  playdlg.edittext.Top := 0;
  playdlg.edittext.Left := 0;
  playdlg.edittext.Width := LedWidth;
  playdlg.edittext.Height := LedHeight;
  VrUserLed2.Active := False;
end;

procedure TMainForm.VrShadowButton2Click(Sender: TObject);
begin
  N28Click(Self);
end;

procedure TMainForm.MYFlcStop(var Msg: TMessage);
begin
  PlayDlg.Flc.PlayState := 0;
  PlayDlg.Flc.Visible := False;
  if not FlcThread.Suspended then
    FlcThread.Suspend;
  if (MainForm.SimType = 1) then
    begin
      PlayDlg.FXLabel1.DeletePicture;
      PlayDlg.FXLabel1.SetPicturePos(PlayDlg.Flc.Left, PlayDlg.Flc.Top);
      PlayDlg.FXLabel1.Picture.LoadFromFile(MainForm.Path + 'tmp\avi.bmp');
      playdlg.FXLabel1.FXEnabled := True;
      playdlg.FXLabel1.Refresh;
      MainForm.Sim_Grid;
    end;
  if (MainForm.SimType <> 1) then
    begin
      PlayDlg.FXLabel1.SetPicturePos(PlayDlg.Flc.Left, PlayDlg.Flc.Top);
      PlayDlg.FXLabel1.Picture.LoadFromFile(MainForm.Path + 'tmp\avi.bmp');
      PlayDlg.FXLabel1.FXEnabled := True;
    end;
end;

procedure TMainForm.N38Click(Sender: TObject);
begin
  with PlayDlg.FXLabel1 do
    begin
      TEffect := 0;
      TDelay := 1;
      TGrain := 10;
      TEnabled := True;
      TOnly := True;
      FXEnabled := True;
      Update := True;
      Refresh;
      Paint;
    end;
  Playdlg.Image1.Picture := nil;
  Playdlg.Image2.Picture := nil;
  PlayDlg.BackBmp;
end;

procedure TMainForm.N39Click(Sender: TObject);
begin
  gridpanel.top := 60;
  gridpanel.left := 60;
  gridPanel.Visible := True;
end;

procedure TMainForm.N45Click(Sender: TObject);
begin
  tabPanel.top := 60;
  tabPanel.left := 60;
  tabPanel.Visible := True;
end;

procedure TMainForm.N46Click(Sender: TObject);
begin
  Playdlg.top := 60;
  Playdlg.left := 60;
  PlayDlg.show;
end;

procedure TMainForm.N47Click(Sender: TObject);
begin
  PosPanel.top := 60;
  PosPanel.left := 60;
  PosPanel.Visible := True;
end;

procedure TMainForm.N48Click(Sender: TObject);
begin
  SimPanel.top := 60;
  SimPanel.left := 60;
  SimPanel.Visible := True;
end;

procedure TMainForm.N49Click(Sender: TObject);
begin
  Fontdlg.left := 60;
  FontDlg.top := 60;
  FontDlg.show;
end;

procedure TMainForm.VCD1Click(Sender: TObject);
begin
  vcdPanel.top := 60;
  vcdPanel.left := 60;
  VcdPanel.Visible := True;
end;

procedure TMainForm.N50Click(Sender: TObject);
begin
  videoPanel.top := 60;
  videoPanel.left := 60;
  videoPanel.Visible := True;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  WriteReg;
  btnStopClick(Self);
  FlcThread.Free;
  CanClose := True;
end;

function TMainForm.ReadCtab: Boolean;
var
  i, j: integer;
begin
  j := 0;
  for i := 1 to TabGrid.RowCount - 1 do
    begin
      if (((DateToStr(Now) >= TabGrid.Cells[2, i]) and
        (DateToStr(Now) <= TabGrid.Cells[4, i]) and
        (TimeToStr(Now) >= TabGrid.Cells[3, i]) and
        (TimeToStr(Now) <= TabGrid.Cells[5, i])) or
        (TabGrid.Cells[2, i] = '')) and (TabGrid.Cells[1, i] = '') then
        begin
          try
            Grid.LoadFromcsv(Path + 'prg\' + TabGrid.Cells[1, i]);
          except
            MessageDlg('第' + IntToStr(i) + '行节目不存在',
              mtWarning, [mbOK], 0);

            Continue;
          end;
          Grid.LoadFromcsv(Path + 'prg\' + TabGrid.Cells[1, i]);
          MainForm.Caption := Path + 'prg\' + TabGrid.Cells[1, i];
          Index1 := i;
          j := 1;
          Break;
        end;
    end;

  if j = 0 then
    begin
      MessageDlg('节目表中没有可播放的节目!' + #13 + #10 + #13 + #10 +
        '请建立节目!',mtError, [mbOK], 0);
      btnPlay.Enabled := False;
      btnStep.Enabled := False;
      N28Click(Self);
      Result := False;
    end
  else
    TabGrid.autonumbercol(0);
    Result := True;
end;

procedure TMainForm.TabGridAutoDeleteRow(Sender: TObject; aRow: Integer);
begin
  TabGrid.autonumbercol(0);
end;

procedure TMainForm.TabGridAutoInsertRow(Sender: TObject; ARow: Integer);
begin
  TabGrid.autonumbercol(0);
end;

procedure TMainForm.TabGridRowMoved(Sender: TObject; FromIndex,
  ToIndex: Integer);
begin
  TabGrid.autonumbercol(0);
end;

end.