Delphi VCL FAQ


Вопрос:

Как разместить прозрачную надпись на 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".

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

Пример:

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
	ShowMessage('clicked');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
	SpeedButton1.Perform(WM_LBUTTONDOWN, 0, 0);
	SpeedButton1.Perform(WM_LBUTTONUP, 0, 0);
end;


Наверх к содержанию



Вопрос:
Можно ли отключить определенный элемент в RadioGroup?

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

Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
TRadioButton(RadioGroup1.Controls[1]). Enabled := False;
end;


Наверх к содержанию



Вопрос:

Почему методы рисования Delphi (например MoveTo и LineTo) рисуют на один пиксел короче?

Ответ:

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


Наверх к содержанию



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

Ответ:

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

Пример:

type
TForm1 = class(TForm)
Panel1: TPanel;
MainMenu1: TMainMenu;
MenuItemFile: TMenuItem;
MenuItemOpen: TMenuItem;
MenuItemClose: TMenuItem;
OpenDialog1: TOpenDialog;
procedure FormCreate(Sender: TObject);
procedure MenuItemCloseClick(Sender: TObject);
procedure MenuItemOpenClick(Sender: TObject);
private
{Private declarations}
procedure HintHandler(Sender: TObject);
public
{Public declarations}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
Panel1.Align := alBottom;
MenuItemFile.Hint := 'File Menu';
MenuItemOpen.Hint := 'Opens A File';
MenuItemClose.Hint := 'Closes the Application';
Application.OnHint := HintHandler;
end;

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

procedure TForm1.MenuItemCloseClick(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.MenuItemOpenClick(Sender: TObject);
begin
if OpenDialog1.Execute then
Form1.Caption := OpenDialog1.FileName;
end;


Наверх к содержанию



Вопрос:
Как опеделить состояние списка ComboBox, выпал/скрыт?

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

Пример:

if SendMessage(ComboBox1.Handle, CB_GETDROPPEDSTATE,0,0) = 1 then
begin {список ComboBox выпал}

end;


Наверх к содержанию



Вопрос:
Как удалить каталог вместе со всеми содержащимися в нем файлами?

Ответ:

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


procedure TForm1.Button1Click(Sender: TObject);
var
	DirInfo: TSearchRec;
	r: integer;
begin
	r := FindFirst('C:\Download\*.*', FaAnyfile, DirInfo);
	while r = 0 do
	begin
		if ((DirInfo.Attr and FaDirectory <> FaDirectory) and
			(DirInfo.Attr and FaVolumeId <> FaVolumeID)) then
		if DeleteFile(pChar('C:\Download\' + DirInfo.Name))= false then
			ShowMessage('Unable to delete: C:\Download\'+DirInfo.Name);
		r := FindNext(DirInfo);
	end;
	SysUtils.FindClose(DirInfo);
	if RemoveDirectory('C:\Download\') = false then
		ShowMessage('Unable to delete directory: C:\Download\');
end;


Наверх к содержанию



Вопрос:

Как отключить системное меню формы и кнопки Minimize, Maximize, and Close во время выполнения(Runtime)?

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

Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
	{Disable}
	Form1.BorderIcons := Form1.BorderIcons - [biSystemMenu, biMinimize, biMaximize];
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
	{Enable}
	Form1.BorderIcons := Form1.BorderIcons + [biSystemMenu, biMinimize, biMaximize];
end;


Наверх к содержанию



Вопрос:

Как извлечь Red, Green, и Blue компонент из определенного цвета?

Ответ:

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

Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
Form1.Canvas.Pen.Color := clRed;
Memo1.Lines.Add('Red := ' + IntToStr(GetRValue(Form1.Canvas.Pen.Color)));
Memo1.Lines.Add('Red := ' + IntToStr(GetGValue(Form1.Canvas.Pen.Color)));
Memo1.Lines.Add('Blue:= ' + IntToStr(GetBValue(Form1.Canvas.Pen.Color)));
end;


Наверх к содержанию



Вопрос:
Как определить номер текущей строки в TMemo?

Ответ:

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

Пример:

procedure TForm1.Button1Click(Sender: TObject);
var
	LineNumber : integer;
begin
	LineNumber := SendMessage(Memo1.Handle, EM_LINEFROMCHAR, word(-1), 0);
	ShowMessage(IntToStr(LineNumber));
end;


Наверх к содержанию



Вопрос:
Как проигрываеть MPEG файл в Delphi-программе?

Ответ:

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

Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
MediaPlayer1.Filename := 'C:\DownLoad\rsgrow.mpg';
MediaPlayer1.Open;
MediaPlayer1.Display := Panel1;
MediaPlayer1.DisplayRect := Panel1.ClientRect;
MediaPlayer1.Play;
end;


Наверх к содержанию



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

Ответ:

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

Пример:

procedure TForm1.Button1Click(Sender: TObject);
var
	h : THandle;
begin
	h := LoadImage(0, 'C:\TheWall\Magic.ani', IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE or
			LR_LOADFROMFILE);
	if h = 0 then
		ShowMessage('Cursor not loaded')
	else
		begin
			Screen.Cursors[1] := h;
			Form1.Cursor := 1;
		end;
end;


Наверх к содержанию



Вопрос:
Как узнать о нажатии "non-menu" клавиши в момент когда меню показано?

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

Пример:

unit Unit1;

interface

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

type 
TForm1 = class(TForm)
MainMenu1: TMainMenu;
One1: TMenuItem;
Two1: TMenuItem;
THree1: TMenuItem;
private
{Private declarations}
procedure WmMenuChar(var m : TMessage); message WM_MENUCHAR;
public
{Public declarations}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WmMenuChar(var m : TMessage);
begin
Form1.Caption := 'Non standard menu key pressed';
m.Result := 1;
end;
end.
Наверх к содержанию

DELPHI VCL FAQ