Маленькие хитрости Delphi

(выпуск № 1)


  • Прозрачная надпись на TBitmap.
  • Доступ к колонке-строке grid'а по заголовку.
  • Использование клавиши-акселератора в TTabsheets.
  • Доступ к HKEY_LOCAL_MACHINE под NT без прав администратора.
  • Изменение числа колонок и их ширины в TFileListBox.
  • Настройка табуляции в компоненте TMemo.
  • Перехват нажатия функциональных клавиш и стрелок.
  • Мерцание на DrawCell.
  • Bitmap и текст на TBitBtn.
  • Изменение вида текстового курсора.
  • Ошибка компиляции при вызове метода abort.
  • Цвет букв в стандартных элементах управления Windows.
  • Надпись на компоненте TBitBtn с переносом слов.
  • Изменение стилей шрифта RichEdit нажатиями комбинаций клавиш.
  • Изменение корневого ключа (root key) реестра.
  • Динамическое изменения свойства owner компонента в 'runtime'.
  • Очистка содержимого Canvas'а.
  • Динамическое измененение главной формы приложения в 'runtime' .
  • Программный 'Click' по 'speed button'.
  • Доступ к элементам компонента TRadioGroup.
  • Почему функции рисования Delphi рисуют на один пиксел короче.
  • Как показать подсказки (hints) для элементов меню.
  • Как выяснить состояние списка Combobox.
  • Как удалить каталог вместе с содержимым.
  • Програмное отключение системного меню формы.
  • Выделение RGB компонентов цвета.
  • Номер текущей строки в TMemo.
  • Как проигрывать MPEG файл.
  • Использование анимированного курсора.
  • Как узнать о нажатии клавиши в момент когда показано меню .
  • Как определить наличие сопроцессора.
  • Серийный номер аудио CD.
  • Амперсанд в Windows .
  • Как поместить bitmap в Metafile.
  • Как узнать, что курсор мыши над моей формой.
  • Запущенно ли приложение под Windows NT.
  • Как создать bitmap из пиктогрммы (icon).
  • Отедельный hint для каждой ячейки StringGrid'а.
  • Как внести изменения в код VCL.
  • Эквивалент TwipsPerPixel из VB.
  • Содержимое файла в текущую позицию курсора в TMemo.
  • Перехват нажатия Ctrl-V в TMemo.
  • TEdit с выравниваением текста по правой стороне.
  • Undo в Edit.
  • Переопределение конструктора формы.
  • Цветной текст в TStatusBar.
  • Переделываем TTrackBar.
  • Создание временного canvas'а.
  • Проблема с прозраным glyph'ом.
  • Создание PolyPolygon используя массив точек.
  • Создание невизуальных компонентов без иконок.
  • Нестандартный редактор (например combobox) в ячейке StringGrid .
  • Есть ли в CD-ROM Audio CD.
  • Есть ли у мыши колесико.
  • Определение нажатия клавиши tab.
  • Отличие между Create(Self) и Create(Application).
  • Определение поддерживает ли обьект заданное свойство.
  • Показываем секунды и минуты Audio CD.
  • Рисуем на рамке.
  • Работаем когда приложение бездельничает.
  • Radiogroup и фокус ввода.
  • Картинки в TPopUpMenu.
  • Как узнать число кадров AVI файла.
  • Фиксированные колонки в TDbGrid.
  • Показ dbgrid в режиме disabled.
  • Как узнать нажаты ли клавиши Shift, Ctrl, Alt .
  • Как изменить шрифт подсказки (hint'а).
  • Эквивалент функции SendKeys Visual Basic'а.
  • Динамическое рисование прозрачных картинок TImageList.
  • Бесконечная музыка из TMediaPlayer.
  • Ошибка 'There are no fonts installed'.
  • Смена дисковода, откуда MediaPlayer проигрывает аудио CD.
  • Как убрать кнопку с названием моей программы из Панели Задач.
  • Преобразование цвета в строку - название цвета VCL .
  • Выравнивание максимизированное формы.
  • Как заставить TEdit не 'пикать'.
  • Получение списка всех компонентов, расположенных на TNoteBook.
  • Эквивалент escape codes из С.
  • Как показать первый кадр AVI-файла.
  • Переключить TListView в режим редактирования нажатием клавиш.
  • Уничтожение обьекта, сохраненного в списке TStrings.
  • Using Resident Font.
  • Путь к каталогу откуда была установленна Windows.
  • Строка сообщения об ошибке Windows.
  • Еще более строгая проверка типов.
  • VK_Key для A-Z и 0-9.
  • Изменение оконной процедуры TForm.
  • Размеры TComboBox с показанным выпадающим списком.
  • Меню в стиле Delphi 4.
  • Режим вставка-замена в TMemo и TEdit.
  • Сообщение сразу всем элементам управления формы.
  • Свойство selected Listbox'а.
  • Ограничение длинны текста, вводимого в TEdit.
  • Сохранение обьекта TFont в реестре.
  • Перемещать компонент мышкой в 'runtime'.
  • Ошибка при создании обьекта класса TPrinter.
  • Перехват событий в неклиентской области формы.
  • Как нарисовать пиктограмму (icon) с увеличением.
  • Автоматическая ширина колонок в StringGrid.
  • TTimer работает не достаточно точно.
  • Как поместить JPEG-картинку в exe-файл.
  • Перехват сообщений прокрутки в TScrollBox.
  • Прямоугольник для выделения части рисунка.
  • Использование пиктограммы (Icon) как картинки на TSpeedButton.
  • Прозрачная фоновая картинка на компоненте CoolBar.
  • Отключение мигания ползунока компонента TScrollBar.
  • Установить курсор в нужную позицию ячейки DBGrid.
  • Как поместить курсор в определенную позицию edit'а.
  • Реагируем на минимизацию-максимизацию формы.
  • Показ формы без передачи ей фокуса ввода.
  • Удаление дисков из списка TDriveComboBox.
  • Сообщение всем формам приложения о глобальных изменениях.
  • Обновить список дисков компонента TDriveComboBox.
  • Как программно заставить выпасть меню.
  • Клавиша-акселератор для компонета у которого нет заголовка.
  • Уменьшение мерцания при перерисовке компонента.
  • Как запретить изменение размера моего компонента в design-time.
  • Уменьшение ресурсов потребляемых TNotebook и TTabbedNotebook.
  • Эмуляция нажатия клавиши с кодом #255.
  • Как программно эмулировать движение мыши.
  • Как зарегистрировать новый тип файла за своим приложением.
    Как разместить прозрачную надпись на TBitmap?
    procedure TForm1.Button1Click(Sender: TObject);
    var
      OldBkMode : integer;
    begin
      Image1.Picture.Bitmap.Canvas.Font.Color := clBlue;
      OldBkMode := SetBkMode(Image1.Picture.Bitmap.Canvas.Handle,
                                                       TRANSPARENT);
      Image1.Picture.Bitmap.Canvas.TextOut(10, 10, 'Hello');
      SetBkMode(Image1.Picture.Bitmap.Canvas.Handle,OldBkMode);
    end;
    
    Наверх к содержанию
    Можно ли обратиться к колонке или строке grid'а по заголовку?

    В следующем примере приведены две функции: GetGridColumnByName() и GetGridRowByName(), которые возвращают колонку или строку, имеющую заданный заголовок (caption).

    procedure TForm1.FormCreate(Sender: TObject);
    begin
      StringGrid1.Rows[1].Strings[0] := 'This Row';
      StringGrid1.Cols[1].Strings[0] := 'This Column';
    end;
    
    function GetGridColumnByName(Grid:TStringGrid;ColName:string):integer;
    var
      i : integer;
    begin
      for i := 0 to Grid.ColCount - 1 do
        if Grid.Rows[0].Strings[i] = ColName then 
          begin
            Result := i;
            exit;
          end;
      Result := -1;
    end;
    
    function GetGridRowByName(Grid: TStringGrid; RowName: string): integer;
    var
      i : integer;
    begin
      for i := 0 to Grid.RowCount - 1 do
        if Grid.Cols[0].Strings[i] = RowName then
          begin
            Result := i;
            exit;
          end;
      Result := -1;
    end;
    
    procedure TForm1.Button1Click(Sender: TObject);
    var
      Column : integer;
      Row : integer;
    begin
      Column := GetGridColumnByName(StringGrid1, 'This Column');
      if Column = -1 then
        ShowMessage('Column not found')
      else
        ShowMessage('Column found at ' + IntToStr(Column));
      Row := GetGridRowByName(StringGrid1, 'This Row');
      if Row = -1 then
        ShowMessage('Row not found')
      else
        ShowMessage('Row found at ' + IntToStr(Row));
    end;
    
    Наверх к содержанию
    Как использовать клавишу-акселератор в TTabsheets? Я добавляю клавишу-акселератор в заголовок каждого Tabsheet моего PageControl, но при попытке переключать страницы этой клавишей программа пикает и ничего не происходит.

    Можно перехватить сообщение CM_DIALOGCHAR.

    type
      TForm1 = class(TForm)
        PageControl1: TPageControl;
        TabSheet1: TTabSheet;
        TabSheet2: TTabSheet;
        TabSheet3: TTabSheet;
      private
        {Private declarations}
        procedure CMDialogChar(var Msg:TCMDialogChar);
        message CM_DIALOGCHAR;
      public
        {Public declarations}
    end;
    
    var
      Form1: TForm1;
    
    implementation
    {$R *.DFM}
    procedure TForm1.CMDialogChar(var Msg:TCMDialogChar);
    var
      i : integer;
    begin
      with PageControl1 do
      begin
        if Enabled then
          for i := 0 to PageControl1.PageCount - 1 do
            if ((IsAccel(Msg.CharCode, Pages[i].Caption)) and
              (Pages[i].TabVisible)) then 
            begin
              Msg.Result:=1;
              ActivePage := Pages[i];
              exit;
            end;
      end;
      inherited;
    end;
    
    Наверх к содержанию
    Доступ к HKEY_LOCAL_MACHINE под NT без прав администратора.
    При использованиии компонента TRegistry под NT пользователь с правами доступа ниже чем "администратор" не может получить доступа к информации реестра в ключе HKEY_LOCAL_MACHINE. Как это обойти?

    Проблема вызвана тем, что TRegistry всегда открывает реестр с параметром KEY_ALL_ACCESS (полный доступ), даже если необходим доступ KEY_READ (только чтение). Избежать этого можно используя функции API для работы с реестром (RegOpenKey и т.п.), или создать новый класс из компонента TRegestry, и изменить его так чтобы можно было задавать режим открытия реестра.

    Наверх к содержанию
    Можно ли изменить число колонок и их ширину в компоненте TFileListBox?

    В приведенном примере FileListBox приводится к типу TDirectoryListBox - таким образом можно добавиь дополнительные колонки.

    with TDirectoryListBox(FileListBox1) do 
      begin
        Columns := 2;
        SendMessage(Handle, LB_SETCOLUMNWIDTH, 
                    Canvas.TextWidth('WWWWWWWW.WWW'),0);
      end;
    
    Наверх к содержанию
    Как настроить табуляцию в компоненте TMemo?

    Пошлите в Memo сообщение EM_SETTABSTOPS. Например установим первую позицию табуляции на 20-й пиксел.

    procedure TForm1.FormCreate(Sender: TObject);
    var
      DialogUnitsX : LongInt;
      PixelsX : LongInt;
      i : integer;
      TabArray : array[0..4] of integer;
    begin
      Memo1.WantTabs := true;
      DialogUnitsX := LoWord(GetDialogBaseUnits);
      PixelsX := 20;
      for i := 1 to 5 do
      begin
        TabArray[i - 1] :=((PixelsX * i ) * 4) div DialogUnitsX;
      end;
      SendMessage(Memo1.Handle,
      EM_SETTABSTOPS,5,LongInt(@TabArray));
      Memo1.Refresh;
    end;
    
    Наверх к содержанию
    Как перехватить нажатия функциональных клавиш и стрелок?

    Проверяйте значение переменной key на равенство VK_RIGHT, VK_LEFT, VK_F1 и т.д. на событии KeyDown формы.

    procedure TForm1.FormKeyDown(Sender: TObject; 
                     var Key: Word; Shift: TShiftState);
    begin
      if Key = VK_RIGHT then
        Form1.Caption := 'Right';
      if Key = VK_F1 then
        Form1.Caption := 'F1';
    end;
    
    Наверх к содержанию
    Мерцание на DrawCell.
    При обработке события DrawCell компонента DrawGrid я пишу Font.Color := clRed; и получаю бесконечный цикл мерцаний. Почему?

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

    If (Row = 0) then
      begin
        DrawGrid1.Canvas.Font.Color := clRed;
        DrawGrid1.Canvas.TextOut(Rect.Left,Rect.Top, 
                                 IntToStr(Col));
      end;
    
    Наверх к содержанию
    Bitmap и текст на Bitmap
    При использовании BitBtn Caption(текст) и картинка(bitmap) из файла не видны одновременно. Почему?

    Это может происходить если картинка слишком велика. Класс TBitBtn сначала рисует картинку, а затем выводит текст над, под, слева или справа от картинки (в завивимости от свойства Layout). Если размер картинки такой же как у всей кнопки для вывода текста просто не остается места. Если Вам нужно получить кнопку такого же размера как Ваша картинка и видеть при этом надпись на кнопке Вам придется выводить текст надписи непосредственно на канву картинки.

    var
      bm : TBitmap;
      OldBkMode : integer;
    begin
      bm := TBitmap.Create;
      bm.Width := BitBtn1.Glyph.Width;
      bm.Height := BitBtn1.Glyph.Height;
      bm.Canvas.Draw(0, 0, BitBtn1.Glyph);
      OldBkMode := SetBkMode(bm.Canvas.Handle, Transparent);
      bm.Canvas.TextOut(0, 0, 'The Caption');
      SetBkMode(bm.Canvas.Handle, OldBkMode);
      BitBtn1.Glyph.Assign(bm);
    end;
    
    Наверх к содержанию
    Изменение внешнего вида текстового курсора
    Можно ли изменить вид текстового курсора (каретки) edit'а или другого элемента управления Windows?

    Можно! В примере показано как создать два цветных "bitmap'а": "улыбчивый" и "хмурый" и присвоить их курсору edit'а. Для этого нужно перехватить оконную процедуру edit'а. Чтобы сделать это заменим адрес оконной процедуры Edit'а нашим собственным, а старую оконную процедуру будем вызывать по необходимости. Пример показывает "улыбчивый" курсор при наборе текста и "хмурый" при забое клавишей backspace.

    unit caret1;
    
    interface
    
    {$IFDEF WIN32}
    uses Windows, Messages, SysUtils, Classes, Graphics, 
         Controls, Forms, Dialogs, StdCtrls;
    {$ELSE}
    uses WinTypes, WinProcs, Messages, SysUtils, Classes, 
         Graphics, Controls, Forms, Dialogs, StdCtrls;
    {$ENDIF}
    
    type
      TForm1 = class(TForm)
        Edit1: TEdit;
        procedure FormCreate(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
      private
        {Private declarations}
      public
        {Public declarations}
        CaretBm : TBitmap;
        CaretBmBk : TBitmap;
        OldEditsWindowProc : Pointer;
    end;
    
    var
      Form1: TForm1;
    
    implementation
    {$R *.DFM}
    
    type
    {$IFDEF WIN32}
      WParameter = LongInt;
    {$ELSE}
      WParameter = Word;
    {$ENDIF}
      LParameter = LongInt;
    
    {New windows procedure for the edit control}
    function NewWindowProc(WindowHandle: hWnd; 
             TheMessage: WParameter; ParamW : WParameter;
             ParamL : LParameter) : LongInt 
             {$IFDEF WIN32} stdcall; {$ELSE}; export; {$ENDIF}
    begin
      {Call the old edit controls windows procedure}
      NewWindowProc := CallWindowProc(Form1.OldEditsWindowProc, 
                       WindowHandle, TheMessage, ParamW, ParamL);
      if TheMessage = WM_SETFOCUS then
      begin
        CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0);
        ShowCaret(WindowHandle);
      end;
      if TheMessage = WM_KILLFOCUS then
      begin
        HideCaret(WindowHandle);
        DestroyCaret;
      end;
      if TheMessage = WM_KEYDOWN then
      begin
        if ParamW = VK_BACK then
          CreateCaret(WindowHandle, Form1.CaretBmBk.Handle, 0, 0)
        else
          CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0);
        ShowCaret(WindowHandle);
      end;
    end;
    
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      {Create a smiling bitmap using the wingdings font}
      CaretBm := TBitmap.Create;
      CaretBm.Canvas.Font.Name := 'WingDings';
      CaretBm.Canvas.Font.Height := Edit1.Font.Height;
      CaretBm.Canvas.Font.Color := clWhite;
      CaretBm.Width := CaretBm.Canvas.TextWidth('J') + 2;
      CaretBm.Height := CaretBm.Canvas.TextHeight('J') + 2;
      CaretBm.Canvas.Brush.Color := clBlue;
      CaretBm.Canvas.FillRect(Rect(0, 0, CaretBm.Width, 
                                   CaretBm.Height));
      CaretBm.Canvas.TextOut(1, 1, 'J');
      {Create a frowming bitmap using the wingdings font}
      CaretBmBk := TBitmap.Create;
      CaretBmBk.Canvas.Font.Name := 'WingDings';
      CaretBmBk.Canvas.Font.Height := Edit1.Font.Height;
      CaretBmBk.Canvas.Font.Color := clWhite;
      CaretBmBk.Width := CaretBmBk.Canvas.TextWidth('L') + 2;
      CaretBmBk.Height := CaretBmBk.Canvas.TextHeight('L') + 2;
      CaretBmBk.Canvas.Brush.Color := clBlue;
      CaretBmBk.Canvas.FillRect(Rect(0,0, CaretBmBk.Width, 
                                     CaretBmBk.Height));
      CaretBmBk.Canvas.TextOut(1, 1, 'L');
      {Hook the edit controls window procedure}
      OldEditsWindowProc := Pointer(SetWindowLong(Edit1.Handle,
                            GWL_WNDPROC, LongInt(@NewWindowProc)));
    end;
    
    procedure TForm1.FormDestroy(Sender: TObject);
    begin
    {Unhook the edit controls window procedure and clean up}
      SetWindowLong(Edit1.Handle,GWL_WNDPROC, 
                    LongInt(OldEditsWindowProc));
      CaretBm.Free;
      CaretBmBk.Free;
    end;
    
    Наверх к содержанию
    Ошибка компиляции при вызове метода abort.
    При использовании модулей доступа к BDE (DbiTypes, DbiProcs, DbiErrs), любая попытка вызвать процедуру abort выдает ошибку при компиляции при вызове метода abort "Statement expected, but expression of type 'Integer' found". Я пытался найти DbiTypes.pas, DbiProcs.pas и DbiErrs.pas чтобы разобраться но не нашел этих файлов. Где расположены эти файлы и как обойти ошибку?

    Модули DbiTypes, DbiProcs, DbiErrs это псевдонимы модуля "BDE", обьявлены в Projects->Options->Directories/Conditionals->Unit Aliases. Исходник модуля DBE находится в каталоге "doc" и называется "BDE.INT". В этом файле обьявленна константа ABORT со значением -2. Так как Вы хотите использовать процедуру Abort(), которая обьявлена в модуле SysUtils, Вам нужно добавить префикс SysUtils перед вызовом процедуры Abort.

    SysUtils.Abort;
    
    Наверх к содержанию
    Цвет букв в стандартных элементах управления Windows.
    Почему при изменении цвета букв StatusBar'а ничего не происходит?

    Status bar - стандартный элемент управления Windows, и соответственно цвет его букв - значение clBtnText которое изменяется с помощью настроек в Control Panel. Этот цвет черный по умолчанию и может изменяться в зависимости от выбранной цветовой схемы. Другие стандартные элемент управления Windows, например кнопки, также имеют цвет букв, настраиваемый из ControlPanel. StatusBar и его панели имеют свойство "owner-draw", позволяющее Вам использовать любой цвет букв.

    procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
                       Panel: TStatusPanel; const Rect: TRect);
    begin
      if Panel = StatusBar.Panels[0] then
        begin
          StatusBar.Canvas.Font.Color := clRed;
          StatusBar.Canvas.TextOut(Rect.Left, Rect.Top, 'Panel - 0')
        end 
        else
        begin
          StatusBar.Canvas.Font.Color := clGreen;
          StatusBar.Canvas.TextOut(Rect.Left, Rect.Top, 'Panel - 1');
        end;
    end;
    
    Наверх к содержанию
    Как сделать многострочную надпись на TBitBtn?

    Выводите текст надписи непосредственно на "glyph" TBitBtn'а. См. пример.

    procedure TForm1.FormCreate(Sender: TObject);
    var
      R : TRect;
      N : Integer;
      Buff : array[0..255] of Char;
    begin
      with BitBtn1 do
        begin
          Caption := 'A really really long caption';
          Glyph.Canvas.Font := Self.Font;
          Glyph.Width  := Width - 6;
          Glyph.Height := Height - 6;
          R := Bounds(0, 0, Glyph.Width, 0);
          StrPCopy(Buff, Caption);
          Caption := '';
          DrawText(Glyph.Canvas.Handle,Buff,StrLen(Buff),R,
            DT_CENTER or DT_WORDBREAK or DT_CALCRECT);
          OffsetRect(R,(Glyph.Width - R.Right) div 2,
              (Glyph.Height - R.Bottom) div 2);
          DrawText(Glyph.Canvas.Handle,Buff,StrLen(Buff),R,
            DT_CENTER or DT_WORDBREAK);
        end;
    end;
    
    Наверх к содержанию
    Надпись на компоненте TBitBtn с переносом слов.
    Как изменить стиль шрифта RichEdit нажатиями соответствующих комбинаций клавиш? (например включить курсив по нажатию Ctrl + I)

    В примере стили шрифта меняются по нажатию след. комбинаций клавиш
    Ctrl + B - вкл/выкл жирного шрифта
    Ctrl + I - вкл/выкл наклонного шрифта
    Ctrl + S - вкл/выкл зачеркнутого шрифта
    Ctrl + U - вкл/выкл подчеркнутого шрифта

    const
      KEY_CTRL_B = 02;
      KEY_CTRL_I =  9;
      KEY_CTRL_S = 19;
      KEY_CTRL_U = 21;
    
    procedure TForm1.RichEdit1KeyPress(Sender: TObject; 
                                       var Key: Char);
    begin
      case Ord(Key) of
      KEY_CTRL_B: 
        begin
          Key := #0;
            if fsBold in (Sender as TRichEdit).SelAttributes.Style then
              (Sender as TRichEdit).SelAttributes.Style :=
              (Sender as TRichEdit).SelAttributes.Style - [fsBold]
            else
              (Sender as TRichEdit).SelAttributes.Style :=
              (Sender as TRichEdit).SelAttributes.Style + [fsBold];
        end;
      KEY_CTRL_I:
        begin
          Key := #0;
            if fsItalic in (Sender as TRichEdit).SelAttributes.Style then
              (Sender as TRichEdit).SelAttributes.Style :=
              (Sender as TRichEdit).SelAttributes.Style - [fsItalic]
            else
              (Sender as TRichEdit).SelAttributes.Style :=
              (Sender as TRichEdit).SelAttributes.Style + [fsItalic];
        end;
      KEY_CTRL_S:
        begin
          Key := #0;
          if fsStrikeout in (Sender as TRichEdit).SelAttributes.Style then
            (Sender as TRichEdit).SelAttributes.Style :=
            (Sender as TRichEdit).SelAttributes.Style-[fsStrikeout]
          else
            (Sender as TRichEdit).SelAttributes.Style :=
            (Sender as TRichEdit).SelAttributes.Style+[fsStrikeout];
        end;
      KEY_CTRL_U:
        begin
          Key := #0;
          if fsUnderline in (Sender as TRichEdit).SelAttributes.Style then
            (Sender as TRichEdit).SelAttributes.Style :=
            (Sender as TRichEdit).SelAttributes.Style-[fsUnderline]
          else
            (Sender as TRichEdit).SelAttributes.Style :=
            (Sender as TRichEdit).SelAttributes.Style+[fsUnderline];
        end;
      end;
    end;
    
    Наверх к содержанию
    Изменение корневого ключа (root key) реестра.
    В документации компонента TRegIniFile говорится, что можно изменять корневой ключ (root key). Я пытаюсь это сделать но ничего не получается.

    См. пример.

    uses Registry;
    
    procedure TForm1.Button1Click(Sender: TObject);
    var
      WinIni : TRegIniFile;
    begin
      WinIni := TRegIniFile.Create('');
      WinIni.RootKey := HKEY_LOCAL_MACHINE;
      WinIni.WriteString('Frank','Borland','Writes Fast Code!');
      WinIni.Free;
    end;
    
    Наверх к содержанию
    Динамическое изменения свойства owner компонента в 'runtime'.
    Можно ли динамически изменять свойство "owner" компонента во время выполнения программы?

    Вы можете менять свойство "owner" и после создания компонента с помощью методов InsertComponent() и RemoveComponent().

    Наверх к содержанию
    Как очистить содержимое Canvas'а?

    Просто нарисуйте прямоугольник любого цвета.

    Canvas.Brush.Color := ClWhite;
    Canvas.FillRect(Canvas.ClipRect);
    
    Наверх к содержанию
    Динамическое измененение главной формы приложения в 'runtime'.
    Можно ли динамически менять какая форма считается главной в приложении во время работы программы?

    Можно, но только во время загрузки приложения. Чтобы сделать это выберите "View->Project Source" и измените код инициализации приложения, так что порядок создания форм зависил от какого-то условия.
    Примечание: Вам придется редактировать этот код, если Вы добавите в приложение новые формы.

    begin
      Application.Initialize;
      if <какое-то условие> then 
        begin
          Application.CreateForm(TForm1, Form1);
          Application.CreateForm(TForm2, Form2);
        end 
      else 
        begin
          Application.CreateForm(TForm2, Form2);
          Application.CreateForm(TForm1, Form1);
        end;
    end.
    Application.Run;
    
    Наверх к содержанию
    Программный 'Click' по 'speed button'.
    Как программно "щелкнуть" по компоненту speed button? Я пытался использовать SendMessage но у Speedbuttons нет "handle".

    В примере используется метод Perform класса TControl для отправки сообщения.

    procedure TForm1.SpeedButton1Click(Sender: TObject);
    begin
      ShowMessage('clicked');
    end;
    
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      SpeedButton1.Perform(WM_LBUTTONDOWN, 0, 0);
      SpeedButton1.Perform(WM_LBUTTONUP, 0, 0);
    end;
    
    Наверх к содержанию
    Доступ к элементам компонента TRadioGroup.
    Можно ли отключить определенный элемент в RadioGroup?

    В примере показано как получить доступ к отдельным элементам компонента TRadioGroup.

    procedure TForm1.Button1Click(Sender: TObject);
    begin
      TRadioButton(RadioGroup1.Controls[1]). Enabled := False;
    end;
    
    Наверх к содержанию
    Почему функции рисования Delphi рисуют на один пиксел короче.
    Почему методы рисования Delphi (например MoveTo и LineTo) рисуют на один пиксел короче?

    Так работает большинство графических систем, включая Windows. Библиотека VCL просто передает вызовы в функции GDI. Если Вы хотите нарисовать линию с последним пикселом включительно просто добавте единицу к координатам.

    Наверх к содержанию
    Как показать подсказки "hints" для элементов меню?

    В примере создается обработчик события Application.Hint - подсказки меню изображаются на status panel.

    type
      TForm1 = class(TForm)
        Panel1: TPanel;
        MainMenu1: TMainMenu;
        MenuItemFile: TMenuItem;
        MenuItemOpen: TMenuItem;
        MenuItemClose: TMenuItem;
        OpenDialog1: TOpenDialog;
        procedure FormCreate(Sender: TObject);
        procedure MenuItemCloseClick(Sender: TObject);
        procedure MenuItemOpenClick(Sender: TObject);
      private
        {Private declarations}
        procedure HintHandler(Sender: TObject);
      public
        {Public declarations}
    end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.DFM}
    
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      Panel1.Align := alBottom;
      MenuItemFile.Hint := 'File Menu';
      MenuItemOpen.Hint := 'Opens A File';
      MenuItemClose.Hint := 'Closes the Application';
      Application.OnHint := HintHandler;
    end;
    
    procedure TForm1.HintHandler(Sender: TObject);
    begin
      Panel1.Caption := Application.Hint;
    end;
    
    procedure TForm1.MenuItemCloseClick(Sender: TObject);
    begin
      Application.Terminate;
    end;
    
    procedure TForm1.MenuItemOpenClick(Sender: TObject);
    begin
      if OpenDialog1.Execute then
        Form1.Caption := OpenDialog1.FileName;
    end;
    
    Наверх к содержанию
    Как опеделить состояние списка ComboBox, выпал/скрыт?

    Пошлите ComboBox сообщение CB_GETDROPPEDSTATE.

    if SendMessage(ComboBox1.Handle, CB_GETDROPPEDSTATE,0,0) = 1 then
      begin 
        {список ComboBox выпал}
      end;
    
    Наверх к содержанию
    Как удалить каталог вместе со всеми содержащимися в нем файлами?

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

    procedure TForm1.Button1Click(Sender: TObject);
    var
      DirInfo: TSearchRec;
      r: integer;
    begin
      r := FindFirst('C:\Download\*.*', FaAnyfile, DirInfo);
      while r = 0 do
      begin
        if ((DirInfo.Attr and FaDirectory <> FaDirectory) and
          (DirInfo.Attr and FaVolumeId <> FaVolumeID)) then
        if DeleteFile(pChar('C:\Download\'+DirInfo.Name))=false then
          ShowMessage('Unable to delete: C:\Download\'+DirInfo.Name);
        r := FindNext(DirInfo);
      end;
      SysUtils.FindClose(DirInfo);
      if RemoveDirectory('C:\Download\') = false then
        ShowMessage('Unable to delete directory: C:\Download\');
    end;
    
    Наверх к содержанию
    Програмное отключение системного меню формы.
    Как отключить системное меню формы и кнопки Minimize, Maximize, and Close во время выполнения(Runtime)?

    В приведенном примере показано как это сделать:

    procedure TForm1.Button1Click(Sender: TObject);
    begin
      {Disable}
      Form1.BorderIcons := Form1.BorderIcons - [biSystemMenu, 
                                     biMinimize, biMaximize];
    end;
    
    procedure TForm1.Button2Click(Sender: TObject);
    begin
      {Enable}
      Form1.BorderIcons := Form1.BorderIcons + [biSystemMenu, 
                                     biMinimize, biMaximize];
    end;
    
    Наверх к содержанию
    Выделение RGB компонентов цвета.
    Как извлечь Red, Green, и Blue компонент из определенного цвета?

    Используйте функции Window API Get RValue(), GetGValue(), и GetBValue().

    procedure TForm1.Button1Click(Sender: TObject);
    begin
     Form1.Canvas.Pen.Color := clRed;
     Memo1.Lines.Add('R:= '+IntToStr(GetRValue(Form1.Canvas.Pen.Color)));
     Memo1.Lines.Add('G:= '+IntToStr(GetGValue(Form1.Canvas.Pen.Color)));
     Memo1.Lines.Add('B:= '+IntToStr(GetBValue(Form1.Canvas.Pen.Color)));
    end;
    
    Наверх к содержанию
    Как определить номер текущей строки в TMemo?

    Чтобы определить номер текущей строки любого объекта управления Edit - пошлите ей сообщение EM_LINEFROMCHAR

    procedure TForm1.Button1Click(Sender: TObject);
    var
      LineNumber : integer;
    begin
      LineNumber := SendMessage(Memo1.Handle, EM_LINEFROMCHAR, word(-1),0);
      ShowMessage(IntToStr(LineNumber));
    end;
    
    Наверх к содержанию
    Как проиграть MPEG файл в Delphi-программе?

    Если в системе Windows MMSystem установлен декодер MPEG - используя компонент TMediaPlayer

    procedure TForm1.Button1Click(Sender: TObject);
    begin
      MediaPlayer1.Filename := 'C:\DownLoad\rsgrow.mpg';
      MediaPlayer1.Open;
      MediaPlayer1.Display := Panel1;
      MediaPlayer1.DisplayRect := Panel1.ClientRect;
      MediaPlayer1.Play;
    end;
    
    Наверх к содержанию
    Как использовать анимированный курсор?

    Во первых необходимо получит handle курсора, а затем определить его в массиве курсоров компонента TScreen. Индексы предопределенных курсоров системы отрицательны, пользователь может определить курсор, индекс которого положителен.

    procedure TForm1.Button1Click(Sender: TObject);
    var
      h : THandle;
    begin
      h := LoadImage(0, 'C:\TheWall\Magic.ani', IMAGE_CURSOR, 
                    0, 0, LR_DEFAULTSIZE or LR_LOADFROMFILE);
      if h = 0 then
        ShowMessage('Cursor not loaded')
      else
        begin
          Screen.Cursors[1] := h;
          Form1.Cursor := 1;
        end;
    end;
    
    Наверх к содержанию
    Как узнать о нажатии "non-menu" клавиши в момент когда меню показано?

    Создайте обработчик сообщения WM_MENUCHAR.

    unit Unit1;
    interface
    uses Windows, Messages, SysUtils, Classes, Graphics, 
                        Controls, Forms, Dialogs, Menus;
    type 
      TForm1 = class(TForm)
        MainMenu1: TMainMenu;
        One1: TMenuItem;
        Two1: TMenuItem;
        THree1: TMenuItem;
      private
        {Private declarations}
        procedure WmMenuChar(var m: TMessage); message WM_MENUCHAR;
      public
        {Public declarations}
    end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.DFM}
    
    procedure TForm1.WmMenuChar(var m : TMessage);
    begin
      Form1.Caption := 'Non standard menu key pressed';
      m.Result := 1;
    end;
    
    end.
    
    Наверх к содержанию
    Как определить наличие сопроцессора?

    В отличие от общепринятого мнения не все клоны 486/586/686/ и Pentium имеют сопроцессор для вычислений с плавающей запятой. В примере определяется наличие сопроцессора и под Win16 и под Win32.

    {$IFDEF WIN32}
    
    uses Registry;
    
    {$ENDIF}
    
    function HasCoProcesser : bool;
    {$IFDEF WIN32}
    var
      TheKey : hKey;
    {$ENDIF}
    begin
      Result := true;
      {$IFNDEF WIN32}
      if GetWinFlags and Wf_80x87 = 0 then
      Result := false;
      {$ELSE}
      if RegOpenKeyEx(HKEY_LOCAL_MACHINE,
      'HARDWARE\DESCRIPTION\System\FloatingPointProcessor',0,
      KEY_EXECUTE, TheKey) <> ERROR_SUCCESS then result := false;
      RegCloseKey(TheKey);
    {$ENDIF}
      end;
    
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      if HasCoProcesser then
        ShowMessage('Has CoProcessor') 
      else
        ShowMessage('No CoProcessor - Windows Emulation Mode');
    end;
    
    Наверх к содержанию
    Как узнать серийный номер аудио CD?

    CD может иметь или не иметь серийный номер и/или универсальный код продукта (Universal Product Code). MCI-расширение Windows предоставляет эту информации с помощью комманды MCI_INFO_MEDIA_IDENTITY command. Эта команда возвращает уникальную ID-строку.

    uses MMSystem, MPlayer;
    
    procedure TForm1.Button1Click(Sender: TObject);
    var
      mp : TMediaPlayer;
      msp : TMCI_INFO_PARMS;
      MediaString : array[0..255] of char;
      ret : longint;
    begin
      mp := TMediaPlayer.Create(nil);
      mp.Visible := false;
      mp.Parent := Application.MainForm;
      mp.Shareable := true;
      mp.DeviceType := dtCDAudio;
      mp.FileName := 'D:';
      mp.Open;
      Application.ProcessMessages;
      FillChar(MediaString, sizeof(MediaString), #0);
      FillChar(msp, sizeof(msp), #0);
      msp.lpstrReturn := @MediaString;
      msp.dwRetSize := 255;
      ret := mciSendCommand(Mp.DeviceId, MCI_INFO, 
                            MCI_INFO_MEDIA_IDENTITY, longint(@msp));
      if Ret <> 0 then
        begin
          MciGetErrorString(ret, @MediaString, sizeof(MediaString));
          Memo1.Lines.Add(StrPas(MediaString));
        end
      else
        Memo1.Lines.Add(StrPas(MediaString));
      mp.Close;
      Application.ProcessMessages;
      mp.free;
    end;
    end.
    
    Наверх к содержанию
    Как вывести на элемент управления (Window control) текст, содержащий амперсанд - & ?

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

    Button1.Caption := 'Черное && Белое';
    
    Наверх к содержанию
    Как поместить bitmap в Metafile?

    См. пример

    procedure TForm1.Button1Click(Sender: TObject);
    var
      m : TmetaFile;
      mc : TmetaFileCanvas;
      b : tbitmap;
    begin
      m := TMetaFile.Create;
      b := TBitmap.create;
      b.LoadFromFile('C:\SomePath\SomeBitmap.BMP');
      m.Height := b.Height;
      m.Width := b.Width;
      mc := TMetafileCanvas.Create(m, 0);
      mc.Draw(0, 0, b);
      mc.Free;
      b.Free;
      m.SaveToFile('C:\SomePath\Test.emf');
      m.Free;
      Image1.Picture.LoadFromFile('C:\SomePath\Test.emf');
    end;
    
    Наверх к содержанию
    Как узнать, что курсор мыши над моей формой?

    Можно использовать функцию GetCapture() из Windows API.
    Примечание: Cм. документацию Windows для информации об ограничениях функции GetCapture.

    procedure TForm1.FormDeactivate(Sender: TObject);
    begin
      ReleaseCapture;
    end;
    
    procedure TForm1.FormMouseMove(Sender: TObject; 
                     Shift: TShiftState; X, Y: Integer);
    begin
      If GetCapture = 0 then
        SetCapture(Form1.Handle);
      if PtInRect(Rect(Form1.Left,Form1.Top,
          Form1.Left + Form1.Width, Form1.Top + Form1.Height), 
          ClientToScreen(Point(x, y))) then
        Form1.Caption := 'Мышка над формой!'
      else
        Form1.Caption := 'Мышка вне формы...';
    end;
    
    Наверх к содержанию
    Как программно определить, что приложение работает под Windows NT?

    См. пример

    function IsNT : bool;
    var
      osv : TOSVERSIONINFO;
    begin
      result := true;
      GetVersionEx(osv);
      if osv.dwPlatformId = VER_PLATFORM_WIN32_NT then exit;
      result := false;
    end;
    
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      if IsNt then
        ShowMessage('Running on NT')
      else
        ShowMessage('Not Running on NT');
    end;
    
    Наверх к содержанию
    Как создать bitmap из пиктогрммы (icon)?

    Используя Bitmap.Canvas.Draw нарисуйте пиктограмму на Bitmap'е.

    procedure TForm1.Button1Click(Sender: TObject);
    var
      TheIcon : TIcon;
      TheBitmap : TBitmap;
    begin
        TheIcon := TIcon.Create;
        TheIcon.LoadFromFile('C:\Borland\IcoCur32\EARTH.ICO');
        TheBitmap := TBitmap.Create;
        TheBitmap.Height := TheIcon.Height;
        TheBitmap.Width := TheIcon.Width;
        TheBitmap.Canvas.Draw(0, 0, TheIcon);
        Form1.Canvas.Draw(10, 10, TheBitmap);
        TheBitmap.Free;
        TheIcon.Free;
      end;
    
    Наверх к содержанию
    Как создать отдельную подсказку (hint) для каждой ячейки StringGrid?

    В приведенном примере отслеживается движение курсора мыши - при перемещении между ячейками StringGrid'а - появляется окно подсказки(hint), показываеющее номер текущей строки и колонки.

    type
      TForm1 = class(TForm)
        StringGrid1: TStringGrid;
        procedure StringGrid1MouseMove(Sender: TObject;
        Shift: TShiftState; X, Y: Integer);
        procedure FormCreate(Sender: TObject);
      private
      {Private declarations}
        Col : integer;
        Row : integer;
      public
      {Public declarations}
       end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.DFM}
    
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      StringGrid1.Hint := '0 0';
      StringGrid1.ShowHint := True;
    end;
    
    procedure TForm1.StringGrid1MouseMove(Sender: TObject; 
                       Shift: TShiftState; X, Y: Integer);
    var
      r : integer;
      c : integer;
    begin
      StringGrid1.MouseToCell(X, Y, C, R);
      with StringGrid1 do
        begin
          if ((Row <> r) or(Col <> c)) then
            begin
              Row := r;
              Col := c;
              Application.CancelHint;
              StringGrid1.Hint :=IntToStr(r)+#32+IntToStr(c);
            end;
        end;
    end;
    
    Наверх к содержанию
    Как внести изменения в код VCL?

    Примечание: внесение изменений в VCL не поддерживается Borland или Borland Developer Support.
    Но если Вы решили сделать это...
    Изменеия в код VCL никогда не должны вносится в секцию "interface" модуля - только в секцию "implimentation". Наиболее безопасный способ внести изменения в VCL - создать новый каталог названный "исправленный VCL". Скопируйте файл VCL который Вы хотите изменить в этот каталог. Внесите изменения (лучше прокомментировать их) в этот файл. Затем добавьте путь к Вашему каталогу "исправленный VCL" в самое начало "library path". Перезапустите Delphi/C++ Builder и перекомпилируйте Ваш проект. "library path" можно изменить в меню:

    Delphi 1 : Options | Environment | Library
    Delphi 2 : Tools | Options | Library
    Delphi 3 :  Tools | Environment Options | Library
    Delphi 4 :  Tools | Environment Options | Library
    Delphi 5 :  Tools | Environment Options | Library
    C++ Builder : Options | Environment | Library
    
    Наверх к содержанию
    Как в Delphi реализовать функцию - эквивалент TwipsPerPixel из VisualBasic?

    Функции TwipsPerPixelX и TwipsPerPixelY, приведенные в примере реализуют ту же функциональность в Delphi.

    function TwipsPerPixelX(Canvas : TCanvas) : Extended;
    begin
      result := 1440 / GetDeviceCaps(Canvas.Handle, LOGPIXELSX);
    end;
    
    function TwipsPerPixelY(Canvas : TCanvas) : Extended;
    begin
      result := 1440 / GetDeviceCaps(Canvas.Handle, LOGPIXELSY);
    end;
    
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      ShowMessage(FloatToStr(TwipsPerPixelX(Form1.Canvas)));
      ShowMessage(FloatToStr(TwipsPerPixelY(Form1.Canvas)));
    end;
    
    Наверх к содержанию
    Как вставить содержимое файла в текущую позицию курсора в компонете TMemo?

    Считайте файл в TMemoryStream, затем ипользуйте метод TMemo SetSelTextBuf() для вставки текста;

    var
      TheMStream : TMemoryStream;
      Zero : char;
    begin
      TheMStream := TMemoryStream.Create;
      TheMStream.LoadFromFile('C:\AUTOEXEC.BAT');
      TheMStream.Seek(0, soFromEnd); 
      //Null terminate the buffer!
      Zero := #0;
      TheMStream.Write(Zero, 1);
      TheMStream.Seek(0, soFromBeginning);
      Memo1.SetSelTextBuf(TheMStream.Memory);
      TheMStream.Free;
    end;
    
    Наверх к содержанию
    Перехват нажатия Ctrl-V в TMemo.

    Как в компоненте TMemo перехватить нажатие Ctrl-V и вставить специальный текст не из буфера обмена (clipboard)?

    См. пример.

    uses ClipBrd;
    
    procedure TForm1.Memo1KeyDown(Sender: TObject; 
                     var Key: Word; Shift: TShiftState);
    begin
      if ((Key = ord('V')) and (ssCtrl in Shift)) then
        begin
          if Clipboard.HasFormat(CF_TEXT) then 
            ClipBoard.Clear;
          Memo1.SelText := 'Delphi is RAD!';
          key := 0;
        end;
    end;
    
    Наверх к содержанию
    TEdit с выравниваением текста по правой стороне.
    Как создать эквивалент TEdit но только с выравниваением вводимого текста по центру или по правой стороне?

    TEdit не поддерживает выравниваение текста по центру и по правой стороне - лучше использовать компонент TMemo. Вам понадобится запретить пользователю нажимать Enter, Ctrl-Enter и всевозможные комбинации клавиш со стрелками, чтобы избежать появления нескольких сторк в Memo. Этого можно добиться и просматривая содержимое текста в TMemo в поисках кода возврата каретки (13) и перевода строки(10) на событиях TMemo Change и KeyPress. Можно также заменять код возврата каретки на пробел - для того чтобы позволять вставку из буфера обмена многострочного текста в виде одной строки.

    procedure TForm1.FormCreate(Sender: TObject);
    begin
      Memo1.Alignment := taRightJustify;
      Memo1.MaxLength := 24;
      Memo1.WantReturns := false;
      Memo1.WordWrap := false;
    end;
    
    procedure MultiLineMemoToSingleLine(Memo : TMemo);
    var
      t : string;
    begin
      t := Memo.Text;
      if Pos(#13, t) > 0  then
        begin
          while Pos(#13, t) > 0 do
            delete(t, Pos(#13, t), 1);
          while Pos(#10, t) > 0 do
            delete(t, Pos(#10, t), 1);
          Memo.Text := t;
        end;
    end;
    
    procedure TForm1.Memo1Change(Sender: TObject);
    begin
      MultiLineMemoToSingleLine(Memo1);
    end;
    
    procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
    begin
      MultiLineMemoToSingleLine(Memo1);
    end;
    
    Наверх к содержанию
    Как запрограммировать undo?

    См. пример

    Memo1.Perform(EM_UNDO, 0, 0);
    
    Если Вы хотите узнать, возможно ли выполнить операцию "Undo", проверьте "Undo status":
    If Memo1.Perform(EM_CANUNDO, 0, 0) <> 0 then
    begin
      {Undo is possible}
    end;
    
    Для выполнения "Redo" выполните "Undo" еще раз.

    Наверх к содержанию
    Переопределение конструктора формы.
    Можно ли создать форму, которая получает дополнительные параметры в методе Сreate?

    Просто замените конструктор Create класса Вашей формы.

    unit Unit2;
    
    interface
    
    uses  Windows, Messages, SysUtils, Classes, 
          Graphics, Controls, Forms, Dialogs;
    
    type
      TForm2 = class(TForm)
      private
        {Private declarations}
      public
        constructor CreateWithCaption(aOwner: TComponent; 
                                       aCaption: string);
        {Public declarations} 
    end;
    
    var
      Form2: TForm2;
    
    implementation
    
    {$R *.DFM}
    
    constructor TForm2.CreateWithCaption(aOwner: TComponent; 
                                          aCaption: string);
    begin
      Create(aOwner);
      Caption := aCaption;
    end;
    
    uses Unit2;
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      Unit2.Form2 :=Unit2.TForm2.CreateWithCaption(Application, 
                                                 'My Caption');
      Unit2.Form2.Show;
    end;
    
    Наверх к содержанию
    Цветной текст в TStatusBar.
    Почему при изменении цвета шрифта в StatusBar's он (шрифт) не меняется?

    Status bar (строка состояния) - стандартный элемент управления Windows и цвет его шрифта задается через Control Panel (константа clBtnText). Этот цвет по умолчанию черный и может меняться при выборе пользователем той или иной цветовой схемы. У компонента ТStatusBar и его панелей есть возможность "owner-draw" - программной перерисовки, которая позволяет выводить на панель текст любого цвета. Измените свойство Style компонента TStatusBar.Panels на OwnerDraw.

    procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; 
                       Panel: TStatusPanel; const Rect: TRect);
    begin
      if Panel = StatusBar.Panels[0] then
        begin
        StatusBar.Canvas.Font.Color := clRed;
        StatusBar.Canvas.TextOut(Rect.Left, Rect.Top,'Panel - 0')
        end
      else
        begin
        StatusBar.Canvas.Font.Color := clGreen;
        StatusBar.Canvas.TextOut(Rect.Left, Rect.Top,'Panel - 1');
        end;
    end;
    
    Наверх к содержанию
    Переделываем TTrackBar.
    Как бы мне создать эдакий trackbar в котором вместо широкой белой полоски с ползунком была бы тонкая линия?

    В примере создается компонент, унаследованный от TTrackbar который переопределяет метод CreateParams и убират флаг TBS_ENABLESELRANGE из Style. Константа TBS_ENABLESELRANGE обьявленна в модуле CommCtrl.

    uses CommCtrl, ComCtrls;
    
    type TMyTrackBar = class(TTrackBar)
      procedure CreateParams(var Params: TCreateParams);override;
    end;
    
    procedure TMyTrackBar.CreateParams(var Params: TCreateParams);
    begin
      inherited;
        Params.Style := Params.Style and not TBS_ENABLESELRANGE;
    end;
    
    var
      MyTrackbar : TMyTrackbar;
    
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      MyTrackBar := TMyTrackbar.Create(Form1);
      MyTrackbar.Parent := Form1;
      MyTrackbar.Left := 100;
      MyTrackbar.Top := 100;
      MyTrackbar.Width := 150;
      MyTrackbar.Height := 45;
      MyTrackBar.Visible := true;
    end;
    
    Наверх к содержанию
    Создание временного canvas'а.
    Мне нужен временный canvas, но когда я пытаюсь его создать получаю сообщения об ошибках. Как создать TCanvas?

    Создайте Bitmap и используйте свойство canvas класса TBitmap. Пример создает Bitmap, рисует на его canvas'е, выводит этот canvas на форму и освобождает bitmap.

    procedure TForm1.Button1Click(Sender: TObject);
    var
      bm : TBitmap;
    begin
      bm := TBitmap.Create;
      bm.Width := 100;
      bm.Height := 100;
      bm.Canvas.Brush.Color := clRed;
      bm.Canvas.FillRect(Rect(0, 0, 100, 100));
      bm.Canvas.MoveTo(0, 0);
      bm.Canvas.LineTo(100, 100);
      Form1.Canvas.StretchDraw(Form1.ClientRect,Bm);
      bm.Free;
    end;
    
    Наверх к содержанию
    Проблема с прозраным glyph'ом.
    В некоторых видео режимах прозрачная часть glyph'а стандартного TBitBtn становится видной. Как этого избежать?

    В примере используется техника закраски прозрачной части glyph'а цветом кнопки на которой он находится - таким образом glyph кажется прозрачным.

    function InitStdBitBtn(BitBtn: TBitBtn; kind: TBitBtnKind): bool;
    var
      Bm1 : TBitmap;
      Bm2 : TBitmap;
    begin
      Result := false;
      if Kind = bkCustom then exit;
      Bm1 := TBitmap.Create;
      case Kind of
        bkOK : Bm1.Handle := LoadBitmap(hInstance, 'BBOK');
        bkCancel : Bm1.Handle := LoadBitmap(hInstance, 'BBCANCEL');
        bkHelp : Bm1.Handle := LoadBitmap(hInstance, 'BBHELP');
        bkYes : Bm1.Handle := LoadBitmap(hInstance, 'BBYES');
        bkNo : Bm1.Handle := LoadBitmap(hInstance, 'BBNO');
        bkClose : Bm1.Handle := LoadBitmap(hInstance, 'BBCLOSE');
        bkAbort : Bm1.Handle := LoadBitmap(hInstance, 'BBABORT');
        bkRetry : Bm1.Handle := LoadBitmap(hInstance, 'BBRETRY');
        bkIgnore : Bm1.Handle := LoadBitmap(hInstance, 'BBIGNORE');
        bkAll : Bm1.Handle := LoadBitmap(hInstance, 'BBALL');
      end;
      Bm2 := TBitmap.Create;
      Bm2.Width := Bm1.Width;
      Bm2.Height := Bm1.Height;
      Bm2.Canvas.Brush.Color := ClBtnFace;
      Bm2.Canvas.BrushCopy(Rect(0, 0, bm2.Width, bm2.Height), Bm1,
                           Rect(0, 0, Bm1.width, Bm1.Height),
      Bm1.canvas.pixels[0,0]);
      Bm1.Free;
      LockWindowUpdate(BitBtn.Parent.Handle);
      BitBtn.Kind := kind;
      BitBtn.Glyph.Assign(bm2);
      LockWindowUpdate(0);
      Bm2.Free;
      Result := true;
    end;
    
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      InitStdBitBtn(BitBtn1, bkOk);
    end;
    
    Наверх к содержанию
    Создание PolyPolygon используя массив точек?

    Polygon - метод компонента TCanvas получает в качестве параметра динамический массив точек. Функция PolyPolygon() из Windows GDI получает указатель на массив точек.

    procedure TForm1.Button1Click(Sender: TObject);
    var
      ptArray : array[0..9] of TPOINT;
      PtCounts : array[0..1] of integer;
    begin
      PtArray[0] := Point(0, 0);
      PtArray[1] := Point(0, 100);
      PtArray[2] := Point(100, 100);
      PtArray[3] := Point(100, 0);
      PtArray[4] := Point(0, 0);
      PtCounts[0] := 5;
      PtArray[5] := Point(25, 25);
      PtArray[6] := Point(25, 75);
      PtArray[7] := Point(75, 75);
      PtArray[8] := Point(75, 25);
      PtArray[9] := Point(25, 25);
      PtCounts[1] := 5;
      PolyPolygon(Form1.Canvas.Handle,
      PtArray,PtCounts,2);
    end;
    
    Наверх к содержанию
    Создание невизуальных компонентов без иконок.
    Как создать невизуальный компонент без иконоки, которая изображается в палитре компонентов в "design-time" (вроде TField)?

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

    Наверх к содержанию
    Как показывать нестандартный встроенный редактор (inplace editor) в ячейке stringgrid (например combobox).

    См. пример

    procedure TForm1.FormCreate(Sender: TObject);
    begin
      {Высоту combobox'а не изменишь, так что вместо combobox'а
         будем изменять высоту строки grid'а !}
      StringGrid1.DefaultRowHeight := ComboBox1.Height;
      {Спрятать combobox}
      ComboBox1.Visible := False;
      ComboBox1.Items.Add('Delphi Kingdom');
      ComboBox1.Items.Add('Королевство Дельфи');
    end;
    
    procedure TForm1.ComboBox1Change(Sender: TObject);
    begin
      {Перебросим выбранное в значение из ComboBox в grid}
      StringGrid1.Cells[StringGrid1.Col,
      StringGrid1.Row] :=ComboBox1.Items[ComboBox1.ItemIndex];
      ComboBox1.Visible := False;
      StringGrid1.SetFocus;
    end;
    
    procedure TForm1.ComboBox1Exit(Sender: TObject);
    begin
      {Перебросим выбранное в значение из ComboBox в grid}
      StringGrid1.Cells[StringGrid1.Col,
      StringGrid1.Row] :=ComboBox1.Items[ComboBox1.ItemIndex];
      ComboBox1.Visible := False;
      StringGrid1.SetFocus;
    end;
    
    procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
              ARow: Integer; var CanSelect: Boolean);
    var
      R: TRect;
    begin
      if ((ACol = 3) AND (ARow <> 0)) then
        begin
          {Ширина и положение ComboBox должно соответствовать
                    ячейке StringGrid}
          R := StringGrid1.CellRect(ACol, ARow);
          R.Left := R.Left + StringGrid1.Left;
          R.Right := R.Right + StringGrid1.Left;
          R.Top := R.Top + StringGrid1.Top;
          R.Bottom := R.Bottom + StringGrid1.Top;
          ComboBox1.Left := R.Left + 1;
          ComboBox1.Top := R.Top + 1;
          ComboBox1.Width := (R.Right + 1) - R.Left;
          ComboBox1.Height := (R.Bottom + 1) - R.Top;
          {Покажем combobox}
          ComboBox1.Visible := True;
          ComboBox1.SetFocus;
        end;
      CanSelect := True;
    end;
    
    Наверх к содержанию
    Как узнать есть ли в заданном CD-ROM'е Audio CD?

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

    function IsAudioCD(Drive : char) : bool;
    var
      DrivePath : string;
      MaximumComponentLength : DWORD;
      FileSystemFlags : DWORD;
      VolumeName : string;
    Begin
      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".

    Наверх к содержанию
    Определение нажатия клавиши tab.
    События 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.

    Наверх к содержанию
    Radiogroup и фокус ввода.
    При перемещении фокуса ввода клавишей 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:\Borland\BitBtns\ALARMRNG.BMP');
      bmChecked := TBitmap.Create;
      bmChecked.LoadFromFile('C:\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 файла
    Как узнать число кадров 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;
    
    Наверх к содержанию
    Показ dbgrid в режиме disabled.
    Некоторые компоненты баз данных (и среди них 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 - перехватывает весь экран в буфер обмена.
    ButtonClick3 - перехватывает активное окно в буфер обмена.
    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 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 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 динамически. Как сделать картинки из 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;
    
    Наверх к содержанию
    Ошибка 'There are no fonts installed'.
    При выполнении диалога 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 codes из С.
    Я хочу вставить 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;
    
    Наверх к содержанию
    Переключить TListView в режим редактирования нажатием клавиш.
    Когда пользователь щелкает по 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;
    
    Наверх к содержанию
    Using Resident Font.
    Вместо печати графики я хочу использовать резидентный шрифт принтера. Как?

    Используте функцию 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.
    Мне нужно программно установить некоторые файлы с установочного диска 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.
    Как получить строку сообщения об ошибке 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.
    Как добится того чтобы 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'а.
    При попытке присвоить значение свойству "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'а и не появлялась прокрутка текста.
    Первый способ устанавливает свойство 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\Fonts');
      end;
    end;
    
    procedure TForm1.Button2Click(Sender: TObject);
    var
      NFont : TFont;
    begin
      NFont:=TFont.Create;
      if ReadFontFromRegistry(NFont,'Delphi\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 (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.
    
    Наверх к содержанию
    Как нарисовать пиктограмму (icon) с увеличением.
    При попытке использовать метод 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;
    
    Наверх к содержанию
    Автоматическая ширина колонок в StringGrid.
    Можно ли сделать так чтобы 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 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 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.
    Как программно перевести 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'а.
    Как поместить курсор в определенную позицию 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.
    Как обновить список дисков компонента 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 ресурсы?

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

    {это наш "class cracer"}
    type TMyTabbedNotebook = class(TTabbedNotebook); 
    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;
    
    Наверх к содержанию
    Эмуляция нажатия клавиши с кодом #255.
    Функция 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;
    
    Наверх к содержанию
    Рейтинг@Mail.ru RBGold.ru be number one Классная баннерная система