2017年9月7日 星期四

Delphi像素级放大缩小图片,调节亮度模块

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
  Forms,Dialogs, ExtDlgs, ExtCtrls, Menus,math, Gauges, ComCtrls;
type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    Image1: TImage;
    OpenPictureDialog1: TOpenPictureDialog;
    SavePictureDialog1: TSavePictureDialog;
    Gauge1: TGauge;
    procedure N2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
  i,j: integer;
  PAOld: Array[0..5000,0..5000] of integer;
  PANew: Array[0..10000,0..10000] of integer;
implementation
{$R *.dfm}
//**************************************************************
//象素扩大
procedure Zoom(Bmp: TBitmap;Gauge: TGauge);
begin
  for i :=0 to Bmp.Width do
    begin
      for j :=0 to Bmp.Height do
        begin
          PAOld[i,j] := GetRValue(Bmp.Canvas.Pixels[i,j]);
          PANew[2 * i,2 * j] := PAOld[i,j];
        end;
      Gauge.Progress := (i + 1) * 35 div Bmp.Width;
    end;
   
end;
//*************************************************************
//插值横向
procedure Insert_x(Bmp: TBitmap;Gauge: TGauge);
begin
  for i:=0 to Bmp.Width do
    begin
      for j:=0 to Bmp.Height do
        if j mod 2 <> 0 then
          begin
            PANew[i,j] := Floor((PANew[i,j - 1] + PANew[i,j + 1])/2);
          end;
      Gauge.Progress := 35 + (i + 1) * 10 div Bmp.Width;
    end;
end;
//**************************************************************
//插值纵向
procedure Insert_y(Bmp: TBitmap;Gauge: TGauge);

begin
  for i := 0 to Bmp.Width do
    begin
     for j := 0 to Bmp.Height do
       begin
         if i mod 2 = 1 then
           PANew[i,j] := Floor((PANew[i - 1,j] + PANew[i + 1,j])/2);
         Bmp.Canvas.Pixels[i,j] := RGB(PANew[i,j],PANew[i,j],PANew[i,j]);
       end;
     Gauge.Progress := 45 + (i + 1) * 55 div Bmp.Width;
    end;
end;
//**************************************************************
//打开图片
procedure TForm1.N2Click(Sender: TObject);
begin
  if OpenPictureDialog1.Execute then
    Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;
//**************************************************************
procedure TForm1.N4Click(Sender: TObject);
begin
  Close;
end;
//**************************************************************
//图像灰度处理
procedure TForm1.N6Click(Sender: TObject);
var
  rgb1: TColor;
  f,r,g,b: byte;
begin
  for i := 0 to Image1.Picture.Width do
    for j := 0 to Image1.Picture.Height do
      begin
        rgb1:=form1.Image1.Canvas.Pixels[i,j];
        r := GetRValue(rgb1);
        g := GetGValue(rgb1);
        b := GetBValue(rgb1);
        f := floor(0.3 * r + 0.59 * g + 0.11 * b);
        Image1.Canvas.Pixels[i,j] := RGB(f,f,f);
        Gauge1.Progress := (i + 1) * 100 div Image1.Picture.Width;
      end;
end;
//**************************************************************
//二倍放大
procedure TForm1.N7Click(Sender: TObject);
var
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  Bmp.Width := 2 * Image1.Picture.Width;
  Bmp.Height := 2 * Image1.Picture.Height;
  Zoom(Image1.Picture.Bitmap,Gauge1);
  Insert_x(Bmp,Gauge1);
  Insert_y(Bmp,Gauge1);
  Image1.Picture.Bitmap := Bmp;
end;
//***************************************************************
//四倍放大
procedure TForm1.N8Click(Sender: TObject);
var
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  Bmp.Width := 2 * Image1.Picture.Width;
  Bmp.Height := 2 * Image1.Picture.Height;
  Zoom(Image1.Picture.Bitmap,Gauge1);
  Insert_x(Bmp,Gauge1);
  Insert_y(Bmp,Gauge1);
  Image1.Picture.Bitmap := Bmp;
  Bmp.Width := 2 * Image1.Picture.Width;
  Bmp.Height := 2 * Image1.Picture.Height;
  Zoom(Image1.Picture.Bitmap,Gauge1);
  Insert_x(Bmp,Gauge1);
  Insert_y(Bmp,Gauge1);
  Image1.Picture.Bitmap := Bmp;
end;
//**************************************************************
//保存图片
procedure TForm1.N3Click(Sender: TObject);
begin
  if SavePictureDialog1.Execute then
  Image1.Picture.Bitmap.SaveToFile(SavePictureDialog1.FileName);
end;
//***************************************************************
//图片变亮
procedure TForm1.N9Click(Sender: TObject);
var
  rgb1: TColor;
  r,g,b: Byte;
begin
  for i := 0 to Image1.Picture.Width - 1 do
    for j := 0 to Image1.Picture.Height - 1 do
      begin
        rgb1 := Image1.Canvas.Pixels[i,j];
        if GetRValue(rgb1) + 6 < 255 then
          r := GetRValue(rgb1) + 6;
        if GetGValue(rgb1) + 6 < 255 then
          g := GetGValue(rgb1) + 6;
        if GetBValue(rgb1) + 6 < 255 then
          b := GetBValue(rgb1) + 6;
        Image1.Canvas.Pixels[i,j] := RGB(r,g,b);
      end;
end;
//***************************************************************
//图片变暗
procedure TForm1.N10Click(Sender: TObject);
var
  rgb1: TColor;
  r,g,b: Byte;
begin
  for i := 0 to Image1.Picture.Width - 1 do
    for j := 0 to Image1.Picture.Height - 1 do
      begin
        rgb1 := Image1.Canvas.Pixels[i,j];
        if GetRValue(rgb1) - 6 > 0 then
          r := GetRValue(rgb1) - 6;
        if GetGValue(rgb1) - 6 > 0 then
          g := GetGValue(rgb1) - 6;
        if GetBValue(rgb1) - 6 > 0 then
          b := GetBValue(rgb1) - 6;
        Image1.Canvas.Pixels[i,j] := RGB(r,g,b);
      end;
end;
end.

沒有留言:

張貼留言