| |
VCL
Memo
Настройка табуляции в
компоненте TMemo.
Номер текущей строки в TMemo.
Содержимое файла в текущую
позицию курсора в TMemo.
Перехват нажатия Ctrl-V в TMemo.
Режим вставка-замена в TMemo и TEdit.
Прокрутка Memo
(постранично), фокус находится на Edit1.
Как выполнить UnDo в
Memo.
Как можно определить,
на какой строке в TMemo находится курсор?
Edit
TEdit с выравниваением текста по
правой стороне.
Undo в Edit.
Как заставить TEdit не 'пикать'.
Ограничение длинны текста,
вводимого в TEdit.
Как поместить курсор в
определенную позицию edit'а.
Перехват нажатия
функциональных клавиш и стрелок.
Мерцание на DrawCell.
BitBtn
Надпись на компоненте TBitBtn с
переносом слов.
Bitmap и текст на TBitBtn.
Курсоры
Изменение вида текстового
курсора.
Использование анимированного
курсора.
Меню
Как узнать о нажатии клавиши в
момент когда показано меню .
Как показать подсказки (hints) для
элементов меню.
Меню в стиле Delphi 4.
Как программно заставить
выпасть меню.
Картинки в TPopUpMenu.
Ошибки
Ошибка 'There are no fonts installed'.
Строка сообщения об ошибке Windows.
Ошибка при создании обьекта
класса TPrinter.
Ошибка компиляции при вызове
метода abort.
Цвета
Преобразование цвета в строку -
название цвета VCL .
Выделение RGB компонентов цвета.
Цвет букв в стандартных
элементах управления Windows.
ScrollBar
Перехват сообщений прокрутки в
TScrollBox.
Отключение мигания ползунока
компонента TScrollBar.
DriveComboBox
Удаление дисков из списка
TDriveComboBox.
Обновить список дисков
компонента TDriveComboBox.
ComboBox
Как выяснить состояние списка
Combobox.
Как открыть ComboBox
программно.
Размеры TComboBox с показанным
выпадающим списком.
ListBox
Секреты ListBox
Свойство selected Listbox'а.
Как получить горизонтальную прокрутку
(scrollbar) в ListBox?
Поиск строки в ListBox
Как вставить графику
в ListBox или ComboBox
NoteBook
Получение списка всех
компонентов, расположенных на TNoteBook.
Уменьшение ресурсов
потребляемых TNotebook и TTabbedNotebook.
StringGrid
Отедельный hint для каждой ячейки
StringGrid'а.
Нестандартный редактор
(например combobox) в ячейке StringGrid .
Доступ к колонке-строке grid'а по
заголовку.
Автоматическая ширина колонок
в StringGrid.
Как вставить несколько
строк в середину StringGrid или после определенной
строки?
TDBGrid
Фиксированные колонки в TDbGrid.
Показ dbgrid в режиме disabled.
Установить курсор в нужную
позицию ячейки DBGrid.
RichEdit
Как
вставить иконку (или bitmap) в TRichEdit, причем так,
чтобы пользователь мог ее удалить нажатием
клавиши Del (как это сделано в Microsoft Word)?
Изменение стилей шрифта RichEdit
нажатиями комбинаций клавиш.
Other
Прозрачная надпись на TBitmap.
Использование
клавиши-акселератора в TTabsheets.
Изменение числа колонок и их
ширины в TFileListBox.
Динамическое изменения
свойства owner компонента в 'runtime'.
Очистка содержимого Canvas'а.
Программный 'Click' по 'speed button'.
Доступ к элементам компонента
TRadioGroup.
очему функции рисования Delphi
рисуют на один пиксел короче.
aмперсанд в Windows .
Как поместить bitmap в Metafile.
Запущенно ли приложение под
Windows NT.
kaк создать bitmap из пиктогрммы
(icon).
Как внести изменения в код VCL.
Эквивалент TwipsPerPixel из VB.
Цветной текст в TStatusBar.
Переделываем TTrackBar.
Создание временного canvas'а.
Проблема с прозраным glyph'ом.
Создание PolyPolygon используя
массив точек.
Создание невизуальных
компонентов без иконок.
Определение нажатия клавиши tab.
Определение поддерживает ли
обьект заданное свойство.
Рисуем на рамке.
Radiogroup и фокус ввода.
Как узнать нажаты ли клавиши
Shift, Ctrl, Alt .
Как изменить шрифт подсказки
(hint'а).
Динамическое рисование
прозрачных картинок TImageList.
Эквивалент escape codes из С.
Переключить TListView в режим
редактирования нажатием клавиш.
Уничтожение обьекта,
сохраненного в списке TStrings.
Using Resident Font.
Еще более строгая проверка
типов.
VK_Key для A-Z и 0-9.
Перемещать компонент мышкой в
'runtime'.
Как нарисовать пиктограмму (icon)
с увеличением.
TTimer работает не достаточно
точно.
Прямоугольник для выделения
части рисунка.
Использование пиктограммы (Icon)
как картинки на TSpeedButton.
Прозрачная фоновая каринкя на
компоненте CoolBar.
Клавиша-акселератор для
компонета у которого нет заголовка.
Уменьшение мерцания при
перерисовке компонента.
Как запретить изменение
размера моего компонента в design-time.
Переход на другую страницу TabSet по имени.
TSеlectableTree - TTreeView с
возможностью MultiSelect'а.
Вопрос:
Как разместить прозрачную надпись на 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;
Наверх к содержанию
Вопрос:
Можно ли изменить число колонок и их ширину в компоненте 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;
Наверх к содержанию
Вопрос:
Можно ли динамически изменять свойство "owner" компонента во время выполнения программы?
Ответ:
Вы можете менять свойство "owner" и после создания компонента с помощью
методов InsertComponent() и RemoveComponent().
Наверх к содержанию
Вопрос:
Как очистить содержимое Canvas'а?
Ответ:
Просто нарисуйте прямоугольник любого цвета.
Пример:
Canvas.Brush.Color := ClWhite;
Canvas.FillRect(Canvas.ClipRect);
Наверх к содержанию
Вопрос:
Как программно "щелкнуть" по компоненту 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;
Наверх к содержанию
Вопрос:
Как извлечь 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;
Наверх к содержанию
Вопрос:
Как использовать анимированный курсор?
Ответ:
Во первых необходимо получит 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.
Наверх к содержанию
Вопрос:
Как вывести на элемент управления (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;
Наверх к содержанию
Вопрос:
Как программно определить, что приложение работает под 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" еще раз.
Наверх к содержанию
Вопрос:
Почему при изменении цвета шрифта в 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;
Наверх к содержанию
Вопрос:
События 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;
Наверх к содержанию
Вопрос:
Можно ли рисовать на рамке формы?
Ответ:
Обрабатывайте событие WM_NCPAINT. В примере рамка обводится красной линией
толщиной в 1 пиксел.
Пример:
type
TForm1 = class(TForm)
private
{Private declarations}
procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPAINT;
public
{Public declarations}
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
var
dc : hDc;
Pen : hPen;
OldPen : hPen;
OldBrush : hBrush;
begin
inherited;
dc := GetWindowDC(Handle);
msg.Result := 1;
Pen := CreatePen(PS_SOLID, 1, RGB(255, 0, 0));
OldPen := SelectObject(dc, Pen);
OldBrush := SelectObject(dc, GetStockObject(NULL_BRUSH));
Rectangle(dc, 0,0, Form1.Width, Form1.Height);
SelectObject(dc, OldBrush);
SelectObject(dc, OldPen);
DeleteObject(Pen);
ReleaseDC(Handle, Canvas.Handle);
end;
Наверх к содержанию
Вопрос:
Как выполнить какой-то процесс тогда, когда пользователь не работает с моим приложением?
Ответ:
Создайте процедуру, которая будет вызываться при событии Application.OnIdle.
Обьявим процедуру:
{Private declarations}
procedure IdleEventHandler(Sender: TObject; var Done: Boolean);
В разделе implementation опишем поцедуру:
procedure TForm1.IdleEventHandler(Sender: TObject; var Done: Boolean);
begin
{Do a small bit of work here}
Done := false;
end;
В методе Form'ы OnCreate - укажем что наша процедура вызывается на событии
Application.OnIdle.
Application.OnIdle := IdleEventHandler;
Событие OnIdle возникает один раз - когда приложение переходит в режим
"безделья" (idle). Если в обработчике переменной Done присвоить False событие
будет вызываться вновь и вновь, до тех пор пока приложение "бездельничает"
и переменной Done не присвоенно значение True.
Наверх к содержанию
Вопрос:
При перемещении фокуса ввода клавишей Tab чтобы переместить его в RadioGroup
нужно нажать клавишу Tab дважды если какой нибудь пункт RadioGroup уже
выбран, но только один раз если не выбран. Можно ли сделать поведение RadioGroup
логичным?
Ответ:
Установка свойства RadioGroup'ы TabStop в false должна решить эту проблему
- поскольку клавиша tab будет продолжать работать - перемещаясь сразу на
выделенный пункт RadioGroup.
Наверх к содержанию
Вопрос:
Как разместить маленькие картинки в компоненте TPopUpMenu?
Ответ:
В приведенном примере показано как это сделать с использованием функции
Windows API SetMenuItemBitmaps(). Эта функция получает handle popup menu,
позицию строчки меню куда будет помещена картинка, и два дескриптора(handles)
на две картинки (одна из них - картинка которая будет показана когда строка
меню доступна, вторая - когда строка меню недоступна).
type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
Pop11: TMenuItem;
Pop21: TMenuItem;
Pop31: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{Private declarations}
bmUnChecked : TBitmap;
bmChecked : TBitmap;
public
{Public declarations}
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
bmUnChecked := TBitmap.Create;
bmUnChecked.LoadFromFile('C:\Program Files\Borland\BitBtns\ALARMRNG.BMP');
bmChecked := TBitmap.Create;
bmChecked.LoadFromFile('C:\Program Files\Borland\BitBtns\CHECK.BMP');
{Add the bitmaps to the item at index 1 in PopUpMenu}
SetMenuItemBitmaps(PopUpMenu1.Handle,1,MF_BYPOSITION,BmUnChecked.Handle,
BmChecked.Handle);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
bmUnChecked.Free;
bmChecked.Free;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
pt : TPoint;
begin
pt := ClientToScreen(Point(x, y));
PopUpMenu1.Popup(pt.x, pt.y);
end;
Наверх к содержанию
Вопрос:
Как изменить число фиксированных колонок в TDbGrid?
Пример:
procedure TForm1.Button1Click(Sender: TObject);
begin
TStringGrid(DbGrid1).FixedCols := 2;
end;
Наверх к содержанию
Вопрос:
Некоторые компоненты баз данных (и среди них TDBGrid) никак не меняют визуальных
свойств, когда к ним отключен доступ (disabled). Как это изменить програмно?
Ответ:
Ниже приведен пример, меняющий цвет шрифта на clGray, когда доступ к элементу
управления (в данном случае TDBGrid) запрещен (disabled).
procedure TForm1.Button1Click(Sender: TObject);
begin
DbGrid1.Enabled := false;
DbGrid1.Font.Color := clGray;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
DbGrid1.Enabled := true;
DbGrid1.Font.Color := clBlack;
end;
Наверх к содержанию
Вопрос:
Как определить нажаты ли клавиши Shift, Alt, or Ctrl в какой-либо момент времени?
Ответ:
В приведенном примере показано как определить нажата ли клавиша Shift при
выборе строчки меню. Пример также содержит функции проверки состояния клавиш
Alt, Ctrl.
Пример:
function CtrlDown : Boolean;
var
State : TKeyboardState;
begin
GetKeyboardState(State);
Result := ((State[vk_Control] And 128) <> 0);
end;
function ShiftDown : Boolean;
var
State : TKeyboardState;
begin
GetKeyboardState(State);
Result := ((State[vk_Shift] and 128) <> 0);
end;
function AltDown : Boolean;
var
State : TKeyboardState;
begin
GetKeyboardState(State);
Result := ((State[vk_Menu] and 128) <> 0);
end;
procedure TForm1.MenuItem12Click(Sender: TObject);
begin
if ShiftDown then
Form1.Caption := 'Shift'
else
Form1.Caption := '';
end;
Наверх к содержанию
Вопрос:
Как изменить шрифта hint'а?
Ответ:
В примере перехватывается событие Application.OnShowHint и изменяется шрифт Hint'а.
Пример:
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{Private declarations}
public
procedure MyShowHint(var HintStr: string;
var CanShow: Boolean;var HintInfo: THintInfo);
{Public declarations}
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.MyShowHint(var HintStr: string; var CanShow: Boolean;
var HintInfo: THintInfo);
var
i : integer;
begin
for i := 0 to Application.ComponentCount - 1 do
if Application.Components[i] is THintWindow then
with THintWindow(Application.Components[i]).Canvas do
begin
Font.Name:= 'Arial';
Font.Size:= 18;
Font.Style:= [fsBold];
HintInfo.HintColor:= clWhite;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnShowHint := MyShowHint;
end;
Наверх к содержанию
Вопрос:
Я загружаю TImageList динамически. Как сделать картинки из TImageList прозрачными?
Ответ:
См. ответ.
Пример:
procedure TForm1.Button1Click(Sender: TObject);
var
bm : TBitmap;
il : TImageList;
begin
bm := TBitmap.Create;
bm.LoadFromFile('C:\DownLoad\TEST.BMP');
il := TImageList.CreateSize(bm.Width,bm.Height);
il.DrawingStyle := dsTransparent;
il.Masked := true;
il.AddMasked(bm, clRed);
il.Draw(Form1.Canvas, 0, 0, 0);
bm.Free;
il.Free;
end;
Наверх к содержанию
Вопрос:
При выполнении диалога FontDialog со свойством Device равным fdBoth or
fdPrinter, появляется ошибка "There are no fonts installed".
Ответ:
Эти установки должны показать шрифты совместимые либо с принтером либо
с экраном. В примере диалог Windows ChooseFont вызывается напрямую чтобы
показать список шрифтов, совместимых одновременно и с экраном и с принтером.
Пример:
uses Printers, CommDlg;
procedure TForm1.Button1Click(Sender: TObject);
var
cf : TChooseFont;
lf : TLogFont;
tf : TFont;
begin
if PrintDialog1.Execute then
begin
GetObject(Form1.Canvas.Font.Handle, sizeof(lf),@lf);
FillChar(cf, sizeof(cf), #0);
cf.lStructSize := sizeof(cf);
cf.hWndOwner := Form1.Handle;
cf.hdc := Printer.Handle;
cf.lpLogFont := @lf;
cf.iPointSize := Form1.Canvas.Font.Size * 10;
cf.Flags := CF_BOTH or CF_INITTOLOGFONTSTRUCT or
CF_EFFECTS or CF_SCALABLEONLY or CF_WYSIWYG;
cf.rgbColors := Form1.Canvas.Font.Color;
if ChooseFont(cf) <> false then
begin
tf := TFont.Create;
tf.Handle := CreateFontIndirect(lf);
tf.COlor := cf.RgbColors;
Form1.Canvas.Font.Assign(tf);
tf.Free;
Form1.Canvas.TextOut(10, 10, 'Test');
end;
end;
end;
Наверх к содержанию
Вопрос:
Как убрать кнопку с названием моей программы из Панели Задач(Taskbar)?
Ответ:
Отредактируйте файл-проекта (View -> Project Source) Добавьте модуль Windows
в раздел uses. Application.ShowMainForm := False; в строку после "Application.Initialize;".
Добавьте ShowWindow(Application.Handle, SW_HIDE); в строку перед "Application.Run;"
Ваш файл проекта должен выглядеть приблизительно так:
program Project1;
uses
Windows,
Forms,
Unit1 in 'Unit1.pas' {Form1},
Unit2 in 'Unit2.pas' {Form2};
{$R *.RES}
begin
Application.Initialize;
Application.ShowMainForm := False;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TForm2, Form2);
ShowWindow(Application.Handle, SW_HIDE);
Application.Run;
end.
В разделе "initialization" (в самом низу) каждого unit'а добавьте
begin
ShowWindow(Application.Handle, SW_HIDE);
end.
Наверх к содержанию
Вопрос:
Как преобразовать цвета в строку - название цвета VCL?
Ответ:
Модуль graphics.pas содержит функцию ColorToString() которое преобразует
допустимое значение TColor в его строковое представление используя либо
константу-название цвета (по возможности) либо шестнадцатиричную строку.
Обратная функция - StringToColor()
Пример:
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Lines.Add(ColorToString(clRed));
Memo1.Lines.Add(IntToStr(StringToColor('clRed')));
end;
Наверх к содержанию
Вопрос:
При показе максимизированное формы она перекрывает task bar и не выравнивается
по верху экрана. В чем тут дело?
Ответ:
Это может произойти когда свойство position формы установленно в poScreenCenter.
Установите position = poDefault.
Наверх к содержанию
Вопрос:
Как заставить TEdit не 'пикать' при нажатии недопустимых клавиш?
Ответ:
Перехватите событие KeyPress и установите key = #0 для недопустимых клавиш.
Пример:
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if ((UpCase(Key) < 'A') or (UpCase(Key) > 'Z')) then
Key := #0;
end;
Наверх к содержанию
Вопрос:
Как получить число и список всех компонентов, расположенных на TNoteBook?
Ответ:
В примере список выводится на Listbox.
Пример:
procedure TForm1.Button1Click(Sender: TObject);
var
n: integer;
p: integer;
begin
ListBox1.Clear;
with Notebook1 do
begin
for n := 0 to ControlCount - 1 do
begin
with TPage(Controls[n]) do
begin
ListBox1.Items.Add('Notebook Page: ' +
TPage(Notebook1.Controls[n]).Caption);
for p := 0 to ControlCount - 1 do
ListBox1.Items.Add(Controls[p].Name);
ListBox1.Items.Add(EmptyStr);
end;
end;
end;
end;
Наверх к содержанию
Вопрос:
Я хочу вставить escape code в строку при использовании функции Format().
Например, я хочу создать строку, содержащую символ табуляции. В "C" я бы
написал что-то вроде sprintf(buffer, "%s\t%s", str);. А как это будет на
Pascal'e?
Ответ:
Функция Format Pascal'я не использует escape codes. Вместо этого нужно
вставить в строку действительное значение символа в кодировке ASCII.
Пример:
Buffer := Format('%s'#9'%s', [Str1, Str2]);
ShowMessage(Format('%s'#9'%s', ['Column1', 'Column2']));
Наверх к содержанию
Вопрос:
Когда пользователь щелкает по listview, он переходит в режим редактирования.
Как перевисти его в редим редактирования по нажатию клавиши (например F2)?
Ответ:
Перехватите F2 на событии keydown.
Пример:
procedure TForm1.ListView1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Ord(Key) = VK_F2 then
ListView1.Selected.EditCaption;
end;
Наверх к содержанию
Вопрос:
Когда я добавляю обьект в список TStrings как мне его потом уничтожить?
Ответ:
Просто вызовите метод free этого обьекта.
Пример:
procedure TForm1.FormCreate(Sender: TObject);
var
Icon: TIcon;
begin
Icon := TIcon.Create;
Icon.LoadFromFile('C:\Program Files\BorlandImages\CONSTRUC.ICO');
ListBox1.Items.AddObject('Item 0', Icon);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ListBox1.Items.Objects[0].Free;
end;
Наверх к содержанию
Вопрос:
Вместо печати графики я хочу использовать резидентный шрифт принтера. Как?
Ответ:
Используте функцию Windows API - GetStockObject() чтобы получить дескриптор
(handle) шрифта по умолчанию устройства (DEVICE_DEFAULT_FONT) и передайте
его Printer.Font.Handle.
Пример:
uses Printers;
procedure TForm1.Button1Click(Sender: TObject);
var
tm : TTextMetric;
i : integer;
begin
if PrintDialog1.Execute then
begin
Printer.BeginDoc;
Printer.Canvas.Font.Handle := GetStockObject(DEVICE_DEFAULT_FONT);
GetTextMetrics(Printer.Canvas.Handle, tm);
for i := 1 to 10 do
begin
Printer.Canvas.TextOut(100,i * tm.tmHeight +
tm.tmExternalLeading,'Test');
end;
Printer.EndDoc;
end;
end;
Наверх к содержанию
Вопрос:
Как получить строку сообщения об ошибке Windows код которой получен функцией
GetLastError?
Ответ:
Функция RTL SysErrorMessage(GetLastError).
Пример:
procedure TForm1.Button1Click(Sender: TObject);
begin
{Cause a Windows system error message to be logged}
ShowMessage(IntToStr(lStrLen(nil)));
ShowMessage(SysErrorMessage(GetLastError));
end;
Наверх к содержанию
Вопрос:
Как заставить Delphi выполнять еще более строгую проверка типов? Напрмер
- я создаю пользовательский тип, унаследованный от double и могу передавать
его любым функциям, принимающим параметр типа double. Как заставить компилятор
проводить более строгую проверку типов и выдавать предупреждение в таких
случаях?
Ответ:
См. ответ.
Пример:
type TStrongType = type Double;
type TWeakType = Double;
procedure AddWeakType(var d : TWeakType);
begin
d := d + 1;
end;
procedure AddStrongType(var d : TStrongType);
begin
d := d + 1;
end;
procedure AddDoubleType(var d : Double);
begin
d := d + 1;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
d : Double;
s : TStrongType;
w : TWeakType;
begin
AddDoubleType(d); {compiles fine}
AddDoubleType(w); {compiles fine}
AddDoubleType(s); {<- compile error}
AddDoubleType(double(s)); {compiles fine}
AddWeakType(d); {compiles fine}
AddWeakType(w); {compiles fine}
AddWeakType(s); {<- compile error}
AddWeakType(TWeakType(s)); {compiles fine}
AddStrongType(d); {<- compile error}
AddStrongType(TStrongType(d)); {compiles fine}
AddStrongType(w); {<- compile error}
AddStrongType(TStrongType(w)); {compiles fine}
AddStrongType(s); {compiles fine}
end;
Наверх к содержанию
Вопрос:
Где в Delphi обьявленны VK_Key для A-Z и 0-9?
Ответ:
Они не обьявлены в Delphi поскольку они просто могуть быть заменены буквами.
VK_0 до VK_9 то же что и ASCII '0' до '9' ($30 - $39),
VK_A до VK_Z то же что и ASCII 'A' до 'Z' ($41 - $5A).
Наверх к содержанию
Вопрос:
Как изменить оконную процедуру для TForm?
Ответ:
Переопределите в подклассе TForm оконную процедуру WinProc класса. В примере
оконная процедура переопределяется для того чтобы реагировать на сообщение
WM_CANCELMODE, показывающее, что выполняется messagebox или какой-либо
еще диалог.
Пример:
type
TForm1 = class(TForm)
Button1: TButton;
procedure WndProc (var Message: TMessage); override;
procedure Button1Click(Sender: TObject);
private
{Private declarations}
public
{Public declarations}
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WndProc (var Message: TMessage);
begin
if Message.Msg = WM_CANCELMODE then
begin
Form1.Caption := 'A dialog or message box has popped up';
end
else
inherited // <- остальное сделает родительская процедура
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage('Test Message');
end;
Наверх к содержанию
Вопрос:
Как узнать размеры TComboBox с показанным выпадающим списком до показа списка?
Ответ:
На событии FormShow пошлите сообщение CB_SHOWDROPDOWN в ComboBox дважды
- один раз чтобы заставить список выпасть, второй - чтобы убрать его. Затем
пошлите сообщение CB_GETDROPPEDCONTROLRECT, передав в качестве параметра
адрес TRect. TRect будет содержать экранные кординаты прямоугольника описывающего
ComboBox вместе с выпавшим списком. Затем Вы можете вызвать ScreenToClient
чтобы преобразовать экранные кординаты в координаты клиентской области
окна.
Пример:
var
R : TRect;
procedure TForm1.FormShow(Sender: TObject);
var
T : TPoint;
begin
SendMessage(ComboBox1.Handle, CB_SHOWDROPDOWN, 1, 0);
SendMessage(ComboBox1.Handle, CB_SHOWDROPDOWN, 0, 0);
SendMessage(ComboBox1.Handle, CB_GETDROPPEDCONTROLRECT, 0, LongInt(@r));
t := ScreenToClient(Point(r.Left, r.Top));
r.Left := t.x;
r.Top := t.y;
t := ScreenToClient(Point(r.Right, r.Bottom));
r.Right := t.x;
r.Bottom := t.y;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Form1.Canvas.Rectangle(r.Left, r.Top, r.Right, r.Bottom );
end;
Наверх к содержанию
Вопрос:
Я хочу создать в своей программе меню "а ля Дельфи 4". Как это сделать?
Ответ:
1. Разместите на форме TControlBar. (закладка Additional) Установите Align = Client.
2. Разместите TToolBar (закладка Win32) внутри TControlBar.
3. Установите в True свойства Flat и ShowCaptions этого TToolBar.
4. Создайте на TToolBar столько TToolButtons сколько Вам нужно. (щелкнув по TToolBar
правой кнопкой и выбрав NewButton)
5. Установите свойство Grouped = True для всех TToolButtons. Это позволит меню выпадать
при перемещении курсора между главными пунктами меню (если меню уже показано).
6. Разместите на фоме TMainMenu и убедитесь, что оно *НЕ присоденено* как меню главной
формы. (посмотрите свойство Menu формы).
7. Создайте все пункты меню (щелкнув по TMainMenu кнопкой и выбрав Menu Designer)
8. Для каждой TToolButton установите ее MenuItem равным соответсвующему пункту TMainMenu.
Наверх к содержанию
Вопрос:
Как добится того чтобы TMemo и TEdit имели работали не только в режиме вставки символов,
но и в режиме замены?
Ответ:
Элементы управления Windows TEdit и TMemo не имеют режима замены. Однако
этот режим можно эмулировать установив свойство SelLength edit'а или memo
в 1 при обработке события KeyPress. Это заставит его перезаписывать символ
в текущей позиции курсора. В примере этот способ используется для TMemo.
Режим вставка/замена переключается клавишей "Insert".
Пример:
type
TForm1 = class(TForm)
Memo1: TMemo;
procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure Memo1KeyPress(Sender: TObject; var Key: Char);
private
{Private declarations}
InsertOn : bool;
public
{Public declarations}
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if (Key = VK_INSERT) and (Shift = []) then
InsertOn := not InsertOn;
end;
procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
if ((Memo1.SelLength = 0) and (not InsertOn)) then
Memo1.SelLength := 1;
end;
Наверх к содержанию
Вопрос:
Как отправить сообщение сразу всем элементам управления формы?
Ответ:
Можно использовать Screen.Forms[i].BroadCast(msg); где [i] - индекс той
формы, которой Вы хотите переслать сообщение. BroadCast работает со всеми
компонентами, потомками TWinControls и отправляет сообщение всем дочерним
компонентам из массива Controls. Если один из дочерних компонентов обрабатывает
это сообщение и устанавливает Msg.Result в ненулевое значение - дальнейшая
рассылка сообщения останавливается.
Наверх к содержанию
Вопрос:
При попытке присвоить значение свойству "selected" ListBox'а вырабатывается exception
"Index is out of bounds". В чем тут дело и как присвоить значение свойству selected?
Ответ:
Свойство "selected" компонента ТListBox может быть использованно только если свойство
MultiSelect установленно в True. Если Вы работаете с ListBox'ом у которого
MultiSelect=false то используйте свойство ItemIndex.
Пример:
procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.Add('1');
ListBox1.Items.Add('2');
{This will fail on a single selection ListBox}
// ListBox1.Selected[1] := true;
ListBox1.ItemIndex := 1; {This is ok}
end;
Наверх к содержанию
Вопрос:
Как ограничить длинну текста, вводимого в TEdit, так чтобы ширина текста не превышала
ширину TEdit'а?
Ответ:
В примере приведено два способа ограничить длинну текста в TEdit так чтобы
она не превышала ширину клиентской области окна TEdit'а и не появлялась
прокрутка текста. Первый способ устанавливает свойство TEdit'а MaxLength
равным числу букв "W", которые поместятся в TEdit. "W" выбрана потому,
что является, наверное, самой широкой буквой в любом шрифте. Этот метод
сносно работает для шрифтов с фиксированной шириной букв, но для шрифтов
с переменной шириной букв вряд ли сгодится. Второй способ перхватывает
событие KeyPress TEdit'а и измеряет ширину уже введенного текста и ширину
нового символа. Если ширина больше чем клиентская область TEdit'а новый
символ отбрасывается и вызывается MessageBeep.
Пример:
procedure TForm1.FormCreate(Sender: TObject);
var
cRect : TRect;
bm : TBitmap;
s : string;
begin
Windows.GetClientRect(Edit1.Handle, cRect);
bm := TBitmap.Create;
bm.Width := cRect.Right;
bm.Height := cRect.Bottom;
bm.Canvas.Font := Edit1.Font;
s := 'W';
while bm.Canvas.TextWidth(s) < CRect.Right do
s := s + 'W';
if length(s) > 1 then
begin
Delete(s, 1, 1);
Edit1.MaxLength := Length(s);
end;
end;
{Другой вариант}
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
cRect : TRect;
bm : TBitmap;
begin
if ((Ord(Key) <> VK_TAB) and (Ord(Key) <> VK_RETURN) and
(Ord(Key) <> VK_LEFT) and (Ord(Key) <> VK_BACK)) then
begin
Windows.GetClientRect(Edit1.Handle, cRect);
bm := TBitmap.Create;
bm.Width := cRect.Right;
bm.Height := cRect.Bottom;
bm.Canvas.Font := Edit1.Font;
if bm.Canvas.TextWidth(Edit1.Text + Key) > CRect.Right then
begin
Key := #0;
MessageBeep(-1);
end;
bm.Free;
end;
end;
Наверх к содержанию
Вопрос:
Как перемещать компонент мышкой во время работы программы "runtime"?
Ответ:
Перехватить событие OnMouseDown, запомнить x и y координты курсора мыши.
Отслеживать движение мыши по событию OnMouseMove и перемещать компонент
вслед за курсором мыши до тех пор пока не произойдет событие OnMouseUp.
В примере показано перемещение компонента TButton. Перемещение начинается,
когда пользователь "берет" TButton мышью, удерживая нажатой клавишу "Сontrol".
Пример:
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button1MouseUp(Sender: TObject; Button:
TMouseButton; Shift: TShiftState; X, Y: Integer);
private
{Private declarations}
public
{Public declarations}
MouseDownSpot : TPoint;
Capturing : bool;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if ssCtrl in Shift then
begin
SetCapture(Button1.Handle);
Capturing := true;
MouseDownSpot.X := x;
MouseDownSpot.Y := Y;
end;
end;
procedure TForm1.Button1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if Capturing then
begin
Button1.Left := Button1.Left - (MouseDownSpot.x - x);
Button1.Top := Button1.Top - (MouseDownSpot.y - y);
end;
end;
procedure TForm1.Button1MouseUp(Sender: TObject; Button:
TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Capturing then
begin
ReleaseCapture;
Capturing := false;
Button1.Left := Button1.Left - (MouseDownSpot.x - x);
Button1.Top := Button1.Top - (MouseDownSpot.y - y);
end;
end;
Наверх к содержанию
Вопрос:
При попытке создать обьект класса TPrinter (TPrinter.Create) я получаю exception.
Почему?
Ответ:
В создании обьекта класса TPrinter с использованием TPrinter.Create нет необходимости,
так как обьект класса TPrinter (называемый Printer) автоматически создается при
использовании модуля Printers.
Пример:
uses Printers;
procedure TForm1.Button1Click(Sender: TObject);
begin
Printer.BeginDoc;
Printer.Canvas.TextOut(100, 100, 'Hello World!');
Printer.EndDoc;
end;
Наверх к содержанию
Вопрос:
Как перехватить события в неклиентской области формы, в заголовке окна, например?
Ответ:
Создайте обработчик одного из сообщений WM_NC (non client - не клиентских) (посмотрите
WM_NC в Windows API help). Пример показывает как перехватить вижение мыши во всей
неклиенстской области окна (рамка и заголовок).
Пример:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
private
{Private declarations}
procedure WMNCMOUSEMOVE(var Message: TMessage);
message WM_NCMOUSEMOVE;
public
{Public declarations}
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMNCMOUSEMOVE(var Message: TMessage);
var
s : string;
begin
case Message.wParam of
HTERROR:
s:= 'HTERROR';
HTTRANSPARENT:
s:= 'HTTRANSPARENT';
HTNOWHERE:
s:= 'HTNOWHERE';
HTCLIENT:
s:= 'HTCLIENT';
HTCAPTION:
s:= 'HTCAPTION';
HTSYSMENU:
s:= 'HTSYSMENU';
HTSIZE:
s:= 'HTSIZE';
HTMENU:
s:= 'HTMENU';
HTHSCROLL:
s:= 'HTHSCROLL';
HTVSCROLL:
s:= 'HTVSCROLL';
HTMINBUTTON:
s:= 'HTMINBUTTON';
HTMAXBUTTON:
s:= 'HTMAXBUTTON';
HTLEFT:
s:= 'HTLEFT';
HTRIGHT:
s:= 'HTRIGHT';
HTTOP:
s := 'HTTOP';
HTTOPLEFT:
s:= 'HTTOPLEFT';
HTTOPRIGHT:
s:= 'HTTOPRIGHT';
HTBOTTOM:
s:= 'HTBOTTOM';
HTBOTTOMLEFT:
s:= 'HTBOTTOMLEFT';
HTBOTTOMRIGHT:
s:= 'HTBOTTOMRIGHT';
HTBORDER:
s:= 'HTBORDER';
HTOBJECT:
s:= 'HTOBJECT';
HTCLOSE:
s:= 'HTCLOSE';
HTHELP:
s:= 'HTHELP';
else s:= '';
end;
Form1.Caption := s;
Message.Result := 0;
end;
end.
Наверх к содержанию
Вопрос:
При попытке использовать метод TCanvas.StretchDraw чтобы нарисовать иконку
увеличенной ее размер не изменяется. Что делать?
Ответ:
Иконки всегда рисуются размером принятым в системе по умолчанию. Чтобы показать
увеличенный вид иконки скоприуйте ее на bitmap, а зате используйте метод
TCanvas.StretchDraw.
Пример:
procedure TForm1.Button1Click(Sender: TObject);
var
TheBitmap : TBitmap;
begin
TheBitmap := TBitmap.Create;
TheBitmap.Width := Application.Icon.Width;
TheBitmap.Height := Application.Icon.Height;
TheBitmap.Canvas.Draw(0, 0, Application.Icon);
Form1.Canvas.StretchDraw(Rect(0,0,TheBitmap.Width * 3,TheBitmap.Height * 3),
TheBitmap);
TheBitmap.Free;
end;
Наверх к содержанию
Вопрос:
Можно ли сделать так чтобы TStringGrid автоматически изменял ширину колонок, чтобы
вместить самую длинную строчку в колонке?
Ответ:
См. пример.
Пример:
procedure AutoSizeGridColumn(Grid : TStringGrid; column : integer);
var
i : integer;
temp : integer;
max : integer;
begin
max := 0;
for i := 0 to (Grid.RowCount - 1) do
begin
temp := Grid.Canvas.TextWidth(grid.cells[column, i]);
if temp > max then max := temp;
end;
Grid.ColWidths[column] := Max + Grid.GridLineWidth + 3;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
AutoSizeGridColumn(StringGrid1, 1);
end;
Наверх к содержанию
Вопрос:
TTimer работает не достаточно точно. Как получить более высокую точность?
Ответ:
Таймер Windows не был создан с целью получения сверхточного хронометра.
:-( Другими словами, когда Вы устанавливаете таймер на срабатывания каждые
1000 миллисекунд, он может срабатывать через интервал несколько больший
чем 1000 миллисекунд. Значения меньше 55 миллисекунд никогда не будут срабатывать
вовремя в Windows, поскольку это минимальная точность таймера. Можно проверять
системное время и сравнивать его со временем предыдущего события таймера
чтобы повысить точность.
Наверх к содержанию
Вопрос:
Как поместить JPEG-картинку в exe-файл и потом загрузить ее?
Ответ:
1) Создайте текстовый файл с расширением ".rc". Имя этого файла должно отличаться
от имени файла-пректа или любого модуля проекта.
Файл должен содержать строку вроде: MYJPEG JPEG C:\DownLoad\MY.JPG
где:
"MYJPEG" имя ресурса
"JPEG" пользовательский тип ресурса
"C:\DownLoad\MY.JPG" руть к JPEG файлу.
Пусть например rc-файл называется "foo.rc"
Запустите BRCC32.exe (Borland Resource CommandLine Compiler) - программа находится
в каталоге Bin Delphi/C++ Builder'а - передав ей в качестве параметра полный путь
к rc-файлу.
В нашем примере:
C:\DelphiPath\BIN\BRCC32.EXE C:\ProjectPath\FOO.RC
Вы получите откомпилированный ресурс - файл с расширением ".res".
(в нашем случает foo.res).
Далее добавте ресурс к своему приложению.
{Грузим ресурс}
{$R FOO.RES}
uses Jpeg;
procedure LoadJPEGFromRes(TheJPEG : string; ThePicture : TPicture);
var
ResHandle : THandle;
MemHandle : THandle;
MemStream : TMemoryStream;
ResPtr : PByte;
ResSize : Longint;
JPEGImage : TJPEGImage;
begin
ResHandle := FindResource(hInstance, PChar(TheJPEG), 'JPEG');
MemHandle := LoadResource(hInstance, ResHandle);
ResPtr := LockResource(MemHandle);
MemStream := TMemoryStream.Create;
JPEGImage := TJPEGImage.Create;
ResSize := SizeOfResource(hInstance, ResHandle);
MemStream.SetSize(ResSize);
MemStream.Write(ResPtr^, ResSize);
FreeResource(MemHandle);
MemStream.Seek(0, 0);
JPEGImage.LoadFromStream(MemStream);
ThePicture.Assign(JPEGImage);
JPEGImage.Free;
MemStream.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
LoadJPEGFromRes('MYJPEG', Image1.Picture);
end;
Наверх к содержанию
Вопрос:
Как перехватить сообщения прокрутки в TScrollBox?
Ответ:
Следующий пример перехватывает сообщения о прокрутке компонента TScrollBox и
синхронизирует обе линейки прокрутки. Сообщения прокрутки перехватываются с помощью
переопределения окнной процедуры (WinProc) ScrollBox'а.
Пример:
type
{$IFDEF WIN32}
WParameter = LongInt;
{$ELSE}
WParameter = Word;
{$ENDIF}
LParameter = LongInt;
{Declare a variable to hold the window procedure we are replacing}
var
OldWindowProc : Pointer;
function NewWindowProc(WindowHandle : hWnd;
TheMessage : WParameter;
ParamW : WParameter;
ParamL : LParameter) : LongInt
{$IFDEF WIN32} stdcall; {$ELSE} ; export; {$ENDIF}
var
TheRangeMin : integer;
TheRangeMax : integer;
TheRange : integer;
begin
if TheMessage = WM_VSCROLL then
begin
{Get the min and max range of the horizontal scroll box}
GetScrollRange(WindowHandle, SB_HORZ, TheRangeMin, TheRangeMax);
{Get the vertical scroll box position}
TheRange := GetScrollPos(WindowHandle, SB_VERT);
{Make sure we wont exceed the range}
if TheRange < TheRangeMin then
TheRange := TheRangeMin else
if TheRange > TheRangeMax then
TheRange := TheRangeMax;
{Set the horizontal scroll bar}
SetScrollPos(WindowHandle, SB_HORZ, TheRange, true);
end;
if TheMessage = WM_HSCROLL then
begin
{Get the min and max range of the horizontal scroll box}
GetScrollRange(WindowHandle, SB_VERT, heRangeMin, TheRangeMax);
{Get the horizontal scroll box position}
TheRange := GetScrollPos(WindowHandle, SB_HORZ);
{Make sure we wont exceed the range}
if TheRange < TheRangeMin then
TheRange := TheRangeMin
else
if TheRange > TheRangeMax then
TheRange := TheRangeMax;
{Set the vertical scroll bar}
SetScrollPos(WindowHandle, SB_VERT, TheRange, true);
end;
{Call the old Window procedure to allow processing of the message.}
NewWindowProc := CallWindowProc(OldWindowProc, WindowHandle, TheMessage,
ParamW, ParamL);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
{Set the new window procedure for the control and remember
the old window procedure.}
OldWindowProc := Pointer(SetWindowLong(ScrollBox1.Handle, GWL_WNDPROC,
LongInt(@NewWindowProc)));
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
{Set the window procedure back to the old window procedure.}
SetWindowLong(ScrollBox1.Handle, GWL_WNDPROC, LongInt(OldWindowProc));
end;
Наверх к содержанию
Вопрос:
Как сделать прямоугольник для выделения части картинки для редактирования?
Ответ:
Самый простой способ - воспользоваться функцией Windows API DrawFocusRect.
Функция DrawFocusRect использует операцию XOR при рисовании - таким образом
вывод прямоугольника дважды с одними и теми же координатами стирает прямоугольник,
и прямоугольник всегда будет виден, на фоне какого бы цвета он не выводился.
Пример:
type
TForm1 = class(TForm)
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{Private declarations}
Capturing : bool;
Captured : bool;
StartPlace : TPoint;
EndPlace : TPoint;
public
{Public declarations}
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function MakeRect(Pt1 : TPoint; Pt2 : TPoint) : TRect;
begin
if pt1.x < pt2.x then
begin
Result.Left := pt1.x;
Result.Right := pt2.x;
end
else
begin
Result.Left := pt2.x;
Result.Right := pt1.x;
end;
if pt1.y < pt2.y then
begin
Result.Top := pt1.y;
Result.Bottom := pt2.y;
end
else
begin
Result.Top := pt2.y;
Result.Bottom := pt1.y;
end;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Captured then
DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));
StartPlace.x := X;
StartPlace.y := Y;
EndPlace.x := X;
EndPlace.y := Y;
DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));
Capturing := true;
Captured := true;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Capturing then
begin
DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));
EndPlace.x := X;
EndPlace.y := Y;
DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Capturing := false;
end;
Наверх к содержанию
Вопрос:
Можно ли использовать иконку как картинку на кнопке TSpeedButton?
Ответ:
Можно. См. пример.
Пример:
uses ShellApi;
procedure TForm1.FormShow(Sender: TObject);
var
Icon: TIcon;
begin
Icon := TIcon.Create;
Icon.Handle := ExtractIcon(0,'C:\WINDOWS\NOTEPAD.EXE',1);
SpeedButton1.Glyph.Width := Icon.Width;
SpeedButton1.Glyph.Height := Icon.Height;
SpeedButton1.Glyph.Canvas.Draw(0, 0, Icon);
Icon.Free;
end;
Наверх к содержанию
Вопрос:
Как поместить прозрачную фоновую каринку на компонент CoolBar?
Ответ:
procedure TForm1.Button1Click(Sender: TObject);
var
Bm1 : TBitmap;
Bm2 : TBitmap;
begin
Bm1 := TBitmap.Create;
Bm2 := TBitmap.Create;
Bm1.LoadFromFile('c:\download\test.bmp');
Bm2.Width := Bm1.Width;
Bm2.Height := Bm1.Height;
bm2.Canvas.Brush.Color := CoolBar1.Color;
bm2.Canvas.BrushCopy(Rect(0, 0, bm2.Width, bm2.Height), Bm1,
Rect(0, 0, Bm1.width, Bm1.Height), ClWhite);
bm1.Free;
CoolBar1.Bitmap.Assign(bm2);
bm2.Free;
end;
Наверх к содержанию
Вопрос:
Ползунок компонента TScrollBar все время мигает. Как это отключить?
Ответ:
Установите свойтсво ScrollBar.TabStop в False.
Наверх к содержанию
Вопрос:
Как программно перевести DBgrid в реим редактирования и установить курсор в
окошке редактирования в требуемую позицию?
Ответ:
Переведите таблицу в режим редактирования, затем получите дескриптор (handle)
окна редактирования и перешлите ей сообщение EM_SETSEL. В качестве параметров
вы должны переслать начальную позицию курсора, и конечную позицию, определяющую
конец выделения текста цветом. В приведенном примере курсор помещается
во вторую позицию, текст внутри ячейки не выделяется.
Пример:
procedure TForm1.Button1Click(Sender: TObject);
var
h : THandle;
begin
Application.ProcessMessages;
DbGrid1.SetFocus;
DbGrid1.EditorMode := true;
Application.ProcessMessages;
h:= Windows.GetFocus;
SendMessage(h, EM_SETSEL, 2, 2);
end;
Наверх к содержанию
Вопрос:
Как поместить курсор в определенную позицию edit'а и подобных ему элементов
управления?
Ответ:
Можно использовать методы Delphi SelStart() и SelectLength().
Пример:
procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.SetFocus;
{переводим курсор во
вторую позицию}
Edit1.SelStart := 2;
{не выделяем никакого
текста}
Edit1.SelLength := 0;
end;
Наверх к содержанию
Вопрос:
Как среагировать на минимизацию-максимизацию формы перед тем как произойдет
изменение
размера формы?
Ответ:
В примере перехватывается сообщение WM_SYSCOMMAND.
Если это сообщение говорит о
минимизации или максимизации формы - пищит
динамик.
Пример:
type
TForm1 = class(TForm)
private
{Private declarations}
procedure WMSysCommand(var Msg: TWMSysCommand);
message WM_SYSCOMMAND;
public
{Public declarations}
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMSysCommand;
begin
if (Msg.CmdType = SC_MINIMIZE) or (Msg.CmdType
= SC_MAXIMIZE) then
MessageBeep(0)
else
inherited;
end;
Наверх к содержанию
Вопрос:
Можно ли сделать так - одна форма показывает другую и остается позади
нее, но фокус
ввода не переходит к новой форме, а остается у старой?
Ответ:
В примере показывается не автосоздаваемая (non
auto-created) форма, но фокус ввода ей
не передается.
Пример:
uses Unit2;
procedure TForm1.Button1Click(Sender: TObject);
begin
Form2 := TForm2.Create(Application);
Form2.Visible := FALSE;
ShowWindow(Form2.Handle, SW_SHOWNA);
end;
Наверх к содержанию
Вопрос:
На некоторых laptop компьютерах может не быть флоппи дисковода. Можно
ли удалять
из списка TDriveComboBox диски которые отключены?
Ответ:
В примере TDriveComboBox не показывает дисководы,
которые не готовы. (not ready).
Учтите что на многих компьютерах будет ощутимая
задержка при поверке plug&play
флоппи дисковода.
Пример:
procedure TForm1.FormCreate(Sender: TObject);
var
i : integer;
OldErrorMode : Word;
OldDirectory : string;
begin
OldErrorMode :=
SetErrorMode(SEM_NOOPENFILEERRORBOX);
GetDir(0, OldDirectory);
i := 0;
while i <= DriveComboBox1.Items.Count - 1 do
begin
{$I-}
ChDir(DriveComboBox1.Items[i][1] + ':\');
{$I+}
if IoResult <> 0 then
DriveComboBox1.Items.Delete(i)
else
inc(i);
end;
ChDir(OldDirectory);
SetErrorMode(OldErrorMode);
end;
Наверх к содержанию
Вопрос:
Как сообщить всем формам моего приложения (в том числе и не видимым
в данный момент)
об изминении каких-то глобальных значений?
Ответ:
Один из способов - создать пользовательское
сообщение и использовать метод preform
чтобы разослать его всем формам из массива
Screen.Forms.
Пример:
{Code for Unit1}
const
UM_MyGlobalMessage = WM_USER + 1;
type
TForm1 = class(TForm)
Label1: TLabel;
Button1: TButton;
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{Private declarations}
procedure UMMyGlobalMessage(var AMessage:
TMessage); message
UM_MyGlobalMessage;
public
{Public declarations}
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses Unit2;
procedure TForm1.FormShow(Sender: TObject);
begin
Form2.Show;
end;
procedure TForm1.UMMyGlobalMessage(var AMessage: TMessage);
begin
Label1.Left := AMessage.WParam;
Label1.Top := AMessage.LParam;
Form1.Caption := 'Got It!';
end;
procedure TForm1.Button1Click(Sender: TObject);
var
f: integer;
begin
for f := 0 to Screen.FormCount - 1 do
Screen.Forms[f].Perform(UM_MyGlobalMessage, 42,
42);
end;
{Code for Unit2}
const
UM_MyGlobalMessage = WM_USER + 1;
type
TForm2 = class(TForm)
Label1: TLabel;
private
{Private declarations}
procedure UMMyGlobalMessage(var AMessage:
TMessage);
message UM_MyGlobalMessage;
public
{Public declarations}
end;
var
Form2: TForm2;
implementation
{$R *.DFM}
procedure TForm2.UMMyGlobalMessage(var AMessage: TMessage);
begin
Label1.Left := AMessage.WParam;
Label1.Top := AMessage.LParam;
Form2.Caption := 'Got It!';
end;
Наверх к содержанию
Как обновить список дисков компонента
TDriveComboBox, учитывая, что могут быть
подключены/отключены сетевые диски и произведена "горячая
замена" plug&play дисков?
Совет взят с диска "All4Delphi" 14.10.2001
Следующий пример вызывает защищенный (protected)
метод класса TDriveComboBox
BuildList() для регеирации списка дисков. (использовая
так наз. "class cracer")
Пример:
type
TNewDriveComboBox = class(TDriveComboBox)
//это наш "class cracer"
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Drive : char;
begin
Drive := DriveComboBox1.Drive;
TNewDriveComboBox(DriveComboBox1).BuildList;
//вызываем защищенный
метод родительского класса
DriveComboBox1.Drive := Drive;
end;
Наверх к содержанию
Как программно заставить
выпасть меню?
Совет взят с диска "All4Delphi" 15.10.2001
В примере показано как показать меню и выбрать в
нем какой-то пункт, эмулируя нажатие "быстрой
кдавиши" пункта меню. Если у Вашего пункта меню
нет "быстрой клавиши" Вы можете посылать
комбинации VK_MENU, VK_LEFT, VK_DOWN, и VK_RETURN, чтобы
программно "путешествовать" по меню.
Пример:
procedure TForm1.Button1Click(Sender: TObject);
begin
//Allow button to finish painting in response
to the click
Application.ProcessMessages;
{Alt Key Down}
keybd_Event(VK_MENU, 0, 0, 0);
{F Key Down - Drops the menu down}
keybd_Event(ord('F'), 0, 0, 0);
{F Key Up}
keybd_Event(ord('F'), 0, KEYEVENTF_KEYUP, 0);
{Alt Key Up}
keybd_Event(VK_MENU, 0, KEYEVENTF_KEYUP, 0);
{F Key Down}
keybd_Event(ord('S'), 0, 0, 0);
{F Key Up}
keybd_Event(ord('S'), 0, KEYEVENTF_KEYUP, 0);
end;
Как сделать клавишу-акселератор (keyboard shortcut)
компонету у которого нет заголовка?
Добавлено 15.10.2001
Возможный вариант - присвоить ссылку на этот
компонент свойству FocusControl TLabel'а. В примере
используется невидимый Label для создания
"быстрой" клавиши (Alt+M) компонента Memo. Чтобы
использовать пример, разместите на форме
компонет TMemo, Label и несколько других компонентов,
которые могут принимать фокус ввода. Запустите
программу, перевидите фокус ввода куда-нибудь
вне Memo и нажмите Alt+M - фокус ввода вернется в Memo.
Пример:
procedure TForm1.FormCreate(Sender: TObject);
begin
Label1.Visible := false;
Label1.Caption := '&M';
Label1.FocusControl := Memo1;
end;
Можно ли как-то уменьшить мерцание при перерисовке
компонента?
Добавлено 18.10.2001
Если добавить флаг csOpaque (непрозрачный) к свойству
ControlStyle компонента
- то фон компонента перерисовываться не будет.
Пример:
constructor TMyControl.Create;
begin
inherited;
ControlStyle := ControlStyle + [csOpaque];
end;
Как запретить изменение размера моего компонента
в design-time?
Добавлено 18.10.2001
Поместите в конструктор компонента код,
устанавливающий размеры по умолчанию.
Переопределите метод SetBounds и проверяйте в нем
"componentstate". Если компонет
находится режиме "design-time" (csDesigning in ComponentState)
просто передавайте
значения ширины и высоты (width и heights) компонента по
умолчанию (в нашем
примере 50) методу класса-предка.
Пример:
procedure TVu.SetBounds(ALeft : integer; ATop : integer; AWidth : integer;
AHeight : integer);
begin
if csdesigning in componentstate then
begin
AWidth := 50;
AHeight := 50;
inherited; //вызываем
унаследованный от предка метод
end;
end;
Можно ли уменьшить потребляемые компонентами
TNotebook и TTabbedNotebook ресурсы?
Добавлено 20.10.2001
Да. Можно уничтожать обьекты, расположенные не
на текущей странице TNotebook или
TTabbedNotebook. В примере вызывается защищенный (Protected)
метод путем создания
так называемый "class cracer'ов".
type TMyTabbedNotebook = class(TTabbedNotebook); //это наш "class
cracer"
type TMyNotebook = class(TNotebook);
procedure TForm1.TabbedNotebook1Change(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
begin
with TabbedNotebook1 do
//вызываем защищенный метод родительского класса
TMyTabbedNotebook(TWinControl(Pages.Objects[PageIndex])).DestroyHandle;
end;
procedure TForm1.TabSet1Change(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
begin
with Notebook1 do //вызываем
защищенный метод родительского класса
TMyNotebook(TWinControl(Pages.Objects[PageIndex])).DestroyHandle;
NoteBook1.PageIndex := NewTab;
AllowChange := true
end;
Наверх к содержанию
TSelectableTree - TTreeView с возможностью MultiSelect'а
Добавлено 20.10.2001
TSelectableTree - наследник от TCustomTreeView, обладает
возможностью множественного выбора ( свойство MultiSelect ).
Соответственно дополнительные методы -
procedure SelectAll;
procedure UnSelectAll;
procedure InvertSelection;
Свойство DefaultPopup = True назначает для дерева PopUp-меню (по
правой кнопке мыши) со следующими пунктами:
Отметить все
Снять все пометки
Инверсия выделения
И еще всякие полезные мелочи. Например, очень удобная процедура для обработки
каждой ветки дерева:
procedure TraverseTree(TreeView: TCustomTreeView; Node: TTreeNode;
ATraverseTreeEvent : TTVTraverseEvent; AInfo : Pointer);
var
CNode: TTreeNode;
begin
if Assigned(ATraverseTreeEvent) then begin
if Node = nil
then CNode := TTreeView(TreeView).Items.GetFirstNode
else CNode := Node;
repeat
ATraverseTreeEvent(CNode, AInfo);
CNode := CNode.GetNext;
until (CNode = nil) or (not CNode.HasAsParent(Node));
end;
end;
TSelectableTree - наследник от TCustomTreeView,
обладает возможностью множественного выбора (
свойство MultiSelect ).
Соответственно дополнительные методы -
procedure SelectAll;
procedure UnSelectAll;
procedure InvertSelection;
Свойство DefaultPopup = True назначает для дерева PopUp-меню (по
правой кнопке мыши) со следующими пунктами:
Отметить все
Снять все пометки
Инверсия выделения
И еще всякие полезные мелочи. Например, очень удобная процедура для обработки
каждой ветки дерева:
procedure TraverseTree(TreeView: TCustomTreeView; Node: TTreeNode;
ATraverseTreeEvent : TTVTraverseEvent; AInfo : Pointer);
var
CNode: TTreeNode;
begin
if Assigned(ATraverseTreeEvent) then begin
if Node = nil
then CNode := TTreeView(TreeView).Items.GetFirstNode
else CNode := Node;
repeat
ATraverseTreeEvent(CNode, AInfo);
CNode := CNode.GetNext;
until (CNode = nil) or (not CNode.HasAsParent(Node));
end;
end;
Так же как в случае с TMemo, здесь можно
использовать сообщения. Например, сообщение
может быть отослано в момент создания формы:
procedure TForm1.FormCreate(Sender: TObject);
begin
ListBox1.Perform(LB_SETHORIZONTALEXTENT, 1000, Longint(0));
end;
Второй параметр в вызове - ширина прокрутки в точках.
Поиск строки в ListBox
Добавлено 27.10.2001
Есть функция API Windows, что заставляет искать строку в ListBox
с указанной позиции.
Например, поиск строки, что начинается на '1.' От текущей позиции курсора
в ListBox. Т.о., нажимая на кнопку Button1, будут перебраны все строки
начинающиеся на '1.'
procedure TForm1.Button1Click(Sender: TObject);
var S : string;
begin
S:='1.';
with ListBox1 do
ItemIndex := Perform(LB_SELECTSTRING, ItemIndex, LongInt(S));
end;
Более подробную информацию о работе команды LB_SELECTSTRING можно узнать
из Help-а Win32.
Имеется StringGrid с n-ым количеством строк.
Как вставить еще несколько строк в середину StringGrid или после определенной
строки?
Добавлено 3.11.2001
По-видимому, надо добавить строк в конец, изменив
Grid.RowCount, а потом раздвинуть строки циклом снизу вверх:
Grid.Rows.Strings[i] := Grid.Rows.Strings[i - 1];
Или я бы сделал метод рисования этой таблицы, а
данные хранил бы в отдельном stringList-е, там есть
методы вставки, а вообще-то для этих целей
предпочитаю DrawGrid: переопределяю метод onDrawCell, всё
же объектная модель лучше и данные проще
контролировать.
Как вставить иконку (или
bitmap) в TRichEdit, причем так, чтобы пользователь мог ее
удалить нажатием клавиши Del (как это сделано в
Microsoft Word)?
Добавлено 3.11.2001
Посмотрите компонент RichEdit98 (полностью бесплатный). ftp://ftp.bcsmi.minsk.by/alex/
Прокрутка
Memo (постранично), фокус находится на Edit1.
- Совет взят с диска "All4Delphi" 5.11.2001
- procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift:
TShiftState);
- begin
- if Key = VK_F8 then
- SendMessage(Memo1.Handle, { HWND для Memo }
- WM_VSCROLL, { сообщение Windows }
- SB_PAGEDOWN, {на страницу вниз }
- 0) { не используется }
- else
- if Key = VK_F7 then
- SendMessage(Memo1.Handle, WM_VSCROLL, SB_PAGEUP, 0);
end ;
Как
выполнить UnDo в Memo.
Если определено всплывающее(pop-up) меню для TMemo,и заданы клавиши для
операций Cut,Copy, Paste, то вы можете обрабатывать эти события вызывая
CuttoClipBoard, CopytoClipBoard, и т.д. Однако, если Вы поместили пункт
Undo в меню (обычно Ctrl+Z), то как дать знать TMemo, что нужно выполнить
Undo? Встроенного Undo для этого достаточно:
Memo1.Perform(EM_UNDO, 0, 0);
Для переключения enable/disable опции undo:
Undo1.Enabled := Memo1.Perform(EM_CANUNDO, 0, 0)<> 0;
Весь фокус в сообщении em_LineFromChar. Попробуйте:
procedure TmyForm.BitBtn1Click(Sender:
TObject);
var
- iLine : Integer ;
- begin
- iLine := Memo1.Perform(em_LineFromChar, $FFFF, 0);
- { Внимание: номера строк
начинаются с нуля }
- MessageDlg('Line Number: ' + IntToStr(iLine),
mtInformation, [mbOK], 0 ) ;
end ;
Как
открыть ComboBox программно.
Добавлено 12.11.2001
У ComboBox есть run-time свойство, не упомянутое в On-Line Help - DroppedDown.
Для открытия ComboBox напишите:
ComboBox1.DroppedDown := True;
Естественно, False закроет его.
Переход
на другую страницу TabSet по имени.
Добавлено 12.11.2001
Поместите Tabset(TabSet1) и Edit (Edit1) на форму. Добавьте 4 страницы
в TabSet - свойство Tabs: Hello, World, Of, Delphi. Напишите обработчик
OnChange для Edit:
- procedure Tform1.Edit1Change(Sender: TObject);
- var
- I : Integer;
-
- begin
- for I:= 0 to TabSet1.Tabs.Count - 1 do
- if Edit1.Text = TabSet1.Tabs[I] then
- TabSet1.TabIndex := I;
- end;
Если набрать любое имя в Edit1, фокус установится на соответствующую страницу.
Как
вставить графику в ListBox или ComboBox
Возможность поместить графическое изображение в ListBox и ComboBox может
улучшить внешний вид вашего приложения и сделать пользовательский интерфейс
отличным от других. Ниже приведен пример, как это сделать шаг за шагом
...
- Создать форму.
- Поместить компоненты TComboBox и TListbox на
форму.
- Изменить свойство Style у TComboBox на csOwnerDrawVariable
и lbOwnerDrawVariable для TListBox. Owner-Draw TListBox
или TComboBox позволяют показать и объекты
(например, картинку) и строки одновременно. В
данном примере мы добавляем и графический объект
и строку.
- Создать 5 переменных типа TBitmap в разделе var
модуля для формы.
- Создать обработчики для событий OnCreate, OnDraw,
OnMeasureItem, OnClose.
{START OWNERDRW.PAS}
unit Ownerdrw;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
- type
- Tform1 = class(Tform)
- ComboBox1 : TcomboBox;
- ListBox1 : TListBox;
- procedure FormCreate(Sender : TObject);
- procedure FormClose(Sender : TObject; var Action : TCloseAction);
- procedure ComboBox1DrawItem(Control : TwinControl; Index : Integer; Rect : TRect;
State : TOwnerDrawState);
- procedure ComboBox1MeasureItem(Control : TwinControl; Index : Integer; var
Height : Integer);
- procedure ListBox1DrawItem(Control : TwinControl; Index : Integer; Rect : TRect;
State : TOwnerDrawState);
- procedure ListBox1MeasureItem(Control : TwinControl; Index : Integer; var
Height : Integer);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
- var
- Form1 : TForm1;
- TheBitmap1, TheBitmap2,
- TheBitmap3, TheBitmap4, TheBitmap5 : TBitmap;
- implementation
- {$R *.DFM}
- procedure Tform1.FormCreate(Sender : TObject);
- begin
- TheBitmap1 := TBitmap.Create;
- TheBitmap1.LoadFromFile('C:\delphi\images\buttons\globe.bmp');
- TheBitmap2 := TBitmap.Create;
- TheBitmap2.LoadFromFile('C:\delphi\images\buttons\video.bmp');
- TheBitmap3 := TBitmap.Create;
- TheBitmap3.LoadFromFile('C:\delphi\images\buttons\gears.bmp');
- TheBitmap4 := TBitmap.Create;
- TheBitmap4.LoadFromFile('C:\delphi\images\buttons\key.bmp');
- TheBitmap5 := TBitmap.Create;
- TheBitmap5.LoadFromFile('C:\delphi\images\buttons\tools.bmp');
- ComboBox1.Items.AddObject('Bitmap1 : Globe',
TheBitmap1);
- ComboBox1.Items.AddObject('Bitmap2 : Video',
TheBitmap2);
- ComboBox1.Items.AddObject('Bitmap3 : Gears',
TheBitmap3);
- ComboBox1.Items.AddObject('Bitmap4 : Key',
TheBitmap4);
- ComboBox1.Items.AddObject('Bitmap5 : Tools',
TheBitmap5);
- ListBox1.Items.AddObject('Bitmap1 : Globe',
TheBitmap1);
- ListBox1.Items.AddObject('Bitmap2 : Video',
TheBitmap2);
- ListBox1.Items.AddObject('Bitmap3 : Gears',
TheBitmap3);
- ListBox1.Items.AddObject('Bitmap4 : Key',
TheBitmap4);
- ListBox1.Items.AddObject('Bitmap5 : Tools',
TheBitmap5);
- end;
- procedure TForm1.FormClose(Sender : TObject; var Action : TCloseAction);
- begin
- TheBitmap1.Free;
- TheBitmap2.Free;
- TheBitmap3.Free;
- TheBitmap4.Free;
- TheBitmap5.Free;
- end;
- procedure TForm1.ComboBox1DrawItem(Control : TwinControl; Index : Integer; Rect :
TRect; State : TOwnerDrawState);
- var
- Bitmap : TBitmap;
- Offset : Integer;
- begin
- with (Control as TComboBox).Canvas do
- begin
- FillRect(Rect);
- Bitmap := TBitmap(ComboBox1.Items.Objects[Index]);
- if Bitmap <> nil then
- begin
- BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width, Bitmap.Height), Bitmap,
Bounds(0, 0, Bitmap.Width, Bitmap.Height), clRed);
- Offset := Bitmap.width + 8;
- end;
- { display the text }
- TextOut(Rect.Left + Offset, Rect.Top, Combobox1.Items[Index]);
- end;
- end;
- procedure TForm1.ComboBox1MeasureItem(Control : TWinControl; Index : Integer; var
Height : Integer);
- begin
- Height := 20;
- end;
- procedure TForm1.ListBox1DrawItem(Control : TwinControl; Index : Integer; Rect :
TRect; State : TOwnerDrawState);
- var
- Bitmap : TBitmap;
- Offset : Integer;
- begin
- with (Control as TListBox).Canvas do
- begin
- FillRect(Rect);
- Bitmap := TBitmap(ListBox1.Items.Objects[Index]);
- if Bitmap <> nil then
- begin
- BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width, Bitmap.Height), Bitmap,
Bounds(0, 0, Bitmap.Width, Bitmap.Height), clRed);
- Offset := Bitmap.width + 8;
- end;
- { display the text }
- TextOut(Rect.Left + Offset, Rect.Top, Listbox1.Items[Index]);
- end;
- end;
- procedure TForm1.ListBox1MeasureItem(Control : TwinControl; Index : Integer; var
Height : Integer);
- begin
- Height := 20;
- end;
- end.
- {END OWNERDRW.PAS}
- {START OWNERDRW.DFM}
- object Form1 : TForm1
- Left = 211
- Top = 155
- Width = 435
- Height = 300
- Caption = 'Form1'
- Font.Color = clWindowText
- Font.Height = -13
- Font.Name = 'System'
- Font.Style = []
- PixelsPerInch = 96
- OnClose = FormClose
- OnCreate = FormCreate
- TextHeight = 16
- object ComboBox1: TcomboBox
- Left = 26
- Top = 30
- Width = 165
- Height = 22
- Style = csOwnerDrawVariable
- ItemHeight = 16
- TabOrder = 0
- OnDrawItem = ComboBox1DrawItem
- OnMeasureItem = ComboBox1MeasureItem
- end
- object ListBox1: TlistBox
- Left = 216
- Top = 28
- Width = 151
- Height = 167
- ItemHeight = 16
- Style = lbOwnerDrawVariable
- TabOrder = 1
- OnDrawItem = ListBox1DrawItem
- OnMeasureItem = ListBox1MeasureItem
- end
end
Используются технологии uCozИспользуются технологии uCoz |
