myedit2.pas

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

                y1:=y1-msg.ypos+pmouseposy;
            end
            else if (selectdot=4) then
            begin
                x1:=x1+msg.Xpos-pmouseposx;
            end
            else if (selectdot=5) then
            begin
                x1:=x1+msg.Xpos-pmouseposx;
                y1:=y1+msg.ypos-pmouseposy;
            end
            else if (selectdot=6) then
            begin
                y1:=y1+msg.Ypos-pmouseposy;
            end
            else if (selectdot=7) then
            begin
                x:=x+msg.Xpos-pmouseposx;
                x1:=x1-msg.Xpos+pmouseposx;
                y1:=y1+msg.ypos-pmouseposy;
            end
            else if (selectdot=8) then
            begin
                x:=x+msg.Xpos-pmouseposx;
                x1:=x1-msg.Xpos+pmouseposx;
            end;
              if x1<1 then x1:=1;
              if y1<1 then y1:=1; 
           // if x+x1<1 then x:=-x1+1;
           // if y+y1<1 then y:=-y1+1;
            if x>=width then x:=width-2;
         //   if y>=height then y:=height-2;
            if y+selectdispno*height<0 then y:=-selectdispno*height;
            if y>(tptotal-selectdispno)*height-2 then y:=(tptotal-selectdispno)*height-2;
            SetCells(1, Fselectbmpno,inttostr(x));
            SetCells(2, Fselectbmpno,inttostr(y));
            SetCells(3, Fselectbmpno,inttostr(x1));
            SetCells(4, Fselectbmpno,inttostr(y1));
            pmouseposx:=msg.Xpos;
            pmouseposy:=msg.Ypos;
            paint;
        end;
    end
    else selseccursor(msg.Xpos,msg.Ypos);
    inherited;
end;

procedure Tmyedit.selseccursor(x,y:integer);
var
    i:integer;
begin
    if (Fselectbmpno>=0) then
    begin
        cursor:=crDefault;
        selectdot:=0;
        for i:=1 to 8 do
        begin
            if dotinrect(x,y,selectdotx[i],selectdoty[i],5,5) then
            begin
                case i of
                    1,5: cursor:=crSizeNWSE;
                    2,6: cursor:=crSizeNS;
                    3,7: cursor:=crSizeNESW;
                    4,8: cursor:=crSizeWE;
                end;
                selectdot:=i;
                break;
            end;
        end;
    end;
end;

procedure Tmyedit.WMLButtonUp(var msg: TWMLButtonUp);
var
    k:integer;
    str:string;
begin
     if (pushed) and (Faddflag) then
     begin
        canvas.DrawFocusRect(rect(startposx,startposy,pmouseposx,pmouseposy));
        if startposx>pmouseposx then
        begin
            k:=startposx;
            pmouseposx:=startposx;
            startposx:=k;
        end;
        if startposy>pmouseposy then
        begin
            k:=startposy;
            pmouseposy:=startposy;
            startposy:=k;
        end;

        str:=inttostr(Ftpcount-1)+','+inttostr(startposx)+','+inttostr(startposy)+','+inttostr(pmouseposx-startposx)+','+inttostr(pmouseposy-startposy)+','+'1,';
        addimage(str);
        Fselectbmpno:=Getimagecount-1;
        paint;
     end;
     pushed:=false;
     inherited;
end;

function Tmyedit.dotinrect(x,y,x1,y1,x2,y2:integer):boolean;
begin
    if (x<x1) or (y<y1) then
    begin
        dotinrect:=false;
        exit;
    end;
    if (x>=x2+x1) or (y>=y2+y1) then
    begin
        dotinrect:=false;
        exit;
    end;
    dotinrect:=true;
end;


procedure Tmyedit.SetCells(ACol, ARow: Integer; const Value: string);
var
    i,k:integer;
    str,str1:string;
begin
    str:=getimage(Arow);
    str1:='';
    for i:=0 to Acol do
    begin
        k:=pos(',',str);
        if k>0 then
        begin
            if i<>Acol then str1:=str1+copy(str,1,k);
            delete(str,1,k);
        end
        else if str<>'' then
        begin
            if i<>Acol then str1:=str1+str+',';
            str:='';
        end
        else
        begin
            if i<>Acol then str1:=str1+',';
        end;
    end;
    str1:=str1+value+','+str;
    Insertimage(Arow,str1);
