Приветствую Вас, уважаемые читатели!

Письмо...

Подписался на вашу рассылку - очень полезная и нужная вещь. Но читать ее неудобно - весь код, приводимый в рассылке прилеплен к левому краю листа - никакого форматирования и как следствие - неудобочитаемо.

Может быть для кусков кода можно задавать моноширинный шрифт (хотя бы и тегом <FONT>) и сохранять структурное ворматирование (например тегом <PRE>)?

Ведущий: В этом выпуске постарался сделать, чтобы читать стало удобнее. Действительно, код прилегал к левому краю страницы. Теперь всё идёт с отступом. Надеюсь, что стало удобнее...

Также хочется сказать всем: почаще заглядывайте в архив рассылки или на сайт. Многие вещи уже обсуждались, а вопросы задаются повторно. Это, например, касается вопроса насчёт MP3 в EXE - как хранить ресурсы в исполняемом файле обсуждалось в вопросе №25.

Ну а теперь о периодичности выхода рассылки. Спасибо всем проголосовавшим, все мнения и пожелания были прочитаны. Итак...

С какой периодичностью вы хотели бы видеть нашу рассылку?

Оставить как есть (раз в неделю) - 12 голосов;
Раз в три дня - 10 голосов;
Другие варианты - 1 голос.

Поскольку наблюдается достаточно серьёзное разногласие во мнениях, оставим всё, как есть. Действительно, как раз за неделю удаётся найти необходимые материалы для рассылки, и как раз за неделю читатели успевают проанализировать всё опубликованное...

Количество подписчиков: 1692.

Внимание! Наш конкурс на поиск и разгадку ключевой фразы заканчивается 31 января, т.е. через 3 дня. Не упустите свой шанс! 31 января ключевая фраза будет убрана с сайта, и будет разослан спец-выпуски рассылки.

Пожалуйста, не забывайте дублировать свои вопросы на нашем форуме.

Top-10 Readers:

Правила нашей рассылки:
1. Не присылайте ответов на вопросы вроде "да я не знаю" или "да/нет". Такие ответы не публикуются.
2. Вопросы, не касающиеся Delphi, не принимаются (для этого существуют другие рассылки).
3. Запрещено присылать вложенные файлы, размером более 100 Кб, без предварительной связи с администратором.
4. Не изменяйте тем присылаемых писем. Письма с "неправильными" темами не публикуются! Используйте текстовый формат писем.

Новые вопросы.

57. Привет! Нужна процедура для вызова в окно WebBrowser файла HTML и других файлов. Спасибо. [Ответить].

58. Добрый день! Я установил в Delphi бибилиотеку "Microsoft Speech Object Library (Version 5.1)", появилось 19 компонентов. Подскажите пожалуйста где найти информацию по их использованию. Заранее всем спасибо. [Ответить].

59. Здравствуйте! подскажите пожалуйста, как подсоединить базу данных, созданную в MSAccess к приложению в Делфи без использования BDE. Заранее спасибо. [Ответить].

60. Всем привет! У меня такой трабл по поводу создания анкет/тестов. Я написал DataSourse - приложение для создания базы вопросов в формате XML. Вопросы создаются, но как связать базу с интерфейсом - не знаю! Хотелось бы создать нормальный менеджер, с начислением баллов (через переменные), примерно такой:

но увы - не хватает мозгов и опыта :)
Буду благодарен за любую информацию. Заранее спасибо.
P.S. Высылаю свой исходник, если что непонятно. Для сохранения базы XML нужно присоединить .dllку (Пуск\выполнить\ с:\windows\system32\regsvr32.exe с:\windows\system\midas.dll )
P.S 2 Извините за кривую форму: тут и вопросник, и ответы. Надеюсь на понимание :))) [Ответить]. Исходники здесь.

61. Запуск программы происходит с параметрами (ключами) : program.exe ключ1 ключ2 ... Как узнать с какими параметрами командной строки было запущено это (не мое) приложение (процесс)? [Ответить].

62. Здравствуйте! Подскажите пожалуйста, где можно найти сведения для такого вот дела. При нажатии на кнопку курсор должен выполнять роль карандаша (как в Paint например) и соответственно рисовать. А при повторном нажатии, курсор должен опять принять прежний облик стрелки. Спасибо. [Ответить].

Вопросы, требующие ответа.

55. Здравствуйте. Прошу знающих помочь. Кто хоть немного соприкоснулся с Delphi 8. В чем разница между WinForm и VCL.NET, В VCL.NET не смог найти как работать с ADO, а в WinForm всё настолько запутанно ...(к примеру, по нажатию кнопки необхрдимо создать и высветить новое окно). В D-5 и D-7 это решалось просто:
Form2 := TForm2.Create(nil);
Form2.ShowModal;
Form2.Free;
Окно создано (когда необходимо), показано пользователю и по закрытию уничтожается. Как в D-8 ? [Ответить].

Ответы на вопросы.

54. (Отслеживание событий Windows). [Ответил: Feniks]. В качестве ответа на вопрос Feniks прислал статью, читайте её в разделе "Статьи".

[Отвечает: Звягинцев Павел]: Ответ не мой, сразу скажу, мои только дополнения.

Невидимые формы в EXE и DLL. К примеру, требуется, чтобы в EXE- или в DLL-проекте отсутствовали какие-либо формы или компоненты, хотя и так большинство компонентов (windows UI-элементов управления) не имеют смысла вне формы. Единственная функциональность, которую вы теряете без использования форм - невозможность визуальной работы с компонентами и их характеристиками. Для примера, процесс создания компонента TDatabase в DLL или EXE "ручками" выглядит примерно таким образом:

procedure XYZ;
var

DB: TDatabase;
begin

DB := TDatabase.Create( nil);
{ теперь используем это }
DB.Alias := 'test';
DB.Active := true;
DB.DoSomething
DB.DosomethingElse
{ теперь освобождаем экземпляр TDatabase }
DB.Free
end;

Для не-визуальных компонентов форма, сама по себе, не имеет никакого значения. Поскольку TForm является дальным наследником TComponent, то она может быть владельцем других компонентов, тем не менее эта характеристика не добавляет функциональности расположенным на ней компонентам. Так какое преимущество существует у компонентов, расположенных на форме? Удобное, но небольшое: при разрушении формы (или компонента), предварительно автоматически освобождаются все компоненты, владельцем которых она является (ссылки на них содержатся во внутреннем списке).

Какое преимущество дает форма для не-визуальных компонентов (TDatabase, TTable и пр.) кроме их автоматического освобождения при освобождении формы? Никакого. Только то, что при использовании визуального конструирования все компоненты, располагаемые на форме, становятся принадлежащими этой форме и позволяют изменить их свойства по умолчанию.

Флаг видимости, как и ожидалось, работает и в dll, и в exe, тем не менее вы должны знать, что некоторые функции, например, Application.Run, устанавливают для главной формы visible := true. Вы не сможете это корректно обойти, поскольку эта форма является главной формой приложения, а для запуска приложения вы вызываете Application.Run.

Если вы хотите сделать главную форму невидимой, замените строку Application.Run следующей конструкцией:

repeat
Application.HandleMessage;
until Application.Terminated;
Application.Destroying;
Application.DestroyComponents;

Дополнение: Чтобы зарегистрировать свою прогу как процесс после вышеперечисленного используй те srvany.exe, это стандартная прога для запуска процессов под НТ системами. Надо, пришлю, но в поиске их полно.

[Отвечает: Iron Monk]: Всем привет! По первому вопросу:

При выключении или перезагрузке выкинет табличку 'Windows ShutDown':

private
procedure WMWinIniChange(var Mes: TMessage); message WM_QUERYENDSESSION;
{ Private declarations }
.......
procedure TForm1.WMWinIniChange(var Mes: TMessage);
begin
inherited;
ShowMessage('Windows ShutDown');
end;

При нажатии кнопки клавиатуры показывает её код:

