DELPHI VCL FAQ

[Начало][назад][далее]

  1. Как определить наличие сопроцессора.
  2. Серийный номер аудио CD.
  3. Амперсанд в Windows .
  4. Как поместить bitmap в Metafile.
  5. Как узнать, что курсор мыши над моей формой.
  6. Запущенно ли приложение под Windows NT.
  7. Как создать bitmap из пиктогрммы (icon).
  8. Отедельный hint для каждой ячейки StringGrid'а.
  9. Как внести изменения в код VCL.
  10. Эквивалент TwipsPerPixel из VB.
  11. Содержимое файла в текущую позицию курсора в TMemo.
  12. Перехват нажатия Ctrl-V в TMemo.
  13. TEdit с выравниваением текста по правой стороне.
  14. Undo в Edit.
  15. Переопределение конструктора формы.
  16. Цветной текст в TStatusBar.
  17. Переделываем TTrackBar.
  18. Создание временного canvas'а.
  19. Проблема с прозраным glyph'ом.
  20. Создание PolyPolygon используя массив точек.
  21. Создание невизуальных компонентов без иконок.
  22. Нестандартный редактор (например combobox) в ячейке StringGrid.
  23. Есть ли в CD-ROM Audio CD.
  24. Есть ли у мыши колесико.
  25. Определение нажатия клавиши tab.
  26. Отличие между Create(Self) и Create(Application).
  27. Определение поддерживает ли обьект заданное свойство.
  28. Показываем секунды и минуты Audio CD.
  29. Рисуем на рамке.
  30. Работаем когда приложение бездельничает.
Вопрос: Как определить наличие сопроцессора? Ответ: В отличие от общепринятого мнения не всее клоны 486/586/686/ и Pentium имеют сопроцессор для вычислений с плавающей запятой. В примере определяется наличие сопроцессора и под Win16 и под Win32. 
Пример:

{$IFDEF WIN32}

uses Registry;

{$ENDIF}

function HasCoProcesser : bool;
{$IFDEF WIN32}
var
	TheKey : hKey;
{$ENDIF}
begin
	Result := true;
	{$IFNDEF WIN32}
	if GetWinFlags and Wf_80x87 = 0 then
	Result := false;
	{$ELSE}
	if RegOpenKeyEx(HKEY_LOCAL_MACHINE,
	'HARDWARE\DESCRIPTION\System\FloatingPointProcessor',0,
	KEY_EXECUTE, TheKey) <> ERROR_SUCCESS then result := false;
	RegCloseKey(TheKey);
{$ENDIF}
	end;

procedure TForm1.Button1Click(Sender: TObject);
begin
	if HasCoProcesser then
		ShowMessage('Has CoProcessor')
	else
		ShowMessage('No CoProcessor - Windows Emulation Mode');
end;


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




Вопрос:
Как узнать серийный номер аудио CD?

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

uses MMSystem, MPlayer;

procedure TForm1.Button1Click(Sender: TObject);
var
	mp : TMediaPlayer;
	msp : TMCI_INFO_PARMS;
	MediaString : array[0..255] of char;
	ret : longint;
