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
ictType; 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
ictType; // 存放结果的缓冲区 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.