                               Borland          |
                           TURBO PASCAL 7.1     |
                                                |
                             |
                                                |
                                   _____________|
                                   |-=CHE@TER=- |
                                   ~~~~~~~~~~~~~~

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!                :       !!!
!!!!!!!!!!!!!     http://CTPAX-CHEATER.losthost.org     !!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!         :       !!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!       _CTPAX_@MAIL.RU       !!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!  v2.3   10.09.2007       !!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!  v2.2   04.09.2007       !!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!  v2.0   07.11.2004       !!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!  v1.0   ??.??.????       !!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!


  :

1) 㯫
2) ᪮쪮 ᮢ⮢
3) 祭 ⠭ ".CHR" ⮢  ".BGI" ࠩ஢  ".EXE"
4) 祭  䠩  ".EXE"
5)   ⥪⮢ 䨪
6)  㭪  ଠ Borland Pascal/C (ᮧ GetImage')
7)    16- 梥

......................................................................
..............................㯫..............................
......................................................................

    Turbo  Pascal  뫮  ᠭ      (,  ୮,  
).    祬      ?    -    
稭  짮⥫,      ,  㦥 "⢮ " 
ணࠬ஢    ⮬  몥.  ᮤন ᭥ 
ᮢ,   묨  ᢮ ६  (쭮  ᯥ譮)
.  ᠭ    ⮩   ணࠬ ⫠  Borland Turbo
Pascal 7.1,   ࠡ   6- ᨨ .

......................................................................
..........................᪮쪮 ᮢ⮢...........................
......................................................................

  ⠪,      ᯮ ணࠬ, . ࢮ,  , 
 ணࠬ. ,     ⮩ ணࠬ:

var i:byte;
begin for i:=1 to 100 do writeln('Turbo Pascal - 4ever!');readln;end.

쭮 㤭⥫쭮,   ⮩:

Var
    I: Byte;
Begin
  For I:=1 To 100 Do
    WriteLn('Turbo Pascal - 4ever!');
  ReadLn;
End.

      ᮢ -  ணࠬ ஢.   ,
        १  ஥  ६,   ,  
.   ⮣,  ॡ ६, ⮡ ᭮   .
ᮡ, ᫨  ணࠬ ப, ⠪,  1000  .
  .      㦥  ⨫  -    楤  㭪権. 
㤭,        (  ࠧ     㪢),
ᯮᮡ,       ॥  ணࠬ.  뢠 
"騥  ".    砥    ⮬,      ६
"shetchik_okrujnostey",     -  "j",  "z"    "so",  
  ६  "CircleCounter".     ,  
  ६      㪢.    ⠪  ࠧ 
,   稢  ᫮  稭 㣮.  
(  祫,       ணࠬ  ࠧ,  
    )      ⠭ ⭮ 祭 ६ -
稪  㦭⥩.   ᪠: ᫨    ᪨,
          - ⮣ 㡠.   ᬮ , 
 㭪 EOF(Fl) -  ஢뢠  EndOfFile (
䠩)   䠩 ६ Fl (㭪 頥 "True" (⨭),
᫨    ⨣    䠩  Fl,  "False" ()). ࠢ,
  ६    ᮪,  ᫨    ⠢襩 
  ⠭  , ਬ:

FName - FileName ( 䠩)
MItem - MenuItem (㭪 )
 ⠪ ...

  㦭 ,   ।  ਭ ᫥騥 祭:
-----------------------------------------------------------
|  ᮪饭  |   祣  |  ॢ (⨯  ६)  |
-----------------------------------------------------------
|*Str/St/S     | String    | ப (ப)           |
|*Val          | Value     | 祭 (᫮)          |
| Fl/F         | File      |  (䠩)              |
| Prn          | Printer   | ਭ ( )         |
| P            | Pointer   | ⥫ (㪠⥫)        |
| Ch           | Char      |  (ᨬ)          |
|***********  -   *****************************|
| Sum          | Sum       | 㬬                        |
|*Pos          | Position  |  ( 䠩/ப/..)|
| Chk          | Check     | ஢ઠ (: 䠩)|
| Gr           | Graph     | 䨪 (: . .)|
-----------------------------------------------------------
    ⠪ ...
*  -  ⬥祭 楤  㭪樨,    Turbo
Pascal,         ᯮ짮  ⤥쭮,    ⥫쭮
,  ⮫쪮   . ਬ:

Var
    Val: Integer; - 

  :

Var
    XVal, Val1, Val2: Integer;


