LED字幕显示屏

unit P2000R10A;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, Menus, ExtCtrls, lmdctrl, lmdstdcS, lmdextcS, lmdcctrl, Grids,
  StdCtrls, lmdstdcA, lmdcombo, Buttons, OleCtrls, lmdbtn, CheckLst, registry,
  lmdmmS, lmdshapA, RzStatus, RzDBStat, RzPrgres, RzPanel,
  lmdcompo, lmdclass, lmdnonvS, lmdgroup, AdPort, AdvGrid, FileCtrl,
  RzButton, VrControls, VrLcd, OoMisc;

type
  TfrmsignA = class(TForm)
    ScrollBox1: TScrollBox;
    Panel7: TPanel;
    ScrollBox2: TScrollBox;
    SetupBox: TGroupBox;
    Label8: TLabel;
    CommPort1: TRadioButton;
    CommPort2: TRadioButton;
    Panel3: TPanel;
    Label9: TLabel;
    Sign_Speed: TLMDSpinEdit;
    Sign_Height: TLMDSpinEdit;
    Panel1: TPanel;
    Memo1: TMemo;
    GroupBox1: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    SendList: TListBox;
    RzStatusBar1: TRzStatusBar;
    RzStatusPane: TRzStatusPane;
    RzKeyStatus: TRzKeyStatus;
    RzKeyStatus1: TRzKeyStatus;
    RzClockStatus: TRzClockStatus;
    Timer1: TTimer;
    CommPort: TApdComPort;
    SendGrid: TAdvStringGrid;
    Panel2: TPanel;
    DriveComboBox1: TDriveComboBox;
    DirectoryListBox1: TDirectoryListBox;
    FileListBox1: TFileListBox;
    Edit1: TEdit;
    Label1: TLabel;
    Cls: TRzBitBtn;
    Send: TRzBitBtn;
    CheckSignSend: TRzBitBtn;
    StopCheckSend: TRzBitBtn;
    btnNewFile: TRzBitBtn;
    btnLoadFile: TRzBitBtn;
    btnSaveFile: TRzBitBtn;
    SaveConfig: TRzBitBtn;
    LoadSendSign: TRzBitBtn;
    Panel4: TPanel;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    Label2: TLabel;
    OutEffect: TComboBox;
    Label3: TLabel;
    OutSpeed: TLMDSpinEdit;
    LineNum: TLabel;
    VrClock1: TVrClock;
    RzBitBtn1: TRzBitBtn;
    LMD3DEffectButton2: TLMD3DEffectButton;
    Splitter1: TSplitter;
    VrNum1: TVrNum;
    RadioButton5: TRadioButton;
    RadioButton6: TRadioButton;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure btnLoadFileClick(Sender: TObject);
    procedure btnNewFileClick(Sender: TObject);
    procedure btnSaveFileClick(Sender: TObject);
    procedure SaveConfigClick(Sender: TObject);
    procedure LoadSignSendClick(Sender: TObject);
    procedure SendClick(Sender: TObject);
    procedure LMD3DEffectButton2Click(Sender: TObject);
    procedure ClsClick(Sender: TObject);
    procedure CheckSignSendClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure StopCheckSendClick(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure RadioButton3Click(Sender: TObject);
    procedure RadioButton4Click(Sender: TObject);
    procedure SendGridSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure FileListBox1DblClick(Sender: TObject);
    procedure RzBitBtn1Click(Sender: TObject);
    procedure RadioButton6Click(Sender: TObject);
    procedure RadioButton5Click(Sender: TObject);

  private
    { Private declarations }
//    SelectFlag: integer;
    sendLine: integer;
    Sign_Color: integer;
    SendByte: array[0..1800] of byte;
    Tmp: array of byte;
    Comm: Integer;
    SignHeight: integer;
    Speed: integer;
    sign_Color_tmp: integer;
    SendString: array[0..5] of string;
    ByteLength: integer;
    DisplayDirct: Boolean;
    CurrentLine: integer;
    Big5:Boolean;
  public
    { Public declarations }

    procedure SaveFile(Filename: string);
    procedure WriteReg();
    procedure ReadReg();
    procedure SendIDCode(PortID: byte);
    procedure SendCls();
    procedure Text_Command(Color, Position, Style: byte; Send_Text: string);
    procedure ClipWindows_Command(x, y, x1, y1: integer);
    function GetCheckSum: integer;
    procedure Cls_Command();
    procedure Delay_Command;
    procedure DownItem;
    procedure UpItem;
    procedure ZMTOTXT(FileName: string);

  end;

var
  frmsignA: TfrmsignA;

implementation

uses CVCode;

{$R *.DFM}

procedure TfrmsignA.SendIDCode;
var
  SendId: array of byte;
  i: integer;
begin
  SetLength(SendId, 4);
  {SendId[0]:=$9a;   //Start Code
  SendId[1]:=$00;   //ID_Length
  SendId[2]:=$00;   //Start_ID
  SendId[3]:=$00;   //End_ID}
  SendId[0] := $9A; //Start Code
  SendId[1] := $01; //ID_Length
  SendId[2] := PortID; //ID
  SendId[3] := $00; //Send Command Startcode 00
  for i := 0 to 3 do
    CommPort.PutChar(char(SendId[i]));
end;

procedure TfrmsignA.SaveFile(Filename: string);
var
  MyFile: TextFile;
begin
  AssignFile(MyFile, FileName);
  ReWrite(MyFile);
  try
    Write(MyFile, Memo1.text);
  finally
    CloseFile(MyFile);
  end;
end;

procedure TfrmsignA.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Memo1.Modified then
    BtnSaveFileClick(Sender);
  Action := caFree;
end;

procedure TfrmsignA.FormCreate(Sender: TObject);
begin
  ReadReg();
  DisplayDirct := True;
  OutEffect.ItemIndex := 0;
  CurrentLine := 1;
  Big5:=False;
  DirectoryListBox1.Directory := ExtractFileDir(Application.ExeName);
  SendGrid.ColWidths[1] := 270;
end;

procedure TfrmsignA.ReadReg;
var
  Reg: TRegistry;
  Tmp: integer;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('\Software\2000r10\', True) then
    begin
      Tmp := Reg.ReadInteger('Comm');
      case Tmp of
        1:
          begin
            commPort1.Checked := True;
            Comm := 1;
          end;
        2:
          begin
            CommPort2.Checked := True;
            Comm := 2;
          end;
      end;
      Sign_Color := Reg.ReadInteger('Color');
      SignHeight := Reg.ReadInteger('Height');
      sign_Height.Text := inttostr(SignHeight);
      SendLine := Reg.ReadInteger('Line');
      Speed := Reg.ReadInteger('Speed');
      Sign_Speed.Value := Speed;
    end;
  finally
    Reg.CloseKey;
    Reg.Free;
    CommPort.ComNumber := Comm;
  end;
end;

procedure TfrmsignA.WriteReg;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('\Software\2000r10\', True) then
    begin
      Comm := 2;
      if CommPort1.Checked = true then
        Comm := 1;
      Reg.WriteInteger('Comm', Comm);
      Reg.WriteInteger('Color', Sign_Color_Tmp);
      Reg.WriteInteger('Height', Sign_Height.Value);
      SignHeight := Sign_Height.Value;
      case signHeight of
	16: SendLine := 1;
	24: SendLine := 1;
        48: SendLine := 2;
        32: SendLine := 2;
      end;
      Reg.WriteInteger('Line', SendLine);
      Reg.WriteInteger('Speed', Sign_Speed.Value);
    end;
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
end;

procedure TfrmsignA.RadioButton1Click(Sender: TObject);
begin
  Panel1.Enabled := False;
  Panel3.Enabled := True;
  Panel7.enabled := True;
  SendGrid.SetFocus;
  SendGrid.TopRow := 0;
end;

procedure TfrmsignA.RadioButton2Click(Sender: TObject);
begin
  Panel1.Enabled := True;
  Panel7.Enabled := False;
  Panel3.Enabled := False;
  Memo1.SetFocus
end;

procedure TfrmsignA.btnLoadFileClick(Sender: TObject);
begin
  if Trim(Edit1.Text) = '' then
  begin
    showmessage('请输入要装入的文件名');
    exit;
  end;
  if Memo1.Modified then
    BtnSaveFileClick(Sender);
  BtnSaveFile.Enabled := True;
  Memo1.Enabled := true;
  Memo1.Lines.LoadFromFile(Edit1.text);

end;

procedure TfrmsignA.btnNewFileClick(Sender: TObject);
begin
  if Memo1.Modified then
    if MessageDlg('是否保存文件?', mtInformation, [mbYes, mbNo], 0) = mrYes then
      BtnSaveFileClick(Sender);
  BtnSaveFile.Enabled := True;
  Edit1.Text := '';
  Memo1.Lines.Clear;
end;

procedure TfrmsignA.btnSaveFileClick(Sender: TObject);
begin
  if Trim(Edit1.Text) = '' then
  begin
    showmessage('请输入要保存的文件名');
    exit;
  end;
  if MessageDlg('是否将节目保存为' + Edit1.text, mtInformation, [mbYes, mbNo], 0)
    = mrYes then
  begin
    SaveFile(Edit1.Text);
    Memo1.Modified := False;
    FileListBox1.Update;
  end;
end;

procedure TfrmsignA.SaveConfigClick(Sender: TObject);
begin
  WriteReg();
  ReadReg();
end;

procedure TfrmsignA.LoadSignSendClick(Sender: TObject);
var
  i: Integer;
  Txt: TextFile;
  Tmp: string;
begin
  if Trim(Edit1.Text) = '' then
  begin
    showmessage('请输入要装入的文件名');
    exit;
  end;
  for i := 0 to SendGrid.RowCount - 1 do
  begin
    if SendGrid.RowSelectCount <> 0 then
      SendGrid.RowSelect[i] := False
    else
      Break;
  end;
  LoadSendSign.Enabled:=False;
  vrNum1.Value:=0;
  GroupBox1.Enabled := True;
  SendGrid.LockUpdate := True;
  SendGrid.Clear;
  self.Refresh;
  AssignFile(Txt, Edit1.Text);
  Reset(Txt);
  i := 0;
  while not Eof(Txt) do
  begin
    Readln(Txt, Tmp);
    SendGrid.Cells[1, i] := Tmp;
    if (i mod 100)=0 then
	    VrNum1.Value:=i;
    i := i +1;
  end;
   VrNum1.Value:=i;
  CloseFile(Txt);
  CheckSignSend.Enabled := True;
  SendGrid.RowSelect[1] := True;
  SendGrid.TopRow := 0;
    SendGrid.Row := 0;
  SendString[1] := '';
  if SendLine = 2 then
    SendString[2] := '';
  SendString[1] := SendGrid.Cells[1, 0];
  if SendLine = 2 then
    SendString[2] := SendGrid.Cells[1, 1];