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.