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

Вопрос:

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

Ответ:

В примере приведено два способа ограничить длину текста в TEdit так чтобы она не превышала ширину клиентской области окна TEdit'а и не появлялась прокрутка текста. Первый способ устанавливает свойство TEdit'а MaxLength равным числу букв "W", которые поместятся в TEdit. "W" выбрана потому, что является, наверное, самой широкой буквой в любом шрифте. Этот метод сносно работает для шрифтов с фиксированной шириной букв, но для шрифтов с переменной шириной букв вряд ли сгодится. Второй способ перхватывает событие KeyPress TEdit'а и измеряет ширину уже введенного текста и ширину нового символа. Если ширина больше чем клиентская область TEdit'а новый символ отбрасывается и вызывается MessageBeep.

Пример:

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;

Вопрос:

Как сохранить обьект TFont в реестре/ini/файле/таблице базы данных?

Ответ:

Нужно сохранять атрибуты шрифта (имя, размер и т.п.) а не сам обьект TFont. После считывания этой информации следует проверить существует ли такой шрифт, прежде чем его использовать. Чтобы не показаться голословным дополню ответ Borland'а своим примером сохранения/чтения шрифта в/из реестра

Uses ... Registry;

procedure SaveFontToRegistry(Font : TFont; SubKey : String);
Var R :
 TRegistry;
 FontStyleInt : byte;
 FS : TFontStyles;
begin
 R:=TRegistry.Create;
 try
  FS:=Font.Style;
  Move(FS,FontStyleInt,1);
  R.OpenKey(SubKey,True);
  R.WriteString('Font Name',Font.Name);
  R.WriteInteger('Color',Font.Color);
  R.WriteInteger('CharSet',Font.Charset);
  R.WriteInteger('Size',Font.Size);
  R.WriteInteger('Style',FontStyleInt);
 finally
  R.Free;
 end;
end;

function ReadFontFromRegistry(Font : TFont; SubKey : String) : boolean;
Var
 R : TRegistry;
 FontStyleInt : byte;
 FS : TFontStyles;
begin
 R:=TRegistry.Create;
 try
  result:=R.OpenKey(SubKey,false);
  if not result then exit;
  Font.Name:=R.ReadString('Font Name');
  Font.Color:=R.ReadInteger('Color');
  Font.Charset:=R.ReadInteger('CharSet');
  Font.Size:=R.ReadInteger('Size');
  FontStyleInt:=R.ReadInteger('Style');
  Move(FontStyleInt,FS,1);
  Font.Style:=FS;
 finally
  R.Free;
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 If FontDialog1.Execute then begin
  SaveFontToRegistry(FontDialog1.Font,'Delphi Kingdom\Fonts');
 end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var NFont : TFont;
begin
 NFont:=TFont.Create;
 if ReadFontFromRegistry(NFont,'Delphi Kingdom\Fonts') then begin
  //здесь добавить проверку - существует ли шрифт
  Label1.Font.Assign(NFont);
  NFont.Free;
 end;
end;

Вопрос:

Как перемещать компонент мышкой во время работы программы "runtime"?

Ответ:

Перехватить событие OnMouseDown, запомнить x и y координты курсора мыши. Отслеживать движение мыши по событию OnMouseMove и перемещать компонент вслед за курсором мыши до тех пор пока не произойдет событие OnMouseUp. В примере показано перемещение компонента TButton. Перемещение начинается, когда пользователь "берет" TButton мышью, удерживая нажатой клавишу "Сontrol".

Пример:

type TForm1 = class(TForm)
 Button1: TButton;
 procedure Button1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
 procedure Button1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
private
 {Private declarations}
public
 {Public declarations}
 MouseDownSpot : TPoint;
 Capturing : bool;
end;