Часть II
Вопрос:
Как узнать есть ли в заданном CD-ROM'е Audio CD?

Ответ:
Можно использовать функцию Windows API GetDriveType() чтобы определить является ли дисковод CD-ROM'мом. И функцию API GetVolumeInformation() чтобы проверить VolumeName на равенство 'Audio CD'.
Пример:

function IsAudioCD(Drive : char) : bool;
var
DrivePath : string;
MaximumComponentLength : DWORD;
FileSystemFlags : DWORD;
VolumeName : string;
Begin
sult := false;
DrivePath := Drive + ':\';
if GetDriveType(PChar(DrivePath)) <> DRIVE_CDROM then
    exit;
SetLength(VolumeName, 64);
GetVolumeInformation(PChar(DrivePath),PChar(VolumeName),
Length(VolumeName),nil,MaximumComponentLength,FileSystemFlags,nil,0);
if lStrCmp(PChar(VolumeName),'Audio CD') = 0 then
    result := true;
end;

function PlayAudioCD(Drive : char) : bool;
var
mp : TMediaPlayer;
begin
result := false;
Application.ProcessMessages;
if not IsAudioCD(Drive) then
    exit;
mp := TMediaPlayer.Create(nil);
mp.Visible := false;
mp.Parent := Application.MainForm;
mp.Shareable := true;
mp.DeviceType := dtCDAudio;
mp.FileName := Drive + ':';
mp.Shareable := true;
mp.Open;
Application.ProcessMessages;
mp.Play;
Application.ProcessMessages;
mp.Close;
Application.ProcessMessages;
mp.free;
result := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if not PlayAudioCD('D') then
    ShowMessage('Not an Audio CD');
end;

Вопрос:
Как узнать есть ли у мыши колесико?

Ответ:
Свойство "WheelPresent" глобального обьекта "mouse".

Вопрос:
События KeyPress и KeyDown не вызываются для клавиши Tab - как определить, что она была нажата?
Ответ:
На уровне формы клавиша tab обычно обрабатывается Windows. В примере создается обработчик события CM_Dialog для перехвата Dialog keys.
Пример:

type
TForm1 = class(TForm)
private
    procedure CMDialogKey( Var msg: TCMDialogKey );
    message CM_DIALOGKEY;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.CMDialogKey(var msg: TCMDialogKey);
begin
if msg.Charcode <> VK_TAB then
    inherited;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Key = VK_TAB then
Form1.Caption := 'Tab Key Down!';
end;

Вопрос:
В чем отличие между Create(Self) и Create(Application)?

Ответ:
Self может быть использовано только в методе класса, и ссылается на текущий экземпляр класса. Таким образом "Self" в методе класса TForm1 ссылается на текущий экземпляр TForm1. При создании компонента Вы передаете его владельца (owner) в конструктор. При уничтожении формы или компонента автоматически уничтожаются и все компоненты владельцем которого она является. Таким образом если при создании формы передать в качестве владельца Application эта форма будет автоматически уничтожена при уничтожении Application. Если же при создании формы передать в качестве владельца другую форму, вновь созданная форма будет автоматически уничтоженна при уничтожении формы-владельца.

Вопрос:
Как во время выполнения определить поддерживает ли обьект заданное свойство?

Ответ:
function HasProperty(Obj : TObject; Prop : string) : PPropInfo;
begin
Result := GetPropInfo(Obj.ClassInfo, Prop);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
p : pointer;
begin
p :=  HasProperty(Button1, 'Color');
if p <> nil then
    SetOrdProp(Button1, p, clRed)
else
    ShowMessage('Button has no color property');
p :=  HasProperty(Label1, 'Color');
if p <> nil then
    SetOrdProp(Label1, p, clRed)
else
    ShowMessage('Label has no color property');
p :=  HasProperty(Label1.Font, 'Color');
if p <> nil then
    SetOrdProp(Label1.Font.Color, p, clBlue)
else
    ShowMessage('Label.Font has no color property');
end;

Вопрос:
Как при проигрывании музыки с Audio CD показывать сколько прошло минут и секунд?

Ответ:
В примере время выводится по таймеру.

Пример:

uses MMSystem;

procedure TForm1.Timer1Timer(Sender: TObject);
var
Trk : Word;
Min : Word;
Sec : Word;
begin
with MediaPlayer1 do
    begin
    Trk := MCI_TMSF_TRACK(Position);
    Min := MCI_TMSF_MINUTE(Position);
    Sec := MCI_TMSF_SECOND(Position);
    Label1.Caption := Format('%.2d',[Trk]);
    Label2.Caption := Format('%.2d:%.2d',[Min,Sec]);
    end;
end;

Вопрос:
Можно ли рисовать на рамке формы?

Ответ:
Обрабатывайте событие WM_NCPAINT. В примере рамка обводится красной линией
толщиной в 1 пиксел.

Пример:

type
TForm1 = class(TForm)
private
{Private declarations}
    procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPAINT;
public
{Public declarations}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
var
dc : hDc;
Pen : hPen;
OldPen : hPen;
OldBrush : hBrush;
begin
inherited;
dc := GetWindowDC(Handle);
msg.Result := 1;
Pen := CreatePen(PS_SOLID, 1, RGB(255, 0, 0));
OldPen := SelectObject(dc, Pen);
OldBrush := SelectObject(dc, GetStockObject(NULL_BRUSH));
Rectangle(dc, 0,0, Form1.Width, Form1.Height);
SelectObject(dc, OldBrush);
SelectObject(dc, OldPen);
DeleteObject(Pen);
ReleaseDC(Handle, Canvas.Handle);
end;

Вопрос:
Как выполнить какой-то процесс тогда, когда пользователь не работает с моим приложением?

Ответ:
Создайте процедуру, которая будет вызываться при событии Application.OnIdle.

Обьявим процедуру:
{Private declarations}
procedure IdleEventHandler(Sender: TObject; var Done: Boolean);

В разделе implementation опишем поцедуру:

procedure TForm1.IdleEventHandler(Sender: TObject; var Done: Boolean);
begin
{Do a small bit of work here}
Done := false;
end;

В методе Form'ы OnCreate - укажем что наша процедура вызывается на событии
Application.OnIdle.

Application.OnIdle := IdleEventHandler;
Событие OnIdle возникает один раз - когда приложение переходит в режим "безделья" (idle). Если в обработчике переменной Done присвоить False событие будет вызываться вновь и вновь, до тех пор пока приложение "бездельничает" и переменной Done не присвоенно значение True.

Вопрос:
При перемещении фокуса ввода клавишей Tab чтобы переместить его в RadioGroup нужно нажать клавишу Tab дважды если какой нибудь пункт RadioGroup уже выбран, но только один раз если не выбран. Можно ли сделать поведение RadioGroup логичным?
Ответ:
Установка свойства RadioGroup'ы TabStop в false должна решить эту проблему - поскольку клавиша tab будет продолжать работать - перемещаясь сразу на выделенный пункт RadioGroup.

Вопрос:
Как разместить маленькие картинки в компоненте TPopUpMenu?

Ответ:
В приведенном примере показано как это сделать с использованием функции Windows API SetMenuItemBitmaps(). Эта функция получает handle popup menu, позицию строчки меню куда будет помещена картинка, и два дескриптора(handles) на две картинки (одна из них - картинка которая будет показана когда строка меню доступна, вторая - когда строка меню недоступна).
type
TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    Pop11: TMenuItem;
    Pop21: TMenuItem;
    Pop31: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
            Shift: TShiftState; X, Y: Integer);
private
    {Private declarations}
    bmUnChecked : TBitmap;
    bmChecked : TBitmap;
public
    {Public declarations}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
