thememgr.pas

Last change: 2008-02-03 This is the source code of KCeasy。

  FPanelList := TWindowProcList.Create(Self, PrePanelWindowProc, TCustomPanel);
  FWinControlList := TWindowProcList.Create(Self, PreWinControlWindowProc, TWinControl);

  if csDesigning in ComponentState then
    FSubclassingDisabled := True
  else
  begin
    if ThemeServices.ThemesEnabled then
    begin
      Application.HookMainWindow(MainWindowHook);
      FHookWasInstalled := True;
    end
    else
      FHookWasInstalled := False;
    
    // Keep the reference of this instance if it is the first one created in the application.
    Lock.Enter;
    try
      // If this is not the first instance then disable subclassing.
      if MainManager = nil then
        MainManager := Self
      else
      begin
        FSubclassingDisabled := True;
        FOptions := MainManager.FOptions;
      end;
    finally
      Lock.Leave;
    end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

destructor TThemeManager.Destroy;

begin
  FWinControlList.Free;
  FPanelList.Free;
  {$ifdef COMPILER_5_UP}
    FFrameList.Free;
  {$endif COMPILER_5_UP}
  FFormList.Free;
  {$ifdef CheckListSupport}
    FCheckListBoxList.Free;
  {$endif CheckListSupport}
  FStatusBarList.Free;
  FAnimateList.Free;
  FTrackBarList.Free;
  FSpeedButtonList.Free;
  FSplitterList.Free;
  FButtonControlList.Free;
  FListViewList.Free;
  FTabSheetList.Free;
  FGroupBoxList.Free;

  // Reset first manager reference if it is set to this instance.
  if not (csDesigning in ComponentState) then
  begin
    if FHookWasInstalled then
      Application.UnhookMainWindow(MainWindowHook);

    // We have to check the critical section here because it can happen that it is already freed (finalization section)
    // but there is still a theme manager instance lurking around, due to the finalization order.
    // If there is no lock anymore then the app. is being terminated and we don't need to set a new main manager.
    if Assigned(Lock) then
    begin
      Lock.Enter;
      try
        if MainManager = Self then
        begin
          MainManager := nil;
          if Application.Handle <> 0 then
            SendAppMessage(WM_MAINMANAGERRELEASED, 0, 0);
        end;
      finally
        Lock.Leave;
      end;
    end;
  end;

  FPendingFormsList.Free;
  FPendingRecreationList.Free;
  FListeners.Free;

  inherited;
end;

//----------------------------------------------------------------------------------------------------------------------

type
  // Used to access protected methods and properties.
  TWinControlCast = class(TWinControl);

procedure TThemeManager.AnimateWindowProc(Control: TControl; var Message: TMessage);

begin
  if not DoControlMessage(Control, Message) then
  begin
    if ThemeServices.ThemesEnabled then
    begin
      case Message.Msg of
        WM_ERASEBKGND:
          Message.Result := 1;
        CN_CTLCOLORSTATIC:
          if TAnimate(Control).Transparent then
            with TWMCtlColorStatic(Message) do
            begin
              // Return a brush corresponding to the control's fixed background color.
              // The animation control insists on always erasing its background.
              Result := GetSysColorBrush(TWinControlCast(Control).Color and not $80000000);
              {ThemeServices.DrawParentBackground(TWinControl(Control).Handle, ChildDC, nil, False);
              SetBkMode(ChildDC, TRANSPARENT);
              // Return an empty brush to prevent Windows from overpainting we just have created.
              Result := GetStockObject(NULL_BRUSH);}
            end
          else
            FAnimateList.DispatchMessage(Control, Message);
      else
        FAnimateList.DispatchMessage(Control, Message);
      end;
    end
    else
      FAnimateList.DispatchMessage(Control, Message);
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TThemeManager.ButtonControlWindowProc(Control: TControl; var Message: TMessage);

var                                                     
  Details: TThemedElementDetails;
                                                                
