unit1.pas

通讯屏控制卡串口发送 最大控制宽度达2048列

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, CL2005OCXLib_TLB, StdCtrls, ExtCtrls;

Const
    LedType     =   2;      // 控制卡类型,1-4
    LedNum      =   0;      // 控制卡编号,由控制卡上的跳线设定
    LedWidth    =   384;    // 屏体宽度,由CL2005节目管理系统设定
    LedHeight   =   128;    // 屏体高度,由CL2005节目管理系统设定
    LedColor    =   1;      // 颜色, 0:单色,1:双色, 由CL2005节目管理系统设定

    ComPort     =   1;      // 串行口
    ComBaudRate =   38400;  // 通讯速率,由控制卡跳线设定
    ComDelay    =   1000;   // 等待应答的延时,由通讯质量及速率和数据包大小决定
                            //      一般至少取800以上

    _ROLE       :  Array [0..15] Of Word =
            ($8000,$4000,$2000,$1000,$0800,$0400,$0200,$0100,
             $0080,$0040,$0020,$0010,$0008,$0004,$0002,$0001);

type
    // 图片缓冲区大小必须如此设定,不得更改
    PictType =  Array[0..511] Of Array[0..127] Of SmallInt;
    // 节目表结构,各域的顺序和大小均不得改变
    ProgType = Record
	    PictIndex	: BYTE;
	    Enter		: BYTE;
	    Leave		: BYTE;
	    Speed		: BYTE;
	    StayTime	: BYTE;
	    bFollowFlag	: BYTE;
	    bShowTimer	: BYTE;
	    bTimerPlay	: BYTE;
	    TimerMode	: BYTE;
	    WeekFlag	: BYTE;
	    StartHour	: BYTE;
	    StartMinute	: BYTE;
	    EndHour	    : BYTE;
	    EndMinute	: BYTE;
	    NotUsed0	: BYTE;
	    NotUsed1	: BYTE;
    End;

  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    CL2005: TCL2005Ocx;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
        Procedure PictToBuff(dc:TCanvas; Var buff:PictType;
                                PictWidth:Integer;PictHeight:integer;
                                Width:integer; height:integer; color:integer);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// 通用的将图片转换成PictTYpe数组的子程序

Procedure   TForm1.PictToBuff ( dc:TCanvas;         // TBitmap或TPicture类的Canvas成员
                                Var buff:PictType;  // 存放结果的缓冲区
                                PictWidth:Integer;  // 图片的宽度
                                PictHeight:Integer; // 图片的高度
                                Width:integer;      // 屏体宽度
                                height:integer;     // 屏体高度
                                color:integer);     // 显示屏颜色
Var x,y,z,EndX,EndY : Integer;
    vC              : TColor;
    v,xv            : Word;
Begin
    // 清空缓冲区
    For y:=0 To 511 Do
        For X:=0 To 127 Do
            buff[y][x] := 0;

    // 根据图片和屏体的宽高决定截取图片的宽高,保证数据不越界
    If PictWidth >=Width  Then EndX:=Width  Else EndX:=PictWidth;
    If PictHeight>=Height Then EndY:=Height Else EndY:=PictHeight;

    // 遍历高度和宽度
    // 先截取红色
    For y:=0 To EndY-1 Do
        For x:=0 To (EndX+15) Div 16 Do
        Begin
            v := 0;
            For z:=0 To 15 Do
            Begin
                vC := dc.Pixels[x*16+z,y];
                If vC And RGB($ff,0,0) > RGB($80,0,0) Then v := v Or _ROLE[z];
            End;
            xv := (v And $ff)*256 +(v Div 256);         // 交换高低字节
            buff[y][x] := xv;
        End;
    // 双色屏再截取绿色
    If color<>0 Then
    Begin
        For y:=0 To EndY-1 Do
            For x:=0 To (EndX+15) Div 16 Do
            Begin
                v := 0;
                For z:=0 To 15 Do
                Begin
                    vC := dc.Pixels[x*16+z,y];
                    If vC And RGB(0,$ff,0) > RGB(0,$80,0) Then v := v Or _ROLE[z];
                End;
                xv := (v And $ff)*256 +(v Div 256);   // 交换高低字节
                buff[y+Height][x] := xv;
            End;
    End;
End;

procedure TForm1.Button1Click(Sender: TObject);
Var bOK      :   Boolean;
    SendBuff :   PictType;
    ProgBuff :   Array [0..9] Of ProgType;
begin
    PictToBuff(Image1.Canvas,SendBuff,Image1.Width,Image1.Height,
                LedWidth,LedHeight,LedColor);

    // 初始化串行通讯
    bOK := CL2005.ComInitial(ComPort,ComBaudRate,ComDelay);
    If Not bOK Then MessageBox(Self.Handle,'初始化串口失败','显示图片',MB_OK)
    Else
    Begin
        // 设置屏体(控制卡)属性
        bOK := CL2005.SetLEDProperty(LedType,LedNum,LedWidth,LedHeight,LedColor,1);

        // 发送图片
        If bOK Then bOK := CL2005.SendPicture(0,Integer(@SendBuff[0][0]));

        // 发送节目表
        If bOK Then
        Begin
            ProgBuff[0].PictIndex   := 0;   // 图片0的播放属性
            ProgBuff[0].Enter       := 3;   // 进入方式2
            ProgBuff[0].Leave       := 0;   // 退出方式
            ProgBuff[0].Speed       := 10;  // 进入速度
            ProgBuff[0].StayTime    := 5;   // 停留时间
            ProgBuff[0].bFollowFlag := 0;   // 非紧随模式
            ProgBuff[0].bShowTimer  := 0;   // 非整页时钟项
            ProgBuff[0].TimerMode   := 0;   // 不显示日期时间
            ProgBuff[0].bTimerPlay  := 0;   // 非定时播放项

            bOK := CL2005.SendProgList(1,Integer(@ProgBuff[0]));
        End;
        CL2005.CloseCL2005();
        If bOK
            Then MessageBox(Self.Handle,'发送成功','发送图片',MB_OK)
            Else MessageBox(Self.Handle,'发送失败','发送图片',MB_OK);
    End;
end;

// 显示文字,此前需运行CL2005.exe程序上载汉字库
procedure TForm1.Button2Click(Sender: TObject);
Var     S : String;
     bOK  : Boolean;
begin
    S := '`01红`02绿`03黄';
    bOK := CL2005.ComInitial(ComPort,ComBaudRate,ComDelay);
    If Not bOK Then MessageBox(Self.Handle,'串口初始化失败','显示文字',MB_OK)
    Else
    Begin
        bOK := CL2005.SetLEDProperty(LedType,LedNum,LedWidth,LedHeight,LedColor,1);
        If bOK Then bOK := CL2005.SwitchToBank(0);                                  // 切换到页面0
        If bOK Then bOK := CL2005.ShowString(1,LedWidth-3*16,0,0,Integer(Pchar(S)));// 在页面1输出
        If bOK Then bOK := CL2005.SwitchToBank(1);                                  // 切换到页面1
        CL2005.CloseCL2005();
        If bOK
            Then MessageBox(Self.Handle,'发送成功','显示文字',MB_OK)
            Else MessageBox(Self.Handle,'发送失败','显示文字',MB_OK);
    End;
end;

procedure TForm1.Button3Click(Sender: TObject);
Var bOK : Boolean;
begin
    bOK := CL2005.ComInitial(ComPort,ComBaudRate,ComDelay);
    If Not bOK Then MessageBox(Self.Handle,'串口初始化失败','复位控制卡',MB_OK)
    Else
    Begin
        bOK := CL2005.SetLEDProperty(LedType,LedNum,LedWidth,LedHeight,LedColor,1);
        If bOK Then bOK:=CL2005.Reset();
        CL2005.CloseCL2005();
        If bOK
            Then MessageBox(Self.Handle,'发送成功','复位控制卡',MB_OK)
            Else MessageBox(Self.Handle,'发送失败','复位控制卡',MB_OK);
    End;
end;

end.