線上訂房服務-台灣趴趴狗聯合訂房中心
發文 回覆 瀏覽次數:1573
推到 Plurk!
推到 Facebook!

TMS WebImage控件修正支持PNG

缺席
pcernet
初階會員


發表:68
回覆:113
積分:41
註冊:2002-11-29

發送簡訊給我
#1 引用回覆 回覆 發表時間:2008-10-28 10:54:17 IP:61.218.xxx.xxx 未訂閱
Delphi2009已納入TPNGImage,但我用的是Delphi2007,另外安裝TPNGImage,
使用TMS的TWebImage顯示網路上的圖片時,發現沒有支援PNG,原始程式如下

即使 uses pngimage 也無法解決,謝謝。

(p.s:網頁中加入code delphi的部分,程式後面不能再有其他文字,否則會被合併到程式裡,所以我才會再修改貼文)

[code delphi]
procedure TWebPicture.LoadPicture;
const
IID_IPicture: TGUID = (
D1:$7BF80980;D2:$BF32;D3:$101A;D4:($8B,$BB,$00,$AA,$00,$30,$0C,$AB));

var
hGlobal: THandle;
pvData: Pointer;
pstm: IStream;
hr: HResult;
gifstream: TMemoryStream;
i: Integer;
b,c,d,e: byte;
skipimg: Boolean;
imgidx: Integer;
begin
hGlobal := GlobalAlloc(GMEM_MOVEABLE, fDataStream.Size);
if (hGlobal = 0) then raise Exception.Create('Could not allocate memory for image');

try
pvData := GlobalLock(hGlobal);
FDataStream.Position := 0;

FFrameXPos := 0;
FFrameYPos := 0;
FAnimMaxX := 0;
FAnimMaxY := 0;

{skip first image ctrl}
if IsGIF and (FrameCount>0) then
begin
//manipulate the stream here for animated GIF ?
Gifstream := TMemoryStream.Create;
imgidx := 1;
skipimg := False;

FDataStream.Position := 6;
FDataStream.Read(FAnimMaxX,2);
FDataStream.Read(FAnimMaxY,2);

for i := 1 to FDataStream.Size do
begin
FDataStream.Position := i - 1;
FDataStream.Read(b,1);


if (b = $21) and (i 8 < FDataStream.Size) then
begin
FDataStream.Read(c,1);
FDataStream.Read(d,1);
FDataStream.Position := FDataStream.Position 5;
FDataStream.Read(e,1);
if (c=$F9) and (d=$4) and (e=$2C) then
begin
if imgidx = FFrame then
begin
FDataStream.Read(FFrameXPos,2);
FDataStream.Read(FFrameYPos,2);
FDataStream.Read(FFrameXSize,2);
FDataStream.Read(FFrameYSize,2);
end;
inc(imgidx);
if imgidx <= FFrame then
skipimg := True
else
skipimg := False;
end;
end;
if not skipimg then GifStream.write(b,1);
end;
GifStream.Position:=0;
GifStream.ReadBuffer(pvData^,GifStream.Size);
GifStream.Free;
end
else
FDataStream.ReadBuffer(pvData^,FDataStream.Size);
GlobalUnlock(hGlobal);
pstm := nil;
// Create IStream* from global memory
hr := CreateStreamOnHGlobal(hGlobal, TRUE, pstm);
if (not hr=S_OK) then
raise Exception.Create('Could not create image stream')
else
if (pstm = nil) then
raise Exception.Create('Empty image stream created');
// Create IPicture from image file
hr := OleLoadPicture(pstm,
fDataStream.Size,
FALSE,
IID_IPicture,
gpPicture);
if not (hr=S_OK) then
raise Exception.Create('沒有支援這種格式的圖檔')
else
if (gpPicture = nil) then
raise Exception.Create('Could not load image');
finally
GlobalFree (hGlobal);
end;
end;
[/code]
編輯記錄
pcernet 重新編輯於 2008-10-28 10:55:22, 註解 無‧
pcernet 重新編輯於 2008-10-28 10:58:46, 註解 無‧
axsoft
版主


發表:681
回覆:1056
積分:969
註冊:2002-03-13

發送簡訊給我
#2 引用回覆 回覆 發表時間:2008-11-03 14:20:12 IP:61.219.xxx.xxx 訂閱
系統時間:2017-10-17 10:06:57
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!