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

53. Всем привет ! Хотел бы задать несколько вопросов. На Delphi подсел недавно - может быть вопросы покажутся вам примитивными :)))
1. Как затолкать в EXEшник вместе с прогой MP3 файл, который должен проигрыватся с помощью кнопки ?
2. Подскажите, как правильно писать строку для запуска файла, если буква привода CD переменная ? Заранее спасибо. Если вопросы некорректны - извините. [Ответить].

54. Всем привет!!! У меня такой вопрос: как можно из Дельфы отслеживать события Винды, такие как выключение, спящий режим, открытие файла и вообще-события? А ещё как делать, чтобы программа запускалась не как задача, а как процесс(как антивирус к примеру). Заранее Большое спасибо! С уважением, Alex. [Ответить].

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

56. Вопрос следующего плана, во многоих программах в сетках (StringGrid, DBGrid) по щелчку в подписи столбца появляется стрелка вниз(вверх) и записи сортируются в прямом или обратном порядке. Есть ли стандартный способ или компонент, осуществляющий подобное, или только ручками... (есть такой HeaderControl? но что к чему не понятно...). [Ответить].

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

12. Привет. Может, кому-нибудь из читателей, удалось написать утилиту, показывающую все активные TCP/IP соединения (аналог Netstat) на Delphi без использования Fnugry Netstat Components. Поделитесь пожалуйста исходником, а то дядька Google мне отказался с этим помочь. [Ответить].

40. Как мне определить скорость инета? Почитал msdn, понял, что надо юзать IPHLPAPI.DLL, а вот как? [Ответить].

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

13. (Откуда скачать Delphi?). [Отвечает: Dron]: Можно скачать Trial-версию Delphi с официального сайта Borland. Вот здесь: http://borland.com/products/downloads/download_delphi.html. Но она большая - 170 Мб.

15. (Работа с компонентами других форм.). [Отвечает: Садовников Владимир]: На мой взгляд, здесь без Copy/Paste/Replace не обойтись. Открываешь форму другого компонента, копируешь его на твою форму, после чего меняешь его имя на то, которое тебе надо.

50. (Слайд-шоу с подписями для картинок). [Отвечает: Садовников Владимир]: Не совсем понял вопрос. Если ты хочешь сразу все рисунки отобразить, то тут надо немного помучаться - лично я бы воспользовался в данном случае таблицами (в которых твоему рисунку соответствует текст). Если хочешь отображать один рисунок - удобно воспользоваться базами данных (в них можно хранить рисунки или расположение файлов рисунков), в Delphi 6 можно использовать движок баз данных MS Access, что позволяет не включать в дистрибутив программы движок BDE. Тогда вся проблема сводится к заполнению строчек твоей таблицы соответствующими данными и дальнейшей работе с ними.

[Отвечает: Dasha]: Если не надо будет менять рисунки, то проще, наверное, сохранить рисунки в ImageList, а текст к ним в массиве, чтобы номера совпадали с номерами рисунков. Тогда вызываешь рисунок и к нему текст с тем же номером.

37. (Отправка данных на сайт). [Отвечает: Iron Monk]: Всем привет! Чтобы что-то отправить на сайт, в документ, необходимо иметь FTP вход на этот сайт. Допустим, что FTP вход есть. Тогда создаём новый проект и добавляем на форму IdFTP1, Button1 и Statusbar1. В свойствах IdFTP1 заполняем свойства Host, Password и Username.
procedure Upload();
begin
Form1.IdFTP1.ChangeDir('www'); // переходим в нужную папку
Form1.IdFTP1.Delete('ident.txt'); // если нужно заменить файл - удалим предыдущий
Form1.IDFtp1.Put('ident.txt', 'ident.txt', false ); // отправим наш файл 'ident.txt'
Form1.IDFtp1.Disconnect; // и отключимся
ShowMessage('Файл передан');
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
IDFtp1.Connect;// соединяемся
end;
end;

procedure TForm1.IdFTP1Status(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: String);
begin
StatusBar1.SimpleText:= aStatusText;
Application.ProcessMessages;
// возможность отправки файла я проверяю по получению сообщения 'Connection established'
if StatusBar1.SimpleText='Connection established' then
Upload();
end;

