32位图像处理库 delphi简单实现(转贴)

原创 2006年06月14日 10:26:00
unit Image32;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls, ToolWin, ImgList, GraphicEx, Jpeg,
  Buttons, Math, Trace, mmsystem;

const
    PixelCountMax = 32768;
    bias = $00800080;
    // Some predefined color constants

type
  TRGBQuad = packed record
    rgbBlue: BYTE;
    rgbGreen: BYTE;
    rgbRed: BYTE;
    rgbReserved: BYTE;
  end;


  PColor32 = ^TColor32;
  TColor32 = type Cardinal;

  PColor32Array = ^TColor32Array;
  TColor32Array = array [0..0] of TColor32;
  TArrayOfColor32 = array of TColor32;

  pRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = array[0..PixelCountMax - 1] of TRGBQuad;

  PRGBArray = ^TRGBArray;
  {* RGB数组指针}
  TRGBArray = array[0..8192] of tagRGBTriple;
  {* RGB数组类型}




  TGradualStyle = (gsLeftToRight, gsRightToLeft, gsTopToBottom, gsBottomToTop,
    gsCenterToLR, gsCenterToTB);
  {* 渐变方式类型
   |<PRE>
     gsLeftToRight      - 从左向右渐变
     gsRightToLeft      - 从右向左渐变
     gsTopToBottom      - 从上向下渐变
     gsBottomToTop      - 从下向上渐变
     gsCenterToLR       - 从中间向左右渐变
     gsCenterToTB       - 从中间向上下渐变
   |</PRE>}
  TTextureMode = (tmTiled, tmStretched, tmCenter, tmNormal);
  {* 纹理图像显示模式
   |<PRE>
     tmTiled            - 平铺显示
     tmStretched        - 自动缩放显示
     tmCenter           - 在中心位置显示
     tmNormal           - 在左上角显示
   |</PRE>}    


  function RedComponent(Color32: TColor32): Integer;           //取得32位色的红色通道
  function GreenComponent(Color32: TColor32): Integer;         //取得32位色的绿色通道
  function BlueComponent(Color32: TColor32): Integer;          //取得32位色的蓝色通道
  function AlphaComponent(Color32: TColor32): Integer;         //取得32位色的ALPHA(透明)通道
  function Intensity(Color32: TColor32): Integer;              //计算灰度
  function RGBA(R, G, B: Byte; A: Byte = $00): TColor32;       //
  function RGBAToColor32(RGBA: TRGBQuad): TColor32;            //
  function Color32ToRGBA(Color32: TColor32): TRGBQuad;         //

  { An analogue of FillChar for 32 bit values }
  procedure FillLongword(var X; Count: Integer; Value: Longword);

const
                     ALPHA(0-255,不透明-透明) Red, Green, Blue
  clBlack32               : TColor32 = $00000000;
  clDimGray32             : TColor32 = $003F3F3F;
  clGray32                : TColor32 = $007F7F7F;
  clLightGray32           : TColor32 = $00BFBFBF;
  clWhite32               : TColor32 = $00FFFFFF;
  clMaroon32              : TColor32 = $007F0000;
  clGreen32               : TColor32 = $00007F00;
  clOlive32               : TColor32 = $007F7F00;
  clNavy32                : TColor32 = $0000007F;
  clPurple32              : TColor32 = $007F007F;
  clTeal32                : TColor32 = $00007F7F;
  clRed32                 : TColor32 = $00FF0000;
  clLime32                : TColor32 = $0000FF00;
  clYellow32              : TColor32 = $00FFFF00;
  clBlue32                : TColor32 = $000000FF;
  clFuchsia32             : TColor32 = $00FF00FF;
  clAqua32                : TColor32 = $0000FFFF;

  // Some semi-transparent color constants
  clTrWhite32             : TColor32 = $7FFFFFFF;
  clTrBlack32             : TColor32 = $7F000000;
  clTrRed32               : TColor32 = $7FFF0000;
  clTrGreen32             : TColor32 = $7F00FF00;
  clTrBlue32              : TColor32 = $7F0000FF;      

type
  TBitmap32 = class(TBitmap)
  private

  protected
  public
    constructor Create; override;                                   //重载,设置为32位 PixelFormat := pf32bit
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;                //重载,设置为32位
    procedure LoadFromFile(const Filename: string); override;       //重载,设置为32位

// 这两个函数引用自FLIB //
// 只处理目标ALPHA通道时,两个函数可以替换到用 //

//  注意这里一下, 替换时请在DrawTo,DrawFrom 里面替换就可以了

// CombinAlphaPixel是以目标及源像素的ALPHA通道合成
    procedure CombineAlphaPixel(var pDest: TRGBQuad; cr1: TRGBQuad; nAlpha1: integer; cr2: TRGBQuad; nAlpha2: integer);
// AlphaBlendPixel是以目标的ALPHA通道合成
    /://
{    把这个函数写到DrawTo函数以替换CombineAlphaPiexl
     
图层的概念
[
最下层是画布(就是一个TBitmap32对像,也可以是Image1.Picture.Bitmap)
跟着上面的就是图层啦,文字层什么的
]


从最下层的32位图像画起
就可以把许多个32位图层到画布上,显示出来


procedure TBitmap32.DrawTo(DstX, DstY: Integer; Tge: TBitmap);
var
    x, y: integer;
    TR, SR: TRect;
    Source, Target: pRGBQuadArray;
begin
    Tge.PixelFormat := pf32bit;
    SetAlphaChannels(Tge, $FF);

    Tr := Rect(0, 0, Tge.Width, Tge.Height);
    SR := Rect(DstX, DstY, DstX + Width, DstY + Height);

    if IntersectRect(Tr, Tr, SR) = false then
    exit;

    for y := Tr.Top to Tr.Bottom - 1 do
    begin
        Target := Tge.ScanLine[y];
        Source := ScanLine[y - Dsty];


        for x := Tr.Left to Tr.Right - 1 do
        begin
//这里替换了
//            CombineAlphaPixel(Target^[x], Target^[x], Target^[x].rgbReserved, Source^[x - DstX], Source^[x- DstX].rgbReserved);
            AlphaBlendPixel(Target^[x], Source^[x - DstX]);
        end;


    end;

end;

for i := 0 to LayerList.Count -1 do
begin
    TBitmap32(LayerList.Items[i ]).DrawTo(0,0, Image1.Picture.Bitmap);
end;
}
    //o//

    procedure AlphaBlendPixel(var pDest: TRGBQuad; pSrc: TRGBQuad);

    function  GetBits: PColor32Array;                      //获得图像的起始地址
    procedure SetPixel(x, y: integer; color: TColor32);    //在x,y座标画点
    function  GetPixel(x, y: integer): TColor32;           //取得x,y座标点的颜色

    function  GetPixelPtr(Left, Top: Integer): PColor32;

    procedure  Clear(color: TColor32);overload;
    procedure  Clear(Bitmap: TBitmap; color: TColor32);overload;
    procedure  Clear;overload;    
    procedure  FillRect(X1, Y1, X2, Y2: Integer; Color: TColor32);


    procedure  SetAlphaChannels(Alpha: BYTE);overload;                              //设置透明通道
    procedure  SetAlphaChannels(Bitmap: TBitmap; Alpha: Byte);overload;
    procedure  SetAlphaChannels(Mask8: TBitmap);overload;

    procedure DrawFrom(DstX, DstY: Integer; Src: TBitmap32);                //把图像写到自身
    procedure DrawTo(DstX, DstY: Integer; Tge: TBitmap32);overload;         //把自身写到图像
    procedure DrawTo(DstX, DstY: Integer; Tge: TBitmap);overload;


    procedure CreateGradual(Style: TGradualStyle; StartColor, EndColor: TColor);
    procedure DrawTiled(Canvas: TCanvas; Rect: TRect; G: TGraphic);
    procedure CreateForeBmp(Mode: TTextureMode; G: TGraphic; BkColor: TColor);

    property PixelPtr[X, Y: Integer]: PColor32 read GetPixelPtr;    

  end;

implementation

procedure FillLongword(var X; Count: Integer; Value: Longword);
asm
// EAX = X
// EDX = Count
// ECX = Value
        PUSH    EDI

        MOV     EDI,EAX  // Point EDI to destination              
        MOV     EAX,ECX
        MOV     ECX,EDX
        TEST    ECX,ECX
        JS      @exit

        REP     STOSD    // Fill count dwords
@exit:
        POP     EDI
end;

function RedComponent(Color32: TColor32): Integer;
begin
  Result := (Color32 and $00FF0000) shr 16;
end;

function GreenComponent(Color32: TColor32): Integer;
begin
  Result := (Color32 and $0000FF00) shr 8;
end;

function BlueComponent(Color32: TColor32): Integer;
begin
  Result := Color32 and $000000FF;
end;

function AlphaComponent(Color32: TColor32): Integer;
begin
  Result := Color32 shr 24;
end;

function Intensity(Color32: TColor32): Integer;
begin
// (R * 61 + G * 174 + B * 21) / 256
  Result := (
    (Color32 and $00FF0000) shr 16 * 61 +
    (Color32 and $0000FF00) shr 8 * 174 +
    (Color32 and $000000FF) * 21
    ) shr 8;
end;

function RGBA(R, G, B: Byte; A: Byte = $00): TColor32;
begin
  Result := A shl 24 + R shl 16 + G shl 8 + B;
end;

function RGBAToColor32(RGBA: TRGBQuad): TColor32;
begin
  Result := RGBA.rgbReserved shl 24 + RGBA.rgbRed shl 16 + RGBA.rgbGreen shl 8 + RGBA.rgbBlue;
end;

function Color32ToRGBA(Color32: TColor32): TRGBQuad;
var
    RGBA: TRGBQuad;
begin
     RGBA.rgbRed := RedComponent(Color32);
     RGBA.rgbRed := GreenComponent(Color32);
     RGBA.rgbRed := BlueComponent(Color32);
     RGBA.rgbRed := AlphaComponent(Color32);
     Result := RGBA;
end;

constructor TBitmap32.Create;
begin
    inherited Create;
    PixelFormat := pf32bit;
end;

destructor TBitmap32.Destroy;
begin
    inherited Destroy;
end;

function TBitmap32.GetPixelPtr(Left, Top: Integer): PColor32;
begin
  Result := @GetBits[Top * Width + Left];
end;

function TBitmap32.GetBits: PColor32Array;
begin
    Result := ScanLine[Height - 1];
end;


procedure TBitmap32.DrawFrom(DstX, DstY: Integer; Src: TBitmap32);
var
    x, y: integer;
    TR, SR: TRect;
    Source, Target: pRGBQuadArray;
begin

    TR := Rect(0, 0, Width, Height);
    SR := Rect(DstX, DstY, DstX + Src.Width, DstY + Src.Height);

    if IntersectRect(TR, TR, SR) = false then
    exit;

    for y := Tr.Top to Tr.Bottom - 1 do
    begin
        Source := Src.ScanLine[y - Dsty];
        Target := ScanLine[y];
        for x := TR.Left to Tr.Right - 1 do
        begin
            CombineAlphaPixel(Target^[x], Target^[x], Target^[x].rgbReserved, Source^[x - DstX], Source^[x- DstX].rgbReserved);
//            AlphaBlendPixel(Target^[x], Source^[x - DstX]);
        end;
    end;
end;

procedure TBitmap32.DrawTo(DstX, DstY: Integer; Tge: TBitmap32);
var
    x, y: integer;
    TR, SR: TRect;
    Source, Target: pRGBQuadArray;
begin

    TR := Rect(0, 0, TGe.Width, Tge.Height);
    SR := Rect(DstX, DstY, DstX + Width, DstY + Height);

    if IntersectRect(TR, TR, SR) = false then
    exit;

    for y := Tr.Top to Tr.Bottom - 1 do
    begin
        Target := Tge.ScanLine[y];
        Source := ScanLine[y - Dsty];
        for x := TR.Left to Tr.Right - 1 do
        begin
            CombineAlphaPixel(Target^[x], Target^[x], Target^[x].rgbReserved, Source^[x - DstX], Source^[x- DstX].rgbReserved);
//            AlphaBlendPixel(Target^[x], Source^[x -DstX]);
        end;
    end;

end;



procedure TBitmap32.DrawTo(DstX, DstY: Integer; Tge: TBitmap);
var
    x, y: integer;
    TR, SR: TRect;
    Source, Target: pRGBQuadArray;
begin
    Tge.PixelFormat := pf32bit;
    SetAlphaChannels(Tge, $FF);

    Tr := Rect(0, 0, Tge.Width, Tge.Height);
    SR := Rect(DstX, DstY, DstX + Width, DstY + Height);

    if IntersectRect(Tr, Tr, SR) = false then
    exit;

    for y := Tr.Top to Tr.Bottom - 1 do
    begin
        Target := Tge.ScanLine[y];
        Source := ScanLine[y - Dsty];


        for x := Tr.Left to Tr.Right - 1 do
        begin
//            CombineAlphaPixel(Target^[x], Target^[x], Target^[x].rgbReserved, Source^[x - DstX], Source^[x- DstX].rgbReserved);
            AlphaBlendPixel(Target^[x], Source^[x-DstX]);
        end;


    end;

end;


procedure  TBitmap32.Clear(color: TColor32);
begin

    FillLongword(GetBits^[0], Width * Height, RGBA(RedComponent(Color), GreenComponent(Color), BlueComponent(Color), 255-AlphaComponent(Color)));
end;


procedure TBitmap32.FillRect(X1, Y1, X2, Y2: Integer; Color: TColor32);
var
  j: Integer;
  P: PColor32Array;
begin
  for j := Y1 to Y2 - 1 do
  begin
    P := Pointer(ScanLine[j]);
    FillLongword(P[X1], X2 - X1, RGBA(RedComponent(Color), GreenComponent(Color), BlueComponent(Color), 255-AlphaComponent(Color)));
  end;
end;

procedure  TBitmap32.Clear(Bitmap: TBitmap; color: TColor32);
var
    bits: PColor32Array;
begin
    Bitmap.PixelFormat := pf32bit;
    bits := Bitmap.ScanLine[Bitmap.Height - 1];

    FillLongword(Bits^[0], Width * Height, RGBA(RedComponent(Color), GreenComponent(Color), BlueComponent(Color), 255-AlphaComponent(Color)));
 
end;

procedure TBitmap32.Clear;
begin
  Clear(clBlack32);
end;

procedure  TBitmap32.SetAlphaChannels(Alpha: BYTE);
var
    x, y: integer;
    SS: pRGBQuadArray;
begin
    for y := 0 to Height-1 do
    begin
        SS := ScanLine[y];
        for x := 0 to Width-1 do
        begin
            SS^[x].rgbReserved := Alpha;
        end;
    end;
end;
{
procedure  TBitmap32.SetAlphaChannels(Bitmap: TBitmap);
var
    x, y: integer;
    DS: pRGBQuadArray;
    SS: pByteArray;
begin
    for y := 0 to Height-1 do
    begin
        DS := ScanLine[y];
        SS := Bitmap.ScanLine[y];
        for x := 0 to Width-1 do
        begin
            DS^[x].rgbReserved := SS^[x];
        end;
    end;
end;
}
procedure  TBitmap32.SetAlphaChannels(Mask8: TBitmap);
var
    x, y: integer;
    DS: pRGBQuadArray;
    SS: pByteArray;
    Bits1: pRGBQuadArray;
    Bits2: pByteArray;

begin
{    Bits1 := ScanLine[Height-1];
    Bits2 := Bitmap.ScanLine[Bitmap.height-1];

    for x := 0 to Width * Height-1 do
    begin
        Bits1^[x].rgbReserved := 1;
    end;
}


    for y := 0 to Height-1 do
    begin
        DS := ScanLine[y];
        SS := Mask8.ScanLine[y];
        for x := 0 to Width-1 do
        begin
            DS^[x].rgbReserved := SS^[x];
        end;
    end;

end;



procedure  TBitmap32.SetAlphaChannels(Bitmap: TBitmap; Alpha: Byte);
var
    x, y: integer;
    SS: pRGBQuadArray;
begin
    for y := 0 to Bitmap.Height-1 do
    begin
        SS := Bitmap.ScanLine[Bitmap.Height - y -1];
        for x := 0 to Bitmap.Width-1 do
        begin
            SS^[x].rgbReserved := Alpha;
        end;
    end;
end;

