[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]

    {
    Here is a version of a bitmap scaler. It is rather old and isn't very
    optimized. Please do not send improvements to me, as I don't want them.
    The unit IMAGE is included in the next message.

    }
    Program ScaleImage;
    { A bitmap scaler }
    { Alex Chalfin    achalfin@uceng.uc.edu }
    { About 1 1/2 years old. It works and its pretty fast }
    { Sorry about the Pascal only, bungled, uncommented code }

    Uses Crt,Image;
    Var
      Pic, Bit : Pointer;
      X, y, z, A1, A12 : Integer;

    Procedure Scale(Factor : Real; Var Image, Scaled : Pointer);

    Var
      NewLength, NewWidth, Segment, Offset, ScaleSeg, ScaleOfs : Word;
      ScaleSize, Count3, Count2, Count, Orig, Orig2, TallStep, SideStep : Word;
      Msb, Lsb, TallLeft, SideLeft, TallSkip, SideSkip : Byte;

    Begin
      Segment := Seg(Image^); Offset := Ofs(Image^);
      Msb := Mem[Segment:Offset + 2]; Lsb := Mem[SegMent:Offset + 3];
      Orig2 := (Msb ShL 8) + Lsb;
      ScaleSize := Trunc((Factor * Factor) * ((MsB ShL 8) + LsB));
      GetMem(Scaled, (ScaleSize) + 4);
      ScaleSeg := Seg(Scaled^); ScaleOfs := Ofs(Scaled^);
      Msb := Mem[Segment:Offset]; Lsb := Mem[Segment:Offset + 1];
      Orig := ((Msb ShL 8) + LsB);
      NewWidth := Trunc(Factor * Orig);
      NewLength := Trunc(Factor * (Orig2 div Orig));
      A1 := newwidth; A12 := newlength;
      TallStep := Trunc(NewLength / (Orig2 div Orig));
      SideStep := NewWidth Div Orig; TallLeft := NewLength Mod TallStep;
      SideLeft := NewWidth Mod SideStep;
      Mem[ScaleSeg:ScaleOfs] := NewWidth Shr 8;
      Mem[ScaleSeg:ScaleOfs + 1] := NewWidth and 255;
      Mem[ScaleSeg:ScaleOfs + 2] := (NewLength * NewWidth + 4) Shr 8;
      Mem[ScaleSeg:ScaleOfs + 3] := (NewLength * NewWidth + 4) and 255;
      ScaleOfs := ScaleOfs + 4;
      Offset := Offset + 4;
      If TallLeft > 0
        Then TallSkip := TallSkip + 1;
      If SideLeft > 0
        Then SideSkip := SideSkip + 1;
      For Count := 1 to (Orig2 Div Orig) do
        Begin
          For Count2 := 1 to Orig do
            Begin
              FillChar(Mem[ScaleSeg:ScaleOfs], SideStep, Mem[Segment:Offset]);
              ScaleOfs := ScaleOfs + SideStep;
              Offset := Offset + 1;
            End;
          For Count3 := 1 to (TallStep - 1) do
            Begin
              Move(Mem[ScaleSeg:ScaleOfs - NewWidth], Mem[ScaleSeg:ScaleOfs], NewWi
              ScaleOfs := ScaleOfs + NewWidth;
            End;
       End;
    End;

    Begin
      Asm
        mov  ax,13h
        int  10h
      End;
      For X := 0 to 199 do
        FillChar(Mem[$A000:X*320], 320, X);
      z := ImageSize(1, 1, 10, 10);
      Getmem(Pic, z);
      Getimage(1, 1, 10, 10, Pic^);
      for z := 1 to 15 do
        begin
          Scale(z, Pic, Bit);
          Putimage((320 div 2) - (A1 div 2), (200 div 2) - (A12 div 2), Bit^);
        {  Delay(200);}
        end;
      Readln;
      Asm
        mov  ax,3
        int  10h
      End;
    End.

    {
    Here is the IMAGE unit required for the bitmap scaler.
    Again, don't send me improvements.
    }

    Unit Image;

    Interface

    Function ImageSize(X1, Y1, X2, Y2 : Word): Word;
    Procedure GetImage(X1, Y1, X2, Y2 : Word; Var BitMap);
    Procedure Putimage(X1, Y1 : Word; Var BitMap);

    Implementation

    Function ImageSize(X1, Y1, X2, Y2 : Word) : Word;

    Begin
      ImageSize := 4 + ((1 + (Y2 - Y1)) * (1 + (X2 - X1)));
    End;

    Procedure GetImage(X1, Y1, X2, Y2 : Word; Var BitMap);

    Var
      BitMapPicSize : Word;  {size of bitmap to be saved}
      Count : Word;          {counting variable}
      TempOfs : Word;        {length of a line in bitmap}
      Offset : Word;         {offset to move move memory to}
      Msb, Lsb : Byte;       {most and least significant bytes of a word}

    Begin
      BitMapPicSize := ImageSize(X1, Y1, X2, Y2);
      OffSet := Ofs(BitMap);
      TempOfs := (X2 - X1) + 1;
      Msb := TempOfs ShR 8;            {\                                 }
      Lsb := TempOfs and 255;          {  \                               }
      MemW[Seg(BitMap):OffSet] := Msb; {   | Save line length in pointer  }
      Offset := OffSet + Sizeof(Msb);  {   |                              }
      MemW[Seg(BitMap):OffSet] := Lsb; {  /                               }
      Offset := OffSet + Sizeof(Msb);  {/                                 }
      Msb := BitMapPicSize ShR 8;      {\                                 }
      Lsb := BitMapPicSize and 255;    {  \                               }
      MemW[Seg(BitMap):OffSet] := Msb; {   | Save imagesize in pointer    }
      Offset := OffSet + Sizeof(Msb);  {   |                              }
      MemW[Seg(BitMap):OffSet] := Lsb; {  /                               }
      OffSet := OffSet + Sizeof(Lsb);  {/                                 }
      For Count := Y1 to Y2 do                     {\                         }
        Begin                                      {  \                       }
          Move(MemW[$A000:X1 + (320 * Count)],    {    \  Save picture info  }
               MemW[Seg(BitMap):Offset], TempOfs); {    /                     }
          OffSet := OffSet + TempOfs;              {  /                       }
        End;                                       {/                         }
    End;

    Procedure Putimage(X1, Y1 : Word; Var BitMap);

    Var
      OffSet : Word;
      BitLength : Word;
      BitSize : Word;
      VGAOffSet : Word;
      Msb : Byte;
      Lsb : Byte;
      BitCount : Word;

    Begin
      VGAOffSet := X1 + (Y1 * 320);
      OffSet := Ofs(BitMap);
      Msb := MemW[Seg(BitMap):Offset];
      Lsb := MemW[Seg(BitMap):Offset + 1];
      BitLength := (Msb ShL 8) + Lsb;
      Msb := MemW[Seg(BitMap):Offset + 2];
      Lsb := MemW[Seg(BitMap):Offset + 3];
      OffSet := OffSet + 4;
      BitSize := (Msb Shl 8) + Lsb;
      BitSize := ((BitSize - 2) div BitLength);
      For BitCount := 1 to BitSize do
        Begin
          Move(MemW[Seg(BitMap):OffSet], MemW[$A000:VGAOffSet], BitLength);
          OffSet := OffSet + BitLength;
          VgaOffSet := VGAOffSet + 320;
        End;
    End;

    End.

[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]