computergraphicstest.pas

计算机图形图像学基础算法实验软件包

 begin
  Height:=20.0;Frequency:=0.03;XFirst:=-100;XLast:=240;Lastpoint:=1;
  XCenter:=350;YCenter:=100;
  //初始化记录最大和最小Y值的数组
  for Element:=1 to 800 do
  begin
  BiggestY[Element]:=0;SmallestY[Element]:=1000;
  end;
  for I:=-25 to 25   do
  begin
  Z:=I*5;
  XScreenAdjust:=XCenter+0.75*Z;     //产生轴测图的效果
  YScreenAdjust:=480-(YCenter+0.5*Z);//将计算的结果投影到屏幕的X，Y坐标上
for x:=XFirst to  XLast do
     begin
      Y:=Height*sin(Frequency*(0.02*X*X+0.01*Z*Z));
      Xscreen:=Trunc(XScreenAdjust+x);
      Yscreen:=Trunc(YScreenAdjust-y);
  if (YScreen>=SmallestY[XScreen]) and (YScreen<=BiggestY[XScreen])  then
  begin Lastpoint:=0;  goto XFinish;  end;
     if Lastpoint=0 then PenChanged:=1;
       LastPoint:=1;
  if YScreen<SmallestY[XScreen]  then  SmallestY[XScreen]:=YScreen;
          if BiggestY[XScreen]=0 then
  begin BiggestY[XScreen]:=YScreen;goto DrawSubprgram;end;
        if yscreen>BiggestY[XScreen] then BiggestY[XScreen]:=YScreen;
        Drawsubprgram:
   if    X=XFirst then    //移笔到新的位置
        begin  Canvas.MoveTo(XScreen,YScreen);PenChanged:=0;end Else
        Canvas.LineTo(XScreen,YScreen);  //由上一点画线到这一点
  XFinish:
    end;
 end;
end;

procedure TComputerGrapicsMainForm.ClearScreenClick(Sender: TObject);
begin
ComputerGrapicsMainForm.Invalidate;
end;

procedure TComputerGrapicsMainForm.SimpleTrangleFractal1Click(
  Sender: TObject);
var xa,ya,xb,yb,xc,yc,n:Integer;
  begin
    n:=13;
    xa:=10;ya:=10;
    xb:=100;yb:=10;
    xc:=10;yc:=200;
    Canvas.MoveTo(xa,ya);Canvas.LineTo(xb,yb);
    Canvas.LineTo(xc,yc);Canvas.LineTo(xa,ya);
 Trianglefractal(sender,xa,ya,xb,yb,xc,yc,n);
end;
procedure TComputerGrapicsMainForm.Trianglefractal(
 Sender: TObject;xa:Integer;ya:Integer;xb:Integer;yb:Integer;xc:Integer
 ;yc:Integer;n:Integer);
 var xp,yp,xq,yq,xr,yr:Integer;
 begin
 if n>0 then
 begin
 xp:=Trunc((xb+xc)/2);yp:=Trunc((yb+yc)/2);
 xq:=Trunc((xc+xa)/2);yq:=Trunc((yc+ya)/2);
 xr:=Trunc((xa+xb)/2);yr:=Trunc((ya+yb)/2);
  Canvas.MoveTo(xp,yp); Canvas.LineTo(xq,yq);
  Canvas.LineTo(xr,yr); Canvas.LineTo(xp,yp);
 Trianglefractal(sender,xa,ya,xr,yr,xq,yq,n-1);
 Trianglefractal(sender,xb,yb,xp,yp,xr,yr,n-1);
 Trianglefractal(sender,xc,yc,xq,yq,xp,yp,n-1);
 end;
 end;
procedure TComputerGrapicsMainForm.MappingTwodimensionalprojectivemapping1Click(
  Sender: TObject);
var u,v,x,y:Integer;
begin
   for u:=0 to 300 do
   begin
   for v:=0 to 300 do
   begin
    x:=Trunc(0.8*u+0.3*v);
    y:=Trunc(0.1*u+0.7*v);
  ImageChanged.Canvas.Pixels[x,y]:=ImageOriginal.Canvas.Pixels[u,v];
   end;
   end;
  end;