......................................................................
..祭 ⠭ ".CHR" ⮢  ".BGI" ࠩ஢  ".EXE"..
......................................................................

    ,    㦥  ணࠬ஢   䨪, 猪 
ᮬ  -    ".EXE"  㦥 ⮢ ணࠬ,  
䠩-ࠩ ᪨ ०?
   ࠩ    :
  1) ⠭ (,  ᯮ   ".EXE" 䠩):
      -  (*.CHR):

          䨪 |  |  䠩
            GRAPH.TPU  |       |  
          ---------------------------------
          TriplexFont   |   1   | TRIP.CHR
          SmallFont     |   2   | LITT.CHR
          SansSerifFont |   3   | SANS.CHR
          GothicFont    |   4   | GOTH.CHR
                        |   5   | SCRI.CHR
                        |   6   | SIMP.CHR
                        |   7   | TSCR.CHR
                        |   8   | LCOM.CHR
                        |   9   | EURO.CHR
                        |  10   | BOLD.CHR

      - ࠩ ᪨ ० (*.BGI):

         CGA.BGI
         EGAVGA.BGI
         IBM8514.BGI
         HERC.BGI
         ATT.BGI
         PC3270.BGI

          ᫥ ०:

          䨪 |  |  䠩
            GRAPH.TPU  |       |  ࠩ
          ---------------------------------
               CGA      |  1    | CGA.BGI
               MCGA     |  2    | CGA.BGI
               EGA      |  3    | EGAVGA.BGI
               EGA64    |  4    | EGAVGA.BGI
               EGAMono  |  5    | EGAVGA.BGI
               IBM8514  |  6    | IBM8514.BGI
               HercMono |  7    | HERC.BGI
               ATT400   |  8    | ATT.BGI
               VGA      |  9    | EGAVGA.BGI
               PC3270   | 10    | PC3270.BGI

  2) ⠭ ( ⠫,  ᫥ ):
      -  (⨯: FN01.CHR; FN09.CHR; GREK.CHR;  ..)
      - ࠩ ᪨ ० (SVGA256.BGI; VGA256.BGI;  ..)

     ࠧ,   ᫨           ᢮  ணࠬ
⠭   ࠩ,   :

  SetTextStyle(1, 0, 3); {   }
  { - - - }

  GrDriver:=1; {  ࠩ }
  GrMode:=0;
  InitGraph(GrDriver, GrMode, '');

    ⠪:

  SetTextStyle(TriplexFont, 0, 3); {   }
  { - - - }

  GrDriver:=CGA; {  ࠩ }
  GrMode:=CGAC0;
  InitGraph(GrDriver, GrMode, '');

   ⠭ /ࠩ 㤥 .

    ⠭ 㦭  ⠪:

  Var
      MyFnt: Integer;

  { - - - }

  MyFnt:=InstallUserFont('font');
  SetTextStyle(MyFnt, 0, 3); {   }
  { - - - }

  GrDriver:=InstallUserDriver('svga256', Nil); {  ࠩ }
  GrMode:=0;
  InitGraph(GrDriver, GrMode, '');

    ⠪  ᪫,  ࠩ    , ...  
㤥 ਫ  ".EXE" ணࠬ!
  ⮯!  ⢥,  -  祣  稭    -. 祬
࠭    䠩     ".EXE"?  祬?!  ᫨  㣨
䠩,      ᤥ    ணࠬ,    ன  㤥
몠  砩,      㦭 䠩! ,  
祭 㤮, ᮡ  ᪨ ।஢.
  ᫨      ᢮  ணࠬ  Graph.tpu  (Uses  Graph;),  
ᤥ  ᯮ塞  䠩  (  ᫮,     뢠  ᢮
ணࠬ      楤    㭪   Graph,  
    ),  ᬮॢ 稢訩 ".EXE" 䠩 
⭠   ।஬   (  䠩),        
  ᫥  ⮢  ࠩ஢ (⮫쪮  ७
".CHR"  ".BGI" ᮮ⢥⢥).    ⮬,   䠩 GRAPH.TPU
யᠭ     ࠩ. 室  :

1) ᯮ  GRAPH.TPU,  ࠢ    ⭠筮 । 
-      ࠩ,  ਬ  "GOTH"   "FN01" 
"IBM8514"  "SVGA256".  ⮬ 砥   㤠 ᮡ ணࠬ
   㦮     (  ਤ      ᮡ ࠢ
GRAPH.TPU).

