                               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
