DELPHI VCL FAQ

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

  1. Сообщение сразу всем элементам управления формы.
  2. Свойство selected Listbox'а.
  3. Ограничение длинны текста, вводимого в TEdit.
  4. Сохранение обьекта TFont в реестре.
  5. Перемещать компонент мышкой в 'runtime'.
  6. Ошибка при создании обьекта класса TPrinter.
  7. Перехват событий в неклиентской области формы.
  8. Как нарисовать пиктограмму (icon) с увеличением.
  9. Автоматическая ширина колонок в StringGrid.
  10. TTimer работает не достаточно точно.
  11. Как поместить JPEG-картинку в exe-файл.
  12. Перехват сообщений прокрутки в TScrollBox.
  13. Прямоугольник для выделения части рисунка.
  14. Использование пиктограммы (Icon) как картинки на TSpeedButton.
  15. Прозрачная фоновая каринкя на компоненте CoolBar.
  16. Отключение мигания ползунока компонента TScrollBar.
  17. Установить курсор в нужную позицию ячейки DBGrid.
  18. Как поместить курсор в определенную позицию edit'а.
  19. Реагируем на минимизацию-максимизацию формы.
  20. Показ формы без передачи ей фокуса ввода.
  21. Удаление дисков из списка TDriveComboBox.
  22. Сообщение всем формам приложения о глобальных изменениях.
  23. Обновить список дисков компонента TDriveComboBox.
  24. Как программно заставить выпасть меню.
  25. Клавиша-акселератор для компонета у которого нет заголовка.
  26. Уменьшение мерцания при перерисовке компонента.
  27. Как запретить изменение размера моего компонента в design-time.
  28. Уменьшение ресурсов потребляемых TNotebook и TTabbedNotebook.
  29. Эмуляция нажатия клавиши с кодом #255.
  30. Как программно эмулировать движение мыши.
  31. Как зарегистрировать новый тип файла за своим приложением.
Вопрос: Как отправить сообщение сразу всем элементам управления формы? Ответ: Можно использовать 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) < CRect.Right do
	s := s + 'W';
	if length(s) > 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) <> VK_TAB) and (Ord(Key) <> VK_RETURN) and
		(Ord(Key) <> VK_LEFT) and (Ord(Key) <> 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) > CRect.Right then
		begin
			Key := #0;
			MessageBeep(-1);
		end;
		bm.Free;
	end;
end;


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




Вопрос:
Как сохранить обьект TFont в реестре/ini/файле/таблице базы данных?

Ответ:
Нужно сохранять атрибуты шрифта (имя, размер и т.п.) а не сам обьект TFont. После считывания этой информации следует проверить существует ли такой шрифт, прежде чем его использовать. Чтобы не показаться голословным дополню ответ Borland'а своим примером сохранения/чтения шрифта в/из реестра 

Uses    ... Registry;

procedure SaveFontToRegistry(Font : TFont; SubKey : String);
Var
	R : TRegistry;
	FontStyleInt : byte;
	FS : TFontStyles;
begin
	R:=TRegistry.Create;
	try
		FS:=Font.Style;
		Move(FS,FontStyleInt,1);
		R.OpenKey(SubKey,True);
		R.WriteString('Font Name',Font.Name);
		R.WriteInteger('Color',Font.Color);
		R.WriteInteger('CharSet',Font.Charset);
		R.WriteInteger('Size',Font.Size);
		R.WriteInteger('Style',FontStyleInt);
	finally
		R.Free;
	end;
end;

function ReadFontFromRegistry(Font : TFont; SubKey : String) : boolean;
Var
	R : TRegistry;
	FontStyleInt : byte;
	FS : TFontStyles;
