500+ FAQ по Delphi

Перейти на: Главную | Индексную | Предыдущую | Следующую страницу
покер учиться

Как опеделить состояние списка ComboBox, выпал/скрыт?

Пошлите ComboBox сообщение CB_GETDROPPEDSTATE.

Пример:

if SendMessage(ComboBox1.Handle, CB_GETDROPPEDSTATE,0,0) = 1 then
begin {список ComboBox выпал}

end;

Как удалить каталог вместе со всеми содержащимися в нем файлами?

В примере стираются все файлы в каталоге и сам каталог. Чтобы удалить файл, помечанные только для чтения (read only) и занятые другими программами в момент удаления - напишите дополнительную процедуру.
procedure TForm1.Button1Click(Sender: TObject);
var
DirInfo: TSearchRec;
r: integer;
begin
r := FindFirst('C:\Download\*.*', FaAnyfile, DirInfo);
while r = 0 do
begin
if ((DirInfo.Attr and FaDirectory <> FaDirectory) and
(DirInfo.Attr and FaVolumeId <> FaVolumeID)) then
if DeleteFile(pChar('C:\Download\' + DirInfo.Name))= false then
ShowMessage('Unable to delete: C:\Download\'+DirInfo.Name);
r := FindNext(DirInfo);
end;
SysUtils.FindClose(DirInfo);
if RemoveDirectory('C:\Download\') = false then
ShowMessage('Unable to delete directory: C:\Download\');
end;

Как отключить системное меню формы и кнопки Minimize, Maximize, and Close во время выполнения(Runtime)?

В приведенном примере показано как это сделать

Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
{Disable}
Form1.BorderIcons := Form1.BorderIcons - [biSystemMenu, biMinimize, biMaximize];
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);
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
if ((Row <> r) or(Col <> c)) then
begin
Row := r;
Col := c;
Application.CancelHint;
StringGrid1.Hint :=IntToStr(r)+#32+IntToStr(c);
end;
end;
end;

Как внести изменения в код VCL?

Примечание: внесение изменений в VCL не поддерживается Borland или Borland Developer Support.
-Но если Вы решили сделать это...
Изменеия в код VCL никогда не должны вносится в секцию "interface" модуля - только в секцию "implimentation". Наиболее безопасный способ внести изменения в VCL - создать новый каталог названный "исправленный VCL". Скопируйте файл VCL который Вы хотите изменить в этот каталог. Внесите изменения (лучше прокомментировать их) в этот файл. Затем добавьте путь к Вашему каталогу "исправленный VCL" в самое начало "library path". Перезапустите Delphi/C++ Builder и перекомпилируйте Ваш проект. "library path" можно изменить в меню:
Delphi 1 : Options | Environment | Library
Delphi 2 : Tools | Options | Library
Delphi 3 : Tools | Environment Options | Library
Delphi 4 : Tools | Environment Options | Library
C++ Builder : Options | Environment | Library

Как в Delphi реализовать функцию - эквивалент TwipsPerPixel из VisualBasic?

Функции TwipsPerPixelX и TwipsPerPixelY, приведенные в примере реализуют ту же
функциональность в Delphi.
Пример:
function TwipsPerPixelX(Canvas : TCanvas) : Extended;
begin
result := 1440 / GetDeviceCaps(Canvas.Handle, LOGPIXELSX);
end;

function TwipsPerPixelY(Canvas : TCanvas) : Extended;
begin
result := 1440 / GetDeviceCaps(Canvas.Handle, LOGPIXELSY);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(FloatToStr(TwipsPerPixelX(Form1.Canvas)));
ShowMessage(FloatToStr(TwipsPerPixelY(Form1.Canvas)));
end;

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

Считайте файл в TMemoryStream, затем ипользуйте метод TMemo SetSelTextBuf() для вставки текста;
var
TheMStream : TMemoryStream;
Zero : char;
begin
TheMStream := TMemoryStream.Create;
TheMStream.LoadFromFile('C:\AUTOEXEC.BAT');
TheMStream.Seek(0, soFromEnd);
//Null terminate the buffer!
Zero := #0;
TheMStream.Write(Zero, 1);
TheMStream.Seek(0, soFromBeginning);
Memo1.SetSelTextBuf(TheMStream.Memory);
TheMStream.Free;
end;


Материалы находятся на сайте http://cracklab.narod.ru/faq/


Создатель этого HTML файла не претендует на авторство вопросов/ответов представленных в нём, не отвечает за их содержание и достоверность, а также за последствия использования программных кодов , полученных из этого HTML файла. Также не принимаются претензии относительно не размещённой информации об авторе каждого конкретного FAQ'а. Любые другие вопросы присылайте на bad_guy@cracklab.ru (обращаться к Bad_guy'ю).
Hosted by uCoz