Delphi基本图像处理方法汇总

    本文实例汇总了Delphi基本图像处理方法。分享给大家供大家参考。具体分析如下:

    
    //浮雕
    procedure Emboss(SrcBmp,DestBmp:TBitmap;AzimuthChange:integer);overload;
    var
     i, j, Gray, Azimuthvalue, R, G, B: integer;
     SrcRGB, SrcRGB1, SrcRGB2, DestRGB: pRGBTriple;
    begin
     for i := 0 to SrcBmp.Height - 1 do
     begin
      SrcRGB := SrcBmp.ScanLine[i];
      DestRGB := DestBmp.ScanLine[i];
      if (AzimuthChange >= -180) and (AzimuthChange < -135) then
      begin
       if i > 0 then
        SrcRGB1 := SrcBmp.ScanLine[i-1]
       else
        SrcRGB1 := SrcRGB;
       Inc(SrcRGB1);
       SrcRGB2 := SrcRGB;
       Inc(SrcRGB2);
      end
      else if (AzimuthChange >= -135) and (AzimuthChange < -90) then
      begin
       if i > 0 then
        SrcRGB1 := SrcBmp.ScanLine[i-1]
       else
        SrcRGB1 := SrcRGB;
       SrcRGB2 := SrcRGB1;
       Inc(SrcRGB2);
      end
      else if (AzimuthChange >= -90) and (AzimuthChange < -45) then
      begin
       if i > 0 then
        SrcRGB1 := SrcBmp.ScanLine[i-1]
       else
        SrcRGB1 := SrcRGB;
       SrcRGB2 := SrcRGB1;
      end
      else if (AzimuthChange >= -45) and (AzimuthChange < 0) then
      begin
       SrcRGB1 := SrcRGB;
       if i > 0 then
        SrcRGB2 := SrcBmp.ScanLine[i-1]
       else
        SrcRGB2 := SrcRGB;
      end
      else if (AzimuthChange >= 0) and (AzimuthChange < 45) then
      begin
       SrcRGB2 := SrcRGB;
       if (i < SrcBmp.Height - 1) then
        SrcRGB1 := SrcBmp.ScanLine[i+1]
       else
        SrcRGB1 := SrcRGB;
      end
      else if (AzimuthChange >= 45) and (AzimuthChange < 90) then
      begin
       if (i < SrcBmp.Height - 1) then
        SrcRGB1 := SrcBmp.ScanLine[i+1]
       else
        SrcRGB1 := SrcRGB;
       SrcRGB2 := SrcRGB1;
      end
      else if (AzimuthChange >= 90) and (AzimuthChange < 135) then
      begin
       if (i < SrcBmp.Height - 1) then
        SrcRGB1 := SrcBmp.ScanLine[i+1]
       else
        SrcRGB1 := SrcRGB;
       SrcRGB2 := SrcRGB1;
       Inc(SrcRGB1);
      end
      else if (AzimuthChange >= 135) and (AzimuthChange <= 180) then
      begin
       if (i < SrcBmp.Height - 1) then
        SrcRGB2 := SrcBmp.ScanLine[i+1]
       else
        SrcRGB2 := SrcRGB;
       Inc(SrcRGB2);
       SrcRGB1 := SrcRGB;
       Inc(SrcRGB1);
      end;
      for j := 0 to SrcBmp.Width - 1 do
      begin
       if (AzimuthChange >= -180) and (AzimuthChange < -135) then
       begin
        Azimuthvalue := AzimuthChange + 180;
        R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;
        G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;
        B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;
       end
       else if (AzimuthChange >= -135) and (AzimuthChange < -90) then
       begin
        Azimuthvalue := AzimuthChange + 135;
        R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;
        G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;
        B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;
       end
       else if (AzimuthChange >= -90) and (AzimuthChange < -45) then
       begin
        if j=1 then Inc(SrcRGB1,-1);
        Azimuthvalue := AzimuthChange + 90;
        R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;
        G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;
        B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;
       end
       else if (AzimuthChange >= -45) and (AzimuthChange < 0) then
       begin
        if j=1 then
        begin
         Inc(SrcRGB1,-1);
         Inc(SrcRGB2,-1);
        end;
        Azimuthvalue := AzimuthChange + 45;
        R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;
        G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;
        B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;
       end
       else if (AzimuthChange >= 0) and (AzimuthChange < 45) then
       begin
        if j=1 then
        begin
         Inc(SrcRGB1,-1);
         Inc(SrcRGB2,-1);
        end;
        Azimuthvalue := AzimuthChange;
        R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;
        G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;
        B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;
       end
       else if (AzimuthChange >= 45) and (AzimuthChange < 90) then
       begin
        if j=1 then Inc(SrcRGB2,-1);
        Azimuthvalue := AzimuthChange - 45;
        R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;
        G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;
        B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;
       end
       else if (AzimuthChange >= 90) and (AzimuthChange < 135) then
       begin
        Azimuthvalue := AzimuthChange - 90;
        R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;
        G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;
        B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;
       end
       else if (AzimuthChange >= 135) and (AzimuthChange <= 180) then
       begin
        Azimuthvalue := AzimuthChange - 135;
        R:=SrcRGB.rgbtRed-((SrcRGB1.rgbtRed)*Azimuthvalue div 45)-((SrcRGB2.rgbtRed)*(45-Azimuthvalue) div 45)+78;
        G:=SrcRGB.rgbtGreen-((SrcRGB1.rgbtGreen)*Azimuthvalue div 45)-((SrcRGB2.rgbtGreen)*(45-Azimuthvalue) div 45)+78;
        B:=SrcRGB.rgbtBlue-((SrcRGB1.rgbtBlue)*Azimuthvalue div 45)-((SrcRGB2.rgbtBlue)*(45-Azimuthvalue) div 45)+78;
       end;
       R:=Min(R,255);
       R:=Max(R,0);
       G:=Min(G,255);
       G:=Max(G,0);
       B:=Min(B,255);
       B:=Max(B,0);
       Gray := (R shr 2) + (R shr 4) + (G shr 1) + (G shr 4) + (B shr 3);
       DestRGB.rgbtRed:=Gray;
       DestRGB.rgbtGreen:=Gray;
       DestRGB.rgbtBlue:=Gray;
       if (j=-180) and (AzimuthChange<-135)) or ((AzimuthChange>=90) and (AzimuthChange<=180))) then
       begin
        Inc(SrcRGB1);
       end;
       if (j=135) and (AzimuthChange<180)) or ((AzimuthChange>=-180) and (AzimuthChange<=-90))) then
       begin
        Inc(SrcRGB2);
       end;
       Inc(SrcRGB);
       Inc(DestRGB);
      end;
     end;
    end;
    procedure Emboss(Bmp:TBitmap;AzimuthChange:integer;ElevationChange:integer;WeightChange:integer);overload;
    var
     DestBmp:TBitmap;
    begin
      DestBmp:=TBitmap.Create;
      DestBmp.Assign(Bmp);
      Emboss(Bmp,DestBmp,AzimuthChange,ElevationChange,WeightChange);
      Bmp.Assign(DestBmp);
    end;
    //反色
    procedure Negative(Bmp:TBitmap);
    var
     i, j: Integer;
     PRGB: pRGBTriple;
    begin
     Bmp.PixelFormat:=pf24Bit;
     for i := 0 to Bmp.Height - 1 do
     begin
      PRGB := Bmp.ScanLine[i];
      for j := 0 to Bmp.Width - 1 do
      begin
       PRGB^.rgbtRed :=not PRGB^.rgbtRed ;
       PRGB^.rgbtGreen :=not PRGB^.rgbtGreen;
       PRGB^.rgbtBlue :=not PRGB^.rgbtBlue;
       Inc(PRGB);
      end;
     end;
    end;
    //曝光
    procedure Exposure(Bmp:TBitmap);
    var
     i, j: integer;
     PRGB: pRGBTriple;
    begin
     Bmp.PixelFormat:=pf24Bit;
     for i := 0 to Bmp.Height - 1 do
     begin
      PRGB := Bmp.ScanLine[i];
      for j := 0 to Bmp.Width - 1 do
      begin
       if PRGB^.rgbtRed<128 then
        PRGB^.rgbtRed :=not PRGB^.rgbtRed ;
       if PRGB^.rgbtGreen<128 then
        PRGB^.rgbtGreen :=not PRGB^.rgbtGreen;
       if PRGB^.rgbtBlue<128 then
        PRGB^.rgbtBlue :=not PRGB^.rgbtBlue;
       Inc(PRGB);
      end;
     end;
    end;
    //模糊
    procedure Blur(SrcBmp:TBitmap);
    var
     i, j:Integer;
     SrcRGB:pRGBTriple;
     SrcNextRGB:pRGBTriple;
     SrcPreRGB:pRGBTriple;
     Value:Integer;
     procedure IncRGB;
     begin
      Inc(SrcPreRGB);
      Inc(SrcRGB);
      Inc(SrcNextRGB);
     end;
     procedure DecRGB;
     begin
      Inc(SrcPreRGB,-1);
      Inc(SrcRGB,-1);
      Inc(SrcNextRGB,-1);
     end;
    begin
     SrcBmp.PixelFormat:=pf24Bit;
     for i := 0 to SrcBmp.Height - 1 do
     begin
      if i > 0 then
       SrcPreRGB:=SrcBmp.ScanLine[i-1]
      else
       SrcPreRGB := SrcBmp.ScanLine[i];
      SrcRGB := SrcBmp.ScanLine[i];
      if i < SrcBmp.Height - 1 then
       SrcNextRGB:=SrcBmp.ScanLine[i+1]
      else
       SrcNextRGB:=SrcBmp.ScanLine[i];
      for j := 0 to SrcBmp.Width - 1 do
      begin
       if j > 0 then DecRGB;
       Value:=SrcPreRGB.rgbtRed+SrcRGB.rgbtRed+SrcNextRGB.rgbtRed;
       if j > 0 then IncRGB;
       Value:=Value+SrcPreRGB.rgbtRed+SrcRGB.rgbtRed+SrcNextRGB.rgbtRed;
       if j < SrcBmp.Width - 1 then IncRGB;
       Value:=(Value+SrcPreRGB.rgbtRed+SrcRGB.rgbtRed+SrcNextRGB.rgbtRed) div 9;
       DecRGB;
       SrcRGB.rgbtRed:=value;
       if j > 0 then DecRGB;
       Value:=SrcPreRGB.rgbtGreen+SrcRGB.rgbtGreen+SrcNextRGB.rgbtGreen;
       if j > 0 then IncRGB;
       Value:=Value+SrcPreRGB.rgbtGreen+SrcRGB.rgbtGreen+SrcNextRGB.rgbtGreen;
       if j < SrcBmp.Width - 1 then IncRGB;
       Value:=(Value+SrcPreRGB.rgbtGreen+SrcRGB.rgbtGreen+SrcNextRGB.rgbtGreen) div 9;
       DecRGB;
       SrcRGB.rgbtGreen:=value;
       if j > 0 then DecRGB;
       Value:=SrcPreRGB.rgbtBlue+SrcRGB.rgbtBlue+SrcNextRGB.rgbtBlue;
       if j > 0 then IncRGB;
       Value:=Value+SrcPreRGB.rgbtBlue+SrcRGB.rgbtBlue+SrcNextRGB.rgbtBlue;
       if j < SrcBmp.Width - 1 then IncRGB;
       Value:=(Value+SrcPreRGB.rgbtBlue+SrcRGB.rgbtBlue+SrcNextRGB.rgbtBlue) div 9;
       DecRGB;
       SrcRGB.rgbtBlue:=value;
       IncRGB;
      end;
     end;
    end;
    //锐化
    procedure Sharpen(SrcBmp:TBitmap);
    var
     i, j: integer;
     SrcRGB: pRGBTriple;
     SrcPreRGB: pRGBTriple;
     Value: integer;
    begin
     SrcBmp.PixelFormat:=pf24Bit;
     for i := 0 to SrcBmp.Height - 1 do
     begin
      SrcRGB := SrcBmp.ScanLine[i];
      if i > 0 then
       SrcPreRGB:=SrcBmp.ScanLine[i-1]
      else
       SrcPreRGB:=SrcBmp.ScanLine[i];
      for j := 0 to SrcBmp.Width - 1 do
      begin
       if j = 1 then Dec(SrcPreRGB);
       Value:=SrcRGB.rgbtRed+(SrcRGB.rgbtRed-SrcPreRGB.rgbtRed) div 2;
       Value:=Max(0,Value);
       Value:=Min(255,Value);
       SrcRGB.rgbtRed:=value;
       Value:=SrcRGB.rgbtGreen+(SrcRGB.rgbtGreen-SrcPreRGB.rgbtGreen) div 2;
       Value:=Max(0,Value);
       Value:=Min(255,Value);
       SrcRGB.rgbtGreen:=value;
       Value:=SrcRGB.rgbtBlue+(SrcRGB.rgbtBlue-SrcPreRGB.rgbtBlue) div 2;
       Value:=Max(0,Value);
       Value:=Min(255,Value);
       SrcRGB.rgbtBlue:=value;
       Inc(SrcRGB);
       Inc(SrcPreRGB);
      end;
     end;
    end;
     [图像的旋转和翻转]
    以下代码用ScanLine配合指针移动实现,用于24位色!
    //旋转90度
    procedure Rotate90(const Bitmap:TBitmap);
    var
     i,j:Integer;
     rowIn,rowOut:pRGBTriple;
     Bmp:TBitmap;
     Width,Height:Integer;
    begin
     Bmp:=TBitmap.Create;
     Bmp.Width := Bitmap.Height;
     Bmp.Height := Bitmap.Width;
     Bmp.PixelFormat := pf24bit;
     Width:=Bitmap.Width-1;
     Height:=Bitmap.Height-1;
     for j := 0 to Height do
     begin
      rowIn := Bitmap.ScanLine[j];
      for i := 0 to Width do
      begin
       rowOut := Bmp.ScanLine[i];
       Inc(rowOut,Height - j);
       rowOut^ := rowIn^;
       Inc(rowIn);
      end;
     end;
     Bitmap.Assign(Bmp);
    end;
    //旋转180度
    procedure Rotate180(const Bitmap:TBitmap);
    var
     i,j:Integer;
     rowIn,rowOut:pRGBTriple;
     Bmp:TBitmap;
     Width,Height:Integer;
    begin
     Bmp:=TBitmap.Create;
     Bmp.Width := Bitmap.Width;
     Bmp.Height := Bitmap.Height;
     Bmp.PixelFormat := pf24bit;
     Width:=Bitmap.Width-1;
     Height:=Bitmap.Height-1;
     for j := 0 to Height do
     begin
      rowIn := Bitmap.ScanLine[j];
      for i := 0 to Width do
      begin
       rowOut := Bmp.ScanLine[Height - j];
       Inc(rowOut,Width - i);
       rowOut^ := rowIn^;
       Inc(rowIn);
      end;
     end;
     Bitmap.Assign(Bmp);
    end;
    //旋转270度
    procedure Rotate270(const Bitmap:TBitmap);
    var
     i,j:Integer;
     rowIn,rowOut:pRGBTriple;
     Bmp:TBitmap;
     Width,Height:Integer;
    begin
     Bmp:=TBitmap.Create;
     Bmp.Width := Bitmap.Height;
     Bmp.Height := Bitmap.Width;
     Bmp.PixelFormat := pf24bit;
     Width:=Bitmap.Width-1;
     Height:=Bitmap.Height-1;
     for j := 0 to Height do
     begin
      rowIn := Bitmap.ScanLine[j];
      for i := 0 to Width do
      begin
       rowOut := Bmp.ScanLine[Width - i];
       Inc(rowOut,j);
       rowOut^ := rowIn^;
       Inc(rowIn);
      end;
     end;
     Bitmap.Assign(Bmp);
    end;
    //任意角度
    function RotateBitmap(Bitmap:TBitmap;Angle:Integer;BackColor:TColor):TBitmap;
    var
     i,j,iOriginal,jOriginal,CosPoint,SinPoint : integer;
     RowOriginal,RowRotated : pRGBTriple;
     SinTheta,CosTheta : Extended;
     AngleAdd : integer;
    begin
     Result:=TBitmap.Create;
     Result.PixelFormat := pf24bit;
     Result.Canvas.Brush.Color:=BackColor;
     Angle:=Angle Mod 360;
     if Angle<0 then Angle:=360-Abs(Angle);
     if Angle=0 then
      Result.Assign(Bitmap)
     else if Angle=90 then
     begin
      Result.Assign(Bitmap);
      Rotate90(Result);//如果是旋转90度,直接调用上面的代码
     end
     else if (Angle>90) and (Angle<180) then
     begin
      AngleAdd:=90;
      Angle:=Angle-AngleAdd;
     end
     else if Angle=180 then
     begin
      Result.Assign(Bitmap);
      Rotate180(Result);//如果是旋转180度,直接调用上面的过程
     end
     else if (Angle>180) and (Angle<270) then
     begin
      AngleAdd:=180;
      Angle:=Angle-AngleAdd;
     end
     else if Angle=270 then
     begin
      Result.Assign(Bitmap);
      Rotate270(Result);//如果是旋转270度,直接调用上面的过程
     end
     else if (Angle>270) and (Angle<360) then
     begin
      AngleAdd:=270;
      Angle:=Angle-AngleAdd;
     end
     else
      AngleAdd:=0;
     if (Angle>0) and (Angle<90) then
     begin
     SinCos((Angle + AngleAdd) * Pi / 180, SinTheta, CosTheta);
     if (SinTheta * CosTheta) < 0 then
     begin
      Result.Width := Round(Abs(Bitmap.Width * CosTheta - Bitmap.Height * SinTheta));
      Result.Height := Round(Abs(Bitmap.Width * SinTheta - Bitmap.Height * CosTheta));
     end
     else
     begin
      Result.Width := Round(Abs(Bitmap.Width * CosTheta + Bitmap.Height * SinTheta));
      Result.Height := Round(Abs(Bitmap.Width * SinTheta + Bitmap.Height * CosTheta));
     end;
     CosTheta:=Abs(CosTheta);
     SinTheta:=Abs(SinTheta);
     if (AngleAdd=0) or (AngleAdd=180) then
     begin
      CosPoint:=Round(Bitmap.Height*CosTheta);
      SinPoint:=Round(Bitmap.Height*SinTheta);
     end
     else
     begin
      SinPoint:=Round(Bitmap.Width*CosTheta);
      CosPoint:=Round(Bitmap.Width*SinTheta);
     end;
     for j := 0 to Result.Height-1 do
     begin
      RowRotated := Result.Scanline[j];
      for i := 0 to Result.Width-1 do
      begin
       Case AngleAdd of
        0:
        begin
         jOriginal := Round((j+1)*CosTheta-(i+1-SinPoint)*SinTheta)-1;
         iOriginal := Round((i+1)*CosTheta-(CosPoint-j-1)*SinTheta)-1;
        end;
        90:
        begin
         iOriginal := Round((j+1)*SinTheta-(i+1-SinPoint)*CosTheta)-1;
         jOriginal := Bitmap.Height-Round((i+1)*SinTheta-(CosPoint-j-1)*CosTheta);
        end;
        180:
        begin
         jOriginal := Bitmap.Height-Round((j+1)*CosTheta-(i+1-SinPoint)*SinTheta);
         iOriginal := Bitmap.Width-Round((i+1)*CosTheta-(CosPoint-j-1)*SinTheta);
        end;
        270:
        begin
         iOriginal := Bitmap.Width-Round((j+1)*SinTheta-(i+1-SinPoint)*CosTheta);
         jOriginal := Round((i+1)*SinTheta-(CosPoint-j-1)*CosTheta)-1;
        end;
       end;
       if (iOriginal >= 0) and (iOriginal <= Bitmap.Width-1)and
         (jOriginal >= 0) and (jOriginal <= Bitmap.Height-1)
       then
       begin
        RowOriginal := Bitmap.Scanline[jOriginal];
        Inc(RowOriginal,iOriginal);
        RowRotated^ := RowOriginal^;
        Inc(RowRotated);
       end
       else
       begin
        Inc(RowRotated);
       end;
      end;
     end;
     end;
    end;
    //水平翻转
    procedure FlipHorz(const Bitmap:TBitmap);
    var
     i,j:Integer;
     rowIn,rowOut:pRGBTriple;
     Bmp:TBitmap;
     Width,Height:Integer;
    begin
     Bmp:=TBitmap.Create;
     Bmp.Width := Bitmap.Width;
     Bmp.Height := Bitmap.Height;
     Bmp.PixelFormat := pf24bit;
     Width:=Bitmap.Width-1;
     Height:=Bitmap.Height-1;
     for j := 0 to Height do
     begin
      rowIn := Bitmap.ScanLine[j];
      for i := 0 to Width do
      begin
       rowOut := Bmp.ScanLine[j];
       Inc(rowOut,Width - i);
       rowOut^ := rowIn^;
       Inc(rowIn);
      end;
     end;
     Bitmap.Assign(Bmp);
    end;
    //垂直翻转
    procedure FlipVert(const Bitmap:TBitmap);
    var
     i,j:Integer;
     rowIn,rowOut:pRGBTriple;
     Bmp:TBitmap;
     Width,Height:Integer;
    begin
     Bmp:=TBitmap.Create;
     Bmp.Width := Bitmap.Height;
     Bmp.Height := Bitmap.Width;
     Bmp.PixelFormat := pf24bit;
     Width:=Bitmap.Width-1;
     Height:=Bitmap.Height-1;
     for j := 0 to Height do
     begin
      rowIn := Bitmap.ScanLine[j];
      for i := 0 to Width do
      begin
       rowOut := Bmp.ScanLine[Height - j];
       Inc(rowOut,i);
       rowOut^ := rowIn^;
       Inc(rowIn);
      end;
     end;
     Bitmap.Assign(Bmp);
    end;
    [亮度、对比度、饱和度的调整]
    以下代码用ScanLine配合指针移动实现!
    function Min(a, b: integer): integer;
    begin
     if a < b then
      result := a
     else
      result := b;
    end;
    function Max(a, b: integer): integer;
    begin
     if a > b then
      result := a
     else
      result := b;
    end;
    //亮度调整
    procedure BrightnessChange(const SrcBmp,DestBmp:TBitmap;ValueChange:integer);
    var
     i, j: integer;
     SrcRGB, DestRGB: pRGBTriple;
    begin
     for i := 0 to SrcBmp.Height - 1 do
     begin
      SrcRGB := SrcBmp.ScanLine[i];
      DestRGB := DestBmp.ScanLine[i];
      for j := 0 to SrcBmp.Width - 1 do
      begin
       if ValueChange > 0 then
       begin
        DestRGB.rgbtRed := Min(255, SrcRGB.rgbtRed + ValueChange);
        DestRGB.rgbtGreen := Min(255, SrcRGB.rgbtGreen + ValueChange);
        DestRGB.rgbtBlue := Min(255, SrcRGB.rgbtBlue + ValueChange);
       end else begin
        DestRGB.rgbtRed := Max(0, SrcRGB.rgbtRed + ValueChange);
        DestRGB.rgbtGreen := Max(0, SrcRGB.rgbtGreen + ValueChange);
        DestRGB.rgbtBlue := Max(0, SrcRGB.rgbtBlue + ValueChange);
       end;
       Inc(SrcRGB);
       Inc(DestRGB);
      end;
     end;
    end;
    //对比度调整
    procedure ContrastChange(const SrcBmp,DestBmp:TBitmap;ValueChange:integer);
    var
     i, j: integer;
     SrcRGB, DestRGB: pRGBTriple;
    begin
     for i := 0 to SrcBmp.Height - 1 do
     begin
      SrcRGB := SrcBmp.ScanLine[i];
      DestRGB := DestBmp.ScanLine[i];
      for j := 0 to SrcBmp.Width - 1 do
      begin
       if ValueChange>=0 then
       begin
       if SrcRGB.rgbtRed >= 128 then
        DestRGB.rgbtRed := Min(255, SrcRGB.rgbtRed + ValueChange)
       else
        DestRGB.rgbtRed := Max(0, SrcRGB.rgbtRed - ValueChange);
       if SrcRGB.rgbtGreen >= 128 then
        DestRGB.rgbtGreen := Min(255, SrcRGB.rgbtGreen + ValueChange)
       else
        DestRGB.rgbtGreen := Max(0, SrcRGB.rgbtGreen - ValueChange);
       if SrcRGB.rgbtBlue >= 128 then
        DestRGB.rgbtBlue := Min(255, SrcRGB.rgbtBlue + ValueChange)
       else
        DestRGB.rgbtBlue := Max(0, SrcRGB.rgbtBlue - ValueChange);
       end
       else
       begin
       if SrcRGB.rgbtRed >= 128 then
        DestRGB.rgbtRed := Max(128, SrcRGB.rgbtRed + ValueChange)
       else
        DestRGB.rgbtRed := Min(128, SrcRGB.rgbtRed - ValueChange);
       if SrcRGB.rgbtGreen >= 128 then
        DestRGB.rgbtGreen := Max(128, SrcRGB.rgbtGreen + ValueChange)
       else
        DestRGB.rgbtGreen := Min(128, SrcRGB.rgbtGreen - ValueChange);
       if SrcRGB.rgbtBlue >= 128 then
        DestRGB.rgbtBlue := Max(128, SrcRGB.rgbtBlue + ValueChange)
       else
        DestRGB.rgbtBlue := Min(128, SrcRGB.rgbtBlue - ValueChange);
       end;
       Inc(SrcRGB);
       Inc(DestRGB);
      end;
     end;
    end;
    //饱和度调整
    procedure SaturationChange(const SrcBmp,DestBmp:TBitmap;ValueChange:integer);
    var 
     Grays: array[0..767] of Integer;
     Alpha: array[0..255] of Word;
     Gray, x, y: Integer;
     SrcRGB,DestRGB: pRGBTriple;
     i: Byte;
    begin
    ValueChange:=ValueChange+255;
    for i := 0 to 255 do
     Alpha[i] := (i * ValueChange) Shr 8;
    x := 0;
    for i := 0 to 255 do
    begin 
     Gray := i - Alpha[i];
     Grays[x] := Gray;
     Inc(x);
     Grays[x] := Gray;
     Inc(x);
     Grays[x] := Gray;
     Inc(x);
    end; 
    for y := 0 to SrcBmp.Height - 1 do
    begin
     SrcRGB := SrcBmp.ScanLine[Y];
     DestRGB := DestBmp.ScanLine[Y];
     for x := 0 to SrcBmp.Width - 1 do
     begin
      Gray := Grays[SrcRGB.rgbtRed + SrcRGB.rgbtGreen + SrcRGB.rgbtBlue];
      if Gray + Alpha[SrcRGB.rgbtRed]>0 then
       DestRGB.rgbtRed := Min(255,Gray + Alpha[SrcRGB.rgbtRed])
      else
       DestRGB.rgbtRed := 0;
      if Gray + Alpha[SrcRGB.rgbtGreen]>0 then
       DestRGB.rgbtGreen := Min(255,Gray + Alpha[SrcRGB.rgbtGreen])
      else
       DestRGB.rgbtGreen := 0;
      if Gray + Alpha[SrcRGB.rgbtBlue]>0 then
       DestRGB.rgbtBlue := Min(255,Gray + Alpha[SrcRGB.rgbtBlue])
      else
       DestRGB.rgbtBlue := 0;
      Inc(SrcRGB);
      Inc(DestRGB);
     end;
    end; 
    end;
    //RGB调整
    procedure RGBChange(SrcBmp,DestBmp:TBitmap;RedChange,GreenChange,BlueChange:integer);
    var
     SrcRGB, DestRGB: pRGBTriple;
     i,j:integer;
    begin
     for i := 0 to SrcBmp.Height- 1 do
     begin
      SrcRGB := SrcBmp.ScanLine[i];
      DestRGB :=DestBmp.ScanLine[i];
      for j := 0 to SrcBmp.Width - 1 do
      begin
       if RedChange> 0 then
        DestRGB.rgbtRed := Min(255, SrcRGB.rgbtRed + RedChange)
       else
        DestRGB.rgbtRed := Max(0, SrcRGB.rgbtRed + RedChange);
       if GreenChange> 0 then
        DestRGB.rgbtGreen := Min(255, SrcRGB.rgbtGreen + GreenChange)
       else
        DestRGB.rgbtGreen := Max(0, SrcRGB.rgbtGreen + GreenChange);
       if BlueChange> 0 then
        DestRGB.rgbtBlue := Min(255, SrcRGB.rgbtBlue + BlueChange)
       else
        DestRGB.rgbtBlue := Max(0, SrcRGB.rgbtBlue + BlueChange);
       Inc(SrcRGB);
       Inc(DestRGB);
      end;
     end;
    end;
    [颜色调整]
    //RGB<=>BGR
    procedure RGB2BGR(const Bitmap:TBitmap);
    var 
     X: Integer; 
     Y: Integer;
     PRGB: pRGBTriple;
     Color: Byte;
    begin
     for Y := 0 to (Bitmap.Height - 1) do
     begin
      for X := 0 to (Bitmap.Width - 1) do
      begin
       Color := PRGB^.rgbtRed;
       PRGB^.rgbtRed := PRGB^.rgbtBlue;
       PRGB^.rgbtBlue := Color;
       Inc(PRGB);
      end;
      end
     end;
    end;
    //灰度化(加权)
    procedure Grayscale(const Bitmap:TBitmap);
    var 
     X: Integer; 
     Y: Integer; 
     PRGB: pRGBTriple;
     Gray: Byte;
    begin
     for Y := 0 to (Bitmap.Height - 1) do
     begin
      PRGB := Bitmap.ScanLine[Y];
      for X := 0 to (Bitmap.Width - 1) do
      begin
       Gray := (77 * Red + 151 * Green + 28 * Blue) shr 8;
       PRGB^.rgbtRed:=Gray;
       PRGB^.rgbtGreen:=Gray;
       PRGB^.rgbtBlue:=Gray;
       Inc(PRGB);
      end;
     end;
    end;

    理论篇:

    关键词:

    绘图区-即窗口显示图像的区域,亦可为全屏幕(在全屏幕下绘图的效果比一般窗口下好)
    中心点-即要绘图区显示的中心点在原始图像的坐标(声明:这个概念特别重要)

    先说说图像的放大,要放大一张图片,我们一般的做法是直接放大图像,但本文介绍的方法仅放大我们能够看到的部分,放大分两种情况,一种是放大后比绘图区还要小,这种情况没什么好说,当然是显示全部的图像;第二种是放大后的图像比绘图区大,这才是我们今天要讨论的重点话题,这种情况下我们先要确定图像放大后的大小,然后根据“中心点”计算在原始图像的位置和大小,最后把截取的图像放大到绘图区。

    再说说图像的漫游,当显示的图像超过绘图区时,我们需要对图像进行漫游,以便看到全部的图像。原理是:当鼠标在绘图区进行单击时,这时开始漫游,先记录鼠标的单击位置,然后检测鼠标的移动,根据鼠标和上次的位移计算出“中心点”(需要将屏幕坐标转换为原始图像坐标),根据在上面放大的原理到原始图像中取出要显示的部分,放大显示到绘图区。

    算法实现篇:

    1.图像放大
    变量定义:
    PZoom:放大率(整数:100时为100%,根据需要可以将 100 该为 10000 或者更大些,但不推荐使用浮点数)
    a,b:中心点
    w,h:要截取原始图像的宽和高
    x,y:要截取的位置(左上角)
    sw,sh:原始图像的宽和高
    p1,p2:放大比例
    aw,ah:放大后图像的大小
    pw,ph:绘图区大小
    vx,vy:在绘图区显示的位置(左上角)
    vw,vh:在绘图区显示的大小
    ptx,pty:临时变量
    已知的变量:PZoom,(a,b),(sw,sh),(p1,p2),(aw,ah),(pw,ph)
    要计算的变量:(x,y),(w,h),(vx,vy),(vw,vh)
    开始计算:

    
    aw=Round(PZoom*sw/100);
    ah=Round(PZoom*sh/100);
    p1=aw/pw
    p2=ah/ph
    // 注:Round 用于取整,如其他语言的Int(),Fix()等
    if p1>1 then w=Round(sw/p1) else w=sw
    if p2>1 then h=Round(sh/p2) else h=sh
    // 注:shr 为右移运算符,可以使用“>>1”、“div 2”、“/2”或“Round(w/2)”代替
    x=a-w shr 1
    y=b-h shr 1
    // 注:div 为整除运算符
    ptx=(w*PZoom) div 100
    pty=(h*PZoom) div 100
    // 以下计算在绘图区显示的图像大小和位置

    变量

    
      Pencent:double; // 缩放比
      wx:double;    // 宽缩放比
      hx:double;    // 高缩放比
      // 获得缩放比
      wx:=pw/ptx
      hx:=ph/pty
      if wx>hx then Pencent:=hx
      else     Pencent:=wx;
      // 获得图片最后的大小
      vw:=Round(Pencent*ptx);
      vh:=Round(Pencent*pty);
      // 计算出图片的位置
      vx:=(pw-vw) div 2;
      vy:=(ph-vh) div 2;
    // ------------------------------------
    

    好了,两个重要的任务完成(x,y),(w,h),(vx,vy),(vw,vh)已经全部计算得出,下面的工作就是显示了,我们选择 Windows API 进行操作
    变量

    
    sDC 为原始图片的设备句柄(DC)
    tDC 为临时设备句柄
    dDC 最终设备句柄
    BitBlt(tDC,0,0,w,h,sDC,0,0,SRCCOPY);
    SetStretchBltMode(dDC,STRETCH_DELETESCANS);
    StretchBlt(dDC,0,0,vw,vh,tDC,0,0,w,h,SRCCOPY);

    最后绘制到显示的区域即可:
    例如:

    
    BitBlt(GetDC(0),vx,vy,vx+vw,xy+vh,dDC,0,0,SRCCOPY);

    2.图像漫游

    先定义三个全局变量:

    
    FBeginDragPoint  :TPoint;     // 记录鼠标开始拖动的位置
    FBeginDragSBPoint :TPoint;     // 记录“中心点”位置
    FBeginDrag    :boolean;    // 是否已经开始“拖动”
    a,b        :integer;    // “中心点”位置

    在鼠标左键点击时,记录鼠标的位置和“中心点”的位置,同时设置 FBeginDrag 为真
    当鼠标右键弹起时,设置 FBeginDrag 为假
    鼠标移动时,判断 FBeginDrag ,如果为假不进行处理,如果为真进行下面处理:
    假设 X,Y 为鼠标当前的位置

    
    a=FBeginDragPoint.X-((X-FBeginDragPoint.X)*100) div PZoom
    b=FBeginDragPoint.Y-((Y-FBeginDragPoint.Y)*100) div PZoom

    最后使用上面介绍的图像放大显示出图像

    技巧篇:

    1.如果图像较大,使用 delphi 的 位图对象会出现内存溢出错误,这时可以进行如下设置:

    
      bitImage:=TBitmap.Create;
      bitImage.PixelFormat:=pf24bit;
      bitImage.ReleaseHandle;

    2.如果要让图像自动适应窗口的大小,参考以下代码:

    
    var
      p1,p2    :double;
    begin
      p1:=pw/sw;
      p2:=ph/sw;
      if p1>p2 then PZoom:=Round(p2*100)
      else     PZoom:=Round(p1*100);
      if PZoom=0 then PZoom:=100;
    end;

    Delphi灰度图像像素颜色亮度处理

    在图像处理中,速度是很重要的。因此,我们得重新处理一下TBitmap,得到TVczhBitmap。这只是因为GetPixels和SetPixels的速度太慢,换一个方法而已。

    
      unit untBitmapProc;
      interface
      uses Graphics, SysUtils;
      type
      TVczhBitmap=class(TBitmap)
      private
      Data:PByteArray;
      Line:Integer;
      procedure SetFormat;
      function GetBytePointer(X,Y:Integer):PByte;
      procedure SetBytes(X,Y:Integer;Value:Byte);
      function GetBytes(X,Y:Integer):Byte;
      protected
      published
      constructor Create;
      public
      property Bytes[X,Y:Integer]:Byte read GetBytes write SetBytes;
      procedure LoadFromFile(FileName:String);
      procedure ToGray;
      end;
      implementation
      procedure TVczhBitmap.SetFormat;
      begin
      HandleType:=bmDIB;
      PixelFormat:=pf24bit;
      end;
      function TVczhBitmap.GetBytePointer(X,Y:Integer):PByte;
      begin
      if Line<>Y then
      begin
      Line:=Y;
      Data:=ScanLine[Y];
      end;
      Longint(result):=Longint(Data)+X;
      end;
      procedure TVczhBitmap.SetBytes(X,Y:Integer;Value:Byte);
      begin
      GetBytePointer(X,Y)^:=Value;
      end;
      function TVczhBitmap.GetBytes(X,Y:Integer):Byte;
      begin
      result:=GetBytePointer(X,Y)^;
      end;
      constructor TVczhBitmap.Create;
      begin
      inherited Create;
      SetFormat;
      Line:=-1;
      end;
      procedure TVczhBitmap.LoadFromFile(FileName:String);
      begin
      inherited LoadFromFile(FileName);
      SetFormat;
      Line:=-1;
      end;
      procedure TVczhBitmap.ToGray;
      var X,Y,R:Integer;
      B:Byte;
      begin
      for Y:=0 to Height-1 do
      for X:=0 to Width-1 do
      begin
      R:=0;
      for B:=0 to 2 do
      R:=R+GetBytes(X*3+B,Y);
      for B:=0 to 2 do
      SetBytes(X*3+B,Y,R div 3);
      end;
      end;
      end.

    此后,我们需要建立几个窗体。第一个用来显示图片,第二个用来处理图片,其他的窗体都继承自第二个窗体,包含实际的处理方法。

    先看第二个窗口:

    
      unit untProc;
      interface
      uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, ExtCtrls, untBitmapProc, StdCtrls, ComCtrls;
      type
      TfrmProcessor = class(TForm)
      pbBar: TPaintBox;
      gpProc: TGroupBox;
      Button1: TButton;
      procedure FormCreate(Sender: TObject);
      procedure FormDestroy(Sender: TObject);
      procedure FormShow(Sender: TObject);
      procedure pbBarPaint(Sender: TObject);
      procedure Button1Click(Sender: TObject);
      private
      { Private declarations }
      public
      { Public declarations }
      BarData:array[0..255]of Byte;
      Bar:TVczhBitmap;
      procedure DrawBar;
      end;
      var
      frmProcessor: TfrmProcessor;
      implementation
      {$R *.dfm}
      uses untViewer;
      procedure TfrmProcessor.DrawBar;
      var I:Integer;
      begin
      Bar.Canvas.FillRect(Bar.Canvas.ClipRect);
      Bar.Canvas.MoveTo(0,255-BarData[0]);
      for I:=1 to 255 do
      Bar.Canvas.LineTo(I,255-BarData[I]);
      end;
      procedure TfrmProcessor.FormCreate(Sender: TObject);
      begin
      Bar:=TVczhBitmap.Create;
      Bar.Width:=256;
      Bar.Height:=256;
      Bar.Canvas.Brush.Color:=clWhite;
      Bar.Canvas.Brush.Style:=bsSolid;
      end;
      procedure TfrmProcessor.FormDestroy(Sender: TObject);
      begin
      Bar.Free;
      end;
      procedure TfrmProcessor.FormShow(Sender: TObject);
      var I:Integer;
      begin
      for I:=0 to 255 do
      BarData[I]:=I;
      DrawBar;
      end;
      procedure TfrmProcessor.pbBarPaint(Sender: TObject);
      begin
      pbBar.Canvas.Draw(0,0,Bar);
      end;
      procedure TfrmProcessor.Button1Click(Sender: TObject);
      var X,Y:Integer;
      begin
      for Y:=0 to Buffer.Height-1 do
      for X:=0 to Buffer.Width*3-1 do
      Played.Bytes[X,Y]:=BarData[Buffer.Bytes[X,Y]];
      frmViewer.FormPaint(frmViewer);
      end;
      end.
    
    

    之后,做一个窗口继承自它,则调整BarData[]后,按Apply即可看到结果。

    现在开始将图像处理。具体效果见示例程序。
      
    一、颜色反转。

    灰度图像的颜色都是从0~255,所以,为了使颜色反转,我们可以用255减去该颜色值以得到反转后的颜色。

    
      var I:Integer;
      begin
      inherited;
      for I:=0 to 255 do
      BarData[I]:=255-I;//用255减去该颜色值
      DrawBar;
      pbBarPaint(pbBar);
      end;
    

    二、缩小颜色范围以增强或减弱亮度

    颜色本来是从0~255的。如果调节它的范围,例如从0~16,则会是图像明显变暗。我们可以把起始值设为a,把终止值设为b,则新的颜色值New=a+(b-1)*Old/255。这样做的话可以改变亮度,并且不会破坏原先颜色的顺序。代码如下

    
      var I:Integer;
      begin
      for I:=0 to 255 do
      BarData[I]:=(255-sbMin.Position)+Round((sbMin.Position-sbMax.Position)/255*I);
      DrawBar;
      pbBarPaint(pbBar);
      Button1Click(Button1);
      end;

    这里的sbMin.Position和sbMaxPosition都是反转过的。所以使用时要用255去减
      
    三、增加某个范围内的颜色范围

    如果图像本身的颜色范围很小的画,你可以通过这种方法来加大图像的对比度,有利于对图像的分析。具体做法:

    选取一个值a做为起始值,选取一个值b做为终止值,然后按以下公式变形:
      | 0 (X<=a)
      f(X)= | 255/(b-a)*(X-a)
      | 255(X>=b)

    
      var I:Integer;
      begin
      for I:=0 to 255 do
      begin
      if I<=sbMin.Position then
      BarData[I]:=0
      else if I>=sbMax.Position then
      BarData[I]:=255
      else
      BarData[I]:=Round(255/(sbMax.Position-sbMin.Position)*(I-sbMin.Position));
      end;
      DrawBar;
      pbBarPaint(pbBar);
      Button1Click(Button1);
      end;

    四、变为黑白图片

    在使用第三个功能的时候,你会发现当b<=a时,图像上的颜色除了黑色就是白色。这样操作的好处是不能直接显示出来的。这只要到了比较高级的图像处理如边缘检测等,才有作用。本例可以拿第三种方法的公式再变形,因此不作详细阐述。
      
    五、指数级亮度调整

    我们假设这个图的定义域是[0,1],值域也是[0,1]。那么,定义函数f(x)=x^c,则f(x)的图像有一段如上图。我们再用鼠标操作时,可以在上面取一点P(a,b),然后使f(x)通过点P,则c=ln(b)/ln(a)。有了c之后,我们就可以对颜色进行操作了:

    
      New=(Old/255)^c*255=exp(ln(old/255)*c)*255
      var ea,eb,ec:Extended;
      I:Integer;
      begin
      ea:=A/255;
      eb:=B/255;
      ec:=Ln(eb)/Ln(ea);
      for I:=1 to 255 do
      BarData[I]:=Round(Exp(Ln((I/255))*ec)*255);
      DrawBar;
      pbBarPaint(pbBar);
      Button1Click(Button1);
      end;

    这样做可以调节图像的亮度。

    Delphi图形显示特效的技巧

    概述

    —-目前在许多学习软件、游戏光盘中,经常会看到各种

    图形显示技巧,凭着图形的移动、交错、雨滴状、百页窗、积木堆叠等显现方式,使画面变得更为生动活泼,更 能吸引观众。本文将探讨如何在delphi中实现各种图形显示技巧。

    基本原理

    —-在delphi中,实现一副图象的显示是非常简单的,只要在form中定义一个timage组件,设置其picture属性,然后选 择任何有效的.ico、.bmp、.emf或.wmf文件,进行load,所选文 件就显示在timage组件中了。但这只是直接将图形显示在窗体中,毫无技巧可言。为了使图形显示具有别具一格的效果,可以按下列步骤实现:

    —-定义一个timage组件,把要显示的图形先装入到timage组件中,也就是说,把图形内容从磁盘载入内存中, 做为图形缓存。

    —-创建一新的位图对象,其尺寸跟timage组件中的图形一样。

    —-利用画布(canvas)的copyrect功能(将一个画布的矩形区域拷贝到另一个画布的矩形区域),使用技巧,动态形

    成位图文件内容,然后在窗体中显示位图。

    —-实现方法

    下面介绍各种图形显示技巧:

    1.推拉效果

    将要显示的图形由上、下、左、右方向拉进屏幕内显示,同时将屏幕上原来的旧图盖掉,此种效果可分为四种,上拉、下拉、左拉、右拉,但原理都差不多,以上拉 效果为例。

    原理:首先将放在暂存图形的第一条水平线,搬移至要显示的位图的最后一条,接着再将暂存图形的前两条水平线,依序搬移至要显示位图的最后两条水平线,然后搬移前三条、前四条叄?直到全部图形数据搬完为止。在搬移的过程中即可看到显示的位图由下而上浮起,而达到上拉的效果。

    程序算法:

    
    procedure tform1.button1click(sender: tobject); 
    var 
    newbmp: tbitmap; 
    i,bmpheight,bmpwidth:integer; 
    begin 
    newbmp:= tbitmap.create; 
    newbmp.width:=image1.width; 
    newbmp.height:=image1.height; 
    bmpheight:=image1.height; 
    bmpwidth:=image1.width; 
    for i:=0 to bmpheight do 
    begin 
    newbmp.canvas.copyrect(rect 
    (0,bmpheight-i,bmpwidth,bmpheight), 
    image1.canvas, 
    rect(0,0,bmpwidth,i)); 
    form1.canvas.draw(120,100,newbmp); 
    end; 
    newbmp.free; 
    end; 

    2.垂直交错效果

    原理:将要显示的图形拆成两部分,奇数条扫描线由上往下搬移,偶数条扫描线的部分则由下往上搬移,而且两者同时进行。从屏幕上便可看到分别由上下两端出现的较淡图形向屏幕中央移动,直到完全清楚为止。

    程序算法:

    
    procedure tform1.button4click(sender: tobject); 
    var 
    newbmp:tbitmap; 
    i,j,bmpheight,bmpwidth:integer; 
    begin 
    newbmp:= tbitmap.create; 
    newbmp.width:=image1.width; 
    newbmp.height:=image1.height; 
    bmpheight:=image1.height; 
    bmpwidth:=image1.width; 
    i:=0; 
    while i< =bmpheight do 
    begin 
    j:=i; 
    while j >0 do 
    begin 
    newbmp.canvas.copyrect(rect(0,j-1,bmpwidth,j), 
    image1.canvas, 
    rect(0,bmpheight-i+j-1,bmpwidth,bmpheight-i+j)); 
    newbmp.canvas.copyrect(rect 
    (0,bmpheight-j,bmpwidth,bmpheight-j+1), 
    image1.canvas, 
    rect(0,i-j,bmpwidth,i-j+1)); 
    j:=j-2; 
    end; 
    form1.canvas.draw(120,100,newbmp); 
    i:=i+2; 
    end; 
    newbmp.free; 
    end; 

    3.水平交错效果

    原理:同垂直交错效果原理一样,只是将分成两组后的图形分别由左右两端移进屏幕。

    程序算法:

    
    procedure tform1.button5click(sender: tobject); 
    var 
    newbmp:tbitmap; 
    i,j,bmpheight,bmpwidth:integer; 
    begin 
    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,0,bmpwidth-j+1,bmpheight), 
    image1.canvas, 
    rect(i-j,0,i-j+1,bmpheight)); 
    j:=j-2; 
    end; 
    form1.canvas.draw(120,100,newbmp); 
    i:=i+2; 
    end; 
    newbmp.free; 
    end;

    4.雨滴效果

    原理:将暂存图形的最后一条扫描线,依序搬移到可视位图的第一条到最后一条扫描线,让此条扫描线在屏幕上留下它的轨迹。接着再把暂存图形的倒数第二条扫描线,依序搬移到可视位图的第一条到倒数第二条扫描线。其余的扫描线依此类推。

    程序算法:

    
    procedure tform1.button3click(sender: tobject); 
    var 
    newbmp:tbitmap; 
    i,j,bmpheight,bmpwidth:integer; 
    begin 
    newbmp:= tbitmap.create; 
    newbmp.width:=image1.width; 
    newbmp.height:=image1.height; 
    bmpheight:=image1.height; 
    bmpwidth:=image1.width; 
    for i:=bmpheight downto 1 do 
    for j:=1 to i do 
    begin 
    newbmp.canvas.copyrect(rect(0,j-1,bmpwidth,j), 
    image1.canvas, 
    rect(0,i-1,bmpwidth,i)); 
    form1.canvas.draw(120,100,newbmp); 
    end; 
    newbmp.free; 
    end; 

    5.百叶窗效果

    原理:将放在暂存图形的数据分成若干组,然后依次从第一组到最后一组搬移,第一次每组各搬移第一条扫描线到可视位图的相应位置,第二次搬移第二条扫描线,接着搬移第三条、第四条扫描线.

    程序算法:

    
    procedure tform1.button6click(sender: tobject); 
    var 
    newbmp:tbitmap; 
    i,j,bmpheight,bmpwidth:integer; 
    xgroup,xcount:integer; 
    begin 
    newbmp:= tbitmap.create; 
    newbmp.width:=image1.width; 
    newbmp.height:=image1.height; 
    bmpheight:=image1.height; 
    bmpwidth:=image1.width; 
    xgroup:=16; 
    xcount:=bmpheight div xgroup; 
    for i:=0 to xcount do 
    for j:=0 to xgroup do 
    begin 
    newbmp.canvas.copyrect(rect 
    (0,xcount*j+i-1,bmpwidth,xcount*j+i), 
    image1.canvas, 
    rect(0,xcount*j+i-1,bmpwidth,xcount*j+i)); 
    form1.canvas.draw(120,100,newbmp); 
    end; 
    newbmp.free; 
    end; 

    6.积木效果

    原理:是雨滴效果的一种变化,不同之处在于,积木效果每次搬移的是一块图形,而不只是一根扫描线。

    程序算法:

    
    procedure tform1.button7click(sender: tobject); 
    var 
    newbmp:tbitmap; 
    i,j,bmpheight,bmpwidth:integer; 
    begin 
    newbmp:= tbitmap.create; 
    newbmp.width:=image1.width; 
    newbmp.height:=image1.height; 
    bmpheight:=image1.height; 
    bmpwidth:=image1.width; 
    i:=bmpheight; 
    while i>0 do 
    begin 
    for j:=10 to i do 
    begin 
    newbmp.canvas.copyrect(rect(0,j-10,bmpwidth,j), 
    image1.canvas, 
    rect(0,i-10,bmpwidth,i)); 
    form1.canvas.draw(120,100,newbmp); 
    end; 
    i:=i-10; 
    end; 
    newbmp.free; 
    end; 

    结束语

    上述图形显示效果均已上机通过。使用效果很好。
    用Delphi实现图像放大镜

    向窗体上添加两个TImage组件,其中一个TImage组件的Name属性设置为Image1,它充当原图片显示的载体。另一个TImage组件的Name属性设置为Image2,它可以显示放大后的图像。

    本例的核心是StretchBlt函数,利用StretchBlt函数实现局部图像放大,响应代码如下:

    
    procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    begin
     StretchBlt(Image2.Canvas.Handle,0,0,Image2.Width,Image2.Height,
     Image1.Canvas.Handle, X-20,Y-20,40,40,SRCCOPY);
     Image2.Refresh;
     Screen.Cursors[1]:=LoadCursorFromFile('MAGNIFY.CUR');
     Self.Cursor:=1;
    end;
    

    程序首先会调用StretchBlt函数,以鼠标当前位置作为中心点,以边长为40选中Image1组件上的局部图像,并放大此局部图像到Image2组件上。然后通过调用Image2组件的Refresh方法以刷新Image2组件的显示。最后设置鼠标指针为新的形状。

    程序代码如下:

    
    unit Unit1;
    interface
    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, ExtCtrls, StdCtrls;
    type
     TForm1 = class(TForm)
     Image1: TImage;
     Image2: TImage;
     procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
    private
     { Private declarations }
    public
     { Public declarations }
    end;
    var
     Form1: TForm1;
     implementation
     {$R *.dfm}
     procedure TForm1.Image1MouseMove(Sender:TObject;Shift:TShiftState;X,Y: Integer);
     begin
    StretchBlt(Image2.Canvas.Handle,0,0,Image2.Width,Image2.Height,Image1.Canvas.Handle, X-20,Y-20,40,40,SRCCOPY);
      Image2.Refresh;
      Screen.Cursors[1]:=LoadCursorFromFile('MAGNIFY.CUR');
      Self.Cursor:=1;
    end;
    procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
    begin
     Screen.Cursors[1]:=crDefault;
     Self.Cursor:=1;
    end;
    end.
    
    

    保存文件,然后按F9键运行程序,程序运行。
    放大图像是一个优秀的看图软件必备的功能,本实例提供了一种非常简便易行的方法,不但代码数量少,而且执行效率高。

    希望本文所述对大家的Delphi程序设计有所帮助。