请问我用image加载后缀为jif的图片为什么不行?是不是要下载新的控件?
解决方案 »
- TListView的问题
- 对webBrowser返回状态的问题
- 很久没有散分了,散分
- 問兩個cxgrid的問題?
- 如何将 字符串"TFrom" 转换成类 TForm,在线等
- 请问哪里有“浏览目录对话狂“控件下啊?
- delphi程序员们我终于快有女朋友了快来看看秘方!!!
- 怎么把FLASH动画加到res文件里去,原来已经有一个res文件了
- delphi 打开*.pas时根据什么找Frm文件的
- delphi高手做得一个软件,大家参考参考吧。(delphi5.0)http://www.csdn.net/soft/openfile.asp?kind=1&id=14192
- 找不到控件了,告诉我吧。
- delphi新手来报到~~~
如果是静态的,用下面的代码也可以!
TGIFGraphic = class(TBitmap)
public
procedure LoadFromStream(Stream: TStream); override;
end;
const
GIF_GLOBALCOLORTABLE = $80;
GIF_COLORRESOLUTION = $70;
GIF_GLOBALCOLORTABLESORTED = $08;
GIF_COLORTABLESIZE = $07;
GIF_LOCALCOLORTABLE = $80;
GIF_INTERLACED = $40;
GIF_LOCALCOLORTABLESORTED= $20;
GIF_PLAINTEXT = $01;
GIF_GRAPHICCONTROLEXTENSION = $F9;
GIF_COMMENTEXTENSION = $FE;
GIF_APPLICATIONEXTENSION = $FF;
GIF_IMAGEDESCRIPTOR = Ord(',');
GIF_EXTENSIONINTRODUCER = Ord('!');
GIF_TRAILER = Ord(';');
type
TGIFHeader = packed record
Signature: array[0..2] of Char;
Version: array[0..2] of Char;
end; TLogicalScreenDescriptor = packed record
ScreenWidth: Word;
ScreenHeight: Word;
PackedFields,
BackgroundColorIndex,
AspectRatio: Byte;
end;
TImageDescriptor = packed record
Left: Word;
Top: Word;
Width: Word;
Height: Word;
PackedFields: Byte;
end;
procedure TGIFGraphic.LoadFromStream(Stream: TStream);
var
Header: TGIFHeader;
ScreenDescriptor: TLogicalScreenDescriptor;
ImageDescriptor: TImageDescriptor;
LogPalette: TMaxLogPalette;
I: Integer;
BlockID: Byte;
InitCodeSize: Byte;
RawData,
Run: PByte;
TargetBuffer,
TargetRun,
Line: Pointer;
Pass,
Increment,
Marker: Integer;
Decoder: TDecoder;
begin
Handle := 0;
PixelFormat := pf8Bit;
with Stream do
begin
ReadBuffer(Header, SizeOf(Header));
if UpperCase(Header.Signature) <> 'GIF' then raise Exception.Create('Not a valid GIF file.');
ReadBuffer(ScreenDescriptor, SizeOf(ScreenDescriptor));
FillChar(LogPalette, SizeOf(LogPalette), 0);
LogPalette.palVersion := $300;
if (ScreenDescriptor.PackedFields and GIF_GLOBALCOLORTABLE) <> 0 then
begin
LogPalette.palNumEntries := 2 shl (ScreenDescriptor.PackedFields and GIF_COLORTABLESIZE);
for I := 0 to LogPalette.palNumEntries - 1 do
begin
ReadBuffer(LogPalette.palPalEntry[I].peRed, 1);
ReadBuffer(LogPalette.palPalEntry[I].peGreen, 1);
ReadBuffer(LogPalette.palPalEntry[I].peBlue, 1);
end;
Palette := CreatePalette(PLogPalette(@LogPalette)^);
end;
repeat
ReadBuffer(BlockID, 1);
if BlockID = GIF_EXTENSIONINTRODUCER then
begin
repeat
ReadBuffer(BlockID, 1);
until BlockID = 0;
end;
until (BlockID = GIF_IMAGEDESCRIPTOR) or (BlockID = GIF_TRAILER);
if BlockID = GIF_IMAGEDESCRIPTOR then
begin
ReadBuffer(ImageDescriptor, SizeOf(TImageDescriptor));
Width := ImageDescriptor.Width;
if Width = 0 then Width := ScreenDescriptor.ScreenWidth;
Height := ImageDescriptor.Height;
if Height = 0 then Height := ScreenDescriptor.ScreenHeight;
if (ImageDescriptor.PackedFields and GIF_LOCALCOLORTABLE) <> 0 then
begin
LogPalette.palNumEntries := 2 shl (ImageDescriptor.PackedFields and GIF_COLORTABLESIZE);
for I := 0 to LogPalette.palNumEntries - 1 do
begin
ReadBuffer(LogPalette.palPalEntry[I].peRed, 1);
ReadBuffer(LogPalette.palPalEntry[I].peGreen, 1);
ReadBuffer(LogPalette.palPalEntry[I].peBlue, 1);
end;
Palette := CreatePalette(PLogPalette(@LogPalette)^);
end;
ReadBuffer(InitCodeSize, 1);
Marker := Position;
Pass := 0;
Increment := 0;
repeat
if Read(Increment, 1) = 0 then Break;
Inc(Pass, Increment);
Seek(Increment, soFromCurrent);
until Increment = 0;
GetMem(RawData, Pass);
GetMem(TargetBuffer, Width * Height);
Position := Marker;
Increment := 0;
Run := RawData;
repeat
if Read(Increment, 1) = 0 then Break;
Read(Run^, Increment);
Inc(Run, Increment);
until Increment = 0;
Decoder := TGIFLZW.Create;
TGIFLZW(Decoder).InitialCodeSize := InitCodeSize;
Run := RawData;
Decoder.Decode(Pointer(Run), TargetBuffer, Pass, Width * Height);
Decoder.Free;
if (ImageDescriptor.PackedFields and GIF_INTERLACED) = 0 then
begin
TargetRun := TargetBuffer;
for I := 0 to Height - 1 do
begin
Line := Scanline[I];
Move(TargetRun^, Line^, Width);
Inc(PByte(TargetRun), Width);
end;
end
else
begin
TargetRun := TargetBuffer;
for Pass := 0 to 3 do
begin
case Pass of
0:
begin
I := 0;
Increment := 8;
end;
1:
begin
I := 4;
Increment := 8;
end;
2:
begin
I := 2;
Increment := 4;
end;
else
I := 1;
Increment := 2;
end;
while I < Height do
begin
Line := Scanline[I];
Move(TargetRun^, Line^, Width);
Inc(PByte(TargetRun), Width);
Inc(I, Increment);
end;
end;
end;
FreeMem(TargetBuffer);
FreeMem(RawData);
end;
end;
end;
TPicture.RegisterFileFormat('gif', 'CompuServe images', TGIFGraphic);