myedit.pas

delphi LED 显示屏用,带串口发送,内容编辑,演示功能

unit myedit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TC32EventState = (evBreak, evCTS, evDSR, evError, evRing,
    evRlsd, evRxChar, evRxFlag, evTxEmpty);
  TC32EventType = set of TC32EventState;

  TBaudRate = (cbr110, cbr300, cbr600, cbr1200, cbr2400, cbr4800,
               cbr9600, cbr14400, cbr19200, cbr38400, cbr56000,
               cbr57600, cbr115200, cbr128000, cbr256000);
  TParity = (paNone, paOdd, paEven, paMark, paSpace);
  TStopbits = (sb10, sb15, sb20);
  TFlowControl = (fcNone, fcCTS, fcDTR, fcSoftware, fcDefault);

  TComm32Option = (osParityCheck, osDsrSensitivity, osIgnoreXOff,
                osErrorChar, osNullStrip);
  TComm32Options = set of TComm32Option;

type tpinf=record
   color: longint;
   fontsize: integer;
   fontname: integer;
   fontstyle:integer;
   extra: integer;
end;

type sendinf=record
     sendred: array[0..255] of array[0..255] of byte;
     sendgreen: array[0..255] of array[0..255] of byte;
end;

type tpstrinf=record
    lineheight:integer;
    linebyte:integer;
    no:integer;
end;

