Виртуальная библиотека Delphi - [79]

 Memo1.Lines.Add('Red := ' + IntToStr(GetGValue(Form1.Canvas.Pen.Color)));
 Memo1.Lines.Add('Blue:= ' + IntToStr(GetBValue(Form1.Canvas.Pen.Color)));
end;

Вопрос:

Как определить номер текущей строки в TMemo?

Ответ:

Чтобы определить номер текущей строки любого объекта управления edit — пошлите ей сообщение EM_LINEFROMCHAR

Пример:

procedure TForm1.Button1Click(Sender: TObject);
var LineNumber : integer;
begin
 LineNumber := SendMessage(Memo1.Handle, EM_LINEFROMCHAR, word(-1), 0);
 ShowMessage(IntToStr(LineNumber));
end;

Вопрос:

Как проигрывать MPEG файл в Delphi-программе?

Ответ:

Если в системе Windows MMSystem установлен декодер MPEG — используя компонент TMediaPlayer

Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
 MediaPlayer1.Filename := 'C:\DownLoad\rsgrow.mpg';
 MediaPlayer1.Open;
 MediaPlayer1.Display := Panel1;
 MediaPlayer1.DisplayRect := Panel1.ClientRect;
 MediaPlayer1.Play;
end;

Вопрос:

Как использовать анимированный курсор?

Ответ:

Во первых необходимо получить handle курсора, а затем определить его в массиве курсоров компонента TScreen. Индексы предопределенных курсоров системы отрицательны, пользователь может определить курсор, индекс которого положителен.

Пример:

procedure TForm1.Button1Click(Sender: TObject);
var h : THandle;
begin
 h := LoadImage(0, 'C:\TheWall\Magic.ani', IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE or LR_LOADFROMFILE);
 if h = 0 then ShowMessage('Cursor not loaded')
 else begin
  Screen.Cursors[1] := h;
  Form1.Cursor := 1;
 end;
end;

Вопрос:

Как узнать о нажатии "non-menu" клавиши в момент когда меню показано?

Ответ:

Создайте обработчик сообщения WM_MENUCHAR.

Пример:

unit Unit1;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus;

type TForm1 = class(TForm)
 MainMenu1: TMainMenu;
 One1: TMenuItem;
 Two1: TMenuItem;
 THree1: TMenuItem;
private
 {Private declarations}
 procedure WmMenuChar(var m : TMessage); message WM_MENUCHAR;
public
 {Public declarations}
end;
var Form1: TForm1;

implementation
{$R *.DFM}

procedure TForm1.WmMenuChar(var m : TMessage);
begin
 Form1.Caption := 'Non standard menu key pressed';
 m.Result := 1;
end;

end.

Вопрос:

Как определить наличие сопроцессора?

Ответ:

В отличие от общепринятого мнения не всее клоны 486/586/686/ и Pentium имеют сопроцессор для вычислений с плавающей запятой. В примере определяется наличие сопроцессора и под Win16 и под Win32.

Пример:

{$IFDEF WIN32}
uses Registry;
{$ENDIF}

function HasCoProcesser : bool;
{$IFDEF WIN32}
var TheKey : hKey;
{$ENDIF}
begin
 Result := true;
{$IFNDEF WIN32}
 if GetWinFlags and Wf_80x87 = 0 then Result := false;
{$ELSE}
 if RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'HARDWARE\DESCRIPTION\System\FloatingPointProcessor',0, KEY_EXECUTE, TheKey) <> ERROR_SUCCESS then result := false;
 RegCloseKey(TheKey);
{$ENDIF}
end;

procedure TForm1.Button1Click(Sender: TObject);
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.