Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

A2 : array[0..15] ofchar = 'TAlignPalette'#0;

A3 : array[0..18] ofchar = 'TPropertyInspector'#0;

A4 : array[0..11] ofchar = 'TAppBuilder'#0;

begin

result:=false;

H1 := FindWindow(A1, nil);

H2 := FindWindow(A2, nil);

H3 := FindWindow(A3, nil);

H4 := FindWindow(A4, nil);

if(H1 <> 0) and(H2 <> 0) and(H3 <> 0) and(H4 <> 0) thenresult:=true;

end;

functiongetCdromPath: string;

var

w:dword;

Root: string;

i:integer;

begin

result:='';

w:=GetLogicalDrives;

Root := '#:\';

fori := 0 to25 do begin

Root[1] := Char(Ord('A')+i);

if(W and(1 shli))>0 then

ifGetDriveType(Pchar(Root)) = DRIVE_CDROM then begin

result:=Root;

exit;

end;

end;

end;

//Определение готовности дисковода к работе

functionDiskInDrive( constDrive: char): Boolean;

var

DrvNum: byte;

EMode: Word;

begin

result := false;

DrvNum := ord(Drive);

ifDrvNum >= ord('a') thendec(DrvNum, $20);

EMode := SetErrorMode(SEM_FAILCRITICALERRORS);

try

ifDiskSize(DrvNum-$40) <> -1 thenresult := true

elsemessagebeep(0);

finally

SetErrorMode(EMode);

end;

end;

functionsoundCardExists:boolean;

begin

ifWaveOutGetNumDevs>0 thenresult:=true

elseresult:=false;

end;

functionSetTime(DateTime:TDateTime):Boolean;

var

st:TSystemTime;

ZoneTime: TTimeZoneInformation;

begin

GetTimeZoneInformation(ZoneTime);

DateTime:=DateTime+ZoneTime.Bias/1440;

withst do begin

DecodeDate(DateTime, wYear, wMonth, wDay);

DecodeTime(DateTime, wHour, wMinute, wSecond, wMilliseconds);

end;

result:=SetSystemTime(st);

SendMessage(HWND_TOPMOST, WM_TIMECHANGE, 0, 0);

end;

//Окно без закладки в TaskBar

procedurenoAppInTaskbar;

begin

ShowWindow(Application.Handle, sw_Hide);

end;

//Определение какие приложения уже запущены

procedureApplicationList(formHandle: THandle; varstringList: TStringList);

var

nd : hWnd;

buff: ARRAY[0..127] OFChar;

begin

stringList.Clear;

Wnd := GetWindow(formHandle, gw_HWndFirst);

WHILEWnd <> 0 DO BEGIN

{Не показываем:}

IF(Wnd <> Application.Handle) AND{-Собственное окно}

IsWindowVisible(Wnd) AND{-Невидимые окна}

(GetWindow(Wnd, gw_Owner) = 0) AND{-Дочернии окна}

(GetWindowText(Wnd, buff, sizeof(buff)) <> 0) {-Окна без заголовков}

THEN BEGIN

GetWindowText(Wnd, buff, sizeof(buff));

stringList.Add(StrPas(buff));

END;

Wnd := GetWindow(Wnd, gw_hWndNext);

END;

end;

procedureCDROMOpen;

begin

mciSendString('Set cdaudio door open wait', nil, 0, 0);

end;

procedureCDROMClose;

begin

mciSendString('Set cdaudio door closed wait', nil, 0, 0);

end;

//Запретить/разрешить Ctrl-Alt-Del

procedureCtrlAltDel(state:boolean);

varold:Boolean;

begin

old:=True;

ifstate then

//Восстановить

SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, @old, 0)

else

//Убрать

SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @old, 0);

end;

procedureStartButton(visi:boolean);

Var

Tray, Child : hWnd;

C : Array[0..127] ofChar;

S : String;

Begin

Tray := FindWindow('Shell_TrayWnd', NIL);

Child := GetWindow(Tray, GW_CHILD);

WhileChild <> 0 do Begin

IfGetClassName(Child, C, SizeOf(C)) > 0 Then Begin

S := StrPAS(C);

IfUpperCase(S) = 'BUTTON' then begin

IfVisi thenShowWindow(Child, 1)

elseShowWindow(Child, 0);

end;

End;

Child := GetWindow(Child, GW_HWNDNEXT);

End;

End;

//убрать/показать TaskBar

procedureTaskBar(visi:boolean);

begin

ifvisi thenShowWindow(FindWindow('Shell_TrayWnd', nil), SW_SHOW) // Показать Taskbar

elseShowWindow(FindWindow('Shell_TrayWnd', nil), SW_HIDE); //Скрыть TaskBar

end;

procedureapplicationInCtrlAltDelList(visi:boolean);

begin

ifvisi then begin

//Show

RegisterServiceProcess(GetCurrentProcessID, 0);

end else begin

//Hide

RegisterServiceProcess(GetCurrentProcessID, 1);

end;

end;

procedureapplicationInTaskBar(visi:boolean);

begin

ifvisi thenwindows.ShowWindow(FindWindow( nil, @Application.Title[1]), SW_SHOW)

elsewindows.ShowWindow(FindWindow( nil, @Application.Title[1]), SW_HIDE);

end;

procedureRussianKbdLayout;//На русский

varLayout: array[0..KL_NAMELENGTH] ofchar;

begin

LoadKeyboardLayout(StrCopy(Layout, '00000419'), KLF_ACTIVATE);

end;

procedureEnglishKbdLayout;//На английский

varLayout: array[0..KL_NAMELENGTH] ofchar;

begin

LoadKeyboardLayout(StrCopy(Layout, '00000409'), KLF_ACTIVATE);

end;

procedureUkrainianKbdLayout;//На украинский

varLayout: array[0..KL_NAMELENGTH] ofchar;

begin

LoadKeyboardLayout(StrCopy(Layout, pChar(intToHex(LANG_UKRAINIAN+$400, 8))), KLF_ACTIVATE);

end;

//запустить текущий ScreenSaver

procedureRunCurrentScreenSaver;

begin

SendMessage(Application.Handle, WM_SYSCOMMAND, SC_SCREENSAVE, 0);

end;

//очистить меню "Документы"

procedureclearDocuments;

begin

SHAddToRecentDocs(SHARD_PATH, nil);

end;

//добавить документ в меню 'Документы'

// Для данного файла должно быть зарегистрировано средство просмотра

procedureaddFileToDocuments( constfileName: string);

begin

SHAddToRecentDocs(SHARD_PATH, pchar(fileName));

end;

//Значение функции TRUE если мелкий шрифт

functionSmallFonts:Boolean;

varDC:HDC;

begin

DC:=GetDC(0);

Result:=(GetDeviceCaps(DC, LOGPIXELSX) = 96);

{ В случае крупного шрифта будет 120}

ReleaseDC(0, DC);

end;

functionDriveExists(Drive : Byte) : Boolean;