bmUnChecked := TBitmap.Create;
bmUnChecked.LoadFromFile('C:\Program Files\Borland\BitBtns\ALARMRNG.BMP');
bmChecked := TBitmap.Create;
bmChecked.LoadFromFile('C:\Program Files\Borland\BitBtns\CHECK.BMP');
{Add the bitmaps to the item at index 1 in PopUpMenu}
SetMenuItemBitmaps(PopUpMenu1.Handle,1,MF_BYPOSITION,BmUnChecked.Handle,
                BmChecked.Handle);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
bmUnChecked.Free;
bmChecked.Free;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
            Shift: TShiftState; X, Y: Integer);
var
pt : TPoint;
begin
pt := ClientToScreen(Point(x, y));
PopUpMenu1.Popup(pt.x, pt.y);
end;

Вопрос:
Как узнать число кадров AVI файла, и выяснить как долго будет проигрывться этот файл?

Ответ:
В приведенном примере указано как получить эту информацию.

Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
MediaPlayer1.TimeFormat := tfFrames;
ShowMessage('Number of frames = ' + IntToStr(MediaPlayer1.Length));
MediaPlayer1.TimeFormat := tfMilliseconds;
ShowMessage('Number of milliseconds = ' + IntToStr(MediaPlayer1.Length));
end;

Вопрос:
Как изменить число фиксированных колонок в TDbGrid?

Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
TStringGrid(DbGrid1).FixedCols := 2;
end;

Вопрос:
Некоторые компоненты баз данных (и среди них TDBGrid) никак не меняют визуальных свойств, когда к ним отключен доступ (disabled). Как это изменить програмно?
Ответ:
Ниже приведен пример, меняющий цвет шрифта на clGray, когда доступ к элементу управления (в данном случае TDBGrid) запрещен (disabled).
procedure TForm1.Button1Click(Sender: TObject);
begin
DbGrid1.Enabled := false;
DbGrid1.Font.Color := clGray;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
DbGrid1.Enabled := true;
DbGrid1.Font.Color := clBlack;
end;

Вопрос:
Как определить нажаты ли клавиши Shift, Alt, or Ctrl в какой-либо момент времени?

Ответ:
В приведенном примере показано как определить нажата ли клавиша Shift при выборе строчки меню. Пример также содержит функции проверки состояния клавиш Alt, Ctrl.
Пример:

function CtrlDown : Boolean;
var
State : TKeyboardState;
begin
GetKeyboardState(State);
Result := ((State[vk_Control] And 128) <> 0);
end;

function ShiftDown : Boolean;
var
State : TKeyboardState;
begin
GetKeyboardState(State);
Result := ((State[vk_Shift] and 128) <> 0);
end;

function AltDown : Boolean;
var
State : TKeyboardState;
begin
GetKeyboardState(State);
Result := ((State[vk_Menu] and 128) <> 0);
end;
procedure TForm1.MenuItem12Click(Sender: TObject);
begin
if ShiftDown then
    Form1.Caption := 'Shift'
else
    Form1.Caption := '';
end;

Вопрос:
Как изменить шрифта hint'а?

Ответ:
В примере перехватывается событие Application.OnShowHint и изменяется шрифт Hint'а.

Пример:

type
TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
private
    {Private declarations}
public
    procedure MyShowHint(var HintStr: string;
    var CanShow: Boolean;var HintInfo: THintInfo);
    {Public declarations}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.MyShowHint(var HintStr: string; var CanShow: Boolean;
                var HintInfo: THintInfo);
var
i : integer;
begin
for i := 0 to Application.ComponentCount - 1 do
if Application.Components[i] is THintWindow then
    with THintWindow(Application.Components[i]).Canvas do
    begin
        Font.Name:= 'Arial';
        Font.Size:= 18;
        Font.Style:= [fsBold];
        HintInfo.HintColor:= clWhite;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnShowHint := MyShowHint;
end;

Вопрос:
Есть ли в Delphi эквивалент функции SendKeys Visual Basic'а?

Ответ:
Ниже приведена процедура, позволяющаю отправлять нажатия в любой элемент управления (window control), способный принимать ввод с клавиатуры. Вы можете использовать эту технику чтобы включать клавиши NumLock, CapsLock и ScrollLock под Windows NT. Та же техника работает и под Windows 95 для CapsLock и ScrollLock но не работает для клавиши NumLock.
Обратите внимание, что приведены четыре поцедуры: SimulateKeyDown() - эмулировать нажатие клавиши (без отпускания) SimulateKeyUp() - эмулировать отпускание клавиши SimulateKeystroke() - эмулировать удар по клавише (нажатие и отпускание) и SendKeys(), позволяющие Вам гибко контролировать посылаемые сообщения клавиатуры.
SimulateKeyDown(), SimulateKeyUp() и SimulateKeystroke() получают коды виртуальных клавиш (virtural key) (вроде VK_F1). Процедура SimulateKeystroke() получает дополнительный параметр, полезный при эмуляции нажатия PrintScreen. Когда этот параметр равен нулю весь экран будет скопирован в буфер обмена (clipboard). Если дополнительный параметр равен 1 будет скопированно только активное окно.
Четыре метода "button click" демонстрируют использование: ButtonClick1 - включает capslock ButtonClick2 - перехватывает весь экран в буфер обмена (clipboard). ButtonClick3 - перехватывает активное окно в буфер обмена (clipboard). ButtonClick4 - устанавливает фокус в Edit и отправляет в него строку.
Пример:

procedure SimulateKeyDown(Key : byte);
begin
keybd_event(Key, 0, 0, 0);
end;

procedure SimulateKeyUp(Key : byte);
begin
keybd_event(Key, 0, KEYEVENTF_KEYUP, 0);
end;

procedure SimulateKeystroke(Key : byte; extra : DWORD);
begin
keybd_event(Key,extra,0,0);
keybd_event(Key,extra,KEYEVENTF_KEYUP,0);
end;

procedure SendKeys(s : string);
var
i : integer;
flag : bool;
w : word;
begin
{Get the state of the caps lock key}
flag := not GetKeyState(VK_CAPITAL) and 1 = 0;
{If the caps lock key is on then turn it off}
if flag then
    SimulateKeystroke(VK_CAPITAL, 0);
