|
作者：李淼
隨著網(wǎng)絡(luò)的普及，越來(lái)越多的人開(kāi)始過(guò)起了網(wǎng)絡(luò)生涯。網(wǎng)站讓你目不暇接，可是有的網(wǎng)站卻專(zhuān)門(mén)鉆IE的空子，當(dāng)你瀏覽了它的主頁(yè)之后，注冊(cè)表就會(huì)被禁止，還會(huì)修改你的其他設(shè)置，真是害人不淺。還有一招更毒的，你瀏覽它的主頁(yè)后，它會(huì)下載一個(gè)撥號(hào)器在你的硬盤(pán)，撥號(hào)器會(huì)斷開(kāi)你當(dāng)前的連接去撥別的號(hào)（想一想，撥一個(gè)長(zhǎng)途國(guó)際電話(huà)，一小時(shí)多少錢(qián)？�。�，所以，我們這些撥號(hào)上網(wǎng)的用戶(hù)需要一個(gè)能隨時(shí)監(jiān)測(cè)自己IP地址的軟件，當(dāng)IP發(fā)生改變時(shí)，它會(huì)自動(dòng)的報(bào)警;同時(shí)，它還應(yīng)該是透明的，這樣即使運(yùn)行時(shí)總在最前面，也不會(huì)影響別的窗體。
廢話(huà)不多說(shuō)了，馬上開(kāi)工。首先打開(kāi)Delphi新建一個(gè)工程，添加一個(gè)定時(shí)器Timer1、一個(gè)標(biāo)簽Label1、一個(gè)PopupMenu1，并且為PopupMenu1添加一個(gè)Exit菜單項(xiàng)。下面就是全部的源代碼:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, ExtCtrls, Winsock; //首先要添加winsock
type
TForm1 = class(TForm)
Timer1: TTimer;
Label1: TLabel;
PopupMenu1: TPopupMenu;
Exit: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Label1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ExitClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
oldx,oldy: integer;//添加變量,用做移動(dòng)窗體
oldIp: string;
implementation
{$R *.dfm}
//下面就是關(guān)鍵所在了
function LIP : 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:=StrPas(inet_ntoa(pptr^[I]^));
Inc(I);
end;
WSACleanup;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
with Label1 do //定義屬性
begin
Caption:='';
Font.Charset:=ANSI_CHARSET;
Font.Name:='Arial';
Font.Size:=10;
Font.Color:=clRed;
Align:=alClient;
PopupMenu:=popupmenu1;
end;
Timer1.Interval:=1000;
Timer1.Enabled:=true;
Label1.Caption:='IP:'+LIP; //賦值，把Ip賦值給label1
oldIp:=LIP;
BorderStyle:=bsNone;
Alphablend:=true; //呵呵，這個(gè)就是讓窗口變透明的辦法了
Alphablendvalue:=100;
FormStyle:=fsStayOnTop; //讓窗體總在最前面
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Label1.Caption :='IP:'+LIP;
if oldip <> LIP then
Showmessage('IP地址已經(jīng)改變,請(qǐng)檢查!');//提醒用戶(hù)
end;
procedure TForm1.Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssleft in shift then //移動(dòng)窗體Form1
begin
Form1.Left:=Form1.Left+x-oldx;
Form1.Top:=Form1.top+y-oldy;
end;
end;
procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
oldx:=x;
oldy:=y;
end;
procedure TForm1.ExitClick(Sender: TObject);
begin
Close;
end;
end.
程序比較簡(jiǎn)單，我只想再說(shuō)說(shuō)透明窗體。使窗體透明的方法有好幾種，其中一種是我用的這種，方法比較簡(jiǎn)單。還有一種是調(diào)用API函數(shù)SetLayeredWindowAttributes，它有4個(gè)參數(shù)，分別是hwnd、crKey、bAlpha和dwFlags。hwnd指操作的窗口的句柄，crKey是指定要透明的顏色值，是和第四個(gè)參數(shù)配合使用的（當(dāng)?shù)谒膫�(gè)參數(shù)為L(zhǎng)WA_COLORKEY），bAlpha是透明參數(shù)，當(dāng)bAlpha為0時(shí)窗口全透明，當(dāng)值為255時(shí)為正常的窗口。比如要Form1透明的話(huà)，相應(yīng)的語(yǔ)句是SetLayeredWindowAttributes(form1.Handle, 0, 100, LWA_ALPHA)，不過(guò)這個(gè)API只能在Win2000下用，不支持Win98。
本程序在Delphi6.0＋Win2000下調(diào)試通過(guò)。
|
