CnPack Forum - Powered by Discuz! Board

Subject: 32位图像处理库简单实现 [Print This Page]

Author: croslq Time: 2005-10-12 09:07 Subject: 32位图像处理库简单实现

32位图像处理库简单实现
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;
  function GreenComponent(Color32: TColor32): Integer;
  function BlueComponent(Color32: TColor32): Integer;
  function AlphaComponent(Color32: TColor32): Integer;
  function Intensity(Color32: TColor32): Integer;
  function RGBA(R, G, B: Byte; A: Byte = $FF): 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
  clBlack32             : TColor32 = $FF000000;
  clDimGray32          : TColor32 = $FF3F3F3F;
  clGray32             : TColor32 = $FF7F7F7F;
  clLightGray32          : TColor32 = $FFBFBFBF;
  clWhite32             : TColor32 = $FFFFFFFF;
  clMaroon32             : TColor32 = $FF7F0000;
  clGreen32             : TColor32 = $FF007F00;
  clOlive32             : TColor32 = $FF7F7F00;
  clNavy32             : TColor32 = $FF00007F;
  clPurple32             : TColor32 = $FF7F007F;
  clTeal32             : TColor32 = $FF007F7F;
  clRed32                : TColor32 = $FFFF0000;
  clLime32             : TColor32 = $FF00FF00;
  clYellow32             : TColor32 = $FFFFFF00;
  clBlue32             : TColor32 = $FF0000FF;
  clFuchsia32          : TColor32 = $FFFF00FF;
  clAqua32             : TColor32 = $FF00FFFF;

  // 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;
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通道合成
/

:o:o://
{ 把这个函数写到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]);
      end;

end;

end;

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

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

function  GetBits: PColor32Array;
procedure SetPixel(x, y: integer; color: TColor32);
function  GetPixel(x, y: integer): TColor32;

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; Value: 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 = $FF): 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 + Top];
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]);
      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]);
      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]);
      end;

end;

end;

procedure  TBitmap32.Clear(color: TColor32);
var
x, y: integer;
begin
FillLongword(GetBits^[0], Width * Height, Color);
end;

procedure TBitmap32.FillRect(X1, Y1, X2, Y2: Integer; Value: TColor32);
var
  j: Integer;
  P: PColor32Array;
begin
  for j := Y1 to Y2 - 1 do
  begin
P := Pointer(ScanLine[j]);
FillLongword(P[X1], X2 - X1, Value);
  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, 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。

刘强 2005.10.12
邮箱地址：lqcros@163.com
主页地址：http://lqcros.go1.wy8.net

[ Last edited by croslq on 2005-10-15 at 14:36 ]

Author: croslq Time: 2005-10-12 21:08

上面这个３２位图像处理的方法，可以开发字体特效（抗锯齿，字体的纹理填充，阴影，描边及描边的纹理填充），也可以开发其他的如图像处理软件（图层什么的），只要再在里面加入一部分功能（如：画线、矩形，非规则区域选择<ALPHA通道(把ALPHA作为一个MASK处理就行)>......）。。。。。。

刘强 2005.10.12
邮箱地址：lqcros@163.com
主页地址：http://lqcros.go1.wy8.net

Author: croslq Time: 2005-10-13 13:33

刘强 2005.10.13
邮箱地址：lqcros@163.com
主页地址：http://lqcros.go1.wy8.net

示例:

[ Last edited by croslq on 2005-10-13 at 14:08 ]

Attachment: demo.part01.rar (2005-10-13 13:33, 500 K) / Download count 544
http://bbs.cnpack.org/attachment.php?aid=144

Attachment: demo.part02.rar (2005-10-13 13:33, 500 K) / Download count 601
http://bbs.cnpack.org/attachment.php?aid=145

Attachment: demo.part03.rar (2005-10-13 13:33, 279.87 K) / Download count 556
http://bbs.cnpack.org/attachment.php?aid=146

Author: croslq Time: 2005-10-13 15:03 Subject: 图

Image Attachment: Image32.jpg (2005-10-13 15:03, 22.1 K) / Download count 473
http://bbs.cnpack.org/attachment.php?aid=148

Author: croslq Time: 2005-10-14 10:58

