mainplay.pas

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

        checkbox1.Checked := True
      else
        checkbox1.Checked := False;
      if Grid.Cells[19, IndexRow] = '1' then
        checkbox2.Checked := True
      else
        checkbox2.Checked := False
    end;

  with PlayDlg.EditText do
    begin
      FontSize := fontdlg.FontSize.Value;
      FontBlockSize := fontdlg.ShSize.Value;
      Font3D := fontdlg.VrSlider1.Position;
      FontName := fontdlg.lmdfontcombobox1.SelectedFont;
      BackColor := fontdlg.fontBackColor.SelectedColor;
      Font3DColor2 := fontdlg.fontWeightColor.SelectedColor;
      Font3DColor1 := fontdlg.fontLightColor.SelectedColor;
      FontOutlineColor := fontdlg.fontOutLineColor.SelectedColor;
      FontShadowColor := fontdlg.fontShadowColor.SelectedColor;
      ForeColor := fontdlg.fontForeColor.SelectedColor;
      FontItalic := fontdlg.checkbox2.Checked;
      FontBold := fontdlg.checkbox1.Checked;
      caption := fontdlg.edit1.Text;
    end;
  ReadPosition;
end;

procedure TMainForm.ReadPosition;
var
  dc: HDC;
begin
  with fontdlg do
    begin
      d_x.value := StrToInt(Grid.Cells[20, IndexRow]);
      d_y.value := StrToInt(Grid.Cells[21, IndexRow]);
      d_x1.value := StrToInt(Grid.Cells[22, IndexRow]);
      d_y1.value := StrToInt(Grid.Cells[23, IndexRow]);
      d_x2.value := StrToInt(Grid.Cells[24, IndexRow]);
      d_y2.value := StrToInt(Grid.Cells[25, IndexRow]);
      with playdlg.FXLabel1 do
        begin
          dc := GetDC(Handle);
          BitBlt(playdlg.Image1.Canvas.Handle, d_x.Value, d_y.Value, d_x2.Value,
            d_y2.Value, dc, 0, 0, BLACKNESS);
          ReleaseDC(Handle, dc);
          playdlg.BackBmp;
        end;
      playdlg.edittext.AutoSize := False;
      playdlg.EditText.Top := d_y1.Value;
      playdlg.EditText.Left := d_x1.Value;
      playdlg.EditText.Width := d_x2.Value;
      playdlg.EditText.Height := d_y2.Value;
      playdlg.FXLabel1.TEnabled := False;
    end;
end;

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

procedure TMainForm.DTApplayMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  DTApplay.Active := False;
  if StartData.Date <= EndData.Date then
    begin
      if StartData.Date = EndData.Date then
        if StartTime.Time >= EndTime.Time then
          begin
            MessageDlg('定时时间错误', mtError, [mbOK], 0);
            Exit;
          end;
    end
  else
    begin
      MessageDlg('定时时间错误', mtError, [mbOK], 0);
      Exit;
    end;
  TabGrid.Cells[2, index1] := DateToStr(StartData.Date);
  TabGrid.Cells[4, Index1] := DateToStr(EndData.Date);
  TabGrid.Cells[3, Index1] := TimeToStr(StartTime.Time);
  TabGrid.Cells[5, Index1] := TimeToStr(EndTime.Time);
end;

procedure TMainForm.TabGridClickCell(Sender: TObject; Arow, Acol: Integer);
begin
  Index1 := Arow;
  if (TabGrid.Cells[1, Index1] <> '') and (TabGrid.Cells[2, Index1] <> '') and
    (Arow <> 0) then
    begin
      StartData.Date := StrToDate(TabGrid.Cells[2, index1]);
      EndData.Date := StrToDate(TabGrid.Cells[4, Index1]);
      StartTime.Time := StrToTime(TabGrid.Cells[3, Index1]);
      EndTime.Time := StrToTime(TabGrid.Cells[5, Index1]);
    end
end;

procedure TMainForm.SaveGridFile;
var
  i: Integer;
  Loopp: Boolean;