type
  Tmyedit = class(TCustomControl)
  private
    Faddflag:boolean;
    Fplay: Boolean;
    Ftpcount:integer;
    Ftppos:longint;
    Ftxt:ansistring;
    Ftpbyte:integer;
    Ftprownum:integer;
    Fscale:integer;
    Fspace:integer;
    Fdataflag:boolean;
    fontname:Tstrings;
    Fselectbmpno:integer;

    FDeviceName: String;
    FBaudRate: TBaudRate;
    FParity: TParity;
    FStopbits: TStopbits;
    FDatabits: integer;
    FReadBufferSize: Integer;
    FWriteBufferSize: Integer;

    dispno,aleft,atop,awidth,aheight:integer;
    selectdot:integer;
    selectdotx,selectdoty:array[1..8] of integer;
    pushed:boolean;
    selectdispno:integer;
    startposx,startposy,pmouseposx,pmouseposy:integer;
    procedure setaddflag(Value: Boolean);
    procedure setplay(Value: Boolean);
    procedure settpbyte(Value: integer);
    procedure settprownum(Value: integer);
    procedure settxt(value:ansistring);
    procedure settpcount(Value: integer);
    procedure settppos(Value: integer);
    procedure Setselectbmpno(Value: integer);
    procedure setscale(Value: integer);
    procedure setspace(Value: integer);
    procedure setdataflag(Value: boolean);

    procedure SetBaudRate(Value: TBaudRate);
    procedure SetParity(Value: TParity);
    procedure SetStopbits(Value: TStopBits);
    procedure SetDatabits(Value: integer);
  protected
    FHandle: THandle;
    FWriteEvent: THandle;
    FCT: TComStat;
    FDCB: TDCB;
    FCommConfig: TCommConfig;
    FErrors: dword;
    FIOpending: Boolean;
    FWriteOS: TOverlapped;
    FMonitorEvents: TC32EventType;
    FOptions: TComm32Options;
    FXonChar: char;
    FXoffChar: char;

    hCloseEvent: THandle;
    HandlesToWaitFor: array[0..2] of THandle;
    dwHandleSignaled: DWORD;
    BytesTransferred: DWORD;
    Status: dword;
    OverlappedCommEvent: TOverlapped;

    myfont:TLogFont;
    sysfont:Tfont;
    bmp:Tbitmap;
    bmptemp,bmpbak:tbitmap;
    totalline:integer;
    procedure paint;override;
    procedure calpaint;
    procedure selseccursor(x,y:integer);
    procedure readselectdot(Index: Integer);
    procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMMouseMove(var Msg: TWMMouseMove); message WM_MOUSEMOVE;
    procedure WMLButtonUp(var Msg: TWMLButtonUp); message WM_LBUTTONUP;
    procedure readdata(Index: Integer);
    procedure Opencom;
    procedure readstatus;
    procedure Write(const Buf; Count: Integer);

  public

    tptotal:integer;
    tpdata:array[0..30000] of tpinf;
    tpstr:array[0..5000] of tpstrinf;
    paramtext:ansistring;
    senddata:sendinf;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear;
    procedure change;
    procedure writestr;
    procedure readdot(pageno:integer);
    function  readasc(pageno:integer):string; overload;
    function  readasc:string; overload;
    function  readcolor(pageno:integer):string; overload;
    function  readcolor:string; overload;
    function  dotinrect(x,y,x1,y1,x2,y2:integer):boolean;
    procedure addimage(const S: string);
    procedure insertpara(startpos,len,totallen,colorvalue,sizevalue,namevalue,stylevalue:longint);
    procedure deletepara(startpos,len,totallen:longint);
    procedure movepara(startpos,len,endpos,fontcolor,fontsize,fontname,stylevalue:longint);
    procedure changepara(startpos,selectlen,klen,k,fontcolor,fontsize,fontname,stylevalue:longint);
    procedure addstyle(startpos,endpos,value:integer);
    procedure subbstyle(startpos,endpos,value:integer);
    procedure changestyle(startpos,endpos,value:integer);
    procedure changeextra(startpos,endpos,value:integer);
    procedure Clearimage;
    function GetimageCount: Integer;
    function Getimage(Index: Integer): string;
    procedure Insertimage(Index: Integer; const S: string);
    procedure deleteimage(Index: Integer);
    function GetCells(ACol, ARow: Integer): string;
    procedure SetCells(ACol, ARow: Integer; const Value: string);
    procedure senddatetime;
    procedure sendbyte(Bufbyte: byte);
    procedure initcom(comstr:string);
    procedure closecom;
  published
      property DeviceName: string read FDeviceName write FDeviceName;
      property BaudRate: TBaudRate read FBaudRate write SetBaudRate default cbr9600;
      property Parity: TParity read FParity write SetParity default paNone;
      property Stopbits: TStopbits read FStopbits write SetStopbits default sb10;
      property Databits: integer read FDatabits write SetDatabits default 8;
      property ReadBufferSize: Integer read FReadBufferSize write FReadBufferSize default 4096;
      property WriteBufferSize: Integer read FWriteBufferSize write FWriteBufferSize default 2048;

     property addflag:boolean read Faddflag write setaddflag;
     property Play:boolean read Fplay write setplay;
     property Dataflag:boolean read Fdataflag write setdataflag;
     property  Tpbyte:integer read Ftpbyte write settpbyte;
     property  Tprownum:integer read Ftprownum write settprownum;
     property  Scale:integer read Fscale write setscale;
     property  Space:integer read Fspace write setspace;
     property Tpcount:integer read Ftpcount write settpcount;
     property Tppos:longint read Ftppos write settppos;
     property Txt:ansistring read Ftxt write settxt;
     property Selectbmpno:integer read Fselectbmpno write Setselectbmpno;
     property Color;
     property Font;
     property canvas;
     property visible;
     property OnClick;
     property OnDblClick;
     property Onkeyup;
     property Onkeypress;
     property Onkeydown;
     property Onmouseup;
     property Onmousemove;
     property Onmousedown;
     property OnDragDrop;
     property OnDragOver;
     property OnEndDock;
     property OnEndDrag;
  end;