end;

function Tmyedit.GetCells(ACol, ARow: Integer): string;
var
    i,k:integer;
    str,str1:string;
begin
    str:=getimage(AroW);
    for i:=0 to Acol do
    begin
        k:=pos(',',str);
        if k>0 then
        begin
            str1:=copy(str,1,k-1);
            delete(str,1,k);
        end
        else if str<>'' then
        begin
            str1:=str;
            str:='';
        end
        else
        begin
            str1:='';
            break;
        end;
    end;
    result:=str1;
end;


function Tmyedit.GetimageCount: Integer;
var
    k:integer;
    klen:longint;
begin
    k:=0;
    repeat
        klen:=AnsiPos(chr(k div 125 div 125+2)+chr(k div 125 mod 125+2)+chr((k mod 125)+2) +chr(1)+'*',paramtext);
        if klen>0 then k:=k+1;
    until  klen<=0;
    Result := k;
end;

function Tmyedit.Getimage(Index: Integer): string;
var
    klen1,klen2:longint;
begin
    klen1:=AnsiPos('#'+chr(1)+chr(Index div 125 div 125+2)+chr(Index div 125 mod 125+2)+chr((Index mod 125)+2),paramtext);
    klen2:=AnsiPos(chr(Index div 125 div 125+2)+chr(Index div 125 mod 125+2)+chr((Index mod 125)+2) +chr(1)+'*',paramtext);
    if klen1<klen2 then result:=copy(paramtext,klen1+5,klen2-klen1-5)
    else result:='';
end;

procedure Tmyedit.Insertimage(Index: Integer; const S: string);
var
    klen1,klen2:longint;
begin
    klen1:=AnsiPos('#'+chr(1)+chr(Index div 125 div 125+2)+chr(Index div 125 mod 125+2)+chr((Index mod 125)+2),paramtext);
    klen2:=AnsiPos(chr(Index div 125 div 125+2)+chr(Index div 125 mod 125+2)+chr((Index mod 125)+2) +chr(1)+'*',paramtext);
    if (klen1<klen2) then
    begin
        delete(paramtext,klen1,klen2-klen1+5);
        Insert('#'+chr(1)+chr(Index div 125 div 125+2)+chr(Index div 125 mod 125+2)+chr((Index mod 125)+2)+s+chr(Index div 125 div 125+2)+chr(Index div 125 mod 125+2)+chr((Index mod 125)+2) +chr(1)+'*',paramtext,klen1);
    end
    else paramtext:=paramtext+'#'+chr(1)+chr(Index div 125 div 125+2)+chr(Index div 125 mod 125+2)+chr((Index mod 125)+2)+s+chr(Index div 125 div 125+2)+chr(Index div 125 mod 125+2)+chr((Index mod 125)+2) +chr(1)+'*';
end;

procedure Tmyedit.addimage(const S: string);
var
    k:integer;
begin
    k:=GetimageCount;
    paramtext:=paramtext+'#'+chr(1)+chr(k div 125 div 125+2)+chr(k div 125 mod 125+2)+chr((k mod 125)+2)+s+chr(k div 125 div 125+2)+chr(k div 125 mod 125+2)+chr((k mod 125)+2) +chr(1)+'*';
end;

procedure Tmyedit.deleteimage(Index: Integer);
var
    i,k:integer;
    str:string;
    klen1,klen2:longint;
begin
    k:=GetimageCount-1;
    for i:=index to k-1 do
    begin
        str:=Getimage(i+1);
        Insertimage(i,str);
    end;
    klen1:=AnsiPos('#'+chr(1)+chr(k div 125 div 125+2)+chr(k div 125 mod 125+2)+chr((k mod 125)+2),paramtext);
    klen2:=AnsiPos(chr(k div 125 div 125+2)+chr(k div 125 mod 125+2)+chr((k mod 125)+2) +chr(1)+'*',paramtext);
    if (klen1<klen2) then  delete(paramtext,klen1,klen2-klen1+5);
    paint;
