про Align, когда выключена видимость родителей

← →
Galkov © (2006-12-15 23:48) [0]

Вот пример:
Program test; uses windows,kol; type TMainForm=object Control,Check,Panel_1,Panel_2,Button_1,Button_2:PControl; procedure _OnClick(Obj:PObj); end; function TMainForm._OnClick; begin Panel_1.Visible := Check.Checked; end; var MainForm:TMainForm; begin Applet := NewApplet("TestApp"); with MainForm do begin Control := NewForm(Applet,"Test").SetSize(400,300); //CheckBox Check := NewCheckBox(Control,"Show").SetPosition(10,240); Check.OnClick := MainForm._OnClick; //Panel_1 Panel_1 := NewPanel(Control,esLowered).SetPosition(10,10).SetSize(370,180); Panel_1.Visible := false; //Panel_2 Panel_2 := NewPanel(Panel_1,esRaised).SetSize(364,100); Panel_2.Align := caTop; NewSplitterEx(Panel_1,0,0,esRaised); //Button_1 Button_1 := NewButton(Panel_2,"Button_1").SetSize(100,100); Button_1.Align := caLeft; NewSplitterEx(Panel_2,0,0,esRaised); //Button_2 Button_2 := NewButton(Panel_2,"Button_1").SetSize(100,100); Button_2.Align := caClient; end; Run(Applet); end.

Размышляя над ним возникают вопросы:
1) Какие у нас гарантии, что здесь
procedure AlignChildrenProc( Sender: PObj ); type TAligns = set of TControlAlign; var P: PControl; CR: TRect; procedure DoAlign( Allowed: TAligns ); ........... if ChgPos or ChgSiz then begin C.BoundsRect := R; if ChgSiz then AlignChildrenProc( C ); end; ...........
НЕТ необходимости вызывать AlignChildrenProc, если не менялся размер контролла. Вроде бы совершенно не факт, что Ailgn там УЖЕ произведен. Видимость родителей, в момент предыдущих вызовов AlignChildrenProc, вполне могла быть выключена. Как в вышестоящем примере.

2) И чего делать, если возникает необходимость поменять некоторые размеры, в момент невидимости кого-то из родителей ???

← →
Vladimir Kladov (2006-12-16 08:15) [1]

всегда можно вызвать Global_Align( parent ) для проблемного parent"а, когда что-то не так. Например после включения видимости. Этот вызов стоить будет дешевле, чем городить сложные проверки в самом алгоритме выравнивания.

← →
Vladimir Kladov (2006-12-16 09:00) [2]

Выравнивание работает прекрасно, пока объекты, подлежащие выравниванию, видны на экране. Для того, чтобы выравнивание не выполнялось для невидимых управляющих элементов, и для того, чтобы невидимые управляющие элементы не участвовали в выравнивании (что важнее), в процедуре выравнивания проверяется значение свойства ToBeVisible. Почему именно, оно, а не Visible? Дело в том, что видимость контрола трактуется в терминах оконной системы несколько иначе, чем это подразумевает этимология слова Visible. Для нас «видимый» означает, что мы объект видим на экране. Когда форма передвинута так, что выходит за край экрана, то элементы, имеющие значение Visible = true, оказываются на самом деле невидимыми. Если форма заслонена другими окнами, то мы видим не все части этой формы. Но, даже не принимая в расчет эти случаи, можно обнаружить еще несколько ситуаций, в которых Visible = true не соответствует реальному положению дел.

Во-первых, это видимость родительского визуального объекта (т.е. визуального элемента, на котором размещается исследуемый контрол со значением свойства Visible = true). ToBeVisible возвратит true, только если контрол является видимым вместе со всеми своими родительскими окнами.

Во-вторых, есть такой особый визуальный элемент – tab control. В каждый отдельный момент времени фактически видимой является только одна из множества его закладок, хотя все его закладки могут иметь свойство Visible = true. Выполнять выравнивание для фактически невидимых закладок несколько накладно. Достаточно представить себе ситуацию, когда закладок много (например, 50), и на каждой имеется приличное количество объектов, подлежащих выравниванию (например, 20). Выполнять выравнивание для 1000 контролов, когда изменяется размер только одного из них, наверное, будет несколько накладно.

По этой причине, объекты, не являющиеся в данный момент фактически видимыми (ToBeVisible = false), исключаются из процедуры выравнивания – вместе со всеми своими дочерними визуальными объектами. Это может привести к тому, что окна окажутся не выровненными, если вы включите свойство Visible в значение true, предварительно изменив размеры каких-то подчиненных элементов в своей программе. Исправляется это довольно просто: достаточно вызвать функцию Global_Align( p ) для родителя проблемных (не выровненных) элементов, вместе с включением свойства Visible в true.

Данное решение – не идеально, я это признаю. Но оно простое, не требует много кода, не увеличивает ту часть кода, которая встраивается во все приложения, использующие выравнивание. И не надо мне говорить, что в VCL таких проблем нет. Там другие проблемы есть. Например, неожиданное изменение визуального порядка выровненных визуальных элементов после включения Visible в свойство true. Особенно неприятное, когда свое положение на неправильное меняет, например, сплиттер. Там для борьбы с подобным глюком приходится своим кодом менять значения свойств Left/Top проблемных контролов, и это решение ничуть не менее обходное, чем использование Global_Align в KOL.

← →
Galkov © (2006-12-16 09:10) [3]

В момент включения видимости Global_Align(Panel_1) и так вызывается.
И целью примера было показать что это не всегда приводит к цели.

Но мне кажется, что всегда приведет, если рекурсивный вызов AlignChildrenProc из DoAlign вытащить из под условий проверки (обоих).
И мне тоже кажется, что это гораздо проще, чем проверять адекватность этой проверки.

