gdpicturezoomer.pas

gdskin的源码

unit GDPictureZoomer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, ExtCtrls, ComCtrls;

type
  TPictureZoomer = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    StatusBar1: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    FBitmap: TBitmap;
    FDrawRegion:TRect;
    FScale:Single;
    FZoomPoint: TPoint;
    procedure SetBitmap(Value: TBitmap);
    procedure SetScale(Value:Single);
    procedure SetZoomPoint(Value: TPoint);
    procedure DrawCross;
  protected
    procedure ReDrawImage;
  public
    { Public declarations }
    property ZoomPoint:TPoint read FZoomPoint write SetZoomPoint;
    property Bitmap:TBitmap read FBitmap write SetBitmap;
    property Scale:Single read FScale write SetScale;
  end;

var
  PictureZoomer: TPictureZoomer;

implementation

{$R *.dfm}

{ TPicturnZoomer }

procedure TPictureZoomer.FormCreate(Sender: TObject);
begin
  Scale:=2;
end;

procedure TPictureZoomer.ReDrawImage;
var
  ARect:TRect;
begin
  if not ((Bitmap<>Nil) and not (Bitmap.Empty)) then Exit;

  with Image1 do
  begin
    ARect:=Rect(0,0,Width,Height);
    Canvas.FillRect(ARect);
    Canvas.CopyRect(ARect,FBitmap.Canvas,FDrawRegion);
    DrawCross;
  end;
end;

procedure TPictureZoomer.SetBitmap(Value: TBitmap);
begin
  if FBitmap <> Value then
  begin
    FBitmap := Value;
//    Image1.Picture.Bitmap.Assign(Value);
    ZoomPoint:=Point(0,0);
  end;
end;

procedure TPictureZoomer.SetScale(Value: Single);
begin
  if (Value<0.1) or (Value>5) then Exit;
  if FScale <> Value then
  begin
    FScale := Value;
    ZoomPoint:=FZoomPoint;
  end;
  StatusBar1.Panels[0].Text :=
    Format('Scale:%0.0f',[FScale*100])+'%';
end;

procedure TPictureZoomer.SetZoomPoint(Value: TPoint);
var
  AW,AH:Integer;
begin
  FZoomPoint := Value;
  AW:=Round(Image1.Width/FScale);
  AH:=Round(Image1.Height/FScale);
  Value.X:=Value.X-AW div 2;
  Value.Y:=Value.Y-AH div 2;
  FDrawRegion:=Rect(Value,Point(Value.X+AW,Value.Y+AH));
  ReDrawImage;
end;

procedure TPictureZoomer.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action:=caFree;
end;

procedure TPictureZoomer.SpeedButton1Click(Sender: TObject);
begin
  Scale:=Scale+0.1;
end;

procedure TPictureZoomer.SpeedButton2Click(Sender: TObject);
begin
  Scale:=Scale-0.1;
end;

procedure TPictureZoomer.SpeedButton3Click(Sender: TObject);
begin
  Scale:=1;
end;

procedure TPictureZoomer.FormResize(Sender: TObject);
begin
  with Image1.Picture do
  begin
    Bitmap.Width:=Image1.Width;
    Bitmap.Height:=Image1.Height;
  end;
  ZoomPoint:=FZoomPoint;
end;

procedure TPictureZoomer.DrawCross;
const Dist=20;
var
  ACenterPoint:TPoint;
begin
  with Image1 do
  begin
    ACenterPoint.X:=Width div 2;
    ACenterPoint.Y:=Height div 2;
    Canvas.MoveTo(ACenterPoint.X-Dist,ACenterPoint.Y);
    Canvas.LineTo(ACenterPoint.X+Dist,ACenterPoint.Y);
    Canvas.MoveTo(ACenterPoint.X,ACenterPoint.Y-Dist);
    Canvas.LineTo(ACenterPoint.X,ACenterPoint.Y+Dist);
  end;
end;

end.