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

📄 fontdlg_frm.pas

📁 unit Video interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, stdctrl
💻 PAS
📖 第 1 页 / 共 2 页
字号:
procedure Tfontdlg.Button5Click(Sender: TObject);
begin
  openavi.InitialDir := '';
  openavi.Filter := '';
  openavi.FileName := '';
  openavi.InitialDir := MainForm.Path + 'grp\';
  openavi.Filter :=
    '图形文件|*.bmp|BMP文件(*.bmp)|*.bmp';
  if Openavi.Execute then
    if openavi.Files.Strings[0] <> '' then
      begin
        playdlg.edittext.AutoSize := False;
        playdlg.EditText.Caption := '';
        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;
        filenameflag := 1;
        redrawtext();
      end;
end;

procedure Tfontdlg.LoadAviClick(Sender: TObject);
var
  SubStr: pchar;
begin
  substr := '';
  openavi.InitialDir := '';
  openavi.Filter := '';
  openavi.FileName := '';
  openavi.InitialDir := MainForm.Path + 'avi\';
  OpenAvi.Filter := '动画文件|*.flc|flc文件(*.flc)|*.flc';
  if Openavi.Execute then
    if strpos(pchar(openavi.Files.Strings[0]), SubStr) = nil then
      begin
        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.WindowShape := Combobox1.ItemIndex;
        avibak.AutoSize := False;
        Avibak.SetBounds(8, 106, 160, 164);
        AviBak.Stretch := True;
        AviBak.PlayState := 1;
        playdlg.edittext.AutoSize := False;
        playdlg.EditText.Caption := '';
        playdlg.edittext.Width := avibak.FlcWidth;
        playdlg.edittext.Height := avibak.FlcHeight;
        avibak.SaveFrame(MainForm.Path + 'Tmp\avi.bmp');
        playdlg.EditText.DeletePicture;
        playdlg.EditText.picture.Bitmap.LoadFromFile(MainForm.Path +
          'tmp\avi.bmp');
        filenameflag := 1;
      end;
end;

procedure Tfontdlg.btnOKClick(Sender: TObject);
begin
  fximage2.FXEnabled := False;
  if not MainForm.GridIns then
    begin
      MainForm.Grid.Row := MainForm.Grid.RowCount - 1;
      SendMessage(Mainform.Grid.Handle, WM_KEYDOWN, VK_INSERT, 45);
      MainForm.IndexRow := MainForm.Grid.RowCount - 1;
    end;
  case MainPlay.CommandID of
    1:
      begin
        if Edit1.Text = '' then
          begin
            Application.MessageBox('文本不能为空', '错误信息', MB_OK +
              MB_DEFBUTTON1);
            exit;
          end;
        WriteGrid_Text;
      end;
    2:
      begin
        if OpenAvi.FileName = '' then
          begin
            Application.MessageBox('图形不能为空', '错误信息', MB_OK +
              MB_DEFBUTTON1);
            photo1.Picture := nil;
            exit;
          end;
        WriteGrid_Grp;
      end;
    3:
      WriteGrid_Cls;
    4:
      begin
        if OpenAvi.FileName = '' then
          begin
            Application.MessageBox('动画不能为空', '错误信息', MB_OK +
              MB_DEFBUTTON1);
            exit;
          end;
        WriteGrid_Avi;
      end;
  end;
  if not MainForm.GridIns then
    MainForm.Grid.Row := MainForm.Grid.RowCount - 1;
  MainForm.Grid.AutoNumberCol(0);
  with playdlg do
    begin
      SaveBack;
      SaveBackPrv;
      BackBmp;
      EditText.Visible := False;
      EditText.Picture := nil;
      EditText.Caption := '';
    end;
  fontdlg.Edit1.Text := '';
  MainForm.MenuOn;
  fontdlg.Hide;
  MainForm.GridPanel.Enabled := True;
  MainForm.SimPanel.Enabled := True;
end;

procedure Tfontdlg.WriteGrid_Avi;
begin
  with MainForm.Grid do
    begin
      Cells[1, MainForm.IndexRow] := '动画命令';
      Cells[2, MainForm.IndexRow] := aviBak.FileName;
      Cells[3, MainForm.IndexRow] := Inttostr(avibak.windowshape);
      Cells[4, MainForm.IndexRow] := '';
      Cells[5, MainForm.IndexRow] := '';
      Cells[6, MainForm.IndexRow] := '';
      Cells[7, MainForm.IndexRow] := '';
      Cells[8, MainForm.IndexRow] := InttoStr(AviDelay.Value);
      Cells[9, MainForm.IndexRow] := '';
      Cells[10, MainForm.IndexRow] := '';
      Cells[11, MainForm.IndexRow] := '';
      Cells[12, MainForm.IndexRow] := '';
      Cells[13, MainForm.IndexRow] := '';
      Cells[14, MainForm.IndexRow] := '';
      Cells[15, MainForm.IndexRow] := '';
      Cells[16, MainForm.IndexRow] := '';
      Cells[17, MainForm.IndexRow] := '';
      Cells[18, MainForm.IndexRow] := '';
      Cells[19, MainForm.IndexRow] := '';
      PositionEqu;
    end;
