Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 30.11.2010, 21:53   #1
Денис999
Форумчанин
 
Регистрация: 24.05.2010
Сообщений: 124
По умолчанию Графика в Паскале

Подскажите как можно сделать сделать меню в моей программе..
вот я сделал меню:
Код:
uses crt;
const number_item=3;
var c:char;
    i:integer;
procedure out_menu(flag:integer);
var f_1,f_2,f_3:byte;
begin
f_1:=1;
f_2:=1;
f_3:=1;
if flag=1 then f_1:=16;
if flag=2 then f_2:=16;
if flag=3 then f_3:=16;

     textcolor(f_1);
     gotoxy(30,8);
     writeln('File');
     textcolor(f_2);
     gotoxy(30,10);
     writeln('EDIT');
     textcolor(f_3);
     gotoxy(30,12);
     writeln('HELP');
     textcolor(1);
     gotoxy(1,1);
     writeln('q-exit, d-down, u-up, e-enter');
end;

procedure file_;
begin
window(20,5,50,15);
textbackground(3);
clrscr;
writeln('Item FILE - 1 tip okna');
writeln('Any key to EXIT to main menu');
repeat until keypressed;
window(1,1,80,25);
textbackground(6);

end;

procedure edit;
begin
window(20,10,70,20);
textbackground(5);
clrscr;
window(21,11,69,19);
textbackground(4);
clrscr;
writeln('Item EDIT');
writeln('Any key to EXIT to main menu');
repeat until keypressed;
window(1,1,80,25);
textbackground(6);
end;

procedure help;
begin
window(20,5,50,15);
textbackground(0);
clrscr;
window(17,4,47,13);
textbackground(3);
clrscr;
writeln('Item FILE');
writeln('Any key to EXIT to main menu');
repeat until keypressed;
window(1,1,80,25);
textbackground(6);
end;

begin
i:=1;
textbackground(6);
clrscr;
     repeat
           clrscr;
           if (i>number_item) or (i<1) then i:=1;
           out_menu(i);
           c:=readkey;
           if  c='d' then i:=i+1;
           if c='u' then i:=i-1;
           if c='e' then
              case i of
                   1:file_;
                   2:edit;
                   3:help;
              end;

     until c='q';
end.
Денис999 вне форума Ответить с цитированием
Старый 30.11.2010, 21:54   #2
Денис999
Форумчанин
 
Регистрация: 24.05.2010
Сообщений: 124
По умолчанию

а вот сама программа:
Код:
program kyrs;

uses
 Dos, Crt;

const
 MaxBufLen = 65520;

type
 RGB = record
  Red,
  Green,
  Blue : Byte;
 end;

 PCXHeader = record
  Maker        : Byte;
  Version      : Byte;
  Code         : Byte;
  BitsPerPixel : Byte;
  XLow         : Word;
  YLow         : Word;
  XHigh        : Word;
  YHigh        : Word;
  Hres         : Word;
  Vres         : Word;
  Palette      : array [0..15] of RGB;
  VMode        : Byte;
  PlaneCount   : Byte;
  BytesPerLine : Word;
  Reserved     : array [0..59] of byte;
 end;

 BufType = array [1..MaxBufLen] of Byte;
 PtrToByte = ^Byte;

 Pallette = array [0..255] of RGB;

var
 PCXFile  : File;
 FileName : PathStr;
 Header   : PCXHeader;
 VGAPtr   : PtrToByte;
 Count    : Byte;
 Data     : Byte;
 i        : Byte;
 Regs     : Registers;
 PlaneNum : Byte;
 Bytes    : Word;
 Lines    : Word;
 Buf      : ^BufType;
 BufPtr   : Word;
 BufLen   : Word;
 Pal      : Pallette;
 VGAFile  : Boolean;

Function RGBColor(ColorNum : Byte) : Byte;
 begin
  RGBColor := (((Header.Palette[ColorNum].Red div 85) and 1) shl 5) +
              (((Header.Palette[ColorNum].Red div 85) and 2) shl 1) +
              (((Header.Palette[ColorNum].Green div 85) and 1) shl 4) +
              (((Header.Palette[ColorNum].Green div 85) and 2) shl 0)+
              (((Header.Palette[ColorNum].Blue div 85) and 1) shl 3)+
              (((Header.Palette[ColorNum].Blue div 85) and 2) shr 1);
 end;

BEGIN
 FileName :='123456.pcx';
 Write('File name : ');


 { ReadLn(FileName) }

  WriteLn(FileName);

 Assign(PCXFile, filename);
 Reset(PCXFile, 1);