begin
	mp := TMediaPlayer.Create(nil);
	mp.Visible := false;
	mp.Parent := Application.MainForm;
	mp.Shareable := true;
	mp.DeviceType := dtCDAudio;
	mp.FileName := 'D:';
	mp.Open;
	Application.ProcessMessages;
	FillChar(MediaString, sizeof(MediaString), #0);
	FillChar(msp, sizeof(msp), #0);
	msp.lpstrReturn := @MediaString;
	msp.dwRetSize := 255;
	ret := mciSendCommand(Mp.DeviceId, MCI_INFO, MCI_INFO_MEDIA_IDENTITY,
			longint(@msp));
	if Ret <> 0 then
		begin
			MciGetErrorString(ret, @MediaString, sizeof(MediaString));
			Memo1.Lines.Add(StrPas(MediaString));
		end
	else
		Memo1.Lines.Add(StrPas(MediaString));
	mp.Close;
	Application.ProcessMessages;
	mp.free;
end;
end.


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




Вопрос:
Как вывести на элемент управления (Window control) текст, содержащий амперсанд - & ?

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

Button1.Caption := 'Черное && Белое';

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




Вопрос:
Как поместить bitmap в Metafile?

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

Пример:

procedure TForm1.Button1Click(Sender: TObject);
var
m : TmetaFile;
mc : TmetaFileCanvas;
b : tbitmap;
begin
m := TMetaFile.Create;
b := TBitmap.create;
b.LoadFromFile('C:\SomePath\SomeBitmap.BMP');
m.Height := b.Height;
m.Width := b.Width;
mc := TMetafileCanvas.Create(m, 0);
mc.Draw(0, 0, b);
mc.Free;
b.Free;
m.SaveToFile('C:\SomePath\Test.emf');
m.Free;
Image1.Picture.LoadFromFile('C:\SomePath\Test.emf');
end;


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




Вопрос:
Как узнать, что курсор мыши над моей формой?

Ответ:
Можно использовать функцию GetCapture() из Windows API.

Примечание: Cм. документацию Windows для информации об ограничениях функции GetCapture.

Пример:

procedure TForm1.FormDeactivate(Sender: TObject);
begin
ReleaseCapture;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
If GetCapture = 0 then
SetCapture(Form1.Handle);
if PtInRect(Rect(Form1.Left,Form1.Top,Form1.Left + Form1.Width,
Form1.Top + Form1.Height), ClientToScreen(Point(x, y))) then
Form1.Caption := 'Мышка над формой!'
else
Form1.Caption := 'Мышка вне формы...';
end;


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




Вопрос:
Как программно определить, что приложение работает под Windows NT?

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

Пример:

function IsNT : bool;
var
osv : TOSVERSIONINFO;
begin
result := true;
GetVersionEx(osv);
if osv.dwPlatformId = VER_PLATFORM_WIN32_NT then exit;
result := false;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if IsNt then
ShowMessage('Running on NT')
else
ShowMessage('Not Running on NT');
end;


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




Вопрос:
Как создать bitmap из пиктогрммы (icon)?

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

Пример:

procedure TForm1.Button1Click(Sender: TObject);
var
TheIcon : TIcon;
TheBitmap : TBitmap;
begin
TheIcon := TIcon.Create;
TheIcon.LoadFromFile('C:\Program Files\Borland\IcoCur32\EARTH.ICO');
TheBitmap := TBitmap.Create;
TheBitmap.Height := TheIcon.Height;
TheBitmap.Width := TheIcon.Width;
TheBitmap.Canvas.Draw(0, 0, TheIcon);
Form1.Canvas.Draw(10, 10, TheBitmap);
TheBitmap.Free;
TheIcon.Free;
end;


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




Вопрос:
Как создать отдельную подсказку (hint) для каждой ячейки StringGrid?

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

type
	TForm1 = class(TForm)
		StringGrid1: TStringGrid;
		procedure StringGrid1MouseMove(Sender: TObject;
		Shift: TShiftState; X, Y: Integer);
		procedure FormCreate(Sender: TObject);
	private
	{Private declarations}
		Col : integer;
		Row : integer;
	public
	{Public declarations}
   end;

var
	Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
	StringGrid1.Hint := '0 0';
	StringGrid1.ShowHint := True;
end;

procedure TForm1.StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
	r : integer;
	c : integer;
begin
	StringGrid1.MouseToCell(X, Y, C, R);
	with StringGrid1 do
		begin
			if ((Row <> r) or(Col <> c)) then
				begin
					Row := r;
					Col := c;
					Application.CancelHint;
					StringGrid1.Hint :=IntToStr(r)+#32+IntToStr(c);
				end;
		end;
end;


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




Вопрос:
Как внести изменения в код VCL?

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

Delphi 1 : Options | Environment | Library
Delphi 2 : Tools | Options | Library
Delphi 3 :  Tools | Environment Options | Library
Delphi 4 :  Tools | Environment Options | Library
C++ Builder : Options | Environment | Library


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




Вопрос:

Как в Delphi реализовать функцию - эквивалент TwipsPerPixel из VisualBasic?

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

Пример:

function TwipsPerPixelX(Canvas : TCanvas) : Extended;
begin
result := 1440 / GetDeviceCaps(Canvas.Handle, LOGPIXELSX);
end;

function TwipsPerPixelY(Canvas : TCanvas) : Extended;
begin
result := 1440 / GetDeviceCaps(Canvas.Handle, LOGPIXELSY);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(FloatToStr(TwipsPerPixelX(Form1.Canvas)));
ShowMessage(FloatToStr(TwipsPerPixelY(Form1.Canvas)));
end;


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




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

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

var
	TheMStream : TMemoryStream;
	Zero : char;
begin
	TheMStream := TMemoryStream.Create;
	TheMStream.LoadFromFile('C:\AUTOEXEC.BAT');
	TheMStream.Seek(0, soFromEnd);
	//Null terminate the buffer!
	Zero := #0;
	TheMStream.Write(Zero, 1);
	TheMStream.Seek(0, soFromBeginning);
	Memo1.SetSelTextBuf(TheMStream.Memory);
	TheMStream.Free;
end;


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




Вопрос:
Как в компоненте 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. Можно также заменять код возврата каретки на пробел - для того чтобы позволять вставку из буфера обмена многострочного текста в виде одной строки. 
Пример:

procedure TForm1.FormCreate(Sender: TObject);
begin
	Memo1.Alignment := taRightJustify;
	Memo1.MaxLength := 24;
	Memo1.WantReturns := false;
	Memo1.WordWrap := false;
end;

procedure MultiLineMemoToSingleLine(Memo : TMemo);
var
	t : string;
begin
	t := Memo.Text;
	if Pos(#13, t) > 0  then
		begin
			while Pos(#13, t) > 0 do
				delete(t, Pos(#13, t), 1);
			while Pos(#10, t) > 0 do
				delete(t, Pos(#10, t), 1);
			Memo.Text := t;
		end;
end;

procedure TForm1.Memo1Change(Sender: TObject);
begin
	MultiLineMemoToSingleLine(Memo1);
end;

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
	MultiLineMemoToSingleLine(Memo1);
end;


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




Вопрос:

Как запрограммировать undo?

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

Memo1.Perform(EM_UNDO, 0, 0);

Если Вы хотите узнать, возможно ли выполнить операцию "Undo", проверьте "Undo status":

If Memo1.Perform(EM_CANUNDO, 0, 0) <> 0 then
begin
{Undo is possible}
end;

Для выполнения "Redo" выполните "Undo" еще раз.


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




Вопрос:
Можно ли создать форму, которая получает дополнительные параметры в методе Сreate?

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

Пример:

unit Unit2;

interface

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

type
TForm2 = class(TForm)
private
{Private declarations}
public
constructor CreateWithCaption(aOwner: TComponent; aCaption: string);
{Public declarations} 
end;

var
Form2: TForm2;

implementation

{$R *.DFM}

constructor TForm2.CreateWithCaption(aOwner: TComponent; aCaption: string);
begin
Create(aOwner);
Caption := aCaption;
end;

uses Unit2;
procedure TForm1.Button1Click(Sender: TObject);
begin
Unit2.Form2 :=Unit2.TForm2.CreateWithCaption(Application, 'My Caption');
Unit2.Form2.Show;
end;


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




Вопрос:
Почему при изменении цвета шрифта в 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. 
Наверх к содержанию