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

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

TAllegroMDIBar: проблема с сообщением WM_GETTEXT под "стилем XP" [WinXP]


Страницы:   1 2

kaif ©   (2004-10-23 11:31:00) 

На основе кода ElegantMDI и частично кода Игоря Шевченко я разработал свой компонент панели кнопок для MDI.
Но у меня проблема - под "стилем XP" экранных настроек в XP на кнопках не высвечиваются надписи, хотя картинки высвечиваются. Кнопки TBarButton у меня потомки TSpeedButton, панель TAllegroMDIBar - потомок обычной TPanel.
Под "классическим стилем" в XP и в других ОС все нормально.
Проблема в том, что в "стиле XP" не возникает почему-то WM_GETTEXT, где у меня назначается Caption кнопке из заголовка MDIChild окна.
 Почему это так и что делать?
 Ниже привожу полный код компонента:

unit AllegroMDI;

interface

uses
 Windows, Classes, Graphics, Messages, Controls, Forms, ExtCtrls, Buttons, Menus, StdCtrls,
 Dialogs, SysUtils;

type
 TAllegroMDIBar = class(TPanel)
 private
   Form: TForm;
   FFlat: Boolean;
   OldWndClientProc: Pointer;
   InstanceWndClientProc: Pointer;
   Popup: TPopupMenu;
   procedure RedrawButtons;
   procedure PopupMenuPopup(Sender: TObject);
   procedure MinimizeMDIWindow(Sender: TObject);
   procedure CloseMDIWindow(Sender: TObject);
   procedure RestoreMDIWindow(Sender: TObject);
   procedure MaximizeMDIWindow(Sender: TObject);
 protected
   procedure WndClientProc(var Message: TMessage); virtual;
 public
   constructor Create(AOwner: TComponent); override;
 published
   property Flat: boolean read FFlat write FFlat;
 end;

 TBarButton = class(TSpeedButton)
 private
   Handle: THandle;
   AllegroMDIBar: TAllegroMDIBar;
   OldChildWndProc: Pointer;
   InstanceChildWndProc: Pointer;
   procedure GetButtonGlyph;
 protected
   procedure ChildWndProc(var Message: TMessage); virtual;
   procedure BarButtonClick(Sender: TObject);
   procedure BarButtonDblClick(Sender: TObject);
 public
   constructor Create(AOwner: TComponent);override;
   destructor Destroy; override;
 end;

const MaxButtonWidth = 140;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents('Samples', [TAllegroMDIBar]);
end;

{ TBarButton }

procedure TBarButton.ChildWndProc(var Message: TMessage);
begin
 case Message.Msg of
 WM_GETTEXT: //нет этого события под стилем XP!!!   begin
     Message.Result:= CallWindowProc(OldChildWndProc, Handle, Message.Msg, Message.WParam, Message.LParam);
     Caption := PChar(Message.LParam);
     Hint := Caption;
     Exit;
   end;
 WM_MDIACTIVATE:
   begin
     if HWND(Message.LParam) = Handle then Down := True;
     if HWND(Message.WParam) = Handle then Down := False;
   end;
 WM_SETICON:
     GetButtonGlyph;
 WM_DESTROY:
   begin
     self.Free;
     AllegroMDIBar.RedrawButtons;
   end;
 end;
 Message.Result:= CallWindowProc(OldChildWndProc, Handle, Message.Msg, Message.WParam, Message.LParam);
end;

procedure TBarButton.BarButtonClick(Sender: TObject);
begin
 BringWindowToTop(Handle);
end;

constructor TBarButton.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 OnClick := BarButtonClick;
 OnDblClick := BarButtonDblClick;
 Top := 1;
 GroupIndex := 1;
 Width := 140;
 AllowAllUp := False;
 Glyph.Width := 16;
 Glyph.Height := 16;
 Glyph.TransparentColor := clCaptionText;
 Layout := blGlyphLeft;
 Margin := 2;
end;

destructor TBarButton.Destroy;
begin
 SetWindowLong(Handle, GWL_WNDPROC, Longint(OldChildWndProc));
 FreeObjectInstance(InstanceChildWndProc);
 inherited Destroy;
end;

procedure TBarButton.BarButtonDblClick(Sender: TObject);
begin
 ShowWindow(Handle, SW_RESTORE);
