Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Вывод текста боком и вверх ногами

Автор: RathaR 13.08.2009 15:32

Проблема возникла там где не ждали....
Необходимо в графическом режиме вывести текст верх ногами, и боком, не сверху вниз, а именно боком... процедуры такой я в модуле Graph не нашол(может плохо искал?), но надобность существует, без этого никак не обойтись, ...
Выводить нужно лишь цыфры и знак $.
Подскажите как можна решить подобную проблему?

хотя насчет вверх ногами наверно можна и без этого....
Но боком всёрамно нужно...

Автор: volvo 13.08.2009 15:54

У Фаронова в модуле F_GRTEXT.PAS есть процедура OutString, которая может выводить текст под любым углом.

Автор: RathaR 14.08.2009 3:34

Цитата(volvo @ 13.08.2009 11:54)

У Фаронова в модуле F_GRTEXT.PAS есть процедура OutString, которая может выводить текст под любым углом.

погуглил, нашел, скачал... но для меня неприемлимо подключать "левый" модуль, тимболее ради одной процедуры, вся программа должна быть написана мною, а розбирать в том модуле одну процедуру, самому переписывать, - черт ногу сломит.
Сам задачу поставил и сам путь к решению закрыл....
Мне нужно всегото на поле в "Монополии" подписать стоимости участков на каждом секторе, но секторы розположены в форме прямоугольника, и соответственно некоторые надписи должны быть повёрнуты боком... и еще пару знаков вопросов боком повернуть (чтоб не рисовать знак вопроса фигурами) - несколько секторов (шанс) обозначаються знаками вопросов.
Я и незнаю как быть... рисовать цыфры линиями чтоли...

Автор: volvo 14.08.2009 5:14

Цитата

а розбирать в том модуле одну процедуру, самому переписывать, - черт ногу сломит.

Ну во-первых, изобретение велосипеда здесь не надо... Мало ли чего нет в модуле Graph... Добавляешь функционал. Я бы включил прямо модуль f_grtext целиком, если бы столкнулся с такой проблемой. Все равно без написания своих модулей при программировании Монополии (да еще с прицелом на обучение) ты не обойдешься. Какая разница, подключать 2 модуля или 3?

Если хочется все-таки изобрести велосипед - вот тебе набросок. Обрати внимание: в программе есть массив, куда можно выделить память и сохранить образы перевернутых символов (через GetMem + GetImage). А потом, при необходимости вывести "перевернутую" строку, надо будет посимвольно делать PutImage, каждый раз высчитывая позицию очередного символа...

uses graph;
type
  angle = (_90, _180, _270);

var
  gd, gm, err: integer;
  s: string;

  images: array[1 .. 11, angle] of pointer;
  centerx, centery, width, height: integer;
  i, X, Y, dx, dy: integer;

begin
  initgraph(gd, gm, '');
  err := graphresult;
  if err <> grok then begin
    writeln('error: ' + grapherrormsg(err));
    readln; halt(100);
  end;

  s := '0123456789$';

  centerx := getmaxx div 2; centery := getmaxy div 2;
  width := textwidth('W') + 4; height := textheight('W') + 4;

  settextjustify(centertext, centertext);
  for i := 1 to length(s) do begin
    cleardevice;
    outtextxy(getmaxx div 2, getmaxy div 2, s[i]);

    { 1: 90 degrees clockwise }
    dy := 0;
    for x := centerx - (width div 2) to centerx + (width div 2) do begin
      dx := 0;
      for y := centery + (height div 2) downto centery - (height div 2) do
      begin
        putpixel(25 + dx, 25 + dy, getpixel(x, y)); inc(dx);
      end;
      inc(dy);
    end;

    { 2: 180 degrees }
    dx := 0;
    for x := centerx + (width div 2) downto centerx - (width div 2) do begin
      dy := 0;
      for y := centery + (height div 2) downto centery - (height div 2) do
      begin
        putpixel(50 + dx, 25 + dy, getpixel(x, y)); inc(dy);
      end;
      inc(dx);
    end;

    { 3: 270 degrees clockwise }
    dy := 0;
    for x := centerx + (width div 2) downto centerx - (width div 2) do begin
      dx := 0;
      for y := centery - (height div 2) to centery + (height div 2) do
      begin
        putpixel(75 + dx, 25 + dy, getpixel(x, y)); inc(dx);
      end;
      inc(dy);
    end;

    readln;
  end;

  closegraph;
end.

