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

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;