这段显示Bitmap的程序错在那。(50分)

  • 主题发起人 主题发起人 lizhao
  • 开始时间 开始时间
L

lizhao

Unregistered / Unconfirmed
GUEST, unregistred user!
我这个程序用来显示不同位数的位图,除了真彩显示正确外,其余用到调色板的位图(如256色位图)都显示不正确,我怀疑是有关调色板的部分不对,
可又看不出来,请各位帮我看看。现贴源程序如下:
unit main;

{$P+,S-,W-,R-}
{$C PRELOAD}

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus;

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
File1: TMenuItem;
Open1: TMenuItem;
Exit1: TMenuItem;
OpenDialog1: TOpenDialog;
procedure Exit1Click(Sender: TObject);
procedure Open1Click(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormDestroy(Sender: TObject);


private

{ Private declarations }
public
hPalette1:HPALETTE;
hBmp:HBITMAP;
hImgData:HGLOBAL;
bf :BITMAPFILEHEADER;
bi :BITMAPINFOHEADER;
function LoadBmpFile(hWnd:HWND ; BmpFileName: pchar):Boolean;
{ Public declarations }

end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Exit1Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.Open1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
deleteObject(hbmp);
hBmp:=0 ;
deleteObject(hPalette1);
hPalette1:=0;
if hImgData<>0 then
begin
GlobalUnlock(hImgData);
Globalfree(hImgData);
hImgData:=0;
end;
LoadBmpFile(form1.ClientHandle,pchar(OpenDialog1.filename));
refresh;
end;
end;


function TForm1.LoadBmpFile(hWnd:HWND;BmpFileName:Pchar):Boolean;
var
hf :HFILE;
lpImgData :^BITMAPINFOHEADER;
pPal :^LOGPALETTE;
// pPal :^TMaxLogPalette ;
lpRGB :^RGBQUAD;
Bits: Pointer;
hPrevPalette : HPALETTE;
hDc1, hMemDC : HDC;
hPal :HLOCAL;
LineBytes :DWORD;
ImgSize :DWORD;
NumColors :DWORD;
i :DWORD;
temp1 :DWORD;
temp2 :DWORD;

begin
hf:=_lopen(BmpFileName,OF_READ);
if hf=HFILE_ERROR then
begin
windows.MessageBox(hWnd,'File Can not Open','Error Message',
MB_OK+MB_ICONEXCLAMATION);
result := False;
end;
windows._lread(hf,@bf,Sizeof(BITMAPFILEHEADER));
windows._lread(hf,@bi,Sizeof(BITMAPINFOHEADER));
LineBytes:=((bi.biWidth*bi.biBitCount+31)div 32*4);
ImgSize:=LineBytes*bi.biHeight;
if bi.biClrUsed<> 0 then
NumColors:=bi.biClrused
else
begin
Case bi.biBitCount of
1: NumColors:=2;
2: NumColors:=4;
8: NumColors:=256;
24: NumColors:=0;
else
begin
windows.MessageBox(hWnd,'Invalid color Numbers !',
'Error Message',
MB_OK+MB_ICONEXCLAMATION);
_lclose(hf);
Result:= False;
end; //else;
end; //case;
end;
if bf.bfOffBits<>(NumColors*Sizeof(TRGBQUAD)+sizeof(BITMAPFILEHEADER)+
sizeof(BITMAPINFOHEADER)) then
begin
windows.MessageBox(hWnd,'Invalid color numbers!','Error Message',MB_OK+MB_ICONEXCLAMATION);
windows._lclose(hf);
Result:=False;
end;
bf.bfSize:=Sizeof(BITMAPFILEHEADER)+Sizeof(BITMAPINFOHEADER)+
NumColors*Sizeof(RGBQUAD)+ImgSize;

hImgData:=GlobalAlloc(GHND,Sizeof(BITMAPINFOHEADER)+NumColors*Sizeof(RGBQUAD)+ImgSize);
if hImgData=0 then
begin
//分配内存错误
Windows.MessageBox(hWnd,'Error alloc memory!','ErrorMessage',MB_OK+MB_ICONEXCLAMATION);
windows._lclose(hf);
Result:=False;
end;
lpImgData:=(GlobalLock(hImgData));
windows._llseek(hf,Sizeof(BITMAPFILEHEADER),FILE_BEGIN);
windows._lread(hf,lpImgData,sizeof(BITMAPINFOHEADER)+NumColors*Sizeof(RGBQUAD)+ImgSize);
windows._lclose(hf);
if NumColors<>0 then
begin
hPal:=LocalAlloc(LHND,sizeof(LOGPALETTE)+NumColors*sizeof(PALETTEENTRY));
pPal:=LocalLock(hPal);
pPal^.palNumEntries:=NumColors;
pPal^.palVersion:=$300;

lpRGB:=Pointer(LPSTR(lpImgData)+sizeof(BITMAPINFOHEADER));
for i:=0 to NumColors-1 do
begin
pPal^.palPalEntry.peRed:=lpRGB.rgbRed;
pPal^.palPalEntry.peGreen:=lpRGB.rgbGreen;
pPal^.palPalEntry.peBlue:=lpRGB.rgbBlue;
pPal^.palPalEntry.peFlags:=0;
lpRGB:=Pointer(LPSTR(lpRGB)+sizeof(TRGBQUAD));
end;
hPalette1:=CreatePalette(PLogPalette(pPal)^);
LocalUnlock(hPal);
LocalFree(hPal);
end;
hDc1:=GetDC(0);
if hPalette1 <> 0 then
begin
hPrevPalette:=SelectPalette(hDC1,hPalette1,FALSE);
RealizePalette(hDC1);
end;
hBmp:=CreateDIBitmap(hDc1,
PBitmapInfoHeader(lpImgData)^,
LONGWORD(CBM_INIT),
LPSTR(lpImgData)+sizeof(BITMAPINFOHEADER)+NumColors*sizeof(RGBQUAD),
PBitmapInfo(@bi)^,
DIB_RGB_COLORS);

if (hPalette1<>0 )and (hPrevPalette<> 0 ) then
begin
SelectPalette(hDc1,hPrevPalette,FALSE);
RealizePalette(hDc1);
end;

ReleaseDC(0,hDc1);
GlobalUnlock(hImgData);
Result:=True;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
hDc2, hMemDC : Integer;
hPrevPalette :hPalette;
begin
hDC2:=GetDC(form1.WindowHandle);
if hBmp<> 0 then
begin
hMemDC:=CreatecompatibleDC(hDC2);
if hPalette1 <>0 then
begin
hPrevPalette:=SelectPalette(hDC2,hPalette1,False);
SelectPalette(hMemDC,hPalette1,False);
RealizePalette(hDC2);
end;
SelectObject(hMemDC,hBmp);

BitBlt(hDC2,0,0,bi.biWidth,bi.biHeight,hMemDC,0,0,SRCCOPY);
DeleteDC(hMemDC);
end;
if (hPalette1<>0 )and (hPrevPalette<> 0 ) then
begin
SelectPalette(hDc2,hPrevPalette,FALSE);
RealizePalette(hDc2);
end;

ReleaseDC(form1.WindowHandle,hdc2);

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if hBmp<>0 then
DeleteObject(hBmp);

if hPalette1<> 0 then
DeleteObject(hPalette1);

if hImgData<>0 then
begin
GlobalUnlock(hImgData);
GlobalFree(hImgData);
end;
end;

initialization

end.
 
大哥,你太库了,全用API做?!
 
这是从哪个古老的Win3.1C程序移植过来的;)
1、
if hf=HFILE_ERROR then
begin
windows.MessageBox(hWnd,'File Can not Open','Error Message',
MB_OK+MB_ICONEXCLAMATION);
result := False;
……………………
end;
程序不会直接返回的!
2、从流程是看是没问题,能把不正常的现象描述一下吗?(我现在没条件试)
 
