[NonVCL] Hintergundfarbe des TabSheets mit XP-Styles

[Daniel Schuhmann]

So, ich hab es dann mal "komplett" in mein Programm eingebaut. Als Referenz noch die Funktion zum dynamischen reinverbasteln, damits unter Windows NT/2000 auch funktionudelt.

Delphi-Quellcode:

unit Utilities;

interface

uses
  Windows;

type
  TEnableThemeDialogTexture = function(wnd: HWND; dwFlags: dword):
    HRESULT; stdcall;
  function LoadThemeDLL(wnd: hWnd; dwFlags: DWord): Boolean;

implementation

function LoadThemeDLL(wnd: hWnd; dwFlags: DWord): Boolean;
var
  EnableThemeDlgText: TEnableThemeDialogTexture;
  hThemeDll: THandle;
  DllResult: HRESULT;
begin
  Result := False;
  hThemeDll := LoadLibrary('uxtheme.dll');
  If hThemeDll <> 0 then
  begin
    @EnableThemeDlgText := GetProcAddress(hThemeDll, 'EnableThemeDialogTexture');
    if @EnableThemeDlgText <> nil then
    begin
      DllResult := EnableThemeDlgText(wnd, dwFlags);
      Result := DllResult = S_OK;
    end;
    FreeLibrary(hThemeDll);
  end;
end;

end.

Der Aufruf kann dann im Code (siehe Beitrag von MathiasSimmack) folgendermaßen erfolgen:

Delphi-Quellcode:

  For I := 0 to Length(hTabDlgs) -1 do
  begin
    hTabDlgs[I] := CreateDialog(hInstance,
      MAKEINTRESOURCE(200 + I), hDlg, @tabDlgFunc);
    LoadThemeDLL(hTabDlgs[i], 6);
  end;

Ja und dann natürlich noch das allerallerwichtigste.

Vielen herzlichen Dank!!! :)

[himitsu]

Zitat:

Delphi-Quellcode:

DllResult := EnableThemeDlgText(wnd, dwFlags);
Result := DllResult = S_OK;

Delphi-Quellcode:

Result := EnableThemeDlgText(wnd, dwFlags) = S_OK;

[Luckie]

Ichhabe das gerade mit der VCL ausprobiert und ein TPageControl mit TTabSheets genommen. Da scheint das aber nicht zu funktionieren.

Mein Code:

Delphi-Quellcode:

type
  TEnableThemeDialogTexture = function(wnd: HWND; dwFlags: dword): HRESULT; stdcall;

const
  ETDT_ENABLE       = $00000002;
  ETDT_USETABTEXTURE = $00000004;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function LoadThemeDLL(wnd: hWnd; dwFlags: DWord): Boolean;
var
  EnableThemeDlgText: TEnableThemeDialogTexture;
  hThemeDll         : THandle;
  DllResult         : HRESULT;
begin
  Result := False;
  hThemeDll := LoadLibrary('uxtheme.dll');
  if hThemeDll <> 0 then
  begin
    @EnableThemeDlgText := GetProcAddress(hThemeDll, 'EnableThemeDialogTexture');
    if @EnableThemeDlgText <> nil then
    begin
      DllResult := EnableThemeDlgText(wnd, dwFlags);
      Result := DllResult = S_OK;
    end;
    FreeLibrary(hThemeDll);
  end;
end;

Delphi-Quellcode:

procedure TForm1.EnableTabTheme;
var
  i: Integer;
  TabSheet: TTabSheet;
  hTab: THandle;
begin
  for i := 0 to Form1.ComponentCount - 1 do
  begin
    TabSheet := FindComponent('TabSheet' + IntToStr(i)) as TTabSheet;
    if Assigned(TabSheet) then
    begin
    hTab := TabSheet.Handle;
    if not LoadThemeDLL(hTab, ETDT_ENABLE or ETDT_USETABTEXTURE) then
      ShowMessage(SysErrorMessage(GetLastError));
    end;
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  EnableTabTheme;
end;

