|
먼저 Bmp를 jpg로 변환 시키는 프로그램은 쉽게 구할수 있습니다.
ACDSee로도 변환시킬수 있습니다.
그리고 아래는 제가 어디선가 받은 소스인데요.
Bmp를 jpg로 변환시키는것입니다.
어디서 받은 소스인지 기억이 나질않아 출처를 밝히지 못하는점
양해 바랍니다. 그래서 소스를 변함없이 그대로 올립니다.
소스가 좀 많으니까 갈무리 하시는게 좋겠네요.
{ Original Delphi work converted from C++ example in (I think)
"C++ Graphics Programming" by Doug Edwards.
Modified ?? by Yaniv Golan to operate on Delphi streams as well as files.
Modified 6/28/97 to correctly handle bitmaps with widths that do not meet the
requirement (Width mod 4) = 0. (TNH)
(7/2/97) Okay, so the mods didn't quite work right. This one does!?
Caveats:
1. This ONLY converts 256 color bitmaps!
2. The only format supported is GIF87a.
}
unit Bmp2Gif;
interface
uses
SysUtils,
Classes,
Windows,
Graphics;
procedure ConvertBitmapToGifStream(SourceBitmap: TBitmap; DestStream: TStream);
procedure ConvertBitmapToGifFile(SourceBitmap: TBitmap; const DestFilename: string);
implementation
const
BlockTerminator:byte = 0;
FileTrailer:byte = $3B;
gifBGColor:byte = 0;
gifPixAsp:byte = 0;
gifcolordepth:byte = 8; // 8 bit = 256 colors
gifncolors:integer = 256;
gifLIDid:byte = $2C;
HASHSIZE:integer = 5101;
HASHBITS:integer = 4;
TABLSIZE:integer = 4096;
EMPTY:integer = -1;
procedure ConvertBitmapToGifStream(SourceBitmap: TBitmap; DestStream: TStream);
var
MapBM : TBitmap;
ImageWidth,ImageHeight:Integer;
buffer : array[0..255] of byte;
codes : array[0..5101] of Integer;
prefix: array[0..5101] of Integer;
suffix: array[0..5101] of Integer;
nBytes,nbits, size,cursize, curcode, maxcode : Integer;
Started : Boolean;
minsize,maxsize,nroots,Capacity : Integer;
endc, clrc : Integer;
MinLZWCodeSize : Byte;
bytecode,bytemask :Integer;
counter : Integer;
strc,chrc :Integer;
function Putbyte(B:Integer):Boolean;
begin
Counter := counter + 1;
buffer[nbytes] := B;
Inc(nbytes);
If nbytes = 255 then
begin
DestStream.WriteBuffer(nbytes, 1);
DestStream.WriteBuffer(buffer, nbytes);
nbytes := 0;
end;
result := True;
end;
function PutCode(code:Integer) : Boolean;
var
n,mask :Integer;
begin
mask := 1;
n := nbits;
//If nbits > 11 then ShowMessage('nbits = 12');
while n > 0 do
begin
dec(n);
if ((code and mask)<>0) then bytecode := (bytecode or bytemask);
bytemask := bytemask shl 1;
if (bytemask > $80) then
begin
If PutByte(bytecode) then
begin
bytecode := 0;
bytemask := 1;
end;
end;
mask := mask shl 1;
end;
result := True;
end;
procedure Flush;
begin
if bytemask <> 1 then
begin
PutByte(byteCode);
bytecode :=0;
bytemask :=1;
end;
if nbytes > 0 then
begin
DestStream.WriteBuffer(nbytes, 1);
DestStream.WriteBuffer(buffer, nbytes);
nbytes :=0;
end;
end;
procedure ClearX;
var
J : Integer;
begin
cursize := minsize;
nbits := cursize;
curcode := endc + 1;
maxcode := 1 shl cursize;
for J := 0 to HASHSIZE do codes[J] := EMPTY;
end;
function findstr(pfx,sfx :Integer):integer;
var
i,di : Integer;
begin
i := (sfx shl HASHBITS) xor pfx;
if i = 0 then di := 1 else di := Capacity -i;
while True do
begin
if codes[i] = EMPTY then break;
if ((prefix[i] = pfx) and (suffix[i] = sfx)) then break;
i := i - di;
if i < 0 then i := i + Capacity;
end;
Result := i;
end;
procedure EncodeScanLine(var buf : Pbyte; npxls : Integer);
var
np,I : Integer;
begin
np := 0;
if not Started then
begin
strc := buf^;
Inc(np); Inc(buf);
Started := True;
end;
while np < npxls do
begin
// If np = 3 then break;
chrc := buf^;
Inc(np); Inc(buf);
I := findstr(strc,chrc);
if codes[I] <> EMPTY then
strc := codes[I]
else
begin
codes[I] := curcode;
prefix[I] := strc;
suffix[I] := chrc;
putcode(strc);
strc := chrc;
Inc(curcode);
if curcode > maxcode then
begin
Inc(cursize);
if cursize > maxsize then
begin
putcode(clrc);
ClearX;
end
else
begin
nbits := cursize;
maxcode := maxcode shl 1;
if cursize = maxsize then dec(maxcode);
end;
end;
end;
end;
end;
procedure Initialize;
var
flags : Byte;
begin
counter := 0;
Started := False;
size := 8;
nbytes := 0;
nbits := 8;
bytecode := 0;
bytemask := 1;
Capacity := HASHSIZE;
minsize := 9;
maxsize := 12;
nroots := 1 shl 8;
clrc := nroots;
endc := clrc + 1;
MinLZWCodeSize := 8;
ClearX;
// Write the type
DestStream.WriteBuffer(pchar('GIF87a')^,6);
// Write the GIF screen descriptor
// Note: width > 255 is a two byte word!!
DestStream.WriteBuffer(ImageWidth,2);
DestStream.WriteBuffer(ImageHeight,2);
flags := $80 or ((gifcolordepth-1)shl 4) or (gifcolordepth-1);
DestStream.WriteBuffer(flags,1);
DestStream.WriteBuffer(gifBGColor,1);
DestStream.WriteBuffer(gifPixAsp,1);
end;
procedure WriteGif;
var
gifxLeft,gifyTop : word; //Must be 16 bit!!
flags :Byte;
K : Pointer;
IW : word;
Test,J,M : Integer;
PBits, AscanLine, TempscanLine, Bits : PByte;
begin
Bits := nil;
Tempscanline := nil;
//Get the info from the Bitmap
GetMem(K,(sizeof(TBitMapInfoHeader) + 4 * gifncolors));
TBitmapInfo(K^).bmiHeader.biSize := sizeof(TBitMapInfoHeader);
TBitmapInfo(K^).bmiHeader.biWidth := ImageWidth;
TBitmapInfo(K^).bmiHeader.biHeight := ImageHeight;
TBitmapInfo(K^).bmiHeader.biPlanes := 1;
TBitmapInfo(K^).bmiHeader.biBitCount := 8;
TBitmapInfo(K^).bmiHeader.biCompression := BI_RGB;
TBitmapInfo(K^).bmiHeader.biSizeImage :=
((((TBitmapInfo(K^).bmiHeader.biWidth * TBitmapInfo(K^).bmiHeader.biBitCount)+31)
and Not(31)) shr 3)*TBitmapInfo(K^).bmiHeader.biHeight;
TBitmapInfo(K^).bmiHeader.biXPelsPerMeter := 0;
TBitmapInfo(K^).bmiHeader.biYPelsPerMeter := 0;
TBitmapInfo(K^).bmiHeader.biClrUsed := 0;
TBitmapInfo(K^).bmiHeader.biClrImportant := 0;
try
GetMem(Bits,TBitmapInfo(K^).bmiHeader.biSizeImage);
Test := GetDIBits(MapBM.Canvas.Handle,MapBM.Handle,0,ImageHeight,Bits,TBitmapInfo(K^),DIB_RGB_COLORS);
If Test > 0 then
begin
for J := 0 to 255 do
begin
DestStream.WriteBuffer(TBitMapInfo(K^).bmiColors[J].rgbRed,1);
DestStream.WriteBuffer(TBitMapInfo(K^).bmiColors[J].rgbGreen,1);
DestStream.WriteBuffer(TBitMapInfo(K^).bmiColors[J].rgbBlue,1);
end;
//Write the Logical Image Descriptor
DestStream.WriteBuffer(gifLIDid,1);
gifxLeft := 0; DestStream.WriteBuffer(gifxLeft,2); // Write X position of image
gifyTop := 0; DestStream.WriteBuffer(gifyTop,2); // Write Y position of image
DestStream.WriteBuffer(ImageWidth,2);
DestStream.WriteBuffer(ImageHeight,2);
flags := 0; DestStream.WriteBuffer(flags,1); //Write Local flags 0=None
//Write Min LZW code size = 8 (for 8 bit)
MinLZWCodeSize := 8;
DestStream.WriteBuffer(MinLZWCodesize,1);
PutCode(clrc);
PBits := Bits;
// (6/27/97) TNH
// Adjust actual number of bytes pulled from bitmap image to be
// a multiple of 4 bytes. But still use only ImageWidth bytes
// for scanline encoding!
// (7/2/97) TNH
// Oops. Forgot to consider the case of an image being
// a multiple of 4 to begin with.
if ImageWidth mod 4 <> 0 then
IW := ImageWidth + (4 - (ImageWidth mod 4))
else
IW := ImageWidth;
Inc(Pbits,((IW) * (ImageHeight - 1)));
GetMem(AscanLine,IW);
TempscanLine := AscanLine;
For M := 0 to ImageHeight - 1 do
begin
FillChar(AscanLine^,IW,0);
move(PBits^,AscanLine^,ImageWidth);
EncodeScanLine(AscanLine,ImageWidth);
AScanLine := TempScanLine;
dec(PBits,IW);
end;
end;
finally
AscanLine := TempscanLine;
FreeMem(AscanLine,IW);
FreeMem(Bits,TBitMapInfo(K^).bmiHeader.biSizeImage);
FreeMem(K,(sizeof(TBitMapInfoHeader) + 4 * gifncolors));
end;
end;
begin
MapBM := SourceBitmap;
ImageWidth := MapBM.Width;
ImageHeight := MapBM.Height;
Initialize;
WriteGif;
PutCode(strc);
PutCode(endc);
Flush;
DestStream.WriteBuffer(BlockTerminator,1);
DestStream.WriteBuffer(FileTrailer,1);
end;
procedure ConvertBitmapToGifFile(SourceBitmap: TBitmap; const DestFilename: string);
var
F: TFileStream;
begin
F := TFileStream.Create(DestFilename, fmCreate or fmOpenWrite);
try
ConvertBitmapToGifStream(SourceBitmap, F);
finally
F.Free;
end;
end;
end.
|
