Главная > Программирование > Языки Pascal/Delphi >

Delphi VCL FAQ

Секция 2 из 4 - Предыдущая - Следующая
Все секции - 1 - 2 - 3 - 4


Вопрос:
Как определить наличие сопроцессора?

Ответ:

В отличие от общепринятого мнения не всее клоны 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.

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



Вопрос:

При перемещении фокуса ввода клавишей Tab чтобы переместить его в RadioGroup нужно нажать клавишу Tab дважды если какой нибудь пункт RadioGroup уже выбран, но только один раз если не выбран. Можно ли сделать поведение RadioGroup логичным?

Ответ:

Установка свойства RadioGroup'ы TabStop в false должна решить эту проблему - поскольку клавиша tab будет продолжать работать - перемещаясь сразу на выделенный пункт RadioGroup.

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

Секция 2 из 4 - Предыдущая - Следующая

Вернуться в раздел "Языки Pascal/Delphi" - Обсудить эту статью на Форуме

Главная - Поиск по сайту - О проекте - Форум - Обратная связь