Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

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


Страницы:   1 2 3

Galkov ©   (2006-12-15 23:48:00) 

Вот пример:
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) И чего делать, если возникает необходимость поменять некоторые размеры, в момент невидимости кого-то из родителей ???

MTsv DN   (2006-12-24 23:37:00) [21]

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

Galkov   (2006-12-24 22:45:00) [22]

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

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

MTsv DN   (2006-12-24 22:32:00) [23]

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

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

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

Galkov   (2006-12-24 21:59:00) [24]

Парни, а что за ерунда (мой IE говорит, что нету такого в природе...) с url-ом:
http://www.kolnmck.ru/
Он указан среди ссылок сверху, да и по форуму встречается неоднократно...
Здесь, скажем:
http://www.delphimaster.ru/cgi-bin/forum.pl?id=1166375143&n=10&p=2

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

Vladimir Kladov   (2006-12-24 15:41:00) [25]

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

Galkov   (2006-12-24 14:03:00) [26]

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

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

Galkov   (2006-12-24 13:57:00) [27]

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

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-23 10:01:00) [28]

Понимание немного улучшилось (и вскрылись некоторые неточности).
При проведении 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 (одной командой, как показано выше).

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

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

Vladimir Kladov   (2006-12-21 18:11:00) [29]

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

Galkov   (2006-12-21 17:25:00) [30]

Про то, что 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 16:32:00) [31]

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

Galkov   (2006-12-21 00:01:00) [32]

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

Galkov   (2006-12-20 23:51:00) [33]

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

Имел ввиду под "перетаскиванием" такое:
//*
//[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-19 18:30:00) [34]


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

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

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

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

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

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

Vladimir Kladov   (2006-12-19 18:19:00) [35]

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

Galkov   (2006-12-19 14:19:00) [36]

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

Galkov   (2006-12-19 14:15:00) [37]

Мда...
По поводу "не делать лишнего": чем дальше в лес, тем толще партизаны... :(((
У нас сегодня, оказывается, на каждый 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;

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

Vladimir Kladov   (2006-12-18 16:22:00) [38]

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

Galkov   (2006-12-18 12:02:00) [39]


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

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

Barloggg   (2006-12-18 10:49:00) [40]

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

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

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

Страницы:   1 2 3

Наверх

Титульная страница Поиск, карта сайта Написать письмо