begin
  if not DoControlMessage(Control, Message) then
  begin
    if ThemeServices.ThemesEnabled then
    begin
      case Message.Msg of
        CN_KEYDOWN,
        WM_SYSKEYDOWN,
        WM_KEYDOWN:
          begin
            UpdateUIState(Control, TWMKey(Message).CharCode);
            FButtonControlList.DispatchMessage(Control, Message);
          end;
        WM_ERASEBKGND:
          Message.Result := 1;
        CN_CTLCOLORBTN: // TButton background erasing. Necessary for some themes (like EclipseOSX).
          with TWMCtlColorBtn(Message) do
          begin
            if TWinControl(Control.Parent).DoubleBuffered then
              PerformEraseBackground(Control, ChildDC)
            else
              ThemeServices.DrawParentBackground(TWinControl(Control).Handle, ChildDC, nil, False);
            // Return an empty brush to prevent Windows from overpainting we just have created.
            Result := GetStockObject(NULL_BRUSH);
          end;
        CN_CTLCOLORSTATIC: // Background erasing for check boxes and radio buttons. 
          with TWMCtlColorStatic(Message) do
          begin
            if TWinControl(Control.Parent).DoubleBuffered then
              PerformEraseBackground(Control, ChildDC)
            else
              ThemeServices.DrawParentBackground(TWinControl(Control).Handle, ChildDC, nil, False);
            // Return an empty brush to prevent Windows from overpainting we just have created.
            Result := GetStockObject(NULL_BRUSH);
          end;
        CM_MOUSEENTER,
        CM_MOUSELEAVE:
          begin
            // Hot tracking for owner drawn buttons seems to be unsupported by Windows. So we have to work around that.
            if Control is TBitBtn then
              Control.Invalidate;
            FButtonControlList.DispatchMessage(Control, Message);
          end;
        CN_DRAWITEM: // Painting for owner drawn buttons.
          with TWMDrawItem(Message) do
          begin
            // This message is sent for bit buttons (TBitBtn) when they must be drawn. Since a bit button is a normal
            // Windows button (but with custom draw enabled) it is handled here too.
            // TSpeedButton is a TGraphicControl descentant and handled separately.
            Details := ThemeServices.GetElementDetails(tbPushButtonNormal);
            ThemeServices.DrawParentBackground(TWinControl(Control).Handle, DrawItemStruct.hDC, @Details, True);

            // CN_DRAWITEM can also come in when the control is a subclassed button with enabled custom draw.
            // In this case the content of the control is fully controlled by the original source. So let it do
            // whatever it wants to do.
            if (Control is TBitBtn) or (Control is TSpeedButton) then
              DrawBitBtn(TBitBtn(Control), DrawItemStruct^)
            else
              FButtonControlList.DispatchMessage(Control, Message);
          end;
      else
        FButtonControlList.DispatchMessage(Control, Message);
      end;
    end
    else
      FButtonControlList.DispatchMessage(Control, Message);
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

