BesaJLS , Lossless JPEG Codec.
What is BesaJLS?
BesaJLS is a Lossless JPEG Codec. Written in full Pascal. Compile and Use with Delphi or FreePascal . You can run with Windows, Linux, Wince,Raspberry...
Usage areas of JPEG-LS
The strongest point of JPEG-LS is that you can compress images lossless, with a high compression ratio. JPEG-LS allows for compression ratios that are similar to JPEG 2000, which means that compression can go up to 1:4 for natural images, and better than 1:10 for synthetic images. This is done with a relatively simple thus fast algorithm. This makes it appropriate if you have a huge amount of images to deal with, you need the highest possible lossless compression, and apriciate high performance. This could be the case if you work with medical images ('1.2.840.10008.1.2.4.80 JPEG-LS Lossless Image Compression','1.2.840.10008.1.2.4.81 JPEG-LS Lossy (Near-Lossless) Image Compression') , sattelite images, raw images from digital cameras, or for remote desktop applications. A modified version of JPEG-LS has been used to send images from the mars rovers down to earth!
Download Trial (Delphi7 - Delphi 10.2 for 32 Bit) !
Download Executable Demo !
How to use ?
Parameter types
/// Defines the JPEG-LS preset coding parameters as defined in ISO/IEC 14495-1, C.2.4.1.1.
/// JPEG-LS defines a default set of parameters, but custom parameters can be used.
/// When used these parameters are written into the encoded bit stream as they are needed for the decoding process.
TbsJlsCustomParameters = packed record
/// Maximum possible value for any image sample in a scan.
/// This must be greater than or equal to the actual maximum value for the components in a scan.
MAXVAL:integer;
/// First quantization threshold value for the local gradients.
T1:integer;
/// Second quantization threshold value for the local gradients.
T2:integer;
/// Third quantization threshold value for the local gradients.
T3:integer;
/// Value at which the counters A, B, and N are halved.
RESET:integer;
end;
PBSJlsParameters = ^TbsJlsParameters;
TbsJlsParameters = packed record
/// Width of the image in pixels.
Width: integer;
/// Height of the image in pixels.
Height: integer;
/// The number of valid bits per sample to encode.
/// Valid range 2 - 16. When greater than 8, pixels are assumed to stored as two bytes per sample, otherwise one byte per sample is assumed.
BitsPerSample: integer;
/// The number of components.
/// Typical 1 for monochrome images and 3 for color images.
Components: integer;
/// Defines the allowed lossy error. Value 0 defines lossless.
AllowedLossyError:integer;
/// Defines the interleave mode for multi-component (color) pixel data.
/// PLANE_INT = 0;
/// LINE_INT = 1;
/// PIXEL_INT = 2;
InterleavedMode:Integer;
Custom: TbsJlsCustomParameters;
end;
Decoding a JLS File
function DecodeFileToBitmap(FileName: String):TBitmap;
var
LInput,LOutput:TMemorystream;
info:TbsJlsParameters;
ABitmap:TBitmap;
begin
LInput:=TMemorystream.Create;
LOutput:=TMemorystream.Create;
fillchar(info, SizeOf(info), 0);
try
LInput.LoadFromFile(Filename);
if jpegls_decompress(LInput, LOutput, @info) then
begin
ABitmap:=RawToBitmap(LOutput,info);
Result:=ABitmap;
end;
finally
LInput.Free;
LOutput.Free;
end;
end;
//Load JLS...
procedure TForm1.btnOpenClick(Sender: TObject);
var
ABitmap:TBitmap;
begin
if dlgOpen1.Execute() then
begin
ABitmap:=DecodeFileToBitmap(dlgOpen1.FileName);
img1.Picture.Assign(ABitmap);
ABitmap.Free;
end;
end;
Encoding as a JLS File
procedure EncodeBitmapToFile(FileName: String; Bitmap: TBitmap);
var
LInput,LOutput:TMemorystream;
info:TbsJlsParameters;
begin
LInput:=TMemorystream.Create;
LOutput:=TMemorystream.Create;
fillchar(info, SizeOf(info), 0);
try
BitmapToRaw(Bitmap,LInput);
info.Width:=Bitmap.Width;
info.Height:=Bitmap.Height;
info.Components:=BytesPerPixel(Bitmap.PixelFormat);
info.BitsPerSample:=BytesPerPixel(Bitmap.PixelFormat)*8;
if jpegls_compress(LInput, LOutput, @info) then
begin
LOutput.SaveToFile(FileName);
end;
finally
LInput.Free;
LOutput.Free;
end;
end;
//Save JLS...
procedure TForm1.btnSaveClick(Sender: TObject);
var
Bitmap:TBitmap;
begin
if dlgSave1.Execute() then
begin
Bitmap:=TBitmap.Create;
Bitmap.HandleType := bmDIB;
Bitmap.Assign(img1.Picture.Graphic);
EncodeBitmapToFile(dlgSave1.FileName,Bitmap);
Bitmap.Free;
end;
end;
Buy Standart Edition - $149 (Delphi7 - Delphi 10.2 for 32 Bit)
Buy Professional Edition (Full Source)- $599