for i := 1 to Length(s) do
    begin
    w := VkKeyScan(s[i]);
    {If there is not an error in the key translation}
    if ((HiByte(w) <> $FF) and (LoByte(w) <> $FF)) then
        begin
        {If the key requires the shift key down - hold it down}
        if HiByte(w) and 1 = 1 then
            SimulateKeyDown(VK_SHIFT);
            {Send the VK_KEY}
        SimulateKeystroke(LoByte(w), 0);
        {If the key required the shift key down - release it}
        if HiByte(w) and 1 = 1 then
            SimulateKeyUp(VK_SHIFT);
        end;
    end;
{if the caps lock key was on at start, turn it back on}
if flag then
SimulateKeystroke(VK_CAPITAL, 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
{Toggle the cap lock}
SimulateKeystroke(VK_CAPITAL, 0);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
{Capture the entire screen to the clipboard}
{by simulating pressing the PrintScreen key}
SimulateKeystroke(VK_SNAPSHOT, 0);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
{Capture the active window to the clipboard}
{by simulating pressing the PrintScreen key}
SimulateKeystroke(VK_SNAPSHOT, 1);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
{Set the focus to a window (edit control) and send it a string}
Application.ProcessMessages;
Edit1.SetFocus;
SendKeys('Delphi Is RAD!');
end;

Вопрос:
Я загружаю TImageList динамически. Как сделать картинки из TImageList прозрачными?

Ответ:
См. ответ.

Пример:

procedure TForm1.Button1Click(Sender: TObject);
var
bm : TBitmap;
il : TImageList;
begin
bm := TBitmap.Create;
bm.LoadFromFile('C:\DownLoad\TEST.BMP');
il := TImageList.CreateSize(bm.Width,bm.Height);
il.DrawingStyle := dsTransparent;
il.Masked := true;
il.AddMasked(bm, clRed);
il.Draw(Form1.Canvas, 0, 0, 0);
bm.Free;
il.Free;
end;

Вопрос:
Как заставить TMediaPlayer проигрывать одно и тоже бесконечно? AVI например?

Ответ:
В примере AVI файл проигрывается снова и снова - используем событие MediaPlayer'а Notify

Пример:

procedure TForm1.MediaPlayer1Notify(Sender: TObject);
begin
with MediaPlayer1 do
    if NotifyValue = nvSuccessful then
    begin
        Notify := True;
        Play;
    end;
end;

Вопрос:
При выполнении диалога FontDialog со свойством Device равным fdBoth or fdPrinter, появляется ошибка "There are no fonts installed".
Ответ:
Эти установки должны показать шрифты совместимые либо с принтером либо с экраном. В примере диалог Windows ChooseFont вызывается напрямую чтобы показать список шрифтов, совместимых одновременно и с экраном и с принтером.
Пример:

uses Printers, CommDlg;

procedure TForm1.Button1Click(Sender: TObject);
var
cf : TChooseFont;
lf : TLogFont;
tf : TFont;
begin
if PrintDialog1.Execute then
    begin
    GetObject(Form1.Canvas.Font.Handle, sizeof(lf),@lf);
    FillChar(cf, sizeof(cf), #0);
    cf.lStructSize := sizeof(cf);
    cf.hWndOwner := Form1.Handle;
    cf.hdc := Printer.Handle;
    cf.lpLogFont := @lf;
    cf.iPointSize := Form1.Canvas.Font.Size * 10;
    cf.Flags := CF_BOTH or CF_INITTOLOGFONTSTRUCT or
        CF_EFFECTS or CF_SCALABLEONLY or CF_WYSIWYG;
    cf.rgbColors := Form1.Canvas.Font.Color;
    if ChooseFont(cf) <> false then
        begin
        tf := TFont.Create;
        tf.Handle := CreateFontIndirect(lf);
        tf.COlor := cf.RgbColors;
        Form1.Canvas.Font.Assign(tf);
        tf.Free;
        Form1.Canvas.TextOut(10, 10, 'Test');
        end;
    end;
end;

Вопрос:
Как сменить дисковод, откуда  MediaPlayer проигрывает аудио CD?

Ответ:
См. пример.

Пример:

MediaPlayer1.FileName := 'E:';

Вопрос:
Как убрать кнопку с названием моей программы из Панели Задач(Taskbar)?

Ответ:
Отредактируйте файл-проекта (View -> Project Source) Добавьте модуль Windows в раздел uses. Application.ShowMainForm := False; в строку после "Application.Initialize;". Добавьте ShowWindow(Application.Handle, SW_HIDE); в строку перед "Application.Run;"
Ваш файл проекта должен выглядеть приблизительно так:

program Project1;

uses
Windows,
Forms,
Unit1 in 'Unit1.pas' {Form1},
Unit2 in 'Unit2.pas' {Form2};

{$R *.RES}

begin
Application.Initialize;
Application.ShowMainForm := False;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TForm2, Form2);
ShowWindow(Application.Handle, SW_HIDE);
Application.Run;
end.

В разделе "initialization" (в самом низу) каждого unit'а добавьте

begin
ShowWindow(Application.Handle, SW_HIDE);
end.

Вопрос:
Как преобразовать цвета в строку - название цвета  VCL?

Ответ:
Модуль graphics.pas содержит функцию ColorToString() которое преобразует допустимое значение TColor в его строковое представление используя либо константу-название цвета (по возможности) либо шестнадцатиричную строку. Обратная функция - StringToColor()
Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Lines.Add(ColorToString(clRed));
Memo1.Lines.Add(IntToStr(StringToColor('clRed')));
end;

Вопрос:
При показе максимизированное формы она перекрывает task bar и не выравнивается
по верху экрана. В чем тут дело?

Ответ:
Это может произойти когда свойство position формы установленно в poScreenCenter.
Установите position = poDefault.

Вопрос:
Как заставить TEdit не 'пикать' при нажатии недопустимых клавиш?

Ответ:
Перехватите событие KeyPress и установите key = #0 для недопустимых клавиш.

Пример:

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if ((UpCase(Key) < 'A') or (UpCase(Key) > 'Z')) then
    Key := #0;
end;

Вопрос:
Как получить число и список всех компонентов, расположенных на TNoteBook?

Ответ:
В примере список выводится на Listbox.

Пример:

procedure TForm1.Button1Click(Sender: TObject);
var
n: integer;
p: integer;
begin
ListBox1.Clear;
with Notebook1 do
begin
    for n := 0 to ControlCount - 1 do
    begin
    with TPage(Controls[n]) do
    begin
        ListBox1.Items.Add('Notebook Page: ' +
        TPage(Notebook1.Controls[n]).Caption);
        for p := 0 to ControlCount - 1 do
        ListBox1.Items.Add(Controls[p].Name);
        ListBox1.Items.Add(EmptyStr);
    end;
    end;
end;
end;

Вопрос:
Я хочу вставить escape code в строку при использовании функции Format(). Например, я хочу создать строку, содержащую символ табуляции. В "C" я бы написал что-то вроде sprintf(buffer, "%s\t%s", str);. А как это будет на Pascal'e?
Ответ:
Функция Format Pascal'я не использует escape codes. Вместо этого нужно вставить в строку действительное значение символа в кодировке ASCII.
Пример:

Buffer := Format('%s'#9'%s', [Str1, Str2]);
ShowMessage(Format('%s'#9'%s', ['Column1', 'Column2']));

Вопрос:
Как показать первый кадр AVI-файла?

Ответ:
См. пример.
Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
Application.ProcessMessages;
MediaPlayer1.Open;
Application.ProcessMessages;
MediaPlayer1.Step;
Application.ProcessMessages;
MediaPlayer1.Previous;
end;

Вопрос:
Когда пользователь щелкает по listview, он переходит в режим редактирования.
Как перевисти его в редим редактирования по нажатию клавиши (например F2)?

Ответ:
Перехватите F2 на событии keydown.

Пример:

procedure TForm1.ListView1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Ord(Key) = VK_F2 then
ListView1.Selected.EditCaption;
end;

Вопрос:
Когда я добавляю обьект в список TStrings как мне его потом уничтожить?

Ответ:
Просто вызовите метод free этого обьекта.

Пример:

procedure TForm1.FormCreate(Sender: TObject);
var
Icon: TIcon;
begin
Icon := TIcon.Create;
Icon.LoadFromFile('C:\Program Files\BorlandImages\CONSTRUC.ICO');
ListBox1.Items.AddObject('Item 0', Icon);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
ListBox1.Items.Objects[0].Free;
end;

Вопрос:
Вместо печати графики я хочу использовать резидентный шрифт принтера. Как?

Ответ:
Используте функцию Windows API - GetStockObject() чтобы получить дескриптор (handle) шрифта по умолчанию устройства (DEVICE_DEFAULT_FONT) и передайте его Printer.Font.Handle.
Пример:

uses Printers;

procedure TForm1.Button1Click(Sender: TObject);
var
tm : TTextMetric;
i : integer;
begin
if PrintDialog1.Execute then
begin
    Printer.BeginDoc;
    Printer.Canvas.Font.Handle := GetStockObject(DEVICE_DEFAULT_FONT);
    GetTextMetrics(Printer.Canvas.Handle, tm);
    for i := 1 to 10 do
    begin
    Printer.Canvas.TextOut(100,i * tm.tmHeight +
        tm.tmExternalLeading,'Test');
    end;
    Printer.EndDoc;
end;
end;

Вопрос:
Мне нужно программно установить некоторые файлы с установочного диска Windows. На многих компьютерах CAB-файлы установки Windows находятся в каком-то каталоге на жестком диске, на других - Windows был установлен с CD. Как узнать откуда была установленна Windows?
Ответ:
Эту информацию можно получить из реестра.

Пример:
uses Registry;

procedure TForm1.Button1Click(Sender: TObject);
var
reg: TRegistry;
begin
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\SETUP',false);
ShowMessage(reg.ReadString('SourcePath'));
reg.CloseKey;
reg.free;
end;

Вопрос:
Как получить строку сообщения об ошибке Windows код которой получен функцией
GetLastError?

Ответ:
Функция RTL SysErrorMessage(GetLastError).

Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
{Cause a Windows system error message to be logged}
ShowMessage(IntToStr(lStrLen(nil)));
ShowMessage(SysErrorMessage(GetLastError));
end;

Вопрос:
Как заставить Delphi выполнять еще более строгую проверка типов? Напрмер - я создаю пользовательский тип, унаследованный от double и могу передавать его любым функциям, принимающим параметр типа double. Как заставить компилятор проводить более строгую проверку типов и выдавать предупреждение в таких случаях?
Ответ:
См. ответ.

Пример:

type TStrongType = type Double;
type TWeakType = Double;

procedure AddWeakType(var d : TWeakType);
begin
d := d + 1;
end;

procedure AddStrongType(var d : TStrongType);
begin
d := d + 1;
end;

procedure AddDoubleType(var d : Double);
begin
d := d + 1;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
d : Double;
s : TStrongType;
w : TWeakType;
begin
AddDoubleType(d); {compiles fine}
AddDoubleType(w); {compiles fine}
AddDoubleType(s); {<- compile error}
AddDoubleType(double(s)); {compiles fine}
AddWeakType(d); {compiles fine}
AddWeakType(w); {compiles fine}
AddWeakType(s); {<- compile error}
AddWeakType(TWeakType(s)); {compiles fine}
AddStrongType(d); {<- compile error}
AddStrongType(TStrongType(d)); {compiles fine}
AddStrongType(w); {<- compile error}
AddStrongType(TStrongType(w)); {compiles fine}
AddStrongType(s); {compiles fine}
end;

Вопрос:
Где в Delphi обьявленны VK_Key для A-Z и 0-9?

Ответ:
Они не обьявлены в Delphi поскольку они просто могуть быть заменены буквами.
VK_0 до VK_9 то же что и  ASCII '0' до '9' ($30 - $39),
VK_A до VK_Z то же что и  ASCII 'A' до 'Z' ($41 - $5A).

Вопрос:
Как изменить оконную процедуру для TForm?

Ответ:
Переопределите в подклассе TForm оконную процедуру WinProc класса. В примере оконная процедура переопределяется для того чтобы реагировать на сообщение WM_CANCELMODE, показывающее, что выполняется messagebox или какой-либо еще диалог.
Пример:

type
TForm1 = class(TForm)
    Button1: TButton;
    procedure WndProc (var Message: TMessage); override;
    procedure Button1Click(Sender: TObject);
private
    {Private declarations}
public
    {Public declarations}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WndProc (var Message: TMessage);
begin
if Message.Msg = WM_CANCELMODE then
    begin
    Form1.Caption := 'A dialog or message box has popped up';
    end
else
    inherited  // <- остальное сделает родительская процедура
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage('Test Message');
end;

Вопрос:
Как узнать размеры TComboBox с показанным выпадающим списком до показа списка?

Ответ:
На событии FormShow пошлите сообщение CB_SHOWDROPDOWN в ComboBox дважды - один раз чтобы заставить список выпасть, второй - чтобы убрать его. Затем пошлите сообщение CB_GETDROPPEDCONTROLRECT, передав в качестве параметра адрес TRect. TRect будет содержать экранные кординаты прямоугольника описывающего ComboBox вместе с выпавшим списком. Затем Вы можете вызвать ScreenToClient чтобы преобразовать экранные кординаты в координаты клиентской области окна.
Пример:

var
R : TRect;
procedure TForm1.FormShow(Sender: TObject);
var
T : TPoint;
begin
SendMessage(ComboBox1.Handle, CB_SHOWDROPDOWN, 1, 0);
SendMessage(ComboBox1.Handle, CB_SHOWDROPDOWN, 0, 0);
SendMessage(ComboBox1.Handle, CB_GETDROPPEDCONTROLRECT, 0, LongInt(@r));
t := ScreenToClient(Point(r.Left, r.Top));
r.Left := t.x;
r.Top := t.y;
t := ScreenToClient(Point(r.Right, r.Bottom));
r.Right := t.x;
r.Bottom := t.y;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Form1.Canvas.Rectangle(r.Left, r.Top, r.Right, r.Bottom );
end;

Вопрос:
Я хочу создать в своей программе меню "а ля Дельфи 4". Как это сделать?

Ответ:
1. Разместите на форме TControlBar. (закладка Additional) Установите Align = Client.
2. Разместите TToolBar (закладка Win32) внутри TControlBar.
3. Установите в True свойства Flat и ShowCaptions этого TToolBar.
4. Создайте на TToolBar столько TToolButtons сколько Вам нужно. (щелкнув по TToolBar
правой кнопкой и выбрав NewButton)
5. Установите свойство Grouped = True для всех TToolButtons. Это позволит меню выпадать
при перемещении курсора между главными пунктами меню (если меню уже показано).
6. Разместите на фоме TMainMenu и убедитесь, что оно *НЕ присоденено* как меню главной
формы. (посмотрите свойство Menu формы).
7. Создайте все пункты меню (щелкнув по TMainMenu кнопкой и выбрав Menu Designer)
8. Для каждой TToolButton установите ее MenuItem равным соответсвующему пункту TMainMenu.

Вопрос:
Как добится того чтобы TMemo и TEdit имели работали не только в режиме вставки символов,
но и в режиме замены?

Ответ:
Элементы управления Windows TEdit и TMemo не имеют режима замены. Однако этот режим можно эмулировать установив свойство SelLength edit'а или memo в 1 при обработке события KeyPress. Это заставит его перезаписывать символ в текущей позиции курсора. В примере этот способ используется для TMemo. Режим вставка/замена переключается клавишей "Insert".
Пример:

type
TForm1 = class(TForm)
    Memo1: TMemo;
    procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure Memo1KeyPress(Sender: TObject; var Key: Char);
private
{Private declarations}
    InsertOn : bool;
public
{Public declarations}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if (Key = VK_INSERT) and (Shift = []) then
    InsertOn := not InsertOn;
end;

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
if ((Memo1.SelLength = 0) and (not InsertOn)) then
    Memo1.SelLength := 1;
end;

Вопрос:
Как отправить сообщение сразу всем элементам управления формы?

Ответ:
Можно использовать Screen.Forms[i].BroadCast(msg); где [i] - индекс той формы, которой Вы хотите переслать сообщение. BroadCast работает со всеми компонентами, потомками TWinControls и отправляет сообщение всем дочерним компонентам из массива Controls. Если один из дочерних компонентов обрабатывает это сообщение и устанавливает Msg.Result в ненулевое значение - дальнейшая рассылка сообщения останавливается.

Вопрос:
При попытке присвоить значение свойству "selected" ListBox'а вырабатывается exception
"Index is out of bounds". В чем тут дело и как присвоить значение свойству selected?

Ответ:
Свойство "selected" компонента ТListBox может быть использованно только если свойство
MultiSelect установленно в True. Если Вы работаете с ListBox'ом у которого
MultiSelect=false то используйте свойство ItemIndex.

Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.Add('1');
ListBox1.Items.Add('2');
{This will fail on a single selection ListBox}
// ListBox1.Selected[1] := true;
ListBox1.ItemIndex := 1; {This is ok}
end;

Вопрос:
Как ограничить длинну текста, вводимого в TEdit, так чтобы ширина текста не превышала
ширину TEdit'а?

Ответ:
В примере приведено два способа ограничить длинну текста в TEdit так чтобы она не превышала ширину клиентской области окна TEdit'а и не появлялась прокрутка текста. Первый способ устанавливает свойство TEdit'а MaxLength равным числу букв "W", которые поместятся в TEdit. "W" выбрана потому, что является, наверное, самой широкой буквой в любом шрифте. Этот метод сносно работает для шрифтов с фиксированной шириной букв, но для шрифтов с переменной шириной букв вряд ли сгодится. Второй способ перхватывает событие KeyPress TEdit'а и измеряет ширину уже введенного текста и ширину нового символа. Если ширина больше чем клиентская область TEdit'а новый символ отбрасывается и вызывается MessageBeep.
Пример:

procedure TForm1.FormCreate(Sender: TObject);
var
cRect : TRect;
bm : TBitmap;
s : string;
begin
Windows.GetClientRect(Edit1.Handle, cRect);
bm := TBitmap.Create;
bm.Width := cRect.Right;
bm.Height := cRect.Bottom;
bm.Canvas.Font := Edit1.Font;
s := 'W';
while bm.Canvas.TextWidth(s) < CRect.Right do
s := s + 'W';
if length(s) > 1 then
begin
    Delete(s, 1, 1);
    Edit1.MaxLength := Length(s);
end;
end;

{Другой вариант}

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
cRect : TRect;
bm : TBitmap;
begin
if ((Ord(Key) <> VK_TAB) and (Ord(Key) <> VK_RETURN) and
    (Ord(Key) <> VK_LEFT) and (Ord(Key) <> VK_BACK)) then
begin
    Windows.GetClientRect(Edit1.Handle, cRect);
    bm := TBitmap.Create;
    bm.Width := cRect.Right;
    bm.Height := cRect.Bottom;
    bm.Canvas.Font := Edit1.Font;
    if bm.Canvas.TextWidth(Edit1.Text + Key) > CRect.Right then
    begin
    Key := #0;
    MessageBeep(-1);
    end;
    bm.Free;
end;
end;

Вопрос:
Как сохранить обьект TFont в реестре/ini/файле/таблице базы данных?

Ответ:
Нужно сохранять атрибуты шрифта (имя, размер и т.п.) а не сам обьект TFont. После считывания этой информации следует проверить существует ли такой шрифт, прежде чем его использовать. Чтобы не показаться голословным дополню ответ Borland'а своим примером сохранения/чтения шрифта в/из реестра
Uses    ... Registry;

procedure SaveFontToRegistry(Font : TFont; SubKey : String);
Var
R : TRegistry;
FontStyleInt : byte;
FS : TFontStyles;
begin
R:=TRegistry.Create;
try
    FS:=Font.Style;
    Move(FS,FontStyleInt,1);
    R.OpenKey(SubKey,True);
    R.WriteString('Font Name',Font.Name);
    R.WriteInteger('Color',Font.Color);
    R.WriteInteger('CharSet',Font.Charset);
    R.WriteInteger('Size',Font.Size);
    R.WriteInteger('Style',FontStyleInt);
finally
    R.Free;
end;
end;

function ReadFontFromRegistry(Font : TFont; SubKey : String) : boolean;
Var
R : TRegistry;
FontStyleInt : byte;
FS : TFontStyles;
begin
R:=TRegistry.Create;
try
    result:=R.OpenKey(SubKey,false); if not result then exit;
    Font.Name:=R.ReadString('Font Name');
    Font.Color:=R.ReadInteger('Color');
    Font.Charset:=R.ReadInteger('CharSet');
    Font.Size:=R.ReadInteger('Size');
    FontStyleInt:=R.ReadInteger('Style');
    Move(FontStyleInt,FS,1);
    Font.Style:=FS;
finally
    R.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
If FontDialog1.Execute then
begin
    SaveFontToRegistry(FontDialog1.Font,'Delphi Kingdom\Fonts');
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
NFont : TFont;
begin
NFont:=TFont.Create;
if ReadFontFromRegistry(NFont,'Delphi Kingdom\Fonts') then
begin //здесь добавить проверку - существует ли шрифт
    Label1.Font.Assign(NFont);
    NFont.Free;
end;
end;

Вопрос:
  Как перемещать компонент мышкой во время работы программы "runtime"?

Ответ:
Перехватить событие OnMouseDown, запомнить x и y координты курсора мыши. Отслеживать движение мыши по событию OnMouseMove и перемещать компонент вслед за курсором мыши до тех пор пока не произойдет событие OnMouseUp. В примере показано перемещение компонента TButton. Перемещение начинается, когда пользователь "берет" TButton мышью, удерживая нажатой клавишу "Сontrol".
Пример:

type
TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
    procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
        Y: Integer);
    procedure Button1MouseUp(Sender: TObject; Button:
        TMouseButton; Shift: TShiftState; X, Y: Integer);
private
    {Private declarations}
public
    {Public declarations}
    MouseDownSpot : TPoint;
    Capturing : bool;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
begin
if ssCtrl in Shift then
begin
    SetCapture(Button1.Handle);
    Capturing := true;
    MouseDownSpot.X := x;
    MouseDownSpot.Y := Y;
end;
end;

procedure TForm1.Button1MouseMove(Sender: TObject; Shift: TShiftState; X,  Y: Integer);
begin
if Capturing then
begin
    Button1.Left := Button1.Left - (MouseDownSpot.x - x);
    Button1.Top := Button1.Top - (MouseDownSpot.y - y);
end;
end;

procedure TForm1.Button1MouseUp(Sender: TObject; Button:
    TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Capturing then
begin
    ReleaseCapture;
    Capturing := false;
    Button1.Left := Button1.Left - (MouseDownSpot.x - x);
    Button1.Top := Button1.Top - (MouseDownSpot.y - y);
end;
end;

Вопрос:
При попытке создать обьект класса TPrinter (TPrinter.Create) я получаю exception.
Почему?

Ответ:
В создании обьекта класса TPrinter с использованием TPrinter.Create нет необходимости,
так как обьект класса TPrinter (называемый Printer) автоматически создается при
использовании модуля Printers.

Пример:

uses Printers;

procedure TForm1.Button1Click(Sender: TObject);
begin
Printer.BeginDoc;
Printer.Canvas.TextOut(100, 100, 'Hello World!');
Printer.EndDoc;
end;

Вопрос:
Как перехватить события в неклиентской области формы, в заголовке окна, например?

Ответ:
Создайте обработчик одного из сообщений WM_NC (non client - не клиентских) (посмотрите
WM_NC в Windows API help). Пример показывает как перехватить вижение мыши во всей
неклиенстской области окна (рамка и заголовок).

Пример:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
private
{Private declarations}
procedure WMNCMOUSEMOVE(var Message: TMessage);
message WM_NCMOUSEMOVE;
public
{Public declarations}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMNCMOUSEMOVE(var Message: TMessage);
var
s : string;
begin
case Message.wParam of
    HTERROR:
    s:= 'HTERROR';
    HTTRANSPARENT:
    s:= 'HTTRANSPARENT';
    HTNOWHERE:
    s:= 'HTNOWHERE';
    HTCLIENT:
    s:= 'HTCLIENT';
    HTCAPTION:
    s:= 'HTCAPTION';
    HTSYSMENU:
    s:= 'HTSYSMENU';
    HTSIZE:
    s:= 'HTSIZE';
    HTMENU:
    s:= 'HTMENU';
    HTHSCROLL:
    s:= 'HTHSCROLL';
    HTVSCROLL:
    s:= 'HTVSCROLL';
    HTMINBUTTON:
    s:= 'HTMINBUTTON';
    HTMAXBUTTON:
    s:= 'HTMAXBUTTON';
    HTLEFT:
    s:= 'HTLEFT';
    HTRIGHT:
    s:= 'HTRIGHT';
    HTTOP:
    s := 'HTTOP';
    HTTOPLEFT:
    s:= 'HTTOPLEFT';
    HTTOPRIGHT:
    s:= 'HTTOPRIGHT';
    HTBOTTOM:
    s:= 'HTBOTTOM';
    HTBOTTOMLEFT:
    s:= 'HTBOTTOMLEFT';
    HTBOTTOMRIGHT:
    s:= 'HTBOTTOMRIGHT';
    HTBORDER:
    s:= 'HTBORDER';
    HTOBJECT:
    s:= 'HTOBJECT';
    HTCLOSE:
    s:= 'HTCLOSE';
    HTHELP:
    s:= 'HTHELP';
    else s:= '';
end;
Form1.Caption := s;
Message.Result := 0;
end;

end.

Вопрос:
При попытке использовать метод TCanvas.StretchDraw чтобы нарисовать иконку
увеличенной ее размер не изменяется. Что делать?

Ответ:
Иконки всегда рисуются размером принятым в системе по умолчанию. Чтобы показать
увеличенный вид иконки скоприуйте ее на bitmap, а зате используйте метод
TCanvas.StretchDraw.

Пример:

procedure TForm1.Button1Click(Sender: TObject);
var
TheBitmap : TBitmap;
begin
TheBitmap := TBitmap.Create;
TheBitmap.Width := Application.Icon.Width;
TheBitmap.Height := Application.Icon.Height;
TheBitmap.Canvas.Draw(0, 0, Application.Icon);
Form1.Canvas.StretchDraw(Rect(0,0,TheBitmap.Width * 3,TheBitmap.Height * 3),
       TheBitmap);
TheBitmap.Free;
end;

Вопрос:
Можно ли сделать так чтобы TStringGrid автоматически изменял ширину колонок, чтобы
вместить самую длинную строчку в колонке?

Ответ:
См. пример.

Пример:

procedure AutoSizeGridColumn(Grid : TStringGrid; column : integer);
var
i : integer;
temp : integer;
max : integer;
begin
max := 0;
for i := 0 to (Grid.RowCount - 1) do
begin
    temp := Grid.Canvas.TextWidth(grid.cells[column, i]);
    if temp > max then max := temp;
end;
Grid.ColWidths[column] := Max + Grid.GridLineWidth + 3;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
AutoSizeGridColumn(StringGrid1, 1);
end;

Вопрос:
TTimer работает не достаточно точно. Как получить более высокую точность?

Ответ:
Таймер Windows не был создан с целью получения сверхточного хронометра. Другими словами, когда Вы устанавливаете таймер на срабатывания каждые 1000 миллисекунд, он может срабатывать через интервал несколько больший чем 1000 миллисекунд. Значения меньше 55 миллисекунд никогда не будут срабатывать вовремя в Windows, поскольку это минимальная точность таймера. Можно проверять системное время и сравнивать его со временем предыдущего события таймера чтобы повысить точность.

Вопрос:
Как поместить JPEG-картинку в exe-файл и потом загрузить ее?

Ответ:
1) Создайте текстовый файл с расширением ".rc". Имя этого файла должно отличаться
от имени файла-пректа или любого модуля проекта.
Файл должен содержать строку вроде: MYJPEG JPEG C:\DownLoad\MY.JPG
где:
"MYJPEG" имя ресурса
"JPEG" пользовательский тип ресурса
"C:\DownLoad\MY.JPG" руть к  JPEG файлу.

Пусть например rc-файл называется "foo.rc"

Запустите BRCC32.exe (Borland Resource CommandLine Compiler) - программа находится
в каталоге Bin Delphi/C++ Builder'а - передав ей в качестве параметра полный путь
к rc-файлу.
В нашем примере:

C:\DelphiPath\BIN\BRCC32.EXE  C:\ProjectPath\FOO.RC
Вы получите откомпилированный ресурс - файл с расширением ".res".
(в нашем случает foo.res).
Далее добавте ресурс к своему приложению.

{Грузим ресурс}
{$R FOO.RES}

uses Jpeg;

procedure LoadJPEGFromRes(TheJPEG : string; ThePicture : TPicture);
var
ResHandle : THandle;
MemHandle : THandle;
MemStream : TMemoryStream;
ResPtr    : PByte;
ResSize   : Longint;
JPEGImage : TJPEGImage;
begin
ResHandle := FindResource(hInstance, PChar(TheJPEG), 'JPEG');
MemHandle := LoadResource(hInstance, ResHandle);
ResPtr    := LockResource(MemHandle);
MemStream := TMemoryStream.Create;
JPEGImage := TJPEGImage.Create;
ResSize := SizeOfResource(hInstance, ResHandle);
MemStream.SetSize(ResSize);
MemStream.Write(ResPtr^, ResSize);
FreeResource(MemHandle);
MemStream.Seek(0, 0);
JPEGImage.LoadFromStream(MemStream);
ThePicture.Assign(JPEGImage);
JPEGImage.Free;
MemStream.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
LoadJPEGFromRes('MYJPEG', Image1.Picture);
end;

Вопрос:
Как перехватить сообщения прокрутки в TScrollBox?

Ответ:
Следующий пример перехватывает сообщения о прокрутке компонента TScrollBox и
синхронизирует обе линейки прокрутки. Сообщения прокрутки перехватываются с помощью
переопределения окнной процедуры (WinProc) ScrollBox'а.

Пример:

type
{$IFDEF WIN32}
WParameter = LongInt;
{$ELSE}
WParameter = Word;
{$ENDIF}
LParameter = LongInt;

{Declare a variable to hold the window procedure we are replacing}
var
OldWindowProc : Pointer;

function NewWindowProc(WindowHandle : hWnd;
TheMessage   : WParameter;
ParamW : WParameter;
ParamL : LParameter) : LongInt
{$IFDEF WIN32} stdcall; {$ELSE} ; export; {$ENDIF}
var
TheRangeMin : integer;
TheRangeMax : integer;
TheRange : integer;
begin
if TheMessage = WM_VSCROLL then
begin
    {Get the min and max range of the horizontal scroll box}
    GetScrollRange(WindowHandle, SB_HORZ, TheRangeMin, TheRangeMax);
    {Get the vertical scroll box position}
    TheRange := GetScrollPos(WindowHandle, SB_VERT);
    {Make sure we wont exceed the range}
    if TheRange < TheRangeMin then
    TheRange := TheRangeMin else
    if TheRange > TheRangeMax then
    TheRange := TheRangeMax;
    {Set the horizontal scroll bar}
    SetScrollPos(WindowHandle, SB_HORZ, TheRange, true);
end;
if TheMessage = WM_HSCROLL then
begin
    {Get the min and max range of the horizontal scroll box}
    GetScrollRange(WindowHandle, SB_VERT, heRangeMin, TheRangeMax);
    {Get the horizontal scroll box position}
    TheRange := GetScrollPos(WindowHandle, SB_HORZ);
    {Make sure we wont exceed the range}
    if TheRange < TheRangeMin then
    TheRange := TheRangeMin
    else
    if TheRange > TheRangeMax then
        TheRange := TheRangeMax;
    {Set the vertical scroll bar}
    SetScrollPos(WindowHandle, SB_VERT, TheRange, true);
end;

{Call the old Window procedure to allow processing of the message.}
NewWindowProc := CallWindowProc(OldWindowProc, WindowHandle, TheMessage,
        ParamW, ParamL);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
{Set the new window procedure for the control and remember
        the old window procedure.}
OldWindowProc := Pointer(SetWindowLong(ScrollBox1.Handle, GWL_WNDPROC,
        LongInt(@NewWindowProc)));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
{Set the window procedure back to the old window procedure.}
SetWindowLong(ScrollBox1.Handle, GWL_WNDPROC, LongInt(OldWindowProc));
end;

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

Ответ:
Самый простой способ - воспользоваться функцией Windows API DrawFocusRect. Функция DrawFocusRect использует операцию XOR при рисовании - таким образом вывод прямоугольника дважды с одними и теми же координатами стирает прямоугольник, и прямоугольник всегда будет виден, на фоне какого бы цвета он не выводился.
Пример:

type
TForm1 = class(TForm)
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
        Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
private
    {Private declarations}
    Capturing : bool;
    Captured : bool;
    StartPlace : TPoint;
    EndPlace : TPoint;
public
    {Public declarations}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

function MakeRect(Pt1 : TPoint; Pt2 : TPoint) : TRect;
begin
if pt1.x < pt2.x then
    begin
    Result.Left := pt1.x;
    Result.Right := pt2.x;
    end
else
    begin
    Result.Left := pt2.x;
    Result.Right := pt1.x;
    end;
if pt1.y < pt2.y then
    begin
    Result.Top := pt1.y;
    Result.Bottom := pt2.y;
    end
else
begin
    Result.Top := pt2.y;
    Result.Bottom := pt1.y;
end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
begin
if Captured then
    DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));
StartPlace.x := X;
StartPlace.y := Y;
EndPlace.x := X;
EndPlace.y := Y;
DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));
Capturing := true;
Captured := true;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
    Y: Integer);