begin
	R:=TRegistry.Create;
	try
		result:=R.OpenKey(SubKey,false); if not result then exit;
		Font.Name:=R.ReadString('Font Name');
		Font.Color:=R.ReadInteger('Color');
		Font.Charset:=R.ReadInteger('CharSet');
		Font.Size:=R.ReadInteger('Size');
		FontStyleInt:=R.ReadInteger('Style');
		Move(FontStyleInt,FS,1);
		Font.Style:=FS;
	finally
		R.Free;
	end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
	If FontDialog1.Execute then
	begin
		SaveFontToRegistry(FontDialog1.Font,'Delphi Kingdom\Fonts');
	end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
	NFont : TFont;
begin
	NFont:=TFont.Create;
	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". 
Пример:

type
	TForm1 = class(TForm)
		Button1: TButton;
		procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
				Shift: TShiftState; X, Y: Integer);
		procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
				Y: Integer);
		procedure Button1MouseUp(Sender: TObject; Button:
				TMouseButton; Shift: TShiftState; X, Y: Integer);
	private
		{Private declarations}
	public
		{Public declarations}
		MouseDownSpot : TPoint;
		Capturing : bool;
end;

var
	Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
					Shift: TShiftState; X, Y: Integer);
begin
	if ssCtrl in Shift then
	begin
		SetCapture(Button1.Handle);
		Capturing := true;
		MouseDownSpot.X := x;
		MouseDownSpot.Y := Y;
	end;
end;

procedure TForm1.Button1MouseMove(Sender: TObject; Shift: TShiftState; X,  Y: Integer);
begin
	if Capturing then
	begin
		Button1.Left := Button1.Left - (MouseDownSpot.x - x);
		Button1.Top := Button1.Top - (MouseDownSpot.y - y);
	end;
end;

procedure TForm1.Button1MouseUp(Sender: TObject; Button:
			TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
	if Capturing then
	begin
		ReleaseCapture;
		Capturing := false;
		Button1.Left := Button1.Left - (MouseDownSpot.x - x);
		Button1.Top := Button1.Top - (MouseDownSpot.y - y);
	end;
end;


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




Вопрос:
При попытке создать обьект класса 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). Пример показывает как перехватить вижение мыши во всей
неклиенстской области окна (рамка и заголовок).

Пример:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
private
{Private declarations}
procedure WMNCMOUSEMOVE(var Message: TMessage);
message WM_NCMOUSEMOVE;
public
{Public declarations}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMNCMOUSEMOVE(var Message: TMessage);
var
s : string;
begin
case Message.wParam of
HTERROR: 	
s:= 'HTERROR';
HTTRANSPARENT:
s:= 'HTTRANSPARENT';
HTNOWHERE:	
s:= 'HTNOWHERE';
HTCLIENT:
s:= 'HTCLIENT';
HTCAPTION:
s:= 'HTCAPTION';
HTSYSMENU:
s:= 'HTSYSMENU';
HTSIZE:
s:= 'HTSIZE';
HTMENU:
s:= 'HTMENU';
HTHSCROLL:
s:= 'HTHSCROLL';
HTVSCROLL:
s:= 'HTVSCROLL';
HTMINBUTTON:
s:= 'HTMINBUTTON';
HTMAXBUTTON:
s:= 'HTMAXBUTTON';
HTLEFT:
s:= 'HTLEFT';
HTRIGHT:
s:= 'HTRIGHT';
HTTOP:
s := 'HTTOP';
HTTOPLEFT:
s:= 'HTTOPLEFT';
HTTOPRIGHT:
s:= 'HTTOPRIGHT';
HTBOTTOM:
s:= 'HTBOTTOM';
HTBOTTOMLEFT:
s:= 'HTBOTTOMLEFT';
HTBOTTOMRIGHT:
s:= 'HTBOTTOMRIGHT';
HTBORDER:
s:= 'HTBORDER';
HTOBJECT:
s:= 'HTOBJECT';
HTCLOSE:
s:= 'HTCLOSE';
HTHELP:
s:= 'HTHELP';
else s:= '';
end;
Form1.Caption := s;
Message.Result := 0;
end;

end.


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