begin
  Savefile.InitialDir := '';
  SaveFile.Filter := '';
  SaveFile.InitialDir := Path + 'prg\';
  SaveFile.Filter := '节目文件|*.ply';
  Loopp := True;
  if SaveFile.Execute then
    if (SaveFile.FileName <> '') then
      begin
        i := 1;
        while Loopp do
          begin
            if i = grid.rowcount then
              Loopp := False
            else
              begin
                if grid.cells[1, i] = '' then
                  begin
                    grid.RemoveRows(i, 1);
                    i := 0;
                  end;
              end;
            i := i + 1;
          end;
        if Grid.RowCount=1 then
        begin
					 MessageDlg('保存节目不能为空!', mtError, [mbOK], 0);
           exit;
        end;
        btnPlay.Enabled := True;
			  btnStep.Enabled := True;
        for i := 1 to (Grid.RowCount - 1) do
          begin
            if (Grid.Cells[1, i] = '动画命令') or (Grid.Cells[1, i] = '图形命令')
              then
              if (UpperCase(ExtractFilePath(Grid.Cells[2, i])) <> UpperCase(Path
                + 'grp\')) or
                (UpperCase(ExtractFilePath(Grid.Cells[2, i])) <> UpperCase(Path
                + 'avi\')) then
                begin
                  FileTb.SourceFile := Grid.Cells[2, i];

                  if UpperCase(ExtractFileExt(Grid.Cells[2, i])) <> '.FLC' then
                    FileTb.DestFile := Path + 'grp\' +
                      ExtractFileName(Grid.Cells[2,
                      i])
                  else
                    FileTb.DestFile := Path + 'avi\' +
                      ExtractFileName(Grid.Cells[2,
                      i]);
                  Grid.Cells[2, i] := FileTb.DestFile;
                  if UpperCase(FileTb.SourceFile) <> UpperCase(FileTb.DestFile)
                    then
                    FileTb.Execute;
                end;
          end;
        grid.Refresh;
        Grid.SaveToCSV(SaveFile.FileName);
        MainForm.Caption := SaveFile.FileName;
        CtbFileList.ApplyFilePath(Path + '\prg');
      end;
end;

procedure TMainForm.SimPlay(CommId: string);
begin
  playdlg.BringToFront;
  Playdlg.Image1.Visible := False;
  Playdlg.Image2.Visible := False;
  Playdlg.Fxlabel1.Visible := True;
  if SimType = 1 then
    playdlg.FXLabel1.Notify := true
  else
    playdlg.FXLabel1.Notify := False;
  if ((Commid = '动画命令') and (playdlg.VCD.Visible = true)) or (Commid='') then
    begin
      sim_grid;
      Exit;
    end;
  if Commid = '文字命令' then
    Sim_Text(True, SimFlag.Active)
  else
    if Commid = '图形命令' then
      Sim_Grp(SimFlag.Active)
    else
      if (Commid = '动画命令') then
        Sim_Avi
      else
        if Commid = '清屏命令' then
          Sim_Text(False, SimFlag.Active);

end;

procedure TMainForm.Sim_Avi;
begin
  fontdlg.avibak.FileName := Grid.Cells[2, IndexRow];
  fontdlg.AviBak.StartFrame := fontdlg.AviBak.TotalFrames;
  fontdlg.avibak.SaveFrame(Path + '\tmp\avi.bmp');
  playdlg.FXLabel1.Notify := False;
  with playdlg.FXLabel1 do
    begin
      Update := False;
      UpdateArea := 1;
      Alignment := 0;
      Updatex := StrToInt(Grid.Cells[20, IndexRow]);
      UpdateY := StrToInt(Grid.Cells[21, IndexRow]);
      UpdateW := StrToInt(Grid.Cells[24, IndexRow]);
      UpdateH := StrToInt(Grid.Cells[25, IndexRow]);
      FontDlg.AviDelay.Value := StrToInt(Grid.Cells[8, IndexRow]);
      FXEnabled := True;
      Update := True;
      Refresh;
    end;
  with playdlg.flc do
    begin
      Loops := 1;
      try
        FileName := Grid.Cells[2, IndexRow];
      finally
        FileName := Path + 'avi\Inwood.flc'
      end;
      WindowShape := StrtoInt(Grid.Cells[3, IndexRow]);
      Top := StrToInt(Grid.Cells[21, IndexRow]);
      Left := StrToInt(Grid.Cells[20, IndexRow]);
      Width := StrToInt(Grid.Cells[24, IndexRow]);
      Height := StrToInt(Grid.Cells[25, IndexRow]);
      Visible := True;
      PlayState := 1;
      Sleep(10);
      FlcThread.Flag := False;
      if FlcThread.Suspended then
        FlcThread.Resume;
    end;

end;

procedure TMainForm.Sim_Grp(SPFlag: Boolean);
begin
  with playdlg.FXLabel1 do
    begin
      Update := False;
      UpdateArea := 1;
      DeleteCompose;
      DeletePicture;
      Caption := '';
      SetPicturePos(StrToInt(Grid.Cells[20, IndexRow]), StrToInt(Grid.Cells[21,
        IndexRow]));
      SetEffectPos(StrToInt(Grid.Cells[20, IndexRow]), StrToInt(Grid.Cells[21,
        IndexRow]));
      Alignment := 0;
      TEnabled := False;
      TOnly := False;
      Updatex := StrToInt(Grid.Cells[20, IndexRow]);
      UpdateY := StrToInt(Grid.Cells[21, IndexRow]);
      UpdateW := StrToInt(Grid.Cells[24, IndexRow]);
      UpdateH := StrToInt(Grid.Cells[25, IndexRow]);
      try
        Picture.LoadFromFile(Grid.Cells[2, IndexRow]);
      finally
        Picture.LoadFromFile(Path + 'grp\Logo.bmp');
      end;
      MDelay := StrToInt(Grid.Cells[4, IndexRow]);
      MGrain := StrToInt(Grid.Cells[10, IndexRow]);
      if SPFlag then
        MEffect := StrToInt(Grid.Cells[3, IndexRow])
      else
        MEffect := 0;
      NotifyDelay := StrToInt(Grid.Cells[8, IndexRow]);
      FXEnabled := True;
      Update := True;
      Refresh;
    end;
end;

procedure TMainForm.Sim_Text(CTOption: Boolean; SPFlag: Boolean);
begin
  with playdlg.FXLabel1 do
    begin
      Update := False;
      UpdateArea := 1;
      SetTextPos(StrToInt(Grid.Cells[20, IndexRow]), StrToInt(Grid.Cells[21,
        IndexRow]));
      SetEffectPos(StrToInt(Grid.Cells[20, IndexRow]), StrToInt(Grid.Cells[21,
        IndexRow]));
      Alignment := 0;
      Updatex := StrToInt(Grid.Cells[20, IndexRow]);
      UpdateY := StrToInt(Grid.Cells[21, IndexRow]);
      UpdateW := StrToInt(Grid.Cells[24, IndexRow]);
      UpdateH := StrToInt(Grid.Cells[25, IndexRow]);
      if CTOption then
        begin
          TEnabled := False;
          TOnly := False;
          Caption := Grid.Cells[2, IndexRow];
          MDelay := StrToInt(Grid.Cells[4, IndexRow]);
          FontName := Grid.Cells[5, IndexRow];
          FontSize := StrToInt(Grid.Cells[6, IndexRow]);
          Font3D := StrToInt(Grid.Cells[7, IndexRow]);
          FontBlockSize := strToInt(Grid.Cells[9, IndexRow]);
          MGrain := StrToInt(Grid.Cells[10, IndexRow]);
          ForeColor := strToInt(Grid.Cells[11, IndexRow]);
          BackColor := strToInt(Grid.Cells[12, IndexRow]);
          fontOutLineColor := strToInt(Grid.Cells[13, IndexRow]);
          Font3DColor1 := strToInt(Grid.Cells[14, IndexRow]);
          Font3DColor2 := strToInt(Grid.Cells[15, IndexRow]);
          FontShadowColor := strToInt(Grid.Cells[16, IndexRow]);
          if SPFlag then
            MEffect := StrToInt(Grid.Cells[3, IndexRow])
          else
            MEffect := 0;
          if Grid.Cells[18, IndexRow] = '1' then
            FontBold := True
          else
            FontBold := False;
          if Grid.Cells[19, IndexRow] = '1' then
            FontItalic := True
          else
            FontItalic := False;
        end
      else
        begin
          if SPFlag then
            TEffect := StrToInt(Grid.Cells[3, IndexRow])
          else
            TEffect := 0;
          TDelay := StrToInt(Grid.Cells[4, IndexRow]);
          TGrain := StrToInt(Grid.Cells[10, IndexRow]);
          TEnabled := True;
          TOnly := True;
        end;
      NotifyDelay := StrToInt(Grid.Cells[8, IndexRow]);
      FXEnabled := True;
      Update := True;
      Refresh;
      Paint;
    end;
end;

procedure TMainForm.btnStopClick(Sender: TObject);
begin
  SendMessage(handle, MY_FlcStop, 0, 0);
  GridPanel.Enabled := True;
  PosPanel.Enabled := true;
  TabPanel.enabled := true;
  vcdpanel.enabled := true;
  videopanel.enabled := true;
  btnPlay.Enabled := True;
  btnStep.Enabled := True;
  MenuOn;
  FlcThread.Flag := True;
  with playdlg do
    begin
      FXLabel1.AbortEffect;
      FXLabel1.Notify := False;
      FXLabel1.FXEnabled := False;
      Flc.PlayState := 0;
      if not FlcThread.Suspended then
        FlcThread.Suspend;
      FXLabel1.DeletePicture;
      SaveBack;
      SaveBackPrv;
      BackBmp;
      Flc.Visible := False;
    end;
  playdlg.BringToFront;
end;

procedure TMainForm.btnPlayClick(Sender: TObject);
begin
  GridPanel.enabled := False;
  PosPanel.Enabled := False;
  TabPanel.enabled := False;
  vcdpanel.enabled := False;
  videopanel.enabled := False;
  MenuOff;
  btnStep.Enabled := False;
  btnStop.Enabled := True;
  SimType := 1;
  with playdlg do
    begin
      EditText.Visible := False;
      FXLabel1.AbortEffect;
      FXLabel1.FXEnabled := False;
      image1.Visible := False;
      Image2.Visible := False;
      FXLabel1.Visible := True;
      Flc.PlayState := 0;
      Flc.Visible := False;
      FlcThread.Flag := True;
      if not FlcThread.Suspended then
        FlcThread.Suspend;
    end;
  SimFlag.Caption := '有效果';
  SimFlag.Active := True;
  IndexRow := 0;
  Sim_grid;
end;

procedure TMainForm.btnStepClick(Sender: TObject);
begin
  SimType := 2;
  btnPlay.Enabled := False;
  btnStop.Enabled := True;
  with playdlg do
    begin
      FXLabel1.AbortEffect;
      FXLabel1.Notify := False;
      FXLabel1.FXEnabled := False;
      Flc.PlayState := 0;
      if not FlcThread.Suspended then
        FlcThread.Suspend;
      FXLabel1.DeletePicture;
      FlcThread.Flag := True;
      SaveBack;
      SaveBackPrv;
      Flc.Visible := False;
    end;
  Sim_Grid;
end;

procedure TMainForm.SimFlagClick(Sender: TObject);
begin
  SimFlag.Active := not SimFlag.Active;
  if SimFlag.Active then
    SimFlag.Caption := '有效果'
  else
    SimFlag.Caption := '无效果';
end;

procedure TMainForm.Sim_grid;
begin
  IndexRow := IndexRow + 1;
  playdlg.FXLabel1.DeletePicture;
  if IndexRow > (Grid.RowCount - 1) then
    begin
      Grid.TopRow := 1;
      IndexRow := 0;
      if SimType = 1 then
        ReadTabGrid();
    end
  else
    if IndexRow > 5 then
      Grid.TopRow := IndexRow - 2
    else
      Grid.Row := IndexRow;

  SimPlay(Grid.Cells[1, IndexRow]);