Code:
unit Images;
// Bron: http://www.codebase.nl/index.php/command/viewcode/id/28
interface
uses
Windows, SysUtils, Graphics, Classes, Colors;
const
MaxPixelCount = 32768;
type
TRGBTripleArray = array[0..MaxPixelCount-1] of tagRGBTriple;
pRGBTripleArray = ^TRGBTripleArray;
procedure RotateBitmap(Bitmap: TBitmap; AngleOfRotation: Double);
procedure DissolveBitmap(Bitmap: TBitmap; DissolvePixels: Integer);
procedure AlphaBlendBitmaps(Bitmap: TBitmap; Bmp1, Bmp2: TBitmap; R: TRect; Opacity: Integer);
procedure FadeText(Bitmap: TBitmap; S1, S2: String; FromCanvas: TCanvas; Opacity: Integer);
implementation
procedure RotateBitmap(Bitmap: TBitmap; AngleOfRotation: Double);
var
Theta, CosTheta, SinTheta: Extended;
I, IOriginal, IPrime, IPrimeRotated, IRotationAxis,
J, JOriginal, JPrime, JPrimeRotated, JRotationAxis,
oW, oH, nW, nH: Integer;
RowOriginal: pRGBTripleArray;
RowRotated: pRGBTRipleArray;
Tmp: TBitmap;
begin
Tmp := TBitmap.Create;
nW := 0;
nH := 0;
try
Theta := -AngleOfRotation * (Pi / 180);
CosTheta := Cos(Theta);
SinTheta := Sin(Theta);
oW := Bitmap.Width;
oH := Bitmap.Height;
nW := Abs(Round(oW * SinTheta)) + Abs(Round(oW * CosTheta));
nH := Abs(Round(oH * SinTheta)) + Abs(Round(oH * CosTheta));
Tmp := TBitmap.Create;
Tmp.Width := nW;
Tmp.Height := nH;
Tmp.PixelFormat := pf24bit;
IRotationAxis := oW div 2;
JRotationAxis := oH div 2;
for j := nW-1 downto 0 do begin
RowRotated := Tmp.Scanline[J];
JPrime := 2 * (J - (nW - oW) div 2 - JRotationAxis) + 1;
for i := nH-1 downto 0 do begin
IPrime := 2 * (I - (nH - oH) div 2 - IRotationAxis) + 1;
IPrimeRotated := Round(iPrime * CosTheta - jPrime * sinTheta);
JPrimeRotated := Round(iPrime * sinTheta + jPrime * cosTheta);
IOriginal := (IPrimeRotated - 1) div 2 + IRotationAxis;
JOriginal := (JPrimeRotated - 1) div 2 + JRotationAxis;
if (IOriginal >= 0) and (IOriginal <= Bitmap.Width-1) and (JOriginal >= 0) and (JOriginal <= Bitmap.Height-1) then begin
RowOriginal := Bitmap.Scanline[JOriginal];
RowRotated[I] := RowOriginal[IOriginal]
end
else begin
with RowRotated[I] do begin
rgbtBlue := 255;
rgbtGreen := 0;
rgbtRed := 0;
end;
end;
end;
end;
finally
Bitmap.Width := nW;
Bitmap.Height := nH;
Bitmap.Canvas.Draw(0,0,Tmp);
Tmp.Free;
end;
end;
procedure DissolveBitmap(Bitmap: TBitmap; DissolvePixels: Integer);
var
C: Integer;
T: tagRGBTriple;
W, H: Integer;
procedure DissolvePixel(X, Y: Integer);
procedure SetRow(Row: Integer);
function Check(Max, Int: Integer): Integer;
begin
if Int < 0 then Result := Max-(-Int)-1
else if Int > Max-1 then Result := Int-Max
else Result := Int;
end;
procedure SetCol(Col: Integer);
begin
with Bitmap do TRGBTripleArray(Scanline[(Check(H,(Y-Random(5))+Random(2)+Col))]^)[(Check(W,(X-Random(5))+Random(2)))+Row] := T;
end;
begin
SetCol(0);
SetCol(1);
SetCol(2);
SetCol(3);
end;
begin
T := TRGBTripleArray(Bitmap.Scanline[Y]^)[X];
SetRow(0);
SetRow(1);
SetRow(2);
SetRow(3);
end;
var
X, Y: Integer;
begin
C := 0;
if DissolvePixels > 0 then begin
repeat
Inc(C);
W := Bitmap.Width;
H := Bitmap.Height;
X := Random(W);
Y := Random(H);
if X = 0 then X := 1
else if X = W then X := W-1;
if Y = 0 then Y := 1
else if Y = H then Y := H-1;
DissolvePixel(X,Y);
until C = DissolvePixels;
end;
end;
procedure AlphaBlendBitmaps(Bitmap: TBitmap; Bmp1, Bmp2: TBitmap; R: TRect; Opacity: Integer);
var
X, Y: Integer;
ScanLn1, ScanLn2: PRGBTripleArray;
Tmp: TBitmap;
begin
Tmp := TBitmap.Create;
try
Bitmap.Width := R.Right - R.Left;
Bitmap.Height := R.Bottom - R.Top;
Bitmap.PixelFormat := pf24Bit;
Tmp.Width := Bitmap.Width;
Tmp.Height := Bitmap.Height;
Tmp.PixelFormat := pf24Bit;
Bitmap.Canvas.CopyRect(Rect(0,0,Bitmap.Width,Bitmap.Height),Bmp1.Canvas,R);
Tmp.Canvas.CopyRect(Rect(0,0,Bitmap.Width,Bitmap.Height),Bmp2.Canvas,R);
for Y := 0 to Bitmap.Height-1 do begin
ScanLn1 := Bitmap.Scanline[Y];
ScanLn2 := Tmp.Scanline[Y];
for X := 0 to Bitmap.Width-1 do begin
with ScanLn1[X] do begin
rgbtBlue := ((255 - Opacity) * (rgbtBlue - ScanLn2[X].rgbtBlue)) div 255 + ScanLn2[X].rgbtBlue;
rgbtGreen := ((255 - Opacity) * (rgbtGreen - ScanLn2[X].rgbtGreen)) div 255 + ScanLn2[X].rgbtGreen;
rgbtRed := ((255 - Opacity) * (rgbtRed - ScanLn2[X].rgbtRed)) div 255 + ScanLn2[X].rgbtRed;
end;
end;
end;
finally
Tmp.Free;
end;
end;
procedure FadeText(Bitmap: TBitmap; S1, S2: String; FromCanvas: TCanvas; Opacity: Integer);
var
Bmp1: TBitmap;
Bmp2: TBitmap;
T1, T2, H: Integer;
begin
Bmp1 := TBitmap.Create;
Bmp2 := TBitmap.Create;
try
with Bmp1.Canvas do begin
Font.Assign(FromCanvas.Font);
Brush.Color := FromCanvas.Brush.Color;
Pen.Color := FromCanvas.Pen.Color;
end;
with Bmp2.Canvas do begin
Font.Assign(FromCanvas.Font);
Brush.Color := FromCanvas.Brush.Color;
Pen.Color := FromCanvas.Pen.Color;
end;
T1 := Bmp1.Canvas.TextWidth(S1);
T2 := Bmp2.Canvas.TextWidth(S2);
H := Bmp1.Canvas.TextHeight(S1);
Bmp1.Height := H;
Bmp2.Height := H;
if T1 > T2 then begin
Bmp1.Width := T1;
Bmp2.Width := T1;
end
else begin
Bmp1.Width := T2;
Bmp2.Width := T2;
end;
Bmp1.Canvas.FillRect(Rect(0,0,Bmp1.Width,Bmp1.Height));
Bmp2.Canvas.FillRect(Rect(0,0,Bmp2.Width,Bmp2.Height));
Bmp1.Canvas.TextOut(0,0,S1);
Bmp2.Canvas.TextOut(0,0,S2);
AlphaBlendBitmaps(Bitmap, Bmp1, Bmp2, Rect(0,0,Bmp1.Width,Bmp1.Height), Opacity);
finally
Bmp1.Free;
Bmp2.Free;
end;
end;
Gratis code
Bookmarks