DELPHI VCL FAQ

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

  1. Radiogroup и фокус ввода.
  2. Картинки в TPopUpMenu.
  3. Как узнать число кадров AVI файла.
  4. Фиксированные колонки в TDbGrid.
  5. Показ dbgrid в режиме disabled.
  6. Как узнать нажаты ли клавиши Shift, Ctrl, Alt.
  7. Как изменить шрифт подсказки (hint'а).
  8. Эквивалент функции SendKeys Visual Basic'а.
  9. Динамическое рисование прозрачных картинок TImageList.
  10. Бесконечная музыка из TMediaPlayer.
  11. Ошибка 'There are no fonts installed'.
  12. Смена дисковода, откуда MediaPlayer проигрывает аудио CD.
  13. Как убрать кнопку с названием моей программы из Панели Задач.
  14. Преобразование цвета в строку - название цвета VCL.
  15. Выравнивание максимизированное формы.
  16. Как заставить TEdit не 'пикать'.
  17. Получение списка всех компонентов, расположенных на TNoteBook.
  18. Эквивалент escape codes из С.
  19. Как показать первый кадр AVI-файла.
  20. Переключить TListView в режим редактирования нажатием клавиш.
  21. Уничтожение обьекта, сохраненного в списке TStrings.
  22. Using Resident Font.
  23. Путь к каталогу откуда была установленна Windows.
  24. Строка сообщения об ошибке Windows.
  25. Еще более строгая проверка типов.
  26. VK_Key для A-Z и 0-9.
  27. Изменение оконной процедуры TForm.
  28. Размеры TComboBox с показанным выпадающим списком.
  29. Меню в стиле Delphi 4.
  30. Режим вставка-замена в TMemo и TEdit.
Вопрос: При перемещении фокуса ввода клавишей Tab чтобы переместить его в RadioGroup нужно нажать клавишу Tab дважды если какой нибудь пункт RadioGroup уже выбран, но только один раз если не выбран. Можно ли сделать поведение RadioGroup логичным? 
Ответ:
Установка свойства RadioGroup'ы TabStop в false должна решить эту проблему - поскольку клавиша tab будет продолжать работать - перемещаясь сразу на выделенный пункт RadioGroup. 

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




Вопрос:
Как разместить маленькие картинки в компоненте TPopUpMenu?

Ответ:
В приведенном примере показано как это сделать с использованием функции Windows API SetMenuItemBitmaps(). Эта функция получает handle popup menu, позицию строчки меню куда будет помещена картинка, и два дескриптора(handles) на две картинки (одна из них - картинка которая будет показана когда строка меню доступна, вторая - когда строка меню недоступна). 

type
	TForm1 = class(TForm)
		PopupMenu1: TPopupMenu;
		Pop11: TMenuItem;
		Pop21: TMenuItem;
		Pop31: TMenuItem;
		procedure FormCreate(Sender: TObject);
		procedure FormDestroy(Sender: TObject);
		procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
							Shift: TShiftState; X, Y: Integer);
	private
		{Private declarations}
		bmUnChecked : TBitmap;
		bmChecked : TBitmap;
	public
		{Public declarations}
end;

var
	Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
	bmUnChecked := TBitmap.Create;
	bmUnChecked.LoadFromFile('C:\Program Files\Borland\BitBtns\ALARMRNG.BMP');
	bmChecked := TBitmap.Create;
	bmChecked.LoadFromFile('C:\Program Files\Borland\BitBtns\CHECK.BMP');
	{Add the bitmaps to the item at index 1 in PopUpMenu}
	SetMenuItemBitmaps(PopUpMenu1.Handle,1,MF_BYPOSITION,BmUnChecked.Handle,
									BmChecked.Handle);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
	bmUnChecked.Free;
	bmChecked.Free;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
						Shift: TShiftState; X, Y: Integer);
var
	pt : TPoint;
begin
	pt := ClientToScreen(Point(x, y));
	PopUpMenu1.Popup(pt.x, pt.y);
end;


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




Вопрос:
Как узнать число кадров AVI файла, и выяснить как долго будет проигрывться этот файл?

Ответ:
В приведенном примере указано как получить эту информацию.

Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
MediaPlayer1.TimeFormat := tfFrames;
ShowMessage('Number of frames = ' + IntToStr(MediaPlayer1.Length));
MediaPlayer1.TimeFormat := tfMilliseconds;
ShowMessage('Number of milliseconds = ' + IntToStr(MediaPlayer1.Length));
end;


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




