| Новости | Поиск | 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-24 22:40:00) [21]

> Вообще кто-нибудь знает, что такое этот "стиль XP", есть
> ли по нему какая-то документация или спецификация?

http://www.rsdn.ru/article/winshell/themes.xml

Провел небольшое исследование.
Если сделать SendMessage(SomeMDIChild, WM_SETTEXT, 0, 0) то WM_SETTEXT все нормально, и нужный код выполняется.
Если же делать Perform(что происходит при установке Caption формы), то WM_SETTEXT не происходит.

---

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

>  Мне нужно какое-то событие, которое сработает, когда Caption
> окана кто-то решит поменять в процессе работы программы.


WinEventHook (EVENT_OBJECT_NAMECHANGE) возникает всегда в процессе исполнения оконным менеджером сообщения WM_SETTEXT, но, полагаю, что разбираться с SetWinEventHook будет тоже довольно громоздко.

К сожалению, у меня сейчас нет Windows XP, так что я не могу проверить и найти способ обойти ситуацию.

Менеджер тем в Windows XP перехватывает следующие функции:
DefWindowProc, DrawCaption и перерисовку главного окна MDI.
Вся обработка изменения заголовка дочернего окна MDI выполняется без обмена сообщениями с окном клиентской части MDI или с окном главной формы.

---

kaif   (2004-10-24 21:38:00) [23]

2 jack128 ©
Handle - это я добавил. Извиняюсь. Это не Handle кнопки - я просто назвал, видно, неудачно. Это Handle окна, связанного с кнопкой. Сообщение WM_SETTEXT я тоже пробовал перехватить - под "стилем XP" его тоже нет!!! (установлено экспериментально). Вообще кто-нибудь знает, что такое этот "стиль XP", есть ли по нему какая-то документация или спецификация?

 Мне нужно какое-то событие, которое сработает, когда Caption окана кто-то решит поменять в процессе работы программы. Чтобы кнопка на панели, связанная с этим окном, тоже поменяла свой заголовок. Пока что под "стилем XP" у меня все кнопки оказались голыми - картинки есть, а надписей - нет.
Можете поставить этот компонент у себя (у кого XP и установлен стиль мыльницы) и посмотреть. Кстати, сам AllegroMDIBar получился очень неплохим. Ошибок там нет (как в ElegentMDI, где имелась утечка ресурсов, плохая перестновка кнопок и глюки ToolBar-а). Единственная проблема - та, о которой я говорю. Еще я хочу создать у длинных надписей в конце многоточие. Пока идей здесь особых нет, кроме того, чтобы создать абстрактную канву (в TBitmap), и вывести туда текст каким-нибудь DrawText с опцией обрезания с многоточием. Там есть такой режим (у функции Windows), когда обрезанная строка возвращается в виде текста. Конечно все это выглядит громоздко, но другого способа обрезать текст я пока не вижу. Может быть через GetMetric рассчитать какой-нибудь. Я плохо знаю функции API, может чего-то просто не знаю...
 Если поможете с событием (сообщением) для перехвата присвоения заголока окна- буду признателен. Я могу разместить этот компонент как Freeware с исходным текстом и совместным авторством с теми, кто поможет в этом вопросе.

---

jack128   (2004-10-24 12:47:00) [24]

Gero ©   (23.10.04 22:05) [6]угу, туплю...
kaif ©   (23.10.04 12:54) [3]
как я перехватываю сообщение Windows WM_GETTEXT, посылаемое дочернему окну (MDIChild-у)

непонятно только зачем..Мне кажется нужно перехватывать WM_SETTEXT. Именно этим соообщением устанавливается новый заголовок окна..

---

Gero   (2004-10-23 22:05:00) [25]

> jack128 ©   (23.10.04 18:21)



> TBarButton = class(TSpeedButton)
>  private
>    Handle: THandle;



---

jack128   (2004-10-23 18:21:00) [26]

kaif ©   (23.10.04 11:31)

>TBarButton = class(TSpeedButton)
>  


>destructor TBarButton.Destroy;
>begin
>  SetWindowLong( Handle, GWL_WNDPROC,
>Longint(OldChildWndProc));
>  
Откуда HAndle у speedbutton'a ?? Он же вроде GraphicControl...

---

Gero   (2004-10-23 17:31:00) [27]

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

---

kaif   (2004-10-23 12:54:00) [28]

Ситуация такая: сам SpeedButton нормально работает, если ему Caption присвоить. У меня не вызывается само присвоение. Так как я перехватываю сообщение Windows WM_GETTEXT, посылаемое дочернему окну (MDIChild-у) и пытаюсь из него извлечь заголовок окна, чтобы записхать его в SpeedButton.Caption. Этот кусок кода при "стиле XP" не работает. А как мне узнать заголовок окна при стиле XP иначе - я просто не знаю. При других стилях код работает нормально.
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;
 и так далее...

---

Gero   (2004-10-23 11:37:00) [29]

Это странно, так как SpeedButton это не CommonControl и от тем по идее зависить не должен.

---

kaif   (2004-10-23 11:31:00) [30]

продолжение кода:

constructor TAllegroMDIBar.Create(AOwner: TComponent);
var
 Component: TComponent;
 mi: TMenuItem;
