scalingu.pas

DelphiWin32核心API参考光盘内容.是学习书籍中的源码,便于学习.

unit ScalingU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ScaleRect: TRect;       // holds the user drawn rectangle coordinates
  IsDragging: Boolean;    // indicates if the user is drawing a rectangle
  ScaledImage: TBitmap;   // holds the image to be scaled

implementation

{$R *.DFM}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  {indicate that the user is dragging a rectangle}
  IsDragging := TRUE;

  {initialize the rectangle}
  ScaleRect := Rect(X, Y, X, Y);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  {if we are dragging a rectangle}
  if IsDragging then
  begin
    {draw over the current rectangle to erase it}
    Canvas.Pen.Style := psSolid;
    Canvas.Pen.Color := clBlack;
    Canvas.Pen.Mode := pmNot;
    Canvas.Brush.Style := bsClear;
    Canvas.Rectangle(ScaleRect.Left, ScaleRect.Top, ScaleRect.Right,
                     ScaleRect.Bottom);

    {modify the user drawn rectangle coordinates to the new coordinates}
    ScaleRect := Rect(ScaleRect.Left, ScaleRect.Top, X, Y);

    {draw a new rectangle}
    Canvas.Rectangle(ScaleRect.Left, ScaleRect.Top, ScaleRect.Right,
                     ScaleRect.Bottom);
  end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Ratio: Real;        // holds the scaling ratio
begin
  {indicate that the user is no longer dragging a rectangle}
  IsDragging := FALSE;

  {clear the entire window}
  Canvas.Brush.Color := clBtnFace;
  Canvas.Brush.Style := bsSolid;
  Canvas.FillRect(Form1.ClientRect);

  {redraw a new, empty rectangle at the current rectangle coordinates}
  Canvas.Brush.Style := bsClear;
  Canvas.Rectangle(ScaleRect.Left, ScaleRect.Top, ScaleRect.Right,
                   ScaleRect.Bottom);

  {select the images palette into the form's canvas and realize it}
  SelectPalette(Canvas.Handle, ScaledImage.Palette, FALSE);
  RealizePalette(Canvas.Handle);

  {determine the appropriate scaling ratio}
  if ScaleRect.Right-ScaleRect.Left<ScaleRect.Bottom-ScaleRect.Top then
    Ratio := (ScaleRect.Right-ScaleRect.Left)/ScaledImage.Width
  else
    Ratio := (ScaleRect.Bottom-ScaleRect.Top)/ScaledImage.Height;

  {copy the image to the canvas, centered in the rectangle and scaled so that
   the aspect ratio of the original image is retained}
  StretchBlt(Canvas.Handle, ScaleRect.Left+(((ScaleRect.Right-ScaleRect.Left)
             div 2)-(Trunc(ScaledImage.Width*Ratio) div 2)), ScaleRect.Top+
             (((ScaleRect.Bottom-ScaleRect.Top) div 2)-(Trunc(ScaledImage.Height
             *Ratio) div 2)), Trunc(ScaledImage.Width*Ratio),
             Trunc(ScaledImage.Height*Ratio), ScaledImage.Canvas.Handle, 0, 0,
             ScaledImage.Width, ScaledImage.Height, SRCCOPY);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  {create and load the image to be scaled}
  ScaledImage := TBitmap.Create;
  ScaledImage.LoadFromFile('Image9.bmp');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  {free the image bitmap}
  ScaledImage.Free;
end;

end.