Вопрос:
При попытке использовать метод TCanvas.StretchDraw чтобы нарисовать иконку
увеличенной ее размер не изменяется. Что делать?

Ответ: 
Иконки всегда рисуются размером принятым в системе по умолчанию. Чтобы показать
увеличенный вид иконки скоприуйте ее на bitmap, а зате используйте метод
TCanvas.StretchDraw.

Пример:

procedure TForm1.Button1Click(Sender: TObject);
var
TheBitmap : TBitmap;
begin
TheBitmap := TBitmap.Create;
TheBitmap.Width := Application.Icon.Width;
TheBitmap.Height := Application.Icon.Height;
TheBitmap.Canvas.Draw(0, 0, Application.Icon);
Form1.Canvas.StretchDraw(Rect(0,0,TheBitmap.Width * 3,TheBitmap.Height * 3),
TheBitmap);
TheBitmap.Free;
end;


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




Вопрос:
Можно ли сделать так чтобы TStringGrid автоматически изменял ширину колонок, чтобы
вместить самую длинную строчку в колонке?

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

Пример:

procedure AutoSizeGridColumn(Grid : TStringGrid; column : integer);
var
i : integer;
temp : integer;
max : integer;
begin
max := 0;
for i := 0 to (Grid.RowCount - 1) do
begin
temp := Grid.Canvas.TextWidth(grid.cells[column, i]);
if temp > max then max := temp;
end;
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-файлу.
В нашем примере:

C:\DelphiPath\BIN\BRCC32.EXE  C:\ProjectPath\FOO.RC
Вы получите откомпилированный ресурс - файл с расширением ".res".
(в нашем случает foo.res).
Далее добавте ресурс к своему приложению.

{Грузим ресурс}
{$R FOO.RES}

uses Jpeg;

procedure LoadJPEGFromRes(TheJPEG : string; ThePicture : TPicture);
var
ResHandle : THandle;
MemHandle : THandle;
MemStream : TMemoryStream;
ResPtr    : PByte;
ResSize   : Longint;
JPEGImage : TJPEGImage;
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}
var
OldWindowProc : Pointer;

function NewWindowProc(WindowHandle : hWnd;
TheMessage   : WParameter;
ParamW : WParameter;
ParamL : LParameter) : LongInt
{$IFDEF WIN32} stdcall; {$ELSE} ; export; {$ENDIF}
var
TheRangeMin : integer;
TheRangeMax : integer;
TheRange : integer;
begin
if TheMessage = WM_VSCROLL then
begin
{Get the min and max range of the horizontal scroll box}
GetScrollRange(WindowHandle, SB_HORZ, TheRangeMin, TheRangeMax);
{Get the vertical scroll box position}
TheRange := GetScrollPos(WindowHandle, SB_VERT);
{Make sure we wont exceed the range}
if TheRange < TheRangeMin then
TheRange := TheRangeMin else
if TheRange > TheRangeMax then
TheRange := TheRangeMax;
{Set the horizontal scroll bar}
SetScrollPos(WindowHandle, SB_HORZ, TheRange, true);
end;
if TheMessage = WM_HSCROLL then
begin
{Get the min and max range of the horizontal scroll box}
GetScrollRange(WindowHandle, SB_VERT, heRangeMin, TheRangeMax);
{Get the horizontal scroll box position}
TheRange := GetScrollPos(WindowHandle, SB_HORZ);
{Make sure we wont exceed the range}
if TheRange < TheRangeMin then
TheRange := TheRangeMin
else
if TheRange > TheRangeMax then
TheRange := TheRangeMax;
{Set the vertical scroll bar}
SetScrollPos(WindowHandle, SB_VERT, TheRange, true);
end;