end;

procedure Tfontdlg.WriteGrid_Cls;
begin
  with MainForm.Grid do
    begin
      Cells[1, MainForm.IndexRow] := '清屏命令';
      Cells[2, MainForm.IndexRow] := '';
      Cells[3, MainForm.IndexRow] := label9.text;
      Cells[4, MainForm.IndexRow] := inttostr(speedbtn.Value);
      Cells[5, MainForm.IndexRow] := '';
      Cells[6, MainForm.IndexRow] := '';
      Cells[7, MainForm.IndexRow] := '';
      Cells[8, MainForm.IndexRow] := IntToStr(DelayBtn.Value);
      Cells[9, MainForm.IndexRow] := '';
      Cells[10, MainForm.IndexRow] := inttostr(stepbtn.Value);
      Cells[11, MainForm.IndexRow] := '';
      Cells[12, MainForm.IndexRow] := '';
      Cells[13, MainForm.IndexRow] := '';
      Cells[14, MainForm.IndexRow] := '';
      Cells[15, MainForm.IndexRow] := '';
      Cells[16, MainForm.IndexRow] := '';
      Cells[17, MainForm.IndexRow] := '';
      Cells[18, MainForm.IndexRow] := '';
      Cells[19, MainForm.IndexRow] := '';
      PositionEqu;
    end;
end;

procedure Tfontdlg.WriteGrid_Grp;
begin
  with MainForm.Grid do
    begin
      Cells[1, MainForm.IndexRow] := '图形命令';
      Cells[2, MainForm.IndexRow] := GrpName.Caption;
      Cells[3, MainForm.IndexRow] := label9.text;
      Cells[4, MainForm.IndexRow] := inttostr(speedbtn.Value);
      Cells[5, MainForm.IndexRow] := '';
      Cells[6, MainForm.IndexRow] := '';
      Cells[7, MainForm.IndexRow] := '';
      Cells[8, MainForm.IndexRow] := IntToStr(DelayBtn.Value);
      Cells[9, MainForm.IndexRow] := '';
      Cells[10, MainForm.IndexRow] := inttostr(stepbtn.Value);
      Cells[11, MainForm.IndexRow] := '';
      Cells[12, MainForm.IndexRow] := '';
      Cells[13, MainForm.IndexRow] := '';
      Cells[14, MainForm.IndexRow] := '';
      Cells[15, MainForm.IndexRow] := '';
      Cells[16, MainForm.IndexRow] := '';
      Cells[17, MainForm.IndexRow] := '';
      Cells[18, MainForm.IndexRow] := '';
      Cells[19, MainForm.IndexRow] := '';
      PositionEqu;
    end;
end;

procedure Tfontdlg.btnCancelClick(Sender: TObject);
begin
  fontdlg.Hide;
  fximage2.FXEnabled := False;
  playdlg.EditText.Visible := False;
  Playdlg.EditText.Caption := '';
  Playdlg.EditText.Picture := nil;
  playdlg.BackBmpprv;
  filenameflag := 0;
  MainForm.MenuOn;
  MainForm.GridPanel.Enabled := True;
  MainForm.SimPanel.Enabled := True;
end;

procedure Tfontdlg.SimEffect;
begin
  fximage2.AbortEffect;
  fximage2.FXEnabled := True;
  fximage2.Visible := false;
  fximage2.EffectCue := true;
  fximage2.Visible := true;
  fximage2.EffectCue := false
end;

procedure Tfontdlg.WriteGrid_Text;
begin
  with MainForm.Grid do
    begin
      Cells[1, MainForm.IndexRow] := '文字命令';
      Cells[2, MainForm.IndexRow] := edit1.Text;
      Cells[3, MainForm.IndexRow] := label9.text;
      Cells[4, MainForm.IndexRow] := inttostr(speedbtn.Value);
      Cells[5, MainForm.IndexRow] := lmdfontcombobox1.SelectedFont;
      Cells[6, MainForm.IndexRow] := inttostr(FontSize.value);
      Cells[7, MainForm.IndexRow] := inttostr(playdlg.EditText.Font3D);
      Cells[8, MainForm.IndexRow] := IntToStr(DelayBtn.Value);
      Cells[9, MainForm.IndexRow] := inttostr(ShSize.Value);
      Cells[10, MainForm.IndexRow] := inttostr(stepbtn.Value);
      Cells[11, MainForm.IndexRow] := inttostr(fontForeColor.SelectedColor);
      Cells[12, MainForm.IndexRow] := inttostr(fontBackColor.SelectedColor);
      Cells[13, MainForm.IndexRow] := inttostr(fontOutLineColor.SelectedColor);
      Cells[14, MainForm.IndexRow] := inttostr(fontLightColor.SelectedColor);
      Cells[15, MainForm.IndexRow] := inttostr(fontWeightColor.SelectedColor);
      Cells[16, MainForm.IndexRow] := inttostr(fontShadowColor.SelectedColor);
      Cells[17, MainForm.IndexRow] := '';
      if checkbox1.Checked then
        Cells[18, MainForm.IndexRow] := '1'
      else
        Cells[18, MainForm.IndexRow] := '0';
      if checkbox2.Checked then
        Cells[19, MainForm.IndexRow] := '1'
      else
        Cells[19, MainForm.IndexRow] := '0';
      PositionEqu;
    end;