2)  ()  ࠢ  /ࠩ.     "FN01.CHR" 
"SVGA256.BGI",  ,  ᮮ⢥⢥, "GOTH.CHR"  "IBM8514.BGI".  ⮬
砥        ९ 騩   ࠩ  
(    砩).  ᯮ짮 /ࠩ, ண 
,     ᯮ.     !!!    ⮫쪮
२    䠩,    ࠢ     ( ᠬ
  砫)  ᫮ "FN01"  "GOTH"  "SVGA256"  "IBM8514"!  
  䠩, ணࠬ  ࠢ  ᨣ!

  ᫥ ⮣, , 砩 ࠤ ࠩ/:

1)    ப:
   BINOBJ GOTH.CHR GOTH.OBJ GothicFont
     
   BINOBJ IBM8514.BGI IBM8514.OBJ IBM8514Driv
    ࠩ.

2) 稢訩  ".OBJ"  䠩      ⮬  ⠫,  
   ᭮ ணࠬ,   யᠭ 
   Options -> Directories... -> Object directories

3)   ணࠬ (  楤  㭪樨):

  {$F+}
  Procedure GothicFont; External; {   }
  {$L GOTH}
  {$F-}


  {$F+}
  Procedure IBM8514Driv; External; {  ࠩ }
  {$L IBM8514}
  {$F-}

4)   ணࠬ :

   If RegisterBGIDriver(@IBM8514Driv)<0 Then Halt;
   If RegisterBGIFont(@GothicFont)<0 Then Halt;

   । 樠樥 䨪 (InitGraph) :
   GrDriver:=IBM8514;

    ᯮ짮  (⢥ । OutText/OutTextXY):

   SetTextStyle(GothicFont, 0, 3);

  .   ணࠬ   ".EXE" 䠩.
   ᡥ :

  http://www.ibsensoftware.com/

    ࠧ  ⫨  娢஬  ᯮ塞  䠩, ⮡ 
ணࠬ   . : apack -x -1 myprg.exe
  ᫥   ⮣     㤠    ".EXE"  䠩    २
稢訩 "OUT.EXE".

  aPACK: ".:the:smaller:the:better:."
...
  aPACK v0.99b Copyright (c) 1997-2000 by Joergen Ibsen / Jibz
                                           All Rights Reserved
...

......................................................................
...................祭  䠩  ".EXE"....................
......................................................................

     ਬ ⨭.
    㦥  猪      ⨭    ଠ Borland
Pascal/C  (GetImage).    ,   祭 ⮩ ⨭  ".EXE"
:
1)    ப:
   BINOBJ PICTURE.GRA PICTURE.OBJ PICTURE
2)   ணࠬ (  楤  㭪樨):

  {$F+}
  Function Picture: Pointer; External;
  {$L Picture}
  {$F-}

3)  ! ⮡ ᯮ짮  ⨭,    
  !  ⠪:

  Var
      Pic: Pointer;

  { - - - }
  Pic:=Addr(Picture);
4) ,  뢮   ࠭:

   PutImage(0, 0, Pic^, CopyPut);

      ᯮᮡ        ⥪⮢  䠩   
㣮!      ࠭祭!  ணࠬ   뫠 
65520  !  ᫨  祭 讣 㭪 ( ᢮ INTRO,
ਬ) ணࠬ ᮮ頥,  ᥣ ᫨誮 让 - ஡
뭥  楤  祭 䠩  ⤥  (".TPU"),  ⮬
맢      ᭮  ணࠬ:  Uses  MyUnit;     ᬮ
 쭮 .


......................................................................
.....................  ⥪⮢ 䨪......................
......................................................................

  ᫨        Turbo  Pascal  ⭮⥫쭮   (
-  ),    ᪮॥  ᥣ   㬥  ࠡ 
䨪,        ⥪⮢ ०.  祭   ᮢᥬ 
㦭 䨪. ਬ,  㦭  SETUP.   ४᭮
ᤥ        ⥪⮢  ०!      ,    
ॡ (ࠡ  񭭮 CRT ):

TextColor(Color); {  ⥪ - 梥  SetColor(); }
TextBackGround(Color); - {  䮭,  ஬ 뢮 ⥪, }
                         { ᫨ ਡ 128 - 㤥  }

    ਬ   襬 -   .    ⮬,
 ᫨  ணࠬ ࠡ⠥   ०  Windows,  
    㡥.    ⮬,    Windows  ᠬ   .   
࠭ ० (  DOS) -   浪.
    ⮣ ⮡  祧 ( ᮧ , ਬ),  
ᯮᮡ:
1)  뢥   ( 㣮 梥)   ⠪  梥 䮭
(  㤥   ᮢ ࠦ  ࠭).
2)  , ᪠ CrsrVis,   㤠  :

   Procedure SetCursorSize(CurStart, CurEnd: Byte); Assembler;
   Asm
     mov ah, 1;
     mov ch, CurStart;
     mov cl, CurEnd;
     Int 10h
   End;

   Procedure CursorVis(CurVis: Boolean);
   Begin
     If CurVis=True Then SetCursorSize($06, $07) Else SetCursorSize($20, $00);
   End;

   ,   ,  㣠,  - Assembler.
   맮

  CursorVis(False);

   祧,  

  CursorVis(True);

  ᭮ .

    ⮬,   ᨬ  ⥪⮢ ࠭. 猪, 
  ࠧ  ⥫  ᤥ?  㭪樨 ᯫ, ,    
᫨誮      (  CGA  ᯫ),  ⠪    
  .    ᮢ६ ஢  ⥪⮢
० 稭   $B800.  !  ஥ ᫥騬 ࠧ:
    -  ᨬ,  ன    ਡ (ࢠ  梥
䮭     ( ),    - 梥 ⥪). 
ࠧ, ⮡  40- ᨬ  10- 窨 㦭:

Var
    Ch: Char;
     B: Byte;

    { - - - }

  B:=Mem[$B800:((10-1)*80*2)+(40-1)*2];
  Ch:=Chr(B);

  Mem - ᨢ  ࠡ  .  ᥣ  :

  Mem[] - ࠡ⠥  ⠬ (Byte)
  MemW[] - ࠡ⠥  ᫮;   (Word)
  MemL[] - ࠡ⠥  묨 ᫮;   (LongInt)

    ⠪      ࠭ (⮣   㤥
,    㦥 ᠬ  㤥 ᫥  ⥬, ⮡ ⥪ 
뫥 " ࠭" - ஫ (ப⪨ ࠭)  㤥):

  Mem[$B800:((10-1)*80*2)+(40-1)*2]:=B;


......................................................................
...... 㭪  ଠ Borland Pascal/C (ᮧ GetImage)......
......................................................................

        16-  梥⮢  㭪,  ⠪   ᠬ 
騥  㭪.    ᫥     Borland Pascal/C ࠡ
,    ᨫ  ⮣,   ⠭ 16- 梥⮢ ०  㦭
⠪       ⫨稥  ०   ᮪ ⢮
梥⮢.        ,  CGA    ୮-    㦥  ⬥૨
(ࠪ᪨),  256- 梥⮢  , ०   ਦ  "
".
  ⮡        㭪      GetImage  Pascal  C
࠭,    ᬮਬ,      뫨  ஥  16-
梥⮢ ,    ᥩ   ন.
  ⠪.  16  梥⮢. ७쪮 ᮮࠦ... 16   0  15 ⮣,
ࠧ,  , ,  -  , 㦭 ⮡ ஢  
16- 梥⮢ (0000 -  梥 0, 0001 - 1, 0010 - 2, ...., 1111 - 15).
,    ࠭  ᥫ 墠    ࠭
 ᥫ -  .  ⠪  ࠭   Borland?
.  ᥩ  , 祬.   ⮬,  16- 梥⮢ ०, 
⫨稨,  ᪠,    2- 梥⮢  256- 梥⮢,  ᮤন
梥  ᥫ      砫  ࠭ - $A000:0000.  ࠭
梥        ᪮ - ᭠, ,
ᨭ  ⥭ᨢ (/).    ᪮⥩ 砥
뫪  ।      㦭  , ᫥ 祣 ந
    ⥭     ⮢ ᪮.  , ⮡ 뢥
ᥫ  ࠭, 㦭   ।   ⮢ ᪮
    (   ᭮,     ࠧ 
⠬    ᪮ﬨ  ⤥쭮,    ⮩   ᫥ 㣠
楫).  ,  ⢥  ⭮,          ᪮
뢠      ୮-  ०.          
ࠤ  ?      砥    ।  
  㭪  ᭠砫  ,  ⮬  ,    
᪮,    㤠    堥    㣮  䠩. 
    ᭠砫 堥  䠩  1- ⮢ ᪮ 
ࢮ  ப,  ⮬  ᫥  ,  ⮢ ᪮ ⮩ 
ப   .. ⥬ 室  ᫥饩 ப. ⬥,  ⠪ 
ଠ  ࠭  ᪥ ⭮,   ࠭  ᥫ
ணࠬ  4  (  -梥,   !).   
࠭ 2- ᥫ  ਧ⠫,  3-,  .,   8-, 
  ࠢ  㤥  뢠  4- . , ᮮ⢥⢥ 8 
  ⢮    8-   16- .   﫨, 