private
procedure PressKey_Char(var PressKey: TWMKEY); message WM_CHAR;
......
procedure TForm1.PressKey_Char(var PressKey: TWMKEY);
begin
Label1.Caption:=IntToStr(PressKey.CharCode);
inherited;
end;

И далее можешь обрабатывать целую кипу сообщений:

wm_WinIniChange
wm_WindowPosChanging
wm_WindowPosChanged
wm_VScrollClipboard
wm_VScroll
wm_VKeyToItem
wm_Undo
wm_Timer
wm_TimeChange
wm_SystemError
wm_SysKeyUp
wm_SysKeyDown
wm_SysDeadChar
wm_SysCommand
wm_SysColorChange
wm_SysChar
wm_StyleChanging
wm_StyleChanged
wm_SpoolerStatus
wm_SizeClipboard
wm_Size
wm_ShowWindow
wm_SetText
wm_SetRedraw
wm_SetIcon
wm_SetFont
wm_SetFocus
wm_SetCursor
wm_RenderFormat
wm_RenderAllFormats
wm_RButtonUp
wm_RButtonDown
wm_RButtonDblClk
wm_Quit
wm_QueueSync
wm_QueryOpen
wm_QueryNewPalette
wm_QueryEndSession
wm_QueryDragIcon
wm_Power
wm_Paste
wm_ParentNotify
wm_PaletteIsChanging
wm_PaletteChanged
wm_PaintIcon
wm_PaintClipboard
wm_Paint
wm_Null
wm_Notify
wm_NextDlgCtl
wm_NCRButtonUp
wm_NCRButtonDown
wm_NCRButtonDblClk
wm_NCPaint
wm_NCMouseMove
wm_NCMButtonUp
wm_NCMButtonDown
wm_NCMButtonDblClk
wm_NCLButtonUp
wm_NCLButtonDown
wm_NCLButtonDblClk
wm_NCHitTest
wm_NCDestroy
wm_NCCreate
wm_NCCalcSize
wm_NCActivate
wm_Move
wm_MouseMove
wm_MouseActivate
wm_MenuSelect
wm_MenuChar
wm_MeasureItem
wm_MDITile
wm_MDISetMenu
wm_MDIRestore
wm_MDIRefreshMenu
wm_MDINext
wm_MDIMaximize
wm_MDIIconArrange
wm_MDIGetActive
wm_MDIDestroy
wm_MDICreate
wm_MDICascade
wm_MDIActivate
wm_MButtonUp
wm_MButtonDown
wm_MButtonDblClk
wm_LButtonUp
wm_LButtonDown
wm_LButtonDblClk
wm_KillFocus
wm_KeyUp
wm_KeyDown
wm_InitMenuPopup
wm_InitMenu
wm_InitDialog
wm_IconEraseBkGnd
wm_HScrollClipboard
wm_HScroll
wm_GetTextLength
wm_GetText
wm_GetMinMaxInfo
wm_GetIcon
wm_GetFont
wm_GetDlgCode
wm_FontChange
wm_EraseBkGnd
wm_EnterIdle
wm_EndSession
wm_Enable
wm_DropFiles
wm_DrawItem
wm_DrawClipboard
wm_DevModeChange
wm_DestroyClipboard
wm_Destroy
wm_DeleteItem
wm_DeadChar
wm_Cut
wm_CtlColorStatic
wm_CtlColorScrollbar
wm_CtlColorMsgbox
wm_CtlColorListbox
wm_CtlColorEdit
wm_CtlColorDlg
wm_CtlColorBtn
wm_CtlColor
wm_Create
wm_CopyData
wm_Copy
wm_CompareItem
wm_Compacting
wm_CommNotify
wm_Command
wm_Close
wm_Clear
wm_ChildActivate
wm_CharToItem
wm_Char
wm_ChangeCBChain
wm_CancelMode
wm_CancelJournal
wm_AskCBFormatName
wm_ActivateApp
wm_Activate
CN_VSCROLL
CN_VKEYTOITEM
CN_SYSKEYDOWN
CN_SYSCHAR
CN_PARENTNOTIFY
CN_NOTIFY
CN_MEASUREITEM
CN_KEYUP
CN_KEYDOWN
CN_HSCROLL
CN_DRAWITEM
CN_DELETEITEM
CN_CTLCOLORSTATIC
CN_CTLCOLORSCROLLBAR
CN_CTLCOLORMSGBOX
CN_CTLCOLORLISTBOX
CN_CTLCOLOREDIT
CN_CTLCOLORDLG
CN_CTLCOLORBTN
CN_COMPAREITEM
CN_COMMAND
CN_CHARTOITEM
CN_CHAR
CM_WININICHANGE
CM_WINDOWHOOK
CM_WANTSPECIALKEY
CM_VISIBLECHANGED
CM_UIDEACTIVATE
CM_UIACTIVATE
CM_TIMECHANGE
CM_TEXTCHANGED
CM_TABSTOPCHANGED
CM_TABFONTCHANGED
CM_SYSCOLORCHANGE
CM_SHOWINGCHANGED
CM_SHOWHINTCHANGED
CM_RELEASE
CM_PARENTSHOWHINTCHANGED
CM_PARENTFONTCHANGED
CM_PARENTCTL
CM_PARENTCOLORCHANGED
CM_MOUSELEAVE
CM_MOUSEENTER
CM_MENUCHANGED
CM_LOSTFOCUS
CM_ISTOOLCONTROL
CM_INVOKEHELP
CM_ICONCHANGED
CM_HITTEST
CM_HINTSHOW
CM_GOTFOCUS
CM_GETDATALINK
CM_FONTCHANGED
CM_FONTCHANGE
CM_FOCUSCHANGED
CM_EXIT
CM_EXECPROC
CM_ENTER
CM_ENABLEDCHANGED
CM_DRAG
CM_DOCWINDOWACTIVATE
CM_DIALOGKEY
CM_DIALOGHANDLE
CM_DIALOGCHAR
CM_DESIGNHITTEST
CM_DEFERLAYOUT
CM_DEACTIVATE
CM_CURSORCHANGED
CM_CTL
CM_CONTROLLISTCHANGE
CM_COLORCHANGED
CM_CHILDKEY
CM_CANCELMODE
CM_BUTTONPRESSED
CM_APPSYSCOMMAND
CM_APPKEYDOWN
CM_ACTIVATE

А вот запуск файла проще искать по заголовку или имени класса окна:

procedure TForm1.Button1Click(Sender: TObject);
begin
if FindWindow(nil, 'Безымянный - Блокнот') <> 0 then
ShowMessage('Окно найдено')
else
ShowMessage('Окно не найдено');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if FindWindow('Notepad', nil) <> 0 then
ShowMessage('Окно найдено')
else
ShowMessage('Окно не найдено');
end;
end.

Или можно с помощью просмотровщика процессов:

procedure TForm1.FormCreate(Sender: TObject);
var
Wnd : hWnd;
buffer: array [0..256] of Char;
begin
ListBox1.Clear;
Wnd := GetWindow(Handle, gw_HWndFirst);
while Wnd <> 0 do
begin
if (Wnd <> Application.Handle) and
(GetWindowText(Wnd, buffer, sizeof(buffer)) <> 0)
then begin
GetWindowText(Wnd, buffer, sizeof(buffer));
ListBox1.Items.Add(StrPas(buffer));
end;
Wnd := GetWindow(Wnd, gw_hWndNext);
end;
ListBox1.ItemIndex := 0;
end;
end.

По второму вопросу:

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowWindow(Application.Handle,sw_Hide);
end;

Приложение перестаёт фигурировать во вкладке "Приложения" диспетчера задач и исчезает с "Панели задач".

[Отвечает: Dasha]: После создания проекта нужно зайти в Project Manager и удалить unit, оставив только файл самого проекта. После этого можно заменить модуль Forms, который не используется на Windows, а также удалить все строки между begin и end, поскольку приложение тоже не создается. То есть использовать только функции WinAPI и связанные с ними модули. Такая прога к тому же занимает очень мало места.