procedure TComputerGrapicsMainForm.MappingCylindermapping1Click(
  Sender: TObject);
var u,v,x,y:Integer;
angle,r,xx:single;
XYString:string;
begin
   r:=80.0;
   for u:=0 to 300 do
   begin
   for v:=0 to 300 do
   begin
      angle:=(u*3.14159/300);
      xx:=cos(angle)*r;
      x:=Trunc(xx);
      y:=v;
    ImageChanged.Canvas.Pixels[x,y]:=ImageOriginal.Canvas.Pixels[u,v];
   end;
end;
 end;
procedure TComputerGrapicsMainForm.ZBuffer1Click(Sender: TObject);
var  RetangleFrame,RetangleBuffer,TriangleFrame,TriangleBuffer,FinalBuffer: Array [0..32,0..32] of Integer;
     XRrangle: Array [0..32,0..1] of Single;
     x,y,k,l:Integer;
     XYString:string;
begin   //每条扫描线上三角形的交点坐标
       XRrangle[10,0]:=28.5; XRrangle[10,1]:=29.8;
       XRrangle[11,0]:=25.5; XRrangle[11,1]:=29.5;
       XRrangle[12,0]:=22.5; XRrangle[12,1]:=29.2;
       XRrangle[13,0]:=19.5; XRrangle[13,1]:=28.8;
       XRrangle[14,0]:=16.5; XRrangle[14,1]:=28.5;
       XRrangle[15,0]:=15.5; XRrangle[15,1]:=28.2;
       XRrangle[16,0]:=16.5; XRrangle[16,1]:=27.8;
       XRrangle[17,0]:=17.5; XRrangle[17,1]:=27.5;
       XRrangle[18,0]:=18.5; XRrangle[18,1]:=27.2;
       XRrangle[19,0]:=19.5; XRrangle[19,1]:=26.8;
       XRrangle[20,0]:=20.5; XRrangle[20,1]:=26.5;
       XRrangle[21,0]:=21.5; XRrangle[21,1]:=26.2;
       XRrangle[22,0]:=22.5; XRrangle[22,1]:=25.8;
       XRrangle[23,0]:=23.5; XRrangle[23,1]:=25.5;
       XRrangle[24,0]:=24.5; XRrangle[24,1]:=25.2;
//设置矩形框架和矩形帧缓存为零
      for x:=0 to 31 do
        for y:=0 to 31 do
      begin
        RetangleFrame[x,y]:=0;RetangleBuffer[x,y]:=0;
        TriangleBuffer[x,y]:=0; FinalBuffer[x,y]:=0;
      end;
//设置矩形框架和矩形帧缓存为四边形的值
      for x:=10 to 25 do
        for y:=5 to 25 do
      begin
        RetangleFrame[x,y]:=1;RetangleBuffer[x,y]:=10;
      end;
   for y:=10 to 24 do//计算扫描线与三角形的交点的中间值
     for x:=15 to 30 do
   begin
    if (x>=XRrangle[y,0]) and (x<= XRrangle[y,1])
    then TriangleBuffer[x,y]:=Trunc((-3*x-y+120)/4);
    XYString:=IntToStr(TriangleBuffer[x,y]);
    ShowMemo.Lines.add(XYString);//显示三角形的帧缓存值
   end;
       for x:=0 to 31 do
        for y:=0 to 31 do
      begin
         Finalbuffer[x,y]:=RetangleBuffer[x,y];
         if (TriangleBuffer[x,y]>RetangleBuffer[x,y]) then
         Finalbuffer[x,y]:=TriangleBuffer[x,y];
      end; //显示矩形与三角形相交的Z缓冲算法的效果图
     for x:=0 to 31 do
        for y:=0 to 31 do
          begin
          ImageChanged.Canvas.Pixels[x,31-y]:= RGB(FinalBuffer[x,y]*10+100,0,0);
          if FinalBuffer[x,y]=0 then  ImageChanged.Canvas.Pixels[x,31-y]:=ClWhite;
          if FinalBuffer[x,y]=10 then  ImageChanged.Canvas.Pixels[x,31-y]:=ClBlue;
          end;
        //以10倍放大比例显示矩形与三角形相交的Z缓冲算法的效果图
 for x:=0 to 31 do
        for y:=0 to 31 do
      begin
       for k:=1 to 10 do
       for l:=1 to 10 do
       begin
       ImageChanged.Canvas.Pixels[10*x+k,310-10*y+l]:= RGB(FinalBuffer[x,y]*15+10,100,100);
        if FinalBuffer[x,y]=0 then  ImageChanged.Canvas.Pixels[10*x+k,310-10*y+l]:=Clwhite;
            end;
        end;
  end;

