难题：delphi在Image等控件中有实现图形的平面旋转的算法

仔细看以下一个控件的源代码！unit RotImg;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;type
  TRotateImage = class(TGraphicControl)
  private
    FPicture: TPicture;
    FOnProgress: TProgressEvent;
    FStretch: Boolean;
    FCenter: Boolean;
    FIncrementalDisplay: Boolean;
    FTransparent: Boolean;
    FDrawing: Boolean;
    FAngle: Extended;
    {$IFNDEF RI_D4orHigher}
    FAutoSize: Boolean;
    {$ENDIF}
    FUniqueSize: Boolean;
    FRotatedBitmap: TBitmap;
    function GetCanvas: TCanvas;
    procedure PictureChanged(Sender: TObject);
    procedure SetCenter(Value: Boolean);
    procedure SetPicture(Value: TPicture);
    procedure SetStretch(Value: Boolean);
    procedure SetTransparent(Value: Boolean);
    procedure SetAngle(Value: Extended);
    {$IFNDEF RI_D4orHigher}
    procedure SetAutoSize(Value: Boolean);
    {$ENDIF}
    procedure SetUniqueSize(Value: Boolean);
    procedure CreateRotatedBitmap;
    procedure CMColorChanged(var Msg: TMessage); message CM_COLORCHANGED;
  protected
    {$IFDEF RI_D4orHigher}
    function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
    {$ELSE}
    procedure AdjustSize;
    {$ENDIF}
    function DestRect: TRect;
    function DoPaletteChange: Boolean;
    function GetPalette: HPALETTE; override;
    procedure Paint; override;
    procedure Loaded; override;
    procedure Progress(Sender: TObject; Stage: TProgressStage;
      PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string); dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Canvas: TCanvas read GetCanvas;
    property RotatedBitmap: TBitmap read FRotatedBitmap;
  published
    property Align;
    {$IFDEF RI_D4orHigher}
    property Anchors;
    {$ENDIF}
    property Angle: Extended read FAngle write SetAngle;
    {$IFDEF RI_D4orHigher}
    property AutoSize;
    {$ELSE}
    property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
    {$ENDIF}
    property Center: Boolean read FCenter write SetCenter default False;
    property Color;
    {$IFDEF RI_D4orHigher}
    property Constraints;
    {$ENDIF}
    property DragCursor;
    {$IFDEF RI_D4orHigher}
    property DragKind;
    {$ENDIF}
    property DragMode;
    property Enabled;
    property IncrementalDisplay: Boolean read FIncrementalDisplay write FIncrementalDisplay default False;
    property ParentColor;
    property ParentShowHint;
    property Picture: TPicture read FPicture write SetPicture;
    property PopupMenu;
    property ShowHint;
    property Stretch: Boolean read FStretch write SetStretch default False;
    property Transparent: Boolean read FTransparent write SetTransparent default False;
    property UniqueSize: Boolean read FUniqueSize write SetUniqueSize default True;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    {$IFDEF RI_D4orHigher}
    property OnEndDock;
    {$ENDIF}
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnProgress: TProgressEvent read FOnProgress write FOnProgress;
    {$IFDEF RI_D4orHigher}
    property OnStartDock;
    {$ENDIF}
    property OnStartDrag;
  end;function RotateBitmap(Bitmap: TBitmap; Angle: Double; Color: TColor): TBitmap;procedure Register;implementationuses
  Consts, Math;// Bitmaps must be 24 bit pixel format.
// Angle is in degrees.
function RotateBitmap(Bitmap: TBitmap; Angle: Double; Color: TColor): TBitmap;
const
  MaxPixelCount = 32768;
type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..MaxPixelCount] of TRGBTriple;
var
  CosTheta: Extended;
  SinTheta: Extended;
  xSrc, ySrc: Integer;
  xDst, yDst: Integer;
  xODst, yODst: Integer;
  xOSrc, yOSrc: Integer;
  xPrime, yPrime: Integer;
  srcRow, dstRow: PRGBTripleArray;