[Отвечает: Den]: Чтобы прога запускалась без окна (как процесс), в uses удали Forms. Дескриптора окна не будет, но и все компоненты (невидимые как таймер), которые ты используешь, придётся создавать вручную: tTimer := TTimer.Create(nil);

53. (Проигрывание MP3 внутри EXE; Путь к файлу с CD). [Отвечает: Feniks]: "Затолкнуть" в ЕХЕ-шник любой файл - это не проблема. Проблема в том: как ты собрался его проигрывать ? Я, лично, не знаю как проигрывать МР3 файлы. А "запихивать" файлы в ЕХЕ-шник или в DLL-ку нужно следующим образом:

создаешь текстовый файл с расширением .RC и пишешь в нем
<имя ресурса> <тип хранимого ресурса> <имя файла>
например:
BackGround0 BITMAP "BackGround0.bmp"
BackGround1 BITMAP "BackGround1.bmp"
BackGround2 BITMAP "BackGround2.bmp"
BackGround3 BITMAP "BackGround3.bmp"
SoundAbout WAVE "About.wav"
CurSQLWait RCDATA "SQLWait.ani"
AnimateWait AVI "AnimateWait.avi"

тут перечислены стандартные типы ресурсов. так же можно использовать свои, наприме MYGIF. но лучше использовать стандартные, так тогда проще их вытягивать будет. Так как для GIF и JPG нет стандартных типов, необходимо использовать RCDATA. Потом все это сохраняешь под именем myres.rc ОЧЕНЬ ВАЖНО, что бы все перечисленные в нем файлы и сам файл RC лежали в одной папке.

Далее, компилируешь его с помощью утилиты brcc32 в файл .RES brcc32 myres.rc В результате получаешь myres.res Вот его потом присоединяешь в свое проект или в отдельный модель. {$R myres.res}

Тот файл RES, который сама Делфя используем по умолчания для каждого проекта, лучше не использовать, получишь много головной боли хлопот. Я это сам на своей шкуре испытал.

После присоединения его к проекты надо проект перебилдить (Build), а не перекомпилировать, т.к. при компиляции он не компилит файл RES в ЕХЕ. И в последующих изменениях в RC файле надо каждый раз билдить весь проект.

Чтобы вытянуть эти ресурсы из ЕХЕ файла и сохранить их в файлы:

var
ResStream : TResourceStream;
begin
ResStream := TResourceStream.Create(hInstance, <имя ресурса>, RT_RCDATA);
ResStream.SaveToFile('NameFile.ext');
ResStream.Free;
end;

Смотри в Хелпе: TResourceStream, LoadImage, LoadFromResourceName, LoadFromResourceID,
LoadIcon, PlaySound, FindResource, FindResourceEx и т.д. и т.п.

2. Если ты собрался программно запускать с компакт-диск прогу, то тебе в первую очередь надо определить "букву" привода. Потом добавить к ней путь и имя твоего запускаемого файла. Для определения CD-привода надо перебрать все "буквы" дисков от С до Z и проверить тип привода, если это сидюк, то тебе повезло:

var
CD : string;

