thememgr.pas

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

        else
          FCheckListBoxList.DispatchMessage(Control, Message);
        end;
      end
      else
        FCheckListBoxList.DispatchMessage(Control, Message);
    end
    else
      FCheckListBoxList.DispatchMessage(Control, Message);
  end;

{$endif CheckListSupport}

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

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

var
  DC: HDC;

begin
  case Message.Msg of
    CM_CONTROLLISTCHANGE: // Single control addition or removal.
      with TCMControlListChange(Message) do
        HandleControlChange(Control, Inserting);
  end;

  if not DoControlMessage(Control, Message) then
  begin
    if ThemeServices.ThemesEnabled then
    begin
      case Message.Msg of
        WM_PRINTCLIENT,
        WM_ERASEBKGND:
          begin
            if (Message.Msg=WM_PRINTCLIENT) then
              DC := TWMPrintClient(Message).DC
            else
              DC := TWMEraseBkGnd(Message).DC;

            // Get the parent to draw its background into the form's background.
            if not (Control.Parent is TWinControl) then
              FFormList.DispatchMessage(Control, Message)
            else
              if TWinControl(Control.Parent).DoubleBuffered then
                PerformEraseBackground(Control, DC)
              else
                if TWinControl(Control).DoubleBuffered then
                begin
                  if (Message.Msg <> WM_ERASEBKGND) or (Longint(DC) = TWMEraseBkGnd(Message).Unused) then
                    //  VCL mark for second pass, this time into the offscreen bitmap
                    PerformEraseBackground(Control, DC);
                end
            else
              DrawThemeParentBackground(TWinControl(Control).Handle, DC, nil);
            Message.Result := 1;
          end;
      else
        FFormList.DispatchMessage(Control, Message);
      end;
    end
    else
      FFormList.DispatchMessage(Control, Message);
  end;
end;

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

{$ifdef COMPILER_5_UP}

  type
    // Used to access protected properties.
    TFrameCast = class(TCustomFrame);

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

  var
    PS: TPaintStruct;
    Details: TThemedElementDetails;

  begin
    if not DoControlMessage(Control, Message) then
    begin
      if ThemeServices.ThemesEnabled then
      begin
        case Message.Msg of
          WM_ERASEBKGND:
            with TWMEraseBkGnd(Message) do
            begin
              // Get the parent to draw its background into the control's background.
              if TWinControl(Control.Parent).DoubleBuffered then
                PerformEraseBackground(Control, DC)
              else
              begin
                Details := ThemeServices.GetElementDetails(tbGroupBoxNormal);
                ThemeServices.DrawParentBackground(TWinControl(Control).Handle, DC, @Details, False);
              end;
              Result := 1;
            end;
          WM_PAINT:
            begin
              BeginPaint(TFrameCast(Control).Handle, PS);
              TFrameCast(Control).PaintControls(PS.hdc, nil);
              EndPaint(TFrameCast(Control).Handle, PS);
              Message.Result := 0;
            end;
        else
          FFrameList.DispatchMessage(Control, Message);
        end;
      end
      else
        FFrameList.DispatchMessage(Control, Message);
    end;
  end;
  
{$endif COMPILER_5_UP}

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

function TThemeManager.GetIsMainManager: Boolean;

begin
  Result := MainManager = Self;
end;

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

type
  // Used to access protected properties.
  TGroupBoxCast = class(TCustomGroupBox);

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

  //--------------- local function --------------------------------------------

  procedure NewPaint(DC: HDC);

  var
    CaptionRect,
    OuterRect: TRect;
    Size: TSize;
    LastFont: HFONT;
    Box: TThemedButton;
    Details: TThemedElementDetails;

  begin
    with TGroupBoxCast(Control) do
    begin
      LastFont := SelectObject(DC, Font.Handle);
      if Text <> '' then
      begin
        SetTextColor(DC, Graphics.ColorToRGB(Font.Color));
        // Determine size and position of text rectangle.
        // This must be clipped out before painting the frame.
        GetTextExtentPoint32(DC, PChar(Text), Length(Text), Size);
        CaptionRect := Rect(0, 0, Size.cx, Size.cy);
        if not UseRightToLeftAlignment then
          OffsetRect(CaptionRect, 8, 0)
        else
          OffsetRect(CaptionRect, Width - 8 - CaptionRect.Right, 0);
      end
      else
        CaptionRect := Rect(0, 0, 0, 0);

      OuterRect := ClientRect;
      OuterRect.Top := (CaptionRect.Bottom - CaptionRect.Top) div 2;
      with CaptionRect do
        ExcludeClipRect(DC, Left, Top, Right, Bottom);
      if Control.Enabled then
        Box := tbGroupBoxNormal
      else
        Box := tbGroupBoxDisabled;
      Details := ThemeServices.GetElementDetails(Box);
      ThemeServices.DrawElement(DC, Details, OuterRect);

      SelectClipRgn(DC, 0);
      if Text <> '' then
        ThemeServices.DrawText(DC, Details, Text, CaptionRect, DT_LEFT, 0);
      SelectObject(DC, LastFont);
    end;
  end;

  //--------------- local function --------------------------------------------

