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

Пример:

type TForm1 = class(TForm)

procedure FormCreate(Sender: TObject);

private

{Private declarations}

public

procedure MyShowHint(var HintStr: string; var CanShow: Boolean;var HintInfo: THintInfo);

{Public declarations}

end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.MyShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);

var i : integer;

begin

for i := 0 to Application.ComponentCount - 1 do if Application.Components[i] is THintWindow then with THintWindow(Application.Components[i]).Canvas do begin

Font.Name:= 'Arial';

Font.Size:= 18;

Font.Style:= [fsBold];

HintInfo.HintColor:= clWhite;

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

Application.OnShowHint := MyShowHint;

end;

Вопрос:

Есть ли в Delphi эквивалент функции SendKeys Visual Basic'а?

Ответ:

Ниже приведена процедура, позволяющаю отправлять нажатия в любой элемент управления (window control), способный принимать ввод с клавиатуры. Вы можете использовать эту технику чтобы включать клавиши NumLock, CapsLock и ScrollLock под Windows NT. Та же техника работает и под Windows 95 для CapsLock и ScrollLock но не работает для клавиши NumLock.

Обратите внимание, что приведены четыре процедуры: SimulateKeyDown() — эмулировать нажатие клавиши (без отпускания), SimulateKeyUp() — эмулировать отпускание клавиши, SimulateKeystroke() — эмулировать удар по клавише (нажатие и отпускание) и SendKeys(), позволяющие Вам гибко контролировать посылаемые сообщения клавиатуры.

SimulateKeyDown(), SimulateKeyUp() и SimulateKeystroke() получают коды виртуальных клавиш (virtural key) (вроде VK_F1). Процедура SimulateKeystroke() получает дополнительный параметр, полезный при эмуляции нажатия PrintScreen. Когда этот параметр равен нулю весь экран будет скопирован в буфер обмена (clipboard). Если дополнительный параметр равен 1 будет скопированно только активное окно.

Четыре метода "button click" демонстрируют использование: ButtonClick1 — включает capslock, ButtonClick2 — перехватывает весь экран в буфер обмена (clipboard), ButtonClick3 — перехватывает активное окно в буфер обмена (clipboard). ButtonClick4 — устанавливает фокус в Edit и отправляет в него строку.

Пример:

procedure SimulateKeyDown(Key : byte);

begin

keybd_event(Key, 0, 0, 0);

end;

procedure SimulateKeyUp(Key : byte);

begin

keybd_event(Key, 0, KEYEVENTF_KEYUP, 0);

end;

procedure SimulateKeystroke(Key : byte; extra : DWORD);

begin

keybd_event(Key,extra,0,0);

keybd_event(Key,extra,KEYEVENTF_KEYUP,0);

end;

procedure SendKeys(s : string);

var

i : integer;

flag : bool;

w : word;

begin

{Get the state of the caps lock key}

flag := not GetKeyState(VK_CAPITAL) and 1 = 0;

{If the caps lock key is on then turn it off}

if flag then SimulateKeystroke(VK_CAPITAL, 0);

for i := 1 to Length(s) do begin

w := VkKeyScan(s[i]);

{If there is not an error in the key translation}

if ((HiByte(w) <> $FF) and (LoByte(w) <> $FF)) then begin

{If the key requires the shift key down - hold it down}

if HiByte(w) and 1 = 1 then SimulateKeyDown(VK_SHIFT);

{Send the VK_KEY}

SimulateKeystroke(LoByte(w), 0);

{If the key required the shift key down - release it}

if HiByte(w) and 1 = 1 then SimulateKeyUp(VK_SHIFT);

end;

end;

{if the caps lock key was on at start, turn it back on}

if flag then SimulateKeystroke(VK_CAPITAL, 0);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

{Toggle the cap lock}

SimulateKeystroke(VK_CAPITAL, 0);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

{Capture the entire screen to the clipboard}

{by simulating pressing the PrintScreen key}

SimulateKeystroke(VK_SNAPSHOT, 0);

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

{Capture the active window to the clipboard}

{by simulating pressing the PrintScreen key}

SimulateKeystroke(VK_SNAPSHOT, 1);

end;

procedure TForm1.Button4Click(Sender: TObject);

begin

{Set the focus to a window (edit control) and send it a string}

Application.ProcessMessages;

Edit1.SetFocus;

SendKeys('Delphi Is RAD!');

end;

Вопрос:

Я загружаю TImageList динамически. Как сделать картинки из TImageList прозрачными?

Ответ:

См. ответ.

Пример:

procedure TForm1.Button1Click(Sender: TObject);

var

bm : TBitmap;

il : TImageList;

begin

bm := TBitmap.Create;

bm.LoadFromFile('C:\DownLoad\TEST.BMP');

il := TImageList.CreateSize(bm.Width,bm.Height);

il.DrawingStyle := dsTransparent;

il.Masked := true;

il.AddMasked(bm, clRed);

il.Draw(Form1.Canvas, 0, 0, 0);

bm.Free;

il.Free;

end;

Вопрос:

Как заставить TMediaPlayer проигрывать одно и тоже бесконечно? AVI например?

Ответ:

В примере AVI файл проигрывается снова и снова — используем событие MediaPlayer'а Notify

Пример:

procedure TForm1.MediaPlayer1Notify(Sender: TObject);

begin

with MediaPlayer1 do if NotifyValue = nvSuccessful then begin

Notify := True;

Play;

end;

end;

Вопрос:

При выполнении диалога FontDialog со свойством Device равным fdBoth or fdPrinter, появляется ошибка "There are no fonts installed".

Ответ:

Эти установки должны показать шрифты совместимые либо с принтером либо с экраном. В примере диалог Windows ChooseFont вызывается напрямую чтобы показать список шрифтов, совместимых одновременно и с экраном и с принтером.

Пример:

uses Printers, CommDlg;

procedure TForm1.Button1Click(Sender: TObject);

var

cf : TChooseFont;

lf : TLogFont;

tf : TFont;

begin

if PrintDialog1.Execute then begin

GetObject(Form1.Canvas.Font.Handle, sizeof(lf),@lf);

FillChar(cf, sizeof(cf), #0);

cf.lStructSize := sizeof(cf);

cf.hWndOwner := Form1.Handle;

cf.hdc := Printer.Handle;

cf.lpLogFont := @lf;

cf.iPointSize := Form1.Canvas.Font.Size * 10;

cf.Flags := CF_BOTH or CF_INITTOLOGFONTSTRUCT or CF_EFFECTS or CF_SCALABLEONLY or CF_WYSIWYG;

cf.rgbColors := Form1.Canvas.Font.Color;

if ChooseFont(cf) <> false then begin

tf := TFont.Create;

tf.Handle := CreateFontIndirect(lf);

tf.COlor := cf.RgbColors;

Form1.Canvas.Font.Assign(tf);

tf.Free;

Form1.Canvas.TextOut(10, 10, 'Test');

end;

end;

end;

Вопрос:

Как сменить дисковод, откуда MediaPlayer проигрывает аудио CD?

Ответ:

См. пример.

Пример:

MediaPlayer1.FileName := 'E:';

Вопрос:

Как убрать кнопку с названием моей программы из Панели Задач(Taskbar)?

Ответ:

Отредактируйте файл-проекта (View→Project Source). Добавьте модуль Windows в раздел uses. Application.ShowMainForm := False; в строку после "Application.Initialize;". Добавьте ShowWindow(Application.Handle, SW_HIDE); в строку перед "Application.Run;"

Ваш файл проекта должен выглядеть приблизительно так:

program Project1;

uses Windows, Forms, Unit1 in 'Unit1.pas' {Form1}, Unit2 in 'Unit2.pas' {Form2};

{$R *.RES}

begin

Application.Initialize;

Application.ShowMainForm := False;

Application.CreateForm(TForm1, Form1);

Application.CreateForm(TForm2, Form2);

ShowWindow(Application.Handle, SW_HIDE);

Application.Run;

end.

В разделе "initialization" (в самом низу) каждого unit'а добавьте

begin

ShowWindow(Application.Handle, SW_HIDE);

end.

Вопрос:

Как преобразовать цвета в строку — название цвета VCL?

Ответ:

Модуль graphics.pas содержит функцию ColorToString() которое преобразует допустимое значение TColor в его строковое представление используя либо константу — название цвета (по возможности) либо шестнадцатиричную строку. Обратная функция — StringToColor()