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; Наверх к содержанию