unit1.~pas

双击可执行文件

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    OpenPictureDialog1: TOpenPictureDialog;
    SavePictureDialog1: TSavePictureDialog;
    GroupBox2: TGroupBox;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn5: TBitBtn;
    Bevel1: TBevel;
    Image1: TImage;
    Edit1: TEdit;
    XPManifest1: TXPManifest;
    BitBtn6: TBitBtn;
    BitBtn7: TBitBtn;
    Procedure Exc(bool : boolean);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure BitBtn7Click(Sender: TObject);
  private
    { Private declarations }
  public
    bmp : Tbitmap;

    { Public declarations }
  end;

var
  Form1: TForm1;
  SaveField : String;
  ipp : Integer=0;

implementation

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  x,y,i,j,red,green,blue: Integer;
  color1,color2: TColor;
begin
  if (Extractfileext(OpenPictureDialog1.FileName)='.bmp') then
  begin
  x:=Image1.Picture.Width;
  y:=Image1.Picture.Height;
  for i := 1 to x-2 do
    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
      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;
      Image1.Canvas.Pixels[i,j] := rgb(red,green,blue);
    end;

    bmp := image1.Picture.Bitmap;
  end
  else
    showmessage('图片只能为.bmp格式的图片。');
  ipp := 1;
  BitBtn7.Enabled := True;
end;


procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  Image1.Picture.Assign(nil);
  OpenPictureDialog1.InitialDir:='.\图片\';
  if OpenPictureDialog1.Execute then
  begin
    Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
    Exc(True);
    BitBtn3.Enabled := False;
    if (UpperCase(ExtractFileExt(OpenPictureDialog1.FileName))='.JPG')or(UpperCase(ExtractFileExt(OpenPictureDialog1.FileName))='.jpeg') then
    begin
      Exc(False);
      BitBtn3.Enabled := True;
    end;
  end
  else
    Exc(False);
  ipp := 0;
  BitBtn7.Enabled := False;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
var
  ImageBmp : TBitmap;
  ImageJPG : TJPEGImage;
begin
  ImageBmp := TBitmap.Create;
  ImageJPG := TJPEGImage.Create;
  Image1.Visible := True;
  if Extractfileext(OpenPictureDialog1.FileName)='.jpg' then
  begin
      ImageJPG.LoadFromFile(OpenPictureDialog1.FileName);
      ImageBmp.Assign(ImageJPG);
      if SavePictureDialog1.Execute then
      begin
        ImageBmp.SaveToFile(SavePictureDialog1.FileName+'.bmp');
        SaveField := SavePictureDialog1.FileName+'.bmp';
        Image1.Picture.LoadFromFile(SaveField);
      end;
  end;
  ImageBmp.Free;
  ImageJPG.Free;
  ipp := 0;
  BitBtn7.Enabled := False;
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
var
  ImageBmp : TBitmap;
  ImageJPG : TJPEGImage;
begin
  ImageBmp := TBitmap.Create;
  ImageJPG := TJPEGImage.Create;
  Image1.Visible := True;
  if Extractfileext(OpenPictureDialog1.FileName)='.bmp' then
  begin
      ImageBmp.LoadFromFile(OpenPictureDialog1.FileName);
      ImageJPG.Assign(ImageBmp);
      if SavePictureDialog1.Execute then
      begin
        ImageJPG.SaveToFile(SavePictureDialog1.FileName+'.jpg');
        Image1.Picture.LoadFromFile(SavePictureDialog1.FileName+'.jpg');
      end;
  end;
  ImageBmp.Free;
  ImageJPG.Free;
  ipp := 0;
  BitBtn7.Enabled := False;
end;


procedure TForm1.BitBtn5Click(Sender: TObject);
var
  newbmp:Tbitmap;
  i,j,bmpheight,bmpwidth:integer;
begin
  if Extractfileext(OpenPictureDialog1.FileName)='.bmp' then
  begin
  //加上这段代码，虽然可以在水平交错时显示完整的图片，但图片会失帧
  { newbmp:= Tbitmap.Create;
    bitmap := Tbitmap.Create;
    bitmap.LoadFromFile(OpenPictureDialog1.FileName);
    bitmap.Width:=trunc(Image1.Width);
    bitmap.Height:=trunc(Image1.Height);
    Image1.Stretch := False;
    Image1.AutoSize := True;
    stretchblt(bitmap.Canvas.Handle,0,0,bitmap.Width,bitmap.Height,
         image1.Picture.Bitmap.Canvas.Handle,0,0,image1.Width,image1.height,srccopy);
    image1.Picture.Bitmap.Assign(bitmap);
    Image1.AutoSize := False;
    Image1.Stretch := True;
    Image1.Width := bitmap.Width;
    Image1.Height := bitmap.Height;
  }
  newbmp:= TBitmap.Create;
  newbmp.Width:=image1.Width;
  newbmp.Height:=image1.Height;
  bmpheight:=image1.Height;
  bmpwidth:=image1.Width;
  i:=0;
  while i<=bmpwidth do
  begin
    j:=i;
    while j >0 do
    begin
      newbmp.Canvas.CopyRect(Rect(j-1,0,j,bmpheight),image1.Canvas,
                      Rect(bmpwidth-i+j-1,0,bmpwidth-i+j,bmpheight));

      newbmp.Canvas.CopyRect(Rect(bmpwidth-j-1,0,bmpwidth-j,bmpheight),
                      image1.Canvas,Rect(i-j,0,i-j+1,bmpheight));
      j:=j-2;
      Application.ProcessMessages;
    end;
    form1.Canvas.Draw(18,28,newbmp);
    i:=i+2;
  end;
  newbmp.free;
  end;
  ipp := 0;
  BitBtn7.Enabled := False;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  SavePictureDialog1.Filter := '';
  bmp := TBitmap.Create;
  BitBtn2.SetFocus;
  Exc(False);
end;

procedure TForm1.BitBtn6Click(Sender: TObject);
var
   dHight,dWidth : Integer;
begin
  dHight:=image1.Height;
  dwidth:=image1.Width;
  form1.Canvas.CopyRect(rect(dwidth+18,dHight+28,18,28),Image1.Canvas,rect(0,0,dWidth,dHight));
  bmp.Width := dwidth;
  bmp.Height := dHight;
  bmp.Canvas.CopyRect(ClientRect,form1.Canvas,rect(18,28,dwidth+170,dHight+80));
  ipp := 1;
  BitBtn7.Enabled := True;
end;

procedure TForm1.Exc(bool: boolean);
var
  i : Integer;
begin
  for i:=0 to GroupBox2.ControlCount-1 do   //对窗体中的所有组件进行循环
  begin
    if GroupBox2.Controls[i].ClassNameIs('TBitBtn') then   //判断当前组件是否为TDBEdit组件
      //将所有TDBEdit组件连接数据源
      TBitBtn(GroupBox2.Controls[i]).Enabled := bool;
  end;
  BitBtn2.Enabled := True;
end;

procedure TForm1.BitBtn7Click(Sender: TObject);
begin
  if ipp = 1 then
  if SavePictureDialog1.Execute then
  begin
    bmp.SaveToFile(SavePictureDialog1.FileName+'.bmp');
  end;
  BitBtn7.Enabled := False;
end;

end.