procedure TBitmap32.SetPixel(x, y: integer; color: TColor32);
begin
    if (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then
    GetBits^[x + (Height - y -1) * Width] := color;
end;

function  TBitmap32.GetPixel(x, y: integer): TColor32;
begin
    Result := $00000000;
    if (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then
    Result :=  GetBits^[x + (Height - y -1) * Width];
end;

procedure TBitmap32.LoadFromFile(const Filename: string);
begin
    inherited LoadFromFile(FileName);
    PixelFormat := pf32bit;
end;

procedure TBitmap32.Assign(Source: TPersistent);
begin
    inherited Assign(Source);
    PixelFormat := pf32bit;
end;

procedure TBitmap32.AlphaBlendPixel(var pDest: TRGBQuad; pSrc: TRGBQuad);
begin
    if (pSrc.rgbReserved = $FF) then
    begin
        PRGBArray(pDest) := PRGBArray(pSrc);
        exit;
    end;

    if (pSrc.rgbReserved = 0) then
    exit;
    // 以下用不着判断[0,0xFF],我验算过了

    if (PRGBArray(pSrc) <> PRGBArray(pDest)) then
    begin
        pDest.rgbBlue := (PSrc.rgbBlue - pDest.rgbBlue) * pSrc.rgbReserved div $FF + pDest.rgbBlue;
        pDest.rgbGreen := (PSrc.rgbGreen - pDest.rgbGreen) * pSrc.rgbReserved div $FF + pDest.rgbGreen;
        pDest.rgbRed := (PSrc.rgbRed - pDest.rgbRed) * pSrc.rgbReserved div $FF + pDest.rgbRed;
    end;
end;


//===================================================================
// 计算两个32bit象素的等效象素,这个函数非常重要(speed),安全检查就不做了
// cr1:背景    cr2:前景

procedure  TBitmap32.CombineAlphaPixel(var pDest: TRGBQuad; cr1: TRGBQuad; nAlpha1: integer; cr2: TRGBQuad; nAlpha2: integer);
var
    nTmp1, nTmp12, nTemp, nTmp2: integer;
begin
        if ((nAlpha1 <> 0) or (nAlpha2 <> 0)) then
        begin
                if (nAlpha2 = 0) then
                begin
                        pDest.rgbBlue  := cr1.rgbBlue ;
                        pDest.rgbGreen := cr1.rgbGreen ;
                        pDest.rgbRed  := cr1.rgbRed ;
                        pDest.rgbReserved := nAlpha1 ;
                        exit;
                end;
                if ((nAlpha1 = 0) or (nAlpha2 = $FF)) then
                begin
                        pDest.rgbBlue  := cr2.rgbBlue ;
                        pDest.rgbGreen := cr2.rgbGreen ;
                        pDest.rgbRed   := cr2.rgbRed ;
                        pDest.rgbReserved := nAlpha2 ;
                        exit;
        end;


                // 以下用不着判断[0,0xFF],我验算过了
                nTmp1 := $FF * nAlpha1;
        nTmp2 := $FF * nAlpha2 ;
                nTmp12 := nAlpha1 * nAlpha2;
                nTemp  := nTmp1 + nTmp2 - nTmp12 ;
                pDest.rgbBlue  := (nTmp2 * cr2.rgbBlue  + (nTmp1 - nTmp12) * cr1.rgbBlue)  div nTemp ;
                pDest.rgbGreen := (nTmp2 * cr2.rgbGreen + (nTmp1 - nTmp12) * cr1.rgbGreen) div nTemp ;
                pDest.rgbRed   := (nTmp2 * cr2.rgbRed   + (nTmp1 - nTmp12) * cr1.rgbRed)   div nTemp ;
                pDest.rgbReserved := nTemp div $FF ;


//                下面的代码是未优化过的,可读性更好些
{
                nTemp :=  $FF * (nAlpha1 + nAlpha2) - nAlpha1*nAlpha2 ;
                pDest.rgbBlue  := min($FF, ($FF * cr2.rgbBlue  * nAlpha2 + ($FF - nAlpha2) * cr1.rgbBlue  * nAlpha1) div nTemp) ;
                pDest.rgbGreen := min($FF, ($FF * cr2.rgbGreen * nAlpha2 + ($FF - nAlpha2) * cr1.rgbGreen * nAlpha1) div nTemp) ;
                pDest.rgbRed   := min($FF, ($FF * cr2.rgbRed   * nAlpha2 + ($FF - nAlpha2) * cr1.rgbRed   * nAlpha1) div nTemp) ;
                pDest.rgbReserved := nTemp div $FF ;
}
        end
        else
        begin
                pDest.rgbBlue  := $FF;
        pDest.rgbGreen := $FF;
        pDest.rgbRed   := $FF;
                pDest.rgbReserved := 0 ;
        end;
end;

procedure StrectchDrawGraphic(ACanvas: TCanvas; ARect: TRect; AGraphic: TGraphic;
  BkColor: TColor);
var
  Bmp: TBitmap;
begin
  if AGraphic is TIcon then
  begin
    // TIcon 不支持缩放绘制,通过 TBitmap 中转
    Bmp := TBitmap.Create;
    try
      Bmp.Canvas.Brush.Color := BkColor;
      Bmp.Canvas.Brush.Style := bsSolid;
      Bmp.Width := AGraphic.Width;
      Bmp.Height := AGraphic.Height;
      //Bmp.Canvas.FillRect(Rect(0, 0, Bmp.Width, Bmp.Height));
      Bmp.Canvas.Draw(0, 0, AGraphic);
      ACanvas.StretchDraw(ARect, Bmp);
    finally
      Bmp.Free;
    end;
  end
  else
    ACanvas.StretchDraw(ARect, AGraphic);
end;

//绘制平铺图
procedure TBitmap32.DrawTiled(Canvas: TCanvas; Rect: TRect; G: TGraphic);
var
  R, Rows, C, Cols: Integer;
begin
  if (G <> nil) and (not G.Empty) then
  begin
    Rows := ((Rect.Bottom - Rect.Top) div G.Height) + 1;
    Cols := ((Rect.Right - Rect.Left) div G.Width) + 1;
    for R := 1 to Rows do
      for C := 1 to Cols do
        Canvas.Draw(Rect.Left + (C - 1) * G.Width, Rect.Top + (R - 1) * G.Height, G);
  end;
end;


//创建纹理图

procedure TBitmap32.CreateForeBmp(Mode: TTextureMode; G: TGraphic; BkColor: TColor);
begin

    PixelFormat := pf24bit;

  Canvas.Brush.Color := Canvas.Font.Color;
  Canvas.Brush.Style := bsSolid;
  Canvas.FillRect(Rect(0, 0, Width, Height));
  case Mode of
    tmTiled:                            //平铺
        DrawTiled(Canvas, Rect(0, 0, Width, Height), G);
    tmStretched:                        //拉伸
        StrectchDrawGraphic(Canvas, Rect(0, 0, Width, Height), G, Canvas.Font.Color);
    tmCenter:                           //中心
        Canvas.Draw((Width - G.Width) div 2, (Height - G.Height) div 2, G);
    tmNormal:                           //普通
        Canvas.Draw(0, 0, G);
  end;
    PixelFormat := pf32bit;
end;

//创建渐变色前景
procedure TBitmap32.CreateGradual(Style: TGradualStyle; StartColor, EndColor: TColor);
var
  Buf, Dst: PRGBArray;
  BufLen, Len: Integer;
  SCol, ECol: TColor;
  sr, sb, sg: Byte;
  er, eb, eg: Byte;
  BufSize: Integer;
  i, j: Integer;
begin
    PixelFormat := pf24bit;

  if Style in [gsLeftToRight, gsRightToLeft, gsCenterToLR] then
    BufLen := Width                     // 缓冲区长度
  else
    BufLen := Height;
  if Style in [gsCenterToLR, gsCenterToTB] then
    Len := (BufLen + 1) div 2           // 渐变带长度
  else
    Len := BufLen;
  BufSize := BufLen * 3;
  GetMem(Buf, BufSize);
  try
    // 创建渐变色带缓冲区
    if Style in [gsLeftToRight, gsTopToBottom] then
    begin
      SCol := ColorToRGB(StartColor);
      ECol := ColorToRGB(EndColor);
    end
    else begin
      SCol := ColorToRGB(EndColor);
      ECol := ColorToRGB(StartColor);
    end;
    sr := GetRValue(SCol);              //起始色
    sg := GetGValue(SCol);
    sb := GetBValue(SCol);
    er := GetRValue(ECol);              //结束色
    eg := GetGValue(ECol);
    eb := GetBValue(ECol);
    for i := 0 to Len - 1 do
    begin
      Buf[i ].rgbtRed := sr + (er - sr) * i div Len;
      Buf[i ].rgbtGreen := sg + (eg - sg) * i div Len;
      Buf[i ].rgbtBlue := sb + (eb - sb) * i div Len;
    end;

    if Style in [gsCenterToLR, gsCenterToTB] then // 对称渐变
      for i := 0 to Len - 1 do
        Buf[BufLen - 1 - i] := Buf[i ];

    if Style in [gsLeftToRight, gsRightToLeft, gsCenterToLR] then
      for i := 0 to Height - 1 do  // 水平渐变
        Move(Buf[0], ScanLine[Height - i - 1]^, BufSize)
    else
      for i := 0 to Height - 1 do  // 垂直渐变
      begin
        Dst := ScanLine[Height - i - 1];
        for j := 0 to Width - 1 do
          Dst^[j] := Buf[i ];
      end;
  finally
    FreeMem(Buf);
  end;

      PixelFormat := pf32bit;
end;

end.

代码说明

TBitmap可以设置 [pfDevice, pf1bit, pf4bit, pf8bit, pf15bit, pf16bit, pf24bit, pf32bit, pfCustom]9种格式,这里为了处理32位图像只用了pf32Bit。

相关文章推荐

Delphi图像处理 -- 图像像素结构与图像数据转换

    《Delphi图像处理 -- 数据类型及内部过程》一文中定义了基本的图像数据类型及一些内部过程,本文进一步将Delphi常用的图像类型转换为图像处理所需的数据结构,为具体的Delphi图像处理...
  • maozefa
  • maozefa
  • 2009年10月27日 21:41
  • 7807

Delphi 动态与静态调用DLL

   摘要:本文阐述了Windows环境下动态链接库的概念和特点,对静态调用和动态调用两种调用方式作出了比较,并给出了Delphi中应用动态链接库的实例。一、动态链接库的概念 动态链接库(Dynami...
  • sforiz
  • sforiz
  • 2010年09月09日 15:43
  • 9450

Delphi图像处理 -- 平面几何变换(下)

阅读提示:    《Delphi图像处理》系列以效率为侧重点,一般代码为PASCAL,核心代码采用BASM。    《C++图像处理》系列以代码清晰,可读性为主,全部使用C++代码。    尽可能保持...
  • maozefa
  • maozefa
  • 2009年11月03日 20:46
  • 6555

实现一些简单的图像处理功能

  • 2007年07月23日 19:51
  • 60KB
  • 下载

Delphi基本图像处理方法汇总

本文实例汇总了Delphi基本图像处理方法。分享给大家供大家参考。具体分析如下: ? 1 2 3 4 5 6 7 8 9 10 11 12 13...
  • tesily
  • tesily
  • 2016年12月21日 13:39
  • 913

Delphi图像处理 -- RGB与HSL转换

阅读提示:    《Delphi图像处理》系列以效率为侧重点,一般代码为PASCAL,核心代码采用BASM。    《C++图像处理》系列以代码清晰,可读性为主,全部使用C++代码。    尽可能保持...
  • maozefa
  • maozefa
  • 2013年12月04日 20:22
  • 3968

Delphi图像处理 -- 高保真反差

阅读提示:    《Delphi图像处理》系列以效率为侧重点,一般代码为PASCAL,核心代码采用BASM。    《C++图像处理》系列以代码清晰,可读性为主,全部使用C++代码。    尽可能保持...
  • maozefa
  • maozefa
  • 2013年01月09日 21:15
  • 3812

Delphi图像处理 -- 表面模糊

阅读提示:    《Delphi图像处理》系列以效率为侧重点,一般代码为PASCAL,核心代码采用BASM。    《C++图像处理》系列以代码清晰,可读性为主,全部使用C++代码。    尽可能保持...
  • maozefa
  • maozefa
  • 2012年07月03日 01:02
  • 4038

Delphi图像处理 -- RGB与HSV转换

阅读提示:    《Delphi图像处理》系列以效率为侧重点,一般代码为PASCAL,核心代码采用BASM。    《C++图像处理》系列以代码清晰,可读性为主,全部使用C++代码。    尽可能保持...
  • maozefa
  • maozefa
  • 2013年12月04日 20:16
  • 4071

Delphi图像处理 -- 最大值

阅读提示:    《Delphi图像处理》系列以效率为侧重点,一般代码为PASCAL,核心代码采用BASM。    《C++图像处理》系列以代码清晰,可读性为主,全部使用C++代码。    尽可能保持...
  • maozefa
  • maozefa
  • 2013年07月16日 13:49
  • 4242
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:32位图像处理库 delphi简单实现(转贴)
举报原因:
原因补充:

(最多只允许输入30个字)