toolctrlseh.pas

我对ehlib的修改,优化了计算效率,修正了其本身存在的BUG

        Button := tbPushButtonPressed
      else
        if Active
          then Button := tbPushButtonHot
          else Button := tbPushButtonNormal;

    ToolButton := ttbToolbarDontCare;
    if Flat then
    begin
      case Button of
        tbPushButtonDisabled:
          Toolbutton := ttbButtonDisabled;
        tbPushButtonPressed:
          Toolbutton := ttbButtonPressed;
        tbPushButtonHot:
          Toolbutton := ttbButtonHot;
        tbPushButtonNormal:
          Toolbutton := ttbButtonNormal;
      end;
    end;

    if ToolButton = ttbToolbarDontCare then
    begin
      Details := ThemeServices.GetElementDetails(Button);
      ThemeServices.DrawElement(DC, Details, ARect);

//      ARect := ThemeServices.ContentRect(DC, Details, ARect);
      InflateRect(ElRect, -2, -2);
    end else
    begin
      Details := ThemeServices.GetElementDetails(ToolButton);
      ThemeServices.DrawElement(DC, Details, ARect);
      InflateRect(ElRect, -1, -1)
//      ARect := ThemeServices.ContentRect(DC, Details, ARect);
    end;
  end else
{$ENDIF}
  begin
    Brush := GetSysColorBrush(COLOR_BTNFACE);
    if Flat then
    begin
      Windows.FillRect(DC, ElRect, Brush);
      InflateRect(ElRect, -1, -1)
    end else
    begin
      DrawEdge(DC, ElRect, PressedFlags[Pressed], BF_RECT or BF_MIDDLE);
      InflateRect(ElRect, -2, -2);
      //Windows.FillRect(DC, ElRect, Brush);
    end;
  end;

  InterP := 2;
  PWid := 2;
  W := ElRect.Right - ElRect.Left; //+ Ord(not Active and Flat);
  if W < 12 then InterP := 1;
  if W < 8 then PWid := 1;
  W := ElRect.Left + W div 2 - PWid div 2 + Ord(Pressed); //- Ord(not Active and Flat);
  H := ElRect.Top + (ElRect.Bottom - ElRect.Top) div 2 - PWid div 2 + Ord(Pressed);

  if not Enabled then
  begin
    Inc(W); Inc(H);
    Brush := GetSysColorBrush(COLOR_BTNHILIGHT);
    SaveBrush := SelectObject(DC, Brush);
    PatBlt(DC, W, H, PWid, PWid, PATCOPY);
    PatBlt(DC, W - InterP - PWid, H, PWid, PWid, PATCOPY);
    PatBlt(DC, W + InterP + PWid, H, PWid, PWid, PATCOPY);
    Dec(W); Dec(H);
    SelectObject(DC, SaveBrush);
    Brush := GetSysColorBrush(COLOR_BTNSHADOW);
  end else
    Brush := GetSysColorBrush(COLOR_BTNTEXT);

  SaveBrush := SelectObject(DC, Brush);
  PatBlt(DC, W, H, PWid, PWid, PATCOPY);
  PatBlt(DC, W - InterP - PWid, H, PWid, PWid, PATCOPY);
  PatBlt(DC, W + InterP + PWid, H, PWid, PWid, PATCOPY);
  SelectObject(DC, SaveBrush);
end;

procedure DrawPlusMinusButton(DC: HDC; ARect: TRect; Enabled, Active, Flat, Pressed, Plus: Boolean);
var PWid, PHet, W, H, PlusInd, MinWH: Integer;
  ElRect: TRect;
  Brush, SaveBrush: HBRUSH;
{$IFDEF EH_LIB_7}
  Button: TThemedButton;
  ToolButton: TThemedToolBar;
  Details: TThemedElementDetails;
{$ENDIF}
begin
  ElRect := ARect;

