初步實作了旋轉（任意角度，順時針/逆時針方向），固定角度旋轉（90、180、270度，順時針/逆時針方向），翻轉，鏡像等功能，轉換速度還可以。
也可能存在某些BUGs，有時間的可以測驗一下。
{ VCL TBitmap Helper }
{ Supplemental methods to TBitmap for supporting }
{ rotate, flip, mirror, etc. }
{ version 0.01 }
{ written by DG, 2020-03-14 }
unit Vcl.Graphics.BitmapHelper;
interface
uses Vcl.Graphics;
type
TDirection = (dir90, dir180, dir270);
TBitmapHelper = class helper for Vcl.Graphics.TBitmap
procedure Rotate(Rads: single; Clockwise: boolean = false;
AdjustSize: boolean = true; BkColor: TColor = clWhite); overload;
procedure Rotate(Direction: TDirection; Clockwise: boolean = false); overload;
procedure Flip; inline;
procedure Mirror; inline;
procedure FlipAndMirror; inline;
end;
implementation
uses System.Classes, WinApi.Windows;
// --------------------------------------------------------------------------
// TBitmapHelper
// the function TBitmapHelper.Rotate(Rads: single; ...) references to
// following STACKOVERFLOW thread:
// https://stackoverflow.com/questions/10633400/rotate-bitmap-by-real-angle
procedure TBitmapHelper.Rotate(Rads: single; Clockwise: boolean = false;
AdjustSize: boolean = true; BkColor: TColor = clWhite);
var
C: Single;
S: Single;
Tmp: Vcl.graphics.TBitmap;
OffsetX: Single;
OffsetY: Single;
Points: array[0..2] of TPoint;
begin
if not Clockwise then // counterclockwise
begin
Rads := Frac(Rads / PI * PI);
if Rads < 0 then
Rads := PI * 2 + Rads
else
Rads := PI * 2 - Rads;
end;
C := Cos(Rads);
S := Sin(Rads);
Tmp := Vcl.Graphics.TBitmap.Create;
try
Tmp.TransparentColor := Self.TransparentColor;
Tmp.TransparentMode := Self.TransparentMode;
Tmp.Transparent := Self.Transparent;
Tmp.Canvas.Brush.Color := BkColor;
if AdjustSize then
begin
Tmp.Width := Round(Self.Width * Abs(C) + Self.Height * Abs(S));
Tmp.Height := Round(Self.Width * Abs(S) + Self.Height * Abs(C));
OffsetX := (Tmp.Width - Self.Width * C + Self.Height * S) / 2;
OffsetY := (Tmp.Height - Self.Width * S - Self.Height * C) / 2;
end
else
begin
Tmp.Width := Self.Width;
Tmp.Height := Self.Height;
OffsetX := (Self.Width - Self.Width * C + Self.Height * S) / 2;
OffsetY := (Self.Height - Self.Width * S - Self.Height * C) / 2;
end;
Points[0].X := Round(OffsetX);
Points[0].Y := Round(OffsetY);
Points[1].X := Round(OffsetX + Self.Width * C);
Points[1].Y := Round(OffsetY + Self.Width * S);
Points[2].X := Round(OffsetX - Self.Height * S);
Points[2].Y := Round(OffsetY + Self.Height * C);
PlgBlt(Tmp.Canvas.Handle, Points,
Self.Canvas.Handle, 0, 0, Self.Width, Self.Height,
0, 0, 0);
Self.Assign(Tmp);
finally
Tmp.Free;
end;
end;
{$POINTERMATH ON}
procedure __RotateBitmap90(var ABitmap: Vcl.Graphics.TBitmap; Clockwise: boolean = false);
type
TPtrMultiplex = record
case integer of
1: (P1: PByte);
2: (P2: PWord);
3: (P3: PRGBTriple);
4: (P4: PCardinal);
end;
var
Tmp: Vcl.Graphics.TBitmap;
BMP: WinApi.Windows.BITMAP;
PixelSize: integer;
SrcLineSize, DestLineSize: integer;
Src, Dest: pointer;
PSrc, PDest: TPtrMultiplex;
i, j: integer;
begin
if not Assigned(ABitmap) or ABitmap.Empty then exit;
Tmp := Vcl.Graphics.TBitmap.Create;
Tmp.TransparentColor := ABitmap.TransparentColor;
Tmp.TransparentMode := ABitmap.TransparentMode;
Tmp.Transparent := ABitmap.Transparent;
if ABitmap.PixelFormat in [pfDevice, pf1bit, pf4bit, pfCustom] then
begin
if ABitmap.PixelFormat = pfDevice then
Tmp.PixelFormat := pf32bit
else
Tmp.PixelFormat := pf8bit;
Tmp.SetSize(ABitmap.Width, ABitmap.Height);
Tmp.Canvas.Draw(0, 0, ABitmap);
ABitmap.Assign(Tmp);
end
else
Tmp.PixelFormat := ABitmap.PixelFormat;
Tmp.SetSize(ABitmap.Height, ABitmap.Width);
if ABitmap.PixelFormat = pf8bit then
SelectPalette(Tmp.Canvas.Handle, ABitmap.Palette, false);
GetObject(ABitmap.Handle, sizeof(BMP), @BMP);
if BMP.bmBitsPixel >= 8 then
begin
PixelSize := (BMP.bmBitsPixel + 7) div 8;
SrcLineSize := BMP.bmWidthBytes;
Src := BMP.bmBits;
GetObject(Tmp.Handle, sizeof(BMP), @BMP);
DestLineSize := BMP.bmWidthBytes;
Dest := BMP.bmBits;
case PixelSize of
1:
begin
PSrc.P1 := Src;
if Clockwise then
for i := 0 to ABitmap.Height - 1 do
begin
PDest.P1 := Dest;
for j := 0 to ABitmap.Width - 1 do
begin
PDest.P1[i] := PSrc.P1[ABitmap.Width - 1 - j];
Inc(NativeInt(PDest.P1), DestLineSize);
end;
Inc(nativeInt(PSrc.P1), SrcLineSize);
end
else
for i := 0 to ABitmap.Height - 1 do
begin
PDest.P1 := Dest;
for j := 0 to ABitmap.Width - 1 do
begin
PDest.P1[Tmp.Width - i - 1] := PSrc.P1[j];
Inc(NativeInt(PDest.P1), DestLineSize);
end;
Inc(nativeInt(PSrc.P1), SrcLineSize);
end;
end;
2:
begin
PSrc.P2 := Src;
if Clockwise then
for i := 0 to ABitmap.Height - 1 do
begin
PDest.P2 := Dest;
for j := 0 to ABitmap.Width - 1 do
begin
PDest.P2[i] := PSrc.P2[ABitmap.Width - 1 - j];
Inc(NativeInt(PDest.P2), DestLineSize);
end;
Inc(nativeInt(PSrc.P2), SrcLineSize);
end
else
for i := 0 to ABitmap.Height - 1 do
begin
PDest.P2 := Dest;
for j := 0 to ABitmap.Width - 1 do
begin
PDest.P2[Tmp.Width - i - 1] := PSrc.P2[j];
Inc(NativeInt(PDest.P2), DestLineSize);
end;
Inc(nativeInt(PSrc.P2), SrcLineSize);
end;
end;
3:
begin
PSrc.P3 := Src;
if Clockwise then
for i := 0 to ABitmap.Height - 1 do
begin
PDest.P3 := Dest;
for j := 0 to ABitmap.Width - 1 do
begin
PDest.P3[i] := PSrc.P3[ABitmap.Width - 1 - j];
Inc(NativeInt(PDest.P3), DestLineSize);
end;
Inc(nativeInt(PSrc.P3), SrcLineSize);
end
else
for i := 0 to ABitmap.Height - 1 do
begin
PDest.P3 := Dest;
for j := 0 to ABitmap.Width - 1 do
begin
PDest.P3[Tmp.Width - i - 1] := PSrc.P3[j];
Inc(NativeInt(PDest.P3), DestLineSize);
end;
Inc(nativeInt(PSrc.P3), SrcLineSize);
end;
end;
4:
begin
PSrc.P4 := Src;
if Clockwise then
for i := 0 to ABitmap.Height - 1 do
begin
PDest.P4 := Dest;
for j := 0 to ABitmap.Width - 1 do
begin
PDest.P4[i] := PSrc.P4[ABitmap.Width - 1 - j];
Inc(NativeInt(PDest.P4), DestLineSize);
end;
Inc(nativeInt(PSrc.P4), SrcLineSize);
end
else
for i := 0 to ABitmap.Height - 1 do
begin
PDest.P4 := Dest;
for j := 0 to ABitmap.Width - 1 do
begin
PDest.P4[Tmp.Width - i - 1] := PSrc.P4[j];
Inc(NativeInt(PDest.P4), DestLineSize);
end;
Inc(nativeInt(PSrc.P4), SrcLineSize);
end;
end;
end;
end;
ABitmap.Assign(Tmp);
Tmp.Free;
end;
procedure TBitmapHelper.Rotate(Direction: TDirection; Clockwise: boolean = false);
begin
case Direction of
dir90:
__RotateBitmap90(Self, Clockwise);
dir180:
Self.FlipAndMirror;
dir270:
__RotateBitmap90(Self, not Clockwise);
end;
end;
procedure TBitmapHelper.Flip;
begin
Self.Canvas.CopyRect(Rect(0, 0, Self.Width, Self.Height),
Self.Canvas,
Rect(0, Self.Height, Self.Width, 0));
end;
procedure TBitmapHelper.Mirror;
begin
Self.Canvas.CopyRect(Rect(0, 0, Self.Width, Self.Height),
Self.Canvas,
Rect(Self.Width, 0, 0, Self.Height));
end;
procedure TBitmapHelper.FlipAndMirror;
begin
Self.Canvas.CopyRect(Rect(0, 0, Self.Width, Self.Height),
Self.Canvas,
Rect(Self.Width, Self.Height, 0, 0));
end;
end.
uj5u.com熱心網友回復：
Delphi程式中，只要uses Vcl.Graphics.BitmapHelper; 就可以直接：var
bmp: TBitmap;
// ...
bmp.Rotate(...);
這也是Class Helpers的強大之處，可以直接對已有的類打補丁，不需要修改類原始碼或者派生新類。
但是CB不支持Class Helpers，還需要一個介面單元：
unit CPPBitmapHelper;
interface
uses Vcl.Graphics, Vcl.Graphics.BitmapHelper;
type
TDirection = Vcl.Graphics.BitmapHelper.TDirection;
procedure Rotate(ABitmap: TBitmap; Rads: single; Clockwise: boolean = false;
AdjustSize: boolean = true; BkColor: TColor = clWhite); overload; inline;
procedure Rotate(ABitmap: TBitmap; Direction: TDirection;
Clockwise: boolean = false); overload; inline;
procedure Flip(ABitmap: TBitmap); inline;
procedure Mirror(ABitmap: TBitmap); inline;
procedure FlipAndMirror(ABitmap: TBitmap); inline;
implementation
procedure Rotate(ABitmap: TBitmap; Rads: single; Clockwise: boolean = false;
AdjustSize: boolean = true; BkColor: TColor = clWhite);
begin
ABitmap.Rotate(Rads, Clockwise, AdjustSize, BkColor);
end;
procedure Rotate(ABitmap: TBitmap; Direction: TDirection; Clockwise: boolean = false);
begin
ABitmap.Rotate(Direction, Clockwise);
end;
procedure Flip(ABitmap: TBitmap);
begin
ABitmap.Flip;
end;
procedure Mirror(ABitmap: TBitmap);
begin
ABitmap.Mirror;
end;
procedure FlipAndMirror(ABitmap: TBitmap);
begin
ABitmap.FlipAndMirror;
end;
end.
在CB程式中，把上述兩個.pas添加到工程中，然后#include <CPPBitmapHelper.hpp>就可以使用了，但是只能：
Rotate(bmp, ...);這種方式使用，不能作為TBitmap的成員函式使用。咯有遺憾，希望CB的后續版本能支持Helpers功能就好了。
uj5u.com熱心網友回復：
出手不凡亞，你這個寫得太通用了，有空我試一下。不過我看不太懂，可能就不用在我那個小專案中了。uj5u.com熱心網友回復：
不知道Lazarus支不支持Class Helpers功能？uj5u.com熱心網友回復：
只＿是＿４＿０＿０＿分＿＋＿幾＿小＿時＿時＿間，非法詞組是什么鬼~~~
uj5u.com熱心網友回復：
支持，還有擴展，Delphi的Helpers只有Class Helpers允許繼承，對其他型別都不允許繼承，FPC允許對任意型別的Helpers繼承
uj5u.com熱心網友回復：
看來Lazarus也不差，Delphi XE以后有一些新的語法，Lazarus也支持嗎？
uj5u.com熱心網友回復：
語言的兼容性應該能達到99%+，主要的兼容性問題在框架，對VCL的兼容性已經很好了，差不多90%+，但是不支持FMX是很大的問題
uj5u.com熱心網友回復：
對VCL的兼容性是什么意思，指能用的三方控制元件？三方控制元件也只能用于win平臺了。Lazarus也支持安卓、ios開發了，但是沒有FMX那么炫。
uj5u.com熱心網友回復：
指的是官方VCL的大部分功能在FCL/LCL中都有了，第三方的不好說，但是很多也支持FPC，比如indy
uj5u.com熱心網友回復：
三方控制元件Lazarus能不能用，跟三方控制元件原本是不是跨平臺有關嗎？如果三方控制元件只有win平臺，Lazarus在win平臺下多數也能用上吧？
uj5u.com熱心網友回復：
應該大部分可以，依據https://wiki.freepascal.org/Lazarus_For_Delphi_Users 上的說明：Lazarus is a Rapid Application Development (RAD) tool like Delphi. That means it comes with a visual component library and an Integrated Development Environment (IDE). The Lazarus component library (LCL) is very similar to Delphi's Visual Component Library (VCL). Most Lazarus units, classes and properties have the same name and functionality as their equivalents in Delphi. This makes porting Delphi applications to Lazarus relatively easy. Even though Lazarus is in many respects an open source Delphi clone, the compatibility is not 100%.
uj5u.com熱心網友回復：
這里沒提到三方控制元件的兼容性。
uj5u.com熱心網友回復：
幫我看看這個：經過藍牙連接后播放的歌曲，音質相對于直接播放會不會變差了？換句話說，藍牙連接是否屬于物理層加資料鏈路層，對上層傳輸的資料比如音頻是透明無損的？
https://bbs.csdn.net/topics/396185110
uj5u.com熱心網友回復：
哇塞，收藏了轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/14346.html
上一篇：這幾個sql陳述句怎么寫。