Компьютерная документация от А до Я

Поиск по сайту

TOP-10 программ

Symantec Norton Ghost 9.0
Partition Magic 8.0.2 Pro
Xilisoft 3GP Video Converter v3.1.7.0616b
Norton AntiVirus 2005
Xilisoft 3GP Video Converter v2.1.52.831b
Антивирус Касперского Personal 5.0.303 beta 2
RAR Password Cracker 4.12
ABBYY PDF Transformer v1.00.820
Windows Movie Maker 2.6
MP3 To Ringtone Gold v3.02

Наши сервисы

Рассылка новостей. Подпишитесь на рассылку сейчас и вы всегда будете в курсе последних событий в мире информационных технологий.

Новостные информеры. Поставьте наши информеры к себе и у вас на сайте появится дополнительный постоянно обновляемый раздел.

Поставить

Добавление статей. Если вы являетесь автором статьи или обзора на тему ИТ присылайте материал нам, мы с удовольствием опубликуем его у себя на сайте.

Прислать

Программирование -> Delphi / Pascal -> FAQ по Delphi

Delphi FAQ - 2


Вопрос:

Как разместить прозрачную надпись на TBitmap?

Пример:

procedure TForm1.Button1Click(Sender: TObject);
var
        OldBkMode : integer;
begin
        Image1.Picture.Bitmap.Canvas.Font.Color := clBlue;
        OldBkMode := SetBkMode(Image1.Picture.Bitmap.Canvas.Handle,TRANSPARENT);
        Image1.Picture.Bitmap.Canvas.TextOut(10, 10, 'Hello');
        SetBkMode(Image1.Picture.Bitmap.Canvas.Handle,OldBkMode);
end;


Наверх к содержанию




Вопрос:

Можно ли обратиться к колонке или строке grid'а по заголовку?

Ответ:

В следующем примере приведены две функции: GetGridColumnByName() и GetGridRowByName(), которые возвращают колонку или строку, имеющую заданный заголовок (caption).

Пример:

procedure TForm1.FormCreate(Sender: TObject);
begin
        StringGrid1.Rows[1].Strings[0] := 'This Row';
        StringGrid1.Cols[1].Strings[0] := 'This Column';
end;

function GetGridColumnByName(Grid : TStringGrid; ColName : string): integer;
var
        i : integer;
begin
        for i := 0 to Grid.ColCount - 1 do
                if Grid.Rows[0].Strings[i] = ColName then 
                        begin
                Result := i;
                                exit;
                        end;
        Result := -1;
end;

function GetGridRowByName(Grid : TStringGrid; RowName : string): integer;
var
        i : integer;
begin
        for i := 0 to Grid.RowCount - 1 do
                if Grid.Cols[0].Strings[i] = RowName then
                        begin
                                Result := i;
                                exit;
                        end;
        Result := -1;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
        Column : integer;
        Row : integer;
begin
        Column := GetGridColumnByName(StringGrid1, 'This Column');
        if Column = -1 then
                ShowMessage('Column not found')
        else
                ShowMessage('Column found at ' + IntToStr(Column));
        Row := GetGridRowByName(StringGrid1, 'This Row');
        if Row = -1 then
                ShowMessage('Row not found')
        else
                ShowMessage('Row found at ' + IntToStr(Row));
end;


Наверх к содержанию




Вопрос:

Как использовать клавишу-акселератор в TTabsheets? Я добавляю клавишу-акселератор в заголовок каждого Tabsheet моего PageControl, но при попытке переключать страницы этой клавишей программа пикает и ничего не происходит.

Ответ:
Можно перехватить сообщение CM_DIALOGCHAR.

Пример:
type
        TForm1 = class(TForm)
                PageControl1: TPageControl;
                TabSheet1: TTabSheet;
                TabSheet2: TTabSheet;
                TabSheet3: TTabSheet;
        private
                {Private declarations}
                procedure CMDialogChar(var Msg:TCMDialogChar);
                message CM_DIALOGCHAR;
        public
                {Public declarations}
end;

var
        Form1: TForm1;

implementation
{$R *.DFM}
procedure TForm1.CMDialogChar(var Msg:TCMDialogChar);
var
        i : integer;
begin
        with PageControl1 do
        begin
                if Enabled then
                        for i := 0 to PageControl1.PageCount - 1 do
                                if ((IsAccel(Msg.CharCode, Pages[i].Caption)) and
                                        (Pages[i].TabVisible)) then 
                                begin
                                        Msg.Result:=1;
                                        ActivePage := Pages[i];
                                        exit;
                                end;
        end;
        inherited;
end;


Наверх к содержанию




Вопрос:

При использованиии компонента TRegistry под NT пользователь с права доступа ниже чем "администратор" не может получить доступа к информации реестра в ключе HKEY_LOCAL_MACHINE. Как это обойти?

Ответ:

Проблема вызвана тем, что TRegistry всегда открывает реестр с параметром KEY_ALL_ACCESS (полный доступ), даже если необходим доступ KEY_READ (только чтение). Избежать этого можно используя функции API для работы с реестром (RegOpenKey и т.п.), или создать новый класс из компонента TRegestry, и изменить его так чтобы можно было задавать режим открытия реестра.

Наверх к содержанию




Вопрос:
Можно ли изменить число колонок и их ширину в компоненте TFileListBox?

Ответ:

В приведенном примере FileListBox приводится к типу TDirectoryListBox - таким образом можно добавиь дополнительные колонки.

Пример:
with TDirectoryListBox(FileListBox1) do 
begin
        Columns := 2;
        SendMessage(Handle, LB_SETCOLUMNWIDTH, Canvas.TextWidth('WWWWWWWW.WWW'),0);
end;


Наверх к содержанию




Вопрос:
Как настроить табуляцию в компоненте TMemo?

Ответ:

Пошлите в Memo сообщение EM_SETTABSTOPS. Например установим первую позицию табуляции на 20-й пиксел.

Пример:

procedure TForm1.FormCreate(Sender: TObject);
var
        DialogUnitsX : LongInt;
        PixelsX : LongInt;
        i : integer;
        TabArray : array[0..4] of integer;
begin
        Memo1.WantTabs := true;
        DialogUnitsX := LoWord(GetDialogBaseUnits);
        PixelsX := 20;
        for i := 1 to 5 do
        begin
                TabArray[i - 1] :=((PixelsX * i ) * 4) div DialogUnitsX;
        end;
        SendMessage(Memo1.Handle,
        EM_SETTABSTOPS,5,LongInt(@TabArray));
        Memo1.Refresh;
end;


Наверх к содержанию




Вопрос:
Как перехватить нажатия функциональных клавиш и стрелок?

Ответ:

Проверяйте значение переменной key на равенство VK_RIGHT, VK_LEFT, VK_F1 и т.д. на событии KeyDown формы.

Пример:

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
        if Key = VK_RIGHT then
                Form1.Caption := 'Right';
        if Key = VK_F1 then
                Form1.Caption := 'F1';
end;


Наверх к содержанию




Вопрос:

При обработке события DrawCell компонента DrawGrid я пишу Font.Color := clRed; и получаю бесконечный цикл мерцаний. Почему?

Ответ:
Правильно укажите границы используемого канваса.

Пример:

If (Row = 0) then
        begin
                DrawGrid1.Canvas.Font.Color := clRed;
                DrawGrid1.Canvas.TextOut(Rect.Left,Rect.Top, IntToStr(Col));
        end;


Наверх к содержанию




Вопрос:

При использовании BitBtn Caption(текст) и картинка(bitmap) из файла не видны 
одновременно. Почему?

Ответ:

Это может происходить если картинка слишком велика. Класс TBitBtn сначала рисует картинку, а затем выводит текст над, под, слева или справа от картинки (в завивимости от свойства Layout). Если размер картинки такой же как у всей кнопки для вывода текста просто не остается места. Если Вам нужно получить кнопку такого же размера как Ваша картинка и видеть при этом надпись на кнопке Вам придется выводить текст надписи непосредственно на канву картинки.

Пример:
var
        bm : TBitmap;
        OldBkMode : integer;
begin
        bm := TBitmap.Create;
        bm.Width := BitBtn1.Glyph.Width;
        bm.Height := BitBtn1.Glyph.Height;
        bm.Canvas.Draw(0, 0, BitBtn1.Glyph);
        OldBkMode := SetBkMode(bm.Canvas.Handle, Transparent);
        bm.Canvas.TextOut(0, 0, 'The Caption');
        SetBkMode(bm.Canvas.Handle, OldBkMode);
        BitBtn1.Glyph.Assign(bm);
end;


Наверх к содержанию




Вопрос:

Можно ли изменить вид текстового курсора (каретки) edit'а или другого элемента 
управления Windows?

Ответ:

Можно! В примере показано как создать два цветных "bitmap'а": "улыбчивый" и "хмурый" и присвоить их курсору edit'а. Для этого нужно перехватить оконную процедуру edit'а. Чтобы сделать это заменим адрес оконной процедуры Edit'а нашим собственным, а старую оконную процедуру будем вызывать по необходимости. Пример показывает "улыбчивый" курсор при наборе текста и "хмурый" при забое клавишей backspace.

Пример:

unit caret1;

interface

{$IFDEF WIN32}
uses
        Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
{$ELSE}
uses
        WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
        StdCtrls;
{$ENDIF}

type
        TForm1 = class(TForm)
                Edit1: TEdit;
                procedure FormCreate(Sender: TObject);
                procedure FormDestroy(Sender: TObject);
        private
                {Private declarations}
        public
                {Public declarations}
                CaretBm : TBitmap;
                CaretBmBk : TBitmap;
                OldEditsWindowProc : Pointer;
end;

var
        Form1: TForm1;

implementation
{$R *.DFM}

type
{$IFDEF WIN32}
        WParameter = LongInt;
{$ELSE}
        WParameter = Word;
{$ENDIF}
        LParameter = LongInt;

{New windows procedure for the edit control}
function NewWindowProc(WindowHandle : hWnd; TheMessage : WParameter; ParamW : WParameter;
                        ParamL : LParameter) : LongInt
{$IFDEF WIN32} stdcall; {$ELSE} ; export; {$ENDIF}
begin
{Call the old edit controls windows procedure}
        NewWindowProc := CallWindowProc(Form1.OldEditsWindowProc, WindowHandle,
                        TheMessage, ParamW, ParamL);
        if TheMessage = WM_SETFOCUS then
        begin
                CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0);
                ShowCaret(WindowHandle);
        end;
        if TheMessage = WM_KILLFOCUS then
        begin
                HideCaret(WindowHandle);
                DestroyCaret;
        end;
        if TheMessage = WM_KEYDOWN then
        begin
                if ParamW = VK_BACK then
                        CreateCaret(WindowHandle, Form1.CaretBmBk.Handle, 0, 0)
                else
                        CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0);
                ShowCaret(WindowHandle);
        end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
{Create a smiling bitmap using the wingdings font}
        CaretBm := TBitmap.Create;
        CaretBm.Canvas.Font.Name := 'WingDings';
        CaretBm.Canvas.Font.Height := Edit1.Font.Height;
        CaretBm.Canvas.Font.Color := clWhite;
        CaretBm.Width := CaretBm.Canvas.TextWidth('J') + 2;
        CaretBm.Height := CaretBm.Canvas.TextHeight('J') + 2;
        CaretBm.Canvas.Brush.Color := clBlue;
        CaretBm.Canvas.FillRect(Rect(0, 0, CaretBm.Width, CaretBm.Height));
        CaretBm.Canvas.TextOut(1, 1, 'J');
{Create a frowming bitmap using the wingdings font}
        CaretBmBk := TBitmap.Create;
        CaretBmBk.Canvas.Font.Name := 'WingDings';
        CaretBmBk.Canvas.Font.Height := Edit1.Font.Height;
        CaretBmBk.Canvas.Font.Color := clWhite;
        CaretBmBk.Width := CaretBmBk.Canvas.TextWidth('L') + 2;
        CaretBmBk.Height := CaretBmBk.Canvas.TextHeight('L') + 2;
        CaretBmBk.Canvas.Brush.Color := clBlue;
        CaretBmBk.Canvas.FillRect(Rect(0,0, CaretBmBk.Width, CaretBmBk.Height));
        CaretBmBk.Canvas.TextOut(1, 1, 'L');
{Hook the edit controls window procedure}
        OldEditsWindowProc := Pointer(SetWindowLong(Edit1.Handle,GWL_WNDPROC, 
                                                                LongInt(@NewWindowProc)));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
{Unhook the edit controls window procedure and clean up}
        SetWindowLong(Edit1.Handle,GWL_WNDPROC, LongInt(OldEditsWindowProc));
        CaretBm.Free;
        CaretBmBk.Free;
end;


Наверх к содержанию




Вопрос:

При использовании модулей доступа к BDE (DbiTypes, DbiProcs, DbiErrs), любая попытка вызвать процедуру abort выдает ошибку при компиляции при вызове метода abort "Statement expected, but expression of type 'Integer' found". Я пытался найти DbiTypes.pas, DbiProcs.pas и DbiErrs.pas чтобы разобраться но не нашел этих файлов. Где расположены эти файлы и как обойти ошибку?

Ответ:

Модули DbiTypes, DbiProcs, DbiErrs это псевдонимы модуля "BDE", обьявлены в Projects->Options->Directories/Conditionals->Unit Aliases. Исходник модуля DBE находится в каталоге "doc" и называется "BDE.INT". В этом файле обьявленна константа ABORT со значением -2. Так как Вы хотите использовать процедуру Abort(), которая обьявлена в модуле SysUtils, Вам нужно добавить префикс SysUtils перед вызовом процедуры Abort.

Пример:

SysUtils.Abort;


Наверх к содержанию




Вопрос:
Почему при изменении цвета букв StatusBar'а ничего не происходит?

Ответ:

Status bar - стандартный элемент управления Windows, и соответственно цвет его букв - значение clBtnText которое изменяется с помощью настроек в Control Panel. Этот цвет черный по умолчанию и может изменяться в зависимости от выбранной цветовой схемы. Другие стандартные элемент управления Windows, например кнопки, также имеют цвет букв, настраиваемый из ControlPanel. StatusBar и его панели имеют свойство "owner-draw", позволяющее Вам использовать любой цвет букв.

Пример:

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
                        Panel: TStatusPanel; const Rect: TRect);
begin
        if Panel = StatusBar.Panels[0] then
                begin
                        StatusBar.Canvas.Font.Color := clRed;
                        StatusBar.Canvas.TextOut(Rect.Left, Rect.Top, 'Panel - 0')
                end 
        else
                begin
                        StatusBar.Canvas.Font.Color := clGreen;
                        StatusBar.Canvas.TextOut(Rect.Left, Rect.Top, 'Panel - 1');
                end;
end;


Наверх к содержанию




Вопрос:
Как сделать многострочную надпись на TBitBtn?

Ответ:
Выводите текст надписи непосредственно на "glyph" TBitBtn'а. См. пример.

Пример:

procedure TForm1.FormCreate(Sender: TObject);
var
        R : TRect;
        N : Integer;
        Buff : array[0..255] of Char;