BlockRead(PCXFile, Header, SizeOf(PCXHeader));

 VGAFile := Header.BitsPerPixel = 8;        { …б«Ё 8 ЎЁв, в® 256 梥⮢.  }
                                            { ЌҐ  ЄбЁ®¬ , *® p Ў®в Ґв.    }
 if VGAFile then
  begin
   Seek(PCXFile, FileSize(PCXFile)-SizeOf(Pal)); { ‚ 256-梥в*®¬ д ©«Ґ    }
   BlockRead(PCXFile, Pal, SizeOf(pal));         { Ї «Ёвp  ў б ¬®¬ Є®*жҐ. }
   Seek(PCXFile, SizeOf(header));
  end;

 New(Buf);
 BufLen := 0;
 BufPtr := 1;
 Lines  := 0;


 if VGAFile then
  asm                                        { „®бв в®з*® ¬гв®p* п ¤«п    }
   lea si, pal                               { Ї бЄ «п Їp®жҐ¤гp  § Јpг§ЄЁ }
   mov cx, 768                               { VGAи*®© Ї «Ёвpл.           }
  @1:
   shr byte ptr [si], 1
   shr byte ptr [si], 1
   inc si

   loop @1

   mov ax, 0013h                             { 320x200x256colors          }
   int 10h

   mov ax, 1012h
   xor bx, bx
   mov cx, 256
   mov dx, seg pal
   mov es, dx
   mov dx, offset pal
   int 10h                                   { ўбо Ї «Ёвpг - Јгp⮬.      }
  end
 else
  begin                                      { Ђ б EG®© в Є *Ґ ᤥ« вм.   }
   Regs.AX:=$0010;
   Intr($10, Regs);

   for i := 0 to 15 do
    begin
     Regs.AH := $10;
     Regs.AL := 0;
     Regs.BL := i;
     Regs.BH := RGBColor(i);
     Intr($10, Regs);
    end;

   { Write mode }
   Port[$3CE] := 5;                          { €*Ёв Ї®pв®ў ¤«п § ЇЁбЁ.    }
   Port[$3CF] := 0;

   Bytes := 1;
   PlaneNum := 1;
   Port[$3C4] := 2;                          { Џ« * #1.                   }
   Port[$3C5] := 0;
  end;

 VGAPtr := Ptr($A000, $0000);

 repeat
  if BufPtr > BufLen then
   begin
    BlockRead(PCXFile, Buf^, MaxBufLen, BufLen);
    BufPtr := 1;
   end;

  Data := Buf^[BufPtr];
  Inc(BufPtr);

  if Data and $C0 = $C0 then                 { ђ бЇ Є®ўЄ  RLE-Є®¬ЇpҐббЁЁ. }
   begin
    Count := Data and $3F;
    if BufPtr > BufLen then
     BlockRead(PCXFile, Data, 1)
    else
     begin
      Data := Buf^[BufPtr];
      Inc(BufPtr);
     end;
   end
  else
   Count := 1;

  for i := 1 to Count do
   begin
    PtrToByte(Longint(VGAPtr) + Bytes - 1)^ := Data;
    Inc(Bytes);
    if Bytes > Header.BytesPerLine then
     begin
      Bytes := 1;
      if VGAFile then
       begin
        Inc(Longint(VGAPtr), Header.BytesPerLine); { VGA => Їp®б⮠㢥«Ё- }
        Inc(Lines);                                { зЁвм бзҐвзЁЄ.        }
       end
      else
       begin                                       { EGA => ЇҐpҐЄ«оз вм   }
        if PlaneNum > 3 then                       { Ї« *л ®в 0 ¤® 3,     }
         begin                                     { Ї®в®¬ - бзҐвзЁЄ.     }
          PlaneNum := 0;
          Inc(Longint(VGAPtr), Header.BytesPerLine);
          Inc(Lines);
         end;
        Inc(PlaneNum);
        Port[$3C4] := 2;                           { ‘®Ўб⢥**® ўлЎ®p     }
        Port[$3C5] := 1 shl (PlaneNum-1);          { Ї« * .               }
       end;
     end;
   end;
 until Lines > Header.YHigh;                       { Љ ¦Ёбм, ўбҐ.         }

 ReadKey;

 Dispose(Buf);
 Close(PCXFile);

 TextMode(3);
END.
Денис999 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Графика в Паскале Moro Помощь студентам 5 30.06.2009 13:54
графика в паскале Kravec Паскаль, Turbo Pascal, PascalABC.NET 5 16.04.2009 17:27
Графика на Паскале HECTOR.A. Помощь студентам 1 24.03.2009 04:14