tntthememgr.pas

Make your Delphi application UNICODE enabled.

      InflateRect(Rect, -BorderWidth, -BorderWidth);
      if BevelInner <> bvNone then
      begin
        AdjustColors(BevelInner);
        Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
      end;
      if ParentColor or ((Control.Parent <> nil) and (Control.Parent.Brush.Color = Color)) then
      begin
        if TWinControl(Control.Parent).DoubleBuffered then
          FTntThemeManager.PerformEraseBackground(Control, DC)
        else
        begin
          Details := ThemeServices.GetElementDetails(tbGroupBoxNormal);
          ThemeServices.DrawParentBackground(Handle, DC, @Details, False, @Rect);
        end
      end
      else
      begin
        Canvas.Brush.Style := bsSolid;
        Canvas.Brush.Color := Color;
        FillRect(DC, Rect, Canvas.Brush.Handle);
      end;
      FontHeight := WideCanvasTextHeight(Canvas, 'W');
      with Rect do
      begin
        Top := ((Bottom + Top) - FontHeight) div 2;
        Bottom := Top + FontHeight;
      end;
      Flags := DT_EXPANDTABS or DT_VCENTER or Alignments[Alignment];
      Flags := DrawTextBiDiModeFlags(Flags);
      OldFont := SelectObject(DC, Font.Handle);
      SetBKMode(DC, TRANSPARENT);
      SetTextColor(DC, ColorToRGB(Font.Color));
      Tnt_DrawTextW(DC, PWideChar(Caption), -1, Rect, Flags);
      SelectObject(DC, OldFont);
    finally
      Canvas.Handle := 0;
    end;
  end;
end;

procedure TTntThemeManagerHelper.Panel_WM_PAINT(Control: TControl; var Message: TMessage);
var
  DC: HDC;
  PS: TPaintStruct;
begin
  with TPanelCast(Control as TTntCustomPanel) do begin
    DC := BeginPaint(Handle, PS);
    Panel_NewPaint(Control, DC);
    PaintControls(DC, nil);
    EndPaint(Handle, PS);
    Message.Result := 0;
  end;
end;

procedure TTntThemeManagerHelper.Panel_WM_PRINTCLIENT(Control: TControl; var Message: TMessage);
var
  DC: HDC;
begin
  with TPanelCast(Control as TTntCustomPanel) do
  begin
    DC := TWMPrintClient(Message).DC;
    Panel_NewPaint(Control, DC);
    PaintControls(DC, nil);
    Message.Result := 0;
  end;
end;

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

function ClickedToolButton(ToolBar: TToolBar{TNT-ALLOW TToolBar}; var Message: TWMMouse): TToolButton{TNT-ALLOW TToolButton};
var
  Control: TControl;
begin
  Result := nil;
  Control := ToolBar.ControlAtPos(SmallPointToPoint(Message.Pos), False);
  if (Control <> nil) and (Control is TToolButton{TNT-ALLOW TToolButton}) and not Control.Dragging then
    Result := TToolButton{TNT-ALLOW TToolButton}(Control);
end;

var LastClickedButton: TToolButton{TNT-ALLOW TToolButton};

procedure TTntThemeManagerHelper.ToolBar_WM_LBUTTONDOWN(Control: TControl; var Message: TMessage);
begin
  LastClickedButton := ClickedToolButton(Control as TToolBar{TNT-ALLOW TToolBar}, TWMMouse(Message));
end;

procedure TTntThemeManagerHelper.ToolBar_WM_LBUTTONUP(Control: TControl; var Message: TMessage);
var
  ToolButton: TToolButton{TNT-ALLOW TToolButton};
begin
  ToolButton := ClickedToolButton(Control as TToolBar{TNT-ALLOW TToolBar}, TWMMouse(Message));
  if (ToolButton <> nil)
  and (ToolButton = LastClickedButton)
  and (not (csCaptureMouse in ToolButton.ControlStyle)) then begin
    SetCaptureControl(LastClickedButton); // TToolBar is depending on this
    PostMessage((Control as TToolBar{TNT-ALLOW TToolBar}).Handle, WM_CANCELMODE, 0, 0); // this is to clean it up
  end;
end;

procedure TTntThemeManagerHelper.ToolBar_WM_CANCELMODE(Control: TControl; var Message: TMessage);
begin
  if (GetCaptureControl = nil) 
  or (GetCaptureControl = LastClickedButton) then
    SetCaptureControl(nil);
  LastClickedButton := nil;
end;

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

procedure TTntThemeManagerHelper.DrawBitBtn(Control: TBitBtn{TNT-ALLOW TBitBtn}; var DrawItemStruct: TDrawItemStruct);
var
  Button: TThemedButton;
  R: TRect;
  Wnd: HWND;
  P: TPoint;
