delphi 把pf8bit位图变换成pf24bit位图


unit ScreenGetPaletteEntries;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, ExtCtrls;

type
 TForm1 = class(TForm)
 Image1: TImage;
 ButtonReadpf8bit: TButton;
 Memo1: TMemo;
 Image2: TImage;
 procedure ButtonReadpf8bitClick(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;

var
 Form1: TForm1;

implementation
{$R *.DFM}

CONST
 MaxPixelCount = 65536;

TYPE
 TRGBArray = ARRAY[0..MaxPixelCount-1] OF TRGBTriple;
 pRGBArray = ^TRGBArray;

procedure TForm1.ButtonReadpf8bitClick(Sender: TObject);
 VAR
 i  :  CARDINAL;
 index  :  BYTE;
 j  :  CARDINAL;
 LogicalPalette  :  TMaxLogPalette;
 PaletteEntryCount:  CARDINAL;
 Bitmap8  :  TBitmap;
 Bitmap24  :  TBitmap;
 Row8  :  pByteArray;
 Row24  :  pRGBArray;
begin
 Bitmap8 := TBitmap.Create;
 TRY
 Bitmap8.LoadFromFile('Deer.BMP');

 // Show pf8bit Bitmap
 Image1.Picture.Graphic := Bitmap8;

 IF  Bitmap8.PixelFormat <> pf8bit
 THEN ShowMessage('Expecting 8-bits/pixel BMP');

 IF  Bitmap8.Palette = 0
 THEN ShowMessage ('No Palette with BMP')
 ELSE BEGIN
 PaletteEntryCount := GetPaletteEntries(Bitmap8.Palette, 0, 255,
 LogicalPalette.palPalEntry);
 FOR i := 0 TO PaletteEntryCount-1 DO
 BEGIN
 Memo1.Lines.Add(Format('%3.3d %3.3d %3.3d %3.3d %d',
 [i, LogicalPalette.palPalEntry[i].peRed,
 LogicalPalette.palPalEntry[i].peGreen,
 LogicalPalette.palPalEntry[i].peBlue,
 LogicalPalette.palPalEntry[i].peFlags]))
 END;

 Bitmap24 := TBitmap.Create;
 TRY
 Bitmap24.Width  := Bitmap8.Width;
 Bitmap24.Height := Bitmap8.Height;
 Bitmap24.PixelFormat := pf24bit;

 FOR j := 0 TO Bitmap8.Height-1 DO
 BEGIN
 Row8  := Bitmap8.Scanline[j];
 Row24 := Bitmap24.Scanline[j];

 FOR i := 0 TO Bitmap8.Width-1 DO
 BEGIN
 index := Row8[i];  // index in palette array
 WITH Row24[i] DO
 BEGIN
 rgbtRed  := LogicalPalette.palPalEntry[index].peRed;
 rgbtGreen := LogicalPalette.palPalEntry[index].peGreen;
 rgbtBlue  := LogicalPalette.palPalEntry[index].peBlue
 END
 END

 END;

 // Save to new BMP
 Bitmap24.SaveToFile('Deer24.BMP');

 // Show 24-bit BMP (without a palette now)
 Image2.Picture.Graphic := Bitmap24;
 FINALLY
 Bitmap24.Free
 END

 END
 FINALLY
 Bitmap8.Free
 END
end;

end.


联系电话:
020-00000000
联系电话:
020-00000000
联系电话:
020-12345678