begin
 inherited Create(AOwner);

 Flat := False;
 BevelOuter := bvNone;
 Height := 23;
 Align := alBottom;
 Caption := '';

 if not(csDesigning in ComponentState) then
 begin
   Component := Owner;
   while Assigned(Component) and not (Component is TForm) do
     Component:= Component.Owner;
   if not Assigned(Component) then
     Exit;
   Form := Component as TForm;

   if Form.Handle=Form.ClientHandle then ; // without this don''t work :o??????

   if (not (csDesigning in ComponentState)) and (Form.FormStyle=fsMDIForm) then begin
     InstanceWndClientProc := MakeObjectInstance(WndClientProc);
     OldWndClientProc := Pointer(GetWindowLong(Form.ClientHandle, GWL_WNDPROC));
     SetWindowLong(Form.ClientHandle, GWL_WNDPROC, Longint(InstanceWndClientProc));
   end;

   Popup := TPopupMenu.Create(Form);
   Popup.OnPopup := PopupMenuPopup;
   mi := TMenuItem.Create(Form);
   mi.Caption := 'Âîññòàíîâèòü';
   mi.OnClick := RestoreMDIWindow;
   mi.Bitmap.Handle := LoadBitmap(0, PChar(OBM_RESTORED));
   Popup.Items.Add(mi);

   mi := TMenuItem.Create(Form);
   mi.Caption := 'Ñâåðíóòü';
   mi.OnClick := MinimizeMDIWindow;
   mi.Bitmap.Handle := LoadBitmap(0, PChar(OBM_REDUCED));
   Popup.Items.Add(mi);

   mi := TMenuItem.Create(Form);
   mi.Caption := 'Ðàçâåðíóòü';
   mi.OnClick := MaximizeMDIWindow;
   mi.Bitmap.Handle := LoadBitmap(0, PChar(OBM_ZOOMD));
   Popup.Items.Add(mi);

   mi := TMenuItem.Create(Form);
   mi.Caption := '-';
   Popup.Items.Add(mi);

   mi := TMenuItem.Create(Form);
   mi.Caption := 'Çàêðûòü';
   mi.OnClick := CloseMDIWindow;
   Popup.Items.Add(mi);
 end;
end;

procedure TAllegroMDIBar.PopupMenuPopup(Sender: TObject);
begin
 with Popup do
 begin
   if IsIconic(TBarButton(PopupComponent).Handle) then
   begin
     Items[0].Enabled := True;
     Items[1].Enabled := False;
     Items[2].Enabled := True;
   end
   else
   begin
     Items[0].Enabled := IsZoomed(TBarButton(PopupComponent).Handle);
     Items[1].Enabled := True;
     Items[2].Enabled := not Items[0].Enabled;
   end;
   TBarButton(PopupComponent).Down := True;
   TBarButton(PopupComponent).Click;
 end;
end;

procedure TAllegroMDIBar.RedrawButtons;
var
ButtonWidth : Integer;
I : Integer;
begin
Invalidate();
if ComponentCount = 0 then
  Exit;
ButtonWidth := (Width - (ComponentCount * 2)) div ComponentCount;
if ButtonWidth > MaxButtonWidth then
  ButtonWidth := MaxButtonWidth;

  for I:=0 to Pred(ComponentCount) do
  with TBarButton(Components[I]) do
  begin
    Width := ButtonWidth;
    Left := I * (Width + 2);
  end;
end;

procedure TAllegroMDIBar.MaximizeMDIWindow(Sender: TObject);
begin
 ShowWindow(TBarButton(Popup.PopupComponent).Handle, SW_MAXIMIZE);
end;

procedure TAllegroMDIBar.MinimizeMDIWindow(Sender: TObject);
begin
 ShowWindow(TBarButton(Popup.PopupComponent).Handle, SW_MINIMIZE);
end;

procedure TAllegroMDIBar.RestoreMDIWindow(Sender: TObject);
begin
 ShowWindow(TBarButton(Popup.PopupComponent).Handle, SW_RESTORE);
end;

procedure TAllegroMDIBar.CloseMDIWindow(Sender: TObject);
begin
 Form.ActiveMDIChild.Close;
end;

procedure TAllegroMDIBar.WndClientProc(var Message: TMessage);
begin
 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
         Handle := Message.Result;
         AllegroMDIBar := self;
         Parent := self;
         PopupMenu := self.Popup;
         Flat := self.Flat;
         ShowHint := self.ShowHint;
         InstanceChildWndProc := MakeObjectInstance(ChildWndProc);
         OldChildWndProc := Pointer(GetWindowLong(Handle,GWL_WNDPROC));
         SetWindowLong(Handle, GWL_WNDPROC, Longint(InstanceChildWndProc));
       end;
       RedrawButtons;
       Exit;
     end;
   WM_DESTROY:
     begin
       SetWindowLong(Form.ClientHandle, GWL_WNDPROC, Longint(OldWndClientProc));
       FreeObjectInstance(InstanceWndClientProc);
     end;
   WM_SIZE:
     begin
       RedrawButtons;
     end;
 end;
 Message.Result:= CallWindowProc(OldWndClientProc, Form.ClientHandle, Message.Msg, Message.WParam, Message.LParam);
end;

procedure TBarButton.GetButtonGlyph;
var
 i: integer;
 IconHandle: THandle;
begin
 with AllegroMDIBar.Form do
 for i := 0 to MDIChildCount - 1 do
 if MDIChildren[i].Handle = self.Handle then
 begin
   IconHandle := MDIChildren[i].Icon.Handle;
   if IconHandle = 0 then
     IconHandle := Application.Icon.Handle;
   Glyph.Canvas.FillRect(Rect(0,0,15,15));
   DrawIconEx(Glyph.Canvas.Handle, 0, 0, IconHandle,
      Glyph.Width, Glyph.Height, 0, 0, DI_NORMAL);
   exit;
 end;
end;

end.

---

Страницы:   < 1 2 >

Наверх