⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 picprocessor.~pas

📁 自己写的delphi图像处理程序
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
unit PicProcessor;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ExtCtrls, ExtDlgs, jpeg;

type
  rgbp = record
    r : Integer;
    g : Integer;
    b : Integer;
end;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    MNfile: TMenuItem;
    MNIOpen: TMenuItem;
    MNISave: TMenuItem;
    MNIExit: TMenuItem;
    MNEffect: TMenuItem;
    MNISmooth: TMenuItem;
    OpenPictureDialog1: TOpenPictureDialog;
    SavePictureDialog1: TSavePictureDialog;
    Image1: TImage;
    Image2: TImage;
    MNISharpe: TMenuItem;
    MNIEmboss: TMenuItem;
    MNIInvert: TMenuItem;
    MNIMosic: TMenuItem;
    MNIDiffuse: TMenuItem;
    MNDiffer: TMenuItem;
    MNID128: TMenuItem;
    MNID64: TMenuItem;
    MNID32: TMenuItem;
    MNID16: TMenuItem;
    MNColorTran: TMenuItem;
    MNIRTran: TMenuItem;
    MNIBTran: TMenuItem;
    MNIGTran: TMenuItem;
    MNIGrayTran: TMenuItem;
    MNOption: TMenuItem;
    MNILumInc: TMenuItem;
    MNILumDec: TMenuItem;
    MNScreen: TMenuItem;
    MNIInput: TMenuItem;
    MNIScreen: TMenuItem;
    procedure MNIScreenClick(Sender: TObject);
    procedure MNIInputClick(Sender: TObject);
    procedure MNIExitClick(Sender: TObject);
    procedure MNILumDecClick(Sender: TObject);
    procedure MNILumIncClick(Sender: TObject);
    procedure MNIGrayTranClick(Sender: TObject);
    procedure MNIBTranClick(Sender: TObject);
    procedure MNIGTranClick(Sender: TObject);
    procedure MNIRTranClick(Sender: TObject);
    procedure MNID16Click(Sender: TObject);
    procedure MNID32Click(Sender: TObject);
    procedure MNID64Click(Sender: TObject);
    procedure MNID128Click(Sender: TObject);
    procedure MNIDiffuseClick(Sender: TObject);
    procedure MNIMosicClick(Sender: TObject);
    procedure MNIInvertClick(Sender: TObject);
    procedure MNIEmbossClick(Sender: TObject);
    procedure MNISharpeClick(Sender: TObject);
    procedure MNISmoothClick(Sender: TObject);
    Procedure GetRgbp(Sender : TObject);
    procedure MNISaveClick(Sender: TObject);

    procedure MNIOpenClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  x : Integer;
  y : Integer;
  i : Integer;
  j : Integer;
  myBitmap : TBitmap;
  rgbPoint : array[0..1000, 0..1000] of rgbp;

implementation

uses Unit3;

{$R *.dfm}

procedure TForm1.MNIOpenClick(Sender: TObject);
var
  filename : AnsiString;
  color: TColor;
begin
  if OpenPictureDialog1.Execute() then
  begin
    filename:= OpenPictureDialog1.FileName;
    Image1.Picture.LoadFromFile(filename);
    Image2.Picture.LoadFromFile(filename);
    x := Image1.Picture.Width;
    y := Image2.Picture.Height;
    for i:=0 to x-1 do
    begin
      for j:=0 to y-1 do
      begin
        color := Image1.Canvas.Pixels[i, j];
        rgbpoint[i, j].r := GetRValue(color);
        rgbpoint[i, j].g := GetGValue(color);
        rgbpoint[i, j].b := GetBValue(color);
      end;
        MyBitmap := TBitmap.Create();
        MyBitmap.Width := Image1.Picture.Width;
        MyBitmap.Height := Image1.Picture.Height;
      end;
  end;
  MNISave.Enabled := true;
  MNEffect.Enabled := true;
  MNISmooth.Enabled := true;
  MNISharpe.Enabled := true;
  MNIEmboss.Enabled := true;
  MNIInvert.Enabled := true;
  MNIMosic.Enabled := true;
  MNIDiffuse.Enabled := true;
  MNDiffer.Enabled := true;
  MNID128.Enabled := true;
  MNID64.Enabled := true;
  MNID32.Enabled := true;
  MNID16.Enabled := true;
  MNIRTran.Enabled := true;
  MNIBTran.Enabled := true;
  MNIGTran.Enabled := true;
  MNIGrayTran.Enabled := true;
  MNILumInc.Enabled := true;
  MNILumDec.Enabled := true;
