📄 alphalib.pas
字号:
//
// 256怓娐嫬丄摿庩昞尰儔僀僽儔儕
//
// 偙傟傪巊偆偵偼SANDMAN巵偺乽Quadruple D乿偑昁梫偱偡
// 偱傕偦偺側偐偵偼Direct3D傪巊偭偨敿摟柧婡擻愢柧偑偙偭偦傝偲偁偭偨傝偟偰丒丒
// 偙偺儔僀僽儔儕偺懚嵼壙抣偼偁傑傝側偄傗(^^;;;
//
unit AlphaLib;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics,
DDraw,DDDD;
const
BM_SCREEN = 2; //僗僋儕亅儞崌惉
BM_ADD = 2;
BM_NORMAL = 4; //捠忢崌惉
BM_JYOUSAN = 8; //忔嶼崌惉
BM_DEC = 8;
type
Talpha = class(TObject)
private
ScreenPal,NormalPal,JyousanPal,NonSys : Boolean;
wq,nq : Integer;
NormalPalAlph : Byte;
StretchMode : Boolean;
StretchBuff : TDDDDSurface;
function GetBlendMode (rop : Byte) : Byte;
function GetNearestPaletteIndex2(Col : LongInt) : Byte;
public
FontName : TFontName;
ASin,ACos : array[0..1024] of SmallInt; //Sin僥亅僽儖
AATan : array [0..1024] of SmallInt;
RT : array[0..1024] of SmallInt; //Random僥亅僽儖 random()偼抶偄偺偩
RndStep : Word; //Random屇傃弌偟弴彉梡
AT : array[0..2,0..255,0..255] of Byte; //Blend僥亅僽儖
TempPal : array[0..255,0..2] of Byte; //PalIndex -> 4096Pal
ABP: array[0..15,0..15,0..15] of Byte; //4096Pal -> PalIndex
AlphNormal : array[0..255,0..2,0..31] of Byte;//AlphaBlend梡僷儗僢僩忣曬
AlphAdd : array[0..31,0..255] of byte; //AlphaBlend ADD&DEC崌惉梡
AlphDec : array[0..31,0..255] of byte;
GetColStart,GetColEnd : Byte; //僔僗僥儉僷儗僢僩傪敳偄偰張棟偟偨偄偲偒偵巊偄傑偡
//Start-End偺斖埻撪偱嬤帡怓傪扵偟傑偡
//Create偱偡
constructor Create;
destructor Free;
//儐亅僓亅巜掕壜擻側曄悢
property NormalBlendAlpha : Byte read NormalPalAlph //AlphTable惗惉帪偺擟堄愝掕
write NormalPalAlph;
property WaveQuality: Integer read wq
Write wq;
property WindQuality: Integer read nq
Write nq;
//昁梫偭偡乮丱丱丟
procedure ReadPalette(FileName : String; rop : Byte);
procedure ReadDDDDPalette(dd : TDDDD; rop : Byte);
procedure SetStretchSize(dd : TDDDD);
//崌惉僥亅僽儖偺曐懚丒撉傒崬傒
procedure LoadBlendTable(FileName : string);
procedure SaveBlendTable(FileName : string);
//幚梡柦椷
procedure WaterWave(Dest : TDDDDSurface; rc : TRect; Count : Byte);
procedure WindNoise(Dest : TDDDDSurface; rc : TRect; Amount : Integer);
procedure FillRect(Dest : TDDDDSurface; rc : TRect; col : Byte);
procedure Blt(Dest : TDDDDSurface; rc1 : Trect;
Src : TDDDDSurface; rc2 : Trect;
dwFlags : Integer);
procedure Blt2(Dest : TDDDDGenSurface; rc1 : Trect;
Src : TDDDDSurface; rc2 : Trect;
dwFlags : Integer);
procedure ChangeColor(Dest : TDDDDSurface; rc : Trect;
DestCol,SrcCol : Integer);
function LoadBMP(Filename : string; DS : TDDDDSurface) : Boolean;
//崌惉僥亅僽儖巊梡柦椷
procedure Noise(Dest : TDDDDSurface;
rc : TRect; Space : Integer; Col,BM : Byte);
procedure Blend(Dest : TDDDDSurFace;dx,dy : Integer;
Src : TDDDDSurFace;rc : Trect;
BM : Byte);
procedure BlendRect(Dest : TDDDDSurface; rc : Trect;
Col,BM : Byte);
procedure StretchBlend(Dest : TDDDDSurFace;rc1 : Trect;
Src : TDDDDSurFace;rc2 : Trect;
BM : Byte);
function GetBlendColor(dest,src,BM : Byte) : Byte;
//媅帡4096怓僷儗僢僩巊梡柦椷
procedure AlphaBlend(Dest : TDDDDSurFace;dx,dy : Integer;
Src : TDDDDSurFace;rc : Trect;
Alph,BM : Byte);
procedure AlphaStretchBlend(Dest : TDDDDSurFace;rc1 : Trect;
Src : TDDDDSurFace;rc2 : Trect;
Alph,BM : Byte);
procedure AlphaBlendRect(Dest : TDDDDSurface; rc : Trect;
Col,Alph,BM : Byte);
procedure TVDisplay(Dest : TDDDDSurface; rc : TRect);
procedure TVDisplay2(Dest : TDDDDSurface; rc : TRect);
procedure TextOut(dest : TDDDDSurface;x,y : Integer; aaa : String;
RGBcolor : LongInt; size : Byte; Style : TFontStyles);
function MakeRGB(Col : LongInt) : Byte;
function GetAlphaBlendColor(dest,src,Alph,BM : Byte) : Byte;
//悢妛娭悢
//棎悢
procedure SaveRandomTable(fileName : string);
procedure LoadRandomTable(fileName : string);
function Rnd(Max : Integer) : Integer;
function SinT(r : Double) : Double; //幚悢宆
function CosT(r : Double) : Double;
function AtanT(x,y : Double) : Double;
function SinT2(r : SmallInt) : SmallInt; //惍悢宆乮x1024乯
function CosT2(r : SmallInt) : SmallInt;
function AtanT2(x,y : SmallInt) : SmallInt;
//屳姺傪曐偮偨傔
procedure AlphBlend (Dest : TDDDDSurFace;dx,dy : Integer;
Src : TDDDDSurFace;rc : Trect;
Alph,BM : Byte);
procedure AlphBlendRect (Dest : TDDDDSurface; rc : Trect;
Col,Alph,BM : Byte);
procedure AlphStretchBlend (Dest : TDDDDSurFace;rc1 : Trect;
Src : TDDDDSurFace;rc2 : Trect;
Alph,BM : Byte);
//palette憖嶌
procedure ResetPal(DD : TDDDD);
procedure SetPal(rrr,ggg,bbb,No : Byte; DD : TDDDD);
end;
implementation
//------------------------------------------------------------------
//徚偡梊掕
//埲慜偲偺屳姺傪庢傞偨傔
procedure TAlpha.AlphBlend (Dest : TDDDDSurFace;dx,dy : Integer;
Src : TDDDDSurFace;rc : Trect;
Alph,BM : Byte);
begin
AlphaBlend(dest,dx,dy,Src,rc,Alph,BM);
end;
//
procedure TAlpha.AlphBlendRect (Dest : TDDDDSurface; rc : Trect;
Col,Alph,BM : Byte);
begin
AlphaBlendRect(dest,rc,Col,Alph,BM);
end;
//
procedure TAlpha.AlphStretchBlend (Dest : TDDDDSurFace;rc1 : Trect;
Src : TDDDDSurFace;rc2 : Trect;
Alph,BM : Byte);
begin
AlphaStretchBlend(dest,rc1,Src,rc2,Alph,BM);
end;
//---------------------------------------------------------------
//BM乮BlendMethod乯偺抣傪僥亅僽儖憡摉偵曄姺偡傞
function TAlpha.GetBlendMode(rop : Byte) : byte;
begin
GetBlendMode := 0;
if ((rop and BM_SCREEN )<>0)then GetBlendMode := 0;
if ((rop and BM_ADD )<>0)then GetBlendMode := 0;
if ((rop and BM_NORMAL )<>0)then GetBlendMode := 1;
if ((rop and BM_JYOUSAN)<>0)then GetBlendMode := 2;
if ((rop and BM_DEC )<>0)then GetBlendMode := 2;
end;
//---------------------------------------------------------------
//廔椆丒夝曻
destructor TAlpha.Free;
begin
if (StretchMode = True)then StretchBuff.free;
end;
//---------------------------------------------------------------
//弶婜愝掕
constructor TAlpha.Create;
var
iii,jjj,kkk,aaa : Integer;
begin
FontName := 'System';
StretchMode := False; //Stretch梡椞堟偑梡堄偝傟偰偄傑偣傫
NormalPalAlph := 128;
ScreenPal := False;
NormalPal := False;
WaveQuality:= 4;
WindQuality := 1;
getColStart := 0;
GetColEnd := 255;
//SinTable 乮攇曄宍偵巊偆乯
for iii := 0 to 1024 do
begin
ASin[iii] := trunc(sin(3.14159265*(iii/512))*1024);
Acos[iii] := trunc(cos(3.14159265*(iii/512))*1024);
end;
//ATanTable
iii := 0;
for jjj := 0 to 128 do
begin
aaa := round(sin(3.141592 * jjj / 512) / cos(3.141592 * jjj / 512) * 1024);
for kkk := 0 to aaa - iii do
begin
AATAN[iii+kkk] := jjj;
end;
iii := aaa;
end;
for kkk := 0 to 1024 - iii do
begin
AATAN[iii+kkk] := 128;
end;
//RandomTable (僲僀僘偵巊偆乯
randomize;
for iii := 0 to 1024 do
RT[iii] := random(1024);
RndStep := 0;
end;
//---------------------------------------------------------------
//TempPal偐傜嬤帡怓傪傒偮偗傞
//
function TAlpha.GetNearestPaletteIndex2(Col : LongInt) : Byte;
var
iii : Integer;
Volume1,Volume2 : Word;
rr,gg,bb,Index : Byte;
begin
rr := GetRValue(Col);
gg := GetGValue(Col);
bb := GetBValue(Col);
Volume2 := 2048;
Index := GetColStart;
for iii := GetColStart to GetColEnd do
begin
Volume1 := abs(TempPal[iii,0]-RR) + abs(TempPal[iii,1]-GG) + abs(TempPal[iii,2]-BB);
if (Volume1 <= Volume2)then
begin
Index := iii;
//if (Volume1 < 6)then break;
Volume2 := Volume1;
end;
end;
GetNearestPaletteIndex2 := Index;
end;
//---------------------------------------------------------------
//價僢僩儅僢僾偐傜僷儗僢僩忣曬傪捀偄偰丄
//僽儗儞僨傿儞僌梡僷儗僢僩僥亅僽儖傪惗惉偡傞丅
//MMX200Mhz偱4昩偖傜偄偐偐傝傑偡丅
procedure TAlpha.ReadPalette(FileName : String; rop : Byte);
var
bfh:TBitmapFileHeader;
bmi:TBitmapInfoHeader;
fs:TFileStream;
iii,jjj,kkk,num : Integer;
rr,gg,bb : SmallInt;
quad:TRGBQuad;
TempBmp : TBitmap;
begin
//僼傽僀儖偑偁傞偐偳偆偐丠
if (FileExists(FileName) = False)then Exit;
//rop偐傜惗惉偡傞僷儗僢僩僥亅僽儖偺庬椶傪栤偆
ScreenPal := False;
NormalPal := False;
JyousanPal := False;
if ((rop and BM_SCREEN)<>0)then ScreenPal := True;
if ((rop and BM_NORMAL)<>0)then NormalPal := True;
if ((rop and BM_JYOUSAN)<>0)then JyousanPal := True;
//價僢僩儅僢僾偐傜僷儗僢僩忣曬傪敳偒弌偡
TempBmp := Tbitmap.Create;
TempBmp.LoadFromFile(FileName);
fs:=TFileStream.Create(FileName,fmOpenRead);
fs.Read(bfh,sizeof(bfh));
fs.Read(bmi,sizeof(bmi));
num:=bmi.biClrUsed;
if num=0 then num:=256;
//TempPal偵揮幨偡傞
for iii:=0 to num-1 do begin
fs.Read(quad,4);
TempPal[iii,0] := quad.rgbRed;
TempPal[iii,1] := quad.rgbGreen;
TempPal[iii,2] := quad.rgbBlue;
end;
//巊偄幪偰乮丱丱丟
fs.Free;
//***壛怓崌惉僷儗僢僩偺惗惉***
if (ScreenPal = True)then
begin
for kkk := 0 to 255 do
for iii := kkk to 255 do //寉偔偡傞億僀儞僩
begin
//椉曽偺怓偺壛嶼傪弌椡
rr := TempPal[kkk,0] + TempPal[iii,0];
gg := TempPal[kkk,1] + TempPal[iii,1];
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -