программа для вычерчивания своего имени

[Mariy_19]

Написать программу для вычерчивания на экране своего имени с помощью символа «*».

[badname47]

Сообщение от Mariy_19

Написать программу для вычерчивания на экране своего имени с помощью символа «*».

writeln('******************');
writeln('******************');
...

[VIK_aka_TOR]

одна из мыслей.. зделать двумерный массив... в парочку строк... и уйму столбцов...
и для каждой буквы задать свои координаты написания... что бы было более ясно... вспомните инженерную графику на милиметровке... или же тетрис с экраном в котором пиксели - кубики.... для каждой буквы зделать свое написание, в маленькой матрице, строк столько же как и в первой... но столбцов значительно меньше, 4-5 ... матрица для каждой буквы... и затем сканируя введенное имя, заполнять этими маленькими матрицами первую большую... и при выводе попросту проверять значения в матрице и выводить соответсвующий знак (пробел или *).

[Felian]

Как вариант - сделать ASCII графику в файле и просто считать его в консоль. Длина строки - 80 символов...

[vovk]

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;
   const
t =
' a    ***       ** **     **   **   ********* **       **b*****      **    *    ******     **     *   ******     c  *****    **     *   **         **     *     *****    '+
'd*******    **     **  **      *  **     **  *******    e*******    **         *****      **         *******    f*******    **         *****      **         **         '+
'g  *****    **         **   **    **     *     *****    h**     **  **     **  *********  **     **  **     **  i   ****        **         **         **        ****    '+
'j   ****        **         **      *  **       ***      k**    **   **  **     ****       **  **     **    **   l**         **         **         **         *******    '+
'm***     ***** *   * ****  * *  ****   *   ****       **n***     ** ** **   ** **  **  ** **   ** ** **     *** o   *****   **       ****       ****       **   *****   '+
'p*****      **   *     *****      **         **         q   *****   **       ****       ****    *  **   *****   r*****      **   *     *****      ** **      **  **     '+
's  ****      **    *      **      *    **      ****     t********      **         **         **         **      u**       ****       ****       ** **     **    *****   '+
'v**       ** **     **   **   **     ** **       ***    w**       ****       ****   *   ** **  *  **    *   *   x**     **   **   **      ***      **   **   **     **  '+
'y**      **  **    **     ****        **         **     z*******        **        **       **        *******    ';

var
name_, temp_:string;
i, y, x, n_str, last_char, l_scr:integer;

begin
l_scr:=6;

while name_<>'exit' do
begin
writeln('vvedite imya');
readln(name_);
name_:= LowerCase(name_);
temp_:='';
writeln;

last_char:=l_scr;//Length(name_) mod 7;

for  n_str:= 0 to Length(name_) div l_scr do
 begin
      if n_str = Length(name_) div l_scr then
       last_char:= Length(name_) mod l_scr ;
   for x:=0 to 4 do
          begin
    for i:=1 to last_char do
       begin
        if pos(name_[i+(n_str*l_scr)],t)>1 then
         temp_:=temp_+copy(t,(pos(name_[i+(n_str*l_scr)],t)+1)+11*x,11)+' '
        else
         temp_:=temp_+'           ';
       end;
  writeln(temp_);
  temp_:='';
        end;
            writeln;
            writeln('---------------------------------');
            writeln;
 end;

end;
end.

Непродумано, неоптимизировано, но работает))

[Serge_Bliznykov]

vovk, да, работает..
жаль только, что только под Delphi/FPC ...
под обычный (TP) паскаль прийдётся переделывать...
А так - забавненько!

[vovk]

Сообщение от Serge_Bliznykov

vovk, да, работает..
жаль только, что только под Delphi/FPC ...
под обычный (TP) паскаль прийдётся переделывать...
А так - забавненько!

Точно, забыл про строку, и lowercase;
В турбо паскале должно так сработать)

program Project1;


uses  crt;
    const
