myedit2.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:array[0..30000] of longint;
   fontsize:array[0..30000] of integer;
   fontname:array[0..30000] of integer;
   fontstyle:array[0..30000] of 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:tbitmap;
    totalline:integer;
    procedure paint;override;
    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: 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);
    procedure readkkdot(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 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 close;
  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;
    for i:=0 to 30000 do
    begin
        tpdata.color[i]:=0;
        tpdata.fontsize[i]:=12;
        tpdata.fontname[i]:=fontname.Count-1;
        tpdata.fontstyle[i]:=0;
    end;
    bmp:=Tbitmap.Create;
    bmptemp:=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;
    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;
    tpstr[0].no:=0;
    for i:=0 to 30000 do
    begin
        tpdata.color[i]:=0;
        tpdata.fontsize[i]:=12;
        tpdata.fontname[i]:=fontname.Count-1;
        tpdata.fontstyle[i]:=0;
    end;
    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);
begin
    if Value <> Fscale then
    begin
        Fscale:=Value;
        width:=8*Ftpbyte*Fscale;
        height:=16*Ftprownum*Fscale;
    end;
end;

procedure Tmyedit.setspace(Value: integer);
begin
    if Value <> Fspace then
    begin
        Fspace:=Value;
    end;
end;

procedure Tmyedit.setplay(Value: Boolean);
begin
    if Value <> Fplay then
    begin
        Fplay:=Value;
        Invalidate;
    end;
end;

procedure Tmyedit.setaddflag(Value: Boolean);
begin
    if Value <> Faddflag then
    begin
        Faddflag:=Value;
        Invalidate;
    end;
end;

procedure Tmyedit.setdataflag(Value: Boolean);
begin
    if Value <> Fdataflag then
    begin
        Fdataflag:=Value;
        writestr;
        paint;
    end;
end;

procedure Tmyedit.Setselectbmpno(Value: integer);
begin
    if (Value <> Fselectbmpno) and (Value<getimagecount) and (Fplay=false) then
    begin
        Fselectbmpno:=Value;
        Invalidate;
    end;
end;

procedure Tmyedit.change;
begin
    if (Ftpcount=0) and (Ftxt<>'') then Ftpcount:=1;
    paint;
end;

procedure Tmyedit.settxt(value:ansistring);
begin
     if  Ftxt<>Value then
     begin
        Ftxt:=value;
     end;
end;

procedure Tmyedit.writestr;
var
   linewidth,lineheight,lineno,kw,kh:integer;
   i,j,klen,kk,k:longint;
   str1,str2:ansistring;
begin
     for i:=0 to 5000 do tpstr[i].no:=0;
     str1:=ftxt;
     klen:=length(str1);
     i:=0;
     kk:=0;
     kw:=0;
     lineno:=0;
     linewidth:=0;
     lineheight:=0;
     Canvas.Font:=font;
     while i<klen do
     begin
          kh:=(4*tpdata.fontsize[i]+1) div 3;
          if str1[i+1]=#13 then
          begin
               if lineheight<kh then lineheight:=kh;
               lineheight:=lineheight;
               tpstr[lineno].lineheight:=lineheight+Fspace;
               tpstr[lineno].linebyte:=i-kk+2;
               lineno:=lineno+1;
               linewidth:=0;
               lineheight:=0;
               i:=i+2;
               kk:=i;
          end
          else
          begin
               str2:=str1[i+1];
               k:=1;
               if str1[i+1]>#$80 then
               begin
                    k:=2;
                    str2:=str2+str1[i+2];
               end;
               kw:=k*kh div 2;
               linewidth:=linewidth+kw;
               if linewidth>8*Ftpbyte then
               begin
                    tpstr[lineno].linebyte:=i-kk;
                    tpstr[lineno].lineheight:=lineheight+Fspace;
                    lineno:=lineno+1;
                    kk:=i;
                    linewidth:=kw;
                    lineheight:=kh;
               end
               else
               begin