࠭  ⨭.   ᪠  ᠬ ଠ 䠩.
  ଠ 쬠 ⮩:
     (Word) - ਭ_㭪-1 (Width)
     (Word) - _㭪-1 (Height)
   ࠦ  㪠  ଠ,  ࢠ ⮢ ப
ᮤন   ⥭ᨢ,   ⥬      ᭠,      ᨭ
⮢騥 梥.
    ᫥      (Word),  ⭮  祣 (  
 - १ࢨ஢).
   ணࠬ 뢠 ࠧ ࠦ ( ):

  Width:=Width+1;
  Heigth:=Heigth+1;
  If Width Mod 8 <> 0 Then FSize:=((Width Div 8)+1)*4
  Else FSize:=(Width Div 8)*4;
  FSize:=FSize*Height;
  { ⥯  ६ FSize ࠧ ࠦ -  !!! }

    ࠧ,          2!     
!
  祭,    ࠧ      䠩  ࠧ FileSize(FPic) 
  6,    ਢ    ᯮᮡ  䨫஢ 
䠩,        ⨭ ( ०), 筮
㤥 ஢,  ࠦ FSize+6=FileSize(FPic) .
    .    C    PASCAL     
    - 65535 !!!  , ᫨ 
⠥ ࠭, ᪠, ࠭ 640  480, :
1) GetMem(PPic, ImageSize(0, 0, 639, 479));
     PPic 祭 Nil ( -   뤥),  ⠪ 
    뤥  ⠭⭮    64Kb.
2) GetImage(0, 0, 639, 479, P^);
         ,  ⠪  楤 㤥  
    Nil,   0000:0000     뢠.
  㦥   ࠭ ࠦ ?..
      ⥯  ,  ࠤ  祣    ⥢.   ,
ࠦ ࠭  .  蠥  :
1)      䠩 㦭 ࠧ  X  Y.
2) ࠭    ,      ࠭ ப 
         䠩  ⮬ ᫥  ⠪ .  १ 
   襬    :  65535/4  (㣫񭭮) = 16383 ᥫ!
       ⮫쭮   ⠪ ࠧ襭 (⥬ 
    16- 梥⮢)!
3)   ᫥      (᫮).    㤥  0  (ࢮ
   ࠢ  ଠ⮢, ᫨  ᯮ -  0).
  !    㦭  뢠     ⮬,  ⠭ PutImage ⮦ 
ᬮ   ࠢ쭮     ⠪  ⨭  (,  ࠢ  
᭥,    ⨭ 뢥  "猪")!   ਤ 
    窠  ⨭,   ᠬ   १ PutImage
뢮.
    䮭/  /  ⨭  -     筮 
᪮.  㣮    -  .   室 ⠭
PutImage/GetImage,  ⨭  訬.
    ,  ᮡ⢥,      (UNIT),    ⢫  
襯᫥  樨  (   ᢮ ணࠬ  Uses
  F_GRAPH   ᬮ 뢠  ணࠬ):

----------------------------------------------------------------------

{ F_GRAPH.PAS }

{ :        
16-   (EGAVGA.BGI)!    
    𒑟 !
..   DOS ( 뢭 ᪥) 訥 㭪 ࠧ
 ,  ࠡ  ᪫⥫쭮  䠩  ᪥ - 㦭
㪠 .  ⠪ ணࠬ 稭  F_*
⠫ -  ࠡ  묨 㭪.

祭:
FileName -  䠩  ࠡ  㭪 (㧪/࠭/..)

PImg - 㪠⥫  砫   㭪, 筮  ,
        頥 GetImage  㪠⥫  ⠭
        䠩 㭮

X, Y - ᯮ ⮫쪮  F_PutImage - न  孥
       㣫 ⨭   PutImage

 SaveImage:
X1, Y1 - न  孥 㣫 ⨭   GetImage
X2, Y2 - न ࠢ  㣫 ⨭   GetImage
: SaveImage ࠭ ⨭  ! ..  
業   F_PutImage ਣ, ..  ࠡ! ᫨ 室
ࠡ  訬 㭪,   頥  뢭 ᪥
,  ࠧ   ᪮쪮    GetImage 
ࠡ⠩  㭪  窠.
}

Unit F_Graph;
Interface