{$ifdef CheckListSupport}
  type
    TCheckListBoxCast = class(TCheckListBox);

  procedure TThemeManager.CheckListBoxWindowProc(Control: TControl; var Message: TMessage);

  var
    DrawState: TOwnerDrawState;
    ListBox: TCheckListBoxCast;

    //--------------- local functions -------------------------------------------

    procedure DrawCheck(R: TRect; AState: TCheckBoxState; Enabled: Boolean);

    var
      DrawRect: TRect;
      Button: TThemedButton;
      Details: TThemedElementDetails;

    begin
      DrawRect.Left := R.Left + (R.Right - R.Left - GlobalCheckWidth) div 2;
      DrawRect.Top := R.Top + (R.Bottom - R.Top - GlobalCheckWidth) div 2;
      DrawRect.Right := DrawRect.Left + GlobalCheckWidth;
      DrawRect.Bottom := DrawRect.Top + GlobalCheckHeight;
      case AState of
        cbChecked:
          if Enabled then
            Button := tbCheckBoxCheckedNormal
          else
            Button := tbCheckBoxCheckedDisabled;
        cbUnchecked:
          if Enabled then
            Button := tbCheckBoxUncheckedNormal
          else
            Button := tbCheckBoxUncheckedDisabled;
        else // cbGrayed
          if Enabled then
            Button := tbCheckBoxMixedNormal
          else
            Button := tbCheckBoxMixedDisabled;
      end;

      Details := ThemeServices.GetElementDetails(Button);
      ThemeServices.DrawElement(ListBox.Canvas.Handle, Details, DrawRect, @DrawRect);
    end;

    //---------------------------------------------------------------------------
  
    procedure NewDrawItem(Index: Integer; Rect: TRect; DrawState: TOwnerDrawState);

    var
      Flags: Integer;
      Data: string;
      R: TRect;
      ACheckWidth: Integer;
      Enable: Boolean;

    begin
      with ListBox do
      begin
        // The checkbox is always drawn, regardless of the owner draw style.
        ACheckWidth := GetCheckWidth;
        if Index < Items.Count then
        begin
          R := Rect;
          // Delphi 4 has neither an enabled state nor a header state for items.
          Enable := Enabled {$ifdef COMPILER_6_UP} and ItemEnabled[Index] {$endif COMPILER_6_UP};
          if {$ifdef COMPILER_6_UP} not Header[Index] {$else} True {$endif COMPILER_6_UP} then
          begin
            if not UseRightToLeftAlignment then
            begin
              R.Right := Rect.Left;
              R.Left := R.Right - ACheckWidth;
            end
            else
            begin
              R.Left := Rect.Right;
              R.Right := R.Left + ACheckWidth;
            end;
            DrawCheck(R, State[Index], Enable);
          end
          else
          begin
            {$ifdef COMPILER_6_UP}
              Canvas.Font.Color := HeaderColor;
              Canvas.Brush.Color := HeaderBackgroundColor;
            {$endif COMPILER_6_UP}
          end;
          if not Enable then
            Canvas.Font.Color := clGrayText;
        end;

        if Assigned(OnDrawItem) and (Style <> lbStandard)then
          OnDrawItem(ListBox, Index, Rect, DrawState)
        else
        begin
          Canvas.FillRect(Rect);
          if Index < {$ifdef COMPILER_6_UP} Count {$else} Items.Count {$endif COMPILER_6_UP}then
          begin
            Flags := DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
            if not UseRightToLeftAlignment then
              Inc(Rect.Left, 2)
            else
              Dec(Rect.Right, 2);
            Data := '';
            {$ifdef COMPILER_6_UP}
              if (Style in [lbVirtual, lbVirtualOwnerDraw]) then
                Data := DoGetData(Index)
              else
            {$endif COMPILER_6_UP}
                Data := Items[Index];

            DrawText(Canvas.Handle, PChar(Data), Length(Data), Rect, Flags);
          end;
        end;
      end;
    end;
  
    //--------------- end local function ----------------------------------------

  begin
    if not DoControlMessage(Control, Message) then
    begin
      if ThemeServices.ThemesEnabled then
      begin
        ListBox := TCheckListBoxCast(Control);
        case Message.Msg of
          CN_DRAWITEM:
            if {$ifdef COMPILER_6_UP} ListBox.Count > 0 {$else} ListBox.Items.Count > 0 {$endif COMPILER_6_UP} then
              with TWMDrawItem(Message).DrawItemStruct^, ListBox do
              begin
                if {$ifdef COMPILER_6_UP} not Header[itemID] {$else} True {$endif COMPILER_6_UP} then
                  if not UseRightToLeftAlignment then
                    rcItem.Left := rcItem.Left + GetCheckWidth
                  else
                    rcItem.Right := rcItem.Right - GetCheckWidth;
                {$ifdef COMPILER_5_UP}
                  DrawState := TOwnerDrawState(LongRec(itemState).Lo);
                {$else}
                  DrawState := TOwnerDrawState(Byte(LongRec(itemState).Lo));
                {$endif COMPILER_5_UP}
                Canvas.Handle := hDC;
                Canvas.Font := Font;
                Canvas.Brush := Brush;
                if (Integer(itemID) >= 0) and (odSelected in DrawState) then
                begin
                  Canvas.Brush.Color := clHighlight;
                  Canvas.Font.Color := clHighlightText
                end;
                if Integer(itemID) >= 0 then
                  NewDrawItem(itemID, rcItem, DrawState)
                else
                  Canvas.FillRect(rcItem);
                if odFocused in DrawState then
                  DrawFocusRect(hDC, rcItem);
                Canvas.Handle := 0;
              end;