procedure EncryptBMP(const BMP: TBitmap; Key: Integer);
var
BytesPorScan: Integer;
w, h: integer;
p: pByteArray;
begin
try
BytesPorScan := Abs(Integer(BMP.ScanLine[1]) -
Integer(BMP.ScanLine[0]));
except
raise Exception.Create('Error');
end;
RandSeed := Key;
for h := 0 to BMP.Height - 1 do
begin
P := BMP.ScanLine[h];
for w := 0 to BytesPorScan - 1 do
P^[w] := P^[w] xor Random(256);
end;
end;
// Do the actual encryption of the message inside the picture.
procedure TForm1.btnEncryptClick(Sender: TObject);
var
x, y, i, j : Integer;
PixelData : TColor;
CharMask, CharData: Byte;
begin
// Assign the original picture to both the target encrypted image
// and delta image. Also make sure thier resolution is sufficient to
// indicate the change in the LSB.
imgTarget.Picture.Assign(imgOrig.Picture);
imgDelta.Picture.Assign(imgOrig.Picture);
imgTarget.Picture.Bitmap.PixelFormat := pf32bit;
imgDelta.Picture.Bitmap.PixelFormat := pf32bit;
x := 0;
y := 0;
// The letter 'c' is identified by the binary representation of '10000011'
// for each '1' in this number change the current pixel's LSB value.
with imgTarget.Picture.Bitmap do
for i := 1 to Length(sourceMessage.Text) do
begin
CharMask := $80;
// 8 bytes for every letter to be encrypted.
for j := 1 to 8 do
begin
// See if the current byte in the character is either '1' or '0'.
CharData := Byte(sourceMessage.Text[i]) and CharMask;
//Data is not zero - change the LSB of the current pixel.
if (CharData <> 0) then
begin
// Xor the LSB value - hence change its value.
PixelData := Canvas.Pixels[x, y] xor $1;
// Store the changed pixel color back in the Pixels array.
Canvas.Pixels[x, y] := PixelData;
end;
// Move to the next pixel.
x := (x + 1) mod Width;
if (x = 0) then
begin
Inc(y);
end;
// Move the mask to be applied to the current character to the
// right, hence will now examine the next bit in the binary
// representation of the current letter to be encrypted.
CharMask := CharMask shr 1;
end;
end;
// Show the difference in the Delta image.
for y := 0 to imgOrig.Picture.Bitmap.Height - 1 do
for x := 0 to imgOrig.Picture.Bitmap.Width - 1 do
// Check for difference, the difference will show in the LSB of every
// pixel in the original and target images.
if (imgOrig.Picture.Bitmap.Canvas.Pixels[x, y] <>
imgTarget.Picture.Bitmap.Canvas.Pixels[x, y]) then
imgDelta.Picture.Bitmap.Canvas.Pixels[x, y] := clYellow;
end;
// Decryption ( by Lemy )
procedure TForm1.btnDecryptClick(Sender: TObject);
var
x, y : integer;
mask, ch : byte;
begin
sourceMessage.Clear;
mask := $80;
ch := 0;
for y := 0 to imgOrig.Picture.Bitmap.Height - 1 do
begin
for x := 0 to imgOrig.Picture.Bitmap.Width - 1 do
begin
// if the pixel is different then set related bit
if (imgOrig.Picture.Bitmap.Canvas.Pixels[x, y] <>
imgTarget.Picture.Bitmap.Canvas.Pixels[x, y]) then
ch := ch or mask;
// shift the bit to the rigtht
mask := mask shr 1;
// if the mask is 0 then the dexryption of a char is completed
// so add to the Text and rest the highest bit
if mask = 0 then
begin
sourceMessage.Text := sourceMessage.Text + char(ch);
mask := $80;
ch := 0;
end;
end;
end;
end;
procedure FadeOut(const Bmp: TImage; Pause: Integer);
var
BytesPorScan, counter, w, h: Integer;
p : pByteArray;
begin
if not (Bmp.Picture.Bitmap.PixelFormat in [pf24Bit, pf32Bit]) then
raise Exception.Create('Error, bitmap format is not supporting.');
try
BytesPorScan := Abs(Integer(Bmp.Picture.Bitmap.ScanLine[1]) -
Integer(Bmp.Picture.Bitmap.ScanLine[0]));
except
raise Exception.Create('Error!!');
end;
for counter := 1 to 256 do
begin
for h := 0 to Bmp.Picture.Bitmap.Height - 1 do
begin
P := Bmp.Picture.Bitmap.ScanLine[h];
for w := 0 to BytesPorScan - 1 do
if P^[w] > 0 then P^[w] := P^[w] - 1;
end;
Sleep(Pause);
Bmp.Refresh;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
FadeOut(Image1, 1);
end;
procedure TfrmColor.bmp_rotate(src,dst:tbitmap;angle:extended);
var
c1x,c1y,c2x,c2y:integer;
p1x,p1y,p2x,p2y:integer;
radius,n:integer;
alpha:extended;
c0,c1,c2,c3:tcolor;
begin
//将角度转换为PI值
angle := (angle / 180) * pi;
// 计算中心点,你可以修改它
c1x := src.width div 2;
c1y := src.height div 2;
c2x := dst.width div 2;
c2y := dst.height div 2;
// 步骤数值number
if c2x < c2y then
n := c2y
else
n := c2x;
dec (n,1);
// 开始旋转
for p2x := 0 to n do begin
for p2y := 0 to n do begin
if p2x = 0 then
alpha:= pi/2
else
alpha := arctan2(p2y,p2x);
radius := round(sqrt((p2x*p2x)+(p2y*p2y)));
p1x := round(radius * cos(angle+alpha));
p1y := round(radius * sin(angle+alpha));
function ArcTan2(xt,yt : Single): Single;
begin
if xt = 0 then
if yt > 0 then
Result := Pi/2
else
Result := -(Pi/2)
else begin
Result := ArcTan(yt/xt);
if xt < 0 then
Result := Pi + ArcTan(yt/xt);
end;
end;
begin
OFFSET := -(Pi/2);
dx := Bmp.Width - 1;
dy := Bmp.Height - 1;
r := Sqrt(dx * dx + dy * dy);
tx2 := r;
ty2 := r;
txmid := (Bmp.Width-1)/2; //Adjust these to move center of rotation
tymid := (Bmp.Height-1)/2; //Adjust these to move ......
fxmid := (Bmp.Width-1)/2;
fymid := (Bmp.Height-1)/2;
if tx2 >= Bmp.Width then tx2 := Bmp.Width-1;
if ty2 >= Bmp.Height then ty2 := Bmp.Height-1;
for ty := 0 to Round(ty2) do begin
for tx := 0 to Round(tx2) do begin
dx := tx - txmid;
dy := ty - tymid;
r := Sqrt(dx * dx + dy * dy);
if r = 0 then begin
fx := 0;
fy := 0;
end
else begin
theta := ArcTan2(dx,dy) - r/Amount - OFFSET;
fx := r * Cos(theta);
fy := r * Sin(theta);
end;
fx := fx + fxmid;
fy := fy + fymid;
ify := Trunc(fy);
ifx := Trunc(fx);
// Calculate the weights.
if fy >= 0 then begin
weight_y[1] := fy - ify;
weight_y[0] := 1 - weight_y[1];
end else begin
weight_y[0] := -(fy - ify);
weight_y[1] := 1 - weight_y[0];
end;
if fx >= 0 then begin
weight_x[1] := fx - ifx;
weight_x[0] := 1 - weight_x[1];
end else begin
weight_x[0] := -(fx - ifx);
Weight_x[1] := 1 - weight_x[0];
end;
if ifx < 0 then
ifx := Bmp.Width-1-(-ifx mod Bmp.Width)
else if ifx > Bmp.Width-1 then
ifx := ifx mod Bmp.Width;
if ify < 0 then
ify := Bmp.Height-1-(-ify mod Bmp.Height)
else if ify > Bmp.Height-1 then
ify := ify mod Bmp.Height;
total_red := 0.0;
total_green := 0.0;
total_blue := 0.0;
for ix := 0 to 1 do begin
for iy := 0 to 1 do begin
if ify + iy < Bmp.Height then
sli := Bmp.scanline[ify + iy]
else
sli := Bmp.scanline[Bmp.Height - ify - iy];
if ifx + ix < Bmp.Width then begin
new_red := sli[(ifx + ix)*3];
new_green := sli[(ifx + ix)*3+1];
new_blue := sli[(ifx + ix)*3+2];
end
else begin
new_red := sli[(Bmp.Width - ifx - ix)*3];
new_green := sli[(Bmp.Width - ifx - ix)*3+1];
new_blue := sli[(Bmp.Width - ifx - ix)*3+2];
end;
weight := weight_x[ix] * weight_y[iy];
total_red := total_red + new_red * weight;
total_green := total_green + new_green * weight;
total_blue := total_blue + new_blue * weight;
end;
end;
slo := Dst.scanline[ty];
slo[tx*3] := Round(total_red);
slo[tx*3+1] := Round(total_green);
slo[tx*3+2] := Round(total_blue);
end;
end;
end;
procedure Twist(var Bmp, Dst: TBitmap; Amount: integer);
**************************
//This function turns a colored Bitmap into Grayshades
uses
Windows, Graphics;
function ConvertBitmapToGrayscale1(const Bitmap: TBitmap): TBitmap;
var
i, j: Integer;
Grayshade, Red, Green, Blue: Byte;
PixelColor: Longint;
begin
with Bitmap do
for i := 0 to Width - 1 do
for j := 0 to Height - 1 do
begin
PixelColor := ColorToRGB(Canvas.Pixels[i, j]);
Red := PixelColor;
Green := PixelColor shr 8;
Blue := PixelColor shr 16;
Grayshade := Round(0.3 * Red + 0.6 * Green + 0.1 * Blue);
Canvas.Pixels[i, j] := RGB(Grayshade, Grayshade, Grayshade);
end;
Result := Bitmap;
end;
procedure ConvertBitmapToGrayscale2(const Bmp: TBitmap);
{From: Pascal Enz, pascal.enz@datacomm.ch }
type
TRGBArray = array[0..32767] of TRGBTriple;
PRGBArray = ^TRGBArray;
var
x, y, Gray: Integer;
Row: PRGBArray;
begin
Bmp.PixelFormat := pf24Bit;
for y := 0 to Bmp.Height - 1 do
begin
Row := Bmp.ScanLine[y];
for x := 0 to Bmp.Width - 1 do
begin
Gray := (Row[x].rgbtRed + Row[x].rgbtGreen + Row[x].rgbtBlue) div 3;
Row[x].rgbtRed := Gray;
Row[x].rgbtGreen := Gray;
Row[x].rgbtBlue := Gray;
end;
end;
end;
灰度级处理
procedure Gray(bmp: TBitmap);
var
p: PByteArray;
w: Integer;
i, j: Integer;
begin
bmp.pixelformat := pf24bit;
for i := 0 to bmp.height - 1 do
begin
p := bmp.scanline[i];
j := 0;
while j < (bmp.width-1) * 3 do
begin
w :=(p[j] * 28 + p[j+1] * 151 + p[j+2]*77);
w := w shr 8;
p[j] := byte(w);
p[j+1] := byte(w);
p[j+2] := byte(w);
inc(j, 3)
end;
end;
end;