begin
if Capturing then
begin
    DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));
    EndPlace.x := X;
    EndPlace.y := Y;
    DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));
end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
begin
Capturing := false;
end;

Вопрос:
Можно ли использовать иконку как картинку на кнопке TSpeedButton?

Ответ:
Можно. См. пример.

Пример:

uses ShellApi;

procedure TForm1.FormShow(Sender: TObject);
var
Icon: TIcon;
begin
Icon := TIcon.Create;
Icon.Handle := ExtractIcon(0,'C:\WINDOWS\NOTEPAD.EXE',1);
SpeedButton1.Glyph.Width := Icon.Width;
SpeedButton1.Glyph.Height := Icon.Height;
SpeedButton1.Glyph.Canvas.Draw(0, 0, Icon);
Icon.Free;
end;

Вопрос:
Как поместить прозрачную фоновую каринку на компонент CoolBar?

Ответ:
procedure TForm1.Button1Click(Sender: TObject);
var
Bm1 : TBitmap;
Bm2 : TBitmap;
begin
Bm1 := TBitmap.Create;
Bm2 := TBitmap.Create;
Bm1.LoadFromFile('c:\download\test.bmp');
Bm2.Width := Bm1.Width;
Bm2.Height := Bm1.Height;
bm2.Canvas.Brush.Color := CoolBar1.Color;
bm2.Canvas.BrushCopy(Rect(0, 0, bm2.Width, bm2.Height), Bm1,
    Rect(0, 0, Bm1.width, Bm1.Height), ClWhite);
