Виртуальная библиотека Delphi - [81]

Ответ:

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;

Вопрос:

Как бы мне создать эдакий 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]);