|
|
Programming: Delphi
DELPHI VCL FAQ (Часть 2)
Вопрос:
Как вставить содержимое файла в текущую позицию курсора в компонете TMemo?
Ответ:
Считайте файл в TMemoryStream, затем ипользуйте метод TMemo SetSelTextBuf() для вставки текста;
<![CDATA[var
TheMStream : TMemoryStream;
Zero : char;
begin
TheMStream := TMemoryStream.Create;
TheMStream.LoadFromFile('C:\AUTOEXEC.BAT');
TheMStream.Seek(0, soFromEnd);
//Null terminate the buffer!
Zero := #0;
TheMStream.Write(Zero, 1);
TheMStream.Seek(0, soFromBeginning);
Memo1.SetSelTextBuf(TheMStream.Memory);
TheMStream.Free;
end;]]>
Наверх к содержанию
Вопрос:
Как в компоненте TMemo перехватить нажатие Ctrl-V и вставить
специальный текст не из буфера обмена (clipboard)?
Ответ:
См. пример.
Пример:
<![CDATA[uses ClipBrd;
procedure TForm1.Memo1KeyDown
(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if ((Key = ord('V')) and (ssCtrl in Shift)) then
begin
if Clipboard.HasFormat(CF_TEXT) then
ClipBoard.Clear;
Memo1.SelText := 'Delphi is RAD!';
key := 0;
end;
end;]]>
Наверх к содержанию
Вопрос:
Как создать эквивалент TEdit но только с выравниваением
вводимого текста по центру или по правой стороне?
Ответ:
TEdit не поддерживает выравниваение текста по центру и по
правой стороне - лучше использовать компонент TMemo. Вам понадобится
запретить пользователю нажимать Enter, Ctrl-Enter и всевозможные
комбинации клавиш со стрелками, чтобы избежать появления нескольких сторк
в Memo. Этого можно добиться и просматривая содержимое текста в TMemo в
поисках кода возврата каретки (13) и перевода строки(10) на событиях TMemo
Change и KeyPress. Можно также заменять код возврата каретки на пробел -
для того чтобы позволять вставку из буфера обмена многострочного текста в
виде одной строки.
Пример:
<![CDATA[procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Alignment := taRightJustify;
Memo1.MaxLength := 24;
Memo1.WantReturns := false;
Memo1.WordWrap := false;
end;
procedure MultiLineMemoToSingleLine(Memo : TMemo);
var
t : string;
begin
t := Memo.Text;
if Pos(#13, t) > 0 then
begin
while Pos(#13, t) > 0 do
delete(t, Pos(#13, t), 1);
while Pos(#10, t) > 0 do
delete(t, Pos(#10, t), 1);
Memo.Text := t;
end;
end;
procedure TForm1.Memo1Change(Sender: TObject);
begin
MultiLineMemoToSingleLine(Memo1);
end;
procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
MultiLineMemoToSingleLine(Memo1);
end;]]>
Наверх к содержанию
Вопрос:
Как запрограммировать undo?
Ответ:
См. пример
<![CDATA[Memo1.Perform(EM_UNDO, 0, 0);]]>
Если Вы хотите узнать, возможно ли выполнить операцию "Undo", проверьте "Undo status":
<![CDATA[If Memo1.Perform(EM_CANUNDO, 0, 0) <> 0 then
begin
{Undo is possible}
end;]]>
Для выполнения "Redo" выполните "Undo" еще раз.
Наверх к содержанию
Вопрос:
Можно ли создать форму, которая получает дополнительные параметры в методе Сreate?
Ответ:
Просто замените конструктор Create класса Вашей формы.
Пример:
<![CDATA[unit Unit2;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TForm2 = class(TForm)
private
{Private declarations}
public
constructor CreateWithCaption(aOwner: TComponent; aCaption: string);
{Public declarations}
end;
var
Form2: TForm2;
implementation
{$R *.DFM}
constructor TForm2.CreateWithCaption(aOwner: TComponent; aCaption: string);
begin
Create(aOwner);
Caption := aCaption;
end;
uses Unit2;
procedure TForm1.Button1Click(Sender: TObject);
begin
Unit2.Form2 :=Unit2.TForm2.CreateWithCaption(Application, 'My Caption');
Unit2.Form2.Show;
end;]]>
Наверх к содержанию
Вопрос:
Почему при изменении цвета шрифта в StatusBar's он (шрифт) не меняется?
Ответ:
Status bar (строка состояния) - стандартный элемент
управления Windows и цвет его шрифта задается через Control Panel
(константа clBtnText). Этот цвет по умолчанию черный и может меняться при
выборе пользователем той или иной цветовой схемы. У компонента ТStatusBar
и его панелей есть возможность "owner-draw" - программной перерисовки,
которая позволяет выводить на панель текст любого цвета. Измените свойство
Style компонента TStatusBar.Panels на OwnerDraw.
Пример:
<![CDATA[procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
const Rect: TRect);
begin
if Panel = StatusBar.Panels[0] then
begin
StatusBar.Canvas.Font.Color := clRed;
StatusBar.Canvas.TextOut(Rect.Left, Rect.Top, 'Panel - 0')
end
else
begin
StatusBar.Canvas.Font.Color := clGreen;
StatusBar.Canvas.TextOut(Rect.Left, Rect.Top, 'Panel - 1');
end;
end;]]>
Наверх к содержанию
Вопрос:
Как бы мне создать эдакий trackbar в котором вместо широкой
белой полоски с ползунком была бы тонкая линия?
Ответ:
В примере создается компонент, унаследованный от TTrackbar
который переопределяет метод CreateParams и убират флаг TBS_ENABLESELRANGE
из Style. Константа TBS_ENABLESELRANGE обьявленна в модуле CommCtrl.
Пример:
<![CDATA[uses CommCtrl, ComCtrls;
type TMyTrackBar = class(TTrackBar)
procedure CreateParams(var Params: TCreateParams); override;
end;
procedure TMyTrackBar.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style and not TBS_ENABLESELRANGE;
end;
var
MyTrackbar : TMyTrackbar;
procedure TForm1.Button1Click(Sender: TObject);
begin
MyTrackBar := TMyTrackbar.Create(Form1);
MyTrackbar.Parent := Form1;
MyTrackbar.Left := 100;
MyTrackbar.Top := 100;
MyTrackbar.Width := 150;
MyTrackbar.Height := 45;
MyTrackBar.Visible := true;
end;]]>
Наверх к содержанию
Вопрос:
Мне нужен временный canvas, но когда я пытаюсь его создать
получаю сообщения об ошибках. Как создать TCanvas?
Ответ:
Создайте Bitmap и используйте свойство canvas класса TBitmap.
Пример создает Bitmap, рисует на его canvas'е, выводит этот canvas на
форму и освобождает bitmap.
Пример:
<![CDATA[procedure TForm1.Button1Click(Sender: TObject);
var
bm : TBitmap;
begin
bm := TBitmap.Create;
bm.Width := 100;
bm.Height := 100;
bm.Canvas.Brush.Color := clRed;
bm.Canvas.FillRect(Rect(0, 0, 100, 100));
bm.Canvas.MoveTo(0, 0);
bm.Canvas.LineTo(100, 100);
Form1.Canvas.StretchDraw(Form1.ClientRect,Bm);
bm.Free;
end;]]>
Наверх к содержанию
Вопрос:
В некоторых видео режимах прозрачная часть glyph'а
стандартного TBitBtn становится видной. Как этого избежать?
Ответ:
В примере используется техника закраски прозрачной части
glyph'а цветом кнопки на которой он находится - таким образом glyph
кажется прозрачным.
Пример:
<![CDATA[function InitStdBitBtn(BitBtn : TBitBtn; kind : TBitBtnKind) : bool;
var
Bm1 : TBitmap;
Bm2 : TBitmap;
begin
Result := false;
if Kind = bkCustom then exit;
Bm1 := TBitmap.Create;
case Kind of
bkOK : Bm1.Handle := LoadBitmap(hInstance, 'BBOK');
bkCancel : Bm1.Handle := LoadBitmap(hInstance, 'BBCANCEL');
bkHelp : Bm1.Handle := LoadBitmap(hInstance, 'BBHELP');
bkYes : Bm1.Handle := LoadBitmap(hInstance, 'BBYES');
bkNo : Bm1.Handle := LoadBitmap(hInstance, 'BBNO');
bkClose : Bm1.Handle := LoadBitmap(hInstance, 'BBCLOSE');
bkAbort : Bm1.Handle := LoadBitmap(hInstance, 'BBABORT');
bkRetry : Bm1.Handle := LoadBitmap(hInstance, 'BBRETRY');
bkIgnore : Bm1.Handle := LoadBitmap(hInstance, 'BBIGNORE');
bkAll : Bm1.Handle := LoadBitmap(hInstance, 'BBALL');
end;
Bm2 := TBitmap.Create;
Bm2.Width := Bm1.Width;
Bm2.Height := Bm1.Height;
Bm2.Canvas.Brush.Color := ClBtnFace;
Bm2.Canvas.BrushCopy(Rect(0, 0, bm2.Width, bm2.Height), Bm1,
Rect(0, 0, Bm1.width, Bm1.Height),
Bm1.canvas.pixels[0,0]);
Bm1.Free;
LockWindowUpdate(BitBtn.Parent.Handle);
BitBtn.Kind := kind;
BitBtn.Glyph.Assign(bm2);
LockWindowUpdate(0);
Bm2.Free;
Result := true;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
InitStdBitBtn(BitBtn1, bkOk);
end;]]>
Наверх к содержанию
Вопрос:
Создание PolyPolygon используя массив точек?
Ответ:
Polygon - метод компонента TCanvas получает в качестве
параметра динамический массив точек. Функция PolyPolygon() из Windows GDI
получает указатель на массив точек.
Пример:
<![CDATA[procedure TForm1.Button1Click(Sender: TObject);
var
ptArray : array[0..9] of TPOINT;
PtCounts : array[0..1] of integer;
begin
PtArray[0] := Point(0, 0);
PtArray[1] := Point(0, 100);
PtArray[2] := Point(100, 100);
PtArray[3] := Point(100, 0);
PtArray[4] := Point(0, 0);
PtCounts[0] := 5;
PtArray[5] := Point(25, 25);
PtArray[6] := Point(25, 75);
PtArray[7] := Point(75, 75);
PtArray[8] := Point(75, 25);
PtArray[9] := Point(25, 25);
PtCounts[1] := 5;
PolyPolygon(Form1.Canvas.Handle,
PtArray,PtCounts,2);
end;]]>
Наверх к содержанию
Вопрос:
Как создать невизуальный компонент без иконоки, которая
изображается в палитре компонентов в "design-time" (вроде TField)?
Ответ:
Невизуальные компоненты без иконоки удобны для
субкомпонентов, связанных с какими-то другими компонентами. Создайте
компонент как обычно, но используйте RegisterNoIcon вместо
RegisterComponent.
Наверх к содержанию
Вопрос:
Как показывать нестандартный встроенный редактор (inplace editor) в
ячейке stringgrid (например combobox).
Ответ:
См. пример
Пример:
<![CDATA[procedure TForm1.FormCreate(Sender: TObject);
begin
{Высоту combobox'а не изменишь, так что вместо combobox'а
будем изменять высоту строки grid'а !}
StringGrid1.DefaultRowHeight := ComboBox1.Height;
{Спрятать combobox}
ComboBox1.Visible := False;
ComboBox1.Items.Add('Delphi Kingdom');
ComboBox1.Items.Add('Королевство Дельфи');
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
{Перебросим выбранное в значение из ComboBox в grid}
StringGrid1.Cells[StringGrid1.Col,
StringGrid1.Row] :=ComboBox1.Items[ComboBox1.ItemIndex];
ComboBox1.Visible := False;
StringGrid1.SetFocus;
end;
procedure TForm1.ComboBox1Exit(Sender: TObject);
begin
{Перебросим выбранное в значение из ComboBox в grid}
StringGrid1.Cells[StringGrid1.Col,
StringGrid1.Row] :=ComboBox1.Items[ComboBox1.ItemIndex];
ComboBox1.Visible := False;
StringGrid1.SetFocus;
end;
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
var
R: TRect;
begin
if ((ACol = 3) AND (ARow <> 0)) then
begin
{Ширина и положение ComboBox должно соответствовать
ячейке StringGrid}
R := StringGrid1.CellRect(ACol, ARow);
R.Left := R.Left + StringGrid1.Left;
R.Right := R.Right + StringGrid1.Left;
R.Top := R.Top + StringGrid1.Top;
R.Bottom := R.Bottom + StringGrid1.Top;
ComboBox1.Left := R.Left + 1;
ComboBox1.Top := R.Top + 1;
ComboBox1.Width := (R.Right + 1) - R.Left;
ComboBox1.Height := (R.Bottom + 1) - R.Top;
{Покажем combobox}
ComboBox1.Visible := True;
ComboBox1.SetFocus;
end;
CanSelect := True;
end;]]>
Наверх к содержанию
Вопрос:
Как узнать есть ли в заданном CD-ROM'е Audio CD?
Ответ:
Можно использовать функцию Windows API GetDriveType() чтобы
определить является ли дисковод CD-ROM'мом. И функцию API
GetVolumeInformation() чтобы проверить VolumeName на равенство 'Audio CD'.
Пример:
<![CDATA[function IsAudioCD(Drive : char) : bool;
var
DrivePath : string;
MaximumComponentLength : DWORD;
FileSystemFlags : DWORD;
VolumeName : string;
Begin
sult := false;
DrivePath := Drive + ':\';
if GetDriveType(PChar(DrivePath)) <> DRIVE_CDROM then
exit;
SetLength(VolumeName, 64);
GetVolumeInformation(PChar(DrivePath),PChar(VolumeName),
Length(VolumeName),nil,MaximumComponentLength,FileSystemFlags,nil,0);
if lStrCmp(PChar(VolumeName),'Audio CD') = 0 then
result := true;
end;
function PlayAudioCD(Drive : char) : bool;
var
mp : TMediaPlayer;
begin
result := false;
Application.ProcessMessages;
if not IsAudioCD(Drive) then
exit;
mp := TMediaPlayer.Create(nil);
mp.Visible := false;
mp.Parent := Application.MainForm;
mp.Shareable := true;
mp.DeviceType := dtCDAudio;
mp.FileName := Drive + ':';
mp.Shareable := true;
mp.Open;
Application.ProcessMessages;
mp.Play;
Application.ProcessMessages;
mp.Close;
Application.ProcessMessages;
mp.free;
result := true;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not PlayAudioCD('D') then
ShowMessage('Not an Audio CD');
end;]]>
Наверх к содержанию
Вопрос:
Как узнать есть ли у мыши колесико?
Ответ:
Свойство "WheelPresent" глобального обьекта "mouse".
Наверх к содержанию
Вопрос:
События KeyPress и KeyDown не вызываются для клавиши Tab -
как определить, что она была нажата?
Ответ:
На уровне формы клавиша tab обычно обрабатывается Windows. В
примере создается обработчик события CM_Dialog для перехвата Dialog keys.
Пример:
<![CDATA[type
TForm1 = class(TForm)
private
procedure CMDialogKey( Var msg: TCMDialogKey );
message CM_DIALOGKEY;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.CMDialogKey(var msg: TCMDialogKey);
begin
if msg.Charcode <> VK_TAB then
inherited;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Key = VK_TAB then
Form1.Caption := 'Tab Key Down!';
end;]]>
Наверх к содержанию
Вопрос:
В чем отличие между Create(Self) и Create(Application)?
Ответ:
Self может быть использовано только в методе класса, и
ссылается на текущий экземпляр класса. Таким образом "Self" в методе
класса TForm1 ссылается на текущий экземпляр TForm1. При создании
компонента Вы передаете его владельца (owner) в конструктор. При
уничтожении формы или компонента автоматически уничтожаются и все
компоненты владельцем которого она является. Таким образом если при
создании формы передать в качестве владельца Application эта форма будет
автоматически уничтожена при уничтожении Application. Если же при создании
формы передать в качестве владельца другую форму, вновь созданная форма
будет автоматически уничтоженна при уничтожении формы-владельца.
Наверх к содержанию
Вопрос:
Как во время выполнения определить поддерживает ли обьект заданное свойство?
Ответ:
<![CDATA[function HasProperty(Obj : TObject; Prop : string) : PPropInfo;
begin
Result := GetPropInfo(Obj.ClassInfo, Prop);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
p : pointer;
begin
p := HasProperty(Button1, 'Color');
if p <> nil then
SetOrdProp(Button1, p, clRed)
else
ShowMessage('Button has no color property');
p := HasProperty(Label1, 'Color');
if p <> nil then
SetOrdProp(Label1, p, clRed)
else
ShowMessage('Label has no color property');
p := HasProperty(Label1.Font, 'Color');
if p <> nil then
SetOrdProp(Label1.Font.Color, p, clBlue)
else
ShowMessage('Label.Font has no color property');
end;]]>
Наверх к содержанию
Вопрос:
Как при проигрывании музыки с Audio CD показывать сколько прошло минут и секунд?
Ответ:
В примере время выводится по таймеру.
Пример:
<![CDATA[uses MMSystem;
procedure TForm1.Timer1Timer(Sender: TObject);
var
Trk : Word;
Min : Word;
Sec : Word;
begin
with MediaPlayer1 do
begin
Trk := MCI_TMSF_TRACK(Position);
Min := MCI_TMSF_MINUTE(Position);
Sec := MCI_TMSF_SECOND(Position);
Label1.Caption := Format('%.2d',[Trk]);
Label2.Caption := Format('%.2d:%.2d',[Min,Sec]);
end;
end;]]>
Наверх к содержанию
Вопрос:
Можно ли рисовать на рамке формы?
Ответ:
Обрабатывайте событие WM_NCPAINT. В примере рамка обводится красной линией
толщиной в 1 пиксел.
Пример:
<![CDATA[type
TForm1 = class(TForm)
private
{Private declarations}
procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPAINT;
public
{Public declarations}
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
var
dc : hDc;
Pen : hPen;
OldPen : hPen;
OldBrush : hBrush;
begin
inherited;
dc := GetWindowDC(Handle);
msg.Result := 1;
Pen := CreatePen(PS_SOLID, 1, RGB(255, 0, 0));
OldPen := SelectObject(dc, Pen);
OldBrush := SelectObject(dc, GetStockObject(NULL_BRUSH));
Rectangle(dc, 0,0, Form1.Width, Form1.Height);
SelectObject(dc, OldBrush);
SelectObject(dc, OldPen);
DeleteObject(Pen);
ReleaseDC(Handle, Canvas.Handle);
end;]]>
Наверх к содержанию
Вопрос:
Как выполнить какой-то процесс тогда, когда пользователь не работает с моим приложением?
Ответ:
Создайте процедуру, которая будет вызываться при событии Application.OnIdle.
Обьявим процедуру:
<![CDATA[{Private declarations}
procedure IdleEventHandler(Sender: TObject; var Done: Boolean);]]>
В разделе implementation опишем поцедуру:
<![CDATA[procedure TForm1.IdleEventHandler(Sender: TObject; var Done: Boolean);
begin
{Do a small bit of work here}
Done := false;
end;]]>
В методе Form'ы OnCreate - укажем что наша процедура вызывается на событии
Application.OnIdle.
<![CDATA[Application.OnIdle := IdleEventHandler;]]>
Событие OnIdle возникает один раз - когда приложение переходит в
режим "безделья" (idle). Если в обработчике переменной Done присвоить
False событие будет вызываться вновь и вновь, до тех пор пока приложение
"бездельничает" и переменной Done не присвоенно значение True.
Наверх к содержанию
Вопрос:
При перемещении фокуса ввода клавишей Tab чтобы переместить его в
RadioGroup нужно нажать клавишу Tab дважды если какой нибудь пункт
RadioGroup уже выбран, но только один раз если не выбран. Можно ли сделать
поведение RadioGroup логичным?
Ответ:
Установка свойства RadioGroup'ы TabStop в false должна решить
эту проблему - поскольку клавиша tab будет продолжать работать -
перемещаясь сразу на выделенный пункт RadioGroup.
Наверх к содержанию
Вопрос:
Как разместить маленькие картинки в компоненте TPopUpMenu?
Ответ:
В приведенном примере показано как это сделать с использованием
функции Windows API SetMenuItemBitmaps(). Эта функция получает handle
popup menu, позицию строчки меню куда будет помещена картинка, и два
дескриптора(handles) на две картинки (одна из них - картинка которая будет
показана когда строка меню доступна, вторая - когда строка меню
недоступна).
<![CDATA[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 файла, и выяснить как долго будет проигрывться этот файл?
Ответ:
В приведенном примере указано как получить эту информацию.
Пример:
<![CDATA[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?
Пример:
<![CDATA[procedure TForm1.Button1Click(Sender: TObject);
begin
TStringGrid(DbGrid1).FixedCols := 2;
end;]]>
Наверх к содержанию
Вопрос:
Некоторые компоненты баз данных (и среди них TDBGrid) никак не
меняют визуальных свойств, когда к ним отключен доступ (disabled). Как это
изменить програмно?
Ответ:
Ниже приведен пример, меняющий цвет шрифта на clGray, когда
доступ к элементу управления (в данном случае TDBGrid) запрещен
(disabled).
<![CDATA[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.
Пример:
<![CDATA[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'а.
Пример:
<![CDATA[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 и отправляет в него строку.
Пример:
<![CDATA[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 прозрачными?
Ответ:
См. ответ.
Пример:
<![CDATA[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
Пример:
<![CDATA[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 вызывается
напрямую чтобы показать список шрифтов, совместимых одновременно и с
экраном и с принтером.
Пример:
<![CDATA[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?
Ответ:
См. пример.
Пример:
<![CDATA[MediaPlayer1.FileName := 'E:';]]>
Наверх к содержанию
Вопрос:
Как убрать кнопку с названием моей программы из Панели Задач(Taskbar)?
Ответ:
Отредактируйте файл-проекта (View -> Project Source)
Добавьте модуль Windows в раздел uses. Application.ShowMainForm := False;
в строку после "Application.Initialize;". Добавьте
ShowWindow(Application.Handle, SW_HIDE); в строку перед "Application.Run;"
Ваш файл проекта должен выглядеть приблизительно так:
<![CDATA[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()
Пример:
<![CDATA[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 для недопустимых клавиш.
Пример:
<![CDATA[procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if ((UpCase(Key) < 'A') or (UpCase(Key) > 'Z')) then
Key := #0;
end;]]>
Наверх к содержанию
Вопрос:
Как получить число и список всех компонентов, расположенных на TNoteBook?
Ответ:
В примере список выводится на Listbox.
Пример:
<![CDATA[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.
Пример:
<![CDATA[Buffer := Format('%s'#9'%s', [Str1, Str2]);
ShowMessage(Format('%s'#9'%s', ['Column1', 'Column2']));]]>
Наверх к содержанию
Вопрос:
Как показать первый кадр AVI-файла?
Ответ:
См. пример.
Пример:
<![CDATA[procedure TForm1.Button1Click(Sender: TObject);
begin
Application.ProcessMessages;
MediaPlayer1.Open;
Application.ProcessMessages;
MediaPlayer1.Step;
Application.ProcessMessages;
MediaPlayer1.Previous;
end;]]>
Наверх к содержанию
Вопрос:
Когда пользователь щелкает по listview, он переходит в режим редактирования.
Как перевисти его в редим редактирования по нажатию клавиши (например F2)?
Ответ:
Перехватите F2 на событии keydown.
Пример:
<![CDATA[procedure TForm1.ListView1KeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
begin
if Ord(Key) = VK_F2 then
ListView1.Selected.EditCaption;
end;]]>
Наверх к содержанию
Часть 1 | Часть 3
При перепечатке любого материала
с сайта, видимая ссылка на источник www.warayg.narod.ru
и все имена, ссылки авторов обязательны.
© 2005
|
|
|