有TImage控件为什么不用呢。不然要做这些空间干吗
 
程序中这行有误:
hBmp:=CreateDIBitmap(hDc1,
PBitmapInfoHeader(lpImgData)^,
LONGWORD(CBM_INIT),
LPSTR(lpImgData)+sizeof(BITMAPINFOHEADER)
+NumColors*sizeof(RGBQUAD),
PBitmapInfo(@bi)^,---->不能这样转换
DIB_RGB_COLORS);
在前面bi定义为BITMAPINFOHEADER,CreateDIBitmap中需要传递的是BITMAPINFO*
尽管做了强制转换,但其并没有包含调色版的数据(如果该位图非真彩的话),因此,运行
起来会出现所说的问题.
可以做这样的改动:

前面定义一个PBITMAPINFO的变量lpbmi,

在读文件数据的lpImgData:=(GlobalLock(hImgData));前加入
if lpbmi<> nil then FreeMem(lpbmi);
GetMem(lpbmi,SizeOf(BITMAPINFOHEADER) + NumColors * sizeof(TRGBQuad));
windows._llseek(hf,Sizeof(BITMAPFILEHEADER),FILE_BEGIN);
windows._lread(hf,lpbmi,sizeof(BITMAPINFOHEADER)+NumColors*Sizeof(RGBQUAD));

CreateDIBitmap那行改为:
hBmp:=CreateDIBitmap(hDc1,
PBitmapInfoHeader(lpImgData)^,
LONGWORD(CBM_INIT),
LPSTR(lpImgData)+sizeof(BITMAPINFOHEADER)
+NumColors*sizeof(RGBQUAD),
lpbmi^,--->改动之处
DIB_RGB_COLORS);

对于lpbmi注意下释放的问题,在Create事件中,lpbmi:=nil,
在Destroy事件中,if lpbmi<>nil then FreeMem(lpbmi),
all will be ok
另外,如果要纯粹从API上来显示位图,似乎不需要那么烦琐,可以参考
Delphi中TBitmap是如何实现的.
 
to O_O:
这几天忙着毕业,没时间上网,过几天我再按你说的进行调试。
此外我并不是想仅仅显示bitmap,我的下一步是做各种图象变换。

to lwlnic:
控件也是人做的,我认为不应该只满足于使用控件。
to amo:
这原先是vc4.0编的。
 
to 0_0:
你的答案非常正确,困惑我一两周的问题终于解决了。非常感谢。
我还是不明白为什莫强制转换不对,请再给我讲讲。直接给我发mail
li.zhao@263.net .
分我给你加上,再次感谢。
 
接受答案了.
 
后退
顶部