Ein Manifets liegt im Anwendungsverzeichnis. Aber egal, ob ich EnableTabTheme; aufrufe oder nicht, ich sehe nur einen Rand um die Tabsheet. Im XP Usermanager funktioniert es prächtig. Siehe Anhang.

[Luckie]

Pu-hu-hu-usch. ;)

[MathiasSimmack]

Zitat:

Zitat von Daniel Schuhmann

(Nur mit aktivierten Themes und ohne Manifest schaut's komisch aus, aber das macht ja keiner).

Wie wäre folgende "Notlösung"?

Delphi-Quellcode:

function IsManifestAvailable(const FileName: string): boolean;
const
  RT_MANIFEST = MAKEINTRESOURCE(24);

  function ManifestProc(module: HMODULE; lpszType: PAnsiChar;
    lp: LPARAM): bool; stdcall;
  begin
    Result := not(lpszType = RT_MANIFEST);
  end;

var
  module : HINST;
begin
  Result := false;

  // the file does not exist
  if not fileexists(FileName) then exit;

  // this is not Windows XP or newer
  if not IsWindowsXp then exit;
  // ERSETZEN DURCH EIGENE PRÜFROUTINE, OB XP ODER HÖHER!!!

  // is there a regular .manifest file?
  Result := fileexists(FileName + '.manifest');

  // is there a manifest resource?
  if not Result then
  begin
    module := LoadLibrary(pchar(FileName));
    if module <> 0 then
      Result := not EnumResourceTypes(module, @ManifestProc, 0);
  end;
end;

Anzuwenden (um bei deinem Beispiel zu bleiben):

Delphi-Quellcode:

For I := 0 to Length(hTabDlgs) -1 do
  begin
    hTabDlgs[I] := CreateDialog(hInstance,
      MAKEINTRESOURCE(200 + I), hDlg, @tabDlgFunc);

    if IsManifestAvailable(paramstr(0)) then
      LoadThemeDLL(hTabDlgs[i], ETDT_ENABLETAB);
  end;

[Daniel Schuhmann]

Wunderbar, hab es grade getestet, funktioniert klasse :-) Jetzt kann ich auch bei der Ressourcen-Einbinde-Frage das Gehirn abschalten...

Hm, das funktioniert alles zu gut hier. Ich glaube ich werd es morgen auf Arbeit mal unter Vista testen, du brauchst neue Herausforderungen :stupid:

@Luckie: So weit ich das in Erinnerung habe, funktioniert es ab Delphi 7 (bin mir unsicher), spätestens aber ab Delphi 2005 mit den Standardkomponenten ohne weiteres Zutun. Zu Delphi6-Zeiten hatte ich ein Komponenten-Paket, in dem unter anderem ein XP-PageControl dabei war. Ich muss das bei Gelegenheit mal raussuchen. Ansonsten kann ich mal in den TD-VCL-Sourcen wühlen, vielleicht find' ich da was.

[Daniel Schuhmann]

Unter Vista läuft alles bestens, auch unter Aero.

[MathiasSimmack]

Zitat:

Zitat von Daniel Schuhmann

du brauchst neue Herausforderungen :stupid:

Nun stell dir vor, was ich erst leiste, wenn meine rechte Hand wieder aus dem Gips kommt. :lol:

[Daniel Schuhmann]

Da bekommt "das mach ich doch mit links!" eine völlig neue Bedeutung :lol:

[Daniel Schuhmann]

Sodele, ich hab mal meine alten Backups durchwühlt und bin fündig geworden. Es sind sich die mdControls von Michael Frank, das letzte Update (zumindest mein letztes Update) war im Jahr 2003 und ist damit schon was länger her. Eine Webseite konnte ich nicht mehr auffinden.

Ich hab mal das was ich aus dem Backup rausextrahieren konnte angehängt. Die Geschichte war Freeware, somit dürfte das in Ordnung sein. Eine Readme hab ich allerdings nimmer.