rotimg.pas

图象插值旋转源码。可以任意角度旋转图象

        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
      FRotatedBitmap := RotBitmap;
    RotatedBitmap.Transparent := Transparent;
    RotatedBitmap.TransparentColor := BlindColor;
  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;
  RebuildRotatedBitmap;
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 DELPHI4_UP}
procedure TRotateImage.SetAutoSize(Value: Boolean);
begin
  if Value <> AutoSize then
  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];
    RebuildRotatedBitmap;
    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 DELPHI4_UP}
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 DELPHI4_UP}
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}

end.