Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 02.07.2008, 10:34   #1
AlexandrSid
Форумчанин
 
Регистрация: 31.10.2007
Сообщений: 103
По умолчанию Получить стиль оформления Windows

Необходимо определить какой стиль оформления используется в данный момент, вот что нарыл в нете

Код:
procedure TForm1.Button1Click(Sender: TObject);
var
   FileName, ColorScheme, SizeName: WideString;
   hThemeLib: THandle;
   GetCurrentThemeName: function (pszThemeFileName: LPWSTR; cchMaxNameChars: Integer;
     pszColorBuff: LPWSTR; cchMaxColorChars: Integer; pszSizeBuff: LPWSTR;
     cchMaxSizeChars: Integer): HRESULT; stdcall;
 begin
   try
     hThemeLib := LoadLibrary('uxtheme.dll');
     if hThemeLib > 0 then
       GetCurrentThemeName := GetProcAddress(hThemeLib, 'GetCurrentThemeName');
     if Assigned(GetCurrentThemeName) then
     begin
       SetLength(FileName, 255);
       SetLength(ColorScheme, 255);
       SetLength(SizeName, 255);
       OleCheck(GetCurrentThemeName(PWideChar(FileName), 255,
         PWideChar(ColorScheme), 255, PWideChar(SizeName), 255));
       // show the the theme path and file name.
      ShowMessage(PWideChar(FileName));
       // show the color scheme name
      ShowMessage(PWideChar(ColorScheme));
       // show the size name
      ShowMessage(PWideChar(SizeName));
     end;
   finally
     FreeLibrary(hThemeLib);
   end;
end;
Но на строчке OleCheck(GetCurrentThemeName... выходит ошибка "Элемент не найден", подскажите что не так.
AlexandrSid вне форума Ответить с цитированием
Старый 02.07.2008, 11:02   #2
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

А что возвращает сама GetCurrentThemeName?
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 02.07.2008, 11:59   #3
Ring0Sn
Форумчанин
 
Аватар для Ring0Sn
 
Регистрация: 06.09.2007
Сообщений: 239
По умолчанию

UxTheme.pas :
GetThemeFilename: function(hTheme: HTHEME; iPartId, iStateId, iPropId: Integer;
pszThemeFileName: LPWSTR; cchMaxBuffChars: Integer): HRESULT; stdcall;
Ring0Sn вне форума Ответить с цитированием
Старый 02.07.2008, 12:54   #4
AlexandrSid
Форумчанин
 
Регистрация: 31.10.2007
Сообщений: 103
По умолчанию

Функция GetCurrentThemeName возвращает ?????????, т.е. значения переменных она не изменяеет, что не так не могу понять.
AlexandrSid вне форума Ответить с цитированием
Старый 02.07.2008, 13:12   #5
Ring0Sn
Форумчанин
 
Аватар для Ring0Sn
 
Регистрация: 06.09.2007
Сообщений: 239
По умолчанию

смотри в msdm такие дела, там все параметры расписаны

Возвращает S_OK написано, что у тебя там неизменяеться непонятно...
Код:
var
  sBuffer : WideString;
begin
  SetLength(sBuffer, 100);
  if UxTheme.GetCurrentThemeName(PWideChar(s1), 100,
              nil, 0, nil, 0) = S_OK then
                     Result := WideCharToString(PWideChar(s1));
end;

Последний раз редактировалось Stilet; 02.07.2008 в 13:48.
Ring0Sn вне форума Ответить с цитированием
Старый 02.07.2008, 13:41   #6
AlexandrSid
Форумчанин
 
Регистрация: 31.10.2007
Сообщений: 103
По умолчанию

Я имел виду переменные widestring
Прописал условие, видно что функция GetCurrentThemeName не возвращает S_OK. Посмотрел MSDN вроде все верно. Скажите где я облажался.

Код:
procedure TForm1.Button1Click(Sender: TObject);
  var
    GetCurrentThemeName: function (pszThemeFileName: LPWSTR; cchMaxNameChars: Integer;
      pszColorBuff: LPWSTR; cchMaxColorChars: Integer; pszSizeBuff: LPWSTR;
      cchMaxSizeChars: Integer): HRESULT; stdcall;
    FileName, ColorScheme, SizeName: WideString;
    hThemeLib: THandle;
begin
   try
     hThemeLib := LoadLibrary('uxtheme.dll');
     if hThemeLib > 0 then
       GetCurrentThemeName := GetProcAddress(hThemeLib, 'GetCurrentThemeName');
     if Assigned(GetCurrentThemeName) then
     begin
       SetLength(FileName, 255);
       SetLength(ColorScheme, 255);
       SetLength(SizeName, 255);

      if GetCurrentThemeName(PWideChar(FileName), 255,
         PWideChar(ColorScheme), 255, PWideChar(SizeName), 255) = S_OK then begin
      ShowMessage(FileName);
      ShowMessage(ColorScheme);
      ShowMessage(SizeName);
     end;
     end;
   finally
     FreeLibrary(hThemeLib);
   end;
end;
AlexandrSid вне форума Ответить с цитированием
Старый 02.07.2008, 13:52   #7
Ring0Sn
Форумчанин
 
Аватар для Ring0Sn
 
Регистрация: 06.09.2007
Сообщений: 239
По умолчанию

Цитата:
Сообщение от AlexandrSid Посмотреть сообщение
Я имел виду переменные widestring
Прописал условие, видно что функция GetCurrentThemeName не возвращает S_OK. Посмотрел MSDN вроде все верно. Скажите где я облажался.
в коде выше, ктр я привел, у меня например возвращеться S_OK)
Ring0Sn вне форума Ответить с цитированием
Старый 02.07.2008, 15:12   #8
AlexandrSid
Форумчанин
 
Регистрация: 31.10.2007
Сообщений: 103
По умолчанию

Написал точно такой же код, все равно не возвращает S_OK, подскажите что еще может быть. В нете все тоже самое пишут
AlexandrSid вне форума Ответить с цитированием
Старый 02.07.2008, 15:52   #9
Ring0Sn
Форумчанин
 
Аватар для Ring0Sn
 
Регистрация: 06.09.2007
Сообщений: 239
По умолчанию

значит проблемы с uxtheme.dll, попробуй винду3 переустановить ))
зы еще возможно что кто то или чтото хукает у тебя её (например какаянибуть стороняя прога или какой нибуть ховновирус)...

Последний раз редактировалось Ring0Sn; 02.07.2008 в 16:15.
Ring0Sn вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Стили оформления кода Altera Свободное общение 2 30.08.2008 17:23
Проблема оформления SunKnight Общие вопросы Delphi 3 25.02.2008 01:11
Какой стиль оформления форума вы юзаете !?? merax О форуме и сайтах клуба 13 24.01.2008 05:50