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

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

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

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

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

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

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

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