unit1.~pas

delphi 利用usb高速数据采集、及图形打印源代码

unit Unit1;

interface 

uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls;
Const
Wm_CommNotify=WM_User+12; //建立消息
type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Edit1: TEdit;
    Edit2: TEdit;
    Panel1: TPanel;
    Panel2: TPanel;
    Image1: TImage;
    ScrollBar1: TScrollBar;
    Label1: TLabel;
    Button1: TButton;
    Button2: TButton; //制作按钮

    procedure FormDestroy(Sender: TObject); //窗体关闭事件
    procedure FormCreate(Sender: TObject);
      procedure Label1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure label1mouseup(sender: tobject;button:tmousebutton;
      shift: tshiftstate; x, y:integer);
      procedure ScrollBar1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);

  private //私有事件
  Procedure CommInitialize;

  Procedure MsgComm(Var Msg:Tmessage); Message WM_CommNotify;

    { Private declarations }
  public                          
    { Public declarations }
  end;
  TComm=Class(TThread)//创见线程类

  Protected //受保护
  Procedure Execute;override;//线程
  end;
 
var
 
  Form1: TForm1;
  Hcom,Post_Event:Thandle;//句柄
  LpolW,LpolR:Poverlapped;
  RXComm:TComm;
  u:integer;
  origin: Tpoint;
  image_left: integer;
  image_top: integer;
  visa1: Tpoint; //鼠标当前位置相对图像右下角的坐标
  visa2: Tpoint; //鼠标当前位置相对图像左上角的坐标
  canmove,incept,test: boolean;
     MyArray:   Array[0..60000]   of   Integer;
     myarray2:  array[0..60000]   of  integer;
    pts: array[0..9999] of TPoint;
implementation

{$R *.DFM}
 uses unit2;
 var
 thread1:mymath1;

Procedure TComm.Execute;
var
dwEvtmask,dwOvres,bb:Dword;
RXFinish,incept:Bool;
begin
// showmessage('线程打开');
  while true do
  begin
    DwEvtMask:=0;
    RXFinish:=WaitCommEvent(hcom,dwevtmask,nil);//LpolR);   //等待串口事件EV_RXCHAR
    {if not RXFinish then               //如果返回True,已立即完成，否则继续判断
      if GetLastError()=ERROR_IO_PENDING then //正在接收数据
      begin
        bb:=WaitForSingleObject(LpolR^.hEvent,2500);//等待500ms
        Case bb of
          Wait_Object_0:  RXFinish:=GetOverLappedResult(hcom,LpolR^,dwOvRes,False);
                           //返回False,出错
          Wait_TimeOut:  RXFinish:=False;//定时溢出
          else RXFinish:=False;   //出错
        end;
      end else RXFinish:=False; }
    if RXFinish then
    begin
    // if WaitForsingleobject(Post_Event,infinite)=Wait_Object_0 then  //等待同步事件置位
     // begin
        resetEvent(Post_Event);      //同步事件复位
        PostMessage(Form1.handle,WM_CommNotify,0,0);
     // end;
    end;
  end;
end;

Procedure TForm1.CommInitialize;
 Var
    lpdcb:Tdcb;
    Success,error:boolean;
begin
    hcom:=createfile('com4',
    generic_read or generic_write,
    0,
    nil,
    open_existing,
    file_attribute_normal or file_flag_overlapped,0);

    if hcom=invalid_handle_value then showmessage('错误：服务器无法打开串口设备！')
    else
        setupcomm(hcom,4096,4096);
        error:=getcommstate(hcom,lpdcb);
        if not error then ShowMessage('无法获取串口当前参数！');
        lpdcb.baudrate:=9600;
        lpdcb.StopBits:=ONESTOPBIT;
        lpdcb.ByteSize:=8;
        lpdcb.Parity:=NOPARITY;
        error:=Setcommstate(hcom,lpdcb);
        if not error then ShowMessage('无法设置串口参数！');
        success:=setcommMask(hcom,ev_rxchar);
        if not success then ShowMessage('串口监视事件创建错误！');
end;

Procedure TForm1.MsgComm(Var Msg:Tmessage);      //接收数据
var
 clear:boolean;
 coms:TComStat;
 cbNum,Cbread,lpErrors:Dword;
 temp,s:string;
 p,i:integer;
begin
   SetLength(temp,2);
 clear:=clearCommerror(hcom,lperrors,@Coms);
 if clear then
 begin
   cbnum:=Coms.cbInQue;    //获取接收缓冲区待接收字节数
   setlength(s,cbnum+1);     //分配内存
   ReadFile(hcom,PChar(S)^,cbnum,Cbread,LpolR);   //读串口
   setlength(s,cbread);      //分配
   SetEvent(Post_Event);     //同步事件置位
   for I:=1 to Length(S) do
       begin
         if I=1 then
          begin
           if u=10000 then
           begin
               incept:=false;
               u:=0;
               image1.Canvas.Polyline(pts);
               end;
                if incept then
                begin
               pts[u].y:=ord(s[1]);
               pts[u].x:=u;
               u:=u+1;
               end;
           end
           else
           begin
              if u=10000 then
              begin
               incept:=false;
               u:=0;
               image1.Canvas.Polyline(pts);
               end;
                if incept then
                begin
               pts[u].y:=ord(s[1]);
               pts[u].x:=u;
               u:=u+1;
               end;
           end;
        end;


  end;
   //edit1.Text:=inttostr(u);
  // Memo1.text:=inttostr(myarray[3]);

 end;

procedure TForm1.FormDestroy(Sender: TObject);   //释放内存
begin
 CloseHandle(LpolW^.hEvent);
 CloseHandle(LpolR^.hEvent);
 dispose(lpolW);
 dispose(lpolR);
 LpolW:=Nil;
 LpolR:=Nil;
 RXComm.Terminate;
 SetEvent(Post_Event);
 CloseHandle(Post_Event);
 CloseHandle(hcom);
end;

procedure TForm1.FormCreate(Sender: TObject);    //初始化内存及串口
begin
  Comminitialize;
  New(lpolW);
  New(lpolR); 
  LpolW^.Internal:=0;
  LpolW^.InternalHigh:=0;
  LpolW^.Offset:=0;
  LpolW^.OffsetHigh:=0;
  LpolW^.hEvent:=Createevent(nil,true,False,nil);
  Lpolr^.Internal:=0;
  Lpolr^.InternalHigh:=0;
  Lpolr^.Offset:=0;
  Lpolr^.OffsetHigh:=0;
  Lpolr^.hEvent:=Createevent(nil,true,False,nil);
  PurgeComm(Hcom,Purge_TxAbort or Purge_RxAbort or Purge_Txclear or Purge_Rxclear);
  Post_Event:=Createevent(nil,true,true,nil);
  RXComm:=Tcomm.Create(false);
  thread1:=mymath1.create;
  thread1.resume;
  u:=0;
  incept:=true;
  test:=false;
  //image2.Canvas.Pen.Width := 2;
 // image2.Canvas.Pen.Color := clRed;
  //image2.Canvas.Brush.Color := clYellow;
end;

procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
   image1.Left:=-scrollbar1.Position*(image1.Width-panel2.Width) div 100;
end;

procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    begin
      origin.x := X;
      origin.y := Y;
     // edit1.text:=inttostr(x);

      image_left := image1.left;
      image_top := image1.top;
      visa1.x := X - (image1.width - panel2.width + image1.left);
      visa1.y := Y - (image1.height - panel2.height + image1.top);
      visa2.x := X - image1.left;
      visa2.y := Y - image1.top;
      canmove := true;
    end;
end;


procedure TForm1.Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if canmove then
    begin
      if X < visa1.x then X := visa1.x;
    if X > visa2.x then X := visa2.x;
      if Y < visa1.y then Y := visa1.y;
     if Y > visa2.y then Y := visa2.y;
      image1.left := image_left + (X - origin.x);
      image1.top := image_top + (Y - origin.y);
       edit2.text:=inttostr(-image1.left div(image1.Width-panel2.Width) * 100);
     scrollbar1.Position:=-image1.left* 100 div (image1.Width-panel2.Width) ;
    end;

end;
procedure tform1.label1mouseup(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  begin
  canmove:=false;
  end;



procedure TForm1.Button1Click(Sender: TObject);
begin
   image1.Canvas.Polyline(pts);
end;



end.