Гость
Форумы / FoxPro, Visual FoxPro [игнор отключен] [закрыт для гостей] / Просьба проверить / 6 сообщений из 6, страница 1 из 1
21.05.2003, 14:55
    #32165172
NNN
NNN
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Просьба проверить
Кому не очень лениво, проверьте, please, как работает нижеследющая байда. Особо интересуют размены шрифтов (Свойства экрана - Оформление), при мелком шрифте цифра должна совпадать, в других случаях должен учитываться масштабный коэффицент. Все вроде нормально работает, но целых два подгона, поэтому уверенности никакой.
Спасибо.
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
#DEFINE SPI_GETNONCLIENTMETRICS   41 
#DEFINE LOGPIXELSY                90 
#DEFINE LONG_MAX          2147483647 
#DEFINE FONT_CORRECTION         . 75 
CLEAR 
LOCAL lcBuffer 
LOCAL lcValue 
DECLARE INTEGER SystemParametersInfo IN WIN32API;
INTEGER, INTEGER, STRING  @,INTEGER
lcBuffer=CHR( 84 )+CHR( 1 )+REPLICATE(CHR( 0 ), 338 )
IF SystemParametersInfo(SPI_GETNONCLIENTMETRICS,  340 , @lcBuffer, 0 )= 1 
 ?'CaptionFont: '
 ??GetSFont(SUBSTR(lcBuffer, 25 , 60 )) 
 ?'SmCaptionFont: '
 ??GetSFont(SUBSTR(lcBuffer, 93 , 60 )) 
 ?'MenuFont: '
 ??GetSFont(SUBSTR(lcBuffer, 161 , 60 ))
 ?'StatusFont: '
 ??GetSFont(SUBSTR(lcBuffer, 221 , 60 ))
 ?'MessageFont: '
 ??GetSFont(SUBSTR(lcBuffer, 281 , 60 ))
ENDIF 
CLEAR DLLS 

FUNCTION GetSFont
LPARAMETERS lcBuffer
RETURN ;
 LEFT(RIGHT(lcBuffer, 32 ),AT(CHR( 0 ),RIGHT(lcBuffer, 32 ))- 1 ) + ',' +;
 LTRIM(STR(ROUND(ABS(long2num(SUBSTR(lcBuffer, 1 , 4 ))) * ; 
 FONT_CORRECTION, 0 ))) + ',' + ;
 IIF(long2num(SUBSTR(lcBuffer, 17 , 4 ))> 400 ,'B','N') + ;
 IIF(ASC(SUBSTR(lcBuffer, 21 , 1 ))= 1 ,'I','') + ',' + ; 
 LTRIM(STR((ASC(SUBSTR(lcBuffer, 24 , 1 )))))
ENDFUNC 

FUNCTION  long2num 
LPARAMETERS lcBuffer
LOCAL lnReturn
lnReturn = int2num(lcBuffer)
IF lnReturn > LONG_MAX
 lnReturn = lnReturn - LONG_MAX* 2  -  1 
ENDIF 
RETURN lnReturn
ENDFUNC

FUNCTION  int2num 
LPARAMETERS lcBuffer
RETURN;
 ASC(SUBSTR(lcBuffer,  1 , 1 )) + ;
 ASC(SUBSTR(lcBuffer,  2 , 1 )) *  256  +;
 ASC(SUBSTR(lcBuffer,  3 , 1 )) *  65536  +;
 ASC(SUBSTR(lcBuffer,  4 , 1 )) *  16777216 
ENDFUNC
...
Рейтинг: 0 / 0
21.05.2003, 15:34
    #32165252
Crip
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Просьба проверить
CaptionFont: Trebuchet MS,9,B,1
SmCaptionFont:Tahoma,8,B,1
MenuFont: Tahoma,8,N,1
StatusFont: Tahoma,8,N,1
MessageFont: Tahoma,8,N,1
...
Рейтинг: 0 / 0
21.05.2003, 15:49
    #32165273
Glory
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Просьба проверить
Код: plaintext
1.
2.
3.
4.
CaptionFont: Tahoma, 10 ,B, 0 
SmCaptionFont: Tahoma, 10 ,B, 0 
MenuFont: Tahoma, 10 ,N, 0 
StatusFont: Tahoma, 10 ,N, 0 
MessageFont: Tahoma, 10 ,N, 0 
...
Рейтинг: 0 / 0
21.05.2003, 16:08
    #32165298
NNN
NNN
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Просьба проверить
Thanks. Похоже, все совпадает, буду встраивать.
...
Рейтинг: 0 / 0
22.05.2003, 11:45
    #32165916
ВладимирМ
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Просьба проверить
Код: plaintext
1.
2.
3.
4.
CaptionFont: MS Sans Serif, 8 ,B, 204 
SmCaptionFont: MS Sans Serif, 3 ,N, 204 
MenuFont: MS Sans Serif, 8 ,N, 204 
StatusFont: MS Sans Serif, 8 ,N, 204 
MessageFont: MS Sans Serif, 8 ,N, 204 
...
Рейтинг: 0 / 0
22.05.2003, 12:13
    #32165966
NNN
NNN
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Просьба проверить
И тебе, ВладимирМ, спасибо.
Если кому-то интересно, то две ошибки я все-таки нашел:
1. В функции long2num при расчете отрицательных чисел:
lnReturn = lnReturn - (LONG_MAX+1)*2
2. При расчете реальной величины шрифта, вместо ROUND нужно использовать INT.
...
Рейтинг: 0 / 0
Форумы / FoxPro, Visual FoxPro [игнор отключен] [закрыт для гостей] / Просьба проверить / 6 сообщений из 6, страница 1 из 1
Целевая тема:
Создать новую тему:
Автор:
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]