А вот еще, уже просто выдержки из библиотеки:
интерфейс:
| Код |
////////////////////////////////////////////////////////////////////////////////
//
// Итераторы.
type
tRecursiveOrder = (roNone,roParentChildrens,roChildrensParent);
tForEachProc = procedure (Component :tObject);
procedure ForEachOwned (Component :TComponent;
Proc :tForEachProc;
RecursiveOrder :tRecursiveOrder =roParentChildrens
);
// Вызывают Proc для каждого компонента которым владеет Component.
procedure ForEachChild (WinControl :TWinControl;
Proc :tForEachProc;
RecursiveOrder :tRecursiveOrder =roParentChildrens;
IncludeNonWinControls :Boolean =False
);
// Вызывают Proc для каждого дочернего по отношению к WinControl эл-та управления.
// (Визуальное владение, WinControl.Controls, Parent которых = WinControl)
// Главный "кайф" этих процедур в том, что Proc может быть ЛОКАЛЬНОЙ процедурой.
// Причем, что-бы компилятор не ругался, надо поставить @ перед именем процедуры
// (см.примеры). Однако, ответственность за соответствие числа и типа параметров
// лежит на Вас.
//
// Например получение списка всех компонентов формы:
//
// procedure TForm1.FormCreate(Sender: TObject);
// var i :Integer;
// procedure p(Component :TComponent);
// begin
// ListBox1.Items.Add(Format('%4d: %s :%s',[i,Component.Name,Component.ClassName]))
// Inc(i);
// end;
// begin
// ListBox1.Items.Add('Список компонентов принадлежащих форме')
// i := 0;
// ForEachOwned(Self,@p);
// end;
//
// Или еще - открытие всех наборов данных расположенных на форме, и всех
// расположенных на ней фреймах и "подформах" :
//
// procedure TForm1.FormShow(Sender: TObject);
// procedure OpenDataSet(Component :tComponent);
// begin
// if Component is tDataSet then TDataSet(Component).Open;
// end;
// begin
// ForEachOwned(Self,@OpenDataSet);
// end;
//
////////////////////////////////////////////////////////////////////////////////
|
Реализация "пристегнута"
А вот пример полезного использования:
| Код |
procedure En (Container :TWinControl; Enable :Boolean);
// Устанавливает значение свойства Enabled у Container, а также
// всем компонентам-редакторам лежащим на Container
// будет еще установлен и цвет, clWindow при Enable True и clBtnFace
// при Enable False.
const ca :array [boolean] of tColor = (clBtnFace, clWindow);
procedure SetColor (C :TObject);
begin
if (C is TCustomEdit)
//or (C is TCustomCheckBox)
//or (C is TCustomListBox)
then with tHackControl(C) do begin
Color := ca[Enabled and Enable];
end;
end;
begin
Container.Enabled := Enable;
ForEachChild(Container,@SetColor);
end;
|
И еще:
| Код |
procedure SetReadOnlyAndColorForAllWinControls(const WinControl :tWinControl; const ReadOnlyValue :Boolean; const SetColor :Boolean =True);
// Выполняет SetReadOnlyAndColor(...,ReadOnlyValue) для WinControl и всех его
// дочерних компонентов
procedure p (o :tObject);
begin
if o is tWinControl then SetReadOnlyAndColor(TWinControl(o),ReadOnlyValue,SetColor);
end;
begin
ForEachChild(WinControl,@p,roChildrensParent,False);
SetReadOnlyAndColor(WinControl,ReadOnlyValue,SetColor);
end;
|
Соответственно требуется SetReadOnlyAndColor:
| Код |
type tHackControl = class(tControl);
procedure SetReadOnlyAndColor(WinCtrl :tWinControl; const ReadOnlyValue :Boolean; const SetColor :Boolean =True);
// Если компонент WinCtrl имеет свойство ReadOnly то его значение
// устанавливается в ReadOnlyValue.
// Кроме того, если WinCtrl является потомком от TCustomEdit или TCustomGrid,
// то его цвет изменяется в зависимости от значения ReadOnlyValue:
// False - устанавливается цвет clWindow;
// True - устанавливается цвет на 1/8 темнее clWindow;
begin
SetProperty(WinCtrl,'ReadOnly',ReadOnlyValue);
if not SetColor then Exit;
if (WinCtrl is TCustomEdit ) or (WinCtrl is TCustomGrid) then begin
if ReadOnlyValue then
tHackControl(WinCtrl).Color := MulDivIntensity(clWindow,7,8)
else
tHackControl(WinCtrl).Color := clWindow;
end
else begin
// tHackControl(WinCtrl).Color := clBtnFace;
end;
end;
|
http://forum.vingrad.ru/index.php?act=module&module=vingradfaq&target=download_file&articleid=2241&attachid=1 |