Àêæàí â ñåòè - Íà óðîâåíü ââåðõ(VCL, API) Êàê çàäàòü â êà÷åñòâå ôîíà MDIForm êàðòèíêó èç TBitmap?

ß äåëàë òàê:

type
  .... =class(TForm)
    ....
    procedure FormCreate(Sender:TObject);
    procedure FormDestroy(Sender:TObject);
    ....
  private
    FHBrush:HBRUSH;
    FCover:TBitmap;
    FNewClientInstance:TFarProc;
    FOldClientInstance:TFarProc;
    procedure NewClientWndProc(var Message:TMessage);
    ....
  protected
    ....
    procedure CreateWnd;override;
    ....
  end;

.....

implementation

{$R myRes.res} //påñópñ ñ áèòìàïîì ôîíà

procedure .FormCreate(...);
var
  LogBrush:TLogbrush;
begin
  FCover:=TBitmap.Create;
  FCover.LoadFromResourceName(hinstance,'BMPCOVER');
  With LogBrush do
  begin
    lbStyle:=BS_PATTERN;
    lbHatch:=FCover.Handle;
  end;
  FHBrush:=CreateBrushIndirect(Logbrush);
end;

procedure .FormDestroy(...);
begin
  DeleteObject(FHBrush);
  FCover.Free;
end;

procedure .CreateWnd;
begin
  inherited CreateWnd;
  if (ClientHandle <> 0) then
  begin
    if NewStyleControls then
      SetWindowLong(ClientHandle, GWL_EXSTYLE, WS_EX_CLIENTEDGE or
        GetWindowLong(ClientHandle, GWL_EXSTYLE));

    FNewClientInstance:=MakeObjectInstance(NewClientWndProc);
    FOldClientInstance:=pointer(GetWindowLong(ClientHandle,GWL_WNDPROC));
    SetWindowLong(ClientHandle,GWL_WNDPROC,longint(FNewClientInstance));
  end;
end;

procedure .NewClientWndProc(var Message:TMessage);

  procedure Default;
  begin
    with Message do
      Result := CallWindowProc(FOldClientInstance, ClientHandle, Msg, wParam,
        lParam);
  end;

begin
  with Message do
  begin
    case Msg of
      WM_ERASEBKGND:
      begin
        FillRect(TWMEraseBkGnd(Message).DC, ClientRect,FHBrush);
        Result := 1;
      end;
      else
        Default;
    end;
  end;
end;

Alex Miachin

(2:5000/81.12)