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

📄 unit1.pas

📁 Delphi7编程80例(完全版)
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls,math, ComCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    Label1: TLabel;
    ListBox1: TListBox;
    Button2: TButton;
    Button3: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
Const
  MaxPixelCount = 32768;
Type
  TRGBTripleArray =Array [0..MaxPixelCount-1] Of TRGBTriple;
  pRGBTripleArray = ^TRGBTripleArray;
var rowout,rowin:PByteArray;
    i,j:integer;
    bitmap:TBitmap;
    star:cardinal;
 begin
Image2.repaint;
star:=GetTickCount;
bitmap:=TBitmap.Create;
bitmap.Assign(Image1.Picture.Bitmap);   //为位图赋与图像对象
bitmap.width:=Image1.Picture.width;
bitmap.height:=Image1.Picture.height;
bitmap.PixelFormat:=pf24bit;
//对于24色位图,宽度和高度不一定必须设置在pixelsformat之前,
//但待画位图的高度和宽度最好不要人为限定
For j := 0 To bitmap.Height-1 Do        //开始:控制图象显示的循环体;
 Begin
  RowOut:=Bitmap.Scanline[j];          //设置效果图中的扫描线
  RowIn :=Image1.Picture.Bitmap.Scanline[j];
  For i :=0 to 3*bitmap.width-1 Do      //乘以3是最后关键的杰作,当然也可以常识其他的数字;
 Begin
 Case ListBox1.ItemIndex Of
   0:RowOut[i+4]:=Rowin[i];                //这里的4也可改为其他的值,不同的整数值有不同的效果
   1:RowOut[i+j]:=Rowin[i];                //j表示位图的高度变量
   2:rowout[i]:=rowin[3*bitmap.width-i];   //水平反转,但颜色改变;
   3:rowout[i]:=rowin[i]+RGB(122,64,0);    //少许杂色效果,RGB()中的值可以任意设置
   4:rowout[i]:=Round((rowout[i]+rowout[i+1]+rowout[i+2])/3);  //三个临近的点之和然后相除得到灰度转换
   5:rowout[i]:=Round((rowout[i+2]+rowout[i+4])/6);  //明暗度设置,关键是除数(6)的值,值越大,就越暗
   6:rowout[i]:=rowout[i]-Random(100);
    //彩色电视雪花效果,Random的值越大效果越明显
    //rowout[i]的I不能换成J,这样会使图象中有一根彩色斜直线;
  end; //---case结束
  end; //i循环结束
end;//j循环结束
Image2.Picture.Graphic:=bitmap;  //绘制效果图
Image2.Canvas.Draw(0,0,bitmap);
form1.Caption :='Scanline的非凡效果------图象的转换时间是'+FloatToStr((GetTickCount-star)/1000)+'秒';
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
If SaveDialog1.Execute Then
  Image2.Picture.Bitmap.SaveToFile(SaveDialog1.FileName);  //将效果图保存
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  If OpenDialog1.Execute Then
   Begin
   Image1.Picture.LoadFromFile(OpenDialog1.Filename);  //载入文件
   Button1.Enabled:=True;
   end
  Else;
end;

end.

⌨️ 快捷键说明

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