Вопрос:
Как изменить число фиксированных колонок в TDbGrid?

Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
TStringGrid(DbGrid1).FixedCols := 2;
end;


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




Вопрос:
Некоторые компоненты баз данных (и среди них TDBGrid) никак не меняют визуальных свойств, когда к ним отключен доступ (disabled). Как это изменить програмно? 
Ответ:
Ниже приведен пример, меняющий цвет шрифта на clGray, когда доступ к элементу управления (в данном случае TDBGrid) запрещен (disabled). 

procedure TForm1.Button1Click(Sender: TObject);
begin
	DbGrid1.Enabled := false;
	DbGrid1.Font.Color := clGray;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
	DbGrid1.Enabled := true;
	DbGrid1.Font.Color := clBlack;
end;


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




Вопрос:
Как определить нажаты ли клавиши Shift, Alt, or Ctrl в какой-либо момент времени?

Ответ:
В приведенном примере показано как определить нажата ли клавиша Shift при выборе строчки меню. Пример также содержит функции проверки состояния клавиш Alt, Ctrl. 
Пример:

function CtrlDown : Boolean;
var
	State : TKeyboardState;
begin
	GetKeyboardState(State);
	Result := ((State[vk_Control] And 128) <> 0);
end;

function ShiftDown : Boolean;
var
	State : TKeyboardState;
begin
	GetKeyboardState(State);
	Result := ((State[vk_Shift] and 128) <> 0);
end;

function AltDown : Boolean;
var
	State : TKeyboardState;
begin
	GetKeyboardState(State);
	Result := ((State[vk_Menu] and 128) <> 0);
end;
procedure TForm1.MenuItem12Click(Sender: TObject);
begin
	if ShiftDown then
		Form1.Caption := 'Shift'
	else	
		Form1.Caption := '';
end;

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




Вопрос:
Как изменить шрифта hint'а?

Ответ:
В примере перехватывается событие Application.OnShowHint и изменяется шрифт Hint'а.

Пример:

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{Private declarations}
public
procedure MyShowHint(var HintStr: string;
var CanShow: Boolean;var HintInfo: THintInfo);
{Public declarations}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.MyShowHint(var HintStr: string; var CanShow: Boolean;
var HintInfo: THintInfo);
var
i : integer;
begin
for i := 0 to Application.ComponentCount - 1 do
if Application.Components[i] is THintWindow then
with THintWindow(Application.Components[i]).Canvas do
begin
Font.Name:= 'Arial';
Font.Size:= 18;
Font.Style:= [fsBold];
HintInfo.HintColor:= clWhite;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnShowHint := MyShowHint;
end;


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




Вопрос:
Есть ли в Delphi эквивалент функции SendKeys Visual Basic'а?

Ответ:
Ниже приведена процедура, позволяющаю отправлять нажатия в любой элемент управления (window control), способный принимать ввод с клавиатуры. Вы можете использовать эту технику чтобы включать клавиши NumLock, CapsLock и ScrollLock под Windows NT. Та же техника работает и под Windows 95 для CapsLock и ScrollLock но не работает для клавиши NumLock.
Обратите внимание, что приведены четыре поцедуры: SimulateKeyDown() - эмулировать нажатие клавиши (без отпускания) SimulateKeyUp() - эмулировать отпускание клавиши SimulateKeystroke() - эмулировать удар по клавише (нажатие и отпускание) и SendKeys(), позволяющие Вам гибко контролировать посылаемые сообщения клавиатуры.
SimulateKeyDown(), SimulateKeyUp() и SimulateKeystroke() получают коды виртуальных клавиш (virtural key) (вроде VK_F1). Процедура SimulateKeystroke() получает дополнительный параметр, полезный при эмуляции нажатия PrintScreen. Когда этот параметр равен нулю весь экран будет скопирован в буфер обмена (clipboard). Если дополнительный параметр равен 1 будет скопированно только активное окно.
Четыре метода "button click" демонстрируют использование: ButtonClick1 - включает capslock ButtonClick2 - перехватывает весь экран в буфер обмена (clipboard). ButtonClick3 - перехватывает активное окно в буфер обмена (clipboard). ButtonClick4 - устанавливает фокус в Edit и отправляет в него строку. 
Пример:

procedure SimulateKeyDown(Key : byte);
begin
	keybd_event(Key, 0, 0, 0);