end;

procedure TForm1.MNISaveClick(Sender: TObject);
var
  filename : AnsiString;
begin
  if SavePictureDialog1.Execute() then
  begin
    filename := SavePictureDialog1.FileName;
    SavePictureDialog1.DefaultExt := '.BMP';
    Image2.Picture.SaveToFile(filename);
  end;
end;

procedure TForm1.MNISmoothClick(Sender: TObject);
var
  red : Integer;
  green : Integer;
  blue : Integer;
begin
  Image2.Picture.Bitmap.Assign(Image1.Picture.Bitmap);
  GetRgbp(Sender);
  //get the information of colors
  for i := 1 to x-2 do
  begin
    for j := 1 to y-2 do
    begin
      red := rgbpoint[i-1, j-1].r + rgbpoint[i-1, j].r +
        rgbpoint[i-1, j+1].r + rgbpoint[i, j-1].r +
        rgbpoint[i, j].r + rgbpoint[i, j+1].r +
        rgbpoint[i+1, j-1].r + rgbpoint[i+1, j].r +
        rgbpoint[i+1, j+1].r;
      green := rgbpoint[i-1, j-1].g + rgbpoint[i-1, j].g +
        rgbpoint[i-1, j+1].g + rgbpoint[i, j-1].g +
        rgbpoint[i, j].g + rgbpoint[i, j+1].g +
        rgbpoint[i+1, j-1].g + rgbpoint[i+1, j].g +
        rgbpoint[i+1, j+1].g;
      blue := rgbpoint[i-1, j-1].b + rgbpoint[i-1, j].b +
        rgbpoint[i-1, j+1].b + rgbpoint[i, j-1].b +
        rgbpoint[i, j].b + rgbpoint[i, j+1].b +
        rgbpoint[i+1, j-1].b + rgbpoint[i+1, j].b +
        rgbpoint[i+1, j+1].b;
      MyBitmap.Canvas.Pixels[i, j] := RGB(red div 9, green div 9, blue div 9);
    end;
  end;
  Image2.Picture.Bitmap.Assign(MyBitmap);
end;

Procedure TForm1.GetRgbp(Sender : TObject);
var
  color : TColor;
begin
  x := Image1.Picture.Width;
  y := Image1.Picture.Height;
  for i:=0 to y-1 do
  begin
    color := Image1.Canvas.Pixels[i, j];
    rgbpoint[i, j].r := GetRValue(color);
    rgbpoint[i, j].g := GetRValue(color);
    rgbpoint[i, j].b := GetRValue(color);
  end;
end;
procedure TForm1.MNISharpeClick(Sender: TObject);
var
  red : Integer;
  green : Integer;
  blue : Integer;
begin
  Image2.Picture.Bitmap.Assign(Image1.Picture.Bitmap);
  GetRgbp(Sender);
  //get information of the colors
  for i := 1 to x-2 do
  begin
    for j := 1 to y-2 do
    begin
      red := rgbpoint[i, j].r +
        (rgbpoint[i, j].r - rgbpoint[i-1, j-1].r) div 2;
      green := rgbpoint[i, j].g +
        (rgbpoint[i, j].g - rgbpoint[i-1, j-1].g) div 2;
      blue := rgbpoint[i, j].b +
        (rgbpoint[i, j].b - rgbpoint[i-1, j-1].b) div 2;

      if(red > 255) then red := 255;
      if(red < 0) then red := 0;
      if(green > 255) then green := 255;
      if(green < 0) then green := 0;
      if(blue > 255) then green := 255;
      if(blue < 0) then green := 0;
      MyBitmap.Canvas.Pixels[i,j] := RGB(red, green, blue);
    end;
  end;
      Image2.Picture.Bitmap.Assign(MyBitmap);
end;

procedure TForm1.MNIEmbossClick(Sender: TObject);
var
  red : Integer;
  green : Integer;
  blue : Integer;
begin
  Image2.Picture.Bitmap.Assign(Image1.Picture.Bitmap);
  GetRgbp(Sender);
  //get information of the colors
  for i:=1 to x-2 do
  begin
    for j:=1 to y-2 do
    begin
      red := abs(rgbpoint[i, j].r - rgbpoint[i+1, j+1].r +128);
      green := abs(rgbpoint[i, j].g - rgbpoint[i+1, j+1].g +128);
      blue := abs(rgbpoint[i, j].b - rgbpoint[i+1, j+1].b +128);

      if(red > 255) then red := 255;
      if(red < 0) then red := 0;
      if(green > 255) then green := 255;
      if(green < 0) then green := 0;
      if(blue > 255) then blue := 255;
      if(blue < 0) then blue := 0;
      MyBitmap.Canvas.Pixels[i, j] := RGB(red, green, blue);
    end;
  end;
    Image2.Picture.Bitmap.Assign(MyBitmap);
end;

procedure TForm1.MNIInvertClick(Sender: TObject);
var
  red : Integer;
  green : Integer;
  blue : Integer;
begin
  Image2.Picture.Bitmap.Assign(Image1.Picture.Bitmap);
  GetRgbp(Sender);

  for i:=1 to x-2 do
  begin
    for j:=1 to y-2 do
    begin
      red := 255 - rgbpoint[i, j].r;
      green := 255 - rgbpoint[i, j].g;
      blue := 255 - rgbpoint[i, j].b;
      MyBitmap.Canvas.Pixels[i, j] := RGB(red, green, blue);
    end;
  end;
    Image2.Picture.Bitmap.Assign(MyBitmap);
end;
procedure TForm1.MNIMosicClick(Sender: TObject);
var
  red : Integer;
  green : Integer;
  blue : Integer;
begin
  Image2.Picture.Bitmap.Assign(Image1.Picture.Bitmap);
  GetRgbp(Sender);
  i := 1;
  while(i < x-2) do
  begin
    j := 1;
    while(j < y-2) do
    begin
      red := rgbpoint[i-1,j-1].r + rgbpoint[i-1,j].r +
        rgbpoint[i-1, j+1].r + rgbpoint[i, j-1].r +
        rgbpoint[i, j].r + rgbpoint[i, j+1].r +
        rgbpoint[i+1, j-1].r + rgbpoint[i+1, j].r +
        rgbpoint[i+1, j+1].r;
      green := rgbpoint[i-1,j-1].g + rgbpoint[i-1,j].g +
        rgbpoint[i-1, j+1].g + rgbpoint[i, j-1].g +
        rgbpoint[i, j].g + rgbpoint[i, j+1].g +
        rgbpoint[i+1, j-1].g + rgbpoint[i+1, j].g +
        rgbpoint[i+1, j+1].g;
      blue := rgbpoint[i-1,j-1].b + rgbpoint[i-1,j].b +
        rgbpoint[i-1, j+1].b + rgbpoint[i, j-1].b +
        rgbpoint[i, j].b + rgbpoint[i, j+1].b +
        rgbpoint[i+1, j-1].b + rgbpoint[i+1, j].b +
        rgbpoint[i+1, j+1].b;
      MyBitmap.Canvas.Pixels[i-1,j-1] := RGB(red div 9, green div 9, blue div 9);
      MyBitmap.Canvas.Pixels[i-1,j] := RGB(red div 9, green div 9, blue div 9);
      MyBitmap.Canvas.Pixels[i-1,j+1] := RGB(red div 9, green div 9, blue div 9);
      MyBitmap.Canvas.Pixels[i,j-1] := RGB(red div 9, green div 9, blue div 9);
      MyBitmap.Canvas.Pixels[i,j] := RGB(red div 9, green div 9, blue div 9);
      MyBitmap.Canvas.Pixels[i,j+1] := RGB(red div 9, green div 9, blue div 9);
      MyBitmap.Canvas.Pixels[i+1,j-1] := RGB(red div 9, green div 9, blue div 9);
      MyBitmap.Canvas.Pixels[i+1,j] := RGB(red div 9, green div 9, blue div 9);
      MyBitmap.Canvas.Pixels[i+1,j+1] := RGB(red div 9, green div 9, blue div 9);
      j := j+3;
    end;
    i := i+3;
  end;
  Image2.Picture.Bitmap.Assign(MyBitmap);
end;

procedure TForm1.MNIDiffuseClick(Sender: TObject);
var
  red : Integer;
  green : Integer;
  blue : Integer;
  rx : Integer;
  ry : Integer;
begin
  Image2.Picture.Bitmap.Assign(Image1.Picture.Bitmap);
  GetRgbp(Sender);


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -