[NonVCL] Hintergundfarbe des TabSheets mit XP-Styles

[Daniel Schuhmann]

Servus Leute,

ich hätt gern mal wieder ein Problem.

Gestern habe ich mal angefangen, ein paar Tabsheets in mein NonVCL-Wunderprojekt einzufügen. Aus irgendeinem unerfindlichen Grund musste einer meiner Beta-Tester die visuellen Styles unter XP aktiviert haben, um mich hinterher auf einen Bug aufmerksam machen zu können.

Das Problem ist recht einfach erklärt, doch ein Bild sagt mehr als 1000 Worte, also öffnet einfach mal den Screenshot ganz unten.

Meine Fragen dazu:

• Wie kriege ich es hin, beim Laden einer Dialogressource einen Brush anzugeben?
• Wie kriege ich die gewünschte Zeichenfarbe für den Tabsheet-Innenraum heraus?

Oder ganz konkret: Wie schaffe ich es, das vernünftig aussehen zu lassen?

Auf Codevorlagen verzichte ich einfach mal, wer NonVCL programmiert, hat sicher auch Luckies Tutorial auf dem Rechner. Ein Beispiel findet sich unter Samples\CommonC\Tabsheets (Der Fehler tritt im Tutorial von Luckie auch auf, so man das Manifest einbindet).

Viele Grüße,
Daniel

[himitsu]

mit 'nen XP-Manifest werden die Farbdefinitionen übergangen und die Farben des Systems (des dort aktivierten Manifestes) verwendet.

Und da sind nunmal die farben so definiert -.-''

Ist übrigens nicht nur beim TabSheed so, eigentlich alles hat dieses Problem.


Es gibt auch shcon einige Themen hier in der DP dazu. (als Letztes war mal wieder das Edit dran)

[MathiasSimmack]

Das stimmt zwar, beantwortet aber nicht Daniels Frage. Immerhin hat Microsoft auch eine Lösung gefunden, wenn ich mir bspw. das Internetoptionen-Modul in der Systemsteuerung anschaue.

[Elvis]

Zitat:

Zitat von MathiasSimmack

Das stimmt zwar, beantwortet aber nicht Daniels Frage. Immerhin hat Microsoft auch eine Lösung gefunden, wenn ich mir bspw. das Internetoptionen-Modul in der Systemsteuerung anschaue.

Schaue mal was in der VCL bei Parentbackground an das Fenster geschickt wird. Denn ParentBackground in der VCL bei einem Panel zu ändern sollte bewirken, dass es mit dem Hintergrund des TabSheets gezeichnet wird.

[Daniel Schuhmann]

Für per API erstellte Fenster gibt es ja eine Lösung, die steht ja in den NonVCL-Tutorials drin.

Zitat:

Wie Ihnen das Bild links zeigt, wird unter Windows XP der Fensterhintergrund evtl. zu dunkel dargestellt. Das liegt an der Verwendung von COLOR_APPWORKSPACE (wie eingangs gezeigt) bei aktiven Themes. Als Abhilfe sollten Sie mit der Funktion "GetSysColorBrush" die Farbe für 3D-Elemente laden und benutzen:

Delphi-Quellcode:

wc.hbrBackground := GetSysColorBrush(COLOR_3DFACE);

Doch wenn ich den Dialog-Manager nutze, habe ich keine Fensterklasse. Somit kann ich die Zuweisung nicht anwenden. Daher frage ich mich, auf welchem anderen Weg ich das zuweisen kann (WM_INITDIALOG?). Zusätzlich bringt mir COLOR_3DFACE nichts, denn innerhalb eines Tabsheets habe ich ja andere Farbvorgaben als im "normalen" Dialog.

[MathiasSimmack]

Ich habe es nicht getestet, Daniel, aber rein farbmäßig tippe ich auf COLOR_WINDOW.

[MathiasSimmack]

Okay, das war jetzt spaßig, aber wir nähern uns der Lösung. Ich habe das besagte Sample aus den Tutorials aufhellen können. Es ist noch nicht perfekt.

Delphi-Quellcode:

function EnableThemeDialogTexture(wnd: HWND; dwFlags: dword):
  HRESULT; stdcall; external 'uxtheme.dll';


