На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Поиск Участники Календарь Избранное RSS
msm.ru
Модераторы: Rouse_, jack128, Krid
  
    > TOleContainer , с работающим цветом фона
    Testudo
    Сообщ. #1 ,

      Master
      ******
      Профиль · PM
      Рейтинг (т): 105
      В методе TOleContainer.Paint используется функция DrawEdge, которая и заполняет все серым цветом (clBtnFace), вне зависимости от выбранного цвета Color. Лично мне это очень мешало сдать один проект.
      Для исправления глюка пришлось написать компонентик.
      Он использует слегка переписанный Paint. (Несколько функций добавлены для получения приватных свойств).
      ExpandedWrap disabled
        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.
      0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
      0 пользователей:


        Рейтинг@Mail.ru
        [ Script execution time: 0,0170 ]   [ 17 queries used ]   [ Generated: 18.04.24, 23:34 GMT ]  
        Powered by Invision Power Board(U) v1.2 © 2003  IPS, Inc.