скрыть

скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Google  
 

Задать цвет фона для MDI-формы



Оформил: DeeCo

{******************************************************************************* 
 * 
 *  Hintergrundfarbe eines MDI-Formulars setzen ohne die Farbe der darauf 
 *  liegenden Objekte wie TGroupBox oder TPageControl zu verandern. 
 * 
 *  Setting the Background color of a MDI Form without changing the color 
 *  of overlayed objects like TGroupBox or TPageControl. 
 * 
 ******************************************************************************}

 unit Unit1;

 interface

 uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs;

 type
   TForm1 = class(TForm)
   private
     FClientInstance: TFarProc;
     FPrevClientProc: TFarProc;
     BkBrush: HBRUSH;
     procedure ClientWndProc(var Message: TMessage);
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
   end;

 implementation

 {$R *.dfm}

 constructor TForm1.Create(AOwner: TComponent);
 begin
   inherited;
   BkBrush := CreateSolidBrush(clGray);
   FClientInstance := Classes.MakeObjectInstance(ClientWndProc);
   FPrevClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
   SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(FClientInstance));
 end;

 destructor TForm1.Destroy;
 begin
   DeleteObject(BkBrush);
   inherited;
 end;

 procedure TForm1.ClientWndProc(var Message: TMessage);
 var
   DC: HDC;
   BrushOld: HBRUSH;
 begin
   with Message do
    begin
     case Msg of
       WM_ERASEBKGND:
         begin
           DC := TWMEraseBkGnd(Message).DC;
           BrushOld := SelectObject(DC, BkBrush);
           FillRect(DC, ClientRect, BkBrush);
           SelectObject(DC, BrushOld);
           Result := 1;
         end;
       else
         Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
     end;
   end;
 end;

 end.





Copyright © 2004-2016 "Delphi Sources". Delphi World FAQ




Группа ВКонтакте   Ссылка на Twitter   Группа на Facebook