end;

procedure Tfontdlg.PositionEqu;
begin
  with MainForm.Grid do
    begin
      d_y.value := playdlg.edittext.top;
      d_x.value := playdlg.edittext.left;
      d_y1.value := playdlg.edittext.top;
      d_x1.value := playdlg.edittext.left;
      d_x2.value := playdlg.edittext.width;
      d_y2.value := playdlg.edittext.Height;
      Cells[20, MainForm.IndexRow] := inttostr(d_x.value);
      Cells[21, MainForm.IndexRow] := inttostr(d_y.value);
      Cells[22, MainForm.IndexRow] := inttostr(d_x1.value);
      Cells[23, MainForm.IndexRow] := inttostr(d_y1.value);
      Cells[24, MainForm.IndexRow] := inttostr(d_x2.value);
      Cells[25, MainForm.IndexRow] := inttostr(d_y2.value);
    end;
end;

procedure Tfontdlg.N1Click(Sender: TObject);
begin
  N1.Enabled := False;
  N2.Enabled := True;
  EffectView.FullCollapse;
  EffectView.Refresh;
end;

procedure Tfontdlg.N2Click(Sender: TObject);
begin
  N1.Enabled := True;
  N2.Enabled := False;
  EffectView.FullExpand;
  EffectView.Refresh;
end;

procedure Tfontdlg.EffectViewClick(Sender: TObject);
var
  i: integer;
begin
  if (EffectView.Selected <> nil) then
    with EffectView.Selected do
      if HasChildren then
        begin
          Expanded := not Expanded;
        end
      else
        begin
          i := Integer(Data);
          if (i >= 37) or (i <= 39) and (stepbtn.Value < 5) then
            stepbtn.Value := 10;
          if (i >= 60) and (i <= 67) and (stepbtn.Value < 5) then
            stepbtn.Value := 10;
          if (i >= 90) and (i <= 97) and (stepbtn.Value <= 2) then
            stepbtn.Value := 10;
          if (i <> -1) then
            begin
              label9.Text := IntToStr(i);
              playdlg.EditText.MEffect := i;
              playdlg.EditText.MGrain := stepbtn.Value;
              playdlg.EditText.MDelay := speedbtn.Value;
              FXImage2.MEffect := i;
              FXImage2.MGrain := stepbtn.Value;
              FXImage2.MDelay := speedbtn.Value;
              SimEffect;
            end
        end;
end;

procedure Tfontdlg.EffectViewGetImageIndex(Sender: TObject;
  Node: TTreeNode);
begin
  with Node do
    if HasChildren then
      ImageIndex := 0
    else
      ImageIndex := 1;
end;

procedure Tfontdlg.EffectViewGetSelectedIndex(Sender: TObject;
  Node: TTreeNode);
begin
  with Node do
    if not HasChildren then
      SelectedIndex := 2;
end;

procedure Tfontdlg.FormActivate(Sender: TObject);
begin
  playdlg.FXLabel1.AbortEffect;
  playdlg.FXLabel1.FXEnabled := False;
  playdlg.EditText.Visible := True;
end;

procedure Tfontdlg.btnPosAppClick(Sender: TObject);
begin
  playdlg.edittext.top := d_y1.value;
  playdlg.edittext.left := d_x1.value;
  playdlg.edittext.width := d_x2.value;
  playdlg.edittext.Height := d_y2.value;
end;

procedure Tfontdlg.FullScreenClick(Sender: TObject);
begin
  with playdlg.edittext do
    begin
      top := 0;
      left := 0;
      width := playdlg.FXLabel1.Width;
      Height := playdlg.FXLabel1.Height;
      d_y.value := top;
      d_x.value := left;
      d_y1.value := top;
      d_x1.value := left;
      d_x2.value := width;
      d_y2.value := height
    end;
end;

procedure Tfontdlg.VrUserLed1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FullScreenClick(Self);
end;

procedure Tfontdlg.FormShow(Sender: TObject);
begin
  MainForm.MenuOff;
end;

procedure Tfontdlg.ComboBox1Change(Sender: TObject);
begin
  AviBak.WindowShape := Combobox1.ItemIndex;
  avibak.AutoSize := False;
  Avibak.SetBounds(8, 106, 160, 164);
  AviBak.Stretch := True;
  AviBak.PlayState := 1;
end;

end.

⌨️ 快捷键说明

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