Цитата(northener @ 2.9.2012, 02:20  ) | | Неужели процедура таймера столь большая? |
Ну как то так  Проблема - если Таймер2 =True , то всплывающее меню проваливается под форму
| Код |
procedure TForm1.tmr1Timer(Sender: TObject);
// вспомогательная функция, преобразующая МАС адрес к
// "нормальному" виду определяем специальный тип, чтобы
// можно было передать в функцию массив
type
TMAC=array [0..7] of Byte;
// в качестве первого значения массив, второе значение,
// размер данных в массиве
function GetMAC(Value: TMAC; Length: DWORD): string;
var
i: integer;
begin
if Length=0
then Result:='00-00-00-00-00-00'
else
begin
Result:='';
for i:=0 to Length-2 do
Result:=Result+IntToHex(Value[i],2)+'-';
Result:=Result+IntToHex(Value[Length-1],2);
end;
end;
var
FLibHandle: THandle;
Table: TMibIfTable;
i, Size: integer;
s,trafnormin,trafnormout: string;
begin
Tmr1.Enabled:=false; // приостанавливаем на всякий случай таймер
Lst1.Items.BeginUpdate;
Lst1.Items.Clear; // очищаем список
FLibHandle:=LoadLibrary('IPHLPAPI.DLL'); // загружаем библиотеку
if FLibHandle=0
then Exit;
@GetIfTable:=GetProcAddress(FLibHandle, 'GetIfTable');
if not Assigned(GetIfTable)
then
begin
FreeLibrary(FLibHandle);
Close;
end;
//
Size:=SizeOf(Table);
if GetIfTable(@Table,@Size,false)=0
then
for i:=0 to Table.dwNumEntries-1 do // кол-во сетевых карт
begin
with Lst1.Items do
begin // выводим результаты
if string(GetMAC(TMAC(Table.Table[i].bPhysAddr),Table.Table[i].dwPhysAddrLen))<>'00-00-00-00-00-00' // сравнение MAC адресов
then
begin
Add('Description: '+string(Table.Table[i].bDescr)); // наименование интерфейса
Add('MAC-adress: '+string(GetMAC(TMAC(Table.Table[i].bPhysAddr),Table.Table[i].dwPhysAddrLen))); // МАС адрес
cbb1.Items.Add(string(GetMAC(TMAC(Table.Table[i].bPhysAddr),Table.Table[i].dwPhysAddrLen)));
// перевод к нормальным единицам "Входящего" трафика
trafbitin:=Table.Table[i].dwInOctets; // всего принято байт
trafnormin:=BytesToFriendlyString(trafbitin);
// перевод к нормальным единицам "Исходящего" трафика
trafbitout:=Table.Table[i].dwOutOctets; // всего отправлено байт
trafnormout:=BytesToFriendlyString(trafbitout);
/////////////////////////////////////
Add('In: '+BytesToFriendlyString(trafbitin)); // всего принято байт
Add('Out: '+BytesToFriendlyString(trafbitout)); // всего отправлено байт
Add('-------------------------------------------------'); //
end;
end;
end;
EnumInterfaces(s);
Lst1.Items.Add(s);
Lst1.Items.EndUpdate;
FreeLibrary(FLibHandle);
Windows.SetFocus(0);
end;
procedure TForm1.tmr2Timer(Sender: TObject);
type
TMAC=array [0..7] of Byte;
function GetMAC(Value: TMAC; Length: DWORD): string;
var
i: integer;
begin
if Length=0
then Result:='00-00-00-00-00-00'
else
begin
Result:='';
for i:=0 to Length-2 do
Result:=Result+IntToHex(Value[i],2)+'-';
Result:=Result+IntToHex(Value[Length-1],2);
end;
end;
var
FLibHandle :THandle;
Table :TMibIfTable;
old, kol, na, all, Size : Int64;
s :string;
new2, new :Int64;
i: integer;
//ActiveTraffic : TTraffic;
begin
tmr2.Enabled:=false;
btn4.Caption:= 'Обработка';
btn4.Enabled:=False;
FLibHandle:=LoadLibrary('IPHLPAPI.DLL');
if FLibHandle=0
then Exit;
@GetIfTable:=GetProcAddress(FLibHandle, 'GetIfTable');
if not Assigned(GetIfTable)
then
begin
FreeLibrary(FLibHandle);
Close;
end;
Size:=SizeOf(Table);
if GetIfTable(@Table,@Size,false)=0
then
for i:=0 to Table.dwNumEntries-1 do
begin
if string(GetMAC(TMAC(Table.Table[i].bPhysAddr),
Table.Table[i].dwPhysAddrLen))=(edt4.Text)
then
begin
trafbitin:=0;
trafbitin:=Table.Table[i].dwInOctets;
trafbitout:=Table.Table[i].dwOutOctets;
if trafbitin<trafbitold
then
begin
kol:=strtoint(Edt5.Text);
na:=strtoint('1');
all:=kol+na;
Edt5.Text:=inttostr(all);
end;
int64(all):=strtoint(Edt5.Text);
if all>0 then
begin
int64(old):=4294967296;
int64(new):=old*all;
int64(new2):=new+trafbitin;
Edt2.Text:=('In: '+BytesToFriendlyString(new2));
Edt3.Text:= ('Out:'+BytesToFriendlyString(trafbitout));
end
else
begin
Edt2.Text:= ('In: '+BytesToFriendlyString(trafbitin));
Edt3.Text:= ('Out:'+BytesToFriendlyString(trafbitout));
end;
trafbitold:=trafbitin;
end;
//EnumInterfaces(s);
//FreeLibrary(FLibHandle);
if Chk1.Checked=True then
begin
SetWindowPos(Form1.Handle, HWND_TOPMOST, 0, 0, 0, 0,
SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
end;
ShowWindow(Application.Handle, sw_Hide);
btn4.Caption:= 'Запустить';
if chk1.Checked=True Then
begin
cbb1.Enabled:=False;
Tmr2.Enabled:=true;
btn4.Caption:= 'Остановить';
end
else
begin
cbb1.Enabled:=True;
trafbitold:=0;
end;
if Tmr2.Enabled=false then
btn4.Enabled:=True;
end;
end;
|
Вот тут исходник.
Вначале всплывающее меню,( ну еще колорбокс добавил с таким же признаком) нормально отображается. Но если жмем кнопку Запустить, то и Popup Menu и ColorBox будут скрываться под формой. |