end;

{ TAllegroMDIBar }

 

Gero   (2004-10-30 11:41:00) [1]


> kaif ©   (29.10.04 16:44)

Это личная переписка уже пошла, пиши мылом.

kaif   (2004-10-29 16:44:00) [2]

2 Gero ©
Твой компонент у меня заработал под XP Home Edition! С темами и без. Правда ты забыл прислать файл *.dfm , но я понял, что ты хотел сказать.
У меня рука не поднимается выставлять твой компонент Freeware.
Подумай, может стоить разделить на два компонента. Один (мой) AllegroMDIBar, второй - GeroMDIBar. Мой сделать freeware,  а твой - с платным исходником. Подумай.

kaif   (2004-10-28 17:06:00) [3]

Жаль, кладовка закрыта.
Усовершенствованный вариант (со свойством ShowIcons) положил на
http://www.gaapinvest.com/zipprog1/AllegroMDI.zip

Gero ©   (27.10.04 21:41) [26]
Только сейчас получил твой вариант по почте. Еще не смотрел.

kaif   (2004-10-28 10:39:00) [4]

ashot@vallex.ru

Gero   (2004-10-27 21:41:00) [5]


> kaif ©   (27.10.04 12:39)

Давай мыло, скину.

kaif   (2004-10-27 12:39:00) [6]

2 Gero ©
Не то, чтобы не приняты.  
Я старался сделать самый простой и банальный компонент. Так как мне он нужен был для программы Allegro.
Насчет замены popup-меню я готов подумать.
Я не знаю, что такое поддержка тем, честно говоря. Если знаешь - добавь сам. Исходный текст у тебя есть. Если получится что-то более качественное в результате - я буду только рад. Выложим где-нибудь как Freeware.

Gero   (2004-10-27 09:53:00) [7]


> kaif ©   (26.10.04 12:58

Как я понял, пожелания не приняты?

Gero   (2004-10-26 15:41:00) [8]


> kaif ©   (26.10.04 12:58)
> Объясни, я не понял.

Например, мне не нравится твое PopupMenu, и я хочу свое с другими пунктами.
Или просто хочу добавить пару пунктов к твоему, не создавая своего.
Дай мне возможность сделать это.

Добавь события - типа OnButtonClick, OnButtonMouseDown и.т.п.

Потом - под XP с темами кнопки-то рисуются стандартными, не поддерживающими темы.
Неплохо бы добавить поддержку тем.

kaif   (2004-10-26 12:58:00) [9]

2 Gero ©   (26.10.04 08:45) [20]
Мне некоторые моменты не понравились.
Например, нужно давать возможность перекрыть встроенное меню еще в DT.
Объясни, я не понял.
Да и что-то типа ShowImages не помешало бы.
С этим согласен. Добавлю.

2 jack128 ©   (26.10.04 12:08) [21]
Поясню. Мне нужно было поймать момент, когда програма, написанная на Delphi, изменяет заголовок окна (неважно, зачем). Например, разработчик вызвал:

 with TMyChildForm.Create(Application) do
 begin
   Caption := 'Вася Пупкин';
 end;

 Сначала сработало сообщение, которое у меня породило кнопку на панели, а сразу после этого разработчик программы сделал присвоение Caption := 'Вася Пупкин';
 Мне всеравно, как поймать это событие.
 Так как выяснилось, что при присвоении Caption вызывается в конце-концов метод Perform, в который передается сообщение WM_SETTEXT, но это сообщение не доходит до оконной процедурыв "стиле XP". Зато доходит до обработчика методаPerform, так как это делает сама VCL. Поэтому я и подменяю метод, а не процедуру. Мне ведь все равно, как именноVCL в конечном итоге будет менять заголовок окна. Мне важно, чтобы если уж VCL способна изменить заголовок окна (пусть даже самым таинственным способом), то пусть одновременно изменится и заголовок кнопки. А если VCL не сможет изменить заголовок окна, так как Билл Гейтс и дальше решил издеваться над Win32, то пусть и кнопка останется без изменений заголовка.

jack128   (2004-10-26 12:08:00) [10]

kaif ©   (26.10.04 5:50) [19]
Вопрос я не понял. В каком смысле "работать с темами"?
Ну первоначальный вопрос был:
kaif ©   (23.10.04 11:31)
Но у меня проблема - под "стилем XP" экранных настроек в XP на кнопках не высвечиваются надписи
Причина с том, что не приходят сообщения WM_GET/SETTEXT

kaif ©   (26.10.04 5:50) [19]
Да, компонент сейчас нормально работает в "стиле XP" тоже. В том смысле, что надписи видны

Странно..Твои изменения заключались в отказе от подмены оконной процедуры, но я не вижу как это может повлиять на приход сообщений WM_SET/GETTEXT при использовании стиля XP...

Gero   (2004-10-26 08:45:00) [11]


> kaif ©   (26.10.04 05:50)

А корректную прорисовку под XP с темами делать не будешь?

Мне некоторые моменты не понравились.
Например, нужно давать возможность перекрыть встроенное меню еще в DT.
Да и что-то типа ShowImages не помешало бы.

kaif   (2004-10-26 05:50:00) [12]

2 jack128 ©   (26.10.04 04:22) [18]
Вопрос я не понял. В каком смысле "работать с темами"?
Да, компонент сейчас нормально работает в "стиле XP" тоже. В том смысле, что надписи видны и картинкии тоже. Ничего не глючит, все пристойно. Кнопки, разумеется, не мыльные, а человеческие (классические). Могут быть плоскими (свойство Flat нужно установить у AllegroMDIBar)
Скачай - посмотри.

http://www.gaapinvest.com/zipprog1/AllegroMDI.zip

Установи компонент, создай MDI-проект, кинь на главное окно компонент и поюзай. Если что не так - сообщи.
:)