{$IFDEF EH_LIB_7}
  if ThemeServices.ThemesEnabled then
  begin
    if not Enabled then
      Button := tbPushButtonDisabled
    else
      if Pressed then
        Button := tbPushButtonPressed
      else
        if Active
          then Button := tbPushButtonHot
          else Button := tbPushButtonNormal;

    ToolButton := ttbToolbarDontCare;
    if Flat then
    begin
      case Button of
        tbPushButtonDisabled:
          Toolbutton := ttbButtonDisabled;
        tbPushButtonPressed:
          Toolbutton := ttbButtonPressed;
        tbPushButtonHot:
          Toolbutton := ttbButtonHot;
        tbPushButtonNormal:
          Toolbutton := ttbButtonNormal;
      end;
    end;

    if ToolButton = ttbToolbarDontCare then
    begin
      Details := ThemeServices.GetElementDetails(Button);
      ThemeServices.DrawElement(DC, Details, ARect);
//      ARect := ThemeServices.ContentRect(DC, Details, ARect);
      InflateRect(ElRect, -2, -2);
    end else
    begin
      Details := ThemeServices.GetElementDetails(ToolButton);
      ThemeServices.DrawElement(DC, Details, ARect);
      InflateRect(ElRect, -1, -1)
//      ARect := ThemeServices.ContentRect(DC, Details, ARect);
    end;
  end else
{$ENDIF}
  begin
    Brush := GetSysColorBrush(COLOR_BTNFACE);
    if Flat then
    begin
      Windows.FillRect(DC, ElRect, Brush);
      InflateRect(ElRect, -1, -1)
    end else
    begin
      DrawEdge(DC, ElRect, PressedFlags[Pressed], BF_RECT or BF_MIDDLE);
      InflateRect(ElRect, -2, -2);
      Windows.FillRect(DC, ElRect, Brush);
    end;
  end;

  MinWH := ElRect.Right - ElRect.Left; //+ Ord(not Active and Flat);
  if ElRect.Bottom - ElRect.Top < MinWH then
    MinWH := ElRect.Bottom - ElRect.Top;
  PWid := MinWH * 4 div 7;
  if PWid = 0 then PWid := 1;
  PHet := PWid div 3;
  if PHet = 0 then PHet := 1;
  if Flat then Dec(PWid);
  if PWid mod 2 <> MinWH mod 2 then Inc(PWid);
  if Plus and (PWid mod 2 <> PHet mod 2) then
    if (MinWH < 12) then Inc(PWid) else Dec(PWid);
  PlusInd := PWid div 2 - PHet div 2;

  W := ElRect.Left + (ElRect.Right - ElRect.Left - PWid) div 2; //- Ord(not Active and Flat);
  //if W * 2 + PWid > (ElRect.Right - ElRect.Left) then Dec(W);
  Inc(W, Ord(Pressed));
  H := ElRect.Top + (ElRect.Bottom - ElRect.Top - PHet) div 2 + Ord(Pressed);

  if not Enabled then
  begin
    Inc(W); Inc(H);
    Brush := GetSysColorBrush(COLOR_BTNHILIGHT);
    SaveBrush := SelectObject(DC, Brush);
    PatBlt(DC, W, H, PWid, PHet, PATCOPY);
    if Plus then PatBlt(DC, W + PlusInd, H - PlusInd, PHet, PWid, PATCOPY);
    Dec(W); Dec(H);
    SelectObject(DC, SaveBrush);
    Brush := GetSysColorBrush(COLOR_BTNSHADOW);
  end else
    Brush := GetSysColorBrush(COLOR_BTNTEXT);

  SaveBrush := SelectObject(DC, Brush);
  PatBlt(DC, W, H, PWid, PHet, PATCOPY);
  if Plus then PatBlt(DC, W + PlusInd, H - PlusInd, PHet, PWid, PATCOPY);
  SelectObject(DC, SaveBrush);
end;

procedure DrawDropDownButton(DC: HDC; ARect: TRect; Enabled, Flat, Active, Down: Boolean);
var
  Flags: Integer;
{$IFDEF EH_LIB_7}
  Details: TThemedElementDetails;
{$ENDIF}
//  Rgn, SaveRgn: HRGN;
//  r: Integer;
//  IsClip: Boolean;
begin
{$IFDEF EH_LIB_7}
  if ThemeServices.ThemesEnabled then
  begin
    if not Enabled then
      Details := ThemeServices.GetElementDetails(tcDropDownButtonDisabled)
    else
      if Down then
        Details := ThemeServices.GetElementDetails(tcDropDownButtonPressed)
      else
        if Active
          then Details := ThemeServices.GetElementDetails(tcDropDownButtonHot)
          else Details := ThemeServices.GetElementDetails(tcDropDownButtonNormal);

{      with Details do
        GetThemeBackgroundRegion(ThemeServices.Theme[Element], DC, Part, State, ARect, Rgn);
      IsClip := False;
      SaveRgn := 0;
      r := 0;
      if Rgn <> 0 then
      begin
        IsClip := True;
        SaveRgn := CreateRectRgn(0, 0, 0, 0);
        r := GetClipRgn(DC, SaveRgn);
        SelectClipRgn(DC, Rgn);
        DeleteObject(Rgn);
      end;}

    ThemeServices.DrawElement(DC, Details, ARect);

{      if IsClip = True then
      begin
        if r = 0
          then SelectClipRgn(DC, 0)
          else SelectClipRgn(DC, SaveRgn);
        DeleteObject(SaveRgn);
      end;}

  end else
{$ENDIF}
  begin
    Flags := DownFlags[Down] or FlatFlags[Flat] or EnabledFlags[Enabled];
    DrawFrameControl(DC, ARect, DFC_SCROLL, Flags or DFCS_SCROLLCOMBOBOX);
  end;
end;

procedure DrawUpDownButton(DC: HDC; ARect: TRect; Enabled, Flat, Active, Down, DownDirection: Boolean);
var
  Flags: Integer;
{$IFDEF EH_LIB_7}
  Details: TThemedElementDetails;
{$ENDIF}
begin
{$IFDEF EH_LIB_7}
  if ThemeServices.ThemesEnabled then
  begin
    if DownDirection then
      if not Enabled then
        Details := ThemeServices.GetElementDetails(tsDownDisabled)
      else
        if Down then
          Details := ThemeServices.GetElementDetails(tsDownPressed)
        else
          if Active
            then Details := ThemeServices.GetElementDetails(tsDownHot)
            else Details := ThemeServices.GetElementDetails(tsDownNormal)
    else
      if not Enabled then
        Details := ThemeServices.GetElementDetails(tsUpDisabled)
      else
        if Down then
          Details := ThemeServices.GetElementDetails(tsUpPressed)
        else
          if Active
            then Details := ThemeServices.GetElementDetails(tsUpHot)
            else Details := ThemeServices.GetElementDetails(tsUpNormal);
    ThemeServices.DrawElement(DC, Details, ARect);
  end else
{$ENDIF}
  begin
    Flags := DownFlags[Down] or FlatFlags[Flat] or EnabledFlags[Enabled];
    DrawFrameControl(DC, ARect, DFC_SCROLL, Flags or IsDownFlags[DownDirection]);
  end;
end;

procedure DrawOneButton(DC: HDC; Style: TDrawButtonControlStyleEh;
  ARect: TRect; Enabled, Flat, Active, Down, DownDirection: Boolean);
var
  Rgn, SaveRgn: HRgn;
  r: Integer;
  IsClipRgn: Boolean;
  DRect: TRect;
//    Brush: HBRUSH;
begin
  DRect := ARect;
//  LPtoDP(DC, DRect, 2);
  WindowsLPtoDP(DC, DRect);

