HanDs
管理员

[Delphi文章] 把pf8bit位图变换成pf24bit位图 





学习中请遵循国家相关法律法规,黑客不作恶。没有网络安全就没有国家安全

本站需要登陆后才能查看

// efg, 24 August 1998

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.

 


学习中请遵守法律法规,本网站内容均来自于互联网,本网站不负担法律责任
pf 8b it
#1楼
发帖时间:2016-7-9   |   查看数:0   |   回复数:0
游客组
快速回复