begin
  with DrawItemStruct do
  begin
    // For owner drawn buttons we will never get the ODS_HIGHLIGHT flag. This makes it necessary to
    // check ourselves if the button is "hot".
    GetCursorPos(P);
    Wnd := WindowFromPoint(P);
    if Wnd = TWinControl(Control).Handle then
      itemState := itemState or ODS_HOTLIGHT;
    R := rcItem;
    if not Control.Enabled then
      Button := tbPushButtonDisabled
    else
      if (itemState and ODS_SELECTED) <> 0 then
        Button := tbPushButtonPressed
      else
        if (itemState and ODS_HOTLIGHT) <> 0 then
          Button := tbPushButtonHot
        else
          // It seems ODS_DEFAULT is never set, so we have to check the control's properties.
          if Control.Default or ((itemState and ODS_FOCUS) <> 0) then
            Button := tbPushButtonDefaulted
          else
            Button := tbPushButtonNormal;

    DrawButton(Control, Button, hDC, R, itemState and ODS_FOCUS <> 0);
  end;
end;

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

procedure CalcButtonLayout(Control: TControl; DC: HDC; const Client: TRect; const Offset: TPoint; var GlyphPos: TPoint;
  var TextBounds: TRect; BiDiFlags: Integer);
var
  Layout: TButtonLayout;
  Spacing: Integer;
  Margin: Integer;
  Caption: TWideCaption;
begin
  if Control is TTntBitBtn then
  begin
    Layout := TTntBitBtn(Control).Layout;
    Spacing := TTntBitBtn(Control).Spacing;
    Margin := TTntBitBtn(Control).Margin;
    Caption := TTntBitBtn(Control).Caption;
  end
  else if Control is TTntSpeedButton then
  begin
    Layout := TTntSpeedButton(Control).Layout;
    Spacing := TTntSpeedButton(Control).Spacing;
    Margin := TTntSpeedButton(Control).Margin;
    Caption := TTntSpeedButton(Control).Caption;
  end else
    raise Exception.Create('TNT Internal Error: Wrong button class in CalcButtonLayout.');

  TButtonGlyph_CalcButtonLayout(Control, DC, Client, Offset, Caption, Layout, Margin,
    Spacing, GlyphPos, TextBounds, BiDiFlags);
end;

type
  TSpeedButtonCast = class(TTntSpeedButton);
  TControlCast = class(TControl);

procedure TTntThemeManagerHelper.DrawButton(Control: TControl; Button: TThemedButton; DC: HDC; R: TRect; Focused: Boolean);
// Common paint routine for TTntBitBtn and TTntSpeedButton.
var
  TextBounds: TRect;
  LastFont: HFONT;
  Glyph: TBitmap;
  GlyphPos: TPoint;
  GlyphWidth: Integer;
  GlyphSourceX: Integer;
  GlyphMask: TBitmap;
  Offset: TPoint;
  ToolButton: TThemedToolBar;
  Details: TThemedElementDetails;
begin
  GlyphSourceX := 0;
  GlyphWidth := 0;
  ToolButton := ttbToolbarDontCare;
  if Control is TTntBitBtn then
  begin
    Glyph := TTntBitBtn(Control).Glyph;
    // Determine which image to use (if there is more than one in the glyph).
    with TTntBitBtn(Control), Glyph do
    begin
      if not Empty then
      begin
        GlyphWidth := Width div NumGlyphs;
        if not Enabled and (NumGlyphs > 1) then
          GlyphSourceX := GlyphWidth
        else
          if (Button = tbPushButtonPressed) and (NumGlyphs > 2) then
            GlyphSourceX := 2 * GlyphWidth;
      end;
    end;
  end
  else
  begin
    Assert(Control is TTntSpeedButton, 'TNT Internal Error: Wrong button type in TTntThemeManagerHelper.DrawButton');
    Glyph := TTntSpeedButton(Control).Glyph;
    with TSpeedButtonCast(Control) do
    begin
      // Determine which image to use (if there is more than one in the glyph).
      with Glyph do
        if not Empty then
        begin
          GlyphWidth := Width div NumGlyphs;
          if not Enabled and (NumGlyphs > 1) then
            GlyphSourceX := GlyphWidth
          else
            case FState of
              bsDown:
                if NumGlyphs > 2 then
                  GlyphSourceX := 2 * GlyphWidth;
              bsExclusive:
                if NumGlyphs > 3 then
                  GlyphSourceX := 3 * GlyphWidth;
            end;
        end;
      // If the speed button is flat then we use toolbutton images for drawing.
      if Flat then
      begin
        case Button of
          tbPushButtonDisabled:
            Toolbutton := ttbButtonDisabled;
          tbPushButtonPressed:
            Toolbutton := ttbButtonPressed;
          tbPushButtonHot:
            Toolbutton := ttbButtonHot;
          tbPushButtonNormal:
            Toolbutton := ttbButtonNormal;
        end;
      end;
    end;
  end;
  if ToolButton = ttbToolbarDontCare then
  begin
    Details := ThemeServices.GetElementDetails(Button);
    ThemeServices.DrawElement(DC, Details, R);
    R := ThemeServices.ContentRect(DC, Details, R);
  end
  else
  begin
    Details := ThemeServices.GetElementDetails(ToolButton);
    ThemeServices.DrawElement(DC, Details, R);
    R := ThemeServices.ContentRect(DC, Details, R);
  end;

  // The XP style does no longer indicate pressed buttons by moving the caption one pixel down and right.
  Offset := Point(0, 0);

  with TControlCast(Control) do
  begin
    LastFont := SelectObject(DC, Font.Handle);
    CalcButtonLayout(Control, DC, R, Offset, GlyphPos, TextBounds, DrawTextBidiModeFlags(0));
    // Note: Currently we cannot do text output via the themes services because the second flags parameter (which is
    // used for graying out strings) is ignored (bug in XP themes implementation?).
    // Hence we have to do it the "usual" way.
    if ToolButton = ttbButtonDisabled then
      SetTextColor(DC, ColorToRGB(clGrayText));
    SetBkMode(DC, TRANSPARENT);
    if Control is TTntBitBtn then begin
      with TTntBitBtn(Control) do
        Tnt_DrawTextW(DC, PWideChar(Caption), Length(Caption), TextBounds, DT_CENTER or DT_VCENTER)
    end else begin
      Assert(Control is TTntSpeedButton, 'TNT Internal Error: Wrong button type in TTntThemeManagerHelper.DrawButton');
      with TTntSpeedButton(Control) do
        Tnt_DrawTextW(DC, PWideChar(Caption), Length(Caption), TextBounds, DT_CENTER or DT_VCENTER)
    end;
    with Glyph do
      if not Empty then
      begin
        GlyphMask := TBitmap.Create;
        GlyphMask.Assign(Glyph);
        GlyphMask.Mask(Glyph.TransparentColor);
        TransparentStretchBlt(DC, GlyphPos.X, GlyphPos.Y, GlyphWidth, Height, Canvas.Handle, GlyphSourceX, 0,
          GlyphWidth, Height, GlyphMask.Canvas.Handle, GlyphSourceX, 0);
        GlyphMask.Free;
      end;
    SelectObject(DC, LastFont);
  end;

  if Focused then
  begin
    SetTextColor(DC, 0);
    DrawFocusRect(DC, R);
  end;
