Delphi中使用调色板创建渐变色位图

 //创建调色板函数,R,G,B颜色分量,0-1之间取值

 

 1  FUNCTION MaxGradientPalette(CONST RedFactor, GreenFactor, BlueFactor:  Single):  hPalette;
 2    VAR
 3      i             :  INTEGER;
 4      LogicalPalette:  TMaxLogPalette;
 5  BEGIN
 6      ASSERT (RedFactor    <=   1 );    //  values must be  0   to   1
 7      ASSERT (GreenFactor  <=   1 );
 8      ASSERT (BlueFactor   <=   1 );
 9 
10      LogicalPalette.palVersion    : =  PaletteVersion;
11      LogicalPalette.palNumEntries : =   256 ;
12      FOR i : =   0  TO  255  DO
13      BEGIN
14        LogicalPalette.palPalEntry[i].peRed   : =  Round(i  *  RedFactor);
15        LogicalPalette.palPalEntry[i].peGreen : =  Round(i  *  GreenFactor);
16        LogicalPalette.palPalEntry[i].peBlue  : =  Round(i  *  BlueFactor);
17        LogicalPalette.palPalEntry[i].peFlags : =  PC_RESERVED;
18      END;
19      RESULT : =  CreatePalette(pLogPalette(@LogicalPalette)^);
20  END;
21 

 创建使用调色板的位图

 1  procedure   GradientBitmap( var  ShowBitMap:TBitmap;CONST RedFactor, GreenFactor, BlueFactor:  Single);
 2    CONST
 3      BitmapSize  =   256 ;
 4    VAR
 5      i     :  INTEGER;
 6      index :  INTEGER;
 7      j     :  INTEGER;
 8      Row   :  pByteArray;
 9  begin
10       ShowBitMap.PixelFormat : =  pf8bit;
11       ShowBitMap.Height : =  BitmapSize;
12       ShowBitMap.Width  : =  BitmapSize;
13       //   1 .  Create palette first.
14       ShowBitMap.Palette: =  MaxGradientPalette(RedFactor, GreenFactor, BlueFactor);
15 
16       //    2 . Assign Scanline value;
17      FOR  j : =   0  TO BitmapSize - 1  DO
18      BEGIN
19        Row : =   ShowBitMap.Scanline[j];
20        FOR i : =   0  TO BitmapSize - 1  DO
21        BEGIN
22          index : =  (i + j) DIV  2 ;
23          Row[i] : =   index;
24        END
25      END;
26  end ;
27 

 使用调色板位图,显示在Picture上面

 

 1  procedure  TFormPf8bit.Button4Click(Sender: TObject);
 2  var
 3    bitmap1:TBitmap;
 4  begin
 5    bitmap1: = TBitmap.Create;
 6    GradientBitmap( bitmap1, 0.5 , 0.2 , 1.0 );
 7    ImageShow.Picture.Graphic: = bitmap1;
 8    bitmap1.Free;
 9  end ;
10 

 

转载于:https://www.cnblogs.com/sun_catboy/archive/2008/10/06/1304951.html