procedure TComputerGrapicsMainForm.ClearChangedImage1Click(
  Sender: TObject);
begin
  ImageChanged.picture:=nil;
  TestImage1.Picture:=nil;
  TestImage2.Picture:=nil;
end;

procedure TComputerGrapicsMainForm.OpenOrignalImage1Click(Sender: TObject);
begin
 if OpenPictureDialog1.Execute then
    begin
    if not (ofExtensionDifferent in OpenPictureDialog1.Options) then
      ImageOriginal.Picture.LoadFromFile(OpenPictureDialog1.FileName);
    end;
end;

procedure TComputerGrapicsMainForm.BreifImageCompression1Click(
  Sender: TObject);
var  SubAreaRedColorValue,SubAreaGreenColorValue,
      w,h,i,j,n,SubAreaBlueColorValue:Integer;
begin
 n:=4;
 for W:=0 to Trunc(ImageOriginal.width/n)  do
      for H:=0 to Trunc(ImageOriginal.height/n) do
   begin
    SubAreaRedColorValue:=0;
    SubAreaGreenColorValue:=0;
    SubAreaBlueColorValue:=0;
   for i:=1 to n do
        for j:=1 to n do
    begin
    SubAreaRedColorValue:=SubAreaRedColorValue+GetRvalue(ImageOriginal.Canvas.Pixels[n*w+i,n*h+j]);//get red component of the color
    SubAreaGreenColorValue:=SubAreaGreenColorValue+GetGvalue(ImageOriginal.Canvas.Pixels[n*w+i,n*h+j]);//get green component of the color
    SubAreaBlueColorValue:=SubAreaBlueColorValue+GetBvalue(ImageOriginal.Canvas.Pixels[n*w+i,n*h+j]);//get blue component of the color
    end;
    SubAreaRedColorValue:=Trunc(SubAreaRedColorValue/(n*n));
    SubAreaGreenColorValue:=Trunc(SubAreaGreenColorValue/(n*n));
    SubAreaBlueColorValue:=Trunc(SubAreaBlueColorValue/(n*n));
    TestImage1.Canvas.Pixels[w,h]:=RGB(SubAreaRedColorValue,SubAreaGreenColorValue,SubAreaBlueColorValue);
end;
end;

procedure TComputerGrapicsMainForm.ImageAmplication1Click(Sender: TObject);
var  SubAreaRedColorValue,SubAreaGreenColorValue,
     w,h,i,j,Scale,SubAreaBlueColorValue:Integer;
begin
 Scale:=2;
 for W:=1 to   ImageOriginal.width-1  do
      for H:=1 to  ImageOriginal.height-1 do
   begin
   for i:=1 to scale do
        for j:=1 to scale do
    begin
   TestImage1.Canvas.Pixels[scale*w+i,scale*h+j]:=ImageOriginal.Canvas.Pixels[w,h];
    end;
  END;
   for W:=1 to   TestImage1.width-1  do
    for H:=1 to  TestImage1.height-1 do
   begin
    SubAreaRedColorValue:=0;
    SubAreaGreenColorValue:=0;
    SubAreaBlueColorValue:=0;
    SubAreaRedColorValue:=Trunc((GetRvalue(TestImage1.Canvas.Pixels[w-1,h])+
    GetRvalue(TestImage1.Canvas.Pixels[w+1,h])+GetRvalue(TestImage1.Canvas.Pixels[w,h-1])+
    GetRvalue(TestImage1.Canvas.Pixels[w,h+1]))/4);
    SubAreaGreenColorValue:=Trunc((GetGvalue(TestImage1.Canvas.Pixels[w-1,h])
    +GetGvalue(TestImage1.Canvas.Pixels[w+1,h])+GetGvalue(TestImage1.Canvas.Pixels[w,h-1])
    +GetGvalue(TestImage1.Canvas.Pixels[w,h+1]))/4);
    SubAreaBlueColorValue:=Trunc((GetBvalue(TestImage1.Canvas.Pixels[w-1,h])
    +GetBvalue(TestImage1.Canvas.Pixels[w+1,h])+GetBvalue(TestImage1.Canvas.Pixels[w,h-1])
    +GetBvalue(TestImage1.Canvas.Pixels[w,h+1]))/4);
    TestImage2.Canvas.Pixels[W,H]:=RGB(SubAreaRedColorValue,
    SubAreaGreenColorValue,SubAreaBlueColorValue);
   end;