{ ஢   䠩 - ⨭  䠩, 頥:
0 -   ⨭   ⠩  뢠
1 -  쪠 ⨭ ( 筮 ᯮ Borland Pascal/C )
2 -   ⨭ (ࠡ   ⮫쪮 १ ணࠬ F_*) }
Function F_CheckImage(FileName: String): Byte;

{ ⨥ }
Procedure F_PutImage(X, Y: Word; FileName: String; ImgMode: Integer);

{ ਭ 㭪; 頥 0, ᫨ 㪠 䠩   㭪 }
Function F_GetImgWidth(FileName: String): LongInt;

{  㭪; 頥 0, ᫨ 㪠 䠩   㭪 }
Function F_GetImgHeight(FileName: String): LongInt;

{ ********************************************************* }
{ ᪮쪮 ணࠬ  ⠭, 쪨 㭪 }
{ ********************************************************* }

{ 頥 ࠧ 㭪  ,  0, ᫨   㭮.
।०:  ᯮ  㪠  
㭪    , .. ஢ ⮫쪮  
᫮  ࠧ 稢襣   㭪.  㭪 室
⮫쪮   F_GRAPH  ᮡ 業 ᭠㦨  ।⠢. }
Function GetImgMemSize(PImg: Pointer): Word;

{ 㧪 ࠦ  ; 頥 Nil (), ᫨ ࠦ
 64Kb - ..   ࠧ  뢭  
(ᯮ F_PutImage)  ᫨ ந諠 - 訡  ⨨ }
Function LoadImage(FileName: String): Pointer;

{ ⪠  - 㦥 㦭 㭪; ࠧ 頥 
। ⮬᪨, ⠪   室 ࠭ ६
 ࠧ 뤥  㭪  }
Procedure FreeImage(Var PImg: Pointer);

{ ਭ 㭪; 頥 0, ᫨ 㪠 䠩   㭪 }
Function GetImgWidth(PImg: Pointer): LongInt;

{  㭪; 頥 0, ᫨ 㪠 䠩   㭪 }
Function GetImgHeight(PImg: Pointer): LongInt;


{ ********************************************* }
{ 㭪  ࠭ 㭪  ࠧ }
{ ********************************************* }


{ ࠭   訥 ⠪  쪨 㭪!
 ⮬ 쪨 㭪  ࠭  ⠭⭮ ଠ Borland Pascal/C.
頥:
0 - ࠭ 諮 ᯥ譮
1 -  ᮧ 䠩;    稭:
    )  䠩 ᮤন ⨬ ᨬ
    ) ⠪ 䠩 㦥   ਡ⮬ "⮫쪮 ⥭" (read only),
       室   ਡ  ࠭ ࠦ  㣮 䠩
    ) 䠩 ஢, ⮬    
2 - ந諠 訡    䠩 ( 稫   ᪥) }
Function SaveImage(X1, Y1, X2, Y2: Word; FileName: String): Byte;

Implementation
Uses Graph;

Function F_CheckImage(FileName: String): Byte;
Var Width, Height: LongInt;
               Fl: File;
Begin
  Assign(Fl, FileName);
  {$I-}
  Reset(Fl, 1);
  {$I+}
  If IOResult = 0 Then
    Begin
      Width:=0;
      Height:=0;
      BlockRead(Fl, Width, 2);
      BlockRead(Fl, Height, 2);
      Width:=Width+1;
      Height:=Height+1;
      If Width Mod 8 <> 0 Then Width:=((Width Div 8)+1)*4
      Else Width:=(Width Div 8)*4;
      {$Q-}
      If (Width*Height)+6 = FileSize(Fl) Then
        F_CheckImage:=Ord(FileSize(Fl) > $FFF8)+1;
      {$Q+}
      Close(Fl);
    End
  Else F_CheckImage:=0;
End;

Procedure F_PutImage(X, Y: Word; FileName: String; ImgMode: Integer);
Var Width, Height, LineSize, I: Longint;
                             P: Pointer;
                            Fl: File;
Begin
  If F_CheckImage(FileName) <> 0 Then
    Begin
      Assign(Fl, FileName);
      Reset(Fl, 1);
      Width:=0;
      Height:=0;
      BlockRead(Fl, Width, 2);
      BlockRead(Fl, Height, 2);
      Width:=Width+1;
      Height:=Height+1;
      If Width Mod 8 <> 0 Then LineSize:=(((Width Div 8)+1)*4)
      Else LineSize:=((Width Div 8)*4);
      Width:=Width-1;
      Height:=Height-1;
      GetMem(P, LineSize+4);
      MemL[Seg(P^):Ofs(P^)]:=Width;
      For I:=0 To Height Do
        Begin
          BlockRead(Fl, Ptr(Seg(P^), Ofs(P^) + 4)^, LineSize);
          PutImage(X, Y+I, P^, ImgMode);
        End;
      FreeMem(P, LineSize+4);
      Close(Fl);
    End;
