Подборку, перевод и адаптацию материала подготовил Aziz(JINX)
специально для Королевства Дельфи. Прозрачная надпись на 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; Наверх к содержанию Вопрос: При использованиии компонента TRegistry под NT пользователь с права доступа ниже чем "администратор" не может получить доступа к информации реестра в ключе HKEY_LOCAL_MACHINE. Как это обойти? Ответ: Проблема вызвана тем, что TRegistry всегда открывает реестр с параметром KEY_ALL_ACCESS (полный доступ), даже если необходим доступ KEY_READ (только чтение). Избежать этого можно используя функции API для работы с реестром (RegOpenKey и т.п.), или создать новый класс из компонента TRegestry, и изменить его так чтобы можно было задавать режим открытия реестра. Наверх к содержанию Вопрос: Можно ли изменить число колонок и их ширину в компоненте TFileListBox? Ответ: В приведенном примере FileListBox приводится к типу TDirectoryListBox - таким образом можно добавиь дополнительные колонки. Пример: with TDirectoryListBox(FileListBox1) do begin Columns := 2; SendMessage(Handle, LB_SETCOLUMNWIDTH, Canvas.TextWidth('WWWWWWWW.WWW'),0); end; Наверх к содержанию Вопрос: Как настроить табуляцию в компоненте TMemo? Ответ: Пошлите в Memo сообщение EM_SETTABSTOPS. Например установим первую позицию табуляции на 20-й пиксел. Пример: procedure TForm1.FormCreate(Sender: TObject); var DialogUnitsX : LongInt; PixelsX : LongInt; i : integer; TabArray : array[0..4] of integer; begin Memo1.WantTabs := true; DialogUnitsX := LoWord(GetDialogBaseUnits); PixelsX := 20; for i := 1 to 5 do begin TabArray[i - 1] :=((PixelsX * i ) * 4) div DialogUnitsX; end; SendMessage(Memo1.Handle, EM_SETTABSTOPS,5,LongInt(@TabArray)); Memo1.Refresh; end; Наверх к содержанию Вопрос: Как перехватить нажатия функциональных клавиш и стрелок? Ответ: Проверяйте значение переменной key на равенство VK_RIGHT, VK_LEFT, VK_F1 и т.д. на событии KeyDown формы. Пример: procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_RIGHT then Form1.Caption := 'Right'; if Key = VK_F1 then Form1.Caption := 'F1'; end; Наверх к содержанию Вопрос: При обработке события DrawCell компонента DrawGrid я пишу Font.Color := clRed; и получаю бесконечный цикл мерцаний. Почему? Ответ: Правильно укажите границы используемого канваса. Пример: If (Row = 0) then begin DrawGrid1.Canvas.Font.Color := clRed; DrawGrid1.Canvas.TextOut(Rect.Left,Rect.Top, IntToStr(Col)); end; Наверх к содержанию Вопрос: При использовании BitBtn Caption(текст) и картинка(bitmap) из файла не видны одновременно. Почему? Ответ: Это может происходить если картинка слишком велика. Класс TBitBtn сначала рисует картинку, а затем выводит текст над, под, слева или справа от картинки (в завивимости от свойства Layout). Если размер картинки такой же как у всей кнопки для вывода текста просто не остается места. Если Вам нужно получить кнопку такого же размера как Ваша картинка и видеть при этом надпись на кнопке Вам придется выводить текст надписи непосредственно на канву картинки. Пример: var bm : TBitmap; OldBkMode : integer; begin bm := TBitmap.Create; bm.Width := BitBtn1.Glyph.Width; bm.Height := BitBtn1.Glyph.Height; bm.Canvas.Draw(0, 0, BitBtn1.Glyph); OldBkMode := SetBkMode(bm.Canvas.Handle, Transparent); bm.Canvas.TextOut(0, 0, 'The Caption'); SetBkMode(bm.Canvas.Handle, OldBkMode); BitBtn1.Glyph.Assign(bm); end; Наверх к содержанию Вопрос: Можно ли изменить вид текстового курсора (каретки) edit'а или другого элемента управления Windows? Ответ: Можно! В примере показано как создать два цветных "bitmap'а": "улыбчивый" и "хмурый" и присвоить их курсору edit'а. Для этого нужно перехватить оконную процедуру edit'а. Чтобы сделать это заменим адрес оконной процедуры Edit'а нашим собственным, а старую оконную процедуру будем вызывать по необходимости. Пример показывает "улыбчивый" курсор при наборе текста и "хмурый" при забое клавишей backspace. Пример: unit caret1; interface {$IFDEF WIN32} uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; {$ELSE} uses WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; {$ENDIF} type TForm1 = class(TForm) Edit1: TEdit; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private {Private declarations} public {Public declarations} CaretBm : TBitmap; CaretBmBk : TBitmap; OldEditsWindowProc : Pointer; end; var Form1: TForm1; implementation {$R *.DFM} type {$IFDEF WIN32} WParameter = LongInt; {$ELSE} WParameter = Word; {$ENDIF} LParameter = LongInt; {New windows procedure for the edit control} function NewWindowProc(WindowHandle : hWnd; TheMessage : WParameter; ParamW : WParameter; ParamL : LParameter) : LongInt {$IFDEF WIN32} stdcall; {$ELSE} ; export; {$ENDIF} begin {Call the old edit controls windows procedure} NewWindowProc := CallWindowProc(Form1.OldEditsWindowProc, WindowHandle, TheMessage, ParamW, ParamL); if TheMessage = WM_SETFOCUS then begin CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0); ShowCaret(WindowHandle); end; if TheMessage = WM_KILLFOCUS then begin HideCaret(WindowHandle); DestroyCaret; end; if TheMessage = WM_KEYDOWN then begin if ParamW = VK_BACK then CreateCaret(WindowHandle, Form1.CaretBmBk.Handle, 0, 0) else CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0); ShowCaret(WindowHandle); end; end; procedure TForm1.FormCreate(Sender: TObject); begin {Create a smiling bitmap using the wingdings font} CaretBm := TBitmap.Create; CaretBm.Canvas.Font.Name := 'WingDings'; CaretBm.Canvas.Font.Height := Edit1.Font.Height; CaretBm.Canvas.Font.Color := clWhite; CaretBm.Width := CaretBm.Canvas.TextWidth('J') + 2; CaretBm.Height := CaretBm.Canvas.TextHeight('J') + 2; CaretBm.Canvas.Brush.Color := clBlue; CaretBm.Canvas.FillRect(Rect(0, 0, CaretBm.Width, CaretBm.Height)); CaretBm.Canvas.TextOut(1, 1, 'J'); {Create a frowming bitmap using the wingdings font} CaretBmBk := TBitmap.Create; CaretBmBk.Canvas.Font.Name := 'WingDings'; CaretBmBk.Canvas.Font.Height := Edit1.Font.Height; CaretBmBk.Canvas.Font.Color := clWhite; CaretBmBk.Width := CaretBmBk.Canvas.TextWidth('L') + 2; CaretBmBk.Height := CaretBmBk.Canvas.TextHeight('L') + 2; CaretBmBk.Canvas.Brush.Color := clBlue; CaretBmBk.Canvas.FillRect(Rect(0,0, CaretBmBk.Width, CaretBmBk.Height)); CaretBmBk.Canvas.TextOut(1, 1, 'L'); {Hook the edit controls window procedure} OldEditsWindowProc := Pointer(SetWindowLong(Edit1.Handle,GWL_WNDPROC, LongInt(@NewWindowProc))); end; procedure TForm1.FormDestroy(Sender: TObject); begin {Unhook the edit controls window procedure and clean up} SetWindowLong(Edit1.Handle,GWL_WNDPROC, LongInt(OldEditsWindowProc)); CaretBm.Free; CaretBmBk.Free; end; Наверх к содержанию Вопрос: При использовании модулей доступа к BDE (DbiTypes, DbiProcs, DbiErrs), любая попытка вызвать процедуру abort выдает ошибку при компиляции при вызове метода abort "Statement expected, but expression of type 'Integer' found". Я пытался найти DbiTypes.pas, DbiProcs.pas и DbiErrs.pas чтобы разобраться но не нашел этих файлов. Где расположены эти файлы и как обойти ошибку? Ответ: Модули DbiTypes, DbiProcs, DbiErrs это псевдонимы модуля "BDE", обьявлены в Projects->Options->Directories/Conditionals->Unit Aliases. Исходник модуля DBE находится в каталоге "doc" и называется "BDE.INT". В этом файле обьявленна константа ABORT со значением -2. Так как Вы хотите использовать процедуру Abort(), которая обьявлена в модуле SysUtils, Вам нужно добавить префикс SysUtils перед вызовом процедуры Abort. Пример: SysUtils.Abort; Наверх к содержанию Вопрос: Почему при изменении цвета букв StatusBar'а ничего не происходит? Ответ: Status bar - стандартный элемент управления Windows, и соответственно цвет его букв - значение clBtnText которое изменяется с помощью настроек в Control Panel. Этот цвет черный по умолчанию и может изменяться в зависимости от выбранной цветовой схемы. Другие стандартные элемент управления Windows, например кнопки, также имеют цвет букв, настраиваемый из ControlPanel. StatusBar и его панели имеют свойство "owner-draw", позволяющее Вам использовать любой цвет букв. Пример: procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect); begin if Panel = StatusBar.Panels[0] then begin StatusBar.Canvas.Font.Color := clRed; StatusBar.Canvas.TextOut(Rect.Left, Rect.Top, 'Panel - 0') end else begin StatusBar.Canvas.Font.Color := clGreen; StatusBar.Canvas.TextOut(Rect.Left, Rect.Top, 'Panel - 1'); end; end; Наверх к содержанию Вопрос: Как сделать многострочную надпись на TBitBtn? Ответ: Выводите текст надписи непосредственно на "glyph" TBitBtn'а. См. пример. Пример: procedure TForm1.FormCreate(Sender: TObject); var R : TRect; N : Integer; Buff : array[0..255] of Char; begin with BitBtn1 do begin Caption := 'A really really long caption'; Glyph.Canvas.Font := Self.Font; Glyph.Width := Width - 6; Glyph.Height := Height - 6; R := Bounds(0, 0, Glyph.Width, 0); StrPCopy(Buff, Caption); Caption := ''; DrawText(Glyph.Canvas.Handle,Buff,StrLen(Buff),R, DT_CENTER or DT_WORDBREAK or DT_CALCRECT); OffsetRect(R,(Glyph.Width - R.Right) div 2, (Glyph.Height - R.Bottom) div 2); DrawText(Glyph.Canvas.Handle,Buff,StrLen(Buff),R, DT_CENTER or DT_WORDBREAK); end; end; Наверх к содержанию Вопрос: Как изменить стиль шрифта RichEdit нажатиями соответствующих комбинаций клавиш? (например включить курсив по нажатию Ctrl + I) Ответ: В примере стили шрифта меняются по нажатию след. комбинаций клавиш Ctrl + B - вкл/выкл жирного шрифта Ctrl + I - вкл/выкл наклонного шрифта Ctrl + S - вкл/выкл зачеркнутого шрифта Ctrl + U - вкл/выкл подчеркнутого шрифта Пример: const KEY_CTRL_B = 02; KEY_CTRL_I = 9; KEY_CTRL_S = 19; KEY_CTRL_U = 21; procedure TForm1.RichEdit1KeyPress(Sender: TObject; var Key: Char); begin case Ord(Key) of KEY_CTRL_B: begin Key := #0; if fsBold in (Sender as TRichEdit).SelAttributes.Style then (Sender as TRichEdit).SelAttributes.Style := (Sender as TRichEdit).SelAttributes.Style - [fsBold] else (Sender as TRichEdit).SelAttributes.Style := (Sender as TRichEdit).SelAttributes.Style + [fsBold]; end; KEY_CTRL_I: begin Key := #0; if fsItalic in (Sender as TRichEdit).SelAttributes.Style then (Sender as TRichEdit).SelAttributes.Style := (Sender as TRichEdit).SelAttributes.Style - [fsItalic] else (Sender as TRichEdit).SelAttributes.Style := (Sender as TRichEdit).SelAttributes.Style + [fsItalic]; end; KEY_CTRL_S: begin Key := #0; if fsStrikeout in (Sender as TRichEdit).SelAttributes.Style then (Sender as TRichEdit).SelAttributes.Style := (Sender as TRichEdit).SelAttributes.Style-[fsStrikeout] else (Sender as TRichEdit).SelAttributes.Style := (Sender as TRichEdit).SelAttributes.Style+[fsStrikeout]; end; KEY_CTRL_U: begin Key := #0; if fsUnderline in (Sender as TRichEdit).SelAttributes.Style then (Sender as TRichEdit).SelAttributes.Style := (Sender as TRichEdit).SelAttributes.Style-[fsUnderline] else (Sender as TRichEdit).SelAttributes.Style := (Sender as TRichEdit).SelAttributes.Style+[fsUnderline]; end; end; end; Наверх к содержанию Вопрос: В документации компонента TRegIniFile говорится, что можно изменять корневой ключ (root key). Я пытаюсь это сделать но ничего не получается. Ответ: См. пример. Пример: uses Registry; procedure TForm1.Button1Click(Sender: TObject); var WinIni : TRegIniFile; begin WinIni := TRegIniFile.Create(''); WinIni.RootKey := HKEY_LOCAL_MACHINE; WinIni.WriteString('Frank','Borland','Writes Fast Code!'); WinIni.Free; end; Наверх к содержанию Вопрос: Можно ли динамически изменять свойство "owner" компонента во время выполнения программы? Ответ: Вы можете менять свойство "owner" и после создания компонента с помощью методов InsertComponent() и RemoveComponent(). Наверх к содержанию Вопрос: Как очистить содержимое Canvas'а? Ответ: Просто нарисуйте прямоугольник любого цвета. Пример: Canvas.Brush.Color := ClWhite; Canvas.FillRect(Canvas.ClipRect); Наверх к содержанию Вопрос: Можно ли динамически менять какая форма считается главной в приложении во время работы программы? Ответ: Можно, но только во время загрузки приложения. Чтобы сделать это выберите "View->Project Source" и измените код инициализации приложения, так что порядок создания форм зависил от какого-то условия. Примечание: Вам придется редактировать этот код, если Вы добавите в приложение новые формы. begin Application.Initialize; if then begin Application.CreateForm(TForm1, Form1); Application.CreateForm(TForm2, Form2); end else begin Application.CreateForm(TForm2, Form2); Application.CreateForm(TForm1, Form1); end; end. Application.Run; Наверх к содержанию Вопрос: Как программно "щелкнуть" по компоненту speed button? Я пытался использовать SendMessage но у Speedbuttons нет "handle". 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; Наверх к содержанию Вопрос: Почему при изменении цвета шрифта в 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; Наверх к содержанию Вопрос: Как бы мне создать эдакий trackbar в котором вместо широкой белой полоски с ползунком была бы тонкая линия? Ответ: В примере создается компонент, унаследованный от TTrackbar который переопределяет метод CreateParams и убират флаг TBS_ENABLESELRANGE из Style. Константа TBS_ENABLESELRANGE обьявленна в модуле CommCtrl. Пример: uses CommCtrl, ComCtrls; type TMyTrackBar = class(TTrackBar) procedure CreateParams(var Params: TCreateParams); override; end; procedure TMyTrackBar.CreateParams(var Params: TCreateParams); begin inherited; Params.Style := Params.Style and not TBS_ENABLESELRANGE; end; var MyTrackbar : TMyTrackbar; procedure TForm1.Button1Click(Sender: TObject); begin MyTrackBar := TMyTrackbar.Create(Form1); MyTrackbar.Parent := Form1; MyTrackbar.Left := 100; MyTrackbar.Top := 100; MyTrackbar.Width := 150; MyTrackbar.Height := 45; MyTrackBar.Visible := true; end; Наверх к содержанию Вопрос: Мне нужен временный canvas, но когда я пытаюсь его создать получаю сообщения об ошибках. Как создать TCanvas? Ответ: Создайте Bitmap и используйте свойство canvas класса TBitmap. Пример создает Bitmap, рисует на его canvas'е, выводит этот canvas на форму и освобождает bitmap. Пример: procedure TForm1.Button1Click(Sender: TObject); var bm : TBitmap; begin bm := TBitmap.Create; bm.Width := 100; bm.Height := 100; bm.Canvas.Brush.Color := clRed; bm.Canvas.FillRect(Rect(0, 0, 100, 100)); bm.Canvas.MoveTo(0, 0); bm.Canvas.LineTo(100, 100); Form1.Canvas.StretchDraw(Form1.ClientRect,Bm); bm.Free; end; Наверх к содержанию Вопрос: В некоторых видео режимах прозрачная часть glyph'а стандартного TBitBtn становится видной. Как этого избежать? Ответ: В примере используется техника закраски прозрачной части glyph'а цветом кнопки на которой он находится - таким образом glyph кажется прозрачным. Пример: function InitStdBitBtn(BitBtn : TBitBtn; kind : TBitBtnKind) : bool; var Bm1 : TBitmap; Bm2 : TBitmap; begin Result := false; if Kind = bkCustom then exit; Bm1 := TBitmap.Create; case Kind of bkOK : Bm1.Handle := LoadBitmap(hInstance, 'BBOK'); bkCancel : Bm1.Handle := LoadBitmap(hInstance, 'BBCANCEL'); bkHelp : Bm1.Handle := LoadBitmap(hInstance, 'BBHELP'); bkYes : Bm1.Handle := LoadBitmap(hInstance, 'BBYES'); bkNo : Bm1.Handle := LoadBitmap(hInstance, 'BBNO'); bkClose : Bm1.Handle := LoadBitmap(hInstance, 'BBCLOSE'); bkAbort : Bm1.Handle := LoadBitmap(hInstance, 'BBABORT'); bkRetry : Bm1.Handle := LoadBitmap(hInstance, 'BBRETRY'); bkIgnore : Bm1.Handle := LoadBitmap(hInstance, 'BBIGNORE'); bkAll : Bm1.Handle := LoadBitmap(hInstance, 'BBALL'); end; Bm2 := TBitmap.Create; Bm2.Width := Bm1.Width; Bm2.Height := Bm1.Height; Bm2.Canvas.Brush.Color := ClBtnFace; Bm2.Canvas.BrushCopy(Rect(0, 0, bm2.Width, bm2.Height), Bm1, Rect(0, 0, Bm1.width, Bm1.Height), Bm1.canvas.pixels[0,0]); Bm1.Free; LockWindowUpdate(BitBtn.Parent.Handle); BitBtn.Kind := kind; BitBtn.Glyph.Assign(bm2); LockWindowUpdate(0); Bm2.Free; Result := true; end; procedure TForm1.Button1Click(Sender: TObject); begin InitStdBitBtn(BitBtn1, bkOk); end; Наверх к содержанию Вопрос: Создание PolyPolygon используя массив точек? Ответ: Polygon - метод компонента TCanvas получает в качестве параметра динамический массив точек. Функция PolyPolygon() из Windows GDI получает указатель на массив точек. Пример: procedure TForm1.Button1Click(Sender: TObject); var ptArray : array[0..9] of TPOINT; PtCounts : array[0..1] of integer; begin PtArray[0] := Point(0, 0); PtArray[1] := Point(0, 100); PtArray[2] := Point(100, 100); PtArray[3] := Point(100, 0); PtArray[4] := Point(0, 0); PtCounts[0] := 5; PtArray[5] := Point(25, 25); PtArray[6] := Point(25, 75); PtArray[7] := Point(75, 75); PtArray[8] := Point(75, 25); PtArray[9] := Point(25, 25); PtCounts[1] := 5; PolyPolygon(Form1.Canvas.Handle, PtArray,PtCounts,2); end; Наверх к содержанию Вопрос: Как создать невизуальный компонент без иконоки, которая изображается в палитре компонентов в "design-time" (вроде TField)? Ответ: Невизуальные компоненты без иконоки удобны для субкомпонентов, связанных с какими-то другими компонентами. Создайте компонент как обычно, но используйте RegisterNoIcon вместо RegisterComponent. Наверх к содержанию Вопрос: Как показывать нестандартный встроенный редактор (inplace editor) в ячейке stringgrid (например combobox). Ответ: См. пример Пример: procedure TForm1.FormCreate(Sender: TObject); begin {Высоту combobox'а не изменишь, так что вместо combobox'а будем изменять высоту строки grid'а !} StringGrid1.DefaultRowHeight := ComboBox1.Height; {Спрятать combobox} ComboBox1.Visible := False; ComboBox1.Items.Add('Delphi Kingdom'); ComboBox1.Items.Add('Королевство Дельфи'); end; procedure TForm1.ComboBox1Change(Sender: TObject); begin {Перебросим выбранное в значение из ComboBox в grid} StringGrid1.Cells[StringGrid1.Col, StringGrid1.Row] :=ComboBox1.Items[ComboBox1.ItemIndex]; ComboBox1.Visible := False; StringGrid1.SetFocus; end; procedure TForm1.ComboBox1Exit(Sender: TObject); begin {Перебросим выбранное в значение из ComboBox в grid} StringGrid1.Cells[StringGrid1.Col, StringGrid1.Row] :=ComboBox1.Items[ComboBox1.ItemIndex]; ComboBox1.Visible := False; StringGrid1.SetFocus; end; procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); var R: TRect; begin if ((ACol = 3) AND (ARow 0)) then begin {Ширина и положение ComboBox должно соответствовать ячейке StringGrid} R := StringGrid1.CellRect(ACol, ARow); R.Left := R.Left + StringGrid1.Left; R.Right := R.Right + StringGrid1.Left; R.Top := R.Top + StringGrid1.Top; R.Bottom := R.Bottom + StringGrid1.Top; ComboBox1.Left := R.Left + 1; ComboBox1.Top := R.Top + 1; ComboBox1.Width := (R.Right + 1) - R.Left; ComboBox1.Height := (R.Bottom + 1) - R.Top; {Покажем combobox} ComboBox1.Visible := True; ComboBox1.SetFocus; end; CanSelect := True; end; Наверх к содержанию Вопрос: Как узнать есть ли в заданном CD-ROM'е Audio CD? Ответ: Можно использовать функцию Windows API GetDriveType() чтобы определить является ли дисковод CD-ROM'мом. И функцию API GetVolumeInformation() чтобы проверить VolumeName на равенство 'Audio CD'. Пример: function IsAudioCD(Drive : char) : bool; var DrivePath : string; MaximumComponentLength : DWORD; FileSystemFlags : DWORD; VolumeName : string; Begin sult := false; DrivePath := Drive + ':'; if GetDriveType(PChar(DrivePath)) DRIVE_CDROM then exit; SetLength(VolumeName, 64); GetVolumeInformation(PChar(DrivePath),PChar(VolumeName), Length(VolumeName),nil,MaximumComponentLength,FileSystemFlags,nil,0); if lStrCmp(PChar(VolumeName),'Audio CD') = 0 then result := true; end; function PlayAudioCD(Drive : char) : bool; var mp : TMediaPlayer; begin result := false; Application.ProcessMessages; if not IsAudioCD(Drive) then exit; mp := TMediaPlayer.Create(nil); mp.Visible := false; mp.Parent := Application.MainForm; mp.Shareable := true; mp.DeviceType := dtCDAudio; mp.FileName := Drive + ':'; mp.Shareable := true; mp.Open; Application.ProcessMessages; mp.Play; Application.ProcessMessages; mp.Close; Application.ProcessMessages; mp.free; result := true; end; procedure TForm1.Button1Click(Sender: TObject); begin if not PlayAudioCD('D') then ShowMessage('Not an Audio CD'); end; Наверх к содержанию Вопрос: Как узнать есть ли у мыши колесико? Ответ: Свойство "WheelPresent" глобального обьекта "mouse". Наверх к содержанию Вопрос: События KeyPress и KeyDown не вызываются для клавиши Tab - как определить, что она была нажата? Ответ: На уровне формы клавиша tab обычно обрабатывается Windows. В примере создается обработчик события CM_Dialog для перехвата Dialog keys. Пример: type TForm1 = class(TForm) private procedure CMDialogKey( Var msg: TCMDialogKey ); message CM_DIALOGKEY; end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.CMDialogKey(var msg: TCMDialogKey); begin if msg.Charcode VK_TAB then inherited; end; procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_TAB then Form1.Caption := 'Tab Key Down!'; end; Наверх к содержанию Вопрос: В чем отличие между Create(Self) и Create(Application)? Ответ: Self может быть использовано только в методе класса, и ссылается на текущий экземпляр класса. Таким образом "Self" в методе класса TForm1 ссылается на текущий экземпляр TForm1. При создании компонента Вы передаете его владельца (owner) в конструктор. При уничтожении формы или компонента автоматически уничтожаются и все компоненты владельцем которого она является. Таким образом если при создании формы передать в качестве владельца Application эта форма будет автоматически уничтожена при уничтожении Application. Если же при создании формы передать в качестве владельца другую форму, вновь созданная форма будет автоматически уничтоженна при уничтожении формы-владельца. Наверх к содержанию Вопрос: Как во время выполнения определить поддерживает ли обьект заданное свойство? Ответ: function HasProperty(Obj : TObject; Prop : string) : PPropInfo; begin Result := GetPropInfo(Obj.ClassInfo, Prop); end; procedure TForm1.Button1Click(Sender: TObject); var p : pointer; begin p := HasProperty(Button1, 'Color'); if p nil then SetOrdProp(Button1, p, clRed) else ShowMessage('Button has no color property'); p := HasProperty(Label1, 'Color'); if p nil then SetOrdProp(Label1, p, clRed) else ShowMessage('Label has no color property'); p := HasProperty(Label1.Font, 'Color'); if p nil then SetOrdProp(Label1.Font.Color, p, clBlue) else ShowMessage('Label.Font has no color property'); end; Наверх к содержанию Вопрос: Как при проигрывании музыки с Audio CD показывать сколько прошло минут и секунд? Ответ: В примере время выводится по таймеру. Пример: uses MMSystem; procedure TForm1.Timer1Timer(Sender: TObject); var Trk : Word; Min : Word; Sec : Word; begin with MediaPlayer1 do begin Trk := MCI_TMSF_TRACK(Position); Min := MCI_TMSF_MINUTE(Position); Sec := MCI_TMSF_SECOND(Position); Label1.Caption := Format('%.2d',[Trk]); Label2.Caption := Format('%.2d:%.2d',[Min,Sec]); end; end; Наверх к содержанию Вопрос: Можно ли рисовать на рамке формы? Ответ: Обрабатывайте событие WM_NCPAINT. В примере рамка обводится красной линией толщиной в 1 пиксел. Пример: type TForm1 = class(TForm) private {Private declarations} procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPAINT; public {Public declarations} end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.WMNCPaint(var Msg: TWMNCPaint); var dc : hDc; Pen : hPen; OldPen : hPen; OldBrush : hBrush; begin inherited; dc := GetWindowDC(Handle); msg.Result := 1; Pen := CreatePen(PS_SOLID, 1, RGB(255, 0, 0)); OldPen := SelectObject(dc, Pen); OldBrush := SelectObject(dc, GetStockObject(NULL_BRUSH)); Rectangle(dc, 0,0, Form1.Width, Form1.Height); SelectObject(dc, OldBrush); SelectObject(dc, OldPen); DeleteObject(Pen); ReleaseDC(Handle, Canvas.Handle); end; Наверх к содержанию Вопрос: Как выполнить какой-то процесс тогда, когда пользователь не работает с моим приложением? Ответ: Создайте процедуру, которая будет вызываться при событии Application.OnIdle. Обьявим процедуру: {Private declarations} procedure IdleEventHandler(Sender: TObject; var Done: Boolean); В разделе implementation опишем поцедуру: procedure TForm1.IdleEventHandler(Sender: TObject; var Done: Boolean); begin {Do a small bit of work here} Done := false; end; В методе Form'ы OnCreate - укажем что наша процедура вызывается на событии Application.OnIdle. Application.OnIdle := IdleEventHandler; Событие OnIdle возникает один раз - когда приложение переходит в режим "безделья" (idle). Если в обработчике переменной Done присвоить False событие будет вызываться вновь и вновь, до тех пор пока приложение "бездельничает" и переменной Done не присвоенно значение True. Наверх к содержанию Вопрос: При перемещении фокуса ввода клавишей Tab чтобы переместить его в RadioGroup нужно нажать клавишу Tab дважды если какой нибудь пункт RadioGroup уже выбран, но только один раз если не выбран. Можно ли сделать поведение RadioGroup логичным? Ответ: Установка свойства RadioGroup'ы TabStop в false должна решить эту проблему - поскольку клавиша tab будет продолжать работать - перемещаясь сразу на выделенный пункт RadioGroup. Наверх к содержанию Вопрос: Как разместить маленькие картинки в компоненте TPopUpMenu? Ответ: В приведенном примере показано как это сделать с использованием функции Windows API SetMenuItemBitmaps(). Эта функция получает handle popup menu, позицию строчки меню куда будет помещена картинка, и два дескриптора(handles) на две картинки (одна из них - картинка которая будет показана когда строка меню доступна, вторая - когда строка меню недоступна). type TForm1 = class(TForm) PopupMenu1: TPopupMenu; Pop11: TMenuItem; Pop21: TMenuItem; Pop31: TMenuItem; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private {Private declarations} bmUnChecked : TBitmap; bmChecked : TBitmap; public {Public declarations} end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.FormCreate(Sender: TObject); begin bmUnChecked := TBitmap.Create; bmUnChecked.LoadFromFile('C:Program FilesBorlandBitBtnsALARMRNG.BMP'); bmChecked := TBitmap.Create; bmChecked.LoadFromFile('C:Program FilesBorlandBitBtnsCHECK.BMP'); {Add the bitmaps to the item at index 1 in PopUpMenu} SetMenuItemBitmaps(PopUpMenu1.Handle,1,MF_BYPOSITION,BmUnChecked.Handle, BmChecked.Handle); end; procedure TForm1.FormDestroy(Sender: TObject); begin bmUnChecked.Free; bmChecked.Free; end; procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var pt : TPoint; begin pt := ClientToScreen(Point(x, y)); PopUpMenu1.Popup(pt.x, pt.y); end; Наверх к содержанию Вопрос: Как узнать число кадров AVI файла, и выяснить как долго будет проигрывться этот файл? Ответ: В приведенном примере указано как получить эту информацию. Пример: procedure TForm1.Button1Click(Sender: TObject); begin MediaPlayer1.TimeFormat := tfFrames; ShowMessage('Number of frames = ' + IntToStr(MediaPlayer1.Length)); MediaPlayer1.TimeFormat := tfMilliseconds; ShowMessage('Number of milliseconds = ' + IntToStr(MediaPlayer1.Length)); end; Наверх к содержанию Вопрос: Как изменить число фиксированных колонок в TDbGrid? Пример: procedure TForm1.Button1Click(Sender: TObject); begin TStringGrid(DbGrid1).FixedCols := 2; end; Наверх к содержанию Вопрос: Некоторые компоненты баз данных (и среди них TDBGrid) никак не меняют визуальных свойств, когда к ним отключен доступ (disabled). Как это изменить програмно? Ответ: Ниже приведен пример, меняющий цвет шрифта на clGray, когда доступ к элементу управления (в данном случае TDBGrid) запрещен (disabled). procedure TForm1.Button1Click(Sender: TObject); begin DbGrid1.Enabled := false; DbGrid1.Font.Color := clGray; end; procedure TForm1.Button2Click(Sender: TObject); begin DbGrid1.Enabled := true; DbGrid1.Font.Color := clBlack; end; Наверх к содержанию Вопрос: Как определить нажаты ли клавиши Shift, Alt, or Ctrl в какой-либо момент времени? Ответ: В приведенном примере показано как определить нажата ли клавиша Shift при выборе строчки меню. Пример также содержит функции проверки состояния клавиш Alt, Ctrl. Пример: function CtrlDown : Boolean; var State : TKeyboardState; begin GetKeyboardState(State); Result := ((State[vk_Control] And 128) 0); end; function ShiftDown : Boolean; var State : TKeyboardState; begin GetKeyboardState(State); Result := ((State[vk_Shift] and 128) 0); end; function AltDown : Boolean; var State : TKeyboardState; begin GetKeyboardState(State); Result := ((State[vk_Menu] and 128) 0); end; procedure TForm1.MenuItem12Click(Sender: TObject); begin if ShiftDown then Form1.Caption := 'Shift' else Form1.Caption := ''; end; Наверх к содержанию Вопрос: Как изменить шрифта hint'а? Ответ: В примере перехватывается событие Application.OnShowHint и изменяется шрифт Hint'а. Пример: type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); private {Private declarations} public procedure MyShowHint(var HintStr: string; var CanShow: Boolean;var HintInfo: THintInfo); {Public declarations} end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.MyShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo); var i : integer; begin for i := 0 to Application.ComponentCount - 1 do if Application.Components[i] is THintWindow then with THintWindow(Application.Components[i]).Canvas do begin Font.Name:= 'Arial'; Font.Size:= 18; Font.Style:= [fsBold]; HintInfo.HintColor:= clWhite; end; end; procedure TForm1.FormCreate(Sender: TObject); begin Application.OnShowHint := MyShowHint; end; Наверх к содержанию Вопрос: Есть ли в Delphi эквивалент функции SendKeys Visual Basic'а? Ответ: Ниже приведена процедура, позволяющаю отправлять нажатия в любой элемент управления (window control), способный принимать ввод с клавиатуры. Вы можете использовать эту технику чтобы включать клавиши NumLock, CapsLock и ScrollLock под Windows NT. Та же техника работает и под Windows 95 для CapsLock и ScrollLock но не работает для клавиши NumLock.
Обратите внимание, что приведены четыре поцедуры: SimulateKeyDown() - эмулировать нажатие клавиши (без отпускания) SimulateKeyUp() - эмулировать отпускание клавиши SimulateKeystroke() - эмулировать удар по клавише (нажатие и отпускание) и SendKeys(), позволяющие Вам гибко контролировать посылаемые сообщения клавиатуры.
SimulateKeyDown(), SimulateKeyUp() и SimulateKeystroke() получают коды виртуальных клавиш (virtural key) (вроде VK_F1). Процедура SimulateKeystroke() получает дополнительный параметр, полезный при эмуляции нажатия PrintScreen. Когда этот параметр равен нулю весь экран будет скопирован в буфер обмена (clipboard). Если дополнительный параметр равен 1 будет скопированно только активное окно.
Четыре метода "button click" демонстрируют использование: ButtonClick1 - включает capslock ButtonClick2 - перехватывает весь экран в буфер обмена (clipboard). ButtonClick3 - перехватывает активное окно в буфер обмена (clipboard). ButtonClick4 - устанавливает фокус в Edit и отправляет в него строку. Пример: procedure SimulateKeyDown(Key : byte); begin keybd_event(Key, 0, 0, 0); end; procedure SimulateKeyUp(Key : byte); begin keybd_event(Key, 0, KEYEVENTF_KEYUP, 0); end; procedure SimulateKeystroke(Key : byte; extra : DWORD); begin keybd_event(Key,extra,0,0); keybd_event(Key,extra,KEYEVENTF_KEYUP,0); end; procedure SendKeys(s : string); var i : integer; flag : bool; w : word; begin {Get the state of the caps lock key} flag := not GetKeyState(VK_CAPITAL) and 1 = 0; {If the caps lock key is on then turn it off} if flag then SimulateKeystroke(VK_CAPITAL, 0); for i := 1 to Length(s) do begin w := VkKeyScan(s[i]); {If there is not an error in the key translation} if ((HiByte(w) $FF) and (LoByte(w) $FF)) then begin {If the key requires the shift key down - hold it down} if HiByte(w) and 1 = 1 then SimulateKeyDown(VK_SHIFT); {Send the VK_KEY} SimulateKeystroke(LoByte(w), 0); {If the key required the shift key down - release it} if HiByte(w) and 1 = 1 then SimulateKeyUp(VK_SHIFT); end; end; {if the caps lock key was on at start, turn it back on} if flag then SimulateKeystroke(VK_CAPITAL, 0); end; procedure TForm1.Button1Click(Sender: TObject); begin {Toggle the cap lock} SimulateKeystroke(VK_CAPITAL, 0); end; procedure TForm1.Button2Click(Sender: TObject); begin {Capture the entire screen to the clipboard} {by simulating pressing the PrintScreen key} SimulateKeystroke(VK_SNAPSHOT, 0); end; procedure TForm1.Button3Click(Sender: TObject); begin {Capture the active window to the clipboard} {by simulating pressing the PrintScreen key} SimulateKeystroke(VK_SNAPSHOT, 1); end; procedure TForm1.Button4Click(Sender: TObject); begin {Set the focus to a window (edit control) and send it a string} Application.ProcessMessages; Edit1.SetFocus; SendKeys('Delphi Is RAD!'); end; Наверх к содержанию Вопрос: Я загружаю TImageList динамически. Как сделать картинки из TImageList прозрачными? Ответ: См. ответ. Пример: procedure TForm1.Button1Click(Sender: TObject); var bm : TBitmap; il : TImageList; begin bm := TBitmap.Create; bm.LoadFromFile('C:DownLoadTEST.BMP'); il := TImageList.CreateSize(bm.Width,bm.Height); il.DrawingStyle := dsTransparent; il.Masked := true; il.AddMasked(bm, clRed); il.Draw(Form1.Canvas, 0, 0, 0); bm.Free; il.Free; end; Наверх к содержанию Вопрос: Как заставить TMediaPlayer проигрывать одно и тоже бесконечно? AVI например? Ответ: В примере AVI файл проигрывается снова и снова - используем событие MediaPlayer'а Notify Пример: procedure TForm1.MediaPlayer1Notify(Sender: TObject); begin with MediaPlayer1 do if NotifyValue = nvSuccessful then begin Notify := True; Play; end; end; Наверх к содержанию Вопрос: При выполнении диалога FontDialog со свойством Device равным fdBoth or fdPrinter, появляется ошибка "There are no fonts installed". Ответ: Эти установки должны показать шрифты совместимые либо с принтером либо с экраном. В примере диалог Windows ChooseFont вызывается напрямую чтобы показать список шрифтов, совместимых одновременно и с экраном и с принтером. Пример: uses Printers, CommDlg; procedure TForm1.Button1Click(Sender: TObject); var cf : TChooseFont; lf : TLogFont; tf : TFont; begin if PrintDialog1.Execute then begin GetObject(Form1.Canvas.Font.Handle, sizeof(lf),@lf); FillChar(cf, sizeof(cf), #0); cf.lStructSize := sizeof(cf); cf.hWndOwner := Form1.Handle; cf.hdc := Printer.Handle; cf.lpLogFont := @lf; cf.iPointSize := Form1.Canvas.Font.Size * 10; cf.Flags := CF_BOTH or CF_INITTOLOGFONTSTRUCT or CF_EFFECTS or CF_SCALABLEONLY or CF_WYSIWYG; cf.rgbColors := Form1.Canvas.Font.Color; if ChooseFont(cf) false then begin tf := TFont.Create; tf.Handle := CreateFontIndirect(lf); tf.COlor := cf.RgbColors; Form1.Canvas.Font.Assign(tf); tf.Free; Form1.Canvas.TextOut(10, 10, 'Test'); end; end; end; Наверх к содержанию Вопрос: Как сменить дисковод, откуда MediaPlayer проигрывает аудио CD? Ответ: См. пример. Пример: MediaPlayer1.FileName := 'E:'; Наверх к содержанию Вопрос: Как убрать кнопку с названием моей программы из Панели Задач(Taskbar)? Ответ: Отредактируйте файл-проекта (View -> Project Source) Добавьте модуль Windows в раздел uses. Application.ShowMainForm := False; в строку после "Application.Initialize;". Добавьте ShowWindow(Application.Handle, SW_HIDE); в строку перед "Application.Run;" Ваш файл проекта должен выглядеть приблизительно так: program Project1; uses Windows, Forms, Unit1 in 'Unit1.pas' {Form1}, Unit2 in 'Unit2.pas' {Form2}; {$R *.RES} begin Application.Initialize; Application.ShowMainForm := False; Application.CreateForm(TForm1, Form1); Application.CreateForm(TForm2, Form2); ShowWindow(Application.Handle, SW_HIDE); Application.Run; end. В разделе "initialization" (в самом низу) каждого unit'а добавьте begin ShowWindow(Application.Handle, SW_HIDE); end. Наверх к содержанию Вопрос: Как преобразовать цвета в строку - название цвета VCL? Ответ: Модуль graphics.pas содержит функцию ColorToString() которое преобразует допустимое значение TColor в его строковое представление используя либо константу-название цвета (по возможности) либо шестнадцатиричную строку. Обратная функция - StringToColor() Пример: procedure TForm1.Button1Click(Sender: TObject); begin Memo1.Lines.Add(ColorToString(clRed)); Memo1.Lines.Add(IntToStr(StringToColor('clRed'))); end; Наверх к содержанию Вопрос: При показе максимизированное формы она перекрывает task bar и не выравнивается по верху экрана. В чем тут дело? Ответ: Это может произойти когда свойство position формы установленно в poScreenCenter. Установите position = poDefault. Наверх к содержанию Вопрос: Как заставить TEdit не 'пикать' при нажатии недопустимых клавиш? Ответ: Перехватите событие KeyPress и установите key = #0 для недопустимых клавиш. Пример: procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); begin if ((UpCase(Key) < 'A') or (UpCase(Key) > 'Z')) then Key := #0; end; Наверх к содержанию Вопрос: Как получить число и список всех компонентов, расположенных на TNoteBook? Ответ: В примере список выводится на Listbox. Пример: procedure TForm1.Button1Click(Sender: TObject); var n: integer; p: integer; begin ListBox1.Clear; with Notebook1 do begin for n := 0 to ControlCount - 1 do begin with TPage(Controls[n]) do begin ListBox1.Items.Add('Notebook Page: ' + TPage(Notebook1.Controls[n]).Caption); for p := 0 to ControlCount - 1 do ListBox1.Items.Add(Controls[p].Name); ListBox1.Items.Add(EmptyStr); end; end; end; end; Наверх к содержанию Вопрос: Я хочу вставить escape code в строку при использовании функции Format(). Например, я хочу создать строку, содержащую символ табуляции. В "C" я бы написал что-то вроде sprintf(buffer, "%st%s", str);. А как это будет на Pascal'e? Ответ: Функция Format Pascal'я не использует escape codes. Вместо этого нужно вставить в строку действительное значение символа в кодировке ASCII. Пример: Buffer := Format('%s'#9'%s', [Str1, Str2]); ShowMessage(Format('%s'#9'%s', ['Column1', 'Column2'])); Наверх к содержанию Вопрос: Как показать первый кадр AVI-файла? Ответ: См. пример. Пример: procedure TForm1.Button1Click(Sender: TObject); begin Application.ProcessMessages; MediaPlayer1.Open; Application.ProcessMessages; MediaPlayer1.Step; Application.ProcessMessages; MediaPlayer1.Previous; end; Наверх к содержанию Вопрос: Когда пользователь щелкает по listview, он переходит в режим редактирования. Как перевисти его в редим редактирования по нажатию клавиши (например F2)? Ответ: Перехватите F2 на событии keydown. Пример: procedure TForm1.ListView1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Ord(Key) = VK_F2 then ListView1.Selected.EditCaption; end; Наверх к содержанию Вопрос: Когда я добавляю обьект в список TStrings как мне его потом уничтожить? Ответ: Просто вызовите метод free этого обьекта. Пример: procedure TForm1.FormCreate(Sender: TObject); var Icon: TIcon; begin Icon := TIcon.Create; Icon.LoadFromFile('C:Program FilesBorlandImagesCONSTRUC.ICO'); ListBox1.Items.AddObject('Item 0', Icon); end; procedure TForm1.FormDestroy(Sender: TObject); begin ListBox1.Items.Objects[0].Free; end; Наверх к содержанию Вопрос: Вместо печати графики я хочу использовать резидентный шрифт принтера. Как? Ответ: Используте функцию Windows API - GetStockObject() чтобы получить дескриптор (handle) шрифта по умолчанию устройства (DEVICE_DEFAULT_FONT) и передайте его Printer.Font.Handle. Пример: uses Printers; procedure TForm1.Button1Click(Sender: TObject); var tm : TTextMetric; i : integer; begin if PrintDialog1.Execute then begin Printer.BeginDoc; Printer.Canvas.Font.Handle := GetStockObject(DEVICE_DEFAULT_FONT); GetTextMetrics(Printer.Canvas.Handle, tm); for i := 1 to 10 do begin Printer.Canvas.TextOut(100,i * tm.tmHeight + tm.tmExternalLeading,'Test'); end; Printer.EndDoc; end; end; Наверх к содержанию Вопрос: Мне нужно программно установить некоторые файлы с установочного диска Windows. На многих компьютерах CAB-файлы установки Windows находятся в каком-то каталоге на жестком диске, на других - Windows был установлен с CD. Как узнать откуда была установленна Windows? Ответ: Эту информацию можно получить из реестра. Пример: uses Registry; procedure TForm1.Button1Click(Sender: TObject); var reg: TRegistry; begin reg := TRegistry.Create; reg.RootKey := HKEY_LOCAL_MACHINE; reg.OpenKey('SoftwareMicrosoftWindowsCurrentVersionSETUP',false); ShowMessage(reg.ReadString('SourcePath')); reg.CloseKey; reg.free; end; Наверх к содержанию Вопрос: Как получить строку сообщения об ошибке Windows код которой получен функцией GetLastError? Ответ: Функция RTL SysErrorMessage(GetLastError). Пример: procedure TForm1.Button1Click(Sender: TObject); begin {Cause a Windows system error message to be logged} ShowMessage(IntToStr(lStrLen(nil))); ShowMessage(SysErrorMessage(GetLastError)); end; Наверх к содержанию Вопрос: Как заставить Delphi выполнять еще более строгую проверка типов? Напрмер - я создаю пользовательский тип, унаследованный от double и могу передавать его любым функциям, принимающим параметр типа double. Как заставить компилятор проводить более строгую проверку типов и выдавать предупреждение в таких случаях? Ответ: См. ответ. Пример: type TStrongType = type Double; type TWeakType = Double; procedure AddWeakType(var d : TWeakType); begin d := d + 1; end; procedure AddStrongType(var d : TStrongType); begin d := d + 1; end; procedure AddDoubleType(var d : Double); begin d := d + 1; end; procedure TForm1.Button1Click(Sender: TObject); var d : Double; s : TStrongType; w : TWeakType; begin AddDoubleType(d); {compiles fine} AddDoubleType(w); {compiles fine} AddDoubleType(s); { TheRangeMax then TheRange := TheRangeMax; {Set the vertical scroll bar} SetScrollPos(WindowHandle, SB_VERT, TheRange, true); end; {Call the old Window procedure to allow processing of the message.} NewWindowProc := CallWindowProc(OldWindowProc, WindowHandle, TheMessage, ParamW, ParamL); end; procedure TForm1.FormCreate(Sender: TObject); begin {Set the new window procedure for the control and remember the old window procedure.} OldWindowProc := Pointer(SetWindowLong(ScrollBox1.Handle, GWL_WNDPROC, LongInt(@NewWindowProc))); end; procedure TForm1.FormDestroy(Sender: TObject); begin {Set the window procedure back to the old window procedure.} SetWindowLong(ScrollBox1.Handle, GWL_WNDPROC, LongInt(OldWindowProc)); end; Наверх к содержанию Вопрос: Как сделать прямоугольник для выделения части картинки для редактирования? Ответ: Самый простой способ - воспользоваться функцией Windows API DrawFocusRect. Функция DrawFocusRect использует операцию XOR при рисовании - таким образом вывод прямоугольника дважды с одними и теми же координатами стирает прямоугольник, и прямоугольник всегда будет виден, на фоне какого бы цвета он не выводился. Пример: type TForm1 = class(TForm) procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private {Private declarations} Capturing : bool; Captured : bool; StartPlace : TPoint; EndPlace : TPoint; public {Public declarations} end; var Form1: TForm1; implementation {$R *.DFM} function MakeRect(Pt1 : TPoint; Pt2 : TPoint) : TRect; begin if pt1.x < pt2.x then begin Result.Left := pt1.x; Result.Right := pt2.x; end else begin Result.Left := pt2.x; Result.Right := pt1.x; end; if pt1.y < pt2.y then begin Result.Top := pt1.y; Result.Bottom := pt2.y; end else begin Result.Top := pt2.y; Result.Bottom := pt1.y; end; end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Captured then DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace)); StartPlace.x := X; StartPlace.y := Y; EndPlace.x := X; EndPlace.y := Y; DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace)); Capturing := true; Captured := true; end; procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if Capturing then begin DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace)); EndPlace.x := X; EndPlace.y := Y; DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace)); end; end; procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Capturing := false; end; Наверх к содержанию Вопрос: Можно ли использовать иконку как картинку на кнопке TSpeedButton? Ответ: Можно. См. пример. Пример: uses ShellApi; procedure TForm1.FormShow(Sender: TObject); var Icon: TIcon; begin Icon := TIcon.Create; Icon.Handle := ExtractIcon(0,'C:WINDOWSNOTEPAD.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:downloadtest.bmp'); Bm2.Width := Bm1.Width; Bm2.Height := Bm1.Height; bm2.Canvas.Brush.Color := CoolBar1.Color; bm2.Canvas.BrushCopy(Rect(0, 0, bm2.Width, bm2.Height), Bm1, Rect(0, 0, Bm1.width, Bm1.Height), ClWhite); bm1.Free; CoolBar1.Bitmap.Assign(bm2); bm2.Free; end; Наверх к содержанию Вопрос: Ползунок компонента TScrollBar все время мигает. Как это отключить? Ответ: Установите свойтсво ScrollBar.TabStop в False. Наверх к содержанию Вопрос: Как программно перевести DBgrid в реим редактирования и установить курсор в окошке редактирования в требуемую позицию? Ответ: Переведите таблицу в режим редактирования, затем получите дескриптор (handle) окна редактирования и перешлите ей сообщение EM_SETSEL. В качестве параметров вы должны переслать начальную позицию курсора, и конечную позицию, определяющую конец выделения текста цветом. В приведенном примере курсор помещается во вторую позицию, текст внутри ячейки не выделяется. Пример: procedure TForm1.Button1Click(Sender: TObject); var h : THandle; begin Application.ProcessMessages; DbGrid1.SetFocus; DbGrid1.EditorMode := true; Application.ProcessMessages; h:= Windows.GetFocus; SendMessage(h, EM_SETSEL, 2, 2); end; Наверх к содержанию Вопрос: Как поместить курсор в определенную позицию edit'а и подобных ему элементов управления? Ответ: Можно использовать методы Delphi SelStart() и SelectLength(). Пример: procedure TForm1.Button1Click(Sender: TObject); begin Edit1.SetFocus; {переводим курсор во вторую позицию} Edit1.SelStart := 2; {не выделяем никакого текста} Edit1.SelLength := 0; end; Наверх к содержанию Вопрос: Как среагировать на минимизацию-максимизацию формы перед тем как произойдет изменение размера формы? Ответ: В примере перехватывается сообщение WM_SYSCOMMAND. Если это сообщение говорит о минимизации или максимизации формы - пищит динамик. Пример: type TForm1 = class(TForm) private {Private declarations} procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND; public {Public declarations} end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.WMSysCommand; begin if (Msg.CmdType = SC_MINIMIZE) or (Msg.CmdType = SC_MAXIMIZE) then MessageBeep(0) else inherited; end; Наверх к содержанию Вопрос: Можно ли сделать так - одна форма показывает другую и остается позади нее, но фокус ввода не переходит к новой форме, а остается у старой? Ответ: В примере показывается не автосоздаваемая (non auto-created) форма, но фокус ввода ей не передается. Пример: uses Unit2; procedure TForm1.Button1Click(Sender: TObject); begin Form2 := TForm2.Create(Application); Form2.Visible := FALSE; ShowWindow(Form2.Handle, SW_SHOWNA); end; Наверх к содержанию Вопрос: На некоторых laptop компьютерах может не быть флоппи дисковода. Можно ли удалять из списка TDriveComboBox диски которые отключены? Ответ: В примере TDriveComboBox не показывает дисководы, которые не готовы. (not ready). Учтите что на многих компьютерах будет ощутимая задержка при поверке plug&play флоппи дисковода. Пример: procedure TForm1.FormCreate(Sender: TObject); var i : integer; OldErrorMode : Word; OldDirectory : string; begin OldErrorMode := SetErrorMode(SEM_NOOPENFILEERRORBOX); GetDir(0, OldDirectory); i := 0; while i