graphic32methodfordelphi.txt

32位图像处理库delphi简单实现 TBitmap可以设置 ［pfDevice, pf1bit, pf4bit, pf8bit, pf15bit, pf16bit, pf24bit, pf32

    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。