Добрый день!
есть программка которая должна отрисовывать 5 прямоугольников в вертикальном положении через небольшое расстаяние, но она не работает:(

uses Graph;
function init:integer;
var
	grDriver: Integer;
	grMode: Integer;
begin
	grDriver := Detect;
	InitGraph(grDriver, grMode, '');
	init := GraphResult;
end;

procedure dr;
var
	i:integer;
	x1,x2,y1,y2,k:integer;
begin
	ClearViewPort;
	k:=round ((GetMaxY / 200));//отступ
	x2:=round (GetMaxX*(2/3));
	x1:=round (GetMaxX*(1 / 3));
        for i:=1 to 5 do begin
		y1:=round ((GetMaxY / 9)*(1+i) -k);
		y2:=round ((GetMaxY/9)*(1+ 2*i ));
		Rectangle(X1,Y1,X2,Y2);
	end;
end;

begin
	if init = grOk then begin 
			Dr;
			Readln;
			CloseGraph;  
	end; 
end. 

Нажмите для просмотра прикрепленного файла
на скрине видно что отступы между прямоугольниками пропадают, и откуда-то берется шестой прямоугольник...
помогите...

Это не 6 прямоугольников, а 5, но переплетены так, что

Поменяй

        for i:=1 to 5 do begin
		y1:=round ((GetMaxY/9)*(1+i) - k);
		y2:=round ((GetMaxY/9)*(2+i)); { <--- Здесь }
		Rectangle(X1,Y1,X2,Y2);
                readln; { <--- Для теста }
	end;

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

и отнимать К, надо было от другого у...
спасибо..

еще одна проблемка, не меняется фон...

(*{TP mode}*)
uses Graph;
function init:integer;
var
	grDriver: Integer;
	grMode: Integer;
begin
	grDriver := Detect;
	InitGraph(grDriver, grMode, '');
	writeln(grDriver);//15
	writeln( grMode);//5
	init := GraphResult;
end;
function ColorToString(color:word):string;
begin
	case color of 
		0: ColorToString:='Black';
		1: ColorToString:='Blue';
		2: ColorToString:='Green';
		3: ColorToString:='Cyan';{бирюзовый}
		4: ColorToString:='Red';
		5: ColorToString:='Magenta';{Фиолетовый}
		6: ColorToString:='Brown';
		7: ColorToString:='LightGray';
		8: ColorToString:='DarkGray';
		9: ColorToString:='LightBlue';
		10: ColorToString:='LightGreen';
		11: ColorToString:='LightCyan';
		12: ColorToString:='LightRed';
		13: ColorToString:='LightMagenta';
		14: ColorToString:='Yellow';
		15: ColorToString:='White';
		128:ColorToString:='Blink';
		else ColorToString:='unknown'; 
	end;
end;

procedure dr;
var
	Color: Word;
	i:integer;


begin
	for i:=0 to 15 do begin
		readln(color);
		SetBkColor(Color); 			//почему не меняется фон?
		OutTextXY (100,100+(i*10), ColorToString(Color));	
	end;

end;
begin
	if init = grOk then begin 
		Dr;
		Readln;
		CloseGraph;  
	end; 
end. 

что делать?

В Турбо Паскале как раз меняется ...

но у меня его нет... точнее где-то на диске...
как сделать что б менялся в FP?

Добавлено через 19 мин.
прошу перенести тему в соответствующий раздел...

в документации (rtl/graph/setbkcolor) есть подобная процедура SetBkColor -- Set background drawing color
Errors -- None.

Открываем исходники и читаем:

  procedure SetBkColor(ColorNum: Word);
  { Background color means background screen color in this case, and it is  }
  { INDEPENDANT of the viewport settings, so we must clear the whole screen }
  { with the color.                                                         }
...

То есть, после вызова SetBkColor, чтобы изменения вступили в силу, надо вызвать ClearDevice, следовательно программа не будет работать точно так же, как и в TP...

А без отчистки экрана никак?


Добавлено через 11 мин.
и что надо сделать что б работало SetTextStyle? а то у меня шрифты не отличаются...

С использованием SetBkColor - никак. А по-другому - очень медленно:

	for i:=0 to 15 do begin
		readln(color);
		setfillstyle(solidfill, color);
                floodfill(1, 1, getbkcolor);
		OutTextXY (100,100+(i*10), ColorToString(Color));
	end;

(да и артефакты остаются)

Показывай, что делаешь.

это кто?
вот процедурка... использую так же как и dr

procedure text;
var	i:integer;
begin
	SetTextStyle(DefaultFont, HorizDir,10);	OutTextXY (100,100+(i*100), 'TEXT');	inc(i);
	SetTextStyle(TriplexFont, HorizDir,10); OutTextXY (100,100+(i*100), 'TEXT');	inc(i);
	SetTextStyle(TSCRFont, HorizDir,10);	OutTextXY (100,100+(i*100), 'TEXT');	inc(i);
	SetTextStyle(LCOMFont, HorizDir,10);	OutTextXY (100,100+(i*100), 'TEXT');	inc(i);
	SetTextStyle(ScriptFont, HorizDir,10);	OutTextXY (100,100+(i*100), 'TEXT');	inc(i);
end;	

Так:

procedure text;
var	i:integer;
begin
  i := 100;
  settextjustify(lefttext, toptext);

  SetTextStyle(DefaultFont, HorizDir,2); OutTextXY (100,i+10, 'TEXT');
  inc(i, textheight('W'));
  SetTextStyle(TriplexFont, HorizDir,2); OutTextXY (100,i+10, 'TEXT');
  inc(i, textheight('W'));
  SetTextStyle(TSCRFont, HorizDir,2);    OutTextXY (100,i+10, 'TEXT');
  inc(i, textheight('W'));
  SetTextStyle(LCOMFont, HorizDir,2);    OutTextXY (100,i+10, 'TEXT');
  inc(i, textheight('W'));
  SetTextStyle(ScriptFont, HorizDir,2);  OutTextXY (100,i+10, 'TEXT');
  inc(i, textheight('W')); // <--- Не обязательно
end;

и все CHR-файлы либо в одной папке с программой, либо переведены в PP файлы с помощью подобной команды:
, и подключены к программе через {$i имя файла}... У меня все работает по первому варианту.

что такое SetTextJustify?
А где они?

Я брал из 7-го Турбо Паскаля - формат один и тот же...
Если надо - забирай: Нажмите для просмотра прикрепленного файла

Устанавливает выравнивание текста. То что я привел - говорит компилятору, что точка, координаты которой задаешь в OutTextXY, будет левой (LeftText) верхней (TopText) точкой выводимого текста, то есть, весь текст пойдет от нее вправо и вниз. А вот для того, чтобы пропускать между строками, напечатанными разными шрифтами одинаковое расстояние, пользуемся TextHeight, которая выдаст высоту переданной ей буквы (обычно передают "W", как самую высокую) для текущего шрифта...

вот моя менюшка...

uses Graph,crt;
function menuText(i:integer):string;
const a: array[1 .. 6] of ShortString = (
    ('New'), ('last'), ('Record'), ('level'), ('Rules'), ('exit')
  );
begin
	menuText:=a[i];
end;

function init:integer;
var
	grDriver: Integer;
	grMode: Integer;
begin
	grDriver := Detect;
	InitGraph(grDriver, grMode, '');
	init := GraphResult;
end;

procedure dr;
var
	i:integer;
	x1,x2,y1,y2,k:integer;
begin
	ClearViewPort;
	SetBkColor(blue); 	
	ClearDevice;
	
	k:=round ((GetMaxY / 50));
	x1:=round (GetMaxX*(1 / 3));
	x2:=round (GetMaxX*(2/3));
	SetTextStyle(TSCRFont, HorizDir,3);  
	for i:=1 to 6 do begin
		y1:=round ((GetMaxY / 10)*(i+1) +k);
		y2:=round ((GetMaxY/10)*(i+2) ); 
		Rectangle(X1,Y1,X2,Y2);
		//должно выводить в ЦЕНТР текущего прямоугольника, а не выводит : (
		OutTextXY (  round( ((x2+x1-Length(menuText(i)))/2 )), (y1+y2) div 2 , menuText(i));
	end;
end;

function UserEnter():integer;
	var select:integer;
	ch:char;
	x1,x2,y1,y2,k:integer;
	C:word;
const
	Up = #72;
	Down = #80;
	Esc =#27;
begin
	k:=round ((GetMaxY / 50));
	select:=1;
	repeat 
		x1:=round (GetMaxX*(1 / 3));
		x2:=round (GetMaxX*(2/3));
		y1:=round ((GetMaxY / 10)*(select+1) +k);
		y2:=round ((GetMaxY/10)*(select+2) ); 
		Rectangle(X1-10,Y1-10,X2+10,Y2+10);
		ch:=ReadKey;
		if ch=Up then dec(select)//тут надо будет дописать, что б не уходили меньше 1...
			else if ch=Down then inc(select);
				C:=GetColor;
		SetColor(GetBkColor);
		Rectangle(X1-10,Y1-10,X2+10,Y2+10);
		SetColor©;
		writeln('ro',select);
	until (ch <> Esc);
	writeln('re',select);
	UserEnter:=select;		
end;	

begin
	if init = grOk then begin 
			Dr;
			UserEnter();
			{case UserEnter() of
				1 : New   
				2 : last;
				3 : Record;
				4 : level;
				5 : Rules;
				6 : exit;
			end;	}	
			Readln;
			CloseGraph;  
	end; 
end. 

проблема основная -- что-то с циклом отрисовки нового выбора пользователя(прямоугольник новый не отрисовывается)
проблемма второстепенная -- текст выводится не в центр
что делать?

Так?

uses Graph,crt;

const
  max_items = 6;

function menuText(i: integer): string;
const
  a: array[1 .. max_items] of string = (
    'New', 'last', 'Record', 'level', 'Rules', 'exit'
  );
begin
  menuText:=a[i];
end;

function init:integer;
var
  grDriver, grMode: smallint; // <--- Для FPC
begin
  grDriver := Detect;
  InitGraph(grDriver, grMode, '');
  init := GraphResult;
end;

procedure dr;
var
  i:integer;
  x1,x2,y1,y2,k:integer;
begin
  ClearViewPort;
  SetBkColor(blue);
  ClearDevice;

  k:=round ((GetMaxY / 50));
  x1:=round (GetMaxX*(1 / 3));
  x2:=round (GetMaxX*(2/3));
  SetTextStyle(TSCRFont, HorizDir,3);
  settextjustify(centertext, centertext);

  for i:=1 to 6 do begin
    y1:=round ((GetMaxY / 10)*(i+1) +k);
    y2:=round ((GetMaxY/10)*(i+2) );
    Rectangle(X1,Y1,X2,Y2);
    outtextxy(x1 + ((x2 - x1) div 2), y1 + ((y2 - y1) div 2), menuText(i));
  end;
end;

function UserEnter():integer;
var
  select:integer;
  ch:char;
  x1,x2,y1,y2,k:integer;
  C:word;
const
  Up = #72;
  Down = #80;
  Esc =#27;
begin
  k:=round ((GetMaxY / 50));
  select:=1;
  repeat
    x1:=round (GetMaxX*(1 / 3));
    x2:=round (GetMaxX*(2/3));
    y1:=round ((GetMaxY / 10)*(select+1) +k);
    y2:=round ((GetMaxY/10)*(select+2) );
    Rectangle(X1-10,Y1-10,X2+10,Y2+10);
    ch:=ReadKey;
    case ch of
      #0:
        case readkey of
          Up:
            if select > 1 then dec(select);
  	Down:
            if select < max_items then inc(select);
        end;
      Esc:
        break;
    end;

    C:=GetColor;
    SetColor(GetBkColor);
    Rectangle(X1-10,Y1-10,X2+10,Y2+10);
    SetColor©;
    writeln('ro',select);
  until false;
  writeln('re',select);
  UserEnter:=select;
end;

begin
  if init = grOk then begin
    Dr;
    UserEnter();
    {
    case UserEnter() of
      1 : New
      2 : last;
      3 : Record;
      4 : level;
      5 : Rules;
      6 : exit;
    end;
    }
    Readln;
    CloseGraph;
  end;
end.

ага, только есть вопрос... к вот этому x1 + ((x2 - x1) div 2)
ведь round( ((x2+x1-Length(menuText(i))*ширина символа)/2 )) тоесть (х2 - х1) -- длина всего прямоугольника, (Length( menuText(i) )*ширина символа) -- ширина строки(далее L), тогда (х2 - х1)-L--<<остаток>>, делем на 2 и получаем левый остаток. Но и x1 + ((x2 - x1) div 2) выводит посредине, почему?

Потому что именно так я нахожу центр прямоугольника, а потом заставляю текст выводиться со смещением (centertext, centertext), то есть, центр текста совпадает с центром прямоугольника.

Как это делается - проблема модуля Graph, это пусть он себе голову морочит, что надо сделать для правильного вывода текста. Я только говорю, что я хочу получить в результате.

теперь ясно... спасибо.

Добавлено через 4 мин.
стройка начата... с ворот...