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

最新推荐文章于 2024-06-25 09:42:08 发布

jl820712

最新推荐文章于 2024-06-25 09:42:08 发布

阅读量1.7k

点赞数

文章标签： delphi 图像处理 integer function byte div

本文链接：https://blog.csdn.net/jl820712/article/details/795956

版权

这是一个Delphi实现的32位图像处理库，包含多种颜色通道提取函数，如RedComponent、GreenComponent、BlueComponent和AlphaComponent，支持渐变风格和纹理模式，提供了图像绘制、混合和透明度设置等功能。

摘要由CSDN通过智能技术生成

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