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

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

Ответ:

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;


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



Вопрос:

Ответ:

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 в какой-либо момент времени?

Ответ:

Пример:

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'а?

Ответ:

Пример:

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;


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



Вопрос:

Ответ:

Пример:

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)?

Ответ:

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

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?

Ответ:

Пример:

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;


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



Вопрос:

Ответ:

Пример:

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;


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



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

Ответ:

Пример:

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;


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



Вопрос:

Ответ:
Эту информацию можно получить из реестра.

Пример:
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;


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



Вопрос:

Ответ:
См. ответ.

Пример:

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?

Ответ:

Пример:

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 с показанным выпадающим списком до показа списка?

Ответ:

Пример:

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 имели работали не только в режиме вставки символов,
но и в режиме замены?

Ответ:

Пример:

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;


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



Вопрос:
Как отправить сообщение сразу всем элементам управления формы?

Ответ:

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



Вопрос:
При попытке присвоить значение свойству "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'а?

Ответ:

Пример:

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;


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

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

© faqs.org.ru