500+ FAQ по Delphi

Перейти на: Главную | Индексную | Предыдущую | Следующую страницу


Как в компоненте TMemo перехватить нажатие Ctrl-V и вставить специальный текст не из буфера обмена (clipboard)?

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.
Можно также заменять код возврата каретки на пробел - для того чтобы позволять вставку из буфера обмена
многострочного текста в виде одной строки.
Пример:

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?

Memo1.Perform(EM_UNDO, 0, 0);

Если Вы хотите узнать, возможно ли выполнить операцию "Undo", проверьте "Undo status":

If Memo1.Perform(EM_CANUNDO, 0, 0) <> 0 then
begin
{Undo is possible}
end;

Для выполнения "Redo" выполните "Undo" еще раз.

Можно ли создать форму, которая получает дополнительные параметры в методе Сreate?

Просто замените конструктор Create класса Вашей формы.
Пример:
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.
Пример:

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

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.


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 кажется прозрачным.
Пример:

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 получает указатель на массив точек.
Пример:

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).
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'.
Пример:

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.
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. Если же при создании формы передать в
качестве владельца другую форму, вновь созданная форма будет автоматически уничтоженна при
уничтожении формы-владельца.

Как во время выполнения определить поддерживает ли обьект заданное свойство?

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;


Материалы находятся на сайте http://cracklab.narod.ru/faq/


Создатель этого HTML файла не претендует на авторство вопросов/ответов представленных в нём, не отвечает за их содержание и достоверность, а также за последствия использования программных кодов , полученных из этого HTML файла. Также не принимаются претензии относительно не размещённой информации об авторе каждого конкретного FAQ'а. Любые другие вопросы присылайте на bad_guy@cracklab.ru (обращаться к Bad_guy'ю).
Hosted by uCoz