Определять в Run Time "проблемность" парента - тоже ведь точно такой же не подарок. Ну откуда в момент включения видимости Panel_1 можно узнать, что на самом деле следует делать Global_Align(Panel_2) ???
Пример ведь, не конкретная проблема (измени 364 на 363 - и всего делов) - а демонстрация ее существования.
И хочется иметь решение для общего случая...

← →
Vladimir Kladov (2006-12-16 10:15) [4]

А надо - Global_Align( Panel_2 ). Я же говорю, это только в этом конкретном случае, как раз потому что размер менялся в глубоко внутреннем, реально невидимом контроле. Объодить все контролы может быть накладно, если их много - на каждый чих. Например, при движении сплиттера. Все будет тормозить, и кому это понравится.

Нормальный случай: код НЕ меняет размер контролов, когда они реально не видны. Т.е. нормальный случай - это когда размеры контролирует пользователь, меняя позицию сплиттера или размер формы. Ваш случай выпал из нормального. Соответственно, приходится добавлять немного своего кода. Понимаю, что это чуть сложнее, чем просто ничего не делать. Но полный обход - это точно не выход.

← →
Barloggg (2006-12-18 10:49) [5]

ах вот оно почему группбоксы которые на далеких вкладках имеют ширину всего 40 пикселей вместо им положенных 600 с чем-то.

Сейчас я отслеживаю первое появление контроля на экране дабы выровнять в нем своим кодом кое-какие кнопочки выровненные по середине.

то есть я понимаю мне нужно в onCreate принудительно вызывать для этих группбоксов Global_Align(родитель группбокса), верно?

← →
Galkov © (2006-12-18 12:02) [6]

> Этот вызов стоить будет дешевле, чем городить сложные проверки
> в самом алгоритме выравнивания

Беда заключается как раз в том, что у меня общий случай, а не конкретный проект. В котором (как и в стартовом примере) это было бы проще.
Т.е., моя задача - генерация кода по некой информации об алгоритме, полученной от пользователя.
Объяснять моему пользователю технологию определения "проблемного" контролла - задача по сложности сравнимая с общим решением проблемы. Кончится тем, что будет он лепить Global_Align по поводу и без - а это "... еще хуже, чем хорошо лечить"

А пользователь, это такой народ, который сделает все что угодно, и в самых неожиданных местах. Проверено.
Типовой случай - статическая дочерняя форма, созданная при visible=false

Вот причина неудовлетворенности, и продолжения размышлений на этот предмет
Пока только схематично:
1) Общая концепция: производить align только по включению видимости, и производить только необходимые действия - не обсуждается
2) Но из этого логически следует, что при действительном изменении размера какого либо контролла, следует ЗАПОМНИТЬ сей замечательный факт, чтобы воспользоваться этим знанием в момент проведения Global_Align
Причем запоминать надо рекурсивно "вверх" по парентам до первого действительно невидимого.
Т.е., контролл должен иметь дополнительный бит информации (с рабочим названием WaitAlign, к примеру), вроде бы в fChangedPosSz не все еще занято....
3) Кажется, наиболее приемлемым местом для установки флагов WaitAlign является выход из AlignChildrenProc по причине "не видимости" контролла.
Т.е., последовательность действий в AlignChildrenProc могла бы быть такой
3.1) После проверки действительности аргумента, проверить "видимость" (рабочее название ToBeAlign) рекурсивно вверх, с установкой флагов WaitAlign при необходимости.
3.2) Если ToBeAlign возвращает false, значит, установлены флаги WaitAlign для всей цепочки нужной длины вверх, и - выход.
Если true, значит, флаги не тронуты, и производим DoAlign-ы для нашего контролла, сбросивши предварительно ему его флаг WaitAlign
3.3) При этом, конечно, вариант caNone тоже надо отработать
4) Про DoAlign
4.1) Наверное, нет смысла уже рекурсивного просмотра вверх (ToBeVisible) - этот случай отсекается проверкой ToBeAlign в AlignChildrenProc
4.2) В условие проверки необходимости рекурсивного вызова AlignChildrenProc должно входить значение флага WaitAlign (который возможен и для случая caNone) по логике ИЛИ
5) Делать ли ToBeAlign отдельной ф-ей, или совместить ее с ToBeVisible - на это моей эрудиции пока не хватает

Вот и все собственно.
Мне показалось, что особого "беспредела" в кодах не должно случиться.
И интересно мнение Автора о данном соотношении цены и качества
Если договориться о локализации флага WaitAlign, то можно эти мысли превратить в конкретные коды.
Одним из вариантов может быть добавка AlignChildrenProcEx, и метода SetAlignEx (названия условные, конечно).

← →
Vladimir Kladov (2006-12-18 16:22) [7]

конкретные изменения в коде давайте, посмотрим, что плучается. А то что-то сложно.

← →
Galkov © (2006-12-19 14:15) [8]

Мда...
По поводу "не делать лишнего": чем дальше в лес, тем толще партизаны... :(((
У нас сегодня, оказывается, на каждый resize выполняются рекурсивно, ничем не заблокированные, ДВА Global_Align-а (в ответ на C.BoundsRect := R;)

У меня получилось примерно так (нулевое приближение, естественно):

function ToBeAlign( S: PControl ):boolean; begin Result := S.fVisible or S.fCreateHidden; //???? if Result and(not S.isForm)and(S.fParent<>nil)and(not ToBeAlign(S.fParent)) then Result := false; if not Result then S.WaitAlign := true; end; //* //[procedure AlignChildrenProc] procedure AlignChildrenProc( Sender: PObj ); type TAligns = set of TControlAlign; var P: PControl; CR: TRect; T:procedure( Sender: PObj ); procedure DoAlign( Allowed: TAligns ); var I: Integer; C: PControl; R, R1: TRect; W, H: Integer; ChgPos, ChgSiz: Boolean; begin for I := 0 to P.fChildren.fCount - 1 do begin C := P.fChildren.fItems[ I ]; if not (C.fVisible or C.fCreateHidden) then continue; //???? // important: not fVisible, and even not Visible, but ToBeVisible! if C.fNotUseAlign then continue; if C.FAlign in Allowed then begin R := C.BoundsRect; R1 := R; W := R.Right - R.Left; H := R.Bottom - R.Top; case C.FAlign of caTop: begin OffsetRect( R, 0, -R.Top + CR.Top + P.Margin ); Inc( CR.Top, H + P.Margin ); R.Left := CR.Left + P.Margin; R.Right := CR.Right - P.Margin; end; caBottom: begin OffsetRect( R, 0, -R.Bottom + CR.Bottom - P.Margin ); Dec( CR.Bottom, H + P.Margin ); R.Left := CR.Left + P.Margin; R.Right := CR.Right - P.Margin; end; caLeft: begin OffsetRect( R, -R.Left + CR.Left + P.Margin, 0 ); Inc( CR.Left, W + P.Margin ); R.Top := CR.Top + P.Margin; R.Bottom := CR.Bottom - P.Margin; end; caRight: begin OffsetRect( R, -R.Right + CR.Right - P.Margin, 0 ); Dec( CR.Right, W + P.Margin ); R.Top := CR.Top + P.Margin; R.Bottom := CR.Bottom - P.Margin; end; caClient: begin R := CR; InflateRect( R, -P.Margin, -P.Margin ); end; end; if R.Right < R.Left then R.Right := R.Left; if R.Bottom < R.Top then R.Bottom := R.Top; ChgPos := (R.Left <> R1.Left) or (R.Top <> R1.Top); ChgSiz := (R.Right - R.Left <> W) or (R.Bottom - R.Top <> H); if ChgPos or ChgSiz then C.BoundsRect := R; if ChgSiz or C.WaitAlign then AlignChildrenProc( C ); end; end; end; begin P := Pointer( Sender ); if P = nil then Exit; // Called for form - ignore. if not ToBeAlign(P) then exit; P.WaitAlign := false; T := Global_Align; Global_Align := DummyObjProc; CR := P.ClientRect; DoAlign( [ caTop, caBottom ] ); DoAlign( [ caLeft, caRight ] ); DoAlign( [ caClient,caNone ] ); Global_Align := T; end;

Тестирования почти никакого, но стартовый пример топика - работает...

← →
Galkov © (2006-12-19 14:19) [9]

Да, WaitAlign просто пока добавил в TControl, как boolean
..... fCreateVisible, fCreateHidden,WaitAlign: Boolean; .....

← →
Vladimir Kladov (2006-12-19 18:19) [10]

Я то и говорил. Попробуем вставить, старый вариант оставим в IFDEFах, народ попробует, будет самое хорошее тестирование. Все равно все случаи выдумать из головы трудно.

← →
Galkov © (2006-12-19 18:30) [11]

> Попробуем вставить

Владимир, в аспекте этих кодов, теряют смысл (можно было бы "глубже" достать) комбинации типа:

if not fIsForm then Global_Align( fParent ); Global_Align( @Self );

Эффективнее было бы что-то типа такого:

P:=@Self; if not fIsForm then P:=fParent; Global_Align(P);

Впрочем, разумно было бы ВСЕ аналогичные комбинации "перетянуть" в Global_Align .....

← →
Galkov © (2006-12-20 23:51) [12]

Похоже я опять туманно выразился... Ксли не сказать - не точно.

Имел ввиду под "перетаскиванием" такое:
//* //[procedure AlignChildrenProc] procedure AlignChildrenProc_(P:PControl); type TAligns = set of TControlAlign; var CR: TRect; procedure DoAlign(Allowed:TAligns); var I, W, H: Integer; C: PControl; R, R1: TRect; ChgPos, ChgSiz: Boolean; begin for I := 0 to P.fChildren.fCount - 1 do begin C := P.fChildren.fItems[ I ]; with C{-}^{+} do begin if (not(fVisible or fCreateHidden))//???? fVisibleWoParent? or fNotUseAlign or(not(fAlign in Allowed)) then continue; R := BoundsRect; R1 := R; W := R.Right - R.Left; H := R.Bottom - R.Top; case FAlign of caTop: begin OffsetRect( R, 0, -R.Top + CR.Top + P.Margin ); Inc( CR.Top, H + P.Margin ); R.Left := CR.Left + P.Margin; R.Right := CR.Right - P.Margin; end; caBottom: begin OffsetRect( R, 0, -R.Bottom + CR.Bottom - P.Margin ); Dec( CR.Bottom, H + P.Margin ); R.Left := CR.Left + P.Margin; R.Right := CR.Right - P.Margin; end; caLeft: begin OffsetRect( R, -R.Left + CR.Left + P.Margin, 0 ); Inc( CR.Left, W + P.Margin ); R.Top := CR.Top + P.Margin; R.Bottom := CR.Bottom - P.Margin; end; caRight: begin OffsetRect( R, -R.Right + CR.Right - P.Margin, 0 ); Dec( CR.Right, W + P.Margin ); R.Top := CR.Top + P.Margin; R.Bottom := CR.Bottom - P.Margin; end; caClient: begin R := CR; InflateRect( R, -P.Margin, -P.Margin ); end; end; if R.Right < R.Left then R.Right := R.Left; if R.Bottom < R.Top then R.Bottom := R.Top; ChgPos := (R.Left <> R1.Left) or (R.Top <> R1.Top); ChgSiz := (R.Right - R.Left <> W) or (R.Bottom - R.Top <> H); if ChgPos or ChgSiz then BoundsRect := R; if ChgSiz or WaitAlign then AlignChildrenProc_(C); end; end; end; begin P.WaitAlign := false; CR := P.ClientRect; DoAlign( [ caTop, caBottom ] ); DoAlign( [ caLeft, caRight ] ); DoAlign( [ caClient,caNone ] ); end; procedure AlignChildrenProc( P: PObj ); function ToBeAlign( S: PControl ):boolean; begin with S{-}^{+} do begin Result := (fVisible or fCreateHidden) //???? fVisibleWoParent? and(isForm or(fParent=nil)or ToBeAlign(fParent)); if not Result then WaitAlign := true; end; end; begin if P = nil then Exit; {$ifdef ALIGN_FROM_PARENT} if (not PControl(P).isForm)and(PControl(P).fParent<>nil) then begin PControl(P).WaitAlign := true; P := PControl(P).fParent; end; {$endif} if not ToBeAlign(PControl(P)) then exit; Global_Align := DummyObjProc; AlignChildrenProc_(PControl(P)); Global_Align := AlignChildrenProc; end;

И тогда можно было бы делать так:
function TControl.WndProc( var Msg: TMsg ): Integer; .............. WM_SIZE: begin Default; fWindowState := TWindowState( Msg.wParam ); {$ifndef ALIGN_FROM_PARENT} if not fIsForm then Global_Align( fParent ); {$endif} Global_Align( @Self ); Exit; end;

или аналогично в Set_Visible
procedure TControl.Set_Visible( Value: Boolean ); var CmdShow: DWORD; begin if Value then begin fStyle := fStyle or WS_VISIBLE; CmdShow := SW_SHOW; end else begin fStyle := fStyle and not WS_VISIBLE; CmdShow := SW_HIDE; end; fVisible := Value; if fHandle = 0 then Exit; ShowWindow( fHandle, CmdShow ); if not Value and (fHandle <> 0) then fCreateHidden := FALSE; // { +++ } {$ifndef ALIGN_FROM_PARENT} if fParent <> nil then Global_Align( fParent ); {$endif} if Value then Global_Align( @Self ); end;

И еще есть аналогичные места в кодах...

Собственно, это просто уточнения по распространению принципа "не делать лишнего": в кодах дастаточно вызывать один раз Global_Align вместо двух (если при align-е парента self.waitalign=true), и при рекурсивном вызове из DoAlign нет необходимости делать рекурсивные проверки ToBeAlign.

А вот с фишкой Page.fVisibleWoParent=true так и не разобрался...
В смысле, не понятно, чего достигается, по сравнению с обыкновенным случаем fNotUseAlign=fVisibleWoParent=false, когда разреры страниц устанавливаются штатным Global_Align, а не аттачем WndProcTabControl

Если не затруднит, просвятите пожалуйста....

← →
Galkov © (2006-12-21 00:01) [13]

Прошу прощения за опечатки - наклейки на клаве менять пора :(((
(("Ксли" следует читать как "Если", "дастаточно" - как "достаточно", а "разреры" - как "размеры"))

← →
Vladimir Kladov (2006-12-21 16:32) [14]

это как раз чтобы на закладках tab_control"а работало.

← →
Galkov © (2006-12-21 17:25) [15]

Про то, что fVisibleWoParent только в TControl.TC_Insert устанавливается - это понятно...
Не понятно, чем "эмуляция" align лучше простого :(
Ну был бы разрешен align - в одном Global_Align установились бы все размеры страниц, в ответ на resize таба - и все. А сейчас в цикле
function WndProcTabControl( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; .............. WM_SIZE: begin GetClientRect( Self_.fHandle, R ); Self_.Perform( TCM_ADJUSTRECT, 0, Integer( @R ) ); for I := 0 to Self_.Count - 1 do begin Page := Self_.Pages[ I ]; Page.BoundsRect := R; //здесь! end; end; end; Result := False; end;
Каждое изменение страницы сопровождается Global_Align, который тоже шелестит ВСЕМИ страницами. Как ни крути, а зависимость квадратичная от количества страниц...

Аналогично и для TCN_SELCHANGE - каждый Visible, это Global_Align, который опять же "прошелестит" по всему списку.
Тут непонятно, почему вообще цикл делается, а не: один выключил, другой включил.
А если без цикла не обойтись, то может отключить его напрочь во время цикла... Ну типа такого:
T := Global_Align; Global_Align := DummyObjProc; { творим цикл } Global_Align := T; Global_Align(@Self);
Этот объем вычислений таки линейно зависит от кол-ва страниц, а не квадратично....

Теоретически понятно, что "премудрости" с fVisibleWoParent вводились не просто так, и эффект проверялся экспериментально.
А вот понять этого никак не получается...
Будем надеяться - пока...

← →
Vladimir Kladov (2006-12-21 18:11) [16]

чего непонятного. Не работло иначе. Кстати, полное тестирование новых изменеий: надо обязательно проверять под старыми ОС, например Win98 и даже Win95+IE3installed (без installed-то смысла проверять нет, там вообще comctl32.dll кривой).

← →
Galkov © (2006-12-23 10:01) [17]

Понимание немного улучшилось (и вскрылись некоторые неточности).
При проведении Global_Align при получении клиентской части, нам СИЛЬНО не хватает Perform( TCM_ADJUSTRECT, 0, Integer( @R ) ) для TabControl-а.
И с идеями для его простого получения - как-то не очень. Не строковое значение класса сравнивать.... Все же не очень хорошо, что align-ом мы занимаемся в двух разных местах - в AlignChildrenProc, и "эмулируем" его для tab-ов...
В общем, адаптировал стартовый пример для очень большого числа tab-ов, надо же посмотреть где и почему возникают тормоза...
Вот он:

Program test; uses windows,kol; const HIGH_PAGES=1000; type TMainForm=object Control,Check,Tabs,Panel_2,Button_1,Button_2:PControl; procedure _OnClick(Obj:PObj); end; function TMainForm._OnClick; begin Tabs.Visible := Check.Checked; end; var MainForm:TMainForm;i:integer;P1,P2,B1,B2:PControl; begin Applet := NewApplet("TestApp"); with MainForm do begin Control := NewForm(Applet,"Test").SetSize(400,300); //CheckBox Check := NewCheckBox(Control,"Show").SetPosition(10,240); Check.OnClick := MainForm._OnClick; Tabs := NewTabControl(Control,[],[],nil,0).SetPosition(10,10).SetSize(370,180); Tabs.Align := caTop; Tabs.Visible := false; NewSplitterEx(Control,0,0,esRaised); for i:=0 to HIGH_PAGES do begin //Panel_1 P1 := Tabs.TC_Insert(i,"Page_"+ int2str(i),0); //Panel_2 P2 := NewPanel(P1,esRaised).SetSize(364,30+Random(100)); P2.Align := caTop; NewSplitterEx(P1,0,0,esRaised); //Button_1 B1 := NewButton(P2,"Button_"+int2str(2*i)).SetSize(80+Random(200),100); B1.Align := caLeft; NewSplitterEx(P2,0,0,esRaised); //Button_2 B2 := NewButton(P2,"Button_"+int2str(2*i+1)).SetSize(100,100); B2.Align := caClient; end; end; Run(Applet); end.

И сразу же вскрылась неточность при обработке fNotUseAlign в моих кодах - в этом случае, оказывается, надо тоже тестировать WaitAlign
Вот фикс

//* //[procedure AlignChildrenProc] procedure AlignChildrenProc_(P:PControl); type TAligns = set of TControlAlign; var CR: TRect; procedure DoAlign(Allowed:TAligns); var I, W, H: Integer; C: PControl; R, R1: TRect; ChgPos, ChgSiz: Boolean; begin for I := 0 to P.fChildren.fCount - 1 do begin C := P.fChildren.fItems[ I ]; with C{-}^{+} do begin if (not(fVisible or fCreateHidden))//???? fVisibleWoParent? or(not(fAlign in Allowed)) then continue; if not fNotUseAlign then begin R := BoundsRect; R1 := R; W := R.Right - R.Left; H := R.Bottom - R.Top; case FAlign of caTop: begin OffsetRect( R, 0, -R.Top + CR.Top + P.Margin ); Inc( CR.Top, H + P.Margin ); R.Left := CR.Left + P.Margin; R.Right := CR.Right - P.Margin; end; caBottom: begin OffsetRect( R, 0, -R.Bottom + CR.Bottom - P.Margin ); Dec( CR.Bottom, H + P.Margin ); R.Left := CR.Left + P.Margin; R.Right := CR.Right - P.Margin; end; caLeft: begin OffsetRect( R, -R.Left + CR.Left + P.Margin, 0 ); Inc( CR.Left, W + P.Margin ); R.Top := CR.Top + P.Margin; R.Bottom := CR.Bottom - P.Margin; end; caRight: begin OffsetRect( R, -R.Right + CR.Right - P.Margin, 0 ); Dec( CR.Right, W + P.Margin ); R.Top := CR.Top + P.Margin; R.Bottom := CR.Bottom - P.Margin; end; caClient: begin R := CR; InflateRect( R, -P.Margin, -P.Margin ); end; end; if R.Right < R.Left then R.Right := R.Left; if R.Bottom < R.Top then R.Bottom := R.Top; ChgPos := (R.Left <> R1.Left) or (R.Top <> R1.Top); ChgSiz := (R.Right - R.Left <> W) or (R.Bottom - R.Top <> H); if ChgPos or ChgSiz then BoundsRect := R; if ChgSiz then WaitAlign := true; end; if WaitAlign then AlignChildrenProc_(C); end; end; end; begin P.WaitAlign := false; CR := P.ClientRect; DoAlign( [ caTop, caBottom ] ); DoAlign( [ caLeft, caRight ] ); DoAlign( [ caClient,caNone ] ); end; procedure AlignChildrenProc( P: PObj ); function ToBeAlign( S: PControl ):boolean; begin with S{-}^{+} do begin Result := (fVisible or fCreateHidden) //???? fVisibleWoParent? and(isForm or(fParent=nil)or ToBeAlign(fParent)); if not Result then WaitAlign := true; end; end; begin if P = nil then Exit; {$ifdef ALIGN_FROM_PARENT} if (not PControl(P).isForm)and(PControl(P).fParent<>nil) then begin PControl(P).WaitAlign := true; P := PControl(P).fParent; end; {$endif} if not ToBeAlign(PControl(P)) then exit; Global_Align := DummyObjProc; AlignChildrenProc_(PControl(P)); Global_Align := AlignChildrenProc; end;

Следующая неточность, связанная как раз с "эмуляцией" align в WndProcTabControl: при изменении размеров страницы их надо снабжать флагом WaitAlign. Скажем так:

function WndProcTabControl( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; ......... WM_SIZE: begin GetClientRect( Self_.fHandle, R ); Self_.Perform( TCM_ADJUSTRECT, 0, Integer( @R ) ); for I := 0 to Self_.Count - 1 do begin Page := Self_.Pages[ I ]; Page.WaitAlign := true; //Здесь!!! Page.BoundsRect := R; end; end;

И аналогично для ASM-версии:

@@loo2: DEC ESI JS @@e_loo2 MOV EDX, ESI MOV EAX, EBX CALL TControl.GetPages MOV byte ptr [EAX].TControl.WaitAlign,1 //Здесь!!! MOV EDX, ESP CALL TControl.SetBoundsRect JMP @@loo2 @@e_loo2:

((btw: отчего бы не синхронизировать версии? хотя бы как for I := Self_.Count - 1 downto 0 do))

Наблюдения таковы:
1) Тормоза, конечно, есть, но они поменьше таки (2-3 раза вроде) чем сегодня в оригинале
2) Тормоза на resize разные для формы и для tab-а. Связано это с тем, что при изменении формы дальнейшим изменением размеров руководит AlignChildrenProc, подставивши вместо Global_Align "пустышку".
С одной стороны - серьезный выигрыш в производительности, а с другой - приходится "патчить" WndProcTabControl (одной командой, как показано выше).

И жутко не хочется отказываться от установки "пустышки" - придется разбираться с жуткими рекурсиями, да и стек не резиновый, думается...

Вот такие вот пироги с котятами .........

← →
Galkov © (2006-12-24 13:57) [18]

Если сделать так:

function WndProcTabControl( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var Hdr: PNMHdr; A: Integer; R: TRect; Form: PControl; WasActive: Boolean; begin case Msg.message of WM_NOTIFY: begin Hdr := Pointer( Msg.lParam ); case Hdr.code of TCN_SELCHANGE: begin A := Self_.Perform( TCM_GETCURSEL, 0, 0 ); WasActive := Self_.fCurIndex = A; if not WasActive then Self_.Pages[Self_.fCurIndex].Visible := false; Self_.fCurIndex := A; Self_.Pages[Self_.fCurIndex].Visible := true; Self_.Pages[Self_.fCurIndex].BringToFront; Form := Self_.ParentForm; if Form <> nil then begin if Form.fCurrentControl <> nil then begin Self_.Focused := True; Self_.Invalidate; if not Longbool( Self_.fStyle and TCS_FOCUSONBUTTONDOWN ) then Self_.GotoControl( VK_TAB ); end; end; if not WasActive then if Assigned( Self_.fOnSelChange ) then Self_.fOnSelChange( Self_ ); end; end; end; WM_SIZE: begin GetClientRect( Self_.fHandle, R ); Self_.fClientRight := R.Right; Self_.fClientBottom := R.Bottom; Self_.Perform( TCM_ADJUSTRECT, 0, Integer( @R ) ); Self_.fClientLeft := R.Left; Self_.fClientTop := R.Top; Dec(Self_.fClientRight,R.Right); Dec(Self_.fClientBottom,R.Bottom); end; end; Result := False; end; function TControl.TC_Insert(Idx: Integer; const TabText: String; TabImgIdx: Integer): PControl; var TI: TTCItem; begin Result := NewPanel( @Self, esNone ); Result.FAlign := caClient; Result.Visible := Count = 0; TI.mask := TCIF_TEXT or TCIF_IMAGE or TCIF_PARAM; TI.iImage := TabImgIdx; TI.pszText := PChar( TabText ); TI.lParam := Integer( Result ); Perform( TCM_INSERTITEM, Idx, Integer( @TI ) ); Result.BoundsRect := TC_DisplayRect; Perform(WM_SIZE,0,0); // !!! end; procedure TControl.TC_Delete(Idx: Integer); var Page: PControl; begin Page := TC_Pages[ Idx ]; if Page = nil then Exit; Perform( TCM_DELETEITEM, Idx, 0 ); Page.Free; Perform(WM_SIZE,0,0); // !!! end;

То пример из [17] работает (с моим AlignChildrenProc). По сравнению с кодами из дистрибутива, можно сказать - "летает".

Просматривается (если смотреть внимательно при большой скорости переключения страниц), правда, одна фишка: ShowWindow делается РАНЬШЕ, чем Global_Align в Set_Visible.
А отсюда еще один вопрос: может сделать Set_Visible таким образом:

procedure TControl.Set_Visible( Value: Boolean ); begin fStyle := fStyle and not WS_VISIBLE; if Value then fStyle := fStyle or WS_VISIBLE; fVisible := Value; if fHandle = 0 then Exit; if Value then begin if fParent <> nil then Global_Align( fParent ); Global_Align( @Self ); ShowWindow( fHandle, SW_SHOW ); end else begin fCreateHidden := FALSE; // { +++ } ShowWindow( fHandle, SW_HIDE ); if fParent <> nil then Global_Align( fParent ); end; end;

← →
Galkov © (2006-12-24 14:03) [19]

Да, вот разъяснение:
Perform(WM_SIZE,0,0) добавлены в конец методов TC_Delete и TC_Insert на случай изменения размеров "клиента" таба, при изменении кол-ва страниц.

Кажется такое необходимо и в штатном варианте, независимо от применения кодов этого топика....

← →
Vladimir Kladov (2006-12-24 15:41) [20]

Короче. Вы делаете upd-файл от последней версии (2.49), и шлете мне, а я сливаю. Старую версию лучше сразу заключить в {$IFDEF OLD_ALIGN} ... старя версия {$ELSE NEW_ALIGN} ... новая версия {$ENDIF}. А то уже непонятно, в каком топике все целиком, а где только изменения. Кстати, я пользуюсь Dolphin-ом для чтения этой конфы, он жирное внутри code не выделяет (если вы пользуетесь).

← →
Galkov © (2006-12-24 21:59) [21]

Парни, а что за ерунда (мой IE говорит, что нету такого в природе...) с url-ом:
http://www.kolnmck.ru/
Он указан среди ссылок сверху, да и по форуму встречается неоднократно...
Здесь, скажем:
http://delphimaster.net/view/11-1166375143/

Это я к тому, что только начинаю осваивать технику upd :))
Инструмент беру пока с http://kolmck.net/apps/tools/updater.zip

← →
MTsv DN © (2006-12-24 22:32) [22]

> Парни, а что за ерунда (мой IE говорит, что нету такого в природе...) с url-ом:> http://www.kolnmck.ru/
Пока сам не знаю... Связался с Гэндальфом на кого сайт зареган, жду ответа... По документам вчера закончился срок регистрации сайта... Гэндальф говорил, что за сайт платить не надо...если это не так, то...я не потяну это... Я от наследства отказался 8)

Смогу конечно на свой перенести, но имя будет второго уровня, да и свой "маленький гешефт" я буду получать от числа посетителей...

В общем, пока все в подвешанном состоянии...

← →
Galkov © (2006-12-24 22:45) [23]

Сложна жизнь :))))

У нас тоже сайт пару недель висел (мои личные подозрения, что дело в бабках, хоть Автор и молчит как партизан)...
Да и сейчас входим мимо DNS :)

