Можно ли обратиться к колонке или строке 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
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, но при попытке переключать страницы этой клавишей программа пикает и ничего не происходит.
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 — таким образом можно добавиь дополнительные колонки.
При использовании BitBtn Caption(текст) и картинка(bitmap) из файла не видны одновременно. Почему?
Ответ:
Это может происходить если картинка слишком велика. Класс TBitBtn сначала рисует картинку, а затем выводит текст над, под, слева или справа от картинки (в завивимости от свойства Layout). Если размер картинки такой же как у всей кнопки для вывода текста просто не остается места. Если Вам нужно получить кнопку такого же размера как Ваша картинка и видеть при этом надпись на кнопке Вам придется выводить текст надписи непосредственно на канву картинки.
Можно ли изменить вид текстового курсора (каретки) edit'а или другого элемента управления Windows?
Ответ:
Можно! В примере показано как создать два цветных "bitmap'а": "улыбчивый" и "хмурый" и присвоить их курсору edit'а. Для этого нужно перехватить оконную процедуру edit'а. Чтобы сделать это заменим адрес оконной процедуры Edit'а нашим собственным, а старую оконную процедуру будем вызывать по необходимости. Пример показывает "улыбчивый" курсор при наборе текста и "хмурый" при забое клавишей backspace.
При использовании модулей доступа к 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#8594;Options#8594;Directories/Conditionals#8594;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", позволяющее Вам использовать любой цвет букв.
Выводите текст надписи непосредственно на "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#8594;Project Source" и измените код инициализации приложения, так что порядок создания форм зависил от какого-то условия.
Примечание: Вам придется редактировать этот код, если Вы добавите в приложение новые формы.
begin
Application.Initialize;
if lt;какое-то условиеgt; then begin
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TForm2, Form2);
end else begin
Application.CreateForm(TForm2, Form2);
Application.CreateForm(TForm1, Form1);
end;
end.
Application.Run;
Вопрос:
Как программно "щелкнуть" по компоненту speed button? Я пытался использовать SendMessage но у Speedbuttons нет "handle".
Ответ:
В примере используется метод Perform класса TControl для отправки сообщения.
Почему методы рисования Delphi (например MoveTo и LineTo) рисуют на один пиксел короче?
Ответ:
Так работает большинство графических систем, включая Windows. Библиотека VCL просто передает вызовы в функции GDI. Если Вы хотите нарисовать линию с последним пикселом включительно просто добавте единицу к координатам.
Вопрос:
Как показать подсказки "hints" для элементов меню?
Ответ:
В примере создается обработчик события Application.Hint — подсказки меню изображаются на status panel.
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 lt;gt; FaDirectory) and (DirInfo.Attr and FaVolumeId lt;gt; 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)?
Во первых необходимо получить 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" клавиши в момент когда меню показано?
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) lt;gt; 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));
Как вывести на элемент управления (Window control) текст, содержащий амперсанд — amp;?
Ответ:
Используя два амперсанда подряд. Windows интерпритирует одиночный амперсанд как указание на то, что следующий символ — горячая клавиша (и поддчеркивает следующий символ вместо изображения аперсанда).
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'е.
Как создать отдельную подсказку (hint) для каждой ячейки StringGrid?
Ответ:
В приведенном примере отслеживается движение курсора мыши — при перемещении между ячейками StringGrid'а — появляется окно подсказки (hint), показывающее номер текущей строки и колонки.
Примечание: внесение изменений в VCL не поддерживается Borland или Borland Developer Support.
Но если Вы решили сделать это...
Изменения в код VCL никогда не должны вносится в секцию "interface" модуля — только в секцию "implimentation". Наиболее безопасный способ внести изменения в VCL — создать новый каталог названный "исправленный VCL". Скопируйте файл VCL который Вы хотите изменить в этот каталог. Внесите изменения (лучше прокомментировать их) в этот файл. Затем добавьте путь к Вашему каталогу "исправленный VCL" в самое начало "library path". Перезапустите Delphi/C++ Builder и перекомпилируйте Ваш проект. "library path" можно изменить в меню:
Delphi 1 : Options | Environment | Library
Delphi 2 : Tools | Options | Library
Delphi 3 : Tools | Environment Options | Library
Delphi 4 : Tools | Environment Options | Library C++
Builder : Options | Environment | Library
Вопрос:
Как в Delphi реализовать функцию — эквивалент TwipsPerPixel из VisualBasic?
Ответ:
Функции TwipsPerPixelX и TwipsPerPixelY, приведенные в примере реализуют ту же функциональность в Delphi.
Пример:
function TwipsPerPixelX(Canvas : TCanvas) : Extended;
begin
result := 1440 / GetDeviceCaps(Canvas.Handle, LOGPIXELSX);
end;
function TwipsPerPixelY(Canvas : TCanvas) : Extended;
begin
result := 1440 / GetDeviceCaps(Canvas.Handle, LOGPIXELSY);
Как вставить содержимое файла в текущую позицию курсора в компонете TMemo?
Ответ:
Считайте файл в TMemoryStream, затем используйте метод TMemo SetSelTextBuf() для вставки текста;
var
TheMStream : TMemoryStream;
Zero : char;
begin
TheMStream := TMemoryStream.Create;
TheMStream.LoadFromFile('C:\AUTOEXEC.BAT');
TheMStream.Seek(0, soFromEnd); //Null terminate the buffer!
Zero := #0;
TheMStream.Write(Zero, 1);
TheMStream.Seek(0, soFromBeginning);
Memo1.SetSelTextBuf(TheMStream.Memory);
TheMStream.Free;
end;
Вопрос:
Как в компоненте TMemo перехватить нажатие Ctrl-V и вставить специальный текст не из буфера обмена (clipboard)?
Ответ:
См. пример.
Пример:
uses ClipBrd;
procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if ((Key = ord('V')) and (ssCtrl in Shift)) then begin
if Clipboard.HasFormat(CF_TEXT) then ClipBoard.Clear;
Memo1.SelText := 'Delphi is RAD!';
key := 0;
end;
end;
Вопрос:
Как создать эквивалент TEdit но только с выравниваением вводимого текста по центру или по правой стороне?
Ответ:
TEdit не поддерживает выравниваение текста по центру и по правой стороне — лучше использовать компонент TMemo. Вам понадобится запретить пользователю нажимать Enter, Ctrl-Enter и всевозможные комбинации клавиш со стрелками, чтобы избежать появления нескольких строк в Memo. Этого можно добиться и просматривая содержимое текста в TMemo в поисках кода возврата каретки (13) и перевода строки(10) на событиях TMemo Change и KeyPress. Можно также заменять код возврата каретки на пробел — для того чтобы позволять вставку из буфера обмена многострочного текста в виде одной строки.
Как бы мне создать эдакий trackbar в котором вместо широкой белой полоски с ползунком была бы тонкая линия?
Ответ:
В примере создается компонент, унаследованный от TTrackbar который переопределяет метод CreateParams и убират флаг TBS_ENABLESELRANGE из Style. Константа TBS_ENABLESELRANGE обьявленна в модуле CommCtrl.
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;
Polygon — метод компонента TCanvas получает в качестве параметра динамический массив точек. Функция PolyPolygon() из Windows GDI получает указатель на массив точек.
Как создать невизуальный компонент без иконки, которая изображается в палитре компонентов в "design-time" (вроде TField)?
Ответ:
Невизуальные компоненты без иконки удобны для субкомпонентов, связанных с какими-то другими компонентами. Создайте компонент как обычно, но используйте RegisterNoIcon вместо RegisterComponent.
Вопрос:
Как показывать нестандартный встроенный редактор (inplace editor) в ячейке stringgrid (например combobox).
Ответ:
См. пример
Пример:
procedure TForm1.FormCreate(Sender: TObject);
begin
{Высоту combobox'а не изменишь, так что вместо combobox'а будем изменять высоту строки grid'а !}
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
var R: TRect;
begin
if ((ACol = 3) AND (ARow lt;gt; 0)) then begin
{Ширина и положение ComboBox должно соответствовать ячейке StringGrid}
R := StringGrid1.CellRect(ACol, ARow);
R.Left := R.Left + StringGrid1.Left;
R.Right := R.Right + StringGrid1.Left;
R.Top := R.Top + StringGrid1.Top;
R.Bottom := R.Bottom + StringGrid1.Top;
ComboBox1.Left := R.Left + 1;
ComboBox1.Top := R.Top + 1;
ComboBox1.Width := (R.Right + 1) - R.Left;
ComboBox1.Height := (R.Bottom + 1) - R.Top;
{Покажем combobox}
ComboBox1.Visible := True;
ComboBox1.SetFocus;
end;
CanSelect := True;
end;
Вопрос:
Как узнать есть ли в заданном CD-ROM'е Audio CD?
Ответ:
Можно использовать функцию Windows API GetDriveType() чтобы определить является ли дисковод CD-ROM'мом. И функцию API GetVolumeInformation() чтобы проверить VolumeName на равенство 'Audio CD'.
Пример:
function IsAudioCD(Drive : char) : bool;
var
DrivePath : string;
MaximumComponentLength : DWORD;
FileSystemFlags : DWORD;
VolumeName : string;
Begin
result := false;
DrivePath := Drive + ':\';
if GetDriveType(PChar(DrivePath)) lt;gt; DRIVE_CDROM then exit;
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 lt;gt; nil then SetOrdProp(Button1, p, clRed)
else ShowMessage('Button has no color property');
p := HasProperty(Label1, 'Color');
if p lt;gt; nil then SetOrdProp(Label1, p, clRed)
else ShowMessage('Label has no color property');
p := HasProperty(Label1.Font, 'Color');
if p lt;gt; 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 пиксел.
Как выполнить какой-то процесс тогда, когда пользователь не работает с моим приложением?
Ответ:
Создайте процедуру, которая будет вызываться при событии 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) на две картинки (одна из них — картинка которая будет показана когда строка меню доступна, вторая — когда строка меню недоступна).
Как узнать число кадров 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.
В примере перехватывается событие 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) lt;gt; $FF) and (LoByte(w) lt;gt; $FF)) then begin
{If the key requires the shift key down - hold it down}
if HiByte(w) and 1 = 1 then SimulateKeyDown(VK_SHIFT);
{Send the VK_KEY}
SimulateKeystroke(LoByte(w), 0);
{If the key required the shift key down - release it}
if HiByte(w) and 1 = 1 then SimulateKeyUp(VK_SHIFT);
end;
end;
{if the caps lock key was on at start, turn it back on}
if flag then SimulateKeystroke(VK_CAPITAL, 0);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
{Toggle the cap lock}
SimulateKeystroke(VK_CAPITAL, 0);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
{Capture the entire screen to the clipboard}
{by simulating pressing the PrintScreen key}
SimulateKeystroke(VK_SNAPSHOT, 0);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
{Capture the active window to the clipboard}
{by simulating pressing the PrintScreen key}
SimulateKeystroke(VK_SNAPSHOT, 1);
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
{Set the focus to a window (edit control) and send it a string}
Application.ProcessMessages;
Edit1.SetFocus;
SendKeys('Delphi Is RAD!');
end;
Вопрос:
Я загружаю TImageList динамически. Как сделать картинки из TImageList прозрачными?
Ответ:
См. ответ.
Пример:
procedure TForm1.Button1Click(Sender: TObject);
var
bm : TBitmap;
il : TImageList;
begin
bm := TBitmap.Create;
bm.LoadFromFile('C:\DownLoad\TEST.BMP');
il := TImageList.CreateSize(bm.Width,bm.Height);
il.DrawingStyle := dsTransparent;
il.Masked := true;
il.AddMasked(bm, clRed);
il.Draw(Form1.Canvas, 0, 0, 0);
bm.Free;
il.Free;
end;
Вопрос:
Как заставить TMediaPlayer проигрывать одно и тоже бесконечно? AVI например?
Ответ:
В примере AVI файл проигрывается снова и снова — используем событие MediaPlayer'а Notify
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 вызывается напрямую чтобы показать список шрифтов, совместимых одновременно и с экраном и с принтером.
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) lt;gt; 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#8594;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()
for p := 0 to ControlCount - 1 do ListBox1.Items.Add(Controls[p].Name);
ListBox1.Items.Add(EmptyStr);
end;
end;
end;
end;
Вопрос:
Я хочу вставить escape code в строку при использовании функции Format(). Например, я хочу создать строку, содержащую символ табуляции. В "C" я бы написал что-то вроде sprintf(buffer, "%s\t%s", str);. А как это будет на Pascal'e?
Ответ:
Функция Format Pascal'я не использует escape codes. Вместо этого нужно вставить в строку действительное значение символа в кодировке ASCII.
Когда пользователь щелкает по 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 как мне его потом уничтожить?
Вместо печати графики я хочу использовать резидентный шрифт принтера. Как?
Ответ:
Используте функцию Windows API — GetStockObject() чтобы получить дескриптор (handle) шрифта по умолчанию устройства (DEVICE_DEFAULT_FONT) и передайте его Printer.Font.Handle.
Мне нужно программно установить некоторые файлы с установочного диска Windows. На многих компьютерах CAB-файлы установки Windows находятся в каком-то каталоге на жестком диске, на других — Windows был установлен с CD. Как узнать откуда была установленна 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); {lt;- compile error}
AddDoubleType(double(s)); {compiles fine}
AddWeakType(d); {compiles fine}
AddWeakType(w); {compiles fine}
AddWeakType(s); {lt;- compile error}
AddWeakType(TWeakType(s)); {compiles fine}
AddStrongType(d); {lt;- compile error}
AddStrongType(TStrongType(d)); {compiles fine}
AddStrongType(w); {lt;- 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 или какой-либо еще диалог.
Form1.Caption := 'A dialog or message box has popped up';
end else inherited // lt;- остальное сделает родительская процедура
end;
procedure TForm1.Button1Click(Sender: TObject);
begin ShowMessage('Test Message');
end;
Вопрос:
Как узнать размеры TComboBox с показанным выпадающим списком до показа списка?
Ответ:
На событии FormShow пошлите сообщение CB_SHOWDROPDOWN в ComboBox дважды — один раз чтобы заставить список выпасть, второй — чтобы убрать его. Затем пошлите сообщение CB_GETDROPPEDCONTROLRECT, передав в качестве параметра адрес TRect. TRect будет содержать экранные кординаты прямоугольника описывающего ComboBox вместе с выпавшим списком. Затем Вы можете вызвать ScreenToClient чтобы преобразовать экранные кординаты в координаты клиентской области окна.
Я хочу создать в своей программе меню "а ля Дельфи 4". Как это сделать?
Ответ:
1. Разместите на форме TControlBar. (закладка Additional) Установите Align = Client.
2. Разместите TToolBar (закладка Win32) внутри TControlBar.
3. Установите в True свойства Flat и ShowCaptions этого TToolBar.
4. Создайте на TToolBar столько TToolButtons сколько Вам нужно. (щелкнув по TToolBar правой кнопкой и выбрав NewButton)
5. Установите свойство Grouped = True для всех TToolButtons. Это позволит меню выпадать при перемещении курсора между главными пунктами меню (если меню уже показано).
6. Разместите на фоме TMainMenu и убедитесь, что оно НЕ присоединено как меню главной формы. (посмотрите свойство Menu формы).
7. Создайте все пункты меню (щелкнув по TMainMenu кнопкой и выбрав Menu Designer)
8. Для каждой TToolButton установите ее MenuItem равным соответсвующему пункту TMainMenu.
Вопрос:
Как добиться того, чтобы TMemo и TEdit имели работали не только в режиме вставки символов, но и в режиме замены?
Ответ:
Элементы управления Windows TEdit и TMemo не имеют режима замены. Однако этот режим можно эмулировать установив свойство SelLength edit'а или memo в 1 при обработке события KeyPress. Это заставит его перезаписывать символ в текущей позиции курсора. В примере этот способ используется для TMemo. Режим вставка/замена переключается клавишей "Insert".
Пример:
type TForm1 = class(TForm)
Memo1: TMemo;
procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure Memo1KeyPress(Sender: TObject; var Key: Char);
private
{Private declarations}
InsertOn : bool;
public
{Public declarations}
end;
var Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if (Key = VK_INSERT) and (Shift = []) then InsertOn := not InsertOn;
end;
procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
if ((Memo1.SelLength = 0) and (not InsertOn)) then Memo1.SelLength := 1;
end;
Вопрос:
Как отправить сообщение сразу всем элементам управления формы?
Ответ:
Можно использовать Screen.Forms[i].BroadCast(msg); где [i] — индекс той формы, которой Вы хотите переслать сообщение. BroadCast работает со всеми компонентами, потомками TWinControls и отправляет сообщение всем дочерним компонентам из массива Controls. Если один из дочерних компонентов обрабатывает это сообщение и устанавливает Msg.Result в ненулевое значение — дальнейшая рассылка сообщения останавливается.
Вопрос:
При попытке присвоить значение свойству "selected" ListBox'а вырабатывается exception "Index is out of bounds". В чем тут дело и как присвоить значение свойству selected?
Ответ:
Свойство "selected" компонента ТListBox может быть использованно только если свойство MultiSelect установленно в True. Если Вы работаете с ListBox'ом у которого MultiSelect=false то используйте свойство ItemIndex.
Пример:
procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.Add('1');
ListBox1.Items.Add('2');
{This will fail on a single selection ListBox}
// ListBox1.Selected[1] := true;
ListBox1.ItemIndex := 1; {This is ok}
end;
Вопрос:
Как ограничить длину текста, вводимого в TEdit, так чтобы ширина текста не превышала ширину TEdit'а?
Ответ:
В примере приведено два способа ограничить длину текста в TEdit так чтобы она не превышала ширину клиентской области окна TEdit'а и не появлялась прокрутка текста. Первый способ устанавливает свойство TEdit'а MaxLength равным числу букв "W", которые поместятся в TEdit. "W" выбрана потому, что является, наверное, самой широкой буквой в любом шрифте. Этот метод сносно работает для шрифтов с фиксированной шириной букв, но для шрифтов с переменной шириной букв вряд ли сгодится. Второй способ перхватывает событие KeyPress TEdit'а и измеряет ширину уже введенного текста и ширину нового символа. Если ширина больше чем клиентская область TEdit'а новый символ отбрасывается и вызывается MessageBeep.
Пример:
procedure TForm1.FormCreate(Sender: TObject);
var
cRect : TRect;
bm : TBitmap;
s : string;
begin
Windows.GetClientRect(Edit1.Handle, cRect);
bm := TBitmap.Create;
bm.Width := cRect.Right;
bm.Height := cRect.Bottom;
bm.Canvas.Font := Edit1.Font;
s := 'W';
while bm.Canvas.TextWidth(s) lt; CRect.Right do s := s + 'W';
if length(s) gt; 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) lt;gt; VK_TAB) and (Ord(Key) lt;gt; VK_RETURN) and (Ord(Key) lt;gt; VK_LEFT) and (Ord(Key) lt;gt; 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) gt; CRect.Right then begin
Key := #0;
MessageBeep(-1);
end;
bm.Free;
end;
end;
Вопрос:
Как сохранить обьект TFont в реестре/ini/файле/таблице базы данных?
Ответ:
Нужно сохранять атрибуты шрифта (имя, размер и т.п.) а не сам обьект TFont. После считывания этой информации следует проверить существует ли такой шрифт, прежде чем его использовать. Чтобы не показаться голословным дополню ответ Borland'а своим примером сохранения/чтения шрифта в/из реестра
if ReadFontFromRegistry(NFont,'Delphi Kingdom\Fonts') then begin
//здесь добавить проверку - существует ли шрифт
Label1.Font.Assign(NFont);
NFont.Free;
end;
end;
Вопрос:
Как перемещать компонент мышкой во время работы программы "runtime"?
Ответ:
Перехватить событие OnMouseDown, запомнить x и y координты курсора мыши. Отслеживать движение мыши по событию OnMouseMove и перемещать компонент вслед за курсором мыши до тех пор пока не произойдет событие OnMouseUp. В примере показано перемещение компонента TButton. Перемещение начинается, когда пользователь "берет" TButton мышью, удерживая нажатой клавишу "Сontrol".
При попытке создать обьект класса 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). Пример показывает как перехватить вижение мыши во всей неклиенстской области окна (рамка и заголовок).
При попытке использовать метод TCanvas.StretchDraw чтобы нарисовать иконку увеличенной ее размер не изменяется. Что делать?
Ответ:
Иконки всегда рисуются размером принятым в системе по умолчанию. Чтобы показать увеличенный вид иконки скопируйте ее на bitmap, а зате используйте метод TCanvas.StretchDraw.
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-файлу. В нашем примере:
begin ResHandle := FindResource(hInstance, PChar(TheJPEG), 'JPEG');
MemHandle := LoadResource(hInstance, ResHandle);
ResPtr := LockResource(MemHandle);
MemStream := TMemoryStream.Create;
JPEGImage := TJPEGImage.Create;
ResSize := SizeOfResource(hInstance, ResHandle);
MemStream.SetSize(ResSize);
MemStream.Write(ResPtr^, ResSize);
FreeResource(MemHandle);
MemStream.Seek(0, 0);
JPEGImage.LoadFromStream(MemStream);
ThePicture.Assign(JPEGImage);
JPEGImage.Free;
MemStream.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
LoadJPEGFromRes('MYJPEG', Image1.Picture);
end;
Вопрос:
Как перехватить сообщения прокрутки в TScrollBox?
Ответ:
Следующий пример перехватывает сообщения о прокрутке компонента TScrollBox и синхронизирует обе линейки прокрутки. Сообщения прокрутки перехватываются с помощью переопределения оконной процедуры (WinProc) ScrollBox'а.
Пример:
type
{$IFDEF WIN32}
WParameter = LongInt;
{$ELSE}
WParameter = Word;
{$ENDIF}
LParameter = LongInt;
{Declare a variable to hold the window procedure we are replacing}
Как сделать прямоугольник для выделения части картинки для редактирования?
Ответ:
Самый простой способ — воспользоваться функцией Windows API DrawFocusRect. Функция DrawFocusRect использует операцию XOR при рисовании — таким образом вывод прямоугольника дважды с одними и теми же координатами стирает прямоугольник, и прямоугольник всегда будет виден, на фоне какого бы цвета он не выводился.
Ползунок компонента 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. Если это сообщение говорит о минимизации или максимизации формы — пищит динамик.
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). Учтите что на многих компьютерах будет ощутимая задержка при поверке plugamp;play флоппи дисковода.
Как обновить список дисков компонента TDriveComboBox, учитывая, что могут быть подключены/отключены сетевые диски и произведена "горячая замена" plugamp;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 := 'amp;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) методу класса-предка.
inherited; //вызываем унаследованный от предка метод
end;
end;
Вопрос:
Можно ли уменьшить потребляемые компонентами TNotebook и TTabbedNotebook ресурсы?
Ответ:
Да. Можно уничтожать обьекты, расположенные не на текущей странице TNotebook или TTabbedNotebook. В примере вызывается защищенный (Protected) метод путем создания так называемый "class cracer'ов".
type TMyTabbedNotebook = class(TTabbedNotebook); //это наш "class cracer"
type TMyNotebook = class(TNotebook);
procedure TForm1.TabbedNotebook1Change(Sender: TObject; NewTab: Integer; var AllowChange: Boolean);
begin
with TabbedNotebook1 do //вызываем защищенный метод родительского класса
Функция 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}
Некоторые компоненты не меняют курсор мыши до тех пор пока пользователь не сдвинет мышь. Как эмулировать движение мыши?
Ответ:
В примере мышка слегка "подталкивается" без участия пользователя.
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');