Список использованных источников

1. Финогенов К. Г. Win32. Основы программирования. - 2-е изд., испр. и дополн. - М.: ДИАЛОГ-МИФИ, 2006.

2. Гэри Неббет Справочник по базовым функциям API Windows NT/2000 = Windows NT/2000 Native API Reference. — М.: «Вильямс», 2002. — С. 528. — ISBN 1-57870-199-6

3. RSDN Magazine #4-2005

4. http://dims.karelia.ru/win32/ - «Основы программирования для WinAPI»

5. http://habrahabr.ru/post/130093/ -«Разбираемся в WinAPI»

ПРИЛОЖЕНИЕ А

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Buttons, ToolWin, ComCtrls, ExtCtrls;

type

TForm1 = class(TForm)

ToolBar1: TToolBar;

SpeedButton1: TSpeedButton;

ListBox1: TListBox;

SpeedButton2: TSpeedButton;

SpeedButton6: TSpeedButton;

SpeedButton7: TSpeedButton;

SpeedButton8: TSpeedButton;

SpeedButton9: TSpeedButton;

SpeedButton10: TSpeedButton;

SpeedButton3: TSpeedButton;

procedure SpeedButton1Click(Sender: TObject);

procedure SpeedButton2Click(Sender: TObject);

procedure SpeedButton6Click(Sender: TObject);

procedure SpeedButton7Click(Sender: TObject);