const
   bmm:array[0..7] of byte=($80,$40,$20,$10,8,4,2,1);
   SCREENCOLOR:array[0..2] of int64=($ff,$ff00,$ffff);
  fBinary           = $00000001;
  fParity           = $00000002;
  fOutxCtsFlow      = $00000004;
  fOutxDsrFlow      = $00000008;
  fDtrControl       = $00000030;
  fDsrSensitivity   = $00000040;
  fTXContinueOnXoff = $00000080;
  fOutX             = $00000100;
  fInX              = $00000200;
  fErrorChar        = $00000400;
  fNull             = $00000800;
  fRtsControl       = $00003000;
  fAbortOnError     = $00004000;
  fDummy2           = $FFFF8000;

  CBR: array[TBaudRate] of Integer =
    (CBR_110, CBR_300, CBR_600, CBR_1200, CBR_2400, CBR_4800, CBR_9600,
     CBR_14400, CBR_19200, CBR_38400, CBR_56000, CBR_57600, CBR_115200,
     CBR_128000, CBR_256000);

  PAR: array[TParity] of Integer =
    (NOPARITY, ODDPARITY, EVENPARITY, MARKPARITY, SPACEPARITY);

  STB: array[TStopbits] of Integer =
    (ONESTOPBIT, ONE5STOPBITS, TWOSTOPBITS);

  OPT: array[TComm32Option] of Integer =
   (fParity, fDsrSensitivity, fTXContinueOnXoff, fErrorChar, fNull);
 EvList: array[TC32EventState] of dword = (EV_BREAK, EV_CTS, EV_DSR, EV_ERR,
    EV_RING, EV_RLSD, EV_RXCHAR, EV_RXFLAG, EV_TXEMPTY);

procedure Register;

implementation

constructor Tmyedit.Create(AOwner: TComponent);
var
    i:integer;
begin
    inherited Create(AOwner);
    Width := 256;
    Height := 256;
    ControlStyle := ControlStyle - [csOpaque];
    color:=clBlack;
    Ftxt:='';
    paramtext:='';
    Ftpcount:=0;
    Ftppos:=0;
    Ftpbyte:=32;
    Ftprownum:=16;
    Fscale:=1;
    totalline:=0;
    tptotal:=0;
    Faddflag:=false;
    Fplay:=false;
    Fdataflag:=false;
    Fselectbmpno:=-1;
    tpstr[0].no:=0;
    fontname:=screen.Fonts;

    tpdata[0].color:=0;
    tpdata[0].fontsize:=12;
    tpdata[0].fontname:=fontname.Count-1;
    tpdata[0].fontstyle:=0;
    tpdata[0].extra:=0;
    for i:=1 to 30000 do  tpdata[i]:=tpdata[i-1];

    bmp:=Tbitmap.Create;
    bmptemp:=Tbitmap.Create;
    bmpbak:=Tbitmap.Create;
    FHandle := INVALID_HANDLE_VALUE;
    FDeviceName := 'COM2';
    FBaudRate := cbr9600;
    FParity := paNone;
    FStopbits := sb10;
    FDatabits := 8;
    FXonChar := #17;
    FXoffChar := #19;
    FOptions := [];
    FMonitorEvents := [evBreak, evCTS, evDSR, evError, evRing,
                     evRlsd, evRxChar, evRxFlag, evTxEmpty];
    FReadBufferSize := 4096;
    FWriteBufferSize := 2048;

     sysfont:=Tfont.Create;
     sysfont.Assign(font);
     myfont.lfCharSet:=GB2312_CHARSET;
     myfont.lfEscapement:=0;
     myfont.lfOrientation:=0;
end;

destructor Tmyedit.Destroy;
begin
    sysfont.Free;
    bmp.Free;
    bmptemp.Free;
    bmpbak.Free;
    closecom;
    inherited Destroy;
end;

procedure Tmyedit.Clear;
var
    i:integer;
begin
    FSpace:=0;
    Ftxt:='';
    paramtext:='';
    Ftpcount:=0;
    Ftppos:=0;
    totalline:=0;
    tptotal:=0;
    Faddflag:=false;
    Fplay:=false;
    Fselectbmpno:=-1;
    tpdata[0].color:=0;
    tpdata[0].fontsize:=12;
    tpdata[0].fontname:=fontname.Count-1;
    tpdata[0].fontstyle:=0;
    tpdata[0].extra:=0;
    for i:=1 to 30000 do  tpdata[i]:=tpdata[i-1];
    Invalidate;
end;

procedure Tmyedit.settpbyte(Value: integer);
begin
    if Value <> Ftpbyte then
    begin
        Ftpbyte:=Value;
        width:=8*Ftpbyte*Fscale;
    end;
end;

procedure Tmyedit.settprownum(Value: integer);
begin
    if Value <> Ftprownum then
    begin
        Ftprownum:=Value;
        height:=16*Ftprownum*Fscale;
    end;
end;

procedure Tmyedit.setscale(Value: integer);