Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  4 739

•  TDictionary Custom Sort  6 741

•  Fast Watermark Sources  6 530

•  3D Designer  9 471

•  Sik Screen Capture  6 859

•  Patch Maker  7 306

•  Айболит (remote control)  7 253

•  ListBox Drag & Drop  6 113

•  Доска для игры Реверси  97 936

•  Графические эффекты  7 427

•  Рисование по маске  6 722

•  Перетаскивание изображений  5 577

•  Canvas Drawing  5 957

•  Рисование Луны  5 743

•  Поворот изображения  5 197

•  Рисование стержней  3 804

•  Paint on Shape  2 978

•  Генератор кроссвордов  3 916

•  Головоломка Paletto  3 111

•  Теорема Монжа об окружностях  3 933

•  Пазл Numbrix  2 585

•  Заборы и коммивояжеры  3 385

•  Игра HIP  2 325

•  Игра Go (Го)  2 222

•  Симулятор лифта  2 627

•  Программа укладки плитки  2 210

•  Генератор лабиринта  2 731

•  Проверка числового ввода  2 366

•  HEX View  2 708

•  Физический маятник  2 378

 
скрыть

Задать цвет фона для 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.