bm1.Free;
CoolBar1.Bitmap.Assign(bm2);
bm2.Free;
end;

Вопрос:
Ползунок компонента TScrollBar все время мигает. Как это отключить?

Ответ:
Установите свойтсво ScrollBar.TabStop в False.

Вопрос:
Как программно перевести DBgrid в реим редактирования и установить курсор в
окошке редактирования в требуемую позицию?

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

procedure TForm1.Button1Click(Sender: TObject);
var
h : THandle;
begin
Application.ProcessMessages;
DbGrid1.SetFocus;
DbGrid1.EditorMode := true;
Application.ProcessMessages;
h:= Windows.GetFocus;
SendMessage(h, EM_SETSEL, 2, 2);
end;

Вопрос:
Как поместить курсор в определенную позицию edit'а и подобных ему элементов управления?

Ответ:
Можно использовать методы Delphi SelStart() и SelectLength().

Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.SetFocus;
{переводим курсор во вторую позицию}
Edit1.SelStart := 2;
{не выделяем никакого текста}
Edit1.SelLength := 0;
end;

Вопрос:
Как среагировать на минимизацию-максимизацию формы перед тем как произойдет изменение
размера формы?

Ответ:
В примере перехватывается сообщение WM_SYSCOMMAND. Если это сообщение говорит о
минимизации или максимизации формы - пищит динамик.

