|
|
Programming: Delphi
DELPHI VCL FAQ (Часть 1)
Вопрос:
Как разместить прозрачную надпись на TBitmap?
Пример:
<![CDATA[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).
Пример:
<![CDATA[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.
Пример:
<![CDATA[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 - таким образом можно добавиь дополнительные колонки.
Пример:
<![CDATA[with TDirectoryListBox(FileListBox1) do
begin
Columns := 2;
SendMessage(Handle, LB_SETCOLUMNWIDTH, Canvas.TextWidth('WWWWWWWW.WWW'),0);
end;]]>
Наверх к содержанию
Вопрос:
Как настроить табуляцию в компоненте TMemo?
Ответ:
Пошлите в Memo сообщение EM_SETTABSTOPS. Например установим
первую позицию табуляции на 20-й пиксел.
Пример:
<![CDATA[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 формы.
Пример:
<![CDATA[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; и получаю бесконечный цикл мерцаний. Почему?
Ответ:
Правильно укажите границы используемого канваса.
Пример:
<![CDATA[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). Если размер
картинки такой же как у всей кнопки для вывода текста просто не остается
места. Если Вам нужно получить кнопку такого же размера как Ваша картинка
и видеть при этом надпись на кнопке Вам придется выводить текст надписи
непосредственно на канву картинки.
Пример:
<![CDATA[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.
Пример:
<![CDATA[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.
Пример:
<![CDATA[SysUtils.Abort;]]>
Наверх к содержанию
Вопрос:
Почему при изменении цвета букв StatusBar'а ничего не происходит?
Ответ:
Status bar - стандартный элемент управления Windows, и
соответственно цвет его букв - значение clBtnText которое изменяется с
помощью настроек в Control Panel. Этот цвет черный по умолчанию и может
изменяться в зависимости от выбранной цветовой схемы. Другие стандартные
элемент управления Windows, например кнопки, также имеют цвет букв,
настраиваемый из ControlPanel. StatusBar и его панели имеют свойство
"owner-draw", позволяющее Вам использовать любой цвет букв.
Пример:
<![CDATA[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'а. См. пример.
Пример:
<![CDATA[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)
Ответ:
<![CDATA[В примере стили шрифта меняются по нажатию след. комбинаций клавиш
Ctrl + B - вкл/выкл жирного шрифта
Ctrl + I - вкл/выкл наклонного шрифта
Ctrl + S - вкл/выкл зачеркнутого шрифта
Ctrl + U - вкл/выкл подчеркнутого шрифта]]>
Пример:
<![CDATA[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). Я пытаюсь это сделать но ничего не
получается.
Ответ:
См. пример.
Пример:
<![CDATA[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'а?
Ответ:
Просто нарисуйте прямоугольник любого цвета.
Пример:
<![CDATA[Canvas.Brush.Color := ClWhite;
Canvas.FillRect(Canvas.ClipRect);]]>
Наверх к содержанию
Вопрос:
Можно ли динамически менять какая форма считается главной в
приложении во время работы программы?
Ответ:
Можно, но только во время загрузки приложения. Чтобы сделать
это выберите "View->Project Source" и измените код инициализации
приложения, так что порядок создания форм зависил от какого-то условия.
Примечание:
Вам придется редактировать этот код, если Вы добавите в приложение новые формы.
<![CDATA[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 для отправки сообщения.
Пример:
<![CDATA[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.
Пример:
<![CDATA[procedure TForm1.Button1Click(Sender: TObject);
begin
TRadioButton(RadioGroup1.Controls[1]). Enabled := False;
end;]]>
Наверх к содержанию
Вопрос:
Почему методы рисования Delphi (например MoveTo и LineTo) рисуют на один пиксел короче?
Ответ:
Так работает большинство графических систем, включая Windows.
Библиотека VCL просто передает вызовы в функции GDI. Если Вы хотите
нарисовать линию с последним пикселом включительно просто добавте единицу
к координатам.
Наверх к содержанию
Вопрос:
Как показать подсказки "hints" для элементов меню?
Ответ:
В примере создается обработчик события Application.Hint - подсказки меню изображаются
на status panel.
Пример:
<![CDATA[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.
Пример:
<![CDATA[if SendMessage(ComboBox1.Handle, CB_GETDROPPEDSTATE,0,0) = 1 then
begin {список ComboBox выпал}
end;]]>
Наверх к содержанию
Вопрос:
Как удалить каталог вместе со всеми содержащимися в нем файлами?
Ответ:
В примере стираются все файлы в каталоге и сам каталог. Чтобы
удалить файл, помечанные только для чтения (read only) и занятые другими
программами в момент удаления - напишите дополнительную процедуру.
<![CDATA[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)?
Ответ:
В приведенном примере показано как это сделать
Пример:
<![CDATA[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().
Пример:
<![CDATA[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
Пример:
<![CDATA[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
Пример:
<![CDATA[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. Индексы
предопределенных курсоров системы отрицательны, пользователь может
определить курсор, индекс которого положителен.
Пример:
<![CDATA[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.
Пример:
<![CDATA[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.
Пример:
<![CDATA[{$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-строку.
Пример:
<![CDATA[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 интерпритирует
одиночный амперсанд как указание на то, что следующий символ - горячая
клавиша (и поддчеркивает следующий символ вместо излбражения аперсанда).
Пример:
<![CDATA[Button1.Caption := 'Черное && Белое';]]>
Наверх к содержанию
Вопрос:
Как поместить bitmap в Metafile?
Ответ:
см. пример
Пример:
<![CDATA[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.
Пример:
<![CDATA[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?
Ответ:
см. пример
Пример:
<![CDATA[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'е.
Пример:
<![CDATA[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), показываеющее номер текущей строки и колонки.
Пример:
<![CDATA[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 из Visual Basic?
Ответ:
Функции TwipsPerPixelX и TwipsPerPixelY, приведенные в примере реализуют ту же
функциональность в Delphi.
Пример:
<![CDATA[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;]]>
Наверх к содержанию
Часть 2
При перепечатке любого материала
с сайта, видимая ссылка на источник www.warayg.narod.ru
и все имена, ссылки авторов обязательны.
© 2005
|
|
|