{$IFDEF EH_LIB_7}
  IsClipRgn := Flat and Active and not ThemeServices.ThemesEnabled;
{$ELSE}
  IsClipRgn := Flat and Active;
{$ENDIF}
  r := 0; SaveRgn := 0;
  if IsClipRgn then
  begin
    SaveRgn := CreateRectRgn(0, 0, 0, 0);
    r := GetClipRgn(DC, SaveRgn);
    with DRect do
      Rgn := CreateRectRgn(Left + 1, Top + 1, Right - 1, Bottom - 1);
    SelectClipRgn(DC, Rgn);
    DeleteObject(Rgn);
  end;

  if Flat {$IFDEF EH_LIB_7} and not ThemeServices.ThemesEnabled {$ENDIF} then
    if not Active {and not (Style=bcsUpDownEh)}
      then InflateRect(ARect, 2, 2)
      else InflateRect(ARect, 1, 1);
  case Style of
    bcsDropDownEh: DrawDropDownButton(DC, ARect, Enabled, Flat, Active, Down);
    bcsEllipsisEh: DrawEllipsisButton(DC, ARect, Enabled, Active, Flat, Down);
    bcsUpDownEh: DrawUpDownButton(DC, ARect, Enabled, Flat, Active, Down, DownDirection);
    bcsMinusEh, bcsPlusEh: DrawPlusMinusButton(DC, ARect, Enabled, Active, Flat, Down, bcsPlusEh = Style);
  end;
  if Flat then
    if not Active {and not (Style=bcsUpDownEh)}
      then InflateRect(ARect, -2, -2)
      else InflateRect(ARect, -1, -1);

  if IsClipRgn then
  begin
    if r = 0
      then SelectClipRgn(DC, 0)
      else SelectClipRgn(DC, SaveRgn);
    DeleteObject(SaveRgn);
    if Down
      then DrawEdge(DC, ARect, BDR_SUNKENOUTER, BF_RECT)
      else DrawEdge(DC, ARect, BDR_RAISEDINNER, BF_RECT)
  end;
end;

type
  PPoints = ^TPoints;
  TPoints = array[0..0] of TPoint;

  TButtonBitmapInfoEh = record
    Size: TPoint;
    BitmapType: TDrawButtonControlStyleEh;
    Flat: Boolean;
    Pressed: Boolean;
    Active: Boolean;
    Enabled: Boolean;
    DownDirect: Boolean;
    CheckState: TCheckBoxState;
  end;

  function CompareButtonBitmapInfo(Info1, Info2: TButtonBitmapInfoEh): Boolean;
  begin
    Result := (Info1.Size.X = Info2.Size.X) and (Info1.Size.Y = Info2.Size.Y)
      and (Info1.BitmapType = Info2.BitmapType)
      and (Info1.Flat = Info2.Flat)
      and (Info1.Pressed = Info2.Pressed)
      and (Info1.Active = Info2.Active)
      and (Info1.Enabled = Info2.Enabled)
      and (Info1.DownDirect = Info2.DownDirect)
      and (Info1.CheckState = Info2.CheckState);
  end;

type

  { TButtonsBitmapCache }

  TButtonBitmapInfoBitmapEh = class(TObject)
  public
    BitmapInfo: TButtonBitmapInfoEh;
    Bitmap: TBitmap;
  end;

//  PButtonBitmapInfoBitmapEh = ^TButtonBitmapInfoBitmapEh;

  TButtonsBitmapCache = class(TObjectList)
  private
    function Get(Index: Integer): TButtonBitmapInfoBitmapEh;
//    procedure Put(Index: Integer; const Value: PButtonBitmapInfoBitmapEh);
  public
    constructor Create; overload;
    procedure Clear; override;
    function GetButtonBitmap(ButtonBitmapInfo: TButtonBitmapInfoEh): TBitmap;
    property Items[Index: Integer]: TButtonBitmapInfoBitmapEh read Get {write Put}; default;
  end;