Пример:

type
TForm1 = class(TForm)
private
    {Private declarations}
    procedure WMSysCommand(var Msg: TWMSysCommand);
    message WM_SYSCOMMAND;
public
    {Public declarations}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMSysCommand;
begin
if (Msg.CmdType = SC_MINIMIZE) or (Msg.CmdType = SC_MAXIMIZE) then
    MessageBeep(0)
else
    inherited;
end;

Вопрос:
Можно ли сделать так - одна форма показывает другую и остается позади нее, но фокус
ввода не переходит к новой форме, а остается у старой?

Ответ:
В примере показывается не автосоздаваемая (non auto-created) форма, но фокус ввода ей
не передается.

Пример:

uses Unit2;

procedure TForm1.Button1Click(Sender: TObject);
begin
Form2 := TForm2.Create(Application);
Form2.Visible := FALSE;
ShowWindow(Form2.Handle, SW_SHOWNA);
end;

Вопрос:
На некоторых laptop компьютерах может не быть флоппи дисковода. Можно ли удалять
из списка TDriveComboBox диски которые отключены?

Ответ:
В примере TDriveComboBox не показывает дисководы, которые не готовы. (not ready).
Учтите что на многих компьютерах будет ощутимая задержка при поверке plug&play
флоппи дисковода.