Если нужно что либо поменять в файле на сайте, то необходимо его сначала скачать:
IDFtp1.Get('NetFileName','LocalFileName',false,false), изменить, и уже потом отправлять на сайт.

51. (Изменение шрифта в отдельных ячейках StringGrid). [Отвечает: Садовников Владимир]: Посмотри событие OnDrawCell. Вот пример, изменяющий шрифт во втором столбце таблицы на Courier New (MyGrid - TStringGrid): procedure TForm1.MyGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
OldName:string;
begin
OldName:=MyGrid.Canvas.Font.Name;
if (ACol=2) then
MyGrid.Canvas.Font.Name:='Courier New';
MyGrid.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2, MyGrid.Cells[ACol, ARow]);
MyGrid.Canvas.Font.Name:=OldName;
end;

[Отвечает: Iron Monk]: Всем привет! Это выполнимая задача. Необходимо использовать событие "OnDrawCell".
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if ACol = 2 //Выбираем вторую колонку для редактирования
then
begin
StringGrid1.Canvas.Font.Size:=12; //Выбираем размер шрифта

end else StringGrid1.Canvas.Font.Size:=8;
If (ACol > 0) and (ARow>0) then
begin
StringGrid1.canvas.fillRect(Rect);
StringGrid1.canvas.TextOut(Rect.Left,Rect.Top,StringGrid1.Cells[ACol,ARow]);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.Cells[1,1]:='Привет!';
StringGrid1.Cells[2,1]:='Привет!';
end;
end.
Вот и всё.

[Отвечает: Андрей Лучников]: По этому поводу могу предложить перерисовывать текст в ячейке ручками, используя обработчик onDrawCell.

Вот простейший пример.

// выделяет первый столбец жирным шрифтом
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);

var
SaveFont
begin
// проверка на выделенную ячейку
if not (gdSelected in state) then
Begin
If ACol=0 then
Begin
with StringGrid1.Canvas do
Begin
// закрашиваем прямоугольник, чтобы стереть предыдущее значение
FillRect(Rect);
// для примера сделаем шрифт жирным
SaveFont:=Font;
Font.Style:=[fsBold];
TextOut(Rect.Top,Rect.Left,StringGrid1.Cells[ACol,ARow])
// Вернем обратно нормальное значение
Font:=SaveFont;
end;
end;

end;

[Отвечает: Den]: У сетки есть событие OnDrawCell, там выбираешь ячейку (строку,
столбец) и перерисовываешь как угодно.

if (ARow = 1)and(ACol = 1) then
begin
Brush.Color := clRed; //цвет фона ячейки
Font.Color := clWhite; //цвет шрифта надписи
FillRect(Rect);
TextOut(Rect.Left, Rect.Top + 2, 'Test'); //вывод надписи
(Rect.Left - сколько отступить слева в ячейке, Rect.Top -
сколько отступить сверху)
end;

[Отвечает: Ершов Денис]: Возможны три пути решения проблемы:
1. Найти табличный компонент, который поддерживает данную функцию. На раз могу выдать AdvStringGrid ( http://www.tmssoftware.com).
2. Создать свой компонент потомок StringGrid'а, который бы поддерживал данную функцию.
3. Создать для таблицы обработчик события OnDrawCell и самому отрисовывать ячейки с учетом их координаты.

49. (Блокировка повторного запуска приложения). [Отвечает: Iron Monk]: Всем привет!
Как то пробовал я использовать всё это без таймера - ничего хорошего не вышло - форма уходит в Hide, но в диспетчере висит, память кушает, пришлось ставить таймер и вырубать вторую копию принудительно.

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);

private
Procedure WriteSingl(Str:string);
procedure ClearSingl;
function ReadSingl:string;
{ Private declarations }

public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.dfm}

const
Singl='MyAtom';

function TForm1.ReadSingl:string;
var P:PChar;
i:Word;
begin
GetMem(p, 256);
for i:=0 to $FFFF do
begin
GlobalGetAtomName(i, p, 255);
if StrPos(p, PChar(Singl))<>nil then break;
end;
result:=StrPas(p+Length(Singl));
FreeMem(p);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Timer1.Enabled:=false;
Timer1.Interval:=10;
if ReadSingl ='' then // программа была закрыта
begin
WriteSingl('12345');
end else
if (ReadSingl ='12345')or (ReadSingl ='No') then // если одна копия уже запущена
begin
Timer1.Enabled:=true;
Form1.Caption:='Destroy'; // переименуем Caption, чтобы не передавать фокус закрываемой копии
SetForegroundWindow(FindWindow(nil,'Form1'));// здесь наш Form1.Caption, чтобы получить фокус
end else
WriteSingl('No'); // если это первый запуск
end;