for i := 67 to 90 do
begin
DriveType := GetDriveType(PChar(Chr(i)+':\'));
if DriveType = DRIVE_CDROM then
begin
ShowMessage('Найден Сидюк');
CD := Chr(i)+':\';
end;
end;

Но тут есть недостаток в том, что если у тебя более одно привода для дисков. Тогда как быть? Можно, конечно, привязать прогу к серийнику сомого диска, и тогда найдя привод проверить в нем диск.
Для определения Серийного номера самого диска можешь попробовать так:

uses MMSystem, MPlayer;

procedure TForm1.Button1Click(Sender: TObject);
var
mp : TMediaPlayer;
msp : TMCI_INFO_PARMS;
MediaString : array[0..255] of char;
ret : longint;
begin
mp := TMediaPlayer.Create(nil);
mp.Visible := false;
mp.Parent := Application.MainForm;
mp.Shareable := true;
mp.DeviceType := dtCDAudio;
mp.FileName := 'D:';
mp.Open;
Application.ProcessMessages;
FillChar(MediaString, sizeof(MediaString), #0);
FillChar(msp, sizeof(msp), #0);
msp.lpstrReturn := @MediaString;
msp.dwRetSize := 255;
ret := mciSendCommand(Mp.DeviceId, MCI_INFO, MCI_INFO_MEDIA_IDENTITY,
longint(@msp));
if Ret <> 0 then
begin
MciGetErrorString(ret, @MediaString, sizeof(MediaString));
Memo1.Lines.Add(StrPas(MediaString));
end
else
Memo1.Lines.Add(StrPas(MediaString));
mp.Close;
Application.ProcessMessages;
mp.free;
end;

[Отвечает: Iron Monk]: Всем привет! Процесс заталкивания файлов в EXEшник был уже неоднократно рассмотрен в прошлых выпусках рассылки - с помощью файла ресурсов. А в 15 выпуске был дан ответ по воспроизведению музыки и звуков . По второму вопросу: Подскажите, как правильно писать строку для запуска файла, если буква привода CD переменная ? Наверное на разных компах CD-ROM под разными буквами? Тогда при запуске программы просто нужно найти под какой он буквой и дальше использовать её.

var
s:array[0..25] of string = ('A','B','C','D','E',
'F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U',
'V','W','X','Y','Z');
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
Drive:PAnsiChar;
i:integer;
begin
for i:=0 to 25 do
begin
StrPCopy(Drive,s[i]+ ':\');
if GetDriveType(Drive) =5 then
ShowMessage(S[i]+':\');
end;
end;

[Отвечает: Dasha]: 1) Для этого возьми OleContainer, в нем можно хранить что угодно. 2) Можно поставить на форму DriveComboBox и выбирать из него нужный дисковод, а потом использовать в строке с адресом DriveComboBox.Drive и дальше адрес на диске.

[Отвечает: Den]: Если буква сидюка переменная, то перед обращением к нему определи путь до сидюка (Win API Help).

40. (Определение скорости интернета). [Отвечает: yga72]: Network traffic monitor. Network traffic monitor - производит мониторинг входящего/исходящего трафика между вашим компьютером и местной локальной сетью/интернетом. Подробное описание: http://www.codersclub.net/news/156.html.

45. (Запуск приложений). [Отвечает: Sandro]: Повесь в обработчике его запуск через WinExec( имя файла, командная строка).

56. (Сортировка данных в таблице и вывод стрелки в заголовках столбцов). [Отвечает: fil]: Да, есть такой компонент, например, его можно найти в RxLib или (очень посоветую) в DeveloperExpress-QuantumGrid. Кстати, DevExpress, идет на многих дисках вместе с Delphi 7.

[Отвечает: Звягинцев Павел]: Ну данные сортируются не просто по желанию, а по индексу, создай индекс, какой тебе надо, а потом примерно следующее:

procedure Tw_works.GridTitleClick(Column: TColumn);
var s:String;
n:Integer;
begin
s:=column.FieldName;
n:=table.TagArea(s+'_t');
if n>0 then
begin
table.SetOrder(n);
for n:=0 to grid.Columns.Count-1 do
begin
grid.Columns.Items[n].title.color:=clBtnFace;
grid.Columns.Items[n].title.font.color:=clWindowtext;
end;
column.title.Color:=clBlue;
column.Title.Font.Color:=clYellow;
end;
end;
// тут у меня индексы имели имя типа "имя поля"+"_t"

Ну и если есть индекс, его включаем, а поле красим слегка, чтоб было видно, с чем работаем.

[Отвечает: Iron Monk]: Всем привет!

type TStringGridExSortType = (srtAlpha,srtInteger,srtDouble);

procedure GridSort(SG : TStringGrid; ByColNumber,FromRow,ToRow : integer;
SortType : TStringGridExSortType = srtAlpha);
var
Temp : TStringList;
function SortStr(Line : string) : string;
var RetVar : string;
begin
case SortType of
srtAlpha : Retvar := Line;
srtInteger : Retvar := FormatFloat('000000000',
StrToIntDef(trim(Line),0));
srtDouble : try
Retvar := FormatFloat('000000000.000000',
StrToFloat(trim(Line)));
except
RetVar := '0.00';
end;
end;
Result := RetVar;
end;
// Рекурсивный QuickSort
procedure QuickSort(Lo,Hi : integer; CC : TStrings);
procedure Sort(l,r: integer);
var i,j : integer;
x : string;
begin
i := l; j := r;
x := SortStr(CC[(l+r) DIV 2]);
repeat
while SortStr(CC[i]) < x do inc(i);
while x < SortStr(CC[j]) do dec(j);
if i <= j then begin
Temp.Assign(SG.Rows[j]); // Меняем местами 2 строки
SG.Rows[j].Assign(SG.Rows[i]);
SG.Rows[i].Assign(Temp);
inc(i); dec(j);
end;
until i > j;
if l < j then sort(l,j);
if i < r then sort(i,r);
end;
begin {quicksort};
Sort(Lo,Hi);
end;
begin
Temp := TStringList.Create;
QuickSort(FromRow,ToRow,SG.Cols[ByColNumber]);
Temp.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
GridSort(StringGrid1,0,1,4);// Сортирует с 1 по 4 строку
end;

Взято с Исходников.ru: http://www.sources.ru.

[Отвечает: Ершов Денис]: Все тот же AdvStringGrid (http://www.tmssoftware.com).

[Отвечает: Feniks]: В качестве ответа хочуу представить Вашему вниманию несколько не стандартных компонентов (от третих производителей) для работы с сетками:

1. TBitDBGrid - является расширение стандартного компонента TDBGrid VCL Delphi. Существует в версии только для Delphi 3.0 (для 4.0 должен легко портироваться). По сравнению со стандартным включает следующие расширения:

- Многострочные заголовки
- Инкрементальный поиск в колонке
- Итоги по столбцам или для всего грида
- Минимизация колонки по-наибольшему значению (a-la Excel)
- Хинты к ячейкам (если не помещается значение)
- поддержка _своего_ наследника от TDBGridColumn
(хинты на заголовки, итоги)
- Прикрепленный ImageList - для облегчения рисования картинки в ячейке
- Заполнение колонками всего объема :) DBGrid'a
- Или прорисовка title'a за последнюю колонку
- Редактор колонок в run-time'e:
Позволяет редактировать цвета, шрифты, caption'ы
колонок и прятать/показывать сами колонки
- Запоминает настройки в реестре
- Сортирует содержимое DataSet'a
- Возможны различные виды кнопок на заголовках:
Обычная, фиксируемая, 'Только одна нажатая',
'Хотя бы одна нажатая', Выделение текущей колонки.
- Взята пара фичей из RXDBGrid'a:
Событие OnGetCellParams, property IniStorage
- Копирование содержимого колонок (или всей записи)
в Clipboard или вставку из Clipboard'a
- Рисование точечек в конце не влезающих строк.
- Что-то еще, но не помню сейчас :)

2. TVirtualTreeView - Прекрасное сочетания TStringGrid'а и TTreeView'а в одном компоненте. Большое количестов полезных функций и новшеств. www.delphi-gems.com.

3. TStringAlignGrid.

4. XStringGrid.

5. Или можно использовать TListView, указав ему Report стиль. В Хелпе по нему есть прекрасный пример по организации сортировки в двух направлениях и по разным колонкам, см. событие OnCompare.

//От ведущего: TBitDBGrid, TStringAlignGrid и XStringGrid можно скачать с нашего сайта из раздела "Кладовая".

12. (Получение списка всех TCP/IP соединений). [Отвечает: Den]: Книжка есть "Delphi глазами Хакера", там это подробнейшим образом расписано, даже листинг проги имеется. Книгу заказывал на Ozon.ru, но можно и купить в магазе (автор - ведущий рубрики "Кодинг" в журнале "Хакер").

Быстрые ответы.

Как узнать с какими параметрами командной строки запустилось приложение?

Подумал, что этот вопрос очень лёгкий и обсуждать его нет смысла. Количество параметров командной строки можно определить с помощью функции ParamCount. Узнать конкретный параметр - через ParamStr(номер параметра). При этом слудует учитывать, что всего существует нулевой параметр, содержащий полный путь выполняемой программы, т.е. ParamStr(0) выдаст строку вроде "C:\Prog\myprog.exe". Надеюсь, что осветил вопрос достаточно понятно. А вообще, не забывайте, что есть встроенный хелп :)

Вы также можете ответить на предыдущие вопросы. Поскольку на них уже ответили как минимум раз, они больше не публикуются в рассылке. Но если вы можете что-то добавить к ответам других, пожалуйста, отвечайте - ответы будут опубликованы. Найти предыдущие вопросы вы можете на нашем сайте: http://www.delphi-faq.fatal.ru/ или в спец-выпусках рассылки.

Статьи по Delphi.

Начиная с этого выпуска, мы начинаем публикацию нового цикла статей. Не обращайте внимание на упоминаемые версии Delphi (4 и 5) - на 6 и 7 всё практически идентично.

Delphi 4: Автоматизация приложений MS® Office® для эффективного анализа результатов

Содержание:


• Глава 1: Работа с MS Excel.
  • Часть 1: Создание, отображение и удаление экземпляра Excel.
  • Часть 2: Лучшее решение - шаблоны.
  • Часть 3: Создание или открытие книги.
  • Часть 4: Работа с листами и ячейками.
  • Часть 5: Передача данных разного типа.
  • Часть 6: Передача данных используя буфер обмена и DDE.
  • Часть 7: Пример обмена данными с Excel используя VCL и OLE.
• Глава 2: Работа с MS Word.
  • Часть 1: Управление Word-ом через OLE.
  • Часть 2: Подсчет статистики обычного текста, сносок и колонтитулов в документах.
  • Часть 3: Открытие документа используя VCL.
  • Часть 4: Работа с таблицами.
  • Часть 5: Работа с текстом, рисунками и списками.

Евгений Старостин.

Собственно, цель этой статьи мне понятна - поделиться своим опытом с народом. Делюсь...

Итак, зачем нам, лучшим в мире программистам, нужен Excel, порождение "злого" гения Microsoft? Конечно, часто это лишнее - "юзать" Excel для отчетов. Напечатать "платежку" можно и в QReport-е. Но...

Есть заказчики, готовые отдать "кучищи" денег за то, что они будут знать все и всегда о своем предприятии. Да еще, чтоб это было красиво и со вкусом.

Приезжает один из моих заказчиков (немец - они повсюду! курорты Испании просто куплены ими - это знаю наверняка) на свое местное предприятие и начинает задавать интересные вопросы. Как трудились за время его отсутствия, сколько продукции выпустили, кому сколько отгрузили, в разных валютах, итого в USD и пр.? А я ему в ответ открываю отчет, неслабый такой, - сводная таблица по движению готовой продукции (посвященные знают, что это 40-ой счет в бухгалтерии). А в ней одних PageField-ов десяток. И на каждый его вопрос я начинаю отвечать не напрягаясь, потихоньку перетаскивая поля таблицы туда-сюда, фильтрую кое-что, строю диаграммы. Что, вы думаете, было потом? Он, как маленький ребенок, сидел за этой сводной таблицей несколько часов, все восхищался. И правильно, наши программисты круче ихних! Заодно и мы спокойно поработали (ему занятие нашлось). О деньгах тут вообще не говорим.

Потом я ему показал, как эту самую сводную таблицу в Сеть можно опубликовать. Сейчас просит, чтоб ему доступ из Германии сделали к этой табличке. Мы, конечно, рады стараться.

Я бы привел еще несколько примеров, но, думаю, читатели уже поняли меня. Excel - вещь практически незаменимая во всяческих анализах (не путать с поликлиникой). А для тех, кто не понял, я еще напишу. Отдельно.

А просто. Создал "Excel.Application", использовал его по назначению, "убил" и готово. Вот именно об этом я и попытаюсь написать здесь.

Важно! Параллельно с написанием статьи создавался демо-проект (точнее два - для Delphi 4 и 5), где вы сможете найти весь код примеров статьи. Проект для Delphi 4.0 использует импортированную Type Library из Excel 97. Здесь я использую ранее связывание, ибо CreateOLEObject отлично описал мой любимый классик в "Delphi 4 Unleashed" (мне ли с ним тягаться?). Кроме того, обращайтесь к комментариям в исходных текстах этого проекта. Местами там написано намного понятней, нежели здесь. Delphi 5 содержит более удобный механизм импорта библиотек типов с поддержкой событий и прекрасной генерацией ко-классов. Специально для счастливых обладателей Delphi 5 (я тоже им являюсь) я создал проект, но уже применительно к TexcelApplication (правда ли, что импортированный MS Office есть только в версии Enterprise?). Примеры кода я буду приводить сначала для Delphi 4, потом для Delphi 5. Заранее приношу прощения за дублирование информации в комментариях и в статье - писал сразу везде.

И еще. Эффективная работа с Excel-ом из Delphi-приложений немыслима без знания одной важной вещи. И имя ей - интерфейс. Мне, конечно, хотелось бы написать о принципах работы с интерфейсами здесь, в этой статье. Более того, я обещал сделать это самой Королеве. Но...

Мне ли (совсем еще не профессионалу - и это так!) пытаться сделать это лучше, чем классики этой области. Я честно признаюсь, что не смогу этого сделать быстро (в небольшом объеме) и качественно. Поэтому всякого, не знакомого еще с этой областью программирования, я с глубочайшими извинениями отсылаю к книге Чеппела "OLE Inside".

Достойную помощь (уже применительно к Delphi) может вам оказать "Delphi 4 Unleashed" Чарльза Калверта.

Модуль импортированной Excel TLB (неважно, для D4 или D5) содержит описания всех интерфейсов, которые правильные программисты из Microsoft решили выставить наружу. Там есть все необходимое: типы, константы и интерфейсы. Этого вполне достаточно для работы с Excel-ом из Delphi-приложения (во написал! а что еще нужно-то?). Я создаю Excel для последующего его использования с помощью такого кода:

Delphi 4.0

 procedure TForm1.CreateExcel(NewInstance: boolean);
 var IU: IUnknown;
     isCreate: boolean;
 begin
   // FIXLSApp - private-поле у формы
   //            у меня в привычке добавлять букву I для всех интерфейсов
   //            понятно почему FI... ?
   if not Assigned(FIXLSApp) then begin // а зачем создавать, если уже есть?
     isCreate := NewInstance or
       (not SUCCEEDED( GetActiveObject(CLASS_Application_, nil, IU) ) );
     if isCreate then
       FIXLSApp := CreateComObject(CLASS_Application_) as _Application
     else
       FIXLSApp := IU as _Application;
   end;
 end;
   

Этот достаточно простой код вы найдете практически во всех книгах, посвященных работе с интерфейсами. Как и везде, я напишу, что в результате выполнения этого кода создастся объект COM с CLSID-ом "{00024500-0000-0000-C000-000000000046}" (читайте и перечитывайте Калверта, это не только укрепляет сон!).

Delphi 5.0

 procedure TForm1.CreateExcel(NewInstance: boolean);
 begin
   if not Assigned(IXLSApp) then begin
     FIXLSApp := TExcelApplication.Create(Self);
     if NewInstance then FIXLSApp.ConnectKind := ckNewInstance;
     FIXLSApp.Connect;
   end;
 end;
   

В отличие от предыдущих версий, Delphi 5.0 предоставляет более удобный сервис при импорте библиотек типов. Большой шаг вперед - появление класса ToleServer с поддержкой событий. Теперь работа с существующими и создание новых OLE-серверов стала намного удобней. Как видите, не приходится обращаться к низкоуровневым функциям. Впрочем, в Delphi 4.0 тоже существовал этот класс, только не от Borland. Отличная библиотека была создана Бином Ли (Binh Ly) в COM Nodes - это Threading COM Library. С легкой руки Алексея Вуколова (специальное спасибо!) я использовал ее для построения масштабируемых COM-серверов в сервисах WinNT.

Обращу ваше внимание только на параметр NewInstance. Он позволяет создать новый процесс. Я часто задаю себе вопрос - "А нужен ли NewInstance?". Одна копия процесса, все ж, требует меньше памяти. Но еще чаще я думаю - "Боже, как хорошо я сделал, когда создал новый процесс!". Почему? Если вы не хотите потерять уже открытые, но еще не сохраненные книги, экспериментируя даже с моими примерами, создавайте новый процесс. Печальный опыт научил меня использовать GetActiveObject только в случае полной уверенности в коде, который будет выполняться после. Поэтому, мой вам совет, тестируйте свои приложения только с NewInstance. Или закрывайте важные книги пред этим. Excel - хитрая программа, бывает, улетает в неизвестность, ни слова не сказав. Это не вина Microsoft. Это неудачное расположение звезд.

Вот здесь начинаются хитрости. Любой, читавший помощь по Excel VBA, скажет, что достаточно написать FIXLSApp.Visible := true. Не тут-то было. Я делаю так:

Delphi 4.0 / 5.0

 procedure TForm1.ShowExcel;
 begin
   if Assigned(FIXLSApp) then begin // а если он не создан?
     FIXLSApp.Visible[0] := true;
     if FIXLSApp.WindowState[0] = TOLEEnum(xlMinimized) then
       FIXLSApp.WindowState[0] := TOLEEnum(xlNormal);
     FIXLSApp.ScreenUpdating[0] := true;
   end;
 end;
   

Зачем здесь условие на минимайз и какой-то ScreenUpdating? Давайте попробуем закомментировать эти строки, остаиви только Visible, запустить проект, создать Excel (кнопка CreateExcel), показать его (кнопка ShowExcel), минимизировать, вернуться в приложение и сделать снова ShowExcel. Да-да, Visible = true переводит фокус в минимизированный Excel, не восстанавливая размеры окна. Это ситуация, с которой я борюсь условием на xlMinimized. Но ScreenUpdating зачем?

Знающие люди говорят, что это свойство отвечает за перерисовку окон Excel. Это все равно, что DisableControls у TDataSet. Добавляет скорости, если в нем false. И это правда что, если выключить его во время длительных пересчетов, то быстрее пересчитается. Но мы, ведь, не выключали его. Зачем тогда эта строка?

Делаем так: комметируем эту строку, запускаем демо, CreateExcel, ShowExcel, закрываем его (можно кнопкой с крестиком в правом верхнем углу окна, кому нравится - через меню "Файл/Выход"). Знающие люди скажут, что Excel на самом деле не закрыт. Интерфейс мы не освободили, поэтому в TaskManager мы его и увидим. Итак, Excel по-прежнему у нас в руках. Мы имеем право сделать ему снова Show.

После такого действия у меня возникает ощущение, что я переплатил за свою видеокарту. Фокус в Excel-е, но я по-прежнему наблюдаю форму демо-проекта. Видимо, программисты из MS не рассчитывали на то, что кто-то закроет Excel, вызванный через создание Excel.Application, а потом захочет увидеть его снова. Но я-то захотел?!

Свойства Visible, WindowState и ScreenUpdating вызываются с каким-то непонятным индексом массива - 0. В модуле Excel TLB во многих свойствах и методах вы можете встретить параметр или индекс lcid. Не помню, у кого я это прочитал (Калверт или Канту), но с тех пор я туда передаю всегда 0. И все работает. LCID - это что-то насчет локализации. В MSDN написано "Indicates that the parameter is a locale ID (LCID)".

На свой процесс я всегда создаю один экземпляр Excel.Application. Уже пару лет все отчеты у меня - это отчеты Excel. Я написал несколько классов, которые мне очень помогают в этом. Сегодня у меня целая "отчетная" подсистема, зашитая в класс и обслуживающая непомерно большие запросы моих пользователей. В промежутках между работой с отчетами нет необходимости "мозолить глаза" лишним окном в TaskBar-е. Вот и прячу я этот Excel. Это очень просто и комментариев, думаю, не требует:

Delphi 4.0 / 5.0

 procedure TForm1.HideExcel;
 begin
   if Assigned(FIXLSApp) then begin
     FIXLSApp.Visible[0] := false;
   end;
 end;

Собственно говоря, при закрытии приложения Excel сам будет закрыт, если вы там не устели чего-нибудь отредактировать. И это правильно. Программисты Borland (Inprise до сих пор мне режет слух, да и некоторым в Inprise, судя по всему, тоже) позаботились об этом. Но я еще с Delphi 3 заимел дурную привычку освобождать все самостоятельно. Освобождать обычным присваиванием в nil (это касается проекта для D4). Труда это не составляет, да и проверка на Assigned удобна. Поэтому, и еще из кое-каких соображений, я делаю так:

Delphi 4.0

 procedure TForm1.ReleaseExcel;
 begin
   if Assigned(FIXLSApp) then begin
     if (FIXLSApp.Workbooks.Count > 0) and (not FIXLSApp.Visible[0]) then begin
       FIXLSApp.WindowState[0] := TOLEEnum(xlMinimized);
       FIXLSApp.Visible[0] := true;
       Application.BringToFront;
     end;
   end;
   FIXLSApp := nil;
 end;
   

Ну вот, написал только про nil, а кода - на полстраницы. Опишу ситуацию.

Вы не запускали новый процесс, вы "законнектились" к уже существовавшему. В нем была открыта книга. Попробуйте: CreateExcel, ShowExcel, HideExcel (имеем право), ReleaseExcel. Если оставить только присваивание в nil, то существовавший процесс не будет выгружен (он же существовал до запуска нашего демо), но будет спрятан от пользователя с его открытой книгой.

Delphi 5.0

 procedure TForm1.ReleaseExcel;
 begin
   if Assigned(IXLSApp) then begin
     if (IXLSApp.Workbooks.Count > 0) and (not IXLSApp.Visible[0]) then begin
       IXLSApp.WindowState[0] := TOLEEnum(xlMinimized);
       IXLSApp.Visible[0] := true;
       if not(csDestroying in ComponentState) then Self.SetFocus;
       Application.BringToFront;
     end;
   end;
   FreeAndNil(FIXLSApp);
 end;
   

Практически тот же код. Только в D5 вы работаете уже не с интерфейсом напрямую, а с экземпляром класса TexcelApplcation. Если посмотреть его предков, то можно увидеть, что это настоящий класс, освободить который просто необходимо. Поэтому вместо присваивания в nil там написано FreeAndNil (помните такую процедуру?).

Все статьи данного цикла будут опубликованы на сайте чуть позже, как и демо-программы к самим статьям. Скачать демки вы можете прямо сейчас с сайта http://delphi.mtu-net.ru/.

Как можно из Delphi отслеживать все события Windows?

Пример показывает, как можно отслеживать практически все события происходящий в Вашей оболочке. Код находится в процессе разработки, но уже содержит в себе большое количество возможностей.

(Источник: "Delphi X-Files" <http://www.DlfXFiles.narod.ru/>")

<-------------- Begin UNIT code ---------------------------->

{$IFNDEF VER80} {$IFNDEF VER90} {$IFNDEF VER93}
{$DEFINE Delphi3orHigher}
{$ENDIF} {$ENDIF} {$ENDIF}

unit ShellNotify;
interface

uses Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
{$IFNDEF Delphi3orHigher} OLE2, {$ELSE} ActiveX, ComObj, {$ENDIF}
ShlObj;

type
NOTIFYREGISTER = record
pidlPath : PItemIDList;
bWatchSubtree : boolean;
end;

PNOTIFYREGISTER = ^NOTIFYREGISTER;

const
SNM_SHELLNOTIFICATION = WM_USER +1;
SHCNF_ACCEPT_INTERRUPTS = $0001;
SHCNF_ACCEPT_NON_INTERRUPTS = $0002;
SHCNF_NO_PROXY = $8000;

type
TNotificationEvent = (neAssociationChange, neAttributesChange,
neFileChange, neFileCreate, neFileDelete, neFileRename,
neDriveAdd, neDriveRemove, neShellDriveAdd, neDriveSpaceChange,
neMediaInsert, neMediaRemove, neFolderCreate, neFolderDelete,
neFolderRename, neFolderUpdate, neNetShare, neNetUnShare,
neServerDisconnect, neImageListChange);
TNotificationEvents = set of TNotificationEvent;

TShellNotificationEvent1 = procedure(Sender: TObject;
Path: String)of Object;
TShellNotificationEvent2 = procedure(Sender: TObject;
path1, path2: String) of Object;
// TShellNotificationAttributesEvent = procedure(Sender: TObject;
// OldAttribs, NewAttribs: Integer) of Object;

TShellNotification = class( TComponent )
private
fWatchEvents: TNotificationEvents;
fPath: String;
fActive, fWatch: Boolean;

prevPath1, prevPath2: String;
PrevEvent: Integer;

Handle, NotifyHandle: HWND;

fOnAssociationChange: TNotifyEvent;
fOnAttribChange: TShellNotificationEvent2;
FOnCreate: TShellNotificationEvent1;
FOnDelete: TShellNotificationEvent1;
FOnDriveAdd: TShellNotificationEvent1;
FOnDriveAddGui: TShellNotificationEvent1;
FOnDriveRemove: TShellNotificationEvent1;
FOnMediaInsert: TShellNotificationEvent1;
FOnMediaRemove: TShellNotificationEvent1;
FOnDirCreate: TShellNotificationEvent1;
FOnNetShare: TShellNotificationEvent1;
FOnNetUnShare: TShellNotificationEvent1;
FOnRenameFolder: TShellNotificationEvent2;
FOnItemRename: TShellNotificationEvent2;
FOnFolderRemove: TShellNotificationEvent1;
FOnServerDisconnect: TShellNotificationEvent1;
FOnFolderUpdate: TShellNotificationEvent1;

function PathFromPidl(Pidl: PItemIDList): String;
procedure SetWatchEvents(const Value: TNotificationEvents);
function GetActive: Boolean;
procedure SetActive(const Value: Boolean);
procedure SetPath(const Value: String);
procedure SetWatch(const Value: Boolean);
protected
procedure ShellNotifyRegister;
procedure ShellNotifyUnregister;
procedure WndProc(var Message: TMessage);

procedure DoAssociationChange; dynamic;
procedure DoAttributesChange(Path1, Path2: String); dynamic;
procedure DoCreateFile(Path: String); dynamic;
procedure DoDeleteFile(Path: String); dynamic;
procedure DoDriveAdd(Path:String); dynamic;
procedure DoDriveAddGui(Path: String); dynamic;
procedure DoDriveRemove(Path: String); dynamic;
procedure DoMediaInsert(Path: String); dynamic;
procedure DoMediaRemove(Path: String); dynamic;
procedure DoDirCreate(Path: String); dynamic;
procedure DoNetShare(Path: String); dynamic;
procedure DoNetUnShare(Path: String); dynamic;
procedure DoRenameFolder(Path1, Path2: String); dynamic;
procedure DoRenameItem(Path1, Path2: String); dynamic;
procedure DoFolderRemove(Path: String); dynamic;
procedure DoServerDisconnect(Path: String); dynamic;
procedure DoDirUpdate(Path: String); dynamic;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Path: String read fPath write SetPath;
property Active: Boolean read GetActive write SetActive;
property WatchSubTree: Boolean read fWatch write SetWatch;

property WatchEvents: TNotificationEvents
read fWatchEvents write SetWatchEvents;

property OnAssociationChange: TNotifyEvent
read fOnAssociationChange write FOnAssociationChange;

property OnAttributesChange: TShellNotificationEvent2
read fOnAttribChange write fOnAttribChange;

property OnFileCreate: TShellNotificationEvent1
read FOnCreate write FOnCreate;

property OnFolderRename: TShellNotificationEvent2
read FOnRenameFolder write FOnRenameFolder;

property OnFolderUpdate: TShellNotificationEvent1
read FOnFolderUpdate write FOnFolderUpdate;

property OnFileDelete: TShellNotificationEvent1
read FOnDelete write FOnDelete;

property OnDriveAdd: TShellNotificationEvent1
read FOnDriveAdd write FOnDriveAdd;

property OnFolderRemove: TShellNotificationEvent1
read FOnFolderRemove write FOnFolderRemove;

property OnItemRename: TShellNotificationEvent2
read FOnItemRename write FOnItemRename;

property OnDriveAddGui: TShellNotificationEvent1
read FOnDriveAddGui write FOnDriveAddGui;

property OnDriveRemove: TShellNotificationEvent1
read FOnDriveRemove write FOnDriveRemove;

property OnMediaInserted: TShellNotificationEvent1
read FOnMediaInsert write FOnMediaInsert;

property OnMediaRemove: TShellNotificationEvent1
read FOnMediaRemove write FOnMediaRemove;

property OnDirCreate: TShellNotificationEvent1
read FOnDirCreate write FOnDirCreate;

property OnNetShare: TShellNotificationEvent1
read FOnNetShare write FOnNetShare;

property OnNetUnShare: TShellNotificationEvent1
read FOnNetUnShare write FOnNetUnShare;

property OnServerDisconnect: TShellNotificationEvent1
read FOnServerDisconnect write FOnServerDisconnect;
end;

function SHChangeNotifyRegister( hWnd: HWND; dwFlags: integer;
wEventMask : cardinal; uMsg: UINT; cItems : integer;
lpItems : PNOTIFYREGISTER) : HWND; stdcall;
function SHChangeNotifyDeregister(hWnd: HWND) : boolean; stdcall;
function SHILCreateFromPath(Path: Pointer; PIDL: PItemIDList;
var Attributes: ULONG):HResult; stdcall;
implementation

const Shell32DLL = 'shell32.dll';

function SHChangeNotifyRegister; external Shell32DLL index 2;
function SHChangeNotifyDeregister; external Shell32DLL index 4;
function SHILCreateFromPath; external Shell32DLL index 28;

{ TShellNotification }

constructor TShellNotification.Create(AOwner: TComponent);
begin
inherited Create( AOwner );
if not (csDesigning in ComponentState) then
Handle := AllocateHWnd(WndProc);
end;

destructor TShellNotification.Destroy;
begin
if not (csDesigning in ComponentState) then
Active := False;
if Handle <> 0 then DeallocateHWnd( Handle );
inherited Destroy;
end;

procedure TShellNotification.DoAssociationChange;
begin
if Assigned( fOnAssociationChange ) and (neAssociationChange in fWatchEvents) then
fOnAssociationChange( Self );
end;

procedure TShellNotification.DoAttributesChange;
begin
if Assigned( fOnAttribChange ) then
fOnAttribChange( Self, Path1, Path2 );
end;

procedure TShellNotification.DoCreateFile(Path: String);
begin
if Assigned( fOnCreate ) then
FOnCreate(Self, Path)
end;

procedure TShellNotification.DoDeleteFile(Path: String);
begin
if Assigned( FOnDelete ) then
FOnDelete(Self, Path);
end;

procedure TShellNotification.DoDirCreate(Path: String);
begin
if Assigned( FOnDirCreate ) then
FOnDirCreate( Self, Path );
end;

procedure TShellNotification.DoDirUpdate(Path: String);
begin
if Assigned( FOnFolderUpdate ) then
FOnFolderUpdate(Self, Path);
end;

procedure TShellNotification.DoDriveAdd(Path: String);
begin
if Assigned( FOnDriveAdd ) then
FOnDriveAdd(Self, Path);
end;

procedure TShellNotification.DoDriveAddGui(Path: String);
begin
if Assigned( FOnDriveAddGui ) then
FOnDriveAdd(Self, Path);
end;

procedure TShellNotification.DoDriveRemove(Path: String);
begin
if Assigned( FOnDriveRemove ) then
FOnDriveRemove(Self, Path);
end;

procedure TShellNotification.DoFolderRemove(Path: String);
begin
if Assigned(FOnFolderRemove) then
FOnFolderRemove( Self, Path );
end;

procedure TShellNotification.DoMediaInsert(Path: String);
begin
if Assigned( FOnMediaInsert ) then
FOnMediaInsert(Self, Path);
end;

procedure TShellNotification.DoMediaRemove(Path: String);
begin
if Assigned(FOnMediaRemove) then
FOnMediaRemove(Self, Path);
end;

procedure TShellNotification.DoNetShare(Path: String);
begin
if Assigned(FOnNetShare) then
FOnNetShare(Self, Path);
end;

procedure TShellNotification.DoNetUnShare(Path: String);
begin
if Assigned(FOnNetUnShare) then
FOnNetUnShare(Self, Path);
end;

procedure TShellNotification.DoRenameFolder(Path1, Path2: String);
begin
if Assigned( FOnRenameFolder ) then
FOnRenameFolder(Self, Path1, Path2);
end;

procedure TShellNotification.DoRenameItem(Path1, Path2: String);
begin
if Assigned( FOnItemRename ) then
FonItemRename(Self, Path1, Path2);
end;

procedure TShellNotification.DoServerDisconnect(Path: String);
begin
if Assigned( FOnServerDisconnect ) then
FOnServerDisconnect(Self, Path);
end;

function TShellNotification.GetActive: Boolean;
begin
Result := (NotifyHandle <> 0) and (fActive);
end;

function TShellNotification.PathFromPidl(Pidl: PItemIDList): String;
begin
SetLength(Result, Max_Path);
if not SHGetPathFromIDList(Pidl, PChar(Result)) then Result := '';
if pos(#0, Result) > 0 then
SetLength(Result, pos(#0, Result));
end;

procedure TShellNotification.SetActive(const Value: Boolean);
begin
if (Value <> fActive) then
begin
fActive := Value;
if fActive then ShellNotifyRegister else ShellNotifyUnregister;
end;
end;

procedure TShellNotification.SetPath(const Value: String);
begin
if fPath <> Value then
begin
fPath := Value;
ShellNotifyRegister;
end;
end;

procedure TShellNotification.SetWatch(const Value: Boolean);
begin
if fWatch <> Value then
begin
fWatch := Value;
ShellNotifyRegister;
end;
end;

procedure TShellNotification.SetWatchEvents(
const Value: TNotificationEvents);
begin
if fWatchEvents <> Value then
begin
fWatchEvents := Value;
ShellNotifyRegister;
end;
end;

procedure TShellNotification.ShellNotifyRegister;
var
NotifyRecord: PNOTIFYREGISTER;
Flags: DWORD;
Pidl: PItemIDList;
Attributes: ULONG;
begin
if not (csDesigning in ComponentState) and
not (csLoading in ComponentState) then
begin
SHILCreatefromPath( PChar(fPath), Addr(Pidl), Attributes);
NotifyRecord^.pidlPath := Pidl;
NotifyRecord^.bWatchSubtree := fWatch;

if NotifyHandle <> 0 then ShellNotifyUnregister;
Flags := 0;
if neAssociationChange in FWatchEvents then
Flags := Flags or SHCNE_ASSOCCHANGED;
if neAttributesChange in FWatchEvents then
Flags := Flags or SHCNE_ATTRIBUTES;
if neFileChange in FWatchEvents then
Flags := Flags or SHCNE_UPDATEITEM;
if neFileCreate in FWatchEvents then
Flags := Flags or SHCNE_CREATE;
if neFileDelete in FWatchEvents then
Flags := Flags or SHCNE_DELETE;
if neFileRename in FWatchEvents then
Flags := Flags or SHCNE_RENAMEITEM;
if neDriveAdd in FWatchEvents then
Flags := Flags or SHCNE_DRIVEADD;
if neDriveRemove in FWatchEvents then
Flags := Flags or SHCNE_DRIVEREMOVED;
if neShellDriveAdd in FWatchEvents then
Flags := Flags or SHCNE_DRIVEADDGUI;
if neDriveSpaceChange in FWatchEvents then
Flags := Flags or SHCNE_FREESPACE;
if neMediaInsert in FWatchEvents then
Flags := Flags or SHCNE_MEDIAINSERTED;
if neMediaRemove in FWatchEvents then
Flags := Flags or SHCNE_MEDIAREMOVED;
if neFolderCreate in FWatchEvents then
Flags := Flags or SHCNE_MKDIR;
if neFolderDelete in FWatchEvents then
Flags := Flags or SHCNE_RMDIR;
if neFolderRename in FWatchEvents then
Flags := Flags or SHCNE_RENAMEFOLDER;
if neFolderUpdate in FWatchEvents then
Flags := Flags or SHCNE_UPDATEDIR;
if neNetShare in FWatchEvents then
Flags := Flags or SHCNE_NETSHARE;
if neNetUnShare in FWatchEvents then
Flags := Flags or SHCNE_NETUNSHARE;
if neServerDisconnect in FWatchEvents then
Flags := Flags or SHCNE_SERVERDISCONNECT;
if neImageListChange in FWatchEvents then
Flags := Flags or SHCNE_UPDATEIMAGE;
NotifyHandle := SHChangeNotifyRegister(Handle,
SHCNF_ACCEPT_INTERRUPTS or SHCNF_ACCEPT_NON_INTERRUPTS,
Flags, SNM_SHELLNOTIFICATION, 1, NotifyRecord);
end;
end;

procedure TShellNotification.ShellNotifyUnregister;
begin
if NotifyHandle <> 0 then
SHChangeNotifyDeregister(NotifyHandle);
end;

procedure TShellNotification.WndProc(var Message: TMessage);
type
TPIDLLIST = record
pidlist : array[1..2] of PITEMIDLIST;
end;
PIDARRAY = ^TPIDLLIST;
var
Path1 : string;
Path2 : string;
ptr : PIDARRAY;
repeated : boolean;
event : longint;

begin
case Message.Msg of
SNM_SHELLNOTIFICATION:
begin
event := Message.LParam and ($7FFFFFFF);
Ptr := PIDARRAY(Message.WParam);

Path1 := PathFromPidl( Ptr^.pidlist[1] );
Path2 := PathFromPidl( Ptr^.pidList[2] );

repeated := (PrevEvent = event)
and (uppercase(prevpath1) = uppercase(Path1))
and (uppercase(prevpath2) = uppercase(Path2));

if Repeated then exit;

PrevEvent := Message.Msg;
prevPath1 := Path1;
prevPath2 := Path2;

case event of
SHCNE_ASSOCCHANGED : DoAssociationChange;
SHCNE_ATTRIBUTES : DoAttributesChange( Path1, Path2);
SHCNE_CREATE : DoCreateFile(Path1);
SHCNE_DELETE : DoDeleteFile(Path1);
SHCNE_DRIVEADD : DoDriveAdd(Path1);
SHCNE_DRIVEADDGUI : DoDriveAddGui(path1);
SHCNE_DRIVEREMOVED : DoDriveRemove(Path1);
SHCNE_MEDIAINSERTED : DoMediaInsert(Path1);
SHCNE_MEDIAREMOVED : DoMediaRemove(Path1);
SHCNE_MKDIR : DoDirCreate(Path1);
SHCNE_NETSHARE : DoNetShare(Path1);
SHCNE_NETUNSHARE : DoNetUnShare(Path1);
SHCNE_RENAMEFOLDER : DoRenameFolder(Path1, Path2);
SHCNE_RENAMEITEM : DoRenameItem(Path1, Path2);
SHCNE_RMDIR : DoFolderRemove(Path1);
SHCNE_SERVERDISCONNECT : DoServerDisconnect(Path);
SHCNE_UPDATEDIR : DoDirUpdate(Path);
SHCNE_UPDATEIMAGE : ;
SHCNE_UPDATEITEM : ;
end;//Case event of
end;//SNM_SHELLNOTIFICATION
end; //case
end;

end.

[Статью прислал: Feniks].

Присылайте свои статьи по адресу delphi-faq@list.ru с темой 'Clause' (без кавычек), и они будут опубликованы в ближайших выпусках рассылки. Большая просьба: статью оформляйте в -txt или -doc формате и используйте -zip или -rar сжатие (без самораспаковки).

Документация.

В данном разделе публикуются различные ссылки, причём не только по Delphi но и по OpenGL, WinAPI, DirectX и т.д. (они могут быть на других языках, например, на Си). Присылайте свои ссылки на документацию по программированию. Сегодня fil прислал следующие ссылки:

Графика в Delphi:
http://turbo.gamedev.net.

Сайты, предоставляющие сведения о программировании игр:
http://www.gamedev.net;
http://www.flipcode.com;
http://www.gamasutra.com;

Кладовая.

Сегодня наш раздел пополнился в основном StringGrid'ами, так как обсуждался соответствующий вопрос. Но и не только они появились в разделе...
Свои "добавки" присылайте сюда. Только большая просьба: не присылайте файлы сразу, сначала описания и объёмы.

Компоненты:

BitDBGrid- является расширениеv стандартного компонента TDBGrid VCL Delphi. Очень много возможностей. [24.2 Кб, RAR].

TStringAlignGrid- StringGrid с возможностью выравнивания текста в ячейках. [30.9 Кб, RAR].

XStringGrid- StringGrid с дополнительными возможностями. [36.8 Кб, RAR].

XP Menu - Делает большинство элементов управления в стиле Office XP. [52.6 Кб, RAR].

RbControls- Коллекция компонентов: кнопка, панель, радиокнопка, чекбокс, сплиттер, прогрессбар и общий менеджер для смены "скинов" на все сразу эти контролы. [40.4 Кб, RAR].

Исходники:

uRS232 - Модуль для работы с портами интерфейса RS232 (COM). [20.1 Кб, PAS].

Дружественные сайты.

Юмор.

Клиент:
- В стоимость мультимедийного компьютера CDROM входит?
- Входит.
- Так там нет его!
- Kак нет?.. Я его Вам поставил.
- Hу как, мы его открываем, а там пусто!...

***

Во имя шифта, альта и пресвятого ескейпа - делит!

***

- Алло! Техотдел?! Я комп врубаю, а на экране ничего!!!
- Перезагрузи для начала.
- Как?
- Alt-Ctrl-Del.
- Не нажимаются!
- Тогда нажми Reset - потом перезвони.
(Минут через десять)
- Алло! На экране все равно ничего нет!
- Reset нажал?
- Нажал!
- Ну и?..
- Что "и"?! Держу!!!

***

Рекламное объявление:
Появился новый интернет провайдер, обеспечивающий высочайшего качества связь и быстрейшую скорость!!!!!
Тел: 02
Логин: Менты!
Пароль: Козлы!
Через 35 секунд специально обученые высококлассные специалисты выедут на место и пропишут Вам как первичный так и вторичный DNS по самые помидоры!

***

Он был настолько одинок, что на его почтовый ящик даже СПАМ не приходил...

Присылайте свои "компьютерные" анекдоты по этой ссылке: Delphi-FAQ@list.ru и они обязательно будут опубликованы! Нецензурные анекдоты не публикуются!