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;BmpFileNamechar):Boolean;
var
hf :HFILE;
lpImgData :^BITMAPINFOHEADER;
pPal :^LOGPALETTE;
// pPal :^TMaxLogPalette ;
lpRGB :^RGBQUAD;
Bits: Pointer;
hPrevPalette : HPALETTE;
hDc1, hMemDC : HDC;
hPal :HLOCAL;
LineBytes WORD;
ImgSize WORD;
NumColors WORD;
i WORD;
temp1 WORD;
temp2 WORD;
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.
可又看不出来,请各位帮我看看。现贴源程序如下:
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;BmpFileNamechar):Boolean;
var
hf :HFILE;
lpImgData :^BITMAPINFOHEADER;
pPal :^LOGPALETTE;
// pPal :^TMaxLogPalette ;
lpRGB :^RGBQUAD;
Bits: Pointer;
hPrevPalette : HPALETTE;
hDc1, hMemDC : HDC;
hPal :HLOCAL;
LineBytes WORD;
ImgSize WORD;
NumColors WORD;
i WORD;
temp1 WORD;
temp2 WORD;
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.