jack128   (2004-10-26 04:22:00) [13]

kaif ©   (26.10.04 3:02) [17]
Еще раз всем спасибо большое.

Алле, kaif, куда?? какое спасибо???  Или после всех этих манипуляций твой компонент стал работать и с темами XP??

kaif   (2004-10-26 03:02:00) [14]

Спасибо всем!
 Мне многое прояснил jack128 ©   (25.10.04 01:00) [13] - я вдруг сообразил, что если вместо того, чтобы регистрировать новую оконную процедуру с помощью SetWindowLong, нужно просто подменить метод, назначенный свойству WindowProc и в подмененном методе после вызывать старый метод WndProc. Тогда Perform заработает.
 А Игорь Шевченко ©   (24.10.04 23:45) [11] вернул меня к идее работать с WM_SETTEXT. Только вместо SendMessage я просто задействовал Perform.

 case Message.Msg of
   WM_MDICREATE:
     begin
       Message.Result := CallWindowProc(OldWndClientProc, Form.ClientHandle, Message.Msg, Message.WParam, Message.LParam);
       with TBarButton.Create(Self) do
       begin
         AllegroMDIBar := self;
         Parent := self;
         PopupMenu := self.Popup;
         Flat := self.Flat;
         ShowHint := self.ShowHint;
         with AllegroMDIBar.Form do
         for i := 0 to MDIChildCount - 1 do
         if MDIChildren[i].Handle =  THandle(Message.Result) then
         begin
           MDIChildForm := MDIChildren[i];
           break;
         end;
         OldChildWndProc := MDIChildForm.WindowProc;
         MDIChildForm.WindowProc := ChildWndProc;         MDIChildForm.Perform(WM_SETTEXT, 0, longint(PChar(MDIChildForm.Caption)));
       end;
       RedrawButtons;
       Exit;
     end;

 Это гораздо более "Дельфийское решение".
 Удалось также вставить многоточие в конце длинной надписи на кнопке, выводя надпись с помощью DrawText в виртуальной канве:

 ScreenDC := GetDC(0);
 try
   DC := CreateCompatibleDC(ScreenDC);
   ... 

Полностью исходный текст компонента лежит здесь:

http://www.gaapinvest.com/zipprog1/AllegroMDI.zip

Ксати, только сейчас заметил... Вызов Perform можно выкинуть, так как процедура RedrawButtons все равно заменит все Caption кнопок. Мне кажется, неплохой получился компонент.

Еще раз всем спасибо большое.

Gero   (2004-10-25 12:06:00) [15]


> jack128 ©   (25.10.04 12:00)

Интересно то, как могут темы влиять на это.

jack128   (2004-10-25 12:00:00) [16]

