Компрессия ч/б изображений

[KingBelt]

По-моему здесь несложная задача... В общем имеется прога, выполняет компрессию полутоновых изображений, а необходимо ее упростить только для черно-белых. Не поможете ли, а? ^_^

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ExtDlgs, StdCtrls, JPeG, ExtCtrls, ComCtrls;

type
  TPImage=Record
                bfType:Array[1..2] Of Char;
                bfSize:Integer;
            bfReserved:Integer;
             bfOffBits:Integer;
                biSize:Integer;
               biWidth:Integer;
              biHeight:Integer;
              biPlanes:Word;
            biBitCount:Word;
         biCompression:Integer;
           biSizeImage:Integer;
       biXPelsPerMeter:Integer;
       biYPelsPerMeter:Integer;
             biClrUsed:Integer;
         biClrImpotant:Integer
          End;

  TForm1 = class(TForm)
    OpenPictureDialog1: TOpenPictureDialog;
    Label30: TLabel;
    OpenDialog1: TOpenDialog;
    Edit2: TEdit;
    Image1: TImage;
    Bevel1: TBevel;
    Label3: TLabel;
    Label5: TLabel;
    Label7: TLabel;
    Label9: TLabel;
    Label11: TLabel;
    Label13: TLabel;
    Label15: TLabel;
    Label17: TLabel;
    Label19: TLabel;
    Label21: TLabel;
    Label23: TLabel;
    Label25: TLabel;
    Label27: TLabel;
    Label29: TLabel;
    Label31: TLabel;
    Image2: TImage;
    Bevel2: TBevel;
    Button3: TButton;
    SavePictureDialog1: TSavePictureDialog;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    TrackBar1: TTrackBar;
    Label1: TLabel;
    Label32: TLabel;
    Label33: TLabel;
    N5: TMenuItem;
    N6: TMenuItem;

    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N6Click(Sender: TObject);

private
  Procedure GetColor(x,y:ShortInt);
  Procedure PutColor(x,y:ShortInt);
  Procedure ToCos;
  Procedure CosTo;
  Procedure TKwant;
  Procedure ToKwant;
  Procedure KwantTo;
  Procedure Int24ToInt3_8(Digit:Integer;x,y:ShortInt);
  Function Pow(b:ShortInt):Integer;
  Procedure Code;
  Procedure ToBin(Digit:SmallInt;N:ShortInt);
  Procedure ToBinTo(Digit:SmallInt;N:ShortInt);
  Procedure Custom(Digit:SmallInt);
  Function Bit8(Digit:Int64):Byte;
    { Private declarations }

  public
    { Public declarations }
  end;

var
Form1: TForm1;
Var PImage:TPImage;

        TKW:Array[0..7,0..7] Of Byte;
        TOC:Array[1..3,0..7,0..7] Of Integer;
          T:Array[0..7,0..7] Of Integer;
      clRGB:Array[1..3,0..7,0..7] Of Byte;
          F:File Of ShortInt;
        FDC:File Of Int64;
          X:Array[1..64] Of Byte=(0,0,1,2,1,0,0,1,2,3,4,3,2,1,0,0,1,2,3,4,5,6,5,4,3,2,1,0,0,1,2,3,4,5,6,7,7,6,5,4,3,2,1,2,3,4,5,6,7,7,6,5,4,3,4,5,6,7,7,6,5,6,7,7);
          Y:Array[1..64] Of Byte=(0,1,0,0,1,2,3,2,1,0,0,1,2,3,4,5,4,3,2,1,0,0,1,2,3,4,5,6,7,6,5,4,3,2,1,0,1,2,3,4,5,6,7,7,6,5,4,3,2,3,4,5,6,7,7,6,5,4,5,6,7,7,6,7);

implementation


{$R *.DFM}

//-------------------------------------------------------------

Function TForm1.Bit8(Digit:Int64):Byte;
Var i,k,p:Byte;
Begin
   p:=0;
   For i:=0 To 7 Do Begin
      k:=Digit Mod 2;
      If k=1 Then Inc(p,Pow(i));
      Digit:=Digit Div 2
   End;
   Bit8:=p
End;

//----------------------------------------------------------------

Procedure TForm1.Custom(Digit:SmallInt);
Begin
   Case Digit Of
                 -1,0..1:Begin ToBinTo(2,4); ToBin(Digit,2) End;
             -3..-2,2..3:Begin ToBinTo(3,4); ToBin(Digit,3) End;
             -7..-4,4..7:Begin ToBinTo(4,4); ToBin(Digit,4) End;
           -15..-8,8..15:Begin ToBinTo(5,4); ToBin(Digit,5) End;
         -31..-16,16..31:Begin ToBinTo(6,4); ToBin(Digit,6) End;
         -63..-32,32..63:Begin ToBinTo(7,4); ToBin(Digit,7) End;
       -127..-64,64..127:Begin ToBinTo(8,4); ToBin(Digit,8) End;
     -255..-128,128..255:Begin ToBinTo(9,4); ToBin(Digit,9) End;
     -511..-256,256..511:Begin ToBinTo(10,4); ToBin(Digit,10) End;
   -1024..-512,512..1024:Begin ToBinTo(11,4); ToBin(Digit,11) End
   End
End;
//------------------------------------------------------

Procedure TForm1.ToBinTo(Digit:SmallInt;N:ShortInt);
Var i,k:ShortInt;
Begin
   For i:=1 To N Do Begin
      k:=Digit Mod 2;
      Write(F,k);
      Digit:=Digit Div 2
   End
End;

//-----------------------------------------------------

Procedure TForm1.ToBin(Digit:SmallInt;N:ShortInt);
Var i,k:ShortInt;
Begin
   For i:=1 To N-1 Do Begin
     k:=Digit Mod 2;
     Write(F,k);
     Digit:=Digit Div 2
   End;
   i:=1;
   k:=0;
   If Digit<0 Then Write(F,i) Else Write(F,k)
End;

З.ы. весь код модуля не могу выписать(смотреть вложение)

[psycho-coder]

В общем имеется прога, выполняет компрессию полутоновых изображений, а необходимо ее упростить только для черно-белых

А черно-белые изображения эта прога наотрез отказывается сжимать чтоли?

[KingBelt]

Сообщение от psycho-coder

А черно-белые изображения эта прога наотрез отказывается сжимать чтоли?

сжимает, но я же написал, что прогу упростить надо

[psycho-coder]

Блин, ковырять придется >_< будет время гляну

[x128]

1) В программе используется стандартный модуль JPEG и вся остальная писанина не используется.
2) JPEG для сжатия ч/б (1 bpp) изображений не подходит, даже BMP будет предпочтительней по размеру и качество не пострадает.

[KingBelt]

в общем я так понимаю, что jpeg используется для полутоновых и цветных изображений, а мне надо применить простейший метод RLE для монохромных изображений.. кто-нибудь может помочь привязять к проге данный метод?