|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
||||
|
||||
Проблема с рекурсией
есть код
Код:
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; Почему так происходит? рассмотрю любые идеи. Код сырец Последний раз редактировалось Lost_Fish, 18.10.2012 в 09:33. |
#2
|
||||
|
||||
Добавь процедуре Chk параметр типа TComponent и вызывай так:
Код:
Chk(Src.Components[x]); Ну и ещё я не знаю что такое _HintCreate - может что-то с ней не так. p.s. Я бы ещё немного упростил бы эту процедурку... |
#3
|
||||
|
||||
Цитата:
_HintCreate создаёт TBaloonHint и выводит его в нужном месте разобрался в HC засунул MessageBox(TControl(Src.Components[x]).Parent.Parent.... и т.д. .Name) посмотрел предков и узнал что в одном стороннем компоненте TDBNumberEditEh создаются 4 спид батона с красным шрифтом которых я не вижу зачем они не понятно)) Код сырец |
#4
|
||||
|
||||
Вот тебе процедурка без всяких задурений с типом объектов.
Код:
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; Грамотно поставленный вопрос содержит не менее 50% ответа. Грамотно поставленная речь вызывает уважение, а у некоторых даже зависть. |
Этот пользователь сказал Спасибо dr. F.I.N. за это полезное сообщение: | ||
Lost_Fish (18.10.2012)
|
#5
|
||||
|
||||
Цитата:
Спасибо за процедурку та же рекурсия просто более универсальная для .font.color, но у меня ещё есть компоненты в которых нужно проверить .TControlEmptyDataInfoEh.Font.Color и свойство Not VarIsNull(.Value) и + ко всему обнаружил невидимые SpeedButton's на текстовом поле ввода которые имеют красный цвет Код сырец Последний раз редактировалось Lost_Fish, 18.10.2012 в 10:23. |
#6
|
||||
|
||||
Вот немного упростил:
Код:
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; |
Этот пользователь сказал Спасибо poli-smen за это полезное сообщение: | ||
Lost_Fish (18.10.2012)
|
#7
|
||||
|
||||
Цитата:
О! клёва спасибо за оптимизацию)) Код сырец |
#8
|
||||
|
||||
А можно вообще весь этот быдлокод выкинуть и чтение/установку свойств расписать через RTTI: GetObjProp и GetOrdProp/SetOrdProp. Получится строчек 10, не больше. Навскидку пример не нашел, а писать лень.
|
#9
|
||||
|
||||
Цитата:
глаза разуй выше код написан, и даже в в варианте с 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; Код сырец Последний раз редактировалось Lost_Fish, 18.10.2012 в 13:11. |
#10
|
||||
|
||||
Цитата:
Цитата:
По делу: Приведенный мною код ищет свойство FONT у самого контрола. Однако могут быть и вложенные CLASS-свойста, к коим относится EmptyDataInfo. Чтобы унифицировать решение достаточно будет к моему коду добавить рекурсию на вложенность свойств и решение будет универсальное. Но если по смыслу задачи достаточно проверить лишь пару классов, то может и не стоит загружать мозг умными "формулами". А вот разобраться в использовании RTTI стоило бы. Вот, кстати, хороший пример по перебору свойств: ТЫЦ Грамотно поставленный вопрос содержит не менее 50% ответа. Грамотно поставленная речь вызывает уважение, а у некоторых даже зависть. |
#11
|
||||
|
||||
Цитата:
да именно так только не мозг загружать умными формулами а код функциями для универсального решения, DRKB у меня есть очень помогает, функции GetObjProp и GetOrdProp/SetOrdProp знаю и использую но не в этом коде, тут универсальное решение не подходит т.к. на форме могут быть компоненты с Font.Color=clRed которые проверять не нужно это к примеру DBGrid'ы или некоторые memo, + опять же эти невидимые кнопки, тут нужен был простой индивидуальный подход с возможностью расширения списка проверок P.S. прошу прощения за наезд погорячился)) Код сырец Последний раз редактировалось Lost_Fish, 18.10.2012 в 12:52. |
#12
|
||||
|
||||
Цитата:
Но хамить по-любому не стоит. Цитата:
|