{Call the old Window procedure to allow processing of the message.}
NewWindowProc := CallWindowProc(OldWindowProc, WindowHandle, TheMessage,
ParamW, ParamL);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
{Set the new window procedure for the control and remember 
the old window procedure.}
OldWindowProc := Pointer(SetWindowLong(ScrollBox1.Handle, GWL_WNDPROC,
LongInt(@NewWindowProc)));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
{Set the window procedure back to the old window procedure.}
SetWindowLong(ScrollBox1.Handle, GWL_WNDPROC, LongInt(OldWindowProc));
end;


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




Вопрос:
Как сделать прямоугольник для выделения части картинки для редактирования?

Ответ:
Самый простой способ - воспользоваться функцией Windows API DrawFocusRect. Функция DrawFocusRect использует операцию XOR при рисовании - таким образом вывод прямоугольника дважды с одними и теми же координатами стирает прямоугольник, и прямоугольник всегда будет виден, на фоне какого бы цвета он не выводился. 
Пример:

type
	TForm1 = class(TForm)
		procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
				Shift: TShiftState; X, Y: Integer);
		procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
				Y: Integer);
		procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
				Shift: TShiftState; X, Y: Integer);
	private
		{Private declarations}
		Capturing : bool;
		Captured : bool;
		StartPlace : TPoint;
		EndPlace : TPoint;
	public
		{Public declarations}
end;

var
	Form1: TForm1;

implementation

{$R *.DFM}

function MakeRect(Pt1 : TPoint; Pt2 : TPoint) : TRect;
begin
	if pt1.x < pt2.x then
		begin
			Result.Left := pt1.x;
			Result.Right := pt2.x;
		end
	else
		begin
			Result.Left := pt2.x;
			Result.Right := pt1.x;
		end;
	if pt1.y < pt2.y then
		begin
			Result.Top := pt1.y;
			Result.Bottom := pt2.y;
		end
	else
	begin
		Result.Top := pt2.y;
		Result.Bottom := pt1.y;
	end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
		Shift: TShiftState; X, Y: Integer);
begin
	if Captured then
		DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));
	StartPlace.x := X;
	StartPlace.y := Y;
	EndPlace.x := X;
	EndPlace.y := Y;
	DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));
	Capturing := true;
	Captured := true;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
		Y: Integer);
begin
	if Capturing then
	begin
		DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));
		EndPlace.x := X;
		EndPlace.y := Y;
		DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));
	end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
		Shift: TShiftState; X, Y: Integer);
begin
	Capturing := false;
end;


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




Вопрос:
Можно ли использовать иконку как картинку на кнопке TSpeedButton?

Ответ:
Можно. См. пример.

Пример:

uses ShellApi;

procedure TForm1.FormShow(Sender: TObject);
var
Icon: TIcon;
begin
Icon := TIcon.Create;
Icon.Handle := ExtractIcon(0,'C:\WINDOWS\NOTEPAD.EXE',1);
SpeedButton1.Glyph.Width := Icon.Width;
SpeedButton1.Glyph.Height := Icon.Height;
SpeedButton1.Glyph.Canvas.Draw(0, 0, Icon);
Icon.Free;
end;


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




Вопрос:
Как поместить прозрачную фоновую каринку на компонент CoolBar?

Ответ:
procedure TForm1.Button1Click(Sender: TObject);
var
Bm1 : TBitmap;
Bm2 : TBitmap;
begin
Bm1 := TBitmap.Create;
Bm2 := TBitmap.Create;
Bm1.LoadFromFile('c:\download\test.bmp');
Bm2.Width := Bm1.Width;
Bm2.Height := Bm1.Height;
bm2.Canvas.Brush.Color := CoolBar1.Color;
bm2.Canvas.BrushCopy(Rect(0, 0, bm2.Width, bm2.Height), Bm1,
Rect(0, 0, Bm1.width, Bm1.Height), ClWhite);
bm1.Free;
CoolBar1.Bitmap.Assign(bm2);
bm2.Free;
end;


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




Вопрос:
Ползунок компонента TScrollBar все время мигает. Как это отключить?

Ответ:
Установите свойтсво ScrollBar.TabStop в False.


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