// in WM_INITDIALOG:
        for i := 0 to length(hTabDlgs) - 1 do
        begin
          hTabDlgs[i] := CreateDialog(hInstance, MAKEINTRESOURCE((i + 2) * 100),
            hDlg, @tabdlgfunc);
          EnableThemeDialogTexture(hTabDlgs[i], 6);
        end;

Die 6 steht für

Code:

#define ETDT_DISABLE                    0x00000001
#define ETDT_ENABLE                     0x00000002
#define ETDT_USETABTEXTURE              0x00000004
#define ETDT_USEAEROWIZARDTABTEXTURE    0x00000008

#define ETDT_ENABLETAB              (ETDT_ENABLE | \
                                     ETDT_USETABTEXTURE)

Seht es mir bitte nach. Mit nur einer Hand ist das blöd. :|

Jetzt ist das Innere des Tabs etwas zu hell, aber immerhin.

[Daniel Schuhmann]

Wow, das ist ja ein gewaltiger Schritt in die richtige Richtung :)

Stimmt, bissel zu hell isses, aber sonst funktoniert es richtig, mit und ohne Themes (Nur mit aktivierten Themes und ohne Manifest schaut's komisch aus, aber das macht ja keiner).

uxtheme.dll dürfte erst seit XP dabei sein, oder? -> Sprich dynamische Einbindung wäre wohl von Vorteil.

[Daniel Schuhmann]

Liegt es vielleicht nur daran, dass der Dialog des Tabsheets in der Demo in der Mitte liegt? (Hoffe irgendjemand hat meinen in-der-in-der-Satz verstanden...)

Jedenfalls schaut es in meinem Programm ganz und gar nicht falsch aus, auch der Pipettenvergleich mit beliebigen Windows-Tabsheets sagt, dass es die richtige Farbe ist.

Ich würde sagen: Wir haben fertig.

[MathiasSimmack]

Zitat:

Zitat von Daniel Schuhmann

uxtheme.dll dürfte erst seit XP dabei sein, oder? -> Sprich dynamische Einbindung wäre wohl von Vorteil.

Yo.

Zitat:

Ich würde sagen: Wir haben fertig.

Micha, aufschreiben! :mrgreen:

[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.

[turboPASCAL]

*kram* ...lang ist's her...


Hi,

äh, warum nicht einfach das Zeichnen des Tabsheed-Hinttergrundes "auslassen".
Das funktioniert schon aber der Nachteil ist nun das man die Controls eben
nicht auch Transparent gezeichnet werden.

Delphi-Quellcode:

function TabDlgFunc(hDlg: HWND; uMsg: DWORD; wParam: WPARAM; lParam: LPARAM): Bool; stdcall;
begin
  Result := TRUE;
  case uMsg of
    WM_COMMAND:
      begin
        if hiword(wParam) = BN_CLICKED then
        begin
          case loword(wParam) of
            1011: Messagebox(hDlg, 'Tab1', '', 0);
            1021: Messagebox(hDlg, 'Tab2', '', 0);
          end;
        end;
      end;
    WM_ERASEBKGND: ; // wParam := 0;
    else
      Result := FALSE;
  end;
end;

:gruebel:

[neothemachine]

Zitat:

Zitat von Luckie

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

Hi, gibt es da mittlerweile irgendwelche Fortschritte? Bin beim selben Problem, aber mit VCL.

[Daniel Schuhmann]

Das mdControls (Beitrag #20) müsste es doch gelöst haben?

[neothemachine]

Naja, ums mal vorsichtig auszudrücken...nicht direkt ;)

Wenn ich diese Controls (in meinem Fall nur PageControl und die TabSheets) benutze, dann - im nicht-Theme-Modus - flackert es nun, so als wenn ich DoubleBuffered auf false hätte, was aber vorher perfekt war. So, und im Theme-Modus kann ich das flackern nicht wirklich testen, da er eine nach der anderen "Range Check Error" Meldung bringt, wenn sich irgendwas an der Größe der Controls ändert, und es liegt sicher nicht an meinem Code, aber wohl eher daran dass diese Controls für Delphi <=7 gemacht wurden und ich eine höhere Version hab.

Aber trotzdem danke, ich glaub ich werd jetzt einfach warten bis CodeGear das selber korrigiert hat in seinen Sources, bekannt ist das Problem ja, hat auch schon einer der Entwickler in einem Blog darüber geschrieben.