procedure TForm1.ClearSingl;
var P:PChar;
i:Word;
begin
GetMem(p, 256);
For i:=0 to $FFFF do
begin
GlobalGetAtomName(i, p, 255);
if StrPos(p, PChar(Singl))<>nil then GlobalDeleteAtom(i);
end;
FreeMem(p);
end;

procedure TForm1.WriteSingl(Str:string);
begin
ClearSingl;
GlobalAddAtom(PChar(Singl+Str));
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Timer1.Enabled = false then
WriteSingl('');
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Close;
end;
end.

[Отвечает: Igor]: Вот простой и опробованный мною метод:

В самом файле проекта, т.е. файле .dpr пишем следующий код:

uses
Forms, Windows, ...

{$R *.res}

var hnd:Longint;
begin
Application.Initialize;
hnd := FindWindow('TForm1', nil); { получаем Handle окна TForm1 }
if hnd = 0 then { приложение еще не запущено, продолжаем его запуск }
begin
Application.CreateForm(TForm1, Form1);
Application.Run;
end else { иначе }
SetForegroundWindow(hnd); { активизируем предыдущую копию }
end.

Где у вас Form1 и TForm1 имя главной формы и ее класса соответственно.

[Отвечает: Тихонов Михаил]: Предлагаю еще один способ недопущения повторного запуска приложения.

Он основан на объекте ядра FileMapping. Такой способ уже был приведен ранее,
но в отличие от приведенного, в нем использован оригинальный метод получения
дескриптора первого запущенного приложения. Хэндл дескриптора первого запу-
щенного приложения (Application.Handle) как раз и сохраняется в области дан-
ных объекта FileMapping. Используется только одна функция FirstHinstanceRunning.
Она имеет один параметр RunMode, Значения которого должны быть определены
следующим образом:

если RunMode = 0 то недопущение повторного запуска того-же самого
EXE файла с учетом пути

если RunMode = 1 то недопущение повторного запуска того-же самого
EXE файла без учета пути

иначе повторный запуск разрешен

Ниже приводится текст функции:

unit FirstHinstanceRunning;

interface

uses
Windows,
Forms,
StrUtils,
SysUtils;

function FirstHinstanceRunning(RunMode: Integer = 0): boolean;

implementation

function FirstHinstanceRunning(RunMode: Integer = 0): boolean;
const
MemFileSize = 127;

var
MemHnd: HWND;
MemFileName: string;
lpBaseAddress: ^HWND;
FirstAppHandle: HWND;

