程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> Delphi像素級放大縮小圖片,調節亮度模塊

Delphi像素級放大縮小圖片,調節亮度模塊

編輯:Delphi

圖片的處理在Delphi中也算是較常見的方法,當然處理的方法也是很多的,今天的代碼主要是實現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.
  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved