IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Задача на увеличение шрифта., Не знаю какую функцию надо применить.
MeatCrash
сообщение 9.04.2006 2:33
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 56
Пол: Мужской
Реальное имя: Александр

Репутация: -  0  +


Задача взята мною из учебника, который навреняка многим известен, если надо могу вывесить файл с этим учебником.

Задача: Выведите на экран своё имя высотой в 8 строчек. А в главе с этой задаче ничего не сказано про такую возможность, вот и думаю, почему я так туплю, что ничего не замечаю?.. Просматривал текст главы раз 5, но так и не понял как это сделать. Мне кто-то говорил, что это можно сделать с помощью Uses Crt, но в той самой главе про это ничего нет. Помогите мне, пожалуйста.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
volvo
сообщение 9.04.2006 3:05
Сообщение #2


Гость






С латинскими символами работает как положено. Насчет кириллицы - не знаю, проверить не могу. Тестируй:
uses crt, dos;

procedure write_char(col, row, char_to_print: byte;
char_to_fill: char; var addr_of_table);
type
char_dim = array[1 .. 8] of byte;
table_dim = array[1 .. 127] of char_dim;
var
x, y: byte;
table_1: table_dim absolute $f000:$fa6e;
table_2: table_dim absolute addr_of_table;
pattern: char_dim;

begin
case char_to_print of
0 .. 127: pattern := table_1[char_to_print];
128 .. 255: pattern := table_2[char_to_print - 128];
end;
inc(col, 7);
dec(row, 8);

for x := 1 to 8 do
for y := 7 downto 0 do begin
gotoxy(col - y, row + x);
if odd(pattern[x] shr y) then write(char_to_fill);
end;
end;

procedure write_large_string(x, y: byte; c, t: char; s: string);
var
i: byte;
del: shortint;
p: pointer;
begin
s := s + ' ';
inc(y);
getintvec($1f, p);

if y < 9 then y := 9;
if y > hi(windmax) then y := hi(windmax) + 1;

i := lo(windmax) - lo(windmin) + 1;
repeat
del := i - (8 * length(s) + x - 1);
if del > 0 then delete(s, length(s), 1);
until del >= 0;

for i := 1 to length(s) do begin
write_char(x + (8 * i - 7), y, ord(s[i])+1, t, p^);
write_char(x + (8 * i - 7), y - 1, ord(s[i])+1, c, p^);
end;
end;

begin
textbackground(red); clrscr;
textcolor(yellow);
textbackground(blue);
write_large_string(1, 20, #176, ' ', 'alex');
readln;
end.

(С) Д.Б. Поляков - "Программирование в среде Турбо Паскаль" Глава 20.

Незначительные исправления - мои...
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 21.06.2025 20:20
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"