procedure SpeedButton8Click(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure SpeedButton9Click(Sender: TObject);

procedure SpeedButton10Click(Sender: TObject);

procedure SpeedButton3Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses Unit2, Unit3, Unit4;

{$R *.dfm}

procedure TForm1.SpeedButton1Click(Sender: TObject); //инф о процессоре

var

SysInfo:TSystemInfo;

begin

listbox1.items.Clear;

GetSystemInfo(SysInfo);

with ListBox1.Items,SysInfo do

begin

Add('ProcessorArchitecture: '+IntToStr(wProcessorArchitecture));

Add(FloatToStr(dwPageSize)+' Kb page size');

Add(Format('Lowest memory address accessible to applications and DLL - %p',[lpMinimumApplicationAddress]));

Add(Format('Highest memory address accessible to applications and DLL - %p',[lpMaximumApplicationAddress]));

Add('OEMID:'+IntToStr(dwOemId));

Add('ActiveProcessorMask:'+IntToStr(dwActiveProcessorMask));

Add(IntToStr(dwNumberOfProcessors)+' - number of processors');

Add('ProcessorType:'+IntToStr(dwProcessorType));

case wProcessorLevel of

3:Add('Intel 80386 processor level');

4:Add('Intel 80486 processor level');

5:Add('Intel Pentium processor level');

end;

Add(FloatToStr(dwAllocationGranularity/1024)+' Kb - granularity with which virtual memory is allocated');

Add('ProcessorRevision:'+IntToStr(wProcessorRevision));

end;

end;

procedure TForm1.SpeedButton2Click(Sender: TObject);//инф о памяти

var

MemoryStatus:TMemoryStatus;

begin

ListBox1.Items.Clear;

MemoryStatus.dwLength:=SizeOf(MemoryStatus);

GlobalMemoryStatus(MemoryStatus);

with MemoryStatus do

begin

listbox1.items.Add(IntToStr(dwMemoryLoad)+'% использованно памяти');

listbox1.items.Add(IntToStr((dwTotalPhys div 1024) div 1024)+' Мб всего физической памяти');

listbox1.items.Add(IntToStr((dwAvailPhys div 1024) div 1024)+' Мб доступно физической памяти');

listbox1.items.Add(IntToStr((dwTotalPageFile div 1024) div 1024)+' Мб всего виртуальной памяти');

listbox1.items.Add(IntToStr((dwAvailPageFile div 1024) div 1024)+' Мб доступно виртуальной памяти');

listbox1.items.Add(IntToStr((dwTotalVirtual div 1024) div 1024)+' Мб адресное виртуальное простанство текущего процесса');

listbox1.items.Add(IntToStr((dwAvailVirtual div 1024) div 1024)+' Мб доступно виртуального адресного пространства текущего процесса');

end;

end;

procedure TForm1.SpeedButton6Click(Sender: TObject); //показать вторую форму

begin

Form2.Show;

end;

procedure TForm1.SpeedButton7Click(Sender: TObject);//серийный номер винчестера

var

SerialNum:Word;

a,b:DWORD;

Buffer:array [0..255] of Char;

begin

ListBox1.Items.Clear;

if GetVolumeInformation('c:\',Buffer,SizeOf(Buffer),@SerialNum,a,b,nil,0) then

begin

ListBox1.Items.Add('Серийные номер винчестера:');

ListBox1.Items.Add(IntToStr(SerialNum));

end;

end;

procedure TForm1.SpeedButton8Click(Sender: TObject); //показать форму 3

begin

Form3.Show;

end;

procedure TForm1.FormActivate(Sender: TObject); //плавно всплывающее окно и приветствие

const

n=127;

var

i:Byte;

Begin

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add('Добро пожаловать в программу InfoPC!');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add('Данный проект является курсовой работой и не подлежит копированию и редактированию');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add('Все права защищенны');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add('Приятного пользование');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add('Удачи!');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

AlphaBlend:=True;

for i:=1 to n do

begin

AlphaBlendValue:=i*2;

Repaint;

end;

end;

procedure TForm1.SpeedButton9Click(Sender: TObject); //полная очистка

begin

ListBox1.Clear;

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add('Добро пожаловать в программу InfoPC!');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add('Данный проект является курсовой работой и не подлежит копированию и редактированию');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add('Все права защищенны');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add('Приятного пользование');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add('Удачи!');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

ListBox1.Items.Add(' ');

end;

procedure TForm1.SpeedButton10Click(Sender: TObject); //видеоадаптеры и видеорежимы

var

lpDisplayDevice:TDisplayDevice;

DevMode:TDevMode;

S:String;

i,j,k:integer;

dwFlags:DWORD;

cc:DWORD;

begin

ListBox1.Items.Clear;

lpDisplayDevice.cb:=sizeof(lpDisplayDevice);

dwFlags:=0;

cc:=0;

while EnumDisplayDevices(nil,cc,lpDisplayDevice,dwFlags) do

begin

Inc(cc);

ListBox1.Items.add(lpDisplayDevice.DeviceString);

end;

ListBox1.Items.Add(' ');

// Подготовка структуры lpDisplayDevice

lpDisplayDevice.cb:=sizeof(lpDisplayDevice);

// Получение списка видеоадаптеров

i:=0;

while EnumDisplayDevices(nil,i,lpDisplayDevice,0) do

begin

Inc(i);

ListBox1.Items.Add('***** '+lpDisplayDevice.DeviceString + ' *****');

ListBox1.Items.Add(' DeviceName = '+lpDisplayDevice.DeviceName+' - '+lpDisplayDevice.DeviceString);

S:=lpDisplayDevice.DeviceName;

j:=0;

ListBox1.Items.Add(' Мониторы: ' );

// Получение списка мониторов

while EnumDisplayDevices(@S[1],j,lpDisplayDevice,0) do

begin

inc(j);

ListBox1.Items.add(' DeviceMonitor = '+lpDisplayDevice.DeviceName+' - '+lpDisplayDevice.DeviceString);

end;

k:=0;

ListBox1.Items.Add(' Видеорежимы: ' );

// Получение списка поддерживаемых видеорежимов

while EnumDisplaySettings(Pchar(S), k, DevMode) do

begin

ListBox1.Items.Add(' --- режим № '+IntToStr(k)+' ---');

inc(k);

ListBox1.Items.Add('DevMode.dmDeviceName = '+DevMode.dmDeviceName);

ListBox1.Items.Add('DevMode.dmBitsPerPel = '+IntToStr(DevMode.dmBitsPerPel));

ListBox1.Items.Add('DevMode.dmPelsWidth = '+IntToStr(DevMode.dmPelsWidth));

ListBox1.Items.Add('DevMode.dmPelsHeight = '+IntToStr(DevMode.dmPelsHeight));

ListBox1.Items.Add('DevMode.dmDisplayFrequency = '+IntToStr(DevMode.dmDisplayFrequency)+' Гц');

end;

end;

end;

procedure TForm1.SpeedButton3Click(Sender: TObject);//показать окно "Расширенная информация"

begin

Form4.Show;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

Form1.Left:=(Screen.Width-Form1.Width) div 2; //по середине моннитора

Form1.Top:=(Screen.Height-Form1.Height) div 2;

end;

end.

ПРИЛОЖЕНИЕ Б

unit Unit2;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Buttons, StdCtrls, unit1;

type

TForm2 = class(TForm)

Edit1: TEdit;

Edit2: TEdit;

SpeedButton1: TSpeedButton;

Memo1: TMemo;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

procedure SpeedButton1Click(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form2: TForm2;

implementation

{$R *.dfm}

function GetComputerNetName:string; //узнаем имя компьютера

var

buffer:array[0..255] of Char;

size:DWORD;

begin

size:=256;

if GetComputerName(buffer,size) then

Result:=buffer

else Result:= '';

end;

function GetCurrentUserName:String; //узнаем имя текущего пользователя

const

cnMaxUserNameLen=254;

var

sUserName:String;

dwUserNameLen:DWORD;

begin

dwUserNameLen:=cnMaxUserNameLen-1;

SetLength(sUserName,cnMaxUserNameLen);

GetUserName(PChar(sUserName),dwUserNameLen);

SetLength(sUserName,dwUserNameLen);

Result:=sUserName;

end;

procedure TForm2.SpeedButton1Click(Sender: TObject); //информация о пользователе

const

TokenSize=800; // расчет (SizeOf(Pointer)=4 *200)

var

hToken:THandle;

pTokenInfo:PTOKENPRIVILEGES;

ReturnLen:Cardinal;

i:Integer;

PrivName:PChar;

DisplayName:PChar;

NameSize:Cardinal;

DisplSize:Cardinal;

LangId:Cardinal;

begin

Memo1.Lines.Clear;

Edit1.text:=GetComputerNetName; //вызываем функцию имени "имя компьютера"

Edit2.text:= GetCurrentUserName; //вызываем функцию "имя пользователя"

GetMem(pTokenInfo, TokenSize);

if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken) then ShowMessage('OpenProcessToken error');

if not GetTokenInformation(hToken, TokenPrivileges, pTokenInfo, TokenSize, ReturnLen) then

ShowMessage('GetTokenInformation error');

GetMem(PrivName, 255);

GetMem(DisplayName, 255);

for i := 0 to pTokenInfo.PrivilegeCount - 1 do

begin

DisplSize := 255;

NameSize := 255;

LookupPrivilegeName(nil, pTokenInfo.Privileges[i].Luid, PrivName, Namesize);

LookupPrivilegeDisplayName(nil, PrivName, DisplayName, DisplSize, LangId);

memo1.lines.Add(PrivName +^I + DisplayName);

end;

FreeMem(PrivName);

FreeMem(DisplayName);

FreeMem(pTokenInfo);

end;

procedure TForm2.FormActivate(Sender: TObject); //плавно всплывающее окно для формы 2

const

n=127;

var

i:Byte;

begin

AlphaBlend:=True;

for i:=1 to n do

begin

AlphaBlendValue:=i*2;

Repaint;

end;

end;

procedure TForm2.FormCreate(Sender: TObject);

begin

Form2.Left:=(Screen.Width-Form2.Width) div 2; //по середине моннитора

Form2.Top:=(Screen.Height-Form2.Height) div 2;

end;

end.

ПРИЛОЖЕНИЕ В

unit Unit3;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, unit1, ComCtrls;

type

TForm3 = class(TForm)

TreeView1: TTreeView;

procedure FormCreate(Sender: TObject);

procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;

var AllowExpansion: Boolean);

procedure FormActivate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form3: TForm3;

implementation

{$R *.dfm}

procedure NextLevel(ParentNode: TTreeNode); //переключение и показ папок на лок дисках

function DirectoryName(name: string): boolean;

begin

result:=(name<>'.') and (name<>'..');

end;

var

sr, srChild: TSearchRec;

node: TTreeNode;

path: string;

begin

node:=ParentNode;

path:='';

repeat

path:=node.Text+'\'+path;

node:=node.Parent;

until node=nil;

if FindFirst(path+'*.*', faDirectory, sr)=0 then

begin

repeat

if (sr.Attr and faDirectory <> 0) and DirectoryName(sr.Name)

then

begin

node:=Form3.TreeView1.Items.AddChild(ParentNode, sr.Name);

node.ImageIndex:=0;

node.SelectedIndex:=1;

node.HasChildren:=false;

if FindFirst(path+sr.Name+'\*.*', faDirectory, srChild)=0

then

begin

repeat

if (srChild.Attr and faDirectory<>0) and DirectoryName(srChild.Name)

then node.HasChildren := true;

until (FindNext(srChild) <> 0) or node.HasChildren;

end;

FindClose(srChild);

end;

until FindNext(sr) <> 0;

end

else ParentNode.HasChildren:=false;

FindClose(sr);

end;

procedure TForm3.FormCreate(Sender: TObject); //показать локальные диски и находящиеся

//в них папки

const

IconNames:array [0..6] of String=('CLOSEDFOLDER','OPENFOLDER','FLOPPY','HARD','NETWORK','CDROM','RAM');

var

c:Char;

s:String;

Node:TTreeNode;

DriveType:Integer;

bm,mask:TBitmap;

i:Integer;

begin

Form3.Left:=(Screen.Width-Form3.Width) div 2; //по середине моннитора

Form3.Top:=(Screen.Height-Form3.Height) div 2;

TreeView1.Items.BeginUpdate;

TreeView1.Images:=TImageList.CreateSize(16, 16);

bm:=TBitmap.Create;

mask:=TBitmap.Create;

for i:=low(IconNames) to high(IconNames) do

begin

bm.Handle:=LoadBitmap(HInstance, PChar(IconNames[i]));

bm.Width:=16;

bm.Height:=16;

mask.Assign(bm);

mask.Mask(clBlue);

TreeView1.Images.Add(bm, mask);

end;

for c:='A' to 'Z' do

begin

s:=c+':';

DriveType:=GetDriveType(PChar(s));

if DriveType=1 then continue;

node:=Form3.TreeView1.Items.AddChild(nil, s);

case DriveType of

DRIVE_REMOVABLE: node.ImageIndex:=2;

DRIVE_FIXED: node.ImageIndex:=3;

DRIVE_REMOTE: node.ImageIndex:=4;

DRIVE_CDROM: node.ImageIndex:=5;

else node.ImageIndex:=6;

end;

node.SelectedIndex:=node.ImageIndex;

node.HasChildren:=true;

end;

TreeView1.Items.EndUpdate;

end;

procedure TForm3.TreeView1Expanding(Sender: TObject; Node: TTreeNode;

var AllowExpansion: Boolean);

begin

TreeView1.Items.BeginUpdate;

Node.DeleteChildren;

NextLevel(Node);

TreeView1.Items.EndUpdate;

end;

procedure TForm3.FormActivate(Sender: TObject); //плавно всплывающее окно для формы 3

const n=127;

var

i:Byte;

begin

AlphaBlend:=True;

for i:=1 to n do

begin

AlphaBlendValue:=i*2;

Repaint;

end;

end;

end.

ПРИЛОЖЕНИЕ Г

unit Unit4;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Winsock, registry, ExtCtrls, StdCtrls, ImgList, Buttons, ShellAPI, ComCtrls;

type

TForm4 = class(TForm)

Image1: TImage;

Timer1: TTimer;

StatusBar1: TStatusBar;

ImageList1: TImageList;

Image2: TImage;

procedure FormShow(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure Image2Click(Sender: TObject);

private

{ Private declarations }

public

procedure info(s1, s2: string);

end;

var

Form4: TForm4;

gn_speed_y: Integer;

gn_text_y: Integer;

_eax, _ebx, _ecx, _edx: Longword;

i: Integer;

b: Byte;

b1: Word;

s,s1,s2,s3,s_all:string;

q:TImageIndex;

lpDisplayDevice: TDisplayDevice;

dwFlags: DWORD;

cc: DWORD;

const

gn_speed_x: Integer =8;

gn_text_x: Integer =15;

gl_start: Boolean =True;

implementation

{$R *.dfm}

procedure TForm4.FormShow(Sender: TObject);

var

_eax, _ebx, _ecx, _edx: Longword;

i: Integer;

b: Byte;

s, s1, s2, s3, s_all: string;

MS:TMemoryStatus;

wVerReq: WORD;

wsaData: TWSAData;

iw: pchar;

h: PHostEnt;

c: array[0..128] of char;

isa:integer;

ld:DWORD;

PathArray : array [0..255] of char;

OSVersion:TOSVersionInfo;

begin

info('','');

//Set the startup colour of the image

Image1.Canvas.Brush.Color:=clBtnFace;

Image1.Canvas.FillRect(rect(0, 0, Image1.Width,Image1.Height));

begin

asm //get brand ID

mov eax,$80000002

db $0F

db $A2

mov _eax,eax

mov _ebx,ebx

mov _ecx,ecx

mov _edx,edx

end;

s := '';

s1 := '';

s2 := '';

s3 := '';

for i := 0 to 3 do

begin

b := lo(_eax);

s3:= s3 + chr(b);

b := lo(_ebx);

s := s + chr(b);

b := lo(_ecx);

s1 := s1 + chr(b);

b := lo(_edx);

s2 := s2 + chr(b);

_eax := _eax shr 8;

_ebx := _ebx shr 8;

_ecx := _ecx shr 8;

_edx := _edx shr 8;

end;

s_all := s3 + s + s1 + s2;

asm

mov eax,$80000003

db $0F

db $A2

mov _eax,eax

mov _ebx,ebx

mov _ecx,ecx

mov _edx,edx

end;

s := '';

s1 := '';

s2 := '';

s3 := '';

for i := 0 to 3 do

begin

b := lo(_eax);

s3 := s3 + chr(b);

b := lo(_ebx);

s := s + chr(b);

b := lo(_ecx);

s1 := s1 + chr(b);

b := lo(_edx);

s2 := s2 + chr(b);

_eax := _eax shr 8;

_ebx := _ebx shr 8;

_ecx := _ecx shr 8;

_edx := _edx shr 8;

end;

s_all := s_all + s3 + s + s1 + s2;

asm

mov eax,$80000004

db $0F

db $A2

mov _eax,eax

mov _ebx,ebx

mov _ecx,ecx

mov _edx,edx

end;

s := '';

s1 := '';

s2 := '';

s3 := '';

for i := 0 to 3 do

begin

b := lo(_eax);

s3 := s3 + chr(b);

b := lo(_ebx);

s := s + chr(b);

b := lo(_ecx);

s1 := s1 + chr(b);

b := lo(_edx);

s2 := s2 + chr(b);

_eax := _eax shr 8;

_ebx := _ebx shr 8;

_ecx := _ecx shr 8;

_edx := _edx shr 8;

end;

if s2[Length(s2)] = #0 then setlength(s2, Length(s2) - 1);

info('', 'Процессор - ' + s_all + s3 + s + s1 + s2);

end;

lpDisplayDevice.cb := sizeof(lpDisplayDevice);

while EnumDisplayDevices(nil, cc, lpDisplayDevice, dwFlags) do

begin

Inc(cc);

begin

info('', 'Видео карта - ' + lpDisplayDevice.DeviceString);

end

end;

begin

GlobalMemoryStatus(MS);

begin

info('', 'Оперативня память - '+FormatFloat('#,###" Мгб"', MS.dwTotalPhys / 1044484) );

end

end;

begin

OSVersion.dwOSVersionInfoSize := SizeOf(OSVersion);

if GetVersionEx(OSVersion) then

info('', 'Версия операционной системы - ' + Format('%d.%d (%d.%s)',[OSVersion.dwMajorVersion,OSVersion.dwMinorVersion,(OSVersion.dwBuildNumber and $FFFF),OSVersion.szCSDVersion]));

end;

begin

ld:=GetLogicalDrives;

for isa:=0 to 25 do

begin

if (ld and (1 shl isa))<>0 then

if GetDriveType(PChar(Char(Ord('A')+isa) + ':\'))=DRIVE_FIXED then

info('','HDD - ' +Char(Ord('A')+isa)+':\');

if GetDriveType(PChar(Char(Ord('A')+isa) + ':\'))=DRIVE_REMOVABLE then

info('','Floppy - '+Char(Ord('A')+isa)+':\');

if GetDriveType(PChar(Char(Ord('A')+isa)+':\'))=DRIVE_CDROM then

info('','CD-Rom - '+Char(Ord('A')+isa)+':\');

end;

begin

wVerReq:=MAKEWORD(1,1);

WSAStartup(wVerReq,wsaData);

GetHostName(@c,128);

h:=GetHostByName(@c);

iw:=iNet_ntoa(PInAddr(h^.h_addr_list^)^);

WSACleanup;

begin

info('','IP - '+iw);

end;

begin

info('','HOST - '+h^.h_Name);

end;

end;

begin

FillChar(PathArray,SizeOf(PathArray),#0);

GetWindowsDirectory(PathArray,255);

info('','Дериктория Windows - '+Format('%s',[PathArray]));

end;

end;

end;

procedure TForm4.info(s1, s2: string);

begin

if s1 <> '' then

begin

Image1.Canvas.Brush.Color := clBtnFace;

Image1.Canvas.Font.Color := clBlack;

Image1.Canvas.TextOut(gn_text_x, gn_text_y, s1);

end;

if s2 <> '' then

begin

Image1.Canvas.Brush.Color := clBtnFace;

Image1.Canvas.Font.Color := clBlack;

Image1.Canvas.TextOut(gn_text_x + Image1.Canvas.TextWidth(s1), gn_text_y, s2);

end;

Inc(gn_text_y, 13);

end;

procedure TForm4.Timer1Timer(Sender: TObject);

begin

StatusBar1.Panels[0].Text:='Сейчас: '+DateToStr(Now)+' '+TimeToStr(Now);

end;

procedure TForm4.FormCreate(Sender: TObject);

begin

Form4.Left:=(Screen.Width-Form4.Width) div 2; //по середине моннитора

Form4.Top:=(Screen.Height-Form4.Height) div 2;

end;

procedure TForm4.FormActivate(Sender: TObject);

const

n=127;

var

i:Byte;

begin

AlphaBlend:=True;

for i:=1 to n do

begin

AlphaBlendValue:=i*2;

Repaint;

end;

end;

procedure TForm4.Image2Click(Sender: TObject);

var

reestr : TRegistry;

begin

reestr:=TRegistry.Create;

reestr.RootKey := HKEY_CURRENT_USER;

Reestr.OpenKey('SOFTWARE\MICROSOFT\Internet Explorer\Main',True);

close;

end;

end.