delphi 图像旋转90° 反旋转90°


本文整理自网络,侵删。

 
//旋转90°
procedure Rotate(Bitmap: TBitmap);
type
  THelpRGB = packed record
    rgb: TRGBTriple;
    dummy: byte;
  end;
 
  pRGBArray = ^TRGBArray;
  TRGBArray = array[0..32767] of TRGBTriple;
var
  aStream: TMemorystream;
  //内存流
  header: TBITMAPINFO;
  dc: hDC;
  P: ^THelpRGB;
  x, y, b, h: Integer;
  RowOut: pRGBArray;
begin
  //创建内存流
  aStream := TMemoryStream.Create;
  //设置大小,必须是4的倍数
  aStream.SetSize(Bitmap.Height * Bitmap.Width * 4);
  with header.bmiHeader do //操作位图文件
  begin
    biSize := SizeOf(TBITMAPINFOHEADER); //大小
    biWidth := Bitmap.Width; //位图宽
    biHeight := Bitmap.Height; //位图高
    biPlanes := 1;
    biBitCount := 32;
    //无压缩
    biCompression := 0;
    biSizeimage := aStream.Size;
    biXPelsPerMeter := 1; //水平分辨率
    biYPelsPerMeter := 1; //竖直分辨率
    biClrUsed := 0;
    biClrImportant := 0;
  end;
  dc := GetDC(0);
  P := aStream.Memory;
  GetDIBits(dc, Bitmap.Handle, 0, Bitmap.Height, P, header, dib_RGB_Colors);
  ReleaseDC(0, dc);
  b := bitmap.Height; //源图高
  h := bitmap.Width; //源图宽
  //指定要创建的位图的大小尺寸
  bitmap.Width := b;
  bitmap.height := h;
  for y := 0 to (h - 1) do
  begin
    rowOut := Bitmap.ScanLine[y]; //获取新的位图信息
    P := aStream.Memory; //设置文件指针
    inc(p, y); //指针移位
    for x := 0 to (b - 1) do
    begin
      rowout[x] := p^.rgb; //进行数据转移
      inc(p, h);
    end;
  end;
  aStream.Free; //释放资源
end;
 

后面这个不好找 


//反向旋转90°
procedure Rotate2(aBitmap: TBitmap);
var
  nIdx, nOfs,
  x, y, i, nMultiplier: integer;
  nMemWidth, nMemHeight, nMemSize, nScanLineSize: LongInt;
  aScnLnBuffer: PChar;
  aScanLine: PByteArray;
begin
  nMultiplier := 3;
  nMemWidth := aBitmap.Height;
  nMemHeight := aBitmap.Width;
  //实际需要内存大小
  nMemSize := nMemWidth * nMemHeight * nMultiplier;
  //开辟内存
  GetMem(aScnLnBuffer, nMemSize);
  try
    //Scanline的长度
    nScanLineSize := aBitmap.Width * nMultiplier;
    //为ScanLine分配内存
    GetMem(aScanLine, nScanLineSize);
    try
      for y := 0 to aBitmap.Height - 1 do
      begin
        //进行数据块的移动
        Move(aBitmap.ScanLine[y]^, aScanLine^, nScanLineSize);
        for x := 0 to aBitmap.Width - 1 do
        begin
          nIdx := ((aBitmap.Width - 1) - x) * nMultiplier;
          nOfs := (x * nMemWidth * nMultiplier) + (y * nMultiplier);
          for i := 0 to nMultiplier - 1 do
            Byte(aScnLnBuffer[nOfs + i]) := aScanLine[nIdx + i];
        end;
      end;
      //宽和高交换开始,逆时针旋转
      aBitmap.Height := nMemHeight;
      aBitmap.Width := nMemWidth;
      for y := 0 to nMemHeight - 1 do
      begin
        //数据移动
        nOfs := y * nMemWidth * nMultiplier;
        Move((@(aScnLnBuffer[nOfs]))^, aBitmap.ScanLine[y]^, nMemWidth *
          nMultiplier);
      end;
    finally
      //释放内存aScanLine
      FreeMem(aScanLine, nScanLineSize);
    end;
  finally
    //释放内存aScnLnBuffer
    FreeMem(aScnLnBuffer, nMemSize);
  end;
end;

相关阅读 >>

Delphi 的webbrowser如何全选并复制浏览器上的文字

Delphi创建桌面快捷方式及锁定任务栏等功能

Delphi 快速获取文件大小(使用_lopen和fileseek,此函数可以快速获取文件大小,即使文件已经被其它程序锁定)

Delphi webbrowser设置自己定义user-agent

Delphi 世界时间转换

Delphi使用edge browser浏览器组件

Delphi xe7组件tetheringmanager1发送消息

Delphi清空回收站

Delphi tms web core 从js调用pascal函数

Delphi winsock 获取计算机名和ip

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...