relief.~pas

delphi图片处理-将图片转换为浮雕效果.

unit relief;

interface

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

type
  TForm1 = class(TForm)
    Imagerelief: TImage;
    GroupBox1: TGroupBox;
    BtnStart: TButton;
    BtnClose: TButton;
    procedure BtnStartClick(Sender: TObject);
    procedure BtnCloseClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BtnStartClick(Sender: TObject);
var
  x,y,i,j,red,green,blue: Integer;
  color1,color2: TColor;
begin
  x:=Imagerelief.Picture.Width;
  y:=Imagerelief.Picture.Height;
 { x := Imagerelief.width;
  y := Imagerelief.Height; }
  for i := 1 to x-2 do
    For j := 1 to y -2 do
    begin
      color1 := Imagerelief.Canvas.Pixels[i,j];
      color2 := Imagerelief.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
      else if Red<0 then
        Red := 0;
      if Green >255 then
        Green := 255
      else if Green<0 then
        Green := 0;
      if blue >255 then
        blue := 255
      else if blue<0 then
        blue := 0;
      Imagerelief.Canvas.Pixels[i,j] := rgb(red,green,blue);
    end;
end;


procedure TForm1.BtnCloseClick(Sender: TObject);
begin
  Close;
end;

end.