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

begin

Memo1.WantTabs := true;

DialogUnitsX := LoWord(GetDialogBaseUnits);

PixelsX := 20;

for i := 1 to 5 do begin

TabArray[i - 1] :=((PixelsX * i ) * 4) div DialogUnitsX;

end;

SendMessage(Memo1.Handle, EM_SETTABSTOPS,5,LongInt(@TabArray));

Memo1.Refresh;

end;

Вопрос:

Как перехватить нажатия функциональных клавиш и стрелок?

Ответ:

Проверяйте значение переменной key на равенство VK_RIGHT, VK_LEFT, VK_F1 и т.д. на событии KeyDown формы.

Пример:

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

if Key = VK_RIGHT then Form1.Caption := 'Right';

if Key = VK_F1 then Form1.Caption := 'F1';

end;

Вопрос:

При обработке события DrawCell компонента DrawGrid я пишу Font.Color := clRed; и получаю бесконечный цикл мерцаний. Почему?

Ответ:

Правильно укажите границы используемого канваса.

Пример:

If (Row = 0) then begin

DrawGrid1.Canvas.Font.Color := clRed;

DrawGrid1.Canvas.TextOut(Rect.Left,Rect.Top, IntToStr(Col));

end;

Вопрос:

При использовании BitBtn Caption(текст) и картинка(bitmap) из файла не видны одновременно. Почему?

Ответ:

Это может происходить если картинка слишком велика. Класс TBitBtn сначала рисует картинку, а затем выводит текст над, под, слева или справа от картинки (в завивимости от свойства Layout). Если размер картинки такой же как у всей кнопки для вывода текста просто не остается места. Если Вам нужно получить кнопку такого же размера как Ваша картинка и видеть при этом надпись на кнопке Вам придется выводить текст надписи непосредственно на канву картинки.

Пример:

var

bm : TBitmap;

OldBkMode : integer;

begin

bm := TBitmap.Create;

bm.Width := BitBtn1.Glyph.Width;

bm.Height := BitBtn1.Glyph.Height;

bm.Canvas.Draw(0, 0, BitBtn1.Glyph);

OldBkMode := SetBkMode(bm.Canvas.Handle, Transparent);

bm.Canvas.TextOut(0, 0, 'The Caption');

SetBkMode(bm.Canvas.Handle, OldBkMode);

BitBtn1.Glyph.Assign(bm);

end;

Вопрос:

Можно ли изменить вид текстового курсора (каретки) edit'а или другого элемента управления Windows?

Ответ:

Можно! В примере показано как создать два цветных "bitmap'а": "улыбчивый" и "хмурый" и присвоить их курсору edit'а. Для этого нужно перехватить оконную процедуру edit'а. Чтобы сделать это заменим адрес оконной процедуры Edit'а нашим собственным, а старую оконную процедуру будем вызывать по необходимости. Пример показывает "улыбчивый" курсор при наборе текста и "хмурый" при забое клавишей backspace.

Пример:

unit caret1;

interface

{$IFDEF WIN32}

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

{$ELSE}

uses WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

{$ENDIF}

type TForm1 = class(TForm)

Edit1: TEdit;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

{Private declarations}

public

{Public declarations}

CaretBm : TBitmap;

CaretBmBk : TBitmap;

OldEditsWindowProc : Pointer;

end;

var Form1: TForm1;

implementation

{$R *.DFM}

type

{$IFDEF WIN32}

WParameter = LongInt;

{$ELSE}

WParameter = Word;

{$ENDIF}

LParameter = LongInt;

{New windows procedure for the edit control}

function NewWindowProc(WindowHandle : hWnd; TheMessage : WParameter; ParamW : WParameter; ParamL : LParameter) : LongInt

{$IFDEF WIN32} stdcall; {$ELSE} ; export; {$ENDIF}

begin

{Call the old edit controls windows procedure}

NewWindowProc := CallWindowProc(Form1.OldEditsWindowProc, WindowHandle, TheMessage, ParamW, ParamL);

if TheMessage = WM_SETFOCUS then begin

CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0);

ShowCaret(WindowHandle);

end;

if TheMessage = WM_KILLFOCUS then begin

HideCaret(WindowHandle);