begin
  Result := TBitmap.Create;
  SinCos(Angle * 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;
  with Result.Canvas do
  begin
    Brush.Color := Color;
    Brush.Style := bsSolid;
    FillRect(ClipRect);
  end;
  Result.PixelFormat := pf24bit;
  Bitmap.PixelFormat := pf24bit;
  xODst := Result.Width div 2;
  yODst := Result.Height div 2;
  xOSrc := Bitmap.Width div 2;
  yOSrc := Bitmap.Height div 2;
  for ySrc := Max(Bitmap.Height, Result.Height)-1 downto 0 do
  begin
    yPrime := ySrc - yODst;
    for xSrc := Max(Bitmap.Width, Result.Width)-1 downto 0 do
    begin
      xPrime := xSrc - xODst;
      xDst := Round(xPrime * CosTheta - yPrime * SinTheta) + xOSrc;
      yDst := Round(xPrime * SinTheta + yPrime * CosTheta) + yOSrc;
      if (yDst >= 0) and (yDst < Bitmap.Height) and
         (xDst >= 0) and (xDst < Bitmap.Width) and
         (ySrc >= 0) and (ySrc < Result.Height) and
         (xSrc >= 0) and (xSrc < Result.Width) then
      begin
        srcRow := Bitmap.ScanLine[yDst];
        dstRow := Result.Scanline[ySrc];
        dstRow[xSrc] := srcRow[xDst];
      end;
    end;
  end;
end;procedure TRotateImage.CreateRotatedBitmap;
var
  OrgBitmap: TBitmap;
  RotBitmap: TBitmap;
begin
  if (Picture.Width > 0) and (Picture.Height > 0) then
  begin
    OrgBitmap := TBitmap.Create;
    OrgBitmap.Width := Picture.Width;
    OrgBitmap.Height := Picture.Height;
    with OrgBitmap.Canvas do
    begin
      Brush.Color := Color;
      Brush.Style := bsSolid;
      FillRect(ClipRect);
    end;
    OrgBitmap.Canvas.Draw(0, 0, Picture.Graphic);
    RotBitmap := RotateBitmap(OrgBitmap, Angle, Color);
    if UniqueSize then
    begin
      with RotatedBitmap.Canvas do
      begin
        Brush.Color := Color;
        Brush.Style := bsSolid;
        FillRect(ClipRect);
      end;
      RotatedBitmap.Width := Round(Sqrt(Sqr(Picture.Width+2) + Sqr(Picture.Height+2)));
      RotatedBitmap.Height := RotatedBitmap.Width;
      RotatedBitmap.Transparent := Transparent;
      if Center and not Stretch then
        RotatedBitmap.Canvas.Draw((RotatedBitmap.Width - RotBitmap.Width) div 2,
          (RotatedBitmap.Height - RotBitmap.Height) div 2, RotBitmap)
      else
        RotatedBitmap.Canvas.Draw(0, 0, RotBitmap);
      RotBitmap.Free;
    end
    else
    begin
      RotatedBitmap.Free;
      FRotatedBitmap := RotBitmap;
    end;
    OrgBitmap.Free;
  end
  else
  begin
    RotatedBitmap.Width := 0;
    RotatedBitmap.Height := 0;
  end;
  if AutoSize then AdjustSize;
end;constructor TRotateImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  FPicture := TPicture.Create;
  FPicture.OnChange := PictureChanged;
  FPicture.OnProgress := Progress;
  FUniqueSize := True;
  FRotatedBitmap := TBitmap.Create;
  Height := 105;
  Width := 105;
end;destructor TRotateImage.Destroy;
begin
  Picture.Free;
  RotatedBitmap.Free;
  inherited Destroy;
end;function TRotateImage.GetPalette: HPALETTE;
begin
  Result := 0;
  if Picture.Graphic <> nil then
    Result := Picture.Graphic.Palette;
end;function TRotateImage.DestRect: TRect;
begin
  if Stretch then
    Result := ClientRect
  else if Center then
    Result := Bounds((Width - RotatedBitmap.Width) div 2,
                     (Height - RotatedBitmap.Height) div 2,
                      RotatedBitmap.Width, RotatedBitmap.Height)
  else
    Result := Rect(0, 0, RotatedBitmap.Width, RotatedBitmap.Height);
end;procedure TRotateImage.Paint;
var
  Save: Boolean;
begin
  if not RotatedBitmap.Empty then
  begin
    Save := FDrawing;
    FDrawing := True;
    try
      with inherited Canvas do
        StretchDraw(DestRect, RotatedBitmap);
    finally
      FDrawing := Save;
    end;
  end;
  if csDesigning in ComponentState then
    with inherited Canvas do
    begin
      Pen.Style := psDash;
      Brush.Style := bsClear;
      Rectangle(0, 0, Width, Height);
    end;
end;procedure TRotateImage.Loaded;
begin
  inherited Loaded;
  PictureChanged(Self);
end;function TRotateImage.DoPaletteChange: Boolean;
var
  ParentForm: TCustomForm;
  G: TGraphic;
begin
  Result := False;
  G := Picture.Graphic;
  if Visible and (not (csLoading in ComponentState)) and
    (G <> nil) and (G.PaletteModified) then
  begin
    if (G.Palette = 0) then
      G.PaletteModified := False
    else
    begin
      ParentForm := GetParentForm(Self);
      if Assigned(ParentForm) and ParentForm.Active and Parentform.HandleAllocated then
      begin
        if FDrawing then
          ParentForm.Perform(WM_QUERYNEWPALETTE, 0, 0)
        else
          PostMessage(ParentForm.Handle, WM_QUERYNEWPALETTE, 0, 0);
        Result := True;
        G.PaletteModified := False;
      end;
    end;
  end;
end;procedure TRotateImage.Progress(Sender: TObject; Stage: TProgressStage;
  PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
begin
  if IncrementalDisplay and RedrawNow then
  begin
    if DoPaletteChange then Update
    else Paint;
  end;
  if Assigned(OnProgress) then OnProgress(Sender, Stage, PercentDone, RedrawNow, R, Msg);
end;function TRotateImage.GetCanvas: TCanvas;
var
  Bitmap: TBitmap;
begin
  if Picture.Graphic = nil then
  begin
    Bitmap := TBitmap.Create;
    try
      Bitmap.Width := Width;
      Bitmap.Height := Height;
      Picture.Graphic := Bitmap;
    finally
      Bitmap.Free;
    end;
  end;
  if Picture.Graphic is TBitmap then
    Result := TBitmap(Picture.Graphic).Canvas
  else
    raise EInvalidOperation.Create(SImageCanvasNeedsBitmap);
end;procedure TRotateImage.CMColorChanged(var Msg: TMessage);
begin
  inherited;
  CreateRotatedBitmap;
end;procedure TRotateImage.SetCenter(Value: Boolean);
begin
  if Value <> Center then
  begin
    FCenter := Value;
    PictureChanged(Self)
  end;
end;procedure TRotateImage.SetPicture(Value: TPicture);
begin
  Picture.Assign(Value);
end;procedure TRotateImage.SetStretch(Value: Boolean);
begin
  if Value <> Stretch then
  begin
    FStretch := Value;
    PictureChanged(Self);
  end;
end;procedure TRotateImage.SetTransparent(Value: Boolean);
begin
  if Value <> Transparent then
  begin
    FTransparent := Value;
    PictureChanged(Self);
  end;
end;procedure TRotateImage.SetAngle(Value: Extended);
begin
  if Value <> Angle then
  begin
    FAngle := Value;
    PictureChanged(Self);
  end;
end;{$IFNDEF RI_D4orHigher}
procedure TRotateImage.SetAutoSize(Value: Boolean);
begin
  if Value <> AutoSizethen
  begin
    FAutoSize := Value;
    if FAutoSize then AdjustSize;
  end;
end;
{$ENDIF}procedure TRotateImage.SetUniqueSize(Value: Boolean);
begin
  if Value <> UniqueSize then
  begin
    FUniqueSize := Value;
    PictureChanged(Self);
  end;
end;procedure TRotateImage.PictureChanged(Sender: TObject);
var
  G: TGraphic;
begin
  if not (csLoading in ComponentState) then
  begin
    G := Picture.Graphic;
    if G <> nil then
    begin
      if not ((G is TMetaFile) or (G is TIcon)) then
        G.Transparent := FTransparent;
      if (not G.Transparent) and (Stretch or (RotatedBitmap.Width >= Width)
        and (RotatedBitmap.Height >= Height)) then
        ControlStyle := ControlStyle + [csOpaque]
      else
        ControlStyle := ControlStyle - [csOpaque];
      if DoPaletteChange and FDrawing then Update;
    end
    else
      ControlStyle := ControlStyle - [csOpaque];
    CreateRotatedBitmap;
    if AutoSize and (Picture.Width > 0) and (Picture.Height > 0) then
      SetBounds(Left, Top, RotatedBitmap.Width, RotatedBitmap.Height);
    if not FDrawing then Invalidate;
  end;
end;{$IFDEF RI_D4orHigher}
function TRotateImage.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
  Result := True;
  if not (csDesigning in ComponentState) or
    (RotatedBitmap.Width > 0) and (RotatedBitmap.Height > 0) then
  begin
    if Align in [alNone, alLeft, alRight] then
      NewWidth := RotatedBitmap.Width;
    if Align in [alNone, alTop, alBottom] then
      NewHeight := RotatedBitmap.Height;
  end;
end;
{$ENDIF}{$IFNDEF RI_D4orHigher}
procedure TRotateImage.AdjustSize;
begin
  if not (csDesigning in ComponentState) or
    (RotatedBitmap.Width > 0) and (RotatedBitmap.Height > 0) then
  begin
    if Align in [alNone, alLeft, alRight] then
      Width := RotatedBitmap.Width;
    if Align in [alNone, alTop, alBottom] then
      Height := RotatedBitmap.Height;
  end;
end;
{$ENDIF}procedure Register;
begin
  RegisterComponents('Samples', [TRotateImage]);
end;end.

调试易

难题：delphi在Image等控件中有实现图形的平面旋转的算法

解决方案 »