begin
Result := False;
MemFileName := Application.ExeName;
case RunMode of
0:
MemFileName := AnsiReplaceText(MemFileName, '\', '/');
1:
MemFileName := ExtractFileName(MemFileName);
else
Exit;
end;
//если FileMapping есть - то происходит OpenFileMapping
MemHnd := CreateFileMapping(HWND($FFFFFFFF), nil,
PAGE_READWRITE, 0, MemFileSize, PChar(MemFileName));
if GetLastError <> ERROR_ALREADY_EXISTS then
begin
if MemHnd <> 0 then
begin
lpBaseAddress := MapViewOfFile(MemHnd, FILE_MAP_WRITE, 0, 0, 0);
if lpBaseAddress <> nil then
lpBaseAddress^ := Application.Handle;
end;
end
else
begin
// MemFileHnd := OpenFileMapping(FILE_MAP_READ, False, PChar(MemFileName));
Result := True;
if MemHnd <> 0 then
begin
lpBaseAddress := MapViewOfFile(MemHnd, FILE_MAP_READ, 0, 0, 0);
if lpBaseAddress <> nil then
begin
FirstAppHandle := lpBaseAddress^;
ShowWindow(FirstAppHandle, SW_restore);
SetForegroundWindow(FirstAppHandle);
end;
end;
end;
if lpBaseAddress <> nil then
UnMapViewOfFile(lpBaseAddress);
end;

В тексте проекта *.dpr вызов функции выглядит приблизительно следующим образом

program OneHinstance;

uses
Forms,
Unit1 in 'Unit1.pas' {Form1},
FirstHinstanceRunning in '..\..\FirstHinstanceRunning.pas';

{$R *.res}

begin
Application.Initialize;

if FirstHinstanceRunning(0) then
Exit;

Application.CreateForm(TForm1, Form1);
Application.Run;

// CloseHandle(MemHnd); //надо ли ???
end.

Обращаю Ваше внимание на то, что функция CloseHandle() не используется.
В качестве обоснования этого привожу две выдержки из литературы:

'
А вдруг Вы забыли вызвать CloseHandle - будет ли утечка памяти? И да, и нет.
Утечка ресурсов (тех же объектов ядра) вполне вероятна, пока процесс еще
исполняется. Однако по завершении процесса операционная система гарантированно
освобождает все ресурсы, принадлежавшие этому процессу, и в случае объектов
ядра действует так: в момент завершения процесса просматривает его таблицу
описателей и закрывает любые открытые описатели.
'
'
Ядру известно, сколько процессов использует конкретный объект ядра, поскольку
в каждом объекте есть счетчик числа его пользователей. Этот счетчик - один из
элементов данных, общих для всех типов объектов ядра. В момепт создания объекта
счетчику присваивается 1. Когда к существующему объекту ядра обращается другой
процесс, счетчик увеличивается на 1. А когда какой-то процесс завершается,
счетчики всех используемых им объектов ядра автоматически уменьшаются на 1.
Как только счетчик какого-либо объекта обнуляется, ядро уничтожает этот объект.

[Источник: http://www.softera.ru/literature.shtml?topic=visual&book=1&page=head3.htm]

[Отвечает: yga72]: Uses
Forms,
Windows,
SysUtils,

var
HM: THandle;

function Check: boolean;
var
s: PAnsiChar;
begin
s := StrNew(PChar(ParamStr(0)));
while Pos('\', s) <> 0 do s[Pos('\', s)-1] := '_';
HM := OpenMutex(MUTEX_ALL_ACCESS, false, s);
Result := (HM <> 0);
if HM = 0 then HM := CreateMutex(nil, false, s);
end;

begin
if Check then Exit;
Application.Initialize;
Application.Title := 'SmallProxy';
Application.CreateForm(TSmallProxyForm, SmallProxyForm);
Application.Run;
end.

[Отвечает: Ершов Денис]: Вижу человека не надо учить, как определить запущена ли уже
программа. А проблему открытия окна второго экземпляра программы
можно решить отредактировав файл проекта (*.dpr). Ничего страшного в
этом нет.

program Project1;
uses
Forms,
Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}

begin
if {программа уже запущена} then begin
{Активация старого окна}
exit;
end;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

[Отвечает: fil]: По-моему тут дело в том в каком обработчике вы просматриваете другие приложения, если сделать в oncreate формы и выйти при нахождении дубликата, то окно даже не успеет отобразиться. Для активации окна можно сначала получить его handle по названию в заголовке, а затем послать ему сообщение sendmessage({handle},{wm_syscommand}, {sc_....},0); Извиняюсь, что пишу неподробно, т.к. сам использую контекстную подсказку Delphi по ctrl+space и поиск по текстам ее модулей. В принципе, есть много других способов избежать двойного запуска: например использование записи реестра (если в реестре есть запись, то не запускаться), и аналогичный способ с файлами.

[Отвечает: Андрей Лучников]: uses Windows, SysUtils;
...
Begin
if FindWindow('TApplication','Моя программа')<>0 then
Begin
ShowWindow(FindWindow('TApplication','Моя программа'),SW_SHOW);
exit;
End;

Application.Initialize;
...
End.

[Отвечает: Feniks]: Существует множество вариантов: от самых простых до
извращенно-сложных.

1. Код проекта (*.DPR):

var
hwndPrev: HWND;
begin
Application.Initialize;
hwndPrev:= FindWindow('TForm1','Form1');
if hwndPrev < 0 then
begin
SetForegroundWindow(hwndPrev);
Application.Terminate;
end;
Application.CreateForm(TForm1,Form1);
Application.Run;
end.
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
2.
procedure TForm1.FormCreate(Sender: TObject);
VAR
Wnd : hWnd;
buff: ARRAY [0..127] OF Char;
WC: TWndClass;

begin
Wnd := GetWindow(Handle, gw_HWndFirst);
WHILE Wnd <> 0 DO
BEGIN
{Если не собственное и не дочернее окно}
IF (Wnd <> Application.Handle) AND (GetWindow(Wnd, gw_Owner) = 0) THEN
BEGIN
GetWindowText(Wnd, buff, sizeof(buff));
{Если заголовок совпадает, то...}
IF StrPas(buff) = Application.Title THEN
BEGIN
MessageDlg('Приложение уже загружено', mtWarning, [mbOk], 0);
Halt;
END;
END;
Wnd := GetWindow(Wnd, gw_hWndNext);
END;
end;
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
3.
Еще один интересный способ для Win32. Дело в том, что можно в памяти
создавать временные файлы. При перезагрузке они теряются, а так
существуют. Кстати, этот метод можно использовать и для обмена
информацией между вашими приложениями.

Пример:

program Project1;
uses Windows, // Обязательно
Forms,
Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}

Const
MemFileSize = 1024;
MemFileName = 'one_inst_demo_memfile';

Var MemHnd : HWND;

begin
{ Попытаемся создать файл в памяти }
MemHnd := CreateFileMapping(HWND($FFFFFFFF),
nil,
PAGE_READWRITE,
0,
MemFileSize,
MemFileName);
{ Если файл не существовал запускаем приложение }
if GetLastError<>ERROR_ALREADY_EXISTS then
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end;
CloseHandle(MemHnd);
end.
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
4.
И на последок, еще один примерчик работы с именованным мутексом.
Главное, придумать уникальное имя для этого мутекса.
Вот пример вполне работоспособной программы:

program My1;
uses Forms, Windows, Dialogs, SysUtils;
var g_hAppMutex: THandle;
Wnd : hWnd;
buff: array [0..127] of Char;
s:string;
i:integer;

function OneInstance: boolean;
begin
g_hAppMutex:=CreateMutex(nil,false,PChar('AnUniqueString'+IntToStr(GetDesktopWindow)));
Result:=(WaitForSingleObject(g_hAppMutex,0)<>WAIT_TIMEOUT);
end;

begin
Application.Initialize;
Application.Title := 'Заголовок твоей проги';
//создаём инстанс, если его ещё нету на текущем рабочем столе
g_hAppMutex:=0;
if OneInstance then
begin
Application.CreateForm(TMainFrm, MainFrm);
Application.Run;
end;
if LongBool(g_hAppMutex) then //если уже есть
begin
ReleaseMutex(g_hAppMutex);
CloseHandle(g_hAppMutex);
if ParamStr(1)='' then
ShowMessage('Программа уже запущена на этом рабочем столе. Нажмите кнопку "OK" для передачи управления уже запущенной копии программы.');
Wnd:=GetWindow(GetTopWindow(0),gw_HWndFirst);
while Wnd<>0 do
begin
//Если не собственное и не дочернее окно
if (Wnd<>Application.Handle) and (GetWindow(Wnd,gw_Owner)=0) then
begin
GetWindowText(Wnd,buff,sizeof(buff));
if Copy(StrPas(buff),1,12)='SmartDecoder' then
if Wnd=GetWindowLong(Wnd,GWL_USERDATA) then
begin
ShowWindow(Wnd,SW_ShowNormal);
SetForegroundWindow(Wnd);
i:=1;
while ParamStr(i)<>'' do
begin
s:=ParamStr(i);
PostMessage(Wnd,WM_OPEN_FILE,GlobalAddAtom(PChar(s)),0);
inc(i);
end;
Application.Terminate;
Exit;
end;
end;
Wnd:=GetWindow(Wnd,gw_hWndNext);
end;
end;
end.

Если программа уже запущена, управление будет передано существующей копии.

[Отвечает: Четвертных В.В.]: Если программа, которую надо проверить, имеет окна, то можно использовать следующую функцию:
FindWindow(lpClassName, lpWindowName: PChar): HWND;
где lpWindowName: PChar - заголовок (caption) окна прораммы.
Функция возвращает хэндл к окну искомой программы и если он не равен нулю, значит окно включено.
Например так:
MyHandle:= FindWindow(NIL, '(*!!Caption окна!!*)' );
if MyHandle <> 0 then //запустить прогу.

[Отвечает: Dasha]: Спросила, потом сама придумала, как это сделать. Получилось так:

var
MyWin: THandle;

begin
MyWin:=FindWindow(nil,'NewForm');
if MyWin<>0 then
ShowWindow(MyWin,SW_SHOW)
else
begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end;
end.

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

[Отвечает: MagicSasha]: Вот два примера, а какой использовать выбирай сама:

Пример 1;
В коде проекта пишешь следующее:

program Project1;
uses
Forms,
Windows,
Unit1 in 'Unit1.pas' {Form1};
{$R *.RES}

var
HW: THandle;
function Check: boolean;
begin
HW := OpenMutex(MUTEX_ALL_ACCESS, false, 'MyOwnMutex');
Result := (HW <> 0);
if HW = 0 then HW := CreateMutex(nil, false, 'MyOwnMutex');
end;

begin
if Check then Exit;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

Пример 2;

program Project1;
uses
Forms,
Windows,
Unit1 in 'Unit1.pas' {Form1};
{$R *.RES}

var
HW: HWND;
begin
Application.Initialize;
HW := FindWindow('TForm1', 'Form1');
if HW <> 0 then begin
SetForegroundWindow(HW);
Application.Terminate;
end;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

52. (Работа с HTML-справкой из программы). [Отвечает: Dron]: В качестве ответа на вопрос Dron прислал статью, см. раздел "Статья по Delphi"...

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

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

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

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

Статья по Delphi.

Система для работы с HTML-справкой

Удобно вендрять данную систему в самом начале разработки программы. Но я опишу способ внедрения в целом.

В раздел глобальных переменных добавьте следующие переменные для работы со справкой:

_HHwinHwnd: HWND = 0; HHCtrlHandle: THandle = 0; mHelpFile: String;

Сразу после раздела глобальных переменных и перед implementation вставьте следующие строки кода:

var

HtmlHelpA: function(hwndCaller: HWND; pszFile: PAnsiChar;
uCommand: UInt; dwData: DWORD): HWND; stdcall;

HtmlHelpW: function(hwndCaller: HWND; pszFile: PWideChar;
uCommand: UInt; dwData: DWORD): HWND; stdcall;

HtmlHelp: function(hwndCaller: HWND; pszFile: PChar;
uCommand: UInt; dwData: DWORD): HWND; stdcall;

const

hhctrlLib = 'hhctrl.ocx';

const

HH_DISPLAY_TOPIC = $0000;
HH_HELP_CONTEXT = $000F;
HH_CLOSE_ALL = $0012;

Где-нибудь в самом начале раздела implementation вставьте код:

const hhPathRegKey = 'CLSID\{adb880a6-d8ff-11cf-9377-00aa003b7a11}\InprocServer32';

function GetPathToHHCtrlOCX: string;
var Reg: TRegistry;
begin
result := ''; //default return
Reg := TRegistry.Create;
Reg.RootKey := HKEY_CLASSES_ROOT;
if reg.OpenKeyReadOnly(hhPathRegKey) then begin
result := Reg.ReadString(''); Reg.CloseKey;
if (result <> '') and (not FileExists(result)) then result := '';
end;
Reg.Free;
end;

procedure LoadHtmlHelp;
var OcxPath: string;
begin
if HHCtrlHandle = 0 then
begin
OcxPath := GetPathToHHCtrlOCX;
if (OcxPath <> '') and FileExists(OcxPath) then
begin
HHCtrlHandle := LoadLibrary(PChar(OcxPath));
if HHCtrlHandle <> 0 then
begin
@HtmlHelpA := GetProcAddress(HHCtrlHandle, 'HtmlHelpA');
@HtmlHelpW := GetProcAddress(HHCtrlHandle, 'HtmlHelpW');
@HtmlHelp := GetProcAddress(HHCtrlHandle, 'HtmlHelpA');
end;
end;
end;
end;

procedure UnloadHtmlHelp;
begin
if HHCtrlHandle <> 0 then
begin
FreeLibrary(HHCtrlHandle);
HHCtrlHandle := 0;
end;
end;

В OnCreate главной формы приложения добавьте:

mHelpFile := ExtractFilePath(ParamStr(0)) + 'Help.chm';
mHelpFile := ExpandFileName(mHelpFile);
LoadHtmlHelp;
if HHCtrlHandle = 0 then
begin
ShowMessage('HTML-справка не поддерживается системой');
end;

В обработчике пункта меню для загрузки справки (например, Справка - Содержание) пишем:

if HHCtrlHandle = 0 then showmessage('Справка не поддерживается') else
begin
HtmlHelp(Handle,PChar(mHelpFile+'::/Pages/topic1.htm'),HH_DISPLAY_TOPIC,0);
end;

При выходе из программы необходимо закрыть все открытые окна справки, поэтому в OnClose главной формы добавляйте строку:

HtmlHelp(0, nil, HH_CLOSE_ALL, 0);

Часто в программах делают другие пункты меню, соответствующие разделам справки. Вот как их загружать:

HtmlHelp(Handle,PChar(mHelpFile+'::/путь/страница.htm'),HH_DISPLAY_TOPIC,0);

Аналогичным образом можно загружать любой необходимый раздел справки.

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

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

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

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

Сегодня новых ссылок нет :(

Кладовая.

Предлагали добавить в раздел компонент AdvStringGrid - StringGrid с очень большими возможностями: для каждой ячейки индивидуальные настройки шрифтов, фона и хинтов, индивидуальные настройки размеров для строк и столбцов, объединение ячеек, возможность вставки в ячейку рисунка, и элементов управления (CheckBox и пр.), сохранение и загрузка таблицы из MS Excel. Но весит это "чудо" около 4 мегабайт, поэтому было решено на сайт не выкладывать. Вы сами можете скачать компонент с официального сайта - http://www.tmssoftware.com.

Очень обидно, что вы ничего не присылаете в данный раздел, хотя он очень полезный. Присылайте сюда! Очень жду! Только большая просьба: не присылайте файлы сразу! Ну а сегодня я решил подготовить для вас много всего интересного. Итак...

Компоненты:

7BEVEL- компонент, аналог стандартного TBevel. Но как можно заметить, там можно сделать только квадратные или прямоугольные формы. Данный компонент умеет отображать "бордюры" круглой или овальной формы. [8.04 Кб, ZIP].

CollapsePanel- Отличный компонент. Каждый знаком с панельками, которые сворачиваются и разворачиваются. В отличие от подобных "групп" в Windows XP, CollapsePanel имеют сравнительно простой внешний вид, но здорово украсят любую программу. [176 Кб, ZIP].

Cool Tray Icon- Лучший компонент для создания иконок программы в системном трее. Чтобы перечислить все возможности этого уникального пакета, потребуется не одна страница. Иконки как графические, так и текстовые, поддержка анимации и многое другое. Настоятельно рекомендую всем! [347 Кб, ZIP].

Easy Graph - Мощная система для построения графиков функций и вывода разнообразных математических схем. [316 Кб, ZIP].

Directory Dialog Box - Компонент, позволяющий вам выводить окошки выбора каталога, как в Windows. [7.33 Кб, ZIP].

Plug-in'ы для Delphi (впервые в рассылке):

MsPropEdit - Расширяет возможности редактора свойств (Poperties Editor), делая многие пункты наглядными. Работает только под Delphi 6. Для получения версии для Delphi 7, зайдите на сайт разработчика. [130 Кб, ZIP].

Исходники программ :

Paper Airplane - уникальная программа, наглядно показывающая процесс сборки различных фигур из листа бумаги. [427 Кб, ZIP].

Юмор.

Компьютер без Windows - это как рыба без зонтика.

***

Останавливает ГИБДДшник машину, из машины вываливается сильно пьяный водитель. ГИБДДшник спрашивает:
- Ваши права?
Водитель отвечает (с трудом ворочая языком):
- Root!

***

Звонок в компьютерный магазин:
- Можно ли сдать обpатно ваш товаp, если он нам не подходит?
- А в чем пpоблема?
- Мы тут у вас монитоp пpиобpели, а он ничего не печатaет!

***

- Дорогой, по-моему, я беременна!
- Abort, Retry, Ignore?

***

Школа с углубленным изучением компьютеров. Входит учительница и говорит:
- Говорите сразу: кто скачал домашнее задание?

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

Сайт рассылки: http://www.delphi-faq.fatal.ru/
E-mail: Delphi-FAQ@list.ru
Страница рассылки: http://subscribe.ru/catalog/comp.soft.prog.delphifaq