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

begin

 if HasCoProcesser then ShowMessage('Has CoProcessor')

 else ShowMessage('No CoProcessor - Windows Emulation Mode');

end;

Вопрос:

Как узнать серийный номер аудио CD?

Ответ:

CD может иметь или не иметь серийный номер и/или универсальный код продукта (Universal Product Code). MCI-расширение Windows предоставляет эту информации с помощью комманды MCI_INFO_MEDIA_IDENTITY command. Эта команда возвращает уникальную ID-строку.

Пример:

uses MMSystem, MPlayer;

procedure TForm1.Button1Click(Sender: TObject);

var

 mp : TMediaPlayer;

 msp : TMCI_INFO_PARMS;

 MediaString : array[0..255] of char;

 ret : longint;

begin

 mp := TMediaPlayer.Create(nil);

 mp.Visible := false;

 mp.Parent := Application.MainForm;

 mp.Shareable := true;

 mp.DeviceType := dtCDAudio;

 mp.FileName := 'D:';

 mp.Open;

 Application.ProcessMessages;

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

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

 msp.lpstrReturn := @MediaString;

 msp.dwRetSize := 255;

 ret := mciSendCommand(Mp.DeviceId, MCI_INFO, MCI_INFO_MEDIA_IDENTITY, longint(@msp));

 if Ret <> 0 then begin

  MciGetErrorString(ret, @MediaString, sizeof(MediaString));

  Memo1.Lines.Add(StrPas(MediaString));

 end else Memo1.Lines.Add(StrPas(MediaString));

 mp.Close;

 Application.ProcessMessages;

 mp.free;

end;

end.

Вопрос:

Как вывести на элемент управления (Window control) текст, содержащий амперсанд — &?

Ответ:

Используя два амперсанда подряд. Windows интерпритирует одиночный амперсанд как указание на то, что следующий символ — горячая клавиша (и поддчеркивает следующий символ вместо изображения аперсанда).

Пример:

Button1.Caption := 'Черное && Белое';

Вопрос:

Как поместить bitmap в Metafile?

Ответ:

см. пример

Пример:

procedure TForm1.Button1Click(Sender: TObject);

var

 m : TmetaFile;

 mc : TmetaFileCanvas;

 b : tbitmap;

begin

 m := TMetaFile.Create;

 b := TBitmap.create;

 b.LoadFromFile('C:\SomePath\SomeBitmap.BMP');

 m.Height := b.Height;

 m.Width := b.Width;

 mc := TMetafileCanvas.Create(m, 0);

 mc.Draw(0, 0, b);

 mc.Free;

 b.Free;

 m.SaveToFile('C:\SomePath\Test.emf');

 m.Free;

 Image1.Picture.LoadFromFile('C:\SomePath\Test.emf');

end;

Вопрос:

Как узнать, что курсор мыши над моей формой?

Ответ:

Можно использовать функцию GetCapture() из Windows API.

Примечание: Cм. документацию Windows для информации об ограничениях функции GetCapture.

Пример:

procedure TForm1.FormDeactivate(Sender: TObject);

begin

 ReleaseCapture;

end;

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

begin

 If GetCapture = 0 then SetCapture(Form1.Handle);

 if PtInRect(Rect(Form1.Left,Form1.Top,Form1.Left + Form1.Width, Form1.Top + Form1.Height), ClientToScreen(Point(x, y))) then Form1.Caption := 'Мышка над формой!'

 else Form1.Caption := 'Мышка вне формы...';

end;

Вопрос:

Как программно определить, что приложение работает под Windows NT?

Ответ:

см. пример

Пример:

function IsNT : bool;

var osv : TOSVERSIONINFO;

begin

 result := true;

 GetVersionEx(osv);

 if osv.dwPlatformId = VER_PLATFORM_WIN32_NT then exit;

 result := false;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 if IsNt then ShowMessage('Running on NT')

 else ShowMessage('Not Running on NT');

end;

Вопрос:

Как создать bitmap из пиктогрммы (icon)?

Ответ:

Используя Bitmap.Canvas.Draw нарисуйте пиктограмму на Bitmap'е.

Пример:

procedure TForm1.Button1Click(Sender: TObject);

var

 TheIcon : TIcon;

 TheBitmap : TBitmap;

begin

 TheIcon := TIcon.Create;

 TheIcon.LoadFromFile('C:\Program Files\Borland\IcoCur32\EARTH.ICO');

 TheBitmap := TBitmap.Create;

 TheBitmap.Height := TheIcon.Height;

 TheBitmap.Width := TheIcon.Width;

 TheBitmap.Canvas.Draw(0, 0, TheIcon);

 Form1.Canvas.Draw(10, 10, TheBitmap);

 TheBitmap.Free; TheIcon.Free;

end;

Вопрос:

Как создать отдельную подсказку (hint) для каждой ячейки StringGrid?

Ответ:

В приведенном примере отслеживается движение курсора мыши — при перемещении между ячейками StringGrid'а — появляется окно подсказки (hint), показывающее номер текущей строки и колонки.

Пример:

type TForm1 = class(TForm)

 StringGrid1: TStringGrid;

 procedure StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

 procedure FormCreate(Sender: TObject);

private

 {Private declarations}

 Col : integer;

 Row : integer;

public

 {Public declarations}

end;

var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

 StringGrid1.Hint := '0 0';

 StringGrid1.ShowHint := True;

end;

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

var

 r : integer;

 c : integer;

begin

 StringGrid1.MouseToCell(X, Y, C, R);

 with StringGrid1 do begin