end;

procedure TTntThemeManagerHelper.BitBtn_CN_DRAWITEM(Control: TControl; var Message: TMessage);
var
  Details: TThemedElementDetails;
begin
  with FTntThemeManager, TWMDrawItem(Message) do
  begin
    // This message is sent for bit buttons (TTntBitBtn) when they must be drawn. Since a bit button is a normal
    // Windows button (but with custom draw enabled) it is handled here too.
    // TTntSpeedButton is a TGraphicControl descentant and handled separately.
    Details := ThemeServices.GetElementDetails(tbPushButtonNormal);
    ThemeServices.DrawParentBackground(TWinControl(Control).Handle, DrawItemStruct.hDC, @Details, True);
    DrawBitBtn(Control as TTntBitBtn, DrawItemStruct^);
  end;
end;

procedure TTntThemeManagerHelper.SpeedButton_WM_PAINT(Control: TControl; var Message: TMessage);
var
  Button: TThemedButton;
  P: TPoint;
begin
  with FTntThemeManager, TWMPaint(Message) do
  begin
    // We cannot use the theme parent paint for the background of general speed buttons (because they are not
    // window controls).
    PerformEraseBackground(Control, DC);

    // Speed buttons are not window controls and are painted by a call of their parent with a given DC.
    if not Control.Enabled then
      Button := tbPushButtonDisabled
    else
      if TSpeedButtonCast(Control).FState in [bsDown, bsExclusive] then
        Button := tbPushButtonPressed
      else
      with TSpeedButtonCast(Control) do
      begin
        // Check the hot style here. If the button has a flat style then this check is easy. Otherwise
        // some more work is necessary.
        Button := tbPushButtonNormal;
        if Flat then
        begin
          if MouseInControl then
            Button := tbPushButtonHot;
        end
        else
        begin
          GetCursorPos(P);
          if FindDragTarget(P, True) = Control then
            Button := tbPushButtonHot;
        end;
      end;
    DrawButton(Control, Button, DC, Control.ClientRect, False);
    Message.Result := 0;
  end;
end;

{ TTntThemeManager }

constructor TTntThemeManager.Create(AOwner: TComponent);
begin
  inherited;
  FThemeMgrHelper := TTntThemeManagerHelper.Create(Self);
end;

procedure TTntThemeManager.Loaded;
begin
  if  (not (csDesigning in ComponentState))
  and (not ThemeServices.ThemesAvailable) then begin
    Options := Options - [toResetMouseCapture];
    FixControls(nil);
  end;
  inherited;
end;

function TTntThemeManager.DoControlMessage(Control: TControl; var Message: TMessage): Boolean;
begin
  Result := FThemeMgrHelper.DoControlMessage(Control, Message);
end;

initialization
  GetCheckSize;

end.