А теперь скажи, оно тебе надо? Ты опять зацикливаешься на мелочах. У Фаронова уже есть решение, что тебе мешает его использовать? Когда перейдешь на Дельфи, то VCL тоже будешь переписывать сам, чтоб чужими наработками не пользоваться? Глупо. Так ты свою Монополию будешь годами писать. Ну, в принципе, дело твое... Хочешь - линиями рисуй, хочешь вообще поточечно...

Автор: volvo 15.08.2009 0:09

Если надо - вот еще один велосипед, гораздо более компактный, чем предыдущий, и полностью работоспособный:

Спойлер (Показать/Скрыть)

uses graph;
var
  gd, gm, err: integer;
  st: string;

const
  bits: array[1 .. 11] of array[1 .. 14] of word = (
    ($000,$000,$07C,$C6,$0CE,$0DE,$0F6,$0E6,$0C6,$0C6,$07C,$000,$000,$000),
    ($000,$000,$018,$38,$078,$018,$018,$018,$018,$018,$03C,$000,$000,$000),
    ($000,$000,$07C,$C6,$0C6,$006,$01C,$030,$060,$0C6,$0FE,$000,$000,$000),
    ($000,$000,$07C,$C6,$0C6,$006,$01C,$006,$0C6,$0C6,$07C,$000,$000,$000),
    ($000,$000,$00C,$1C,$03C,$06C,$0CC,$0CC,$0FE,$00C,$00C,$000,$000,$000),
    ($000,$000,$0FE,$C0,$0C0,$0FC,$006,$006,$006,$0C6,$07C,$000,$000,$000),
    ($000,$000,$07C,$C6,$0C0,$0C0,$0FC,$0C6,$0C6,$0C6,$07C,$000,$000,$000),
    ($000,$000,$0FE,$C6,$086,$004,$00C,$018,$018,$030,$030,$000,$000,$000),
    ($000,$000,$07C,$C6,$0C6,$0C6,$07C,$0C6,$0C6,$0C6,$07C,$000,$000,$000),
    ($000,$000,$07C,$C6,$0C6,$0C6,$07E,$006,$006,$0C6,$07C,$000,$000,$000),
    ($018,$018,$07C,$C6,$0C2,$0C0,$07C,$006,$086,$0C6,$07C,$018,$018,$000)
  );

{$F+}
procedure putCh_0(var px, py: integer; ch: char);
var x, y: integer;
begin
  for x := 0 to 7 do
    for y := 1 to 14 do begin
      if(bits[pos(ch, st)][y] shr x) and $01 > 0
      then putpixel(px + (7 - x), py + y, white);
    end;
  inc(px, 10);
end;
procedure putCh_90(var px, py: integer; ch: char);
var x, y: integer;
begin
  for x := 0 to 7 do
    for y := 14 downto 1 do begin
      if (bits[pos(ch, st)][y] shl x) and $80 > 0
      then putpixel(px + (14 - y), py + x, white);
    end;
  inc(py, 10);
end;
procedure putCh_180(var px, py: integer; ch: char);
var x, y: integer;
begin
  for x := 0 to 7 do
    for y := 14 downto 1 do begin
      if(bits[pos(ch, st)][y] shr x) and $01 > 0
      then putpixel(px + x, py + (14 - y), white);
    end;
  dec(px, 10);
end;
procedure putCh_270(var px, py: integer; ch: char);
var x, y: integer;
begin
  for x := 7 downto 0 do
    for y := 14 downto 1 do begin
      if (bits[pos(ch, st)][y] shr x) and ($01) > 0
      then putpixel(px + y, py + x, white);
    end;
  dec(py, 10);
end;
{$F-}

type
  TAngle = (ang_0, ang_90, ang_180, ang_270);
  TPutProc = procedure(var px, py: integer; ch: char);

procedure PrintString(angle: TAngle; px, py: integer; s: string);
const
  procFunc: array[TAngle] of TPutProc =
  (putCh_0, putCh_90, putCh_180, putCh_270);
var i: integer;
begin
  for i := 1 to length(s) do
    procFunc[angle](px, py, s[i]);
end;


begin
  initgraph(gd, gm, '');
  err := graphresult;
  if err <> grok then begin
    writeln('error: ' + grapherrormsg(err));
    readln; halt(100);
  end;

  st := '0123456789$'; { только эти символы можно использовать !!! }
  PrintString(ang_0, 10, 10, '$1234');
  PrintString(ang_90, 100, 100, '$1234');
  PrintString(ang_180, 200, 200, '$2345');
  PrintString(ang_270, 300, 300, '$2345');

  readln;
  closegraph;
