Виртуальная библиотека Delphi

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;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

if ssCtrl in Shift then begin

SetCapture(Button1.Handle);

Capturing := true;

MouseDownSpot.X := x;

MouseDownSpot.Y := Y;

end;

end;

procedure TForm1.Button1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

if Capturing then begin

Button1.Left := Button1.Left - (MouseDownSpot.x - x);

Button1.Top := Button1.Top - (MouseDownSpot.y - y);

end;

end;

procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

if Capturing then begin

ReleaseCapture;

Capturing := false;

Button1.Left := Button1.Left - (MouseDownSpot.x - x);

Button1.Top := Button1.Top - (MouseDownSpot.y - y);

end;

end;

Вопрос:

При попытке создать обьект класса TPrinter (TPrinter.Create) я получаю exception. Почему?

Ответ:

В создании обьекта класса TPrinter с использованием TPrinter.Create нет необходимости, так как обьект класса TPrinter (называемый Printer) автоматически создается при использовании модуля Printers.

Пример:

uses Printers;

procedure TForm1.Button1Click(Sender: TObject);

begin

Printer.BeginDoc;

Printer.Canvas.TextOut(100, 100, 'Hello World!');

Printer.EndDoc;

end;

Вопрос:

Как перехватить события в неклиентской области формы, в заголовке окна, например?

Ответ:

Создайте обработчик одного из сообщений WM_NC (non client — не клиентских) (посмотрите WM_NC в Windows API help). Пример показывает как перехватить вижение мыши во всей неклиенстской области окна (рамка и заголовок).

Пример:

unit Unit1;

interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type TForm1 = class(TForm)

private

{Private declarations}

procedure WMNCMOUSEMOVE(var Message: TMessage); message WM_NCMOUSEMOVE;

public

{Public declarations}

end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMNCMOUSEMOVE(var Message: TMessage);

var s : string;

begin

case Message.wParam of

HTERROR: s:= 'HTERROR';

HTTRANSPARENT: s:= 'HTTRANSPARENT';

HTNOWHERE: s:= 'HTNOWHERE';

HTCLIENT: s:= 'HTCLIENT';

HTCAPTION: s:= 'HTCAPTION';

HTSYSMENU: s:= 'HTSYSMENU';

HTSIZE: s:= 'HTSIZE';

HTMENU: s:= 'HTMENU';

HTHSCROLL: s:= 'HTHSCROLL';

HTVSCROLL: s:= 'HTVSCROLL';

HTMINBUTTON: s:= 'HTMINBUTTON';

HTMAXBUTTON: s:= 'HTMAXBUTTON';

HTLEFT: s:= 'HTLEFT';

HTRIGHT: s:= 'HTRIGHT';

HTTOP: s := 'HTTOP';

HTTOPLEFT: s:= 'HTTOPLEFT';

HTTOPRIGHT: s:= 'HTTOPRIGHT';

HTBOTTOM: s:= 'HTBOTTOM';

HTBOTTOMLEFT: s:= 'HTBOTTOMLEFT';

HTBOTTOMRIGHT: s:= 'HTBOTTOMRIGHT';

HTBORDER: s:= 'HTBORDER';

HTOBJECT: s:= 'HTOBJECT';

HTCLOSE: s:= 'HTCLOSE';

HTHELP: s:= 'HTHELP';

else s:= '';

end;

Form1.Caption := s;

Message.Result := 0;

end;

end.

Вопрос:

При попытке использовать метод TCanvas.StretchDraw чтобы нарисовать иконку увеличенной ее размер не изменяется. Что делать?

Ответ:

Иконки всегда рисуются размером принятым в системе по умолчанию. Чтобы показать увеличенный вид иконки скопируйте ее на bitmap, а зате используйте метод TCanvas.StretchDraw.

Пример:

procedure TForm1.Button1Click(Sender: TObject);

var TheBitmap : TBitmap;

begin

TheBitmap := TBitmap.Create;

TheBitmap.Width := Application.Icon.Width;

TheBitmap.Height := Application.Icon.Height;

TheBitmap.Canvas.Draw(0, 0, Application.Icon);

Form1.Canvas.StretchDraw(Rect(0,0,TheBitmap.Width * 3,TheBitmap.Height * 3), TheBitmap);

TheBitmap.Free;

end;

Вопрос:

Можно ли сделать так чтобы TStringGrid автоматически изменял ширину колонок, чтобы вместить самую длинную строчку в колонке?

Ответ: См. пример.

Пример:

procedure AutoSizeGridColumn(Grid : TStringGrid; column : integer);

var

i : integer;

temp : integer;

max : integer;

begin

max := 0;

for i := 0 to (Grid.RowCount - 1) do begin

temp := Grid.Canvas.TextWidth(grid.cells[column, i]);

if temp > max then max := temp;

end;

Grid.ColWidths[column] := Max + Grid.GridLineWidth + 3;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

AutoSizeGridColumn(StringGrid1, 1);

end;

Вопрос:

TTimer работает не достаточно точно. Как получить более высокую точность?

Ответ:

Таймер Windows не был создан с целью получения сверхточного хронометра. :-( Другими словами, когда Вы устанавливаете таймер на срабатывания каждые 1000 миллисекунд, он может срабатывать через интервал несколько больший чем 1000 миллисекунд. Значения меньше 55 миллисекунд никогда не будут срабатывать вовремя в Windows, поскольку это минимальная точность таймера. Можно проверять системное время и сравнивать его со временем предыдущего события таймера чтобы повысить точность.

Вопрос:

Как поместить JPEG-картинку в exe-файл и потом загрузить ее?

Ответ:

1) Создайте текстовый файл с расширением ".rc". Имя этого файла должно отличаться от имени файла-проекта или любого модуля проекта.

Файл должен содержать строку вроде: MYJPEG JPEG C:\DownLoad\MY.JPG

где:

• "MYJPEG" — имя ресурса

• "JPEG" — пользовательский тип ресурса

• "C:\DownLoad\MY.JPG" — путь к JPEG файлу.

Пусть например rc-файл называется "foo.rc"

Запустите BRCC32.exe (Borland Resource CommandLine Compiler) — программа находится в каталоге Bin Delphi/C++ Builder'а — передав ей в качестве параметра полный путь к rc-файлу. В нашем примере:

C:\DelphiPath\BIN\BRCC32.EXE C:\ProjectPath\FOO.RC

Вы получите откомпилированный ресурс — файл с расширением ".res". (в нашем случае — foo.res). Далее добавьте ресурс к своему приложению.

{Грузим ресурс}

{$R FOO.RES}

uses Jpeg;

procedure LoadJPEGFromRes(TheJPEG : string; ThePicture : TPicture);