上面的３２位图像处理通过控件GraphicEx(http://www.soft-gems.net/Graphics.php)可以访问许多种图像格式。现在最新的GraphicEx9.9支持32位PNG。

Author: croslq Time: 2005-10-15 14:46 Subject: 32位图层(随手写的,没测试,你们看一下原理就行了哈:P)

type
TLayerList = class(TList)
private

end;

Bitmap32 : TBitmap32;
LayerList := TLayerList.Create;

Bitmap32 := TBitmap32.Create;
Bitmap32.LoadFromFile('1.tga');
LayerList.Items.add(Bitmap32);

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

for i := 0 to LayerList.Count -1 do
begin
TBitmap32(LayerList.Items[i ]).Free;
end;
LayerList.Free;

刘强 2005.10.13
邮箱地址：lqcros@163.com
主页地址：http://lqcros.go1.wy8.net

Author: croslq Time: 2005-10-15 18:01 Subject: MMX优化AlphaBlendPixel

//                            AARRGGBB    TColor32       0 .. 255
//                               |          |             |
//             AlphaBlendPixel(Source^[x], Target^[x], AlphaComponent(Source^[x]));
procedure AlphaBlendPixel(Source: TColor32; var Target: TColor32; Alpha: DWORD);
asm
MOVD          MM1, EAX       // MM1 = 00 00 00 00 ** Fr Fg Fb
MOVD          MM2,[EDX]    // MM2 = 00 00 00 00 ** Br Bg Bb
PUNPCKLBW MM1, MM0    // MM1 = 00 ** 00 Fr 00 Fg 00 Fb
MOVD          MM3, ECX    // MM3 = 00 00 00 00 00 00 00 AA
PUNPCKLBW MM2, MM0    // MM2 = 00 ** 00 Br 00 Bg 00 Bb
PSHUFW    MM3, MM3, 0 // MM3 = 00 AA 00 AA 00 AA 00 AA
PSUBW       MM1, MM2
PSLLW       MM2, 8
PMULLW    MM1, MM3
PADDW       MM1, MM2
PSRLW       MM1, 8
PACKUSWB MM1, MM0
MOVD          [EDX],MM1
emms
end;

[ Last edited by croslq on 2005-10-15 at 20:30 ]

Author: croslq Time: 2005-10-17 15:41 Subject: 抗锯齿直线的实现

附件里的自定义的画笔(掩码图)，它本身边缘就是羽化了的，所以就能抗锯齿
下面画线函数，首先确定直线的每一点的坐标，然后把自定义画笔画到这个坐标上，直到画完线

（这个抗锯齿直线就画起了三）

这个方法还可以反走样字体的边缘啦

procedure DrawMaskPen(TargetBitmap: TBitmap; DstX, DstY: Integer; Mask8: TBitmap);
var
Source, Target: PByteArray;
TR, SR: TRect;
x, y: integer;
begin

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

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

for y := Tr.Top to Tr.Bottom - 1 do
begin
      Target := TargetBitmap.ScanLine[y];
      Source := Mask8.ScanLine[y - Dsty];
      for x := TR.Left to Tr.Right - 1 do
      begin
         if (Target^[x] + Source^[x - Dstx]) > 255 then
         Target^[x] := 255
         else
         Target^[x] := Target^[x] + Source^[x - Dstx];
      end;
end;
end;

//采用Bresenham算法绘制一条颜色相同的直线
//将Bresenham算法写成统一的形式
//x1, y1, x2, y2直线的起点和端点
//通过附件里自定义的画笔,实现了8位蒙板图画抗锯齿直线

procedure LineMaskPen(Target8: TBitmap; x1, y1, x2, y2: integer; MaskPen8: TBitmap);
var
nDx, nDy: integer;
nIx, nIy: integer;
nInc: integer;
nJudgeX, nJudgeY: integer;
x, y: integer;
nTwoIx, nTwoIy: integer;
i: integer;
bPlot: boolean;

begin
//两端点间的水平偏移量和垂直偏移量
nDx := x2 - x1;
nDy := y2 - y1;

//两端点间的水平距离和垂直距离
nIx := ABS(nDx);
nIy := ABS(nDy);

//描点步数(增量总值)
nInc := MAX(nIx, nIy);

//绘制第一个点, 即, 直线的起点
// SetPixel(hdc, x1, y1, clr);
DrawMaskPen(Target, x1- MaskPen8.Width div 2, y1 - MaskPen8.Height div 2, MaskPen8);

//不包含终点
if(nInc < 2) then
exit;

//用于判断是否在nJudgeX, nJudgeY方向上向前进
nJudgeX := -nIy;
nJudgeY := -nIx;

//通过增量计算得到的当前点
x := x1;
y := y1;

//开始进行增量计算
//采用Bresenham算法.在这里, 我们将算法进行改进,
//使其对于任意斜率的直线都能绘制, 而且绘制方向始终为从起点绘制到终点

//注意, 整数乘2在计算机中采用移位实现
//Bresenham算法
nTwoIx := 2 * nIx;
nTwoIy := 2 * nIy;

//与Windows相对应, 该算法也不包含最后一个点(x2, y2)
dec(nInc);

//开始增量计算
for i := 0  to nInc -1 do
begin
nJudgeX := nJudgeX + nTwoIx;
nJudgeY := nJudgeY + nTwoIy;

//通过增量法计算的当前点是否属于直线上的点
bPlot := FALSE;

//检测 X 方向
if(nJudgeX >= 0) then
begin
bPlot := TRUE;
nJudgeX := nJudgeX - nTwoIy;

//将任意走向的直线统一起来
if(nDx > 0) then
         inc(x)
else if(nDx < 0) then
         dec(x)
end;

//检测 Y 方向
if(nJudgeY >= 0) then
begin
bPlot := TRUE;
nJudgeY := nJudgeY - nTwoIx;

//将任意走向的直线统一起来
if(nDy > 0) then
         inc(y)
else if(nDy < 0) then
         dec(y);
end;
//如果当前点在直线上, 则绘制当前点
if(bPlot) then
//       SetPixel(hdc, x, y, clr);
      DrawMaskPen(Target, x- MaskPen8.Width div 2, y- MaskPen8.Height div 2, MaskPen8);
end;//end for
end;

//画32位色直线这样画啦
var
Bitmap: TBitmap32;
Mask: TBitmap;
begin
Bitmap := TBitmap32.Create;
Bitmap.Width := 500;
Bitmap.Height := 500;
Mask := TBitmap.Create;
Mask.Width := 500;
Mask.Height := 500;

Image1.Picture.Bitmap.PixelFormat := pf8bit;
LineMaskPen(Mask, 0, 0, 200, 200, Image1.Picture.Bitmap);  //Image1.Picture.Bitmap 这里保存的是附件里的8位自定义画笔

Bitmap.Clear($FFFF0000);       //设为红色
Bitmap.SetAlphaChannels(Mask); //只有线条显示

Bitmap.Free;
end;

[ Last edited by croslq on 2005-10-17 at 15:47 ]

Image Attachment: pen08.jpg (2005-10-17 15:41, 1.02 K) / Download count 508
http://bbs.cnpack.org/attachment.php?aid=151

Image Attachment: pen13.jpg (2005-10-17 15:41, 1.16 K) / Download count 467
http://bbs.cnpack.org/attachment.php?aid=152

Author: kendling Time: 2005-10-19 11:18

强！！

Author: croslq Time: 2005-10-20 08:27 Subject: 定义一个画笔类

定义画笔公用类，就像Windows里的CreatePen，
通过这个函数直接生成自定义大小的反走样8位Bitmap。

//生成掩码灰度画笔

TPenMaskBitmap = class(TBitmap)
public
constructor Create; override;
destructor Destroy; override;
procedure CreateMaskBitmap(w, h: integer);
end;

constructor TPenMaskBitmap.Create;
begin
inherited Create;
PixelFormat := pf8bit;
end;

destructor TPenMaskBitmap.Destroy;
begin
inherited Destroy;
end;

procedure TPenMaskBitmap.CreateMaskBitmap(w, h: integer);
begin
//这里省了哈

end;

// 这个类在程序启动时就运行，在程序完了时就释放；
// 这个类直接生成32位色画笔，可以设定颜色，纹理，大小，透明度什么的。

TPenBitmap = class(TBitmap) // class(TBitmap32)

public
constructor Create; override;
destructor Destroy; override;
procedure CreateBitmap(w, h: integer);
end;

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

destructor TPenBitmap.Destroy;
begin
inherited Destroy;
end;

procedure TPenMaskBitmap.CreateMaskBitmap(w, h: integer);
begin
//这里省了哈

end;

Author: croslq Time: 2005-10-21 11:56 Subject: 反走样直线

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
procedure Button1Click(Sender: TObject);
  private
{ Private declarations }
  public
{ Public declarations }
  end;

var
  Form1: TForm1;

procedure AALine(x1,y1,x2,y2 : single; color: TColor32; Bitmap: TBitmap32);

implementation

{$R *.dfm}

procedure AALine(x1, y1, x2, y2: single; color: TColor32; Bitmap: TBitmap32);

function CrossFadeColor(FromColor, ToColor: TColor32; Rate: Single) : TColor32;
var
      R,G,B,A: BYTE;
begin
//    r := Round(RedComponent(FromColor) * Rate + RedComponent(ToColor) * (1 - Rate));
//    g := Round(GreenComponent(FromColor) * Rate + GreenComponent(ToColor) * (1 - Rate));
//    b := Round(BlueComponent(FromColor) * Rate + BlueComponent(ToColor) * (1 - Rate));
//    a := Round(AlphaComponent(FromColor) * Rate + AlphaComponent(ToColor) * (1 - Rate));
      r := RedComponent(FromColor);
      g := GreenComponent(FromColor);
      b := BlueComponent(FromColor);
      a := Round(AlphaComponent(FromColor) * Rate);

   Result := RGBA(r,g,b,a); //RGB(b,g,r);
end;

// type
//    intarray = array[0..1] of integer;
//    pintarray = ^intarray;

procedure hpixel(x : single; y : integer);
var
  FadeRate : single;
begin
  FadeRate := x - trunc(x);
  with bitmap do
  begin
if (x>=0) and (y>=0) and (height>y) and (width>x) then
      pColor32array(bitmap.ScanLine[y])[trunc(x)] := CrossFadeColor(Color,pColor32array(bitmap.ScanLine[y])[trunc(x)],1-FadeRate);

if (trunc(x)+1>=0) and (y>=0) and (height>y) and (width>trunc(x)+1) then
      pColor32array(bitmap.ScanLine[y])[trunc(x)+1]:=CrossFadeColor(Color,pColor32array(bitmap.ScanLine[y])[trunc(x)+1],FadeRate);
  end;
end;

procedure vpixel(x : integer; y : single);
var
  FadeRate : single;
begin
  FadeRate:=y-trunc(y);
  with bitmap do
  begin
if (x>=0) and (trunc(y)>=0) and (height>trunc(y)) and (width>x) then
                     pColor32array(bitmap.ScanLine[trunc(y)])[x]:=CrossFadeColor(Color,pColor32array(bitmap.ScanLine[trunc(y)])[x],1-FadeRate);

      if (x>=0) and (trunc(y)+1>=0) and (height>trunc(y)+1) and (width>x) then
      pColor32array(bitmap.ScanLine[trunc(y)+1])[x]:=CrossFadeColor(Color,pColor32array(bitmap.ScanLine[trunc(y)+1])[x],FadeRate);
      end;
end;

var i: integer;
ly, lx, currentx, currenty, deltax, deltay, l, skipl: single;
begin
  if (x1 <> x2) or (y1 <> y2) then
  begin
// bitmap.PixelFormat := pf32Bit;
// Bitmap.Clear($00000000);

currentx := x1;
currenty := y1;
lx := abs(x2 - x1);
ly := abs(y2 - y1);

if lx > ly then
begin
   l := trunc(lx);
   deltay := (y2-y1)/l;
   if x1 > x2 then
   begin
      deltax := -1;
      skipl  := (currentx - trunc(currentx));
   end
   else
   begin
      deltax := 1;
      skipl  := 1- (currentx - trunc(currentx));
   end;
end
else
begin
   l    :=  trunc(ly);
   deltax := (x2-x1)/l;
   if y1 > y2 then
   begin
      deltay := -1;
      skipl := (currenty-trunc(currenty));
   end
   else
   begin
      deltay := 1;
      skipl  := 1-(currenty-trunc(currenty));
   end;
end;

currentx := currentx+deltax*skipl;
currenty := currenty+deltay*skipl;{}

for i := 1 to trunc(l) do
begin
   if lx > ly then
      vpixel(trunc(currentx), currenty)
   else
      hpixel(currentx, trunc(currenty));

   currentx := currentx + deltax;
   currenty := currenty + deltay;
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
bitmap: TBitmap32;
begin
Bitmap := TBitmap32.Create;
Bitmap.Width := 400;
Bitmap.Height := 400;

Image1.picture.Bitmap.Width := 400;
Image1.picture.Bitmap.Height := 400;

AALine(0,0, 300,100, $FFFF0000, Bitmap);
Bitmap.DrawTo(0,0,Image1.Picture.Bitmap);

Bitmap.Free;
end;

end.

Welcome to CnPack Forum (http://bbs.cnpack.org/)