end.

Автор: RathaR 15.08.2009 14:03

Цитата(volvo @ 14.08.2009 20:09)

Если надо - вот еще один велосипед, гораздо более компактный, чем предыдущий, и полностью работоспособный:

- то что надо

спасиба!

Автор: RathaR 20.08.2009 0:44

возникла ещё одна неувязочка с этой процедурой , дело в том, что цыфры матричным шрифтом 1 размера оказались несколько большеватыми... а самостоятельно я несмог изменить стиль текста выводимого этой процедурой, додумался только как цвет менять, а вот стиль - никак
Вобщем volvo я опять нуждаюсь в вашей помощи
Идеальный вариант для меня - уменьшеный шрифт(с номером 2), и размер 4... другие шрифты или размер мне для этой процедуры уже не понадобятся.
Мне не особо хочется розбираться в этой процедуре, ибо я в ней половину кода непонимаю , да и думаю оно мне ненужно пока, понимать всё это, но вот сама процедура мне нужна...

Автор: volvo 20.08.2009 1:04

Это ты сейчас про какую процедуру? Из 5-го поста, или все-таки у Фаронова? Что такое "уменьшенный шрифт (с номером 2)"? Что за "размер 4"?

Я не телепат, приводи код, который выводит то, что НЕ подходит, и показывай, что именно и насколько надо уменьшить. Миелофон в ремонте.

Автор: RathaR 20.08.2009 1:10

Цитата(volvo @ 19.08.2009 21:04)

Это ты сейчас про какую процедуру? Из 5-го поста, или все-таки у Фаронова? Что такое "уменьшенный шрифт (с номером 2)"? Что за "размер 4"?

Цитата

type
  TAngle = (ang_0, ang_90, ang_180, ang_270);
  TPutProc = procedure(var px, py: integer; ch: char);

procedure PrintString(angle: TAngle; px, py: integer; s: string);
...

вот это полностью подходит, но нужно чтобы выводило текст следующим стилем:

SetTextStyle(2,0,4);

4 - размер, а номер шрифта - 2;

Автор: volvo 20.08.2009 1:26

Цитата

нужно чтобы выводило текст следующим стилем:

Это невозможно. Я реализовал стандартный шрифт 8*14 пикселей, а не векторный шрифт из BGI. Единственное, что можно сделать - это шрифт 8*8, который будет почти в 2 раза меньше в высоту. Если надо - сделаю. Больше по этой теме ко мне можешь не обращаться, делать ничего не буду. Изобретать свой векторный шрифт только из-за того, что тебе лень разбираться в коде и сделать что-либо самостоятельно, мне тоже лень. Задание твое - делай...

Автор: RathaR 20.08.2009 1:40

Цитата(volvo @ 19.08.2009 21:26)

Насчёт "невозможно" - очень жаль, я этого предположить не мог.
Насчёт 8*8 я сам поробую розобраться, может чтото и выйдет.
Насчёт "лень разбираться в коде" - это абсолютно нетак... я немог предугадать, что для такой незначительной вещи придётся прилагать такие усилия по реализации, и даже то что это просто "невозможно". Монополия - моя первая программа (даже не игра) с графикой, поэтому во всём приходиться розбираться, в чём-то с трудом, в чём-то на примерах, но в большинстве - методом проб и ошибок.
Поэтому я и сказал, что невижу смысла розбирать код процедуры Фаронова, он в любом случае для меня непостижимо сложен, а если и не так, то для того чтобы его "освоить" или розобрать, пришлось бы приложить усилия, которые несравнимы с результатом...
ну и если нельзя вывести векторный шрифт таким способом, то я конечно извиняюсь что доставил столько хлопот

ибо я этого не предполагал - буду решать "своё задание" альтернативными путями

Автор: lapp. Опять меня выкинул IE8 : 20.08.2009 2:16

Цитата(RathaR @ 19.08.2009 21:40)

приложить усилия, которые несравнимы с результатом...

Рассматривай получение опыта и знаний как результат - и все придет в норму)).
У меня была когда-то программка для векторного шрифта.. Надо порыться.

Автор: RathaR 20.08.2009 2:22

Цитата(lapp. Опять меня выкинул IE8 : @ 19.08.2009 22:16)

нестоит... будем бороться своими силами

Автор: RathaR 20.08.2009 3:30

Впринципе вопрос можна считать решённым: попробовал я рисовать их не крутя - вышло не настолько ужасно чтобы сбрасывать этот вариант со счетов, очень даже нормально...