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

📄 unit1.pas

📁 Delphi7应用编程150例附书源码.rar
💻 PAS
字号:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    btnOpen: TButton;
    Image1: TImage;
    OpenPictureDialog1: TOpenPictureDialog;
    procedure btnOpenClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  MyBitmap:TBitmap;

implementation

{$R *.dfm}

procedure TForm1.btnOpenClick(Sender: TObject);
var
   Color1,Color2:TColor;
   red:Integer;
   green:Integer;
   blue:Integer;
   i,j:Integer;
   x,y:Integer;
begin
    if self.OpenPictureDialog1.Execute then
    begin
       Image1.Picture.LoadFromFile(self.OpenPictureDialog1.FileName);
       MyBitmap.LoadFromFile(self.OpenPictureDialog1.FileName);
       x:=Image1.Picture.Width;
       y:=Image1.Picture.Height;
       for i:=1 to x-2 do
       begin
            for j:=1 to y-2 do
            begin
                Color1:=Image1.Canvas.Pixels[i,j];
                Color2:=Image1.Canvas.Pixels[i+1,j+1];

                red:=abs(GetRValue(Color1)-GetRValue(Color2)+128);
                green:=abs(GetGValue(Color1)-GetGValue(Color2)+128);
                blue:=abs(GetBValue(Color1)-GetBValue(Color2)+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;
        Image1.Picture.Bitmap.Assign(MyBitmap);
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    MyBitmap:=TBitmap.Create;
    Image1.AutoSize:=false;
    Image1.Stretch:=true;  
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    MyBitmap.Free;
end;

end.

⌨️ 快捷键说明

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