function TControl.Perform(Msg: Cardinal; WParam, LParam: Longint): Longint;
begin
 ...
 if Self <> nil then WindowProc(Message);
 ...
end;
WindowProc по умолчанию = WndProc;

procedure TControl.WndProc(var Message: TMessage);
begin
 ...
 Dispatch(Message);
end;

procedure TWinControl.DefaultHandler(var Message);
begin
 if FHandle <> 0 then
 begin
   with TMessage(Message) do
   begin
     if (Msg = WM_CONTEXTMENU) and (Parent <> nil) then
     begin
       Result := Parent.Perform(Msg, WParam, LParam);
       if Result <> 0 then Exit;
     end;
     case Msg of
       WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
         Result := SendMessage(LParam, CN_BASE + Msg, WParam, LParam);
       CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
         begin
           SetTextColor(WParam, ColorToRGB(FFont.Color));
           SetBkColor(WParam, ColorToRGB(FBrush.Color));
           Result := FBrush.Handle;
         end;
     else
        Result := CallWindowProc(FDefWndProc, FHandle, Msg, WParam, LParam);
     end;
     if Msg = WM_SETTEXT then
       SendDockNotification(Msg, WParam, LParam);
   end;
 end
 ...
end
Так что почти все сообщения за рядом исключений приходят в DefWndProc...

Gero   (2004-10-25 10:43:00) [17]


> Peform в результате отправляет все сообщения в DefWndProc

Не, в WndProc.

jack128   (2004-10-25 01:00:00) [18]

Gero ©   (24.10.04 23:59) [12]
но не через делфийский Perform...
Очень странно на первый взгляд.

Почему странно? Проверять лень ;-) но вроде все логично. Peform в результате отправляет все сообщения в DefWndProc, а это - старая процедура. Та что была до подмены её kaif'ом. Чтобы коректно работал Peform нужно привоить этому свойству новое значение - InstanceChildWndProc.. Только врядли менеджер тем ХP что нибудь знает о методе Peform..

Gero   (2004-10-24 23:59:00) [19]


> Игорь Шевченко ©   (24.10.04 23:45)
> А как же меняется заголовок окна ? Он, помимо WM_SETTEXT никак не
> поменяется (разве что по DrawCaption(Ex))

Безусловно,  WM_SETEXT посылается окну.
Но в данном примере (
case Message.Msg of
WM_SETTEXT:
)
WM_SETTEXT произойдет по отправке сообщения только через SendMessage, но не через делфийский Perform...
Очень странно на первый взгляд.

Игорь Шевченко   (2004-10-24 23:45:00) [20]

Кстати, дочернее окно MDI сообщение WM_SETTEXT получает, согласно которому оно не только обновляет свой заголовок, но и при максимизированном состоянии изменяет заголовок главного окна.
Я бы при создании кнопки на тулбаре вызывал бы GetWindowText, чтобы получить заголовок окна в момент создания кнопки, а затем перекрыл бы у дочернего окна оконную процедуру, в которой бы отслеживал сообщение WM_SETTEXT, после выполнения по CallWindowProc вызывал бы снова GetWindowText

Немного подробнее о том, что такое "Стиль XP". Реализация его состоит в том, что ряд стандартных функции user32 по обработке оконных сообщений, по рисованию (DrawCaption, DrawFrameControl) и по получению параметров оформления окна и системы (GetSystemMetrics, SystemParametersInfo) перекладывается на uxtheme.dll, в которой эти же функции реализованы с поддержкой тем XP. Для того, чтобы такой механизм был возможен, в user32 был введен набор функций под общим названием UserApiHooking
(RegisterUserApiHook, UnregisterUserApiHook). Более того, о том, что используются темы, знает также и диспетчер подсистемы управления окнами (win32k.sys). В этом случае диспетчер изменяет обработку сообщений по умолчанию, с тем, чтобы избежать конликтов при рисовании окон, меню, и т.п.

Gero ©   (24.10.04 22:40) [10]

> Если же делать Perform(что происходит при установке Caption
> формы), то WM_SETTEXT не происходит


А как же меняется заголовок окна ? Он, помимо WM_SETTEXT никак не поменяется (разве что по DrawCaption(Ex))

Страницы:   1 2

Наверх

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