var
  PS: TPaintStruct;
  Details: TThemedElementDetails;

begin
  if not DoControlMessage(Control, Message) then
  begin
    if ThemeServices.ThemesEnabled then
    begin
      case Message.Msg of
        WM_SYSKEYDOWN,
        CN_KEYDOWN,
        WM_KEYDOWN:
          begin
            UpdateUIState(Control, TWMKey(Message).CharCode);
            FGroupBoxList.DispatchMessage(Control, Message);
          end;
        WM_ERASEBKGND:
          with TWMEraseBkGnd(Message) do
          begin
            // Get the parent to draw its background into the control's background.
            if TWinControl(Control.Parent).DoubleBuffered then
              PerformEraseBackground(Control, DC)
            else
            begin
              Details := ThemeServices.GetElementDetails(tbGroupBoxNormal);
              ThemeServices.DrawParentBackground(TGroupBoxCast(Control).Handle, DC, @Details, True);
            end;
            Result := 1;
          end;
        WM_PAINT:
          begin
            BeginPaint(TGroupBoxCast(Control).Handle, PS);
            NewPaint(PS.hdc);
            TGroupBoxCast(Control).PaintControls(PS.hdc, nil);
            EndPaint(TGroupBoxCast(Control).Handle, PS);
            Message.Result := 0;
          end;
      else
        FGroupBoxList.DispatchMessage(Control, Message);
      end;
    end
    else
      FGroupBoxList.DispatchMessage(Control, Message);
  end;
end;

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

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

begin
  if not DoControlMessage(Control, Message) then
  begin
    // In opposition to the other window procedures we should always apply the fix for TListView,
    // regardless of whether themes are enabled or not.
    if (Message.Msg = LVM_SETCOLUMN) or (Message.Msg = LVM_INSERTCOLUMN) then
    begin
      with PLVColumn(Message.LParam)^ do
      begin
        // Fix TListView report mode bug.
        if iImage = - 1 then
          Mask := Mask and not LVCF_IMAGE;
      end;
    end;

    // This special notification message is not handled in the VCL and creates an access violation when
    // passed to the default window procedure. Ignoring it does not seem to have any negative impact.
    if not ((Message.Msg = WM_NOTIFY) and (TWMNotify(Message).NMHdr.code = HDN_GETDISPINFOW)) then
      FListViewList.DispatchMessage(Control, Message);
  end;
end;

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

function TThemeManager.MainWindowHook(var Message: TMessage): Boolean;

// Listens to messages sent to the application to know when a theme change occured.

var
  Form: TCustomForm;
  
begin
  Result := False;

  // If the main manager was destroyed then it posted this message to the application so all still existing
  // theme managers know a new election is due. Well, it is not purely democratic. The earlier a manager was created
  // the higher is the probability to get this message first and become the new main manager.
  if Message.Msg = WM_MAINMANAGERRELEASED then
  begin
    Lock.Enter;
    try
      // Check if the main manager role is still vacant.
      if MainManager = nil then
      begin
        MainManager := Self;
        FSubclassingDisabled := False;
        CollectForms;
      end;
    finally
      Lock.Leave;
    end;
  end;

  // Check first if there are still forms to subclass.
  while FPendingFormsList.Count > 0 do
  begin
    Form := TCustomForm(FPendingFormsList[0]);
    FPendingFormsList.Delete(0);
    FFormList.Add(Form);
    // Since we don't know how many controls on this form already have been created we better collect everything
    // which is already there. The window proc lists will take care not to add a control twice.
    if MainManager = Self then
      CollectControls(Form);
    if [toResetMouseCapture, toSetTransparency] * FOptions <> [] then
      FixControls(Form);
    // Sometimes not all controls are visually updated. Force it to be correct.
    RedrawWindow(Form.Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN or RDW_VALIDATE);
  end;

  while FPendingRecreationList.Count > 0 do
  begin
    TWinControl(FPendingRecreationList[0]).HandleNeeded;
    CollectControls(TWinControl(FPendingRecreationList[0]));
    FPendingRecreationList.Delete(0);
  end;

  if Message.Msg = WM_THEMECHANGED then
  begin
    UpdateThemes;
    DoOnThemeChange;
  end;
end;

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

type
  // Used to access protected properties.
  TPanelCast = class(TCustomPanel);

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

var
  DrawRect: TRect;
  DC: HDC;
  OldFont: HFONT;
  PS: TPaintStruct;
  Details: TThemedElementDetails;

  //--------------- local function --------------------------------------------

  procedure NewPaint;

  // This is an adapted version of the actual TCustomPanel.Paint procedure

  const
    Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);

  var
    Rect: TRect;
    TopColor, BottomColor: TColor;
    FontHeight: Integer;
    Flags: Longint;

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

    procedure AdjustColors(Bevel: TPanelBevel);

    begin
      TopColor := clBtnHighlight;
      if Bevel = bvLowered then
        TopColor := clBtnShadow;
      BottomColor := clBtnShadow;
      if Bevel = bvLowered then
        BottomColor := clBtnHighlight;
    end;

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