mainplay.pas

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

  fontdlg.TabSheet3.Enabled := False;
  fontdlg.TabSheet4.Enabled := False;
  fontdlg.TabSheet1.Enabled := True;
  fontdlg.PageControl1.ActivePage := fontdlg.TabSheet1;
  fontdlg.Edit1.SetFocus;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
  Reg: TRegistry;
  i:integer;
begin
  SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
  InsertFlag := 0;
  CommandID := 0;
  VcdCount := 0;
  Path := ExtractFilePath(application.ExeName);
  IndexRow := -1;
  Index1 := 1;
  CtbFileList.ApplyFilePath(Path + 'prg\');
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  Reg.OpenKey('\play2000\runtab', True);
  TabNum.Value := StrToInt(Reg.ReadString('run'));
  Reg.CloseKey;
  Reg.Free;
  StartData.DateTime := Now;
  EndData.DateTime := Now;
  StartTime.DateTime := Now;
  EndTime.DateTime := Now;
  Grid.ExcelClipboardFormat := True;
  TabGrid.ClearRows(1, TabGrid.RowCount - 1);
  TabGrid.RowCount := 2;
  try
    TabGrid.LoadFromCSV(Path + 'ctab\' + IntToStr(TabNum.Value) + '.tab');
  except
    begin
      MessageDlg('节目表' + IntToStr(TabNum.Value) + '不存在' + #13 + #10 + #13
        + #10 + '请建立节目表!', mtWarning, [mbOK], 0);
      N28Click(Self);
      btnPlay.Enabled := False;
      btnStep.Enabled := False;
      TabGrid.Cells[1,0]:='1';
      exit;
    end;
  end;
  for i:=0  to 25  do
    if IsCDROM(i) then
    begin
    	Vcd4.Enabled:=True;
      Vcd3.Enabled:=True;
      Vcd1.Enabled:=True;
    end;
  ReadCtab();
  FLCThread := TFlcHread.Create(True);
end;

procedure TMainForm.textcommandClick(Sender: TObject);
begin
  FontDlg.fximage2.FXEnabled := False;
  GridIns := True;
  Text_Command;
end;

procedure TMainForm.flccommandClick(Sender: TObject);
begin
  FontDlg.fximage2.FXEnabled := False;
  GridIns := True;
  Flc_Command;
end;

procedure TMainForm.clscommandClick(Sender: TObject);
begin
  FontDlg.fximage2.FXEnabled := False;
  GridIns := True;
  Cls_Command;
end;

procedure TMainForm.grpcommandClick(Sender: TObject);
begin
  FontDlg.fximage2.FXEnabled := False;
  GridIns := True;
  Grp_Command;
end;

procedure TMainForm.Edit_Copy1Click(Sender: TObject);
begin
  Grid.CopySelectionToClipboard;
end;

procedure TMainForm.Edit_Paste1Click(Sender: TObject);
begin
  Grid.PasteSelectionFromClipboard;
  grid.autonumbercol(0);
end;

procedure TMainForm.FormShow(Sender: TObject);
var
  DrvList: TStrings;
begin
  ReadReg;
  FontDlg.Hide;
  playdlg.Show;
  ReadVcdReg;
  ComboBox1.Clear;
  playdlg.Video1.DriverOpen := false;
  drvList := GetDriverList;
  Combobox1.Items := drvList;
  if ComboBox1.Items.Count<>0 then
  begin
  	video1.Enabled:=True;
    n44.Enabled:=True;
    n50.Enabled:=True;
  end;
  drvList.Clear;
  drvList.Free;
end;

procedure TMainForm.GridGetCellColor(Sender: TObject; ARow, ACol: Integer;
  AState: TGridDrawState; ABrush: TBrush; AFont: TFont);
begin
  if (acol = 1) and (arow > 0) and (arow < (grid.RowCount - 1) -
    grid.fixedfooters)
    and (not (gdSelected in AState) or (gdFocused in AState)) then
    begin
      abrush.color := clYellow;
      afont.color := clRed;
    end;
  if (arow = 0) then
    begin
      afont.style := [fsBold];
    end;
end;

procedure TMainForm.GridGetAlignment(Sender: TObject; ARow, ACol: Integer;
  var AAlignment: TAlignment);
begin
  if acol = 0 then aAlignment := taCenter;
end;

procedure TMainForm.GridAutoInsertRow(Sender: TObject; ARow: Integer);
begin
  grid.autonumbercol(0);
end;

procedure TMainForm.GridAutoDeleteRow(Sender: TObject;
  aRow: Integer);
begin
  grid.autonumbercol(0);
end;

procedure TMainForm.AdvStringGrid1AutoInsertRow(Sender: TObject;
  ARow: Integer);
begin
  grid.autonumbercol(0);
end;

procedure TMainForm.AdvStringGrid1GetAlignment(Sender: TObject; ARow,
  ACol: Integer; var AAlignment: TAlignment);
begin
  if acol = 0 then aAlignment := taCenter;
  if acol = 1 then aAlignment := taCenter;
end;

procedure TMainForm.AdvStringGrid1GetCellColor(Sender: TObject; ARow,
  ACol: Integer; AState: TGridDrawState; ABrush: TBrush; AFont: TFont);
begin
  if (acol = 1) and (arow > 0) and (arow <= (grid.RowCount - 1) -
    grid.fixedfooters)
    and (not (gdSelected in AState) or (gdFocused in AState)) then
    begin
      abrush.color := clYellow;
      afont.color := clRed;
    end;
  if (arow = 0) then
    begin
      afont.style := [fsBold];
    end;
end;

procedure TMainForm.GridSelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
begin
  IndexRow := ARow;
  GridIns := False;
end;

procedure TMainForm.LMDSpeedButton6Click(Sender: TObject);
begin
  playdlg.Left := playdlg.Left - 1;
end;

procedure TMainForm.LMDSpeedButton7Click(Sender: TObject);
begin
  playdlg.Left := playdlg.Left + 1;
end;

procedure TMainForm.LMDSpeedButton8Click(Sender: TObject);
begin
  playdlg.Top := playdlg.Top - 1;
end;

procedure TMainForm.LMDSpeedButton9Click(Sender: TObject);
begin
  playdlg.Top := playdlg.Top + 1;
end;

procedure TMainForm.ReadReg;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey('\Play2000\Position', True) then
      begin
        playdlg.Top := StrToInt(Reg.ReadString('PlayDlgTop'));
        playdlg.Left := StrToInt(Reg.ReadString('PlayDlgLeft'));
        FontDlg.Top := StrToInt(Reg.ReadString('FontDlgTop'));
        FontDlg.Left := StrToInt(Reg.ReadString('FontDlgLeft'));
        LedWidth := StrToInt(Reg.ReadString('Width'));
        LedHeight := StrToInt(Reg.ReadString('Height'));
        GridPanel.top := StrToInt(Reg.ReadString('gridPaneltop'));
        GridPanel.Left := StrToInt(Reg.ReadString('gridPanelLeft'));
        tabPanel.top := StrToInt(Reg.ReadString('tabPaneltop'));
        tabPanel.Left := StrToInt(Reg.ReadString('tabPanelLeft'));
        simPanel.top := StrToInt(Reg.ReadString('simPaneltop'));
        simPanel.Left := StrToInt(Reg.ReadString('simPanelLeft'));
        PosPanel.top := StrToInt(Reg.ReadString('posPanelTop'));
        posPanel.Left := StrToInt(Reg.ReadString('posPanelLeft'));
        vcdPanel.top := StrToInt(Reg.ReadString('vcdPanelTop'));
        vcdPanel.Left := StrToInt(Reg.ReadString('vcdPanelLeft'));
        playdlg.Image1.Width := LedWidth;
        playdlg.Image2.Width := LedWidth;
        playdlg.Image1.Height := LedHeight;
        playdlg.Image2.Height := LedHeight;
      end;
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
  playdlg.ClientWidth := LedWidth;
  playdlg.ClientHeight := LedHeight;
  FrameHeight.Value := LedHeight;
  FrameWidth.Value := LedWidth;
end;

procedure TMainForm.WriteReg;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey('\Play2000\Position', True) then
      begin
        Reg.WriteString('PlayDlgTop', IntToStr(playdlg.Top));
        Reg.WriteString('PlayDlgLeft', IntToStr(playdlg.Left));
        Reg.WriteString('FontDlgTop', IntToStr(FontDlg.Top));
        Reg.WriteString('FontDlgLeft', IntToStr(FontDlg.Left));
        Reg.WriteString('Width', IntToStr(LedWidth));
        Reg.WriteString('Height', IntToStr(LedHeight));
        Reg.WriteString('gridPaneltop', IntToStr(MainForm.GridPanel.top));
        Reg.WriteString('gridPanelLeft', IntToStr(MainForm.GridPanel.Left));
        Reg.WriteString('tabPaneltop', IntToStr(MainForm.tabPanel.top));
        Reg.WriteString('tabPanelLeft', IntToStr(MainForm.tabPanel.Left));
        Reg.WriteString('simPaneltop', IntToStr(MainForm.simPanel.top));
        Reg.WriteString('simPanelLeft', IntToStr(MainForm.simPanel.Left));
        Reg.WriteString('posPanelTop', IntToStr(MainForm.PosPanel.top));
        Reg.WriteString('posPanelLeft', IntToStr(MainForm.posPanel.Left));
        Reg.WriteString('vcdPanelTop', IntToStr(MainForm.vcdPanel.top));
        Reg.WriteString('vcdPanelLeft', IntToStr(MainForm.vcdPanel.Left));
      end;
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
end;

procedure TMainForm.btnPosOKClick(Sender: TObject);
begin
  WriteReg;
  N30Click(Self);
end;

procedure TMainForm.btnPosCancelClick(Sender: TObject);
begin
  ReadReg;
  N30Click(Self);
end;

procedure TMainForm.FrameWidthChange(Sender: TObject);
begin
  playdlg.ClientWidth := FrameWidth.Value;
  LedWidth := FrameWidth.Value;
  playdlg.Image1.Width := LedWidth;
  playdlg.Image2.Width := LedWidth;
end;

procedure TMainForm.FrameHeightChange(Sender: TObject);
begin
  playdlg.ClientHeight := FrameHeight.Value;
  LedHeight := FrameHeight.Value;
  playdlg.Image1.Height := LedHeight;
  playdlg.Image2.Height := LedHeight;
end;

procedure TMainForm.VrMediaButton2Click(Sender: TObject);
begin
  TabNum.Value := TabNum.Value + 1;
  TabGrid.ClearRows(1, TabGrid.RowCount - 1);
  TabGrid.RowCount := 2;
  try
    TabGrid.LoadFromCSV(Path + '\ctab\' + IntToStr(TabNum.Value) + '.tab');
  except

    MessageDlg('节目表' + IntToStr(TabNum.Value) + '不存在', mtWarning, [mbOK],
      0);
  end;
end;

procedure TMainForm.VrMediaButton1Click(Sender: TObject);
begin
  TabNum.Value := TabNum.Value - 1;
  TabGrid.ClearRows(1, TabGrid.RowCount - 1);
  TabGrid.RowCount := 2;
  try
    TabGrid.LoadFromCSV(Path + '\ctab\' + IntToStr(TabNum.Value) + '.tab');
  except

    MessageDlg('节目表' + IntToStr(TabNum.Value) + '不存在', mtWarning, [mbOK],
      0);
  end;
end;

procedure TMainForm.ReadGrid_Avi;
begin
  Flc_Command;
  GridIns := True;
  ReadPosition;
  with fontdlg do
    begin
      if FileExists(Grid.Cells[2, IndexRow]) then
        begin
          openavi.FileName := Grid.Cells[2, IndexRow];
          avibak.WindowShape := Strtoint(Grid.Cells[3, IndexRow]);
          ComboBox1.ItemIndex := avibak.WindowShape;
          avibak.FileName := openavi.FileName;
          if (avibak.FlcWidth > playdlg.fxlabel1.Width) or
            (avibak.FlcHeight > playdlg.FXLabel1.Height) then
            begin
              Application.MessageBox('动画尺寸超出看板尺寸，不能装入',
                '错误信息', MB_OK + MB_DEFBUTTON1);
              exit;
            end;
          avibak.AutoSize := False;
          Avibak.SetBounds(8, 106, 160, 164);
          AviBak.Stretch := True;
          AviBak.PlayState := 1;
          playdlg.edittext.Width := avibak.FlcWidth;
          playdlg.edittext.Height := avibak.FlcHeight;
          avibak.SaveFrame(Path + '\tmp\avi.bmp');
          playdlg.EditText.picture.Bitmap.LoadFromFile(Path + '\tmp\avi.bmp');
        end
      else
        MessageDlg('文件' + Grid.Cells[2, IndexRow] + '不存在', mtError, [mbok],
          0);
      filenameflag := 1;
      AviDelay.Value := StrToInt(Grid.Cells[8, IndexRow]);
    end;
end;

procedure TMainForm.ReadGrid_Cls;
begin
  Cls_Command;
  GridIns := True;
  ReadPosition;
  with fontdlg do
    begin
      label9.text := Grid.Cells[3, IndexRow];
      speedbtn.Value := StrToInt(Grid.Cells[4, IndexRow]);
      DelayBtn.Value := StrToInt(Grid.Cells[8, IndexRow]);
      stepbtn.Value := StrToInt(Grid.Cells[10, IndexRow]);
    end;
end;

procedure TMainForm.ReadGrid_Grp;
begin
  Grp_Command;
  GridIns := True;
  ReadPosition;
  with FontDlg do
    begin
      if FileExists(Grid.Cells[2, IndexRow]) then
        begin
          openavi.FileName := Grid.Cells[2, IndexRow];
          photo1.Picture.Bitmap.LoadFromFile(openavi.Filename);
          label23.caption := inttostr(photo1.Picture.Bitmap.Width);
          label22.caption := inttostr(photo1.Picture.Bitmap.height);
          if (photo1.Picture.Bitmap.Width > playdlg.fxlabel1.Width) or
            (photo1.Picture.Bitmap.Height > playdlg.FXLabel1.Height) then
            begin
              Application.MessageBox('图形尺寸超出看板尺寸，不能装入',
                '错误信息', MB_OK + MB_DEFBUTTON1);
              label23.caption := '';
              label22.caption := '';
              photo1.Picture := nil;
              GrpName.Caption := '';
              exit;
            end
          else
            begin
              GrpName.Caption := openavi.Filename;
              playdlg.EditText.Width := photo1.Picture.Bitmap.Width;
              playdlg.edittext.height := photo1.Picture.Bitmap.Height;
              playdlg.EditText.picture.Bitmap.LoadFromFile(openavi.Filename);
            end;
        end
      else
        MessageDlg('文件' + Grid.Cells[2, IndexRow] + '不存在', mtError, [mboK],
          0);
      label9.text := Grid.Cells[3, IndexRow];
      speedbtn.Value := StrToInt(Grid.Cells[4, IndexRow]);
      DelayBtn.Value := StrToInt(Grid.Cells[8, IndexRow]);
      stepbtn.Value := StrToInt(Grid.Cells[10, IndexRow]);
    end;
end;

procedure TMainForm.ReadGrid_Text;
begin
  Text_Command;
  GridIns := True;
  with Fontdlg do
    begin
      edit1.Text := Grid.Cells[2, IndexRow];
      label9.text := Grid.Cells[3, IndexRow];
      speedbtn.Value := StrToInt(Grid.Cells[4, IndexRow]);
      lmdfontcombobox1.SelectedFont := Grid.Cells[5, IndexRow];
      FontSize.value := StrToInt(Grid.Cells[6, IndexRow]);
      VrSlider1.Position := StrToInt(Grid.Cells[7, IndexRow]);
      DelayBtn.Value := StrToInt(Grid.Cells[8, IndexRow]);
      ShSize.Value := strToInt(Grid.Cells[9, IndexRow]);
      stepbtn.Value := StrToInt(Grid.Cells[10, IndexRow]);
      fontForeColor.SelectedColor := strToInt(Grid.Cells[11, IndexRow]);
      fontBackColor.SelectedColor := strToInt(Grid.Cells[12, IndexRow]);
      fontOutLineColor.SelectedColor := strToInt(Grid.Cells[13, IndexRow]);
      fontLightColor.SelectedColor := strToInt(Grid.Cells[14, IndexRow]);
      fontWeightColor.SelectedColor := strToInt(Grid.Cells[15, IndexRow]);
      fontShadowColor.SelectedColor := strToInt(Grid.Cells[16, IndexRow]);
      if Grid.Cells[18, IndexRow] = '1' then