Вопрос:
Как программно перевести DBgrid в реим редактирования и установить курсор в
окошке редактирования в требуемую позицию?

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

procedure TForm1.Button1Click(Sender: TObject);
var
	h : THandle;
begin
	Application.ProcessMessages;
	DbGrid1.SetFocus;
	DbGrid1.EditorMode := true;
	Application.ProcessMessages;
	h:= Windows.GetFocus;
	SendMessage(h, EM_SETSEL, 2, 2);
end;


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




Вопрос:
Как поместить курсор в определенную позицию edit'а и подобных ему элементов управления?

Ответ:
Можно использовать методы Delphi SelStart() и SelectLength().

Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.SetFocus;
{переводим курсор во вторую позицию}
Edit1.SelStart := 2;
{не выделяем никакого текста}
Edit1.SelLength := 0;
end;


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




Вопрос:
Как среагировать на минимизацию-максимизацию формы перед тем как произойдет изменение
размера формы?

Ответ:
В примере перехватывается сообщение WM_SYSCOMMAND. Если это сообщение говорит о
минимизации или максимизации формы - пищит динамик.

Пример:

type
TForm1 = class(TForm)
private
{Private declarations}
procedure WMSysCommand(var Msg: TWMSysCommand);
message WM_SYSCOMMAND;
public
{Public declarations}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMSysCommand;
begin
if (Msg.CmdType = SC_MINIMIZE) or (Msg.CmdType = SC_MAXIMIZE) then
MessageBeep(0)
else
inherited;
end;


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




Вопрос:
Можно ли сделать так - одна форма показывает другую и остается позади нее, но фокус
ввода не переходит к новой форме, а остается у старой?

Ответ:
В примере показывается не автосоздаваемая (non auto-created) форма, но фокус ввода ей
не передается.

Пример:

uses Unit2;

procedure TForm1.Button1Click(Sender: TObject);
begin
Form2 := TForm2.Create(Application);
Form2.Visible := FALSE;
ShowWindow(Form2.Handle, SW_SHOWNA);
end;


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




Вопрос:
На некоторых laptop компьютерах может не быть флоппи дисковода. Можно ли удалять
из списка TDriveComboBox диски которые отключены?

Ответ:
В примере TDriveComboBox не показывает дисководы, которые не готовы. (not ready).
Учтите что на многих компьютерах будет ощутимая задержка при поверке plug&play
флоппи дисковода.

Пример:

