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

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

{Enable}

Form1.BorderIcons := Form1.BorderIcons + [biSystemMenu, biMinimize, biMaximize];

end;

Вопрос:

Как извлечь Red, Green, и Blue компонент из определенного цвета?

Ответ:

Используйте функции Window API Get RValue(), GetGValue(), и GetBValue().

Пример:

procedure TForm1.Button1Click(Sender: TObject);

begin

Form1.Canvas.Pen.Color := clRed;

Memo1.Lines.Add('Red := ' + IntToStr(GetRValue(Form1.Canvas.Pen.Color)));

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.

Примечание: 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);