RRUZ / vcl-styles-utils

Extend and improve the Delphi VCL Styles
https://theroadtodelphi.wordpress.com/
329 stars 115 forks source link

TVirtualExplorerTreeView issue and fix #237

Open rickard67 opened 5 years ago

rickard67 commented 5 years ago

There is a minor draw issue in the scrollbar of the TVirtualExplorerTreeview component (MustangpeakVirtualShellTools).

treeview1

The modification below fix the drawing issue.

unit Vcl.Styles.UxTheme

function Detour_UxTheme_GetThemeColor(hTheme: HTHEME; iPartId, iStateId, iPropId: Integer; var pColor: COLORREF): HRESULT;  stdcall;
var
  LThemeClass : string;
  LColor : TColor;
begin
  ...
  if LThemeClass<>'' then
  begin
    ...
  end
  else
    if SameText(LThemeClass, VSCLASS_SCROLLBAR) then
    begin
      pColor := clNone;
      case iPartId of
        11:
          case iStateId  of
            0 :  pColor := ColorToRGB(StyleServices.GetSystemColor(clScrollBar));
          end;
      end;

     if TColor(pColor) = clNone then
     begin
       Result := Trampoline_UxTheme_GetThemeColor(hTheme, iPartId, iStateId, iPropId, pColor);
       //OutputDebugString(PChar(Format('Detour_GetThemeColor Class %s hTheme %d iPartId %d iStateId %d  iPropId %d Color %8.x', [LThemeClass, hTheme, iPartId, iStateId, iPropId, pColor])));
     end
     else
       Result := S_OK;
    end
    else
    if SameText(LThemeClass, VSCLASS_CONTROLPANELSTYLE) then
    begin
      ...
    end
  ...
end;

After the modification it should look like this:

treeview2