End;

Function F_GetImgWidth(FileName: String): LongInt;
Var
    Fl: File;
    IW: LongInt;
Begin
  If F_CheckImage(FileName) <> 0 Then
    Begin
      Assign(Fl, FileName);
      Reset(Fl, 1);
      IW:=0;
      BlockRead(Fl, IW, 2);
      F_GetImgWidth:=IW+1;
      Close(Fl);
    End
  Else
    F_GetImgWidth:=0;
End;

Function F_GetImgHeight(FileName: String): LongInt;
Var
    Fl: File;
    IH: LongInt;
Begin
  If F_CheckImage(FileName) <> 0 Then
    Begin
      Assign(Fl, FileName);
      Reset(Fl, 1);
      Seek(Fl, 2);
      IH:=0;
      BlockRead(Fl, IH, 2);
      F_GetImgHeight:=IH+1;
      Close(Fl);
    End
  Else
    F_GetImgHeight:=0;
End;


{ ********************************************************* }


Function GetImgMemSize(PImg: Pointer): Word;
Var Width, Height: LongInt;
Begin
  GetImgMemSize:=0;
  If PImg <> Nil Then
    Begin
      Width:=MemW[Seg(PImg^):Ofs(PImg^)];
      Height:=MemW[Seg(PImg^):Ofs(PImg^)+2];
      Width:=Width+1;
      Height:=Height+1;
      If Width Mod 8 <> 0 Then Width:=((Width Div 8)+1)*4
      Else Width:=(Width Div 8)*4;
      {$Q-}
      Width:=(Width*Height)+6;
      {$Q+}
      If Width <= $FFF8 Then GetImgMemSize:=Width;
    End;
End;

Function LoadImage(FileName: String): Pointer;
Var
    PImg: Pointer;
      Sz: Word;
      Fl: File;
Begin
  PImg:=Nil;
  { ⪮ ।塞,   쪮 ࠦ }
  If F_CheckImage(FileName) = 1 Then
    Begin
      Assign(Fl, FileName);
      Reset(Fl, 1);
      Sz:=FileSize(Fl);
      { ஢塞,     ᢮  뢭 ,  ࠧ 㭪 }
      If MaxAvail >= Sz Then
        Begin
          GetMem(PImg, Sz);
          BlockRead(Fl, PImg^, Sz);
        End;
      Close(Fl);
    End;
  LoadImage:=PImg;
End;

Procedure FreeImage(Var PImg: Pointer);
Var Sz: Word;
Begin
  Sz:=GetImgMemSize(PImg);
  If Sz <> 0 Then
    Begin
      FreeMem(PImg, Sz);
      PImg:=Nil;
    End;
End;

Function GetImgWidth(PImg: Pointer): LongInt;
Begin
  If GetImgMemSize(PImg) <> 0 Then
    GetImgWidth:=LongInt(MemW[Seg(PImg^):Ofs(PImg^)])+1
  Else
    GetImgWidth:=0;
End;

Function GetImgHeight(PImg: Pointer): LongInt;
Begin
  If GetImgMemSize(PImg) <> 0 Then
    GetImgHeight:=LongInt(MemW[Seg(PImg^):Ofs(PImg^)+2])+1
  Else
    GetImgHeight:=0;
End;


{ ********************************************************* }


Function SaveImage(X1, Y1, X2, Y2: Word; FileName: String): Byte;
Var Width, Height, LineSize, I: Longint;
                             P: Pointer;
                             Fl: File;