procedure TForm1.FormCreate(Sender: TObject);
var
i : integer;
OldErrorMode : Word;
OldDirectory : string;
begin
OldErrorMode := SetErrorMode(SEM_NOOPENFILEERRORBOX);
GetDir(0, OldDirectory);
i := 0;
while i <= DriveComboBox1.Items.Count - 1 do begin
{$I-}
ChDir(DriveComboBox1.Items[i][1] + ':\');
{$I+}
if IoResult <> 0 then
DriveComboBox1.Items.Delete(i)
else
inc(i);
end;
ChDir(OldDirectory);
SetErrorMode(OldErrorMode);
end;


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




Вопрос:
Как сообщить всем формам моего приложения (в том числе и не видимым в данный момент)
об изминении каких-то глобальных значений?

Ответ:
Один из способов - создать пользовательское сообщение и использовать метод preform
чтобы разослать его всем формам из массива Screen.Forms.

Пример:

{Code for Unit1}

const
UM_MyGlobalMessage = WM_USER + 1;

type
TForm1 = class(TForm)
Label1: TLabel;
Button1: TButton;
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
private	
{Private declarations}
procedure UMMyGlobalMessage(var AMessage: TMessage); message
UM_MyGlobalMessage;
public
{Public declarations}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

uses Unit2;

procedure TForm1.FormShow(Sender: TObject);
begin
Form2.Show;
end;

procedure TForm1.UMMyGlobalMessage(var AMessage: TMessage);
begin
Label1.Left := AMessage.WParam;
Label1.Top  := AMessage.LParam;
Form1.Caption := 'Got It!';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
f: integer;
begin
for f := 0 to Screen.FormCount - 1 do
Screen.Forms[f].Perform(UM_MyGlobalMessage, 42, 42);
end;

{Code for Unit2}

const
UM_MyGlobalMessage = WM_USER + 1;
type
TForm2 = class(TForm)
Label1: TLabel;
private
{Private declarations}
procedure UMMyGlobalMessage(var AMessage: TMessage);
message UM_MyGlobalMessage;
public
{Public declarations}
end;

var
Form2: TForm2;

implementation

{$R *.DFM}

procedure TForm2.UMMyGlobalMessage(var AMessage: TMessage);
begin
Label1.Left := AMessage.WParam;
Label1.Top  := AMessage.LParam;
Form2.Caption := 'Got It!';
end;


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




Вопрос:
Как обновить список дисков компонента TDriveComboBox, учитывая, что могуд быть
подключены/отключены сетевые диски и произведена "горячая замена" plug&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 := '&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) методу класса-предка.

Пример:

procedure TVu.SetBounds(ALeft : integer; ATop : integer; AWidth : integer;
AHeight : integer);
begin
if csdesigning in componentstate then
begin
AWidth := 50;
AHeight := 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  //вызываем защищенный метод родительского класса
		TMyTabbedNotebook(TWinControl(Pages.Objects[PageIndex])).DestroyHandle;
end;

procedure TForm1.TabSet1Change(Sender: TObject; NewTab: Integer;
			var AllowChange: Boolean);
begin
	with Notebook1 do //вызываем защищенный метод родительского класса
		TMyNotebook(TWinControl(Pages.Objects[PageIndex])).DestroyHandle;
		NoteBook1.PageIndex := NewTab;
		AllowChange := true
end;


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




Вопрос:
Функция 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}
	//  SimulateKeyStroke(VK_RIGHT, 0);
	keybd_event(VK_RIGHT, 0,0,0);
	{Let the app get the message}
	Application.ProcessMessages;
	FillChar(KeyData, sizeof(KeyData), #0);
	KeyData.ScanCode := 255;
	KeyData.RepeatCount := 1;
	SendMessage(Edit1.Handle, WM_KEYDOWN, 255,LongInt(KeyData));
	KeyData.Bits := KeyData.Bits or (1 shl 30);
	KeyData.Bits := KeyData.Bits or (1 shl 31);
	SendMessage(Edit1.Handle, WM_KEYUP, 255, LongInt(KeyData));
	KeyData.Bits := KeyData.Bits and not (1 shl 30);
	KeyData.Bits := KeyData.Bits and not (1 shl 31);
	SendMessage(Edit1.Handle, WM_CHAR, 255, LongInt(KeyData));
	Application.ProcessMessages;
end;


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




Вопрос:
Некоторые компоненты не меняют курсор мыши до тех пор пока пользователь не
сдвинет мышь. Как эмулировать движение мыши?

Ответ:
В примере мышка слегка "подталкивается" без участия пользователя.

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');
WriteString('MyExt\DefaultIcon','','C:\MyApp.Exe,0');
WriteString('MyExt\Shell','','This_Is_Our_Default_Action');
WriteString('MyExt\Shell\First_Action',
'','This is our first action');
WriteString('MyExt\Shell\First_Action\command','',
'C:\MyApp.Exe /LotsOfParamaters %1');
WriteString('MyExt\Shell\This_Is_Our_Default_Action','',
'This is our default action');
WriteString('MyExt\Shell\This_Is_Our_Default_Action\command',
'','C:\MyApp.Exe %1');
WriteString('MyExt\Shell\Second_Action',
'','This is our second action');
WriteString('MyExt\Shell\Second_Action\command',
'','C:\MyApp.Exe /TonsOfParameters %1');
Free;
end;
end;
Наверх к содержанию