Thema: Delphi XP Anzeigeeinstellungen

Einzelnen Beitrag anzeigen

Benutzerbild von bitsetter
bitsetter

Registriert seit: 17. Jan 2007
1.169 Beiträge
 
Turbo Delphi für Win32
 
#6

Re: XP Anzeigeeinstellungen

  Alt 18. Nov 2007, 23:34
Zitat von hedie:
Jetzt fehlt nur noch die Funktion für die Darstellung...

Wichtig is einfach das ich auf das XP Design wechseln kann und die Fenster Farbe auf Oliv grün umstellen kan etc...
Hallo,

habe jetzt doch noch was gefunden, und zwar mit Hilfe von angeblich undokumentierten Funktionen in der uxTheme.dll kann man die Darstellung ändern.
Bei meinem Beispiel wird kurz vom XP- Stil auf Windows klassisch umgeschaltet und dann wieder zurück. Auch die Farbe der Fenster und die Größe der Schrift könnte man ändern, wenn man diese vorher mit Funktionen wie EnumThemeColors und EnumThemeSizes auslesen würde.
Delphi-Quellcode:
uses
  uxtheme;

procedure Delay(msec: longint);
var
  start, stop: longint;
begin
  start := gettickcount;
  repeat
  stop := gettickcount;
  application.processmessages;
  until (stop - start ) >= msec;
end;
procedure TForm1.Button1Click(Sender: TObject);
type
  HTHEMEFILE= HWND;
var
  OpenThemeFile: function(pThemeFileName, pColorName, pSizeName: LPCWSTR; hThemeFile_: pCardinal ;unknown: DWORD): HRESULT; stdcall;
  ApplyTheme: function(hThemeFile_: HTHEMEFILE; unknown: Char; hWnd_: HWND): HRESULT; stdcall;
  CloseThemeFile: function(hThemeFile_: HTHEMEFILE): HRESULT; stdcall;

  hUxTheme: THandle;
  hThemeFile_: HTHEMEFILE;
  c: Char;
  pThemeFileName, pColor, pSize: PWideChar;
const
  Sec_ = 8;
begin
  hThemeFile_ := 0;
  GetMem(pThemeFileName, MAX_PATH + 1);
  GetMem(pColor, 61);
  GetMem(pSize, 61);
  hUxTheme := LoadLibrary('uxTheme.dll');
  if hUxTheme <> 0 then
  try
    if uxtheme.GetCurrentThemeName(pThemeFileName, MAX_PATH, pColor, 60, pSize, 60) = 0 then
    begin
      OpenThemeFile := GetProcAddress(hUxTheme, PChar(2));
      ApplyTheme := GetProcAddress(hUxTheme, PChar(4));
      CloseThemeFile := GetProcAddress(hUxTheme, PChar(3));
      if Assigned(OpenThemeFile) and Assigned(ApplyTheme) and Assigned(CloseThemeFile) then
        if OpenThemeFile(pThemeFileName, pColor, pSize, @hThemeFile_, 0)= 0 then
        begin
          if hThemeFile_ > 0 then
          begin
            if MessageDlg(Format('Soll jetzt der Stil der Fenster für %d sec auf "Windows - klassisch" gesetzt werden?', [Sec_]), mtConfirmation, [mbYes, mbNo], 0)= mrYes then
            begin
              ZeroMemory(@c, length(c));
              ApplyTheme(0, c, 0);//Windows - klassisch
              Delay(Sec_* 1000);

              if ApplyTheme(hThemeFile_, c, 0) <> 0 then//alten Stil wiederherstellen
                MessageDlg('Fehler beim setzen des neuen Fensterstils', mtError, [mbOk], 0);
            end;
            CloseThemeFile(hThemeFile_);
          end;
        end
        else
          MessageDlg(Format('Fehler beim öffnen der Datei "%s"', [WideCharToString(pThemeFileName)]), mtError, [mbOk], 0);
    end
    else
      MessageDlg('Fehler beim auslesen des aktuellen Themenamens oder die jetzige Einstellung ist "Windows - klassisch".', mtError, [mbOk], 0);
  finally
    FreeMem(pThemeFileName);
    FreeMem(pColor);
    FreeMem(pSize);
    FreeLibrary(hUxTheme);
  end;
end;
Getestet mit Windows XP SP1.
Gruß bitsetter
"Viele Wege führen nach Rom"
Wolfgang Mocker (geb. 1954), dt. Satiriker und Aphoristiker
  Mit Zitat antworten Zitat