// 32位图像处理库 delphi简单实现
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);
{* 渐变方式类型
|
gsLeftToRight - 从左向右渐变
gsRightToLeft - 从右向左渐变
gsTopToBottom - 从上向下渐变
gsBottomToTop - 从下向上渐变
gsCenterToLR - 从中间向左右渐变
gsCenterToTB - 从中间向上下渐变
|
}
TTextureMode = (tmTiled, tmStretched, tmCenter, tmNormal);
{* 纹理图像显示模式
|
tmTiled - 平铺显示
tmStretched - 自动缩放显示
tmCenter - 在中心位置显示
tmNormal - 在左上角显示
|
}
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;
|
哪有那么复杂 - Delphi(Pascal) code
//Bmp to Bmp
procedure DrawTransparent(var sBmp: TBitMap; dBmp: TBitMap; PosX, PosY: Integer; TranColor: TColor = -1);
type
PRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array[0..32767] of TRGBTriple;
function GetSLColor(pRGB: TRGBTriple): TColor;
begin
Result := RGB(pRGB.rgbtRed, pRGB.rgbtGreen, pRGB.rgbtBlue);
end;
var
b, p: PRGBTripleArray;
x, y: Integer;
BaseColor: TColor;
begin
sBmp.PixelFormat := pf24Bit;
dBmp.PixelFormat := pf24Bit;
p := dBmp.scanline[0];
if TranColor = -1 then
BaseCOlor := GetSLCOlor(p[0])
else
BaseCOlor := TranColor;
if (PosY > sBmp.Width) or (PosY > sBmp.Height) then
Exit;
for y := 0 to dBmp.Height - 1 do
begin
p := dBmp.scanline[y];
b := sBmp.ScanLine[y + PosY];
for x := 0 to (dBmp.Width - 1) do
begin
if GetSLCOlor(p[x]) <> BaseCOlor then
b[x + PosX] := p[x];
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
bmp:TBitMap;
begin
bmp:=TBitMap.Create ;
bmp.Assign(Image1.Picture);
DrawTransparent(bmp,Image2.Picture.Bitmap ,10,10);
image1.Picture.Assign(bmp);
image1.Refresh ;
end;
|