t ='abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
my_font: array [1..26] of array [0..4] of string[11] =
(('    ***    ','   ** **   ','  **   **  ',' ********* ','**       **'),
 ('*****      ','**    *    ','******     ','**     *   ','******     '),
 ('  *****    ','**     *   ','**         ','**     *   ','  *****    '),
 ('*******    ','**     **  ','**      *  ','**     **  ','*******    '),
 ('*******    ','**         ','*****      ','**         ','*******    '),
 ('*******    ','**         ','*****      ','**         ','**         '),
 ('  *****    ','**         ','**   **    ','**     *   ','  *****    '),
 ('**     **  ','**     **  ','*********  ','**     **  ','**     **  '),
 ('   ****    ','    **     ','    **     ','    **     ','   ****    '),
 ('   ****    ','    **     ','    **     ',' *  **     ','  ***      '),
 ('**    **   ','**  **     ','****       ','**  **     ','**    **   '),
 ('**         ','**         ','**         ','**         ','*******    '),
 ('***     ***','** *   * **','**  * *  **','**   *   **','**       **'),
 ('***     ** ','** **   ** ','**  **  ** ','**   ** ** ','**     *** '),
 ('   *****   ','**       **','**       **','**       **','   *****   '),
 ('*****      ','**   *     ','*****      ','**         ','**         '),
 ('   *****   ','**       **','**       **','**    *  **','   *****   '),
 ('*****      ','**   *     ','*****      ','** **      ','**  **     '),
 ('  ****     ',' **    *   ','   **      ','*    **    ','  ****     '),
 ('********   ','   **      ','   **      ','   **      ','   **      '),
 ('**       **','**       **','**       **',' **     ** ','   *****   '),
 ('**       **',' **     ** ','  **   **  ','   ** **   ','    ***    '),
 ('**       **','**       **','**   *   **',' **  *  ** ','   *   *   '),
 ('**     **  ',' **   **   ','   ***     ',' **   **   ','**     **  '),
 ('**      ** ',' **    **  ','   ****    ','    **     ','    **     '),
 ('*******    ','    **     ','   **      ',' **        ','*******    '));

var
name_, temp_:string;
i, y, x, n_str, last_char, l_scr:integer;

begin
while name_<>'exit' do

begin
writeln('vvedite imya');
readln(name_);
temp_:='';
writeln;
l_scr:=6;
last_char:=l_scr;


for  n_str:= 0 to Length(name_) div l_scr do
 begin
      if n_str = Length(name_) div l_scr then
       last_char:= Length(name_) mod l_scr ;
   for x:=0 to 4 do
          begin
    for i:=1 to last_char do
       begin
        y:=pos(name_[i+(n_str*l_scr)],t);
         if y>26 then
        y:=y-26;
        if y>0 then
         temp_:=temp_+my_font[y,x]+' '
         else
         temp_:=temp_+'            ';
       end;

  writeln(temp_);
  temp_:='';
        end;
writeln;
writeln('---------------------------------');
writeln;
 end;
end;

end.

ps похоже вопрос отсюда http://www.pascaler.ru/pascal/graphic/3/, и требовалось совсем не это)

[Serge_Bliznykov]

Сообщение от vovk

Точно, забыл про строку, и lowercase;
В турбо паскале должно так сработать)

vovk, ну, коллега, я отнюдь не хотел Вас брать "на слабо", чтобы Вы переписали свой код.
Это же и так заняло у Вас приличное количество Вашего времени...
Но видимо, лень - это не Ваше качество!
Респект!
снимаю шляпу в глубоком почтении.. (плюсовать движок форума уже не даёт... )

ps похоже вопрос отсюда http://www.pascaler.ru/pascal/graphic/3/, и требовалось совсем не это)

ну, в данном контексте (по ссылке) понятно, какое решени ожидается.
Но если задание вырвано из контекста (смотри первый пост) - то там ничего не сказано - в каком режиме должны выводится эти звёздочки, и как это должно быть решено (кстати, я на 100% уверен, что в данной задаче нужно своё имя задать константой из звёздочек, а не писать универсальную процедуру для любого имени, как это сделали Вы. (Вы сделали больше, чем ожидали авторы задачи!)

Да и я не вижу, чтобы TC проявлял интерес к своей теме...