Change the color of a TOleContainer

Problem/Question/Abstract:

How to change the color of a TOleContainer

Answer:

Basically you have to make a descendent class and reimplement the Paint method. This has some snags to deal with, like references to private fields of the TOleContainer class. Here is an example from a custom TOleContainer descendent.

The Paint method is basically copied from TOlecontainer.Paint and modified to fix a bug in painting the controls background. TOlecontainer uses DrawEdge with BF_MIDDLE as flag and that fills the background gray, ignoring the color set for the control. Since TOLecontainer.Paint makes reference to a number of private fields of the controls some nested functions are introduced to get access to these fields values.

procedure TStructureBox.Paint;

function DrawAspect: Longint;
begin
if Iconic then
result := DVASPECT_ICON
else
result := DVASPECT_CONTENT
end;

function DocObj: boolean;
var
wnd: HWND;
begin
(Self as IOleInPlaceSite).GetWindow(wnd);
result := wnd = Handle;
end;

function UIActive: Boolean;
begin
result := state = osUIActive;
end;

function ObjectOpen: Boolean;
begin
result := state = osOpen;
end;

function Viewsize: TPoint;
var
ViewObject2: IViewObject2;
begin
if Succeeded(OleObjectInterface.QueryInterface(IViewObject2, ViewObject2)) then
ViewObject2.GetExtent(DrawAspect, -1, nil, Result)
else
Result := Point(0, 0);
end;

var
W, H: Integer;
S: TPoint;
R, CR: TRect;
Flags: Integer;
begin
if DocObj and UIActive then
Exit;
CR := Rect(0, 0, Width, Height);
if BorderStyle = bsSingle then
begin
if NewStyleControls and Ctl3D then
Flags := BF_ADJUST or BF_RECT
else
Flags := BF_ADJUST or BF_RECT or BF_MONO;
end
else
Flags := BF_FLAT;
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := Color;
{Main modification are the following two lines}
DrawEdge(Canvas.Handle, CR, EDGE_SUNKEN, Flags);
Canvas.FillRect(CR);
if OleObjectInterface <> nil then
begin
W := CR.Right - CR.Left;
H := CR.Bottom - CR.Top;
S := HimetricToPixels(ViewSize);
if (DrawAspect = DVASPECT_CONTENT) and (SizeMode = smScale) then
if W * S.Y > H * S.X then
begin
S.X := S.X * H div S.Y;
S.Y := H;
end
else
begin
S.Y := S.Y * W div S.X;
S.X := W;
end;
if (DrawAspect = DVASPECT_ICON) or (SizeMode = smCenter) or (SizeMode = smScale)
then
begin
R.Left := (W - S.X) div 2;
R.Top := (H - S.Y) div 2;
R.Right := R.Left + S.X;
R.Bottom := R.Top + S.Y;
end
else if SizeMode = smClip then
begin
SetRect(R, CR.Left, CR.Top, S.X, S.Y);
IntersectClipRect(Canvas.Handle, CR.Left, CR.Top, CR.Right, CR.Bottom);
end
else
SetRect(R, CR.Left, CR.Top, W, H);
OleDraw(OleObjectInterface, DrawAspect, Canvas.Handle, R);
if ObjectOpen then
ShadeRect(Canvas.Handle, CR);
end;
if Focused then
Canvas.DrawFocusRect(CR);
end;