end;


procedure Tmyedit.Clearimage;
begin
    paramtext:='';
end;



procedure Tmyedit.SetBaudRate(Value: TBaudRate);
begin
  FBaudRate := Value;
  if Enabled then
  begin
    GetCommState(FHandle, FDCB);
    FDCB.BaudRate := CBR[FBaudRate];
    SetCommState(FHandle, FDCB);
  end;
end;

procedure Tmyedit.SetParity(Value: TParity);
begin
  FParity := Value;
  if Enabled then
  begin
    GetCommState(FHandle, FDCB);
    FDCB.Parity := PAR[FParity];
    SetCommState(FHandle, FDCB);
  end;
end;

procedure Tmyedit.SetStopbits(Value: TStopbits);
begin
  FStopbits := Value;
  if Enabled then
  begin
    GetCommState(FHandle, FDCB);
    FDCB.Stopbits := STB[FStopbits];
    SetCommState(FHandle, FDCB);
  end;
end;

procedure Tmyedit.SetDataBits(Value: integer);
begin
  FDataBits:=Value;
  if Enabled then
  begin
    GetCommState(FHandle, FDCB);
    FDCB.Bytesize := FDatabits;
    SetCommState(FHandle, FDCB);
  end;
end;

procedure Tmyedit.Opencom;
var
  OptIndex: TComm32Option;
  EvIndex: TC32EventState;
  AttrWord: dword;
begin
    if FHandle = INVALID_HANDLE_VALUE then
    begin
        FWriteEvent := CreateEvent(nil, false, false, nil);
        FHandle := CreateFile(PCHAR(FDeviceName), GENERIC_READ or GENERIC_WRITE,
                        0, nil, OPEN_EXISTING,file_attribute_normal or FILE_FLAG_OVERLAPPED, 0);
        FillChar(OverlappedCommEvent, Sizeof(OverlappedCommEvent), 0);

        hCloseEvent := CreateEvent(nil, True, False, nil);
        OverlappedCommEvent.hEvent := CreateEvent(nil, True, True, nil);
        HandlesToWaitFor[0] := hCloseEvent;
        HandlesToWaitFor[1] := OverlappedCommEvent.hEvent;
    end;
    SetupComm(FHandle, FReadBufferSize, FWriteBufferSize);
    GetCommState(FHandle, FDCB);
    FDCB.BaudRate := CBR[FBaudRate];
    FDCB.Parity := PAR[FParity];
    FDCB.Stopbits := STB[FStopbits];
    FDCB.Bytesize := FDatabits;

    for OptIndex := osParityCheck to osNullStrip do
         if OptIndex in FOptions then
           FDCB.Flags := FDCB.Flags or OPT[OptIndex]
         else
           FDCB.Flags := FDCB.Flags and not OPT[OptIndex];

    SetCommState(FHandle, FDCB);
    AttrWord:=0;
    for EvIndex := evBREAK to evTXEMPTY do
          AttrWord := AttrWord or EvList[EvIndex];
    SetCommMask(FHandle, AttrWord);
end;

procedure Tmyedit.initcom(comstr:string);
var
   i:integer;
   band,databit,stopbit:integer;
   check:char;
   str1:string;
begin
    str1:=trim(comstr);
    val(str1,band,i);
    delete(str1,1,i);
    str1:=trim(str1);
    check:=str1[1];
    delete(str1,1,2);
    str1:=trim(str1);
    val(str1,databit,i);
    delete(str1,1,i);
    str1:=trim(str1);
    val(str1,stopbit,i);
    if band=110 then  FBaudRate:= cbr110
    else if band=300 then  FBaudRate:= cbr300
    else if band=600 then  FBaudRate:=  cbr600
    else if band=1200 then  FBaudRate:=  cbr1200
    else if band=2400 then  FBaudRate:=  cbr2400
    else if band=4800 then  FBaudRate:=  cbr4800
    else if band=9600 then  FBaudRate:=  cbr9600
    else if band=14400 then  FBaudRate:=  cbr14400
    else if band=19200 then  FBaudRate:=  cbr19200
    else if band=38400 then  FBaudRate:=  cbr38400
    else if band=56000 then  FBaudRate:=  cbr56000
    else if band=57600 then  FBaudRate:=  cbr57600
    else if band=115200 then  FBaudRate:=  cbr115200
    else if band=128000 then  FBaudRate:=  cbr128000
    else if band=256000 then  FBaudRate:=  cbr256000;
    if (databit>=4) and (databit<=8) then FDatabits:=databit;
    if  stopbit=1 then FStopbits:=sb10
    else if  stopbit=2 then FStopbits:=sb20;
    if (check='O') or (check='o') then  FParity:=paOdd
    else if (check='E') or (check='e') then  FParity:=paEven
    else if (check='M') or (check='m') then  FParity:=paMark
    else if (check='S') or (check='s') then  FParity:=paSpace
    else FParity:=paNone;
    Opencom;

end;

procedure Tmyedit.readstatus;
var
  k:integer;
 // hCloseEvent: THandle;
 // HandlesToWaitFor: array[0..2] of THandle;
 // dwHandleSignaled: DWORD;
 // BytesTransferred: DWORD;
 // Status: dword;
 // OverlappedCommEvent: TOverlapped;
begin
{  FillChar(OverlappedCommEvent, Sizeof(OverlappedCommEvent), 0);
  hCloseEvent := CreateEvent(nil, True, False, nil);
  OverlappedCommEvent.hEvent := CreateEvent(nil, True, True, nil);
  HandlesToWaitFor[0] := hCloseEvent;
  HandlesToWaitFor[1] := OverlappedCommEvent.hEvent;}
  k:=0;
  while(k=0) do
  begin
    WaitCommEvent(FHandle, Status, @OverlappedCommEvent);
    dwHandleSignaled := WaitForMultipleObjects(2, @HandlesToWaitFor, False, INFINITE);
    if dwHandleSignaled=WAIT_OBJECT_0 + 1 then
    begin
        if GetOverlappedResult(FHandle, OverlappedCommEvent,BytesTransferred, false) then
        begin
            ClearCommError(FHandle, FErrors, @FCT);
            if (Status and EV_TXEMPTY > 0) then k:=1;
        end;
    end;
  end;
 // PurgeComm(FHandle, PURGE_RXABORT + PURGE_RXCLEAR);
 // CloseHandle(OverlappedCommEvent.hEvent);
end;

procedure Tmyedit.Write(const Buf; Count: Integer);
var
  dwNumberOfBytesWritten: DWORD;
begin
  FillChar(FWriteOS, Sizeof(FWriteOS), 0);
  FWriteOS.hEvent := FWriteEvent;
  dwNumberOfBytesWritten:=0;
  WriteFile(FHandle, Buf, Count, dwNumberOfBytesWritten, @FWriteOS);
  readstatus;
end;

procedure Tmyedit.sendbyte(Bufbyte: byte);
var
    buff:array[0..10] of char;
begin
    buff[0]:=chr(bufbyte);
    Write(buff,1);
end;

procedure Tmyedit.close;
begin
  if  FHandle<>INVALID_HANDLE_VALUE then
  begin
      PurgeComm(FHandle, PURGE_RXABORT + PURGE_RXCLEAR);
      CloseHandle(OverlappedCommEvent.hEvent);
      CloseHandle(hCloseEvent);
      CloseHandle(FHandle);
      CloseHandle(FWriteEvent);
      FHandle := INVALID_HANDLE_VALUE;
  end;
end;


procedure Tmyedit.senddatetime;
var
    Year, Month, Day, Hour, Min, Sec, MSec,week: Word;
begin
     decodedate(now,year,month,day);
     DecodeTime(now, Hour, Min, Sec, MSec);
     week:=dayofweek(Now)-1;
     if week=0 then week:=7;
     sendbyte(Year mod 100);
     sendbyte(Month);
     sendbyte(Day);
     sendbyte(Hour);
     sendbyte(Min);
     sendbyte(Sec);
     sendbyte(week);
end;

procedure Register;
begin
  RegisterComponents('Samples', [Tmyedit]);
end;

end.