Пример:

procedure TForm1.FormCreate(Sender: TObject);
var
i : integer;
OldErrorMode : Word;
OldDirectory : string;
begin
OldErrorMode := SetErrorMode(SEM_NOOPENFILEERRORBOX);
GetDir(0, OldDirectory);
i := 0;
while i <= DriveComboBox1.Items.Count - 1 do begin
{$I-}
ChDir(DriveComboBox1.Items[i][1] + ':\');
{$I+}
if IoResult <> 0 then
    DriveComboBox1.Items.Delete(i)
else
    inc(i);
end;
ChDir(OldDirectory);
SetErrorMode(OldErrorMode);
end;

Вопрос:
Как сообщить всем формам моего приложения (в том числе и не видимым в данный момент)
об изминении каких-то глобальных значений?

Ответ:
Один из способов - создать пользовательское сообщение и использовать метод preform
чтобы разослать его всем формам из массива Screen.Forms.

Пример:

{Code for Unit1}

const
UM_MyGlobalMessage = WM_USER + 1;

type
TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
   private
    {Private declarations}
    procedure UMMyGlobalMessage(var AMessage: TMessage); message
    UM_MyGlobalMessage;
public
    {Public declarations}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

uses Unit2;

procedure TForm1.FormShow(Sender: TObject);
begin
Form2.Show;
end;

procedure TForm1.UMMyGlobalMessage(var AMessage: TMessage);
begin
Label1.Left := AMessage.WParam;
Label1.Top  := AMessage.LParam;
Form1.Caption := 'Got It!';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
f: integer;
begin
for f := 0 to Screen.FormCount - 1 do
Screen.Forms[f].Perform(UM_MyGlobalMessage, 42, 42);
end;

{Code for Unit2}

const
UM_MyGlobalMessage = WM_USER + 1;
type
TForm2 = class(TForm)
    Label1: TLabel;
private
    {Private declarations}
    procedure UMMyGlobalMessage(var AMessage: TMessage);
    message UM_MyGlobalMessage;
public
    {Public declarations}
end;

var
Form2: TForm2;

implementation

{$R *.DFM}

procedure TForm2.UMMyGlobalMessage(var AMessage: TMessage);
begin
Label1.Left := AMessage.WParam;
Label1.Top  := AMessage.LParam;
Form2.Caption := 'Got It!';
end;

Вопрос:
Как обновить список дисков компонента TDriveComboBox, учитывая, что могуд быть
подключены/отключены сетевые диски и произведена "горячая замена" plug&play дисков?

Ответ:
Следующий пример вызывает защищенный (protected) метод класса TDriveComboBox
BuildList() для регеирации списка дисков. (использовая так наз. "class cracer")

Пример:

type
TNewDriveComboBox = class(TDriveComboBox)  //это наш "class cracer"
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Drive : char;
begin
Drive := DriveComboBox1.Drive;
TNewDriveComboBox(DriveComboBox1).BuildList;
    //вызываем защищенный метод родительского класса
DriveComboBox1.Drive := Drive;
end;

Вопрос:
Как программно заставить выпасть меню?

Ответ:
В примере показано как показать меню и выбрать в нем какой-то пункт, эмулируя нажатие "быстрой кдавиши" пункта меню. Если у Вашего пункта меню нет "быстрой клавиши" Вы можете посылать комбинации VK_MENU, VK_LEFT, VK_DOWN, и VK_RETURN, чтобы программно "путешествовать" по меню.
Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
//Allow button to finish painting in response to the click
Application.ProcessMessages;
{Alt Key Down}
keybd_Event(VK_MENU, 0, 0, 0);
{F Key Down - Drops the menu down}
keybd_Event(ord('F'), 0, 0, 0);
{F Key Up}
keybd_Event(ord('F'), 0, KEYEVENTF_KEYUP, 0);
{Alt Key Up}
keybd_Event(VK_MENU, 0, KEYEVENTF_KEYUP, 0);
{F Key Down}
keybd_Event(ord('S'), 0, 0, 0);
{F Key Up}
keybd_Event(ord('S'), 0, KEYEVENTF_KEYUP, 0);
end;

Вопрос:
Как сделать клавишу-акселератор (keyboard shortcut) компонету у которого нет заголовка?

Ответ:
Возможный вариант - присвоить ссылку на этот компонент свойству FocusControl TLabel'а. В примере используется невидимый Label для создания "быстрой" клавиши (Alt+M) компонента Memo. Чтобы использовать пример, разместите на форме компонет TMemo, Label и несколько других компонентов, которые могут принимать фокус ввода. Запустите программу, перевидите фокус ввода куда-нибудь вне Memo и нажмите Alt+M - фокус ввода вернется в Memo.
Пример:

procedure TForm1.FormCreate(Sender: TObject);
begin
Label1.Visible := false;
Label1.Caption := '&M';
Label1.FocusControl := Memo1;
end;

Вопрос:
Можно ли как-то уменьшить мерцание при перерисовке компонента?

Ответ:
Если добавить флаг csOpaque (непрозрачный) к свойству ControlStyle компонента
- то фон компонента перерисовываться не будет.

Пример:

constructor TMyControl.Create;
begin
inherited;
ControlStyle := ControlStyle + [csOpaque];
end;

Вопрос:
Как запретить изменение размера моего компонента в design-time?

Ответ:
Поместите в конструктор компонента код, устанавливающий размеры по умолчанию.
Переопределите метод SetBounds и проверяйте в нем "componentstate". Если компонет
находится режиме "design-time" (csDesigning in ComponentState) просто передавайте
значения ширины и высоты (width и heights) компонента по умолчанию (в нашем
примере 50) методу класса-предка.

Пример:

procedure TVu.SetBounds(ALeft : integer; ATop : integer; AWidth : integer;
    AHeight : integer);
begin
if csdesigning in componentstate then
begin
    AWidth := 50;
    AHeight := 50;
    inherited;  //вызываем унаследованный от предка метод
end;
end;

Вопрос:
Можно ли уменьшить потребляемые компонентами TNotebook и TTabbedNotebook ресурсы?

Ответ:
Да. Можно уничтожать обьекты, расположенные не на текущей странице TNotebook или
TTabbedNotebook. В примере вызывается защищенный (Protected) метод путем создания
так называемый "class cracer'ов".

type TMyTabbedNotebook = class(TTabbedNotebook); //это наш "class cracer"
type TMyNotebook = class(TNotebook);

procedure TForm1.TabbedNotebook1Change(Sender: TObject; NewTab: Integer;
    var AllowChange: Boolean);
begin
with TabbedNotebook1 do  //вызываем защищенный метод родительского класса
    TMyTabbedNotebook(TWinControl(Pages.Objects[PageIndex])).DestroyHandle;
end;

procedure TForm1.TabSet1Change(Sender: TObject; NewTab: Integer;
    var AllowChange: Boolean);
begin
with Notebook1 do //вызываем защищенный метод родительского класса
    TMyNotebook(TWinControl(Pages.Objects[PageIndex])).DestroyHandle;
    NoteBook1.PageIndex := NewTab;
    AllowChange := true
end;

Вопрос:
Функция keybd_event() принимает значения до 244 - как мне отправить нажатие
клавиши с кодом #255 в элемент управления Windows?

Ответ:
Это может понадобится для иностранных языков или для специальных символов. (например,
в русских шрифтах символ с кодом #255 - я прописное). Приведенный в примере метод,
не стоит использовать в случае если символ может быть передан обычным способом
(функцией keybd_event()).

procedure TForm1.Button1Click(Sender: TObject);
var
KeyData : packed record
    RepeatCount : word;
    ScanCode : byte;
    Bits : byte;
end;
begin
{Let the button repaint}
Application.ProcessMessages;
{Set the focus to the window}
Edit1.SetFocus;
{Send a right so the char is added to the end of the line}
//  SimulateKeyStroke(VK_RIGHT, 0);
keybd_event(VK_RIGHT, 0,0,0);
{Let the app get the message}
Application.ProcessMessages;
FillChar(KeyData, sizeof(KeyData), #0);
KeyData.ScanCode := 255;
KeyData.RepeatCount := 1;
SendMessage(Edit1.Handle, WM_KEYDOWN, 255,LongInt(KeyData));
KeyData.Bits := KeyData.Bits or (1 shl 30);
KeyData.Bits := KeyData.Bits or (1 shl 31);
SendMessage(Edit1.Handle, WM_KEYUP, 255, LongInt(KeyData));
KeyData.Bits := KeyData.Bits and not (1 shl 30);
KeyData.Bits := KeyData.Bits and not (1 shl 31);
SendMessage(Edit1.Handle, WM_CHAR, 255, LongInt(KeyData));
Application.ProcessMessages;
end;

Вопрос:
Некоторые компоненты не меняют курсор мыши до тех пор пока пользователь не
сдвинет мышь. Как эмулировать движение мыши?

Ответ:
В примере мышка слегка "подталкивается" без участия пользователя.

procedure TForm1.Button1Click(Sender: TObject);
var
pt : TPoint;
begin
Application.ProcessMessages;
Screen.Cursor := CrHourglass;
GetCursorPos(pt);
SetCursorPos(pt.x + 1, pt.y + 1);
Application.ProcessMessages;
SetCursorPos(pt.x - 1, pt.y - 1);
end;

Вопрос:
Как зарегистрировать расширение файла за своим приложением и контекстное меню,
связанное с этим типом?

Ответ:
Пример регистрирует расширение файла(.myext) - файлы этого типа будут открываться
приложением MyApp.Exe. Также регнстрируется одно действие (action) по умолчанию
для файлов этого типа и два дополнительных пункта контекстного меню, связанного с
этим типом файлов. Возможно, потребуется перезайти в систему чтобы изменения
вступили в силу.

Пример:

uses
Registry;

procedure TForm1.Button1Click(Sender: TObject);
var
R : TRegIniFile;
begin
R := TRegIniFile.Create('');
with R do
    begin
    RootKey := HKEY_CLASSES_ROOT;
    WriteString('.myext','','MyExt');
    WriteString('MyExt','','Some description of MyExt files');
    WriteString('MyExt\DefaultIcon','','C:\MyApp.Exe,0');
    WriteString('MyExt\Shell','','This_Is_Our_Default_Action');
    WriteString('MyExt\Shell\First_Action',
            '','This is our first action');
    WriteString('MyExt\Shell\First_Action\command','',
            'C:\MyApp.Exe /LotsOfParamaters %1');
    WriteString('MyExt\Shell\This_Is_Our_Default_Action','',
            'This is our default action');
    WriteString('MyExt\Shell\This_Is_Our_Default_Action\command',
            '','C:\MyApp.Exe %1');
    WriteString('MyExt\Shell\Second_Action',
            '','This is our second action');
    WriteString('MyExt\Shell\Second_Action\command',
            '','C:\MyApp.Exe /TonsOfParameters %1');
    Free;
    end;
end;