获取本机IP并在任务栏显示图标

最新推荐文章于 2024-07-03 10:29:51 发布

fei997yang

最新推荐文章于 2024-07-03 10:29:51 发布

阅读量2k

点赞数

分类专栏： delphi 文章标签：任务 integer timer buffer button action

本文链接：https://blog.csdn.net/fei997yang/article/details/650806

版权

delphi 专栏收录该内容

13 篇文章 0 订阅

订阅专栏

unit local;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls,winsock, Menus,clipbrd,ShellAPI;
const MY_MESSAGE = WM_USER + 100;
type
TForm1 = class(TForm)
    Label1: TLabel;
    Timer1: TTimer;
    PopupMenu1: TPopupMenu;
    exit1: TMenuItem;
    copy1: TMenuItem;
    procedure Timer1Timer(Sender: TObject);
    procedure exit1Click(Sender: TObject);
    procedure copy1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
private
    { Private declarations }
    procedure OnIconNotify(var Message: TMessage);
    message MY_MESSAGE;
public
    { Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function localIP: string;
type
    TaPInAddr = array [0..10] of PInAddr;
    PaPInAddr = ^TaPInAddr;
var
    phe : PHostEnt;
    pptr : PaPInAddr;
    Buffer : array [0..63] of char;
    I    : Integer;
    GInitData      : TWSADATA;
begin
   WSAStartup($101,ginitdata);
   result := '';
   gethostname(buffer,sizeof(buffer));
   phe := gethostbyname(buffer);
   if phe =nil then exit;
   pptr := papinaddr(phe^.h_addr_list);
   I := 0;
   while pptr^[i] <> nil do
   begin
      result := SysUtils.StrPas(inet_ntoa(pptr^[i]^));
      inc(I);
   end;
   WSACleanup;
end ;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   timer1.Interval := 1000*100;
   label1.Font.Color := clred;
   label1.Caption := 'IP ' + localIP;
end;

procedure TForm1.exit1Click(Sender: TObject);
begin
application.terminate;
end;

procedure TForm1.copy1Click(Sender: TObject);
begin
Clipboard.SetTextBuf(pchar(copy(label1.Caption,2,255)))
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
nid: TNotifyIconData;
begin
nid.cbSize := sizeof(nid);
nid.uID :=1;
nid.Wnd := Handle;
Shell_NotifyIcon(NIM_DELETE, @nid);
end;

procedure tform1.OnIconNotify(var message:TMessage);
var busy:boolean;
begin
busy := false;
if not busy then
begin
    Busy := true;
    if Message.LParam=WM_LBUTTONDOWN then
    if Application.MessageBox('确定要退出吗？',
    '退出', MB_YESNO)=IDYES then Close;
    Busy := false;
end;
end ;

procedure TForm1.FormCreate(Sender: TObject);
var
nid: TNotifyIconData;
FullRgn, ClientRgn, ButtonRgn: THandle;
Margin, X, Y: Integer;
begin
top:=screen.Height-50;
left:=screen.width-120;
height:=Label1.Height;
width:=Label1.width;
Margin := (Width - ClientWidth) div 2;
FullRgn := CreateRectRgn(0, 0, Width, Height);
X := Margin;
Y := Height - ClientHeight - Margin;
ClientRgn := CreateRectRgn(X, Y, X + ClientWidth, Y + ClientHeight);
CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);
X := X + Label1.Left;
Y := Y + Label1.Top;
ButtonRgn := CreateRectRgn(X, Y, X + Label1.Width, Y + Label1.Height);
CombineRgn(FullRgn, FullRgn, ButtonRgn, RGN_OR);
SetWindowRgn(Handle, FullRgn, True);
//Hide Taskbar Icon
ShowWindow( Application.Handle, SW_HIDE );
SetWindowLong( Application.Handle, GWL_EXSTYLE,
                 GetWindowLong(Application.Handle, GWL_EXSTYLE) or
                 WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
ShowWindow( Application.Handle, SW_SHOW );
nid.cbSize := sizeof(nid);
nid.Wnd := handle;
nid.uID :=1;
nid.hIcon := application.Icon.Handle;
StrPLCopy(nid.szTip, label1.Caption+localIP, 63); // '获得本机IP的程序';
nid.uCallbackMessage := MY_MESSAGE;
nid.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
if not Shell_NotifyIcon(NIM_ADD, @nid) then begin
    ShowMessage('失败!');
    Application.Terminate;
end;
{将程序的窗口样式设为TOOL窗口，可避免在任务条上出现}
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
//windows.SetWindowLong()
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
//hide;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
const
sc_dragmove = $f012;
begin
ReleaseCapture;
twincontrol(application.mainform).Perform(messages.WM_SYSCOMMAND,sc_dragmove,0 );
end;

end.
相信大家都可以看懂的，代码就不用详尽的解释了，有兴趣的可以试一试