end;

procedure SimulateKeyUp(Key : byte);
begin
	keybd_event(Key, 0, KEYEVENTF_KEYUP, 0);
end;

procedure SimulateKeystroke(Key : byte; extra : DWORD);
begin
	keybd_event(Key,extra,0,0);
	keybd_event(Key,extra,KEYEVENTF_KEYUP,0);
end;

procedure SendKeys(s : string);
var
	i : integer;
	flag : bool;
	w : word;
begin
	{Get the state of the caps lock key}
	flag := not GetKeyState(VK_CAPITAL) and 1 = 0;
	{If the caps lock key is on then turn it off}
	if flag then
		SimulateKeystroke(VK_CAPITAL, 0);
	for i := 1 to Length(s) do
		begin
			w := VkKeyScan(s[i]);
			{If there is not an error in the key translation}
			if ((HiByte(w) <> $FF) and (LoByte(w) <> $FF)) then
				begin
					{If the key requires the shift key down - hold it down}
					if HiByte(w) and 1 = 1 then
						SimulateKeyDown(VK_SHIFT);
						{Send the VK_KEY}
					SimulateKeystroke(LoByte(w), 0);
					{If the key required the shift key down - release it}
					if HiByte(w) and 1 = 1 then
						SimulateKeyUp(VK_SHIFT);
				end;
		end;
{if the caps lock key was on at start, turn it back on}
if flag then
	SimulateKeystroke(VK_CAPITAL, 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
	{Toggle the cap lock}
	SimulateKeystroke(VK_CAPITAL, 0);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
	{Capture the entire screen to the clipboard}
	{by simulating pressing the PrintScreen key}
	SimulateKeystroke(VK_SNAPSHOT, 0);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
	{Capture the active window to the clipboard}
	{by simulating pressing the PrintScreen key}
	SimulateKeystroke(VK_SNAPSHOT, 1);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
	{Set the focus to a window (edit control) and send it a string}
	Application.ProcessMessages;
	Edit1.SetFocus;
	SendKeys('Delphi Is RAD!');
end;


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




Вопрос:
Я загружаю TImageList динамически. Как сделать картинки из TImageList прозрачными?

Ответ:
См. ответ.
 
Пример:

procedure TForm1.Button1Click(Sender: TObject);
var
bm : TBitmap;
il : TImageList;
begin
bm := TBitmap.Create;
bm.LoadFromFile('C:\DownLoad\TEST.BMP');
il := TImageList.CreateSize(bm.Width,bm.Height);
il.DrawingStyle := dsTransparent;
il.Masked := true;
il.AddMasked(bm, clRed);
il.Draw(Form1.Canvas, 0, 0, 0);
bm.Free;
il.Free;
end;


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




Вопрос:
Как заставить TMediaPlayer проигрывать одно и тоже бесконечно? AVI например?

Ответ:
В примере AVI файл проигрывается снова и снова - используем событие MediaPlayer'а Notify

Пример:

procedure TForm1.MediaPlayer1Notify(Sender: TObject);
begin
with MediaPlayer1 do
if NotifyValue = nvSuccessful then
begin
Notify := True;
Play;
end;
end;


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




Вопрос:
При выполнении диалога FontDialog со свойством Device равным fdBoth or fdPrinter, появляется ошибка "There are no fonts installed". 
Ответ:
Эти установки должны показать шрифты совместимые либо с принтером либо с экраном. В примере диалог Windows ChooseFont вызывается напрямую чтобы показать список шрифтов, совместимых одновременно и с экраном и с принтером. 
Пример:

uses Printers, CommDlg;

procedure TForm1.Button1Click(Sender: TObject);
var
	cf : TChooseFont;
	lf : TLogFont;
	tf : TFont;
begin
	if PrintDialog1.Execute then
		begin
			GetObject(Form1.Canvas.Font.Handle, sizeof(lf),@lf);
			FillChar(cf, sizeof(cf), #0);
			cf.lStructSize := sizeof(cf);
			cf.hWndOwner := Form1.Handle;
			cf.hdc := Printer.Handle;
			cf.lpLogFont := @lf;
			cf.iPointSize := Form1.Canvas.Font.Size * 10;
			cf.Flags := CF_BOTH or CF_INITTOLOGFONTSTRUCT or
				CF_EFFECTS or CF_SCALABLEONLY or CF_WYSIWYG;
			cf.rgbColors := Form1.Canvas.Font.Color;
			if ChooseFont(cf) <> false then
				begin
					tf := TFont.Create;
					tf.Handle := CreateFontIndirect(lf);
					tf.COlor := cf.RgbColors;
					Form1.Canvas.Font.Assign(tf);
					tf.Free;
					Form1.Canvas.TextOut(10, 10, 'Test');
				end;
		end;
end;


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




Вопрос:
Как сменить дисковод, откуда  MediaPlayer проигрывает аудио CD?

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

Пример:

MediaPlayer1.FileName := 'E:';


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




Вопрос:
Как убрать кнопку с названием моей программы из Панели Задач(Taskbar)?

Ответ:
Отредактируйте файл-проекта (View -> Project Source) Добавьте модуль Windows в раздел uses. Application.ShowMainForm := False; в строку после "Application.Initialize;". Добавьте ShowWindow(Application.Handle, SW_HIDE); в строку перед "Application.Run;" 

Ваш файл проекта должен выглядеть приблизительно так:

program Project1;

uses
	Windows,
	Forms,
	Unit1 in 'Unit1.pas' {Form1},
	Unit2 in 'Unit2.pas' {Form2};

{$R *.RES}

begin
	Application.Initialize;
	Application.ShowMainForm := False;
	Application.CreateForm(TForm1, Form1);
	Application.CreateForm(TForm2, Form2);
	ShowWindow(Application.Handle, SW_HIDE);
	Application.Run;
end.

В разделе "initialization" (в самом низу) каждого unit'а добавьте

begin
	ShowWindow(Application.Handle, SW_HIDE);
end.


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




Вопрос:
Как преобразовать цвета в строку - название цвета  VCL?

Ответ:
Модуль graphics.pas содержит функцию ColorToString() которое преобразует допустимое значение TColor в его строковое представление используя либо константу-название цвета (по возможности) либо шестнадцатиричную строку. Обратная функция - StringToColor() 
Пример:


procedure TForm1.Button1Click(Sender: TObject);
begin
	Memo1.Lines.Add(ColorToString(clRed));
	Memo1.Lines.Add(IntToStr(StringToColor('clRed')));
end;


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




Вопрос:
При показе максимизированное формы она перекрывает task bar и не выравнивается
по верху экрана. В чем тут дело?

Ответ:
Это может произойти когда свойство position формы установленно в poScreenCenter.
Установите position = poDefault.


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




Вопрос:
Как заставить TEdit не 'пикать' при нажатии недопустимых клавиш?

Ответ:
Перехватите событие KeyPress и установите key = #0 для недопустимых клавиш.

Пример:

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if ((UpCase(Key) < 'A') or (UpCase(Key) > 'Z')) then
Key := #0;
end;


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




Вопрос:
Как получить число и список всех компонентов, расположенных на TNoteBook?

Ответ: 
В примере список выводится на Listbox.

Пример:

procedure TForm1.Button1Click(Sender: TObject);
var
n: integer;
p: integer;
begin
ListBox1.Clear;
with Notebook1 do
begin
for n := 0 to ControlCount - 1 do
begin
with TPage(Controls[n]) do
begin
ListBox1.Items.Add('Notebook Page: ' +
TPage(Notebook1.Controls[n]).Caption);
for p := 0 to ControlCount - 1 do
ListBox1.Items.Add(Controls[p].Name);
ListBox1.Items.Add(EmptyStr);
end;
end;
end;
end;


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




Вопрос:
Я хочу вставить escape code в строку при использовании функции Format(). Например, я хочу создать строку, содержащую символ табуляции. В "C" я бы написал что-то вроде sprintf(buffer, "%s\t%s", str);. А как это будет на Pascal'e? 
Ответ:
Функция Format Pascal'я не использует escape codes. Вместо этого нужно вставить в строку действительное значение символа в кодировке ASCII. 
Пример:

Buffer := Format('%s'#9'%s', [Str1, Str2]);
ShowMessage(Format('%s'#9'%s', ['Column1', 'Column2']));


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




Вопрос:
Как показать первый кадр AVI-файла?

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

procedure TForm1.Button1Click(Sender: TObject);
begin
Application.ProcessMessages;
MediaPlayer1.Open;
Application.ProcessMessages;
MediaPlayer1.Step;
Application.ProcessMessages;
MediaPlayer1.Previous;
end;


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




Вопрос:
Когда пользователь щелкает по listview, он переходит в режим редактирования.
Как перевисти его в редим редактирования по нажатию клавиши (например F2)?

Ответ:
Перехватите F2 на событии keydown.

Пример:

procedure TForm1.ListView1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Ord(Key) = VK_F2 then
ListView1.Selected.EditCaption;
end;


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




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

Ответ:
Просто вызовите метод free этого обьекта.

Пример:

procedure TForm1.FormCreate(Sender: TObject);
var
Icon: TIcon;
begin
Icon := TIcon.Create;
Icon.LoadFromFile('C:\Program Files\BorlandImages\CONSTRUC.ICO');
ListBox1.Items.AddObject('Item 0', Icon);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
ListBox1.Items.Objects[0].Free;
end;


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




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

Ответ:
Используте функцию Windows API - GetStockObject() чтобы получить дескриптор (handle) шрифта по умолчанию устройства (DEVICE_DEFAULT_FONT) и передайте его Printer.Font.Handle. 
Пример:

uses Printers;

procedure TForm1.Button1Click(Sender: TObject);
var
	tm : TTextMetric;
	i : integer;
begin
	if PrintDialog1.Execute then
	begin
		Printer.BeginDoc;
		Printer.Canvas.Font.Handle := GetStockObject(DEVICE_DEFAULT_FONT);
		GetTextMetrics(Printer.Canvas.Handle, tm);
		for i := 1 to 10 do
		begin
			Printer.Canvas.TextOut(100,i * tm.tmHeight +
				tm.tmExternalLeading,'Test');
		end;
		Printer.EndDoc;
	end;
end;


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




Вопрос:
Мне нужно программно установить некоторые файлы с установочного диска Windows. На многих компьютерах CAB-файлы установки Windows находятся в каком-то каталоге на жестком диске, на других - Windows был установлен с CD. Как узнать откуда была установленна Windows? 
Ответ:
Эту информацию можно получить из реестра.

Пример:
uses Registry;

procedure TForm1.Button1Click(Sender: TObject);
var
	reg: TRegistry;
begin
	reg := TRegistry.Create;
	reg.RootKey := HKEY_LOCAL_MACHINE;
	reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\SETUP',false);
	ShowMessage(reg.ReadString('SourcePath'));
	reg.CloseKey;
	reg.free;
end;


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




Вопрос:
Как получить строку сообщения об ошибке Windows код которой получен функцией
GetLastError?

Ответ:
Функция RTL SysErrorMessage(GetLastError).

Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
{Cause a Windows system error message to be logged}
ShowMessage(IntToStr(lStrLen(nil)));
ShowMessage(SysErrorMessage(GetLastError));
end;


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




Вопрос:
Как заставить Delphi выполнять еще более строгую проверка типов? Напрмер - я создаю пользовательский тип, унаследованный от double и могу передавать его любым функциям, принимающим параметр типа double. Как заставить компилятор проводить более строгую проверку типов и выдавать предупреждение в таких случаях? 
Ответ:
См. ответ. 

Пример:

type TStrongType = type Double;
type TWeakType = Double;

procedure AddWeakType(var d : TWeakType);
begin
	d := d + 1;
end;

procedure AddStrongType(var d : TStrongType);
begin
	d := d + 1;
end;

procedure AddDoubleType(var d : Double);
begin
	d := d + 1;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
	d : Double;
	s : TStrongType;
	w : TWeakType;
begin
	AddDoubleType(d); {compiles fine}
	AddDoubleType(w); {compiles fine}
	AddDoubleType(s); {<- compile error}
	AddDoubleType(double(s)); {compiles fine}
	AddWeakType(d); {compiles fine}
	AddWeakType(w); {compiles fine}
	AddWeakType(s); {<- compile error}
	AddWeakType(TWeakType(s)); {compiles fine}
	AddStrongType(d); {<- compile error}
	AddStrongType(TStrongType(d)); {compiles fine}
	AddStrongType(w); {<- compile error}
	AddStrongType(TStrongType(w)); {compiles fine}
	AddStrongType(s); {compiles fine}
end;


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




Вопрос:
Где в Delphi обьявленны VK_Key для A-Z и 0-9?

Ответ:
Они не обьявлены в Delphi поскольку они просто могуть быть заменены буквами.
VK_0 до VK_9 то же что и  ASCII '0' до '9' ($30 - $39),
VK_A до VK_Z то же что и  ASCII 'A' до 'Z' ($41 - $5A).


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




Вопрос: 
Как изменить оконную процедуру для TForm?

Ответ:
Переопределите в подклассе TForm оконную процедуру WinProc класса. В примере оконная процедура переопределяется для того чтобы реагировать на сообщение WM_CANCELMODE, показывающее, что выполняется messagebox или какой-либо еще диалог. 
Пример:

type
	TForm1 = class(TForm)
		Button1: TButton;
		procedure WndProc (var Message: TMessage); override;
		procedure Button1Click(Sender: TObject);
	private
		{Private declarations}
	public
		{Public declarations}
end;

var
	Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WndProc (var Message: TMessage);
begin
	if Message.Msg = WM_CANCELMODE then
		begin
			Form1.Caption := 'A dialog or message box has popped up';
		end
	else
		inherited  // <- остальное сделает родительская процедура
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
	ShowMessage('Test Message');
end;


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




Вопрос:
Как узнать размеры TComboBox с показанным выпадающим списком до показа списка?

Ответ:
На событии FormShow пошлите сообщение CB_SHOWDROPDOWN в ComboBox дважды - один раз чтобы заставить список выпасть, второй - чтобы убрать его. Затем пошлите сообщение CB_GETDROPPEDCONTROLRECT, передав в качестве параметра адрес TRect. TRect будет содержать экранные кординаты прямоугольника описывающего ComboBox вместе с выпавшим списком. Затем Вы можете вызвать ScreenToClient чтобы преобразовать экранные кординаты в координаты клиентской области окна. 
Пример:

var
	R : TRect;
procedure TForm1.FormShow(Sender: TObject);
var
	T : TPoint;
begin
	SendMessage(ComboBox1.Handle, CB_SHOWDROPDOWN, 1, 0);
	SendMessage(ComboBox1.Handle, CB_SHOWDROPDOWN, 0, 0);
	SendMessage(ComboBox1.Handle, CB_GETDROPPEDCONTROLRECT, 0, LongInt(@r));
	t := ScreenToClient(Point(r.Left, r.Top));
	r.Left := t.x;
	r.Top := t.y;
	t := ScreenToClient(Point(r.Right, r.Bottom));
	r.Right := t.x;
	r.Bottom := t.y;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
	Form1.Canvas.Rectangle(r.Left, r.Top, r.Right, r.Bottom );
end;


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




Вопрос:
Я хочу создать в своей программе меню "а ля Дельфи 4". Как это сделать?

Ответ:
1. Разместите на форме TControlBar. (закладка Additional) Установите Align = Client. 
2. Разместите TToolBar (закладка Win32) внутри TControlBar.
3. Установите в True свойства Flat и ShowCaptions этого TToolBar.
4. Создайте на TToolBar столько TToolButtons сколько Вам нужно. (щелкнув по TToolBar
правой кнопкой и выбрав NewButton)
5. Установите свойство Grouped = True для всех TToolButtons. Это позволит меню выпадать
при перемещении курсора между главными пунктами меню (если меню уже показано).
6. Разместите на фоме TMainMenu и убедитесь, что оно *НЕ присоденено* как меню главной
формы. (посмотрите свойство Menu формы).
7. Создайте все пункты меню (щелкнув по TMainMenu кнопкой и выбрав Menu Designer)
8. Для каждой TToolButton установите ее MenuItem равным соответсвующему пункту TMainMenu.


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




Вопрос:
Как добится того чтобы TMemo и TEdit имели работали не только в режиме вставки символов,
но и в режиме замены?

Ответ:
Элементы управления Windows TEdit и TMemo не имеют режима замены. Однако этот режим можно эмулировать установив свойство SelLength edit'а или memo в 1 при обработке события KeyPress. Это заставит его перезаписывать символ в текущей позиции курсора. В примере этот способ используется для TMemo. Режим вставка/замена переключается клавишей "Insert". 
Пример:

type
	TForm1 = class(TForm)
		Memo1: TMemo;
		procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
		procedure Memo1KeyPress(Sender: TObject; var Key: Char);
private
	{Private declarations}
		InsertOn : bool;
public
	{Public declarations}
end;

var
	Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
	if (Key = VK_INSERT) and (Shift = []) then
		InsertOn := not InsertOn;
end;

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
	if ((Memo1.SelLength = 0) and (not InsertOn)) then
		Memo1.SelLength := 1;
end;
Наверх к содержанию