Begin
  SaveImage:=0;
  Assign(Fl, FileName);
  {$I-}
  ReWrite(Fl, 1);
  {$I+}
  If IOResult = 0 Then
    Begin
      If X1>X2 Then
        Begin
          I:=X1;
          X1:=X2;
          X2:=I;
        End;
      If Y1>Y2 Then
        Begin
          I:=Y1;
          Y1:=Y2;
          Y2:=I;
        End;
      Width:=X2-X1;
      Height:=Y2-Y1;
      {$I-}
      BlockWrite(Fl, Width, 2);
      BlockWrite(Fl, Height, 2);
      Width:=Width+1;
      Height:=Height+1;
      If Width Mod 8 <> 0 Then LineSize:=(((Width Div 8)+1)*4)
      Else LineSize:=((Width Div 8)*4);
      Width:=Width-1;
      Height:=Height-1;
      GetMem(P, LineSize+6);
      For I:=Y1 To Y2 Do
        Begin
          GetImage(X1, I, X2, I, P^);
          BlockWrite(Fl, Ptr(Seg(P^), Ofs(P^)+4)^, LineSize);
        End;
      FreeMem(P, LineSize+6);
      I:=0;
      BlockWrite(Fl, I, 2);
      {$I+}
      If IOResult<>0 Then
        Begin
          Erase(Fl);
          SaveImage:=2;
        End
      Else
        Close(Fl);
    End
  Else SaveImage:=1;
End;

End.

{ F_GRAPH.PAS }

----------------------------------------------------------------------


......................................................................
......................   16- 梥......................
......................................................................

    ,   EGA/VGA 16- 梥⮢ ० ⮦  ?
뢠  梥   ⠢  3- ,   
256-  梥⮢  ०  -  ,   ᨭ.   ⫨稥 
256-  梥⮢  ०,      ⥭.      
⥭  梥  ⢮ 2- . ,  ⮢ 
ਭ  祭   0  3-,   (筮): 00, 01, 10  11.
    ⠢騥       ,     
ᯮ.  ⮣ 砥 64 ⥭ ( 0000 0000  00111111).
       ⭮ - 娢      
 ஡.  ! 뢥  稫 ᮢᥬ  , 祣 ⥫
.   ⠪?     ⮬,  । 㯠  ࠧ
  ᫥騬 ࠧ (  ਬ):

   ᪮   祭:

  R=3 (00000011)
             Rr

  G=2 (00000010)
             Gg

  B=1 (00000001)
             Bb


   ⥭: 00 101 110 = 46 (筮)
                   rgb RGB
  :
  r, g, b - 訥 
  R, G, B - 訥 

   㭪,      ८ࠧ  頥 㦥
⮢  ⥭:

Function EGAPalette(R, G, B: Byte): Byte;
Var Hb, Lb, RI, GI, BI: Byte;
Begin
  (* Lo Bits *)

  If R>3 Then R:=3;
  If G>3 Then G:=3;
  If B>3 Then B:=3;

  RI:=R Shr 1;
  RI:=RI Shl 2;

  GI:=G Shr 1;
  GI:=GI Shl 1;

  BI:=B Shr 1;

  Lb:=RI+GI+BI;

  (* Hi Bits *)

  RI:=R Shl 7;
  RI:=RI Shr 2;

  GI:=G Shl 7;
  GI:=GI Shr 3;

  BI:=B Shl 7;
  BI:=BI Shr 4;

  Hb:=RI+GI+BI;

  EGAPalette:=Hb+Lb;
End;

          梥    ⠭⭮ 楤
室饩   GRAPH,  뢠 SetPalette:

  Procedure SetPalette(ColorNum: Word; Color: ShortInt);

  ਬ,    ⠭⭮ ୮ 梥 (0-):

  SetPalette(0, 46);

  ⥫      ⬥,       楤  ࠡ⠥    
᪮ ०.    , ⠪   ⠪ 
  ⥪⮢ ०.  ,   ᯮ짮  楤:

Procedure ChangePalette(Color, Palette: Byte); Assembler;
Asm
  xor al, al
  mov ah, 10h
  mov bl, Color
  mov bh, Palette
  int 10h
End;

  -⠪    ᮢ    㣠  ᥬ,   ⠭
ࢨ BIOS - 10h.

       楤   梥  ࠭ (ਬ
  , ᫨ ᮭ  ࠫ - ।; ᤥ
   - 梥, ⥬ ᭮ ):

Procedure BorderColor(Color: Byte); Assembler;
Asm
  mov ah, 10h
  mov al, 01h
  mov bh, Color
  int 10h
End;

     ᫥.    ⥭  ଠ  16-  梥⮢  ࠭  
६ ( ⠭ 㯭묨  祭  GRAPH):

 梥:

EGABlack     0
EGABlue      1
EGAGreen     2
EGACyan      3
EGARed       4
EGAMagenta   5
EGABrown     20
EGALightgray 7

 梥:

EGADarkgray     56
EGALightblue    57
EGALightgreen   58
EGALightcyan    59
EGALightred     60
EGALightmagenta 61
EGAYellow       62
EGAWhite        63
