Author: Peter Below
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.
1 procedure TStructureBox.Paint;
2
3 function DrawAspect: Longint;
4 begin
5 if Iconic then
6 result := DVASPECT_ICON
7 else
8 result := DVASPECT_CONTENT
9 end;
10
11 function DocObj: boolean;
12 var
13 wnd: HWND;
14 begin
15 (Self as IOleInPlaceSite).GetWindow(wnd);
16 result := wnd = Handle;
17 end;
18
19 function UIActive: Boolean;
20 begin
21 result := state = osUIActive;
22 end;
23
24 function ObjectOpen: Boolean;
25 begin
26 result := state = osOpen;
27 end;
28
29 function Viewsize: TPoint;
30 var
31 ViewObject2: IViewObject2;
32 begin
33 if Succeeded(OleObjectInterface.QueryInterface(IViewObject2, ViewObject2)) then
34 ViewObject2.GetExtent(DrawAspect, -1, nil, Result)
35 else
36 Result := Point(0, 0);
37 end;
38
39 var
40 W, H: Integer;
41 S: TPoint;
42 R, CR: TRect;
43 Flags: Integer;
44 begin
45 if DocObj and UIActive then
46 Exit;
47 CR := Rect(0, 0, Width, Height);
48 if BorderStyle = bsSingle then
49 begin
50 if NewStyleControls and Ctl3D then
51 Flags := BF_ADJUST or BF_RECT
52 else
53 Flags := BF_ADJUST or BF_RECT or BF_MONO;
54 end
55 else
56 Flags := BF_FLAT;
57 Canvas.Brush.Style := bsSolid;
58 Canvas.Brush.Color := Color;
59 {Main modification are the following two lines}
60 DrawEdge(Canvas.Handle, CR, EDGE_SUNKEN, Flags);
61 Canvas.FillRect(CR);
62 if OleObjectInterface <> nil then
63 begin
64 W := CR.Right - CR.Left;
65 H := CR.Bottom - CR.Top;
66 S := HimetricToPixels(ViewSize);
67 if (DrawAspect = DVASPECT_CONTENT) and (SizeMode = smScale) then
68 if W * S.Y > H * S.X then
69 begin
70 S.X := S.X * H div S.Y;
71 S.Y := H;
72 end
73 else
74 begin
75 S.Y := S.Y * W div S.X;
76 S.X := W;
77 end;
78 if (DrawAspect = DVASPECT_ICON) or (SizeMode = smCenter) or (SizeMode = smScale)
79 then
80 begin
81 R.Left := (W - S.X) div 2;
82 R.Top := (H - S.Y) div 2;
83 R.Right := R.Left + S.X;
84 R.Bottom := R.Top + S.Y;
85 end
86 else if SizeMode = smClip then
87 begin
88 SetRect(R, CR.Left, CR.Top, S.X, S.Y);
89 IntersectClipRect(Canvas.Handle, CR.Left, CR.Top, CR.Right, CR.Bottom);
90 end
91 else
92 SetRect(R, CR.Left, CR.Top, W, H);
93 OleDraw(OleObjectInterface, DrawAspect, Canvas.Handle, R);
94 if ObjectOpen then
95 ShadeRect(Canvas.Handle, CR);
96 end;
97 if Focused then
98 Canvas.DrawFocusRect(CR);
99 end;
|