begin
        with BitBtn1 do
                begin
                        Caption := 'A really really long caption';
                        Glyph.Canvas.Font := Self.Font;
                        Glyph.Width  := Width - 6;
                        Glyph.Height := Height - 6;
                        R := Bounds(0, 0, Glyph.Width, 0);
                        StrPCopy(Buff, Caption);
                        Caption := '';
                        DrawText(Glyph.Canvas.Handle,Buff,StrLen(Buff),R,
                                DT_CENTER or DT_WORDBREAK or DT_CALCRECT);
                        OffsetRect(R,(Glyph.Width - R.Right) div 2,
                                        (Glyph.Height - R.Bottom) div 2);
                        DrawText(Glyph.Canvas.Handle,Buff,StrLen(Buff),R,
                                DT_CENTER or DT_WORDBREAK);
                end;
end;


Наверх к содержанию




Вопрос:

Как изменить стиль шрифта RichEdit нажатиями соответствующих комбинаций клавиш? (например включить курсив по нажатию Ctrl + I)

Ответ:
В примере стили шрифта меняются по нажатию след. комбинаций клавиш
        Ctrl + B - вкл/выкл жирного шрифта
        Ctrl + I - вкл/выкл наклонного шрифта
        Ctrl + S - вкл/выкл зачеркнутого шрифта
        Ctrl + U - вкл/выкл подчеркнутого шрифта


Пример:

const
        KEY_CTRL_B = 02;
        KEY_CTRL_I =  9;
        KEY_CTRL_S = 19;
        KEY_CTRL_U = 21;

procedure TForm1.RichEdit1KeyPress(Sender: TObject; var Key: Char);
begin
        case Ord(Key) of
        KEY_CTRL_B: 
                begin
                        Key := #0;
                                if fsBold in (Sender as TRichEdit).SelAttributes.Style then
                                        (Sender as TRichEdit).SelAttributes.Style :=
                                        (Sender as TRichEdit).SelAttributes.Style - [fsBold]
                                else
                                        (Sender as TRichEdit).SelAttributes.Style :=
                                        (Sender as TRichEdit).SelAttributes.Style + [fsBold];
                end;
        KEY_CTRL_I:
                begin
                        Key := #0;
                                if fsItalic in (Sender as TRichEdit).SelAttributes.Style then
                                        (Sender as TRichEdit).SelAttributes.Style :=
                                        (Sender as TRichEdit).SelAttributes.Style - [fsItalic]
                                else
                                        (Sender as TRichEdit).SelAttributes.Style :=
                                        (Sender as TRichEdit).SelAttributes.Style + [fsItalic];
                end;
        KEY_CTRL_S:
                begin
                        Key := #0;
                        if fsStrikeout in (Sender as TRichEdit).SelAttributes.Style then
                                (Sender as TRichEdit).SelAttributes.Style :=
                                (Sender as TRichEdit).SelAttributes.Style-[fsStrikeout]
                        else
                                (Sender as TRichEdit).SelAttributes.Style :=
                                (Sender as TRichEdit).SelAttributes.Style+[fsStrikeout];
                end;
        KEY_CTRL_U:
                begin
                        Key := #0;
                        if fsUnderline in (Sender as TRichEdit).SelAttributes.Style then
                                (Sender as TRichEdit).SelAttributes.Style :=
                                (Sender as TRichEdit).SelAttributes.Style-[fsUnderline]
                        else
                                (Sender as TRichEdit).SelAttributes.Style :=
                                (Sender as TRichEdit).SelAttributes.Style+[fsUnderline];
                end;
        end;
end;


Наверх к содержанию




Вопрос:

В документации компонента TRegIniFile говорится, что можно изменять корневой ключ (root key). Я пытаюсь это сделать но ничего не получается.

Ответ:
См. пример.

Пример:

uses Registry;

procedure TForm1.Button1Click(Sender: TObject);
var
        WinIni : TRegIniFile;
begin
        WinIni := TRegIniFile.Create('');
        WinIni.RootKey := HKEY_LOCAL_MACHINE;
        WinIni.WriteString('Frank','Borland','Writes Fast Code!');
        WinIni.Free;
end;


Наверх к содержанию




Вопрос:

Можно ли динамически изменять свойство "owner" компонента во время выполнения программы?

Ответ:

Вы можете менять свойство "owner" и после создания компонента с помощью методов InsertComponent() и RemoveComponent().

Наверх к содержанию




Вопрос:

Как очистить содержимое Canvas'а?

Ответ:

Просто нарисуйте прямоугольник любого цвета.

Пример:

Canvas.Brush.Color := ClWhite;
Canvas.FillRect(Canvas.ClipRect);


Наверх к содержанию




Вопрос:

Можно ли динамически менять какая форма считается главной в приложении во время работы программы?

Ответ:

Можно, но только во время загрузки приложения. Чтобы сделать это выберите "View->Project Source" и измените код инициализации приложения, так что порядок создания форм зависил от какого-то условия.

Примечание: Вам придется редактировать этот код, если Вы добавите в приложение новые формы.

begin
        Application.Initialize;
        if <какое-то условие> then 
                begin
                        Application.CreateForm(TForm1, Form1);
                        Application.CreateForm(TForm2, Form2);
                end 
        else 
                begin
                        Application.CreateForm(TForm2, Form2);
                        Application.CreateForm(TForm1, Form1);
                end;