DestroyCaret;

end;

if TheMessage = WM_KEYDOWN then begin

if ParamW = VK_BACK then CreateCaret(WindowHandle, Form1.CaretBmBk.Handle, 0, 0)

else CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0);

ShowCaret(WindowHandle);

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

{Create a smiling bitmap using the wingdings font}

CaretBm := TBitmap.Create;

CaretBm.Canvas.Font.Name := 'WingDings';

CaretBm.Canvas.Font.Height := Edit1.Font.Height;

CaretBm.Canvas.Font.Color := clWhite;

CaretBm.Width := CaretBm.Canvas.TextWidth('J') + 2;

CaretBm.Height := CaretBm.Canvas.TextHeight('J') + 2;

CaretBm.Canvas.Brush.Color := clBlue;

CaretBm.Canvas.FillRect(Rect(0, 0, CaretBm.Width, CaretBm.Height));

CaretBm.Canvas.TextOut(1, 1, 'J');

{Create a frowming bitmap using the wingdings font}

CaretBmBk := TBitmap.Create;

CaretBmBk.Canvas.Font.Name := 'WingDings';

CaretBmBk.Canvas.Font.Height := Edit1.Font.Height;

CaretBmBk.Canvas.Font.Color := clWhite;

CaretBmBk.Width := CaretBmBk.Canvas.TextWidth('L') + 2;

CaretBmBk.Height := CaretBmBk.Canvas.TextHeight('L') + 2;

CaretBmBk.Canvas.Brush.Color := clBlue;

CaretBmBk.Canvas.FillRect(Rect(0,0, CaretBmBk.Width, CaretBmBk.Height));

CaretBmBk.Canvas.TextOut(1, 1, 'L');

{Hook the edit controls window procedure}

OldEditsWindowProc := Pointer(SetWindowLong(Edit1.Handle,GWL_WNDPROC, LongInt(@NewWindowProc)));

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

{Unhook the edit controls window procedure and clean up}

SetWindowLong(Edit1.Handle,GWL_WNDPROC, LongInt(OldEditsWindowProc));

CaretBm.Free;

CaretBmBk.Free;

end;

Вопрос:

При использовании модулей доступа к BDE (DbiTypes, DbiProcs, DbiErrs), любая попытка вызвать процедуру abort выдает ошибку при компиляции при вызове метода abort "Statement expected, but expression of type 'Integer' found". Я пытался найти DbiTypes.pas, DbiProcs.pas и DbiErrs.pas чтобы разобраться но не нашел этих файлов. Где расположены эти файлы и как обойти ошибку?

Ответ:

Модули DbiTypes, DbiProcs, DbiErrs это псевдонимы модуля "BDE", обьявлены в Projects→Options→Directories/Conditionals→Unit Aliases. Исходник модуля DBE находится в каталоге "doc" и называется "BDE.INT". В этом файле обьявленна константа ABORT со значением -2. Так как Вы хотите использовать процедуру Abort(), которая обьявлена в модуле SysUtils, Вам нужно добавить префикс SysUtils перед вызовом процедуры Abort.

Пример:

SysUtils.Abort;

Вопрос:

Почему при изменении цвета букв StatusBar'а ничего не происходит?

Ответ:

Status bar — стандартный элемент управления Windows, и соответственно цвет его букв — значение clBtnText которое изменяется с помощью настроек в Control Panel. Этот цвет черный по умолчанию и может изменяться в зависимости от выбранной цветовой схемы. Другие стандартные элемент управления Windows, например кнопки, также имеют цвет букв, настраиваемый из ControlPanel. StatusBar и его панели имеют свойство "owner-draw", позволяющее Вам использовать любой цвет букв.

Пример:

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;

Вопрос:

Как сделать многострочную надпись на TBitBtn?

Ответ:

Выводите текст надписи непосредственно на "glyph" TBitBtn'а. См. пример.

Пример:

procedure TForm1.FormCreate(Sender: TObject);

var

R : TRect;

N : Integer;

Buff : array[0..255] of Char;

begin

with BitBtn1 do begin

Caption := 'A really really long caption';

Glyph.Canvas.Font := Self.Font;

Glyph.Width := Width - 6;