← →
MTsv DN © (2006-12-24 23:37) [24]

Speller еще предлагал тут, на сервере разместиться...но пока молчит...

← →
Galkov © (2006-12-25 14:37) [25]

Владимир, намылил upd на 33-ю ревизию c SVN.
Есть контакт ??? :)

← →
Vladimir Kladov (2006-12-25 17:00) [26]

У меня нет svn. Не настраивал я его. Есть версия 2.49, от нее и пляшем. KOL и KOL_Asm обновились. Буду сливать.

← →
Galkov © (2006-12-25 17:20) [27]

Про 33-ю написано (надо полагать коллегой gandalf), что именно она и есть 2.49, обновлена 19.12.06
В комментах:

> -=[2.49] Новости от 17 декабря 2006 г. (KOL & MCK v2.49)
>
> [-] ASM Исправлен метод TObj.Final (asm-версия). По крайней
> мере могла
> происходить утечка памяти.

ну и т.д..

← →
ANTPro © (2006-12-25 20:34) [28]

> [27] Galkov © (25.12.06 17:20)

KOL там от версии 2.48

Весело, конечно :))
Особенно, если вспомнить что другое место для "учтенного экземпляра" сегодня не работает.

А вот какой тогда версии KOL в ревизии 32, которая декларирована, как 2.48 ???
Черепаха очень не нулевые изменения между этими двумя ревизиями показывает :)))

> [29] Galkov © (25.12.06 22:24)

Блин, а ведь точно... Я только на это глянул...
33:
//[VERSION] **************************************************************** * VERSION 2.48 **************************************************************** //[END OF VERSION]
После диффа все прояснилось :) Не изменилась лишь цифра 8 на 9

Вот еще, позабыл совсем..... :(

После внедрения "штатного Align" в TabControl одна строка оказалась излишней:

//[function TControl.TC_Insert] function TControl.TC_Insert(Idx: Integer; const TabText: String; TabImgIdx: Integer): PControl; var TI: TTCItem; begin Result := NewPanel( @Self, esNone ); Result.FAlign := caClient; {Result.fNotUseAlign := True; Result.fVisibleWoParent := TRUE;} Result.Visible := Count = 0; TI.mask := TCIF_TEXT or TCIF_IMAGE or TCIF_PARAM; TI.iImage := TabImgIdx; TI.pszText := PChar( TabText ); TI.lParam := Integer( Result ); Perform( TCM_INSERTITEM, Idx, Integer( @TI ) ); //Result.BoundsRect := TC_DisplayRect; // Теперь это лишнее !!! Perform(WM_SIZE,0,0); //May be changes of margins for TabControl end;

Владимир, "обложите" ее пожалуйста

btw: а таки "штатный Align" в TabControl - это не так плохо :)
можно в пример из [17] добавить ДО, или ПОСЛЕ цикла такое:

with NewLabel(Tabs,"Привет участникам автопробега !!!").SetSize(100,20)^ do begin TextAlign := taCenter; Align := caBottom; Ctl3D := true; end;

И этот "StatusBar" будет прекрасно работать :)

← →
Vladimir Kladov (2007-01-01 15:03) [32]

Значит так. В версии 2.50 с включенной опцией NEW_ALIGN:
1. Создаем проект MCK. Бросаем TabControl, и не выравниваем. Выставляем Count, например, 4.
2. Бросаем Toolbar, кнопки можно делать или не делать - без разницы.
3. Запускаем и разводим руками.
4. Выключаем NEW_ALIGN, билдим, запускаем: все в порядке.

Выод: рано еще делать NEW_ALIGN в качестве основного.

← →
Vladimir Kladov (2007-01-01 15:05) [33]

Да, и еще: опциональные параметры не поддерживаются в Delphi 2, 3 и (кажется) 4. Т.к. KOL обязательно поддерживает эти старые версии компилятора, просьба таких фишек не использовать и впредь.

> Vladimir Kladov (01.01.07 15:03) [32]
> Значит так. В версии 2.50 с включенной опцией NEW_ALIGN:
> 1. Создаем проект MCK. Бросаем TabControl, и не выравниваем. Выставляем Count, например, 4.
> 2. Бросаем Toolbar, кнопки можно делать или не делать - без разницы.
> 3. Запускаем и разводим руками.

Прошу прощения за серость - с MCK не работал :(
И поэтому пока не понял:
1) Проблема в TabControl (пока не знаю как воспроизвести баг - мои тесты работали без вопросов) ???
2) Проблема в ToolBar (этого пока не тестировал) ???
3) Проблема в MCK ???

← →
Vladimir Kladov (2007-01-01 20:38) [35]

Нет, не в MCK. Просто мне удобнее в нем проект сделать. Схема та же, если без MCK. Что должно быть на форме, я указал.

Ok, или будем что-то делать, или будем что-то решать :))

Из этого логически следует, что мне рациональней повозиться с ToolBar на "чистом" KOL :)

2 Galkov ©
Посмотрите, проект...коль уж Вы начали Align переделывать...
http://www.uus4u.com/download/other/bug_align.rar
Правда там MCK используется, но не думаю, что это будет проблемой...

> Vladimir Kladov (01.01.07 20:38) [35]
> Нет, не в MCK. Просто мне удобнее в нем проект сделать.
> Схема та же, если без MCK. Что должно быть на форме, я указал

Не получается у меня усмотреть разницу между в результатах при изменении OLD/NEW :(
Как ни крутил ToolBar с TabControl-ом...
Владимир, намыльте мне, пожалуйста, таковой проект. Как показывает пример коллеги MTsv DN, разобраться в нем значительно быстрее, чем овладение высоким искусством MCK-техники :)

НО, методом "зоркого присматривания" - одну неточность обнаружил таки.

function TControl.TC_Insert(Idx: Integer; const TabText: KOLString; TabImgIdx: Integer): PControl; var TI: TTCItem; begin Result := NewPanel( @Self, esNone ); Result.FAlign := caClient; // здесь буковка "F" явно лишняя!!! .....

Как раз в простых примерах, где про align и не слышали - он и не пристегнется.
А это уже будет криминал. И как раз при NEW, при OLD - сработает "эмуляция" в аттаче WndProcTabControl.

> MTsv DN © (02.01.07 18:05) [37]
> 2 Galkov ©
> Посмотрите, проект...коль уж Вы начали Align переделывать...
> http://www.uus4u.com/download/other/bug_align.rar
> Правда там MCK используется, но не думаю, что это будет проблемой...

Ага, посмотрел.
Действительно проблема. Если обобщать, то совсем не простая...
А обобщить - хочется.
Выглядит как разрешение произвольных рекурсивных запросов.
По какой-то причине происходит resize, который вызывает некое дерево align-ов
Те в свою очередь вызывают resize-ы, которые опять вызовут align-ы, и т.д..
До моих правок все так и происходило (осознание этого замечательного факта у меня выразилось фразой: чем дальше в лес, тем толще партизаны...)
У себя я просто нахально заблокировал рекурсии - если это только Align, то они и не нужны, вроде. А про event-ы я и позабыл...

Вы напомнили....
Но все равно очень не хочется их разрешать... В происходящем после этого черт ногу сломает. Как подтверждение: вот при OLD они разрешены, а все равно не работает правильно (мне именно так показалось)

Из несомненных выводов пока только один: думать надо :))
А из подлежащих обсуждению: нужен "отложенный" вызов метода...
Что-то похожее на технику TThread.Synchronize, только через PostMessage...
Ну, типа такого:
PostMessage( aParent.handle, CM_EXECPROC_ex, integer(Method.code), integer(Method.data) );
С очевидной реакцией в обработчике.

В других местах от такого тоже польза могла бы быть....
Собственно, сегодня у меня при задачах типа "уничтожить самого себя" приходится "одноразовый" таймер использовать...

Вот значит, какая история приключилась....

Один наш коллега ("наш" - это в hiasm, в проекте fasm, не имеющем отношение к KOL, "коллега" - ака tsdima) сотворил технологию Align в своем проекте.
А я возьми, и подсунь ему пример для тестирования пример, предоставленный MTsv DN, выполненный в нашем "схемном" исполнении.
И он, подумавши, говорит: "Да вот, работает на ура, только вот я WM_SIZE привязываю с самого контрола, а не с парента..."

И все так красиво у него получалось (если не с парента): ф-ия AlignChildrenProc не являлась рекурсивной, а рекурсии осуществлялись через WM_SIZE, и выполнялись они ровно столько раз сколько надо...

А проблема решилась введением одного флага в контрол - признака, что над этим контролом УЖЕ производится Aligning (так он этот флаг и назвал, кстати). И теперь, если AlignChildrenProc увидел, что флаг оказался в нуле, то это означает, что по нашему контролу прошелся "железным катком выравнивания" рекурсивный вызов его же самого (а произойти может такое ТОЛЬКО при onResize-ах, отмеченных MTsv DN, потому что WM_SIZE не работает с парента, а с себя самого), и следует тут же ПРЕКРАТИТЬ дальнейшие действия по aligning-у, ибо все уже сделано, и правильно.

Настолько все это было правильно и минимально, что мы зарешали не ломать эту стройную картину, а завести в именно контроле ЕЩЕ один флаг, который предписывает AlignChildrenProc не в коем случае не начинать работу с парента. И этот флаг взводится только при изменении размера контрола из AlignChildrenProc.

К чему вся эта поучительная история
К тому, что у меня есть вариант KOL-а, работающий по этой схеме.
Т.е., пример, любезно предоставленный коллегой MTsv DN, работает абсолютно корректно.
Еще более конкретно, тестировал на таком примере:

Program test; uses windows,kol; type TMainForm=object Control,Check,Panel,B1,B2,B3:PControl; procedure _OnClick(Obj:PObj); procedure _OnResize(Obj:PObj); end; procedure TMainForm._OnClick; begin Panel.Height := 50*byte(Check.Checked)+50; end; procedure TMainForm._OnResize; begin B1.Width := B2.Height; B2.Width := B2.Height; B3.Width := B2.Height; end; var MainForm:TMainForm; begin Applet := NewApplet("Test"); with MainForm do begin Control := NewForm(Applet,"TestApp").SetSize(400,300); Check := NewCheckBox(Control,"Show").SetPosition(10,240); Check.OnClick := MainForm._OnClick; Panel := NewPanel(Control,esRaised).SetSize(400,100); B1 := NewButton(Panel,"1").SetSize(50,50); B1.Align := caLeft; B2 := NewButton(Panel,"2").SetSize(50,50); B2.Align := caLeft; B2.OnResize := MainForm._OnResize; B3 := NewButton(Panel,"3").SetSize(50,50); B3.Align := caLeft; end; Run(Applet); end.

Далее предложение: а давайте заапдейтим NEW_ALIGN
Осталось только выяснить по какой схеме...

> Далее предложение: а давайте заапдейтим NEW_ALIGN
> Осталось только выяснить по какой схеме...

Владимир, намылил Вам NewAlign2from254.upd в варианте полной замены внутри условных компиляций NEW_ALIGN для рассмотрения
+ небольшое философское "эссе" про все это (align) дело

про Align, когда выключена видимость родителей Найти похожие ветки