end.
Application.Run;


Наверх к содержанию




Вопрос:

Как программно "щелкнуть" по компоненту speed button? Я пытался использовать SendMessage но у Speedbuttons нет "handle".

Ответ:
В примере используется метод Perform класса TControl для отправки сообщения.

Пример:

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
        ShowMessage('clicked');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
        SpeedButton1.Perform(WM_LBUTTONDOWN, 0, 0);
        SpeedButton1.Perform(WM_LBUTTONUP, 0, 0);
end;


Наверх к содержанию




Вопрос:
Можно ли отключить определенный элемент в RadioGroup?

Ответ:
В примере показано как получить доступ к отдельным элементам компонента TRadioGroup.

Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
        TRadioButton(RadioGroup1.Controls[1]). Enabled := False;
end;


Наверх к содержанию




Вопрос:

Почему методы рисования Delphi (например MoveTo и LineTo) рисуют на один пиксел короче?

Ответ:

Так работает большинство графических систем, включая Windows. Библиотека VCL просто передает вызовы в функции GDI. Если Вы хотите нарисовать линию с последним пикселом включительно просто добавте единицу к координатам.

Наверх к содержанию




Вопрос:
Как показать подсказки "hints" для элементов меню?

Ответ:

В примере создается обработчик события Application.Hint - подсказки меню изображаются
на status panel.

Пример:

type
        TForm1 = class(TForm)
                Panel1: TPanel;
                MainMenu1: TMainMenu;
                MenuItemFile: TMenuItem;
                MenuItemOpen: TMenuItem;
                MenuItemClose: TMenuItem;
                OpenDialog1: TOpenDialog;
                procedure FormCreate(Sender: TObject);
                procedure MenuItemCloseClick(Sender: TObject);
                procedure MenuItemOpenClick(Sender: TObject);
        private
                {Private declarations}
                procedure HintHandler(Sender: TObject);
        public
                {Public declarations}
end;

var
        Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
        Panel1.Align := alBottom;
        MenuItemFile.Hint := 'File Menu';
        MenuItemOpen.Hint := 'Opens A File';
        MenuItemClose.Hint := 'Closes the Application';
        Application.OnHint := HintHandler;
end;

procedure TForm1.HintHandler(Sender: TObject);
begin
        Panel1.Caption := Application.Hint;
end;

procedure TForm1.MenuItemCloseClick(Sender: TObject);
begin
        Application.Terminate;
end;

procedure TForm1.MenuItemOpenClick(Sender: TObject);
begin
        if OpenDialog1.Execute then
                Form1.Caption := OpenDialog1.FileName;
end;


Наверх к содержанию




Вопрос:
Как опеделить состояние списка 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;


Наверх к содержанию




Вопрос:

Как в компоненте TMemo перехватить нажатие Ctrl-V и вставить специальный текст не из буфера обмена (clipboard)?

Ответ:
См. пример.

Пример:

uses ClipBrd;

procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
        if ((Key = ord('V')) and (ssCtrl in Shift)) then
                begin
                        if Clipboard.HasFormat(CF_TEXT) then 
                                ClipBoard.Clear;
                        Memo1.SelText := 'Delphi is RAD!';
                        key := 0;
                end;
end;


Наверх к содержанию




Вопрос:

Как создать эквивалент TEdit но только с выравниваением вводимого текста по центру или по правой стороне?

Ответ:

TEdit не поддерживает выравниваение текста по центру и по правой стороне - лучше использовать компонент TMemo. Вам понадобится запретить пользователю нажимать Enter, Ctrl-Enter и всевозможные комбинации клавиш со стрелками, чтобы избежать появления нескольких сторк в Memo. Этого можно добиться и просматривая содержимое текста в TMemo в поисках кода возврата каретки (13) и перевода строки(10) на событиях TMemo Change и KeyPress. Можно также заменять код возврата каретки на пробел - для того чтобы позволять вставку из буфера обмена многострочного текста в виде одной строки.

Пример:

procedure TForm1.FormCreate(Sender: TObject);
begin
        Memo1.Alignment := taRightJustify;
        Memo1.MaxLength := 24;
        Memo1.WantReturns := false;
        Memo1.WordWrap := false;
end;

procedure MultiLineMemoToSingleLine(Memo : TMemo);
var
        t : string;
begin
        t := Memo.Text;
        if Pos(#13, t) > 0  then
                begin
                        while Pos(#13, t) > 0 do
                                delete(t, Pos(#13, t), 1);
                        while Pos(#10, t) > 0 do
                                delete(t, Pos(#10, t), 1);
                        Memo.Text := t;
                end;
end;

procedure TForm1.Memo1Change(Sender: TObject);
begin
        MultiLineMemoToSingleLine(Memo1);
end;

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
        MultiLineMemoToSingleLine(Memo1);
end;


Наверх к содержанию




Вопрос:

Как запрограммировать undo?

Ответ:См. пример

Memo1.Perform(EM_UNDO, 0, 0);

Если Вы хотите узнать, возможно ли выполнить операцию "Undo", проверьте "Undo status":

If Memo1.Perform(EM_CANUNDO, 0, 0) <> 0 then
begin
        {Undo is possible}
end;

Для выполнения "Redo" выполните "Undo" еще раз.


Наверх к содержанию




Вопрос:
Можно ли создать форму, которая получает дополнительные параметры в методе Сreate?

Ответ:
Просто замените конструктор Create класса Вашей формы.

Пример:

unit Unit2;

interface

uses  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
        TForm2 = class(TForm)
        private
                {Private declarations}
        public
                constructor CreateWithCaption(aOwner: TComponent; aCaption: string);
                {Public declarations} 
end;

var
        Form2: TForm2;

implementation

{$R *.DFM}

constructor TForm2.CreateWithCaption(aOwner: TComponent; aCaption: string);
begin
        Create(aOwner);
        Caption := aCaption;
end;

uses Unit2;
procedure TForm1.Button1Click(Sender: TObject);
begin
        Unit2.Form2 :=Unit2.TForm2.CreateWithCaption(Application, 'My Caption');
        Unit2.Form2.Show;
end;


Наверх к содержанию




Вопрос:
Почему при изменении цвета шрифта в StatusBar's он (шрифт) не меняется?

Ответ:

Status bar (строка состояния) - стандартный элемент управления Windows и цвет его шрифта задается через Control Panel (константа clBtnText). Этот цвет по умолчанию черный и может меняться при выборе пользователем той или иной цветовой схемы. У компонента ТStatusBar и его панелей есть возможность "owner-draw" - программной перерисовки, которая позволяет выводить на панель текст любого цвета. Измените свойство Style компонента TStatusBar.Panels на OwnerDraw.

Пример:

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
                                                                const Rect: TRect);
begin
        if Panel = StatusBar.Panels[0] then
                begin
                        StatusBar.Canvas.Font.Color := clRed;
                        StatusBar.Canvas.TextOut(Rect.Left, Rect.Top, 'Panel - 0')
                end
        else
                begin
                        StatusBar.Canvas.Font.Color := clGreen;
                        StatusBar.Canvas.TextOut(Rect.Left, Rect.Top, 'Panel - 1');
                end;
end;


Наверх к содержанию




Вопрос:

Как бы мне создать эдакий trackbar в котором вместо широкой белой полоски с ползунком была бы тонкая линия?

Ответ:

В примере создается компонент, унаследованный от TTrackbar который переопределяет метод CreateParams и убират флаг TBS_ENABLESELRANGE из Style. Константа TBS_ENABLESELRANGE обьявленна в модуле CommCtrl.

Пример:

uses CommCtrl, ComCtrls;

type TMyTrackBar = class(TTrackBar)
        procedure CreateParams(var Params: TCreateParams); override;
end;

procedure TMyTrackBar.CreateParams(var Params: TCreateParams);
begin
        inherited;
                Params.Style := Params.Style and not TBS_ENABLESELRANGE;
end;

var
        MyTrackbar : TMyTrackbar;

procedure TForm1.Button1Click(Sender: TObject);
begin
        MyTrackBar := TMyTrackbar.Create(Form1);
        MyTrackbar.Parent := Form1;
        MyTrackbar.Left := 100;
        MyTrackbar.Top := 100;
        MyTrackbar.Width := 150;
        MyTrackbar.Height := 45;
        MyTrackBar.Visible := true;
end;


Наверх к содержанию




Вопрос:

Мне нужен временный canvas, но когда я пытаюсь его создать получаю сообщения об ошибках. Как создать TCanvas?

Ответ:

Создайте Bitmap и используйте свойство canvas класса TBitmap. Пример создает Bitmap, рисует на его canvas'е, выводит этот canvas на форму и освобождает bitmap.

Пример:

procedure TForm1.Button1Click(Sender: TObject);
var
        bm : TBitmap;
begin
        bm := TBitmap.Create;
        bm.Width := 100;
        bm.Height := 100;
        bm.Canvas.Brush.Color := clRed;
        bm.Canvas.FillRect(Rect(0, 0, 100, 100));
        bm.Canvas.MoveTo(0, 0);
        bm.Canvas.LineTo(100, 100);
        Form1.Canvas.StretchDraw(Form1.ClientRect,Bm);
        bm.Free;
end;


Наверх к содержанию




Вопрос:

В некоторых видео режимах прозрачная часть glyph'а стандартного TBitBtn становится видной. Как этого избежать?

Ответ:

В примере используется техника закраски прозрачной части glyph'а цветом кнопки на которой он находится - таким образом glyph кажется прозрачным.

Пример:

function InitStdBitBtn(BitBtn : TBitBtn; kind : TBitBtnKind) : bool;
var
        Bm1 : TBitmap;
        Bm2 : TBitmap;
begin
        Result := false;
        if Kind = bkCustom then exit;
        Bm1 := TBitmap.Create;
        case Kind of
                bkOK : Bm1.Handle := LoadBitmap(hInstance, 'BBOK');
                bkCancel : Bm1.Handle := LoadBitmap(hInstance, 'BBCANCEL');
                bkHelp : Bm1.Handle := LoadBitmap(hInstance, 'BBHELP');
                bkYes : Bm1.Handle := LoadBitmap(hInstance, 'BBYES');
                bkNo : Bm1.Handle := LoadBitmap(hInstance, 'BBNO');
                bkClose : Bm1.Handle := LoadBitmap(hInstance, 'BBCLOSE');
                bkAbort : Bm1.Handle := LoadBitmap(hInstance, 'BBABORT');
                bkRetry : Bm1.Handle := LoadBitmap(hInstance, 'BBRETRY');
                bkIgnore : Bm1.Handle := LoadBitmap(hInstance, 'BBIGNORE');
                bkAll : Bm1.Handle := LoadBitmap(hInstance, 'BBALL');
        end;
        Bm2 := TBitmap.Create;
        Bm2.Width := Bm1.Width;
        Bm2.Height := Bm1.Height;
        Bm2.Canvas.Brush.Color := ClBtnFace;
        Bm2.Canvas.BrushCopy(Rect(0, 0, bm2.Width, bm2.Height), Bm1,
                                        Rect(0, 0, Bm1.width, Bm1.Height),
        Bm1.canvas.pixels[0,0]);
        Bm1.Free;
        LockWindowUpdate(BitBtn.Parent.Handle);
        BitBtn.Kind := kind;
        BitBtn.Glyph.Assign(bm2);
        LockWindowUpdate(0);
        Bm2.Free;
        Result := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
        InitStdBitBtn(BitBtn1, bkOk);
end;


Наверх к содержанию




Вопрос:
Создание PolyPolygon используя массив точек?

Ответ:

Polygon - метод компонента TCanvas получает в качестве параметра динамический массив точек. Функция PolyPolygon() из Windows GDI получает указатель на массив точек.

Пример:

procedure TForm1.Button1Click(Sender: TObject);
var
        ptArray : array[0..9] of TPOINT;
        PtCounts : array[0..1] of integer;
begin
        PtArray[0] := Point(0, 0);
        PtArray[1] := Point(0, 100);
        PtArray[2] := Point(100, 100);
        PtArray[3] := Point(100, 0);
        PtArray[4] := Point(0, 0);
        PtCounts[0] := 5;
        PtArray[5] := Point(25, 25);
        PtArray[6] := Point(25, 75);
        PtArray[7] := Point(75, 75);
        PtArray[8] := Point(75, 25);
        PtArray[9] := Point(25, 25);
        PtCounts[1] := 5;
        PolyPolygon(Form1.Canvas.Handle,
        PtArray,PtCounts,2);
end;


Наверх к содержанию




Вопрос:

Как создать невизуальный компонент без иконоки, которая изображается в палитре компонентов в "design-time" (вроде TField)?

Ответ:

Невизуальные компоненты без иконоки удобны для субкомпонентов, связанных с какими-то другими компонентами. Создайте компонент как обычно, но используйте RegisterNoIcon вместо RegisterComponent.

Наверх к содержанию




Вопрос:

Как показывать нестандартный встроенный редактор (inplace editor) в ячейке stringgrid (например combobox).

Ответ:
См. пример

Пример:

procedure TForm1.FormCreate(Sender: TObject);
begin
        {Высоту combobox'а не изменишь, так что вместо combobox'а
                                будем изменять высоту строки grid'а !}
        StringGrid1.DefaultRowHeight := ComboBox1.Height;
        {Спрятать combobox}
        ComboBox1.Visible := False;
        ComboBox1.Items.Add('Delphi Kingdom');
        ComboBox1.Items.Add('Королевство Дельфи');
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
        {Перебросим выбранное в значение из ComboBox в grid}
        StringGrid1.Cells[StringGrid1.Col,
        StringGrid1.Row] :=ComboBox1.Items[ComboBox1.ItemIndex];
        ComboBox1.Visible := False;
        StringGrid1.SetFocus;
end;

procedure TForm1.ComboBox1Exit(Sender: TObject);
begin
        {Перебросим выбранное в значение из ComboBox в grid}
        StringGrid1.Cells[StringGrid1.Col,
        StringGrid1.Row] :=ComboBox1.Items[ComboBox1.ItemIndex];
        ComboBox1.Visible := False;
        StringGrid1.SetFocus;
end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
                                        ARow: Integer; var CanSelect: Boolean);
var
        R: TRect;
begin
        if ((ACol = 3) AND (ARow <> 0)) then
                begin
                        {Ширина и положение ComboBox должно соответствовать
                                                                ячейке StringGrid}
                        R := StringGrid1.CellRect(ACol, ARow);
                        R.Left := R.Left + StringGrid1.Left;
                        R.Right := R.Right + StringGrid1.Left;
                        R.Top := R.Top + StringGrid1.Top;
                        R.Bottom := R.Bottom + StringGrid1.Top;
                        ComboBox1.Left := R.Left + 1;
                        ComboBox1.Top := R.Top + 1;
                        ComboBox1.Width := (R.Right + 1) - R.Left;
                        ComboBox1.Height := (R.Bottom + 1) - R.Top;
                        {Покажем combobox}
                        ComboBox1.Visible := True;
                        ComboBox1.SetFocus;
                end;
        CanSelect := True;
end;


Наверх к содержанию




Вопрос:
Как узнать есть ли в заданном CD-ROM'е Audio CD?

Ответ:

Можно использовать функцию Windows API GetDriveType() чтобы определить является ли дисковод CD-ROM'мом. И функцию API GetVolumeInformation() чтобы проверить VolumeName на равенство 'Audio CD'.

Пример:

function IsAudioCD(Drive : char) : bool;
var
        DrivePath : string;
        MaximumComponentLength : DWORD;
        FileSystemFlags : DWORD;
        VolumeName : string;
Begin
        sult := false;
        DrivePath := Drive + ':\';
        if GetDriveType(PChar(DrivePath)) <> DRIVE_CDROM then 
                exit;
        SetLength(VolumeName, 64);
        GetVolumeInformation(PChar(DrivePath),PChar(VolumeName),
        Length(VolumeName),nil,MaximumComponentLength,FileSystemFlags,nil,0);
        if lStrCmp(PChar(VolumeName),'Audio CD') = 0 then
                result := true;
end;

function PlayAudioCD(Drive : char) : bool;
var
        mp : TMediaPlayer;
begin
        result := false;
        Application.ProcessMessages;
        if not IsAudioCD(Drive) then
                exit;
        mp := TMediaPlayer.Create(nil);
        mp.Visible := false;
        mp.Parent := Application.MainForm;
        mp.Shareable := true;
        mp.DeviceType := dtCDAudio;
        mp.FileName := Drive + ':';
        mp.Shareable := true;
        mp.Open;
        Application.ProcessMessages;
        mp.Play;
        Application.ProcessMessages;
        mp.Close;
        Application.ProcessMessages;
        mp.free;
        result := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
        if not PlayAudioCD('D') then
                ShowMessage('Not an Audio CD');
end;


Наверх к содержанию




Вопрос:
Как узнать есть ли у мыши колесико?

Ответ:
Свойство "WheelPresent" глобального обьекта "mouse".


Наверх к содержанию




Вопрос:

События KeyPress и KeyDown не вызываются для клавиши Tab - как определить, что она была нажата?

Ответ:

На уровне формы клавиша tab обычно обрабатывается Windows. В примере создается обработчик события CM_Dialog для перехвата Dialog keys.

Пример:

type
        TForm1 = class(TForm)
        private
                procedure CMDialogKey( Var msg: TCMDialogKey );
                message CM_DIALOGKEY;
end;

var
        Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.CMDialogKey(var msg: TCMDialogKey);
begin
        if msg.Charcode <> VK_TAB then
                inherited;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
        if Key = VK_TAB then
        Form1.Caption := 'Tab Key Down!';
end;


Наверх к содержанию




Вопрос:
В чем отличие между Create(Self) и Create(Application)?

Ответ:

Self может быть использовано только в методе класса, и ссылается на текущий экземпляр класса. Таким образом "Self" в методе класса TForm1 ссылается на текущий экземпляр TForm1. При создании компонента Вы передаете его владельца (owner) в конструктор. При уничтожении формы или компонента автоматически уничтожаются и все компоненты владельцем которого она является. Таким образом если при создании формы передать в качестве владельца Application эта форма будет автоматически уничтожена при уничтожении Application. Если же при создании формы передать в качестве владельца другую форму, вновь созданная форма будет автоматически уничтоженна при уничтожении формы-владельца.

Наверх к содержанию




Вопрос:
Как во время выполнения определить поддерживает ли обьект заданное свойство?

Ответ:
function HasProperty(Obj : TObject; Prop : string) : PPropInfo;
begin
        Result := GetPropInfo(Obj.ClassInfo, Prop);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
        p : pointer;
begin
        p :=  HasProperty(Button1, 'Color');
        if p <> nil then
                SetOrdProp(Button1, p, clRed)
        else
                ShowMessage('Button has no color property');
        p :=  HasProperty(Label1, 'Color');
        if p <> nil then
                SetOrdProp(Label1, p, clRed)
        else
                ShowMessage('Label has no color property');
        p :=  HasProperty(Label1.Font, 'Color');
        if p <> nil then
                SetOrdProp(Label1.Font.Color, p, clBlue)
        else
                ShowMessage('Label.Font has no color property');
end;


Наверх к содержанию




Вопрос:
Как при проигрывании музыки с Audio CD показывать сколько прошло минут и секунд?

Ответ:
В примере время выводится по таймеру.

Пример:

uses MMSystem;

procedure TForm1.Timer1Timer(Sender: TObject);
var
        Trk : Word;
        Min : Word;
        Sec : Word;
begin
        with MediaPlayer1 do
                begin
                        Trk := MCI_TMSF_TRACK(Position);
                        Min := MCI_TMSF_MINUTE(Position);
                        Sec := MCI_TMSF_SECOND(Position);
                        Label1.Caption := Format('%.2d',[Trk]);
                        Label2.Caption := Format('%.2d:%.2d',[Min,Sec]);
                end;
end;


Наверх к содержанию




Вопрос:
Можно ли рисовать на рамке формы?

Ответ:
Обрабатывайте событие WM_NCPAINT. В примере рамка обводится красной линией
толщиной в 1 пиксел.

Пример:

type
        TForm1 = class(TForm)