Проблема с рекурсией

Lost_Fish · #1 18.10.2012, 09:15

есть код

Код:

function CheckRed(Src:TComponent;CheckResult:Boolean):Boolean;
var
	x:Integer;
    procedure Chk;
        procedure HC;
        begin //создаём TBaloonHint
            _HintCreate(TControl(Src.Components[x]),'Заполните все поля отмеченые красным','Заголовок');
        end;
    begin
   		if Src.Components[x] is TLabel then
        begin
   	       	Result:=Result and (TLabel(Src.Components[x]).Font.Color<>clRed);
            if TLabel(Src.Components[x]).Font.Color=clRed then HC;
        end else
   		if Src.Components[x] is TStaticText then
        begin
   	       	Result:=Result and (TStaticText(Src.Components[x]).Font.Color<>clRed);
            if TStaticText(Src.Components[x]).Font.Color=clRed then HC;
        end else
      	if Src.Components[x] is TRadioButton then
        begin
   	       	Result:=Result and (TRadioButton(Src.Components[x]).Font.Color<>clRed);
            if TRadioButton(Src.Components[x]).Font.Color=clRed then HC;
        end else
       	if Src.Components[x] is TSpeedButton then
        begin
   	       	Result:=Result and (TSpeedButton(Src.Components[x]).Font.Color<>clRed);
            if TSpeedButton(Src.Components[x]).Font.Color=clRed then HC;
        end else
       	if Src.Components[x] is TDBLookupComboboxEh then
        begin
            if TDBLookupComboboxEh(Src.Components[x]).EmptyDataInfo.Font.Color=clRed then
            begin
       	       	Result:=Result and not VarIsNull(TDBLookupComboboxEh(Src.Components[x]).KeyValue);
                if VarIsNull(TDBLookupComboboxEh(Src.Components[x]).KeyValue) then HC;
            end;
        end else
       	if Src.Components[x] is TDBEditEh then
        begin
            if TDBEditEh(Src.Components[x]).EmptyDataInfo.Font.Color=clRed then
            begin
       	       	Result:=Result and (TDBEditEh(Src.Components[x]).Text<>'');
                if TDBEditEh(Src.Components[x]).Text='' then HC;
            end;
        end else
       	if Src.Components[x] is TDBNumberEditEh then
        begin
            if TDBNumberEditEh(Src.Components[x]).EmptyDataInfo.Font.Color=clRed then
            begin
       	       	Result:=Result and (TDBNumberEditEh(Src.Components[x]).Text<>'');
                if TDBNumberEditEh(Src.Components[x]).Text='' then HC;
            end;
        end;
    end;
begin
   	Result:=CheckResult;
	for x:=0 to Src.ComponentCount-1 do
    begin
        Result:=Result and CheckRed(Src.Components[x],Result);
        Chk;
    end;
end;

Это рекурсия которая проходит по компонентам на форме и если хоть один компонент из нужных не удовлетворяет условию(например красным шрифтом написан) на выходе False, короче проверка на правильность заполнения полей.

передаю в неё MDI Child форму

Проблема в том что иногда эта процедура начинает откровенно глючить, показывает мне на TSpeedButton который находиться на другой форме и визуально не подходит под условие проверки(ну т.е. шрифт на нём чёрный а определяется как красный) притом показывает на кнопку которая находиться совсем на другой главной форме MDI-контейнер и иногда в пошаговом проходе просто теряет контроль над экзешником ну т.е. экзешник висит, F7 не работает компонентов на форме не много около 60 на другой форме где чуть больше компонентов проходит нормально

один раз всё проходит нормально а в следующий начинает глючить

вызов

Код:

function TEditForm.Save:Boolean;
begin
    Result:=True;
    if GetExistChanges then
    begin
        Result:=Result and CheckRed(Self,Result);
        if Assigned(FOnCheckValid) then
            FOnCheckValid(Self,Result);
        if Result then
            DoSave
        else
            Result:=False
    end;
end;

Почему так происходит? рассмотрю любые идеи.

poli-smen · #2 18.10.2012, 09:55

Добавь процедуре Chk параметр типа TComponent и вызывай так:

Код:

Chk(Src.Components[x]);

Ну и соответственно в самой процедуре обращайся к этому параметру вместо Src.Components[x]. И объявление переменной x перемести "от греха поближе" к begin'у в котором организуется цикл с этой переменной.

Ну и ещё я не знаю что такое _HintCreate - может что-то с ней не так.

p.s. Я бы ещё немного упростил бы эту процедурку...

Lost_Fish · #3 18.10.2012, 10:11

Цитата:

Сообщение от poli-smen

Добавь процедуре Chk параметр типа TComponent и вызывай так:

Код:

Chk(Src.Components[x]);

Ну и соответственно в самой процедуре обращайся к этому параметру вместо Src.Components[x]. И объявление переменной x перемести "от греха поближе" к begin'у в котором организуется цикл с этой переменной.

Ну и ещё я не знаю что такое _HintCreate - может что-то с ней не так.

p.s. Я бы ещё немного упростил бы эту процедурку...

_HintCreate создаёт TBaloonHint и выводит его в нужном месте

разобрался в HC засунул
MessageBox(TControl(Src.Components[x]).Parent.Parent.... и т.д. .Name) посмотрел предков и узнал что в одном стороннем компоненте TDBNumberEditEh создаются 4 спид батона с красным шрифтом которых я не вижу зачем они не понятно))

dr. F.I.N. · #4 18.10.2012, 10:12

Вот тебе процедурка без всяких задурений с типом объектов.

Код:

uses
  TypInfo;

function CheckRedFont(ParentControl: TObject; CheckSelf: Boolean = false): Boolean;
var
  i: Integer;
  PropInfo: PPropInfo;
begin
  Result := false;
  if CheckSelf
  then
  begin
    PropInfo := GetPropInfo(ParentControl.ClassInfo, 'Font');
    if PropInfo <> nil
    then Result := Result and  (TFont(GetOrdProp(ParentControl, 'Font')).Color = clRed);
  end;
  if ParentControl is TControl
  then
  for i := 0 to TControl(ParentControl).ComponentCount - 1 do
  begin
    if TControl(ParentControl).Components[i] is TControl
    then Result := CheckRedFont(TControl(ParentControl).Components[i], true)
    else
    begin
      PropInfo := GetPropInfo(TControl(ParentControl).Components[i].ClassInfo, 'Font');
      if PropInfo <> nil
      then Result := Result and (TFont(GetOrdProp(TControl(ParentControl).Components[i], 'Font')).Color = clRed);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if CheckRedFont(form1)
  then
  ShowMessage('red');
end;

Lost_Fish · #5 18.10.2012, 10:20

Цитата:

Сообщение от dr. F.I.N.

Вот тебе процедурка без всяких задурений с типом объектов.

Код:

uses
  TypInfo;

function CheckRedFont(ParentControl: TObject; CheckSelf: Boolean = false): Boolean;
var
  i: Integer;
  PropInfo: PPropInfo;
begin
  Result := false;
  if CheckSelf
  then
  begin
    PropInfo := GetPropInfo(ParentControl.ClassInfo, 'Font');
    if PropInfo <> nil
    then Result := Result and  (TFont(GetOrdProp(ParentControl, 'Font')).Color = clRed);
  end;
  if ParentControl is TControl
  then
  for i := 0 to TControl(ParentControl).ComponentCount - 1 do
  begin
    if TControl(ParentControl).Components[i] is TControl
    then Result := CheckRedFont(TControl(ParentControl).Components[i], true)
    else
    begin
      PropInfo := GetPropInfo(TControl(ParentControl).Components[i].ClassInfo, 'Font');
      if PropInfo <> nil
      then Result := Result and (TFont(GetOrdProp(TControl(ParentControl).Components[i], 'Font')).Color = clRed);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if CheckRedFont(form1)
  then
  ShowMessage('red');
end;

Спасибо за процедурку та же рекурсия просто более универсальная для .font.color, но у меня ещё есть компоненты в которых нужно проверить .TControlEmptyDataInfoEh.Font.Color и свойство Not VarIsNull(.Value)
и + ко всему обнаружил невидимые SpeedButton's на текстовом поле ввода которые имеют красный цвет

poli-smen · #6 18.10.2012, 10:22

Вот немного упростил:

Код:

function CheckRed(Src: TComponent; CheckResult: Boolean): Boolean;

  procedure Chk(Component: TComponent);
  var
    IsValid: Boolean;
  begin
    if Component is TLabel then
    begin
      IsValid := TLabel(Component).Font.Color <> clRed;
    end else
    if Component is TStaticText then
    begin
      IsValid := TStaticText(Component).Font.Color <> clRed;
    end else
    if Component is TRadioButton then
    begin
      IsValid := TRadioButton(Component).Font.Color <> clRed;
    end else
    if Component is TSpeedButton then
    begin
      IsValid := TSpeedButton(Component).Font.Color <> clRed;
    end else
    if Component is TDBLookupComboboxEh then
    begin
      if TDBLookupComboboxEh(Component).EmptyDataInfo.Font.Color = clRed
        then IsValid := not VarIsNull(TDBLookupComboboxEh(Component).KeyValue)
        else Exit;
    end else
    if Component is TDBEditEh then
    begin
      if TDBEditEh(Component).EmptyDataInfo.Font.Color = clRed
        then IsValid := TDBEditEh(Component).Text <> ''
        else Exit;
    end else
    if Component is TDBNumberEditEh then
    begin
      if TDBNumberEditEh(Component).EmptyDataInfo.Font.Color = clRed
        then IsValid := TDBNumberEditEh(Component).Text <> ''
        else Exit;
    end else
    begin
      Exit;
    end;

    Result := Result and IsValid;

    if not IsValid then
    begin //создаём TBaloonHint
      _HintCreate(TControl(Src.Components[x]), 'Заполните все поля отмеченые красным', 'Заголовок');
    end;
  end;

var
  x: Integer;
begin
  Result := CheckResult;
  for x := 0 to Src.ComponentCount - 1 do
  begin
    Result := Result and CheckRed(Src.Components[x], Result);
    Chk(Src.Components[x]);
  end;
end;

Lost_Fish · #7 18.10.2012, 10:28

Цитата:

Сообщение от poli-smen

Вот немного упростил:

О! клёва спасибо за оптимизацию))

Freeman · #8 18.10.2012, 11:30

А можно вообще весь этот быдлокод выкинуть и чтение/установку свойств расписать через RTTI: GetObjProp и GetOrdProp/SetOrdProp. Получится строчек 10, не больше. Навскидку пример не нашел, а писать лень.

Lost_Fish · #9 18.10.2012, 12:17

Цитата:

Сообщение от Freeman

А можно вообще весь этот быдлокод выкинуть и чтение/установку свойств расписать через RTTI: GetObjProp и GetOrdProp/SetOrdProp. Получится строчек 10, не больше. Навскидку пример не нашел, а писать лень.

глаза разуй выше код написан, и даже в в варианте с GetObjProp мне нужно не для всех типов объектов эту проверку делать, так что мой вариант для моих целей мне больше подходит, а ты бы сперва свой вариант привёл прежде чем чужой код опускать

финальный вариант кстати выглядит так:

Код:

function CheckRed(Src:TComponent;CheckResult:Boolean):Boolean;
var x:Integer;
    procedure Chk(Component:TComponent);
    var IsValid:Boolean;
    begin
        IsValid:=True;
   		if Component is TLabel then IsValid:=TLabel(Component).Font.Color<>clRed else
   		if Component is TStaticText then IsValid:=TStaticText(Component).Font.Color<>clRed else
      	if Component is TRadioButton then IsValid:=TRadioButton(Component).Font.Color<>clRed else
       	if Component is TSpeedButton then
        begin
            if TControl(Component).Parent.ClassName<>'TPopupCalculatorEh' then IsValid:=TSpeedButton(Component).Font.Color<>clRed;
        end else
       	if Component is TDBLookupComboboxEh then
        begin
            if TDBLookupComboboxEh(Component).EmptyDataInfo.Font.Color=clRed then IsValid:=not VarIsNull(TDBLookupComboboxEh(Component).KeyValue)
        end else
       	if Component is TDBEditEh then
        begin
            if TDBEditEh(Component).EmptyDataInfo.Font.Color=clRed then IsValid:=TDBEditEh(Component).Text<>'';
        end else
       	if Component is TDBNumberEditEh then if TDBNumberEditEh(Component).EmptyDataInfo.Font.Color=clRed then IsValid:=TDBNumberEditEh(Component).Text<>'';
        Result:=Result and IsValid;
        if not IsValid then _HintCreate(TControl(Component),'Заполните все поля отмеченые красным','заголовок');
    end;
begin
   	Result:=CheckResult;
	for x:=0 to Src.ComponentCount-1 do
    begin
        Result:=Result and CheckRed(Src.Components[x],Result);
        Chk(Src.Components[x]);
    end;
end;

dr. F.I.N. · #10 18.10.2012, 12:28

Цитата:

Сообщение от Freeman

А можно вообще весь этот быдлокод выкинуть и чтение/установку свойств расписать через RTTI: GetObjProp и GetOrdProp/SetOrdProp. Получится строчек 10, не больше. Навскидку пример не нашел, а писать лень.

Цитата:

Сообщение от Lost_Fish

глаза разуй выше код написан

Давайте перестанем хамить друг другу! На этом форуме люди разной квалификации и с разным уровнем знаний. Кто как умеет, тот так и пишет.

По делу:
Приведенный мною код ищет свойство FONT у самого контрола. Однако могут быть и вложенные CLASS-свойста, к коим относится EmptyDataInfo. Чтобы унифицировать решение достаточно будет к моему коду добавить рекурсию на вложенность свойств и решение будет универсальное.

Но если по смыслу задачи достаточно проверить лишь пару классов, то может и не стоит загружать мозг умными "формулами". А вот разобраться в использовании RTTI стоило бы. Вот, кстати, хороший пример по перебору свойств: ТЫЦ

Lost_Fish · #11 18.10.2012, 12:49

Цитата:

Сообщение от dr. F.I.N.

Но если по смыслу задачи достаточно проверить лишь пару классов, то может и не стоит загружать мозг умными "формулами". А вот разобраться в использовании RTTI стоило бы. Вот, кстати, хороший пример по перебору свойств: ТЫЦ

да именно так только не мозг загружать умными формулами а код функциями для универсального решения, DRKB у меня есть очень помогает, функции GetObjProp и GetOrdProp/SetOrdProp знаю и использую но не в этом коде, тут универсальное решение не подходит т.к. на форме могут быть компоненты с Font.Color=clRed которые проверять не нужно это к примеру DBGrid'ы или некоторые memo, + опять же эти невидимые кнопки, тут нужен был простой индивидуальный подход с возможностью расширения списка проверок

P.S. прошу прощения за наезд погорячился))

Freeman · #12 18.10.2012, 16:18

Цитата:

Сообщение от Lost_Fish

глаза разуй выше код написан

Тут что-то не то с якорями: при клике на первое непрочитанное выкидывает куда-то в середину темы, что сразу и не поймешь, где оказался. Или это только у меня так...

Но хамить по-любому не стоит.

Цитата:

Сообщение от Lost_Fish

прошу прощения за наезд погорячился))

Угу, на первый раз простим.

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	RSS лента	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Новости сайта Новости форума	Ссылки и Баннеры Donate О сайте Реклама Контакты

Этот пользователь сказал Спасибо dr. F.I.N. за это полезное сообщение:
Lost_Fish (18.10.2012)

Этот пользователь сказал Спасибо poli-smen за это полезное сообщение:
Lost_Fish (18.10.2012)