Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[3.147.73.35] |
|
Сообщ.
#1
,
|
|
|
В методе TOleContainer.Paint используется функция DrawEdge, которая и заполняет все серым цветом (clBtnFace), вне зависимости от выбранного цвета Color. Лично мне это очень мешало сдать один проект.
Для исправления глюка пришлось написать компонентик. Он использует слегка переписанный Paint. (Несколько функций добавлены для получения приватных свойств). unit FixOleContainerUnit; interface uses Windows, Messages, CommCtrl, ActiveX, OleDlg, SysUtils, Classes, Controls, Forms, Menus, Graphics, ComObj, OleCtnrs, ExtCtrls; type TFixOleContainer = class(TOleContainer) private { Private declarations } protected { Protected declarations } procedure Paint; override; public { Public declarations } published { Published declarations } end; procedure Register; implementation procedure AdjustColors(Bevel: TPanelBevel; var TopColor, BottomColor: tColor; HighLightColor, ShadowColor: tColor); begin TopColor := HighLightColor; if Bevel = bvLowered then TopColor := ShadowColor; BottomColor := ShadowColor; if Bevel = bvLowered then BottomColor := HighLightColor; end; procedure TFixOleContainer.Paint; function IsDocObj : boolean; var wnd: HWND; begin (Self as IOleInPlaceSite).GetWindow(wnd); result := wnd = Handle; end; function GetDrawAspect (Check : TOleContainer) : LongInt; begin if Check.Iconic then Result := DVASPECT_ICON else Result := DVASPECT_CONTENT; end; procedure GetViewSize (Check : TOleContainer; var ViewSize : TPoint); begin Check.OleObjectInterface.GetExtent(DVASPECT_CONTENT, ViewSize); end; function HimetricToPixels(const P: TPoint): TPoint; begin Result.X := MulDiv(P.X, Screen.PixelsPerInch, 2540); Result.Y := MulDiv(P.Y, Screen.PixelsPerInch, 2540); end; var W, H: Integer; S: TPoint; R, CR: TRect; X, Y : integer; EmptyText : string; TopColor, BottomColor : TColor; ViewSize : TPoint; DrawAspect : LongInt; begin CR := Rect(0,0,Width,Height); Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := Color; Canvas.FillRect(CR); if BorderStyle=bsSingle then begin AdjustColors(bvLowered, TopColor, BottomColor, clBtnHighlight, clBlack); Frame3D(Canvas, CR, TopColor, BottomColor, 1); AdjustColors(bvLowered, TopColor, BottomColor, clBtnFace, clBlack); Frame3D(Canvas, CR, TopColor, BottomColor, 1); end; if IsDocObj and (State = osUIActive) then exit; if State = osEmpty then begin with Canvas do begin EmptyText := Caption; if EmptyText = '' then EmptyText := '<пусто>'; x := round((CR.Right-Canvas.TextWidth(EmptyText))/2); y := round((CR.Bottom-Canvas.TextHeight(EmptyText))/2); TextOut(x,y,EmptyText); end; if Focused then Canvas.DrawFocusRect(CR); exit; end; if OleObjectInterface <> nil then begin W := CR.Right - CR.Left; H := CR.Bottom - CR.Top; GetViewSize(Self, ViewSize); DrawAspect := GetDrawAspect(Self); 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); end; if Focused then Canvas.DrawFocusRect(CR); end; procedure Register; begin RegisterComponents('System', [TFixOleContainer]); end; end. |