谁有图象处理原码

灰度级处理
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;

**************************
//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, [email protected] }
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 Twist(var Bmp, Dst: TBitmap; Amount: integer);
var
  fxmid, fymid : Single;
  txmid, tymid : Single;
  fx,fy : Single;
  tx2, ty2 : Single;
  r : Single;
  theta : Single;
  ifx, ify : integer;
  dx, dy : Single;
  OFFSET : Single;
  ty, tx             : Integer;
  weight_x, weight_y     : array[0..1] of Single;
  weight                 : Single;
  new_red, new_green     : Integer;
  new_blue               : Integer;
  total_red, total_green : Single;
  total_blue             : Single;
  ix, iy                 : Integer;
  sli, slo : PBytearray;  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);

图像旋转：调用方法：
   bmp_rotate(Image1.Picture.Bitmap, Image2.Picture.Bitmap, RAngle);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));

      c0 := src.canvas.pixels[c1x+p1x,c1y+p1y];
      c1 := src.canvas.pixels[c1x-p1x,c1y-p1y];
      c2 := src.canvas.pixels[c1x+p1y,c1y-p1x];
      c3 := src.canvas.pixels[c1x-p1y,c1y+p1x];      dst.canvas.pixels[c2x+p2x,c2y+p2y]:=c0;
      dst.canvas.pixels[c2x-p2x,c2y-p2y]:=c1;
      dst.canvas.pixels[c2x+p2y,c2y-p2x]:=c2;
      dst.canvas.pixels[c2x-p2y,c2y+p2x]:=c3;
    end;
    application.processmessages
  end;
end;
*************8

/////////////////////////////////////////////////
  //                  Fade In                    //
  /////////////////////////////////////////////////procedure FadeIn(ImageFileName: TFileName);
var
  Bitmap, BaseBitmap: TBitmap;
  Row, BaseRow      : PRGBTripleArray;
  x, y, step        : integer;
begin
  // Bitmaps vorbereiten / Preparing the Bitmap //
  Bitmap := TBitmap.Create;
  try
    Bitmap.PixelFormat := pf32bit; // oder pf24bit / or pf24bit //
    Bitmap.LoadFromFile(ImageFileName);
    BaseBitmap := TBitmap.Create;
    try
      BaseBitmap.PixelFormat := pf32bit;
      BaseBitmap.Assign(Bitmap);
      // Fading //
      for step := 0 to 32 do
      begin
        for y := 0 to (Bitmap.Height - 1) do
        begin
          BaseRow := BaseBitmap.Scanline[y];
          // Farben vom Endbild holen / Getting colors from final image //
          Row := Bitmap.Scanline[y];
          // Farben vom aktuellen Bild / Colors from the image as it is now //
          for x := 0 to (Bitmap.Width - 1) do
          begin
            Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 5;
            Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 5; // Fading //
            Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 5;
          end;
        end;
        Form1.Canvas.Draw(0, 0, Bitmap); // neues Bild ausgeben / Output new image //
        InvalidateRect(Form1.Handle, nil, False);
        // Fenster neu zeichnen / Redraw window //
        RedrawWindow(Form1.Handle, nil, 0, RDW_UPDATENOW);
      end;
    finally
      BaseBitmap.Free;
    end;
  finally
    Bitmap.Free;
  end;
end;/////////////////////////////////////////////////
//                  Fade Out                   //
/////////////////////////////////////////////////
procedure FadeOut(ImageFileName: TFileName);
var
  Bitmap, BaseBitmap: TBitmap;
  Row, BaseRow: PRGBTripleArray;
  x, y, step: integer;
begin
  // Bitmaps vorbereiten / Preparing the Bitmap //
  Bitmap := TBitmap.Create;
  try
    Bitmap.PixelFormat := pf32bit;  // oder pf24bit / or pf24bit //
    Bitmap.LoadFromFile(ImageFileName);
    BaseBitmap := TBitmap.Create;
    try
      BaseBitmap.PixelFormat := pf32bit;
      BaseBitmap.Assign(Bitmap);
      // Fading //
     for step := 32 downto 0 do
      begin
        for y := 0 to (Bitmap.Height - 1) do
        begin
          BaseRow := BaseBitmap.Scanline[y];
          // Farben vom Endbild holen / Getting colors from final image //
          Row := Bitmap.Scanline[y];
          // Farben vom aktuellen Bild / Colors from the image as it is now //
          for x := 0 to (Bitmap.Width - 1) do
          begin
            Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 5;
            Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 5; // Fading //
            Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 5;
          end;
        end;
        Form1.Canvas.Draw(0, 0, Bitmap);   // neues Bild ausgeben / Output new image //
        InvalidateRect(Form1.Handle, nil, False);
        // Fenster neu zeichnen / Redraw window //
        RedrawWindow(Form1.Handle, nil, 0, RDW_UPDATENOW);
        sleep(20);
      end;
    finally
      BaseBitmap.Free;
    end;
  finally
    Bitmap.Free;
  end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  FadeIn('F:\Documents\xywper0071.BMP')
end;{*****************************}
{by Yucel Karapinar, [email protected] }{ Only for 24 ve 32 bits bitmaps }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 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;
procedure TForm1.Button1Click(Sender: TObject);
begin
  EncryptBMP(Image1.Picture.Bitmap, 623);
  Image1.Refresh;
end;
*****************************************************
下面的代码，可以把字符串隐藏到一个BitMap中！因此非常有用的噢！原理是利用人眼无法分辨微小色彩的变化：
第一个是源文件，第二个是加密后的文件，第三个是利用计算机判断出来的不同的数据点，这些点三面带有加密信息。
加密的信息，存储在每一个像素的最低一个字节上面。

// 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;

*******************************************************

调试易

谁有图象处理原码

解决方案 »