end;

procedure TComputerGrapicsMainForm.DrawPointIndifferentcolor1Click(
  Sender: TObject);
var
 Number:Integer;
begin
  for number:=0 to 1500 do
  Canvas.Pixels[ Trunc(Random(800)), Trunc(Random(600))]:=
  RGB(Random(255),Random(255),Random(255));
end;

procedure TComputerGrapicsMainForm.IncreasePicturesLights1Click(
  Sender: TObject);
var
   bmp: TBITMAP;
   x, y, ScanlineBytes: Integer;
   p: prgbtriplearray;
   RVALUE, bvalue, gvalue: Integer;
   hVALUE, sVALUE, lVALUE: Integer;
begin
   self.DoubleBuffered := true; //设置双缓冲
   bmp := TBITMAP.Create;
   bmp.Assign(ImageOriginal.Picture.Bitmap); //加载位图
   bmp.PixelFormat := pf24bit;  //指定为24位
   p := bmp.ScanLine[0];
   ScanlineBytes := Integer(bmp.ScanLine[1]) - Integer(bmp.ScanLine[0]);
      for y := 0 to bmp.Height - 1 do
      begin
         for x := 0 to bmp.Width - 1 do
            begin
               //获取RGB的三个分量值，并进行赋值
               RVALUE := p[x].rgbtRed;
               gVALUE := p[x].rgbtGreen;
               bVALUE := p[x].rgbtBlue;
               // 调用前面的RGB转HSL过程，获取HSL三个分量值
               RGBtoHSL(RVALUE, gVALUE, bVALUE, hVALUE, sVALUE, lVALUE);
               //亮度值进行线性调节。
               lVALUE := lVALUE + 20;
               lVALUE := min(100, lVALUE);
               HSLtoRGB(hVALUE, sVALUE, lVALUE, rVALUE, gVALUE, bVALUE);
               p[x].rgbtRed := RVALUE;
               p[x].rgbtGreen := gVALUE;
               p[x].rgbtBlue := bVALUE;
            end;
         inc(Integer(p), ScanlineBytes);//指针递增
      end;
    ImageChanged.Picture.Bitmap.Assign(bmp);
   Bmp.Free;

end;
procedure TComputerGrapicsMainForm.RGBtoHSL(R, G, B: Integer; var H, S, L: Integer);
// RGB空间到HSL空间的转换
var
   Delta: Double;
   CMax, CMin: Double;
   Red, Green, Blue, Hue, Sat, Lum: Double;
begin
   Red := R / 255;
   Green := G / 255;
   Blue := B / 255;
   CMax := Max(Red, Max(Green, Blue));
   CMin := Min(Red, Min(Green, Blue));
   Lum := (CMax + CMin) / 2;
   if CMax = CMin then
      begin
         Sat := 0;
         Hue := 0;
      end
   else
      begin
         if Lum < 0.5 then
            Sat := (CMax - CMin) / (CMax + CMin)
         else
            Sat := (cmax - cmin) / (2 - cmax - cmin);
         delta := CMax - CMin;
         if Red = CMax then
            Hue := (Green - Blue) / Delta
         else if Green = CMax then
            Hue := 2 + (Blue - Red) / Delta
         else
            Hue := 4.0 + (Red - Green) / Delta;
         Hue := Hue / 6;
         if Hue < 0 then
            Hue := Hue + 1;
      end;
   H := Round(Hue * 360);
   S := Round(Sat * 100);