⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 一个串口通信程序,在上海某展馆中控制模型运动的实例.
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, SPComm, ShellAPI, StdCtrls, ExtCtrls, Menus, ImgList, ComCtrls,
  ToolWin,Registry;

const
    ICON_ID = 1;
    MY_ICONMESSAGE = WM_USER + 104;
    WM_MYMESSAGE = WM_USER + 105;

type
  TForm1 = class(TForm)
    Comm1: TComm;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    Edit1: TEdit;
    Button1: TButton;
    ComboBox2: TComboBox;
    Button2: TButton;
    Label6: TLabel;
    Memo1: TMemo;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    GroupBox4: TGroupBox;
    Label1: TLabel;
    ComboBox1: TComboBox;
    Panel1: TPanel;
    Button3: TButton;
    Button4: TButton;
    Image1: TImage;
    Button5: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure WMMyMessage(var Msg:TMessage);message WM_MYMESSAGE;
    procedure IconOnChick(var message:TMessage);message MY_ICONMESSAGE;
    procedure WMSysCommand(var Message: TMessage); message WM_SYSCOMMAND;
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure Edit1Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);

  private
    { Private declarations }

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
    comm;
{$R *.dfm}
var

    IconData:TNotifyIconData;
    isShow:Boolean; //Form1是否显示
    isOpen:Boolean; //串口是否打开
    is_1_Open: Boolean; //连动1
    is_2_Open: Boolean; //连动2
    is_3_Open: Boolean; //连动3
    is_4_Open: Boolean; //连动4


procedure TForm1.FormCreate(Sender: TObject);
var
    strTemp: string;
    handleTemp: THandle;
    intTemp:integer;
    reg:TRegistry;
begin
    if ParamCount < 1 then
    begin
        intTemp := -1;

    end
    else if (not IsAllNum(ParamStr(1))) then
    begin
        ShowMessage('参数类型错误');
        Application.Terminate;
        Exit;
    end
    else if (StrToInt(ParamStr(1)) >255) or (StrToInt(ParamStr(1)) < -255) then
    begin
        ShowMessage('参数的值超出预定范围');
        Application.Terminate;
        Exit;
    end
    else
    begin
      intTemp := StrToInt(ParamStr(1));
    end;

    strTemp := Form1.Caption;
    Form1.Caption := 'OnlyOne'+IntToStr(hInstance);
    handleTemp := FindWindow(nil,pchar(strTemp));
    Form1.Caption := strTemp;

    if handleTemp <> 0 then
    begin
        SendMessage(handleTemp,WM_MYMESSAGE,
            intTemp,0);
        Application.Terminate;
        Exit;
    end;

    //托盘设置

    IconData.cbSize := Sizeof(IconData);
    IconData.Wnd := Handle;
    IconData.uID := ICON_ID;
    IconData.uFlags :=NIF_ICON or NIF_MESSAGE or NIF_TIP;
    IconData.uCallbackMessage := MY_ICONMESSAGE;
    IconData.hIcon := Image1.Picture.Icon.Handle;
    IconData.szTip := '延华多媒体衔接程序';

    Shell_NotifyIcon(NIM_ADD,@IconData);

    SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);

    //初始变量设置
    ComboBox1.ItemIndex := 0;
    isOpen := false;
    Button3Click(nil);
    ComboBox2.Items.Add(ExtractFileName(Application.ExeName)
        +' 1');
    ComboBox2.Items.Add(ExtractFileName(Application.ExeName)
        +' 2');
    ComboBox2.Items.Add(ExtractFileName(Application.ExeName)
        +' 3');
    ComboBox2.Items.Add(ExtractFileName(Application.ExeName)
        +' 4');
    ComboBox2.Items.Add(ExtractFileName(Application.ExeName)
        +' 5');
    ComboBox2.Items.Add(ExtractFileName(Application.ExeName)
        +' 6');
    ComboBox2.Items.Add(ExtractFileName(Application.ExeName)
        +' 7');
    ComboBox2.Items.Add(ExtractFileName(Application.ExeName)
        +' 8');
    ComboBox2.Items.Add(ExtractFileName(Application.ExeName)
        +' 9');
    ComboBox2.ItemIndex := 0;

     //读注册表
   reg:=TRegistry.Create;
   reg.RootKey:=HKEY_LOCAL_MACHINE;//指定需要操作的注册表的主键

   if reg.OpenKey('\Software\Connect',true) then//如果打开成功则进行以下操作
   begin
        try
            ComboBox1.ItemIndex := reg.ReadInteger('index');//将需要保存的信息写入注册表
        finally
            reg.CloseKey;//关闭注册表
   end;

   reg.Free;//释放变量所占内存

   is_1_Open := false;
   is_2_Open := false;
   is_3_Open := false;
   is_4_Open := false;

    SendMessage(Form1.Handle,WM_MYMESSAGE,
            intTemp,0);
    end;
end;

procedure TForm1.WMMyMessage(var Msg: TMessage);
begin
    if Msg.WPARAM = -1 then
    begin
      Form1.Show;
      Exit;
    end;

    case Msg.WPARAM of
        1:
        begin
            if not is_1_Open then
                comm1.writecommdata('1',1)
            else
                comm1.writecommdata('6',1);
            is_1_Open := not is_1_Open;
        end;
        2:
        begin
            if not is_2_Open then
                comm1.writecommdata('2',1)
            else
                comm1.writecommdata('7',1);
            is_2_Open := not is_2_Open;
        end;
        3:
        begin
            if not is_3_Open then
                comm1.writecommdata('3',1)
            else
                comm1.writecommdata('8',1);
            is_3_Open := not is_3_Open;
        end;
        4:
        begin
            if not is_4_Open then
                comm1.writecommdata('4',1)
            else
                comm1.writecommdata('9',1);
            is_4_Open := not is_4_Open;
        end;
    end;


    {
    if not comm1.writecommdata(Pchar(IntToStr(Msg.WPARAM)),1) then
    begin
        Memo1.lines.append(DateTimeToStr(now));
        Memo1.lines.append('发送参数"'
            +IntToStr(Msg.WPARAM)+'"失败!');
        Memo1.lines.add(' ');
        Exit;
    end;
    }
    Memo1.lines.append(DateTimeToStr(now));
    Memo1.lines.append(IntToStr(Msg.WPARAM));
    Memo1.lines.add(' ');

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    Shell_NotifyIcon(NIM_DELETE,@IconData);
    isOpen := true;
    Button3Click(nil);
end;


procedure TForm1.IconOnChick(var message: TMessage);
var
    pt:TPoint;
begin
    if (message.LParam = WM_LBUTTONDBLCLK)
    and (isShow = false) then
    begin
        Form1.Show;
    end
    else if (message.LParam = WM_RBUTTONDOWN) then
    begin
        GetCursorPos(pt);
        PopupMenu1.Popup(pt.X,pt.Y);
    end;
    //else if (message.LParam = WM_LBUTTONDBLCLK) then
    //begin
    //    GetCursorPos(pt);
    //    PopupMenu2.Popup(pt.X,pt.Y);
    //end;

end;

procedure TForm1.WMSysCommand(var Message: TMessage);
begin
    if Message.WParam = SC_MINIMIZE then
    begin
        isShow := false;//点击最小化按扭
        Form1.Hide;
        //ShowWindow(Application.Handle,SW_HIDE);
    end
    else
        inherited;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
    if isShow = false then
        Form1.Show;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
    Application.Terminate;
end;

//打开、关闭串口按钮
procedure TForm1.Button3Click(Sender: TObject);
begin
    if not isOpen then
    //打开串口
    begin
        Comm1.CommName := ComboBox1.Text;
        Comm1.StartComm;

        isOpen := true;
        Panel1.Color := clLime;
        Button3.Caption := '关闭串口';

    end
    else
    //关闭串口
    begin

        comm1.StopComm;
        isOpen := false;
        Panel1.Color := clRed;
        Button3.Caption := '打开串口';

    end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
    SendMessage(Form1.handle,WM_SYSCOMMAND,SC_MINIMIZE,0);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    i:integer;
    p:Pchar;
begin
    p:= Pchar(Edit1.text);
    for i := 0 to length(Edit1.text) do
    begin
        if not comm1.writecommdata(@p[i],1) then
        begin
            Memo1.lines.append(DateTimeToStr(now));
            Memo1.lines.append('发送"'
                +Edit1.text+'"失败!');
            Memo1.lines.append('失败原因:第'
                +IntToStr(i)+' 位字符"'+p[i]+'"未能发送!');
            Memo1.lines.add(' ');
            Exit;
        end;
        Sleep(2);

    end;

    Memo1.lines.append(DateTimeToStr(now));
    Memo1.lines.append(Edit1.text);
    Memo1.lines.add(' ');
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
    Memo1.clear;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    case ComboBox2.ItemIndex of
    0:SendMessage(Form1.handle,WM_MYMESSAGE,1,0);
    1:SendMessage(Form1.handle,WM_MYMESSAGE,2,0);
    2:SendMessage(Form1.handle,WM_MYMESSAGE,3,0);
    3:SendMessage(Form1.handle,WM_MYMESSAGE,4,0);
    4:SendMessage(Form1.handle,WM_MYMESSAGE,5,0);
    5:SendMessage(Form1.handle,WM_MYMESSAGE,6,0);
    6:SendMessage(Form1.handle,WM_MYMESSAGE,7,0);
    7:SendMessage(Form1.handle,WM_MYMESSAGE,8,0);
    8:SendMessage(Form1.handle,WM_MYMESSAGE,9,0);
    end;
end;

procedure TForm1.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
    strTemp:string;
    i:integer;
    p:Pchar;
begin
    strTemp := '';

    p := Pchar(Buffer);

    for i := 0 to BufferLength do
        strTemp := strTemp + p[i];

    memo1.lines.append(DateTimeToStr(now));
    memo1.lines.append(strTemp);
    //memo1.lines.add('');
end;

procedure TForm1.Edit1Click(Sender: TObject);
begin
    Edit1.SelStart := 0;
    Edit1.SelLength  := Length(Edit1.Text);

end;

procedure TForm1.ComboBox1Change(Sender: TObject);
var
    reg:TRegistry;
begin
    
    //写注册表
   reg:=TRegistry.Create;
   reg.RootKey:=HKEY_LOCAL_MACHINE;//指定需要操作的注册表的主键
      
   if reg.OpenKey('\Software\Connect',true) then//如果打开成功则进行以下操作
   begin

        reg.WriteInteger('index',ComboBox1.ItemIndex);//将需要保存的信息写入注册表
        reg.CloseKey;//关闭注册表
   end;

   reg.Free;//释放变量所占内存
end;

end.



⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -