gdregionselector.pas

gdskin的源码

unit GDRegionSelector;

interface

uses
  jpeg,Math, ComCtrls, Buttons, ExtCtrls, Controls, Forms, Classes,
  Graphics,Windows,SysUtils, StdCtrls,DesignEditors,DesignIntf,
  GdClasses,Dialogs,GDPictureZoomer;

type
  TRegionSelector = class(TForm)
    ScrollBox1: TScrollBox;
    Image1: TImage;
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Zoomer_Check: TCheckBox;
    Splitter1: TSplitter;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure LeftEdtKeyPress(Sender: TObject; var Key: Char);
    procedure FormDestroy(Sender: TObject);
    procedure Zoomer_CheckClick(Sender: TObject);
  private
    { Private declarations }
    //FDownPos-按下鼠标时的位置;FCurPos-当前鼠标的位置
    FOldMovePos,FDownPos,FCurPos:TPoint;
    FRegion: TRect;
    FPictureZoomer:TPictureZoomer;
    procedure InitImage;
    procedure DoScrollBar(AScrollBox:TScrollBox;MousePoint:TPoint);
    procedure DrawSelectRect(ACanvas:TCanvas;ARect:TRect);
    function GetBitmap: Graphics.TBitmap;
    function PointToStr(X,Y:Integer):String;
    procedure RegionChanged;
    procedure SetPosText(PointStr:String);
    procedure SetBitmap(Value:Graphics.TBitmap);
    procedure SetRegion(Value: TRect);
    procedure DrawCross(Point:TPoint);
  protected
//    procedure ShowZoomer(Value:Boolean);
  public
    { Public declarations }
    property Bitmap:Graphics.TBitmap read GetBitmap write SetBitmap;
    property Region:TRect read FRegion write SetRegion;
    class function EditRegion(ABitmap:Graphics.TBitmap;
      var ARegion:TRect):Boolean;
  end;

const Title='Region Selector';

var
  RegionSelector: TRegionSelector;

implementation

{$R *.dfm}

procedure TRegionSelector.DoScrollBar(AScrollBox: TScrollBox; MousePoint: TPoint);
var
  ControlRect:TRect;
  POS,POS1,POS2:Integer;
begin
  ControlRect:=AScrollBox.BoundsRect;
  if not PtInRect(ControlRect,MousePoint) then
  begin
    POS1:=MousePoint.X-ControlRect.Left;
    POS2:=MousePoint.X-ControlRect.Right;
    if abs(POS1)<abs(POS2) then POS:=POS1
    else POS:=POS2;
    AScrollBox.HorzScrollBar.Position:=
      AScrollBox.HorzScrollBar.Position+POS div 10;
    POS1:=MousePoint.Y-ControlRect.Top;
    POS2:=MousePoint.Y-ControlRect.Bottom;
    if abs(POS1)<abs(POS2) then POS:=POS1
    else POS:=POS2;
    AScrollBox.VertScrollBar.Position:=
      AScrollBox.VertScrollBar.Position+POS div 10;
  end;
end;

procedure TRegionSelector.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
//  if (FDownPos.X <>FCurPos.X) and (FDownPos.Y <>FCurPos.Y) then
//    DrawSelectRect(Image1.Canvas,Rect(FDownPos,FCurPos));
  FCurPos.X :=X;
  FCurPos.Y :=Y;
  FDownPos:=FCurPos;
end;

procedure TRegionSelector.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  FrmCurPos:TPoint;
  S:String;
begin
  FOldMovePos.X:=X;
  FOldMovePos.Y:=Y;
  S:=Format('X:%d Y:%d',[X,Y]);
  if (ssLeft in Shift) then
  with Image1.Picture do
  begin
    RegionChanged;
    FCurPos.X := X;
    FCurPos.Y := Y;
    if not PtInRect(Rect(0,0,Image1.Width,Image1.Height),Point(X,Y)) then
    begin
      if X<0 then FCurPos.X:=0
      else if X>Image1.Width then FCurPos.X:=Image1.Width;
      if Y<0 then FCurPos.Y:=0
      else if Y>Image1.Height then FCurPos.Y:=Image1.Height;
    end;
    Region:=Rect(FDownPos,FCurPos);

//    FRegion:=Rect(FDownPos,FCurPos);
    S:=S+Format(' (W:%d H:%d)',
      [Abs(FCurPos.X-FDownPos.X),Abs(FCurPos.Y-FDownPos.Y)]);
    FrmCurPos:=Image1.ClientToParent(Point(X,Y));
    DoScrollBar(ScrollBox1,FrmCurPos);
  end;
  FPictureZoomer.ZoomPoint:=Point(X,Y);
  SetPosText(S);
end;

procedure TRegionSelector.DrawSelectRect(ACanvas:TCanvas;ARect: TRect);
begin
  ACanvas.Rectangle(ARect);
end;

procedure TRegionSelector.InitImage;
begin
  with Image1 do
  begin
    FDownPos:=FCurPos;
//    if Picture.Graphic.
    Canvas.Pen.Style:=psDot;
    Canvas.Brush.Style:=bsClear;
    Canvas.Pen.Mode :=pmNotXor;
  end;
end;

procedure TRegionSelector.FormCreate(Sender: TObject);
begin
  ScrollBox1.DoubleBuffered := True;
  FOldMovePos:=Point(-1,-1);
  Image1.BoundsRect:=Rect(0,0,0,0);
  FPictureZoomer:=TPictureZoomer.Create(Self);
  FPictureZoomer.BorderStyle:=bsNone;
  FPictureZoomer.Parent:=Self;
  FPictureZoomer.Align:=alRight;
  Zoomer_Check.Checked:=True;
end;

function TRegionSelector.PointToStr(X, Y: Integer): String;
begin
  Result:=IntToStr(X)+','+IntToStr(Y);
end;

procedure TRegionSelector.SetPosText(PointStr: String);
begin
  Caption := Title+' ['+PointStr+']';
end;

procedure TRegionSelector.SetBitmap(Value: Graphics.TBitmap);
begin
  Image1.Picture.Bitmap.Assign(Value);
  FPictureZoomer.Bitmap:=Image1.Picture.Bitmap;
//  PointToStr(Image1.BoundsRect.BottomRight.X,Image1.BoundsRect.BottomRight.Y);
  InitImage;
end;

function TRegionSelector.GetBitmap: Graphics.TBitmap;
begin
  Result:=Image1.Picture.Bitmap;
end;

procedure TRegionSelector.SetRegion(Value: TRect);
begin
  FRegion:=Value;
  RegionChanged;
end;

procedure TRegionSelector.RegionChanged;
begin
  DrawSelectRect(Bitmap.Canvas,FRegion);
end;

class function TRegionSelector.EditRegion(ABitmap:Graphics.TBitmap;
  var ARegion: TRect): Boolean;
begin
  Result:=False;
  if ABitmap.Empty then Raise Exception.Create('Bitmap is empty.');
  with TRegionSelector.Create(Application) do
  try
    Bitmap:=ABitmap;
    Region:=ARegion;
    Result:=ShowModal=mrOK;
    if Result then ARegion:=Region;
  finally
    Free;
  end;
end;

procedure TRegionSelector.LeftEdtKeyPress(Sender: TObject; var Key: Char);
begin
  if not (Key in ['0'..'9',#8,#13]) then
    Key:=#0;
end;

procedure TRegionSelector.FormDestroy(Sender: TObject);
begin
  FPictureZoomer.Free;
end;

procedure TRegionSelector.Zoomer_CheckClick(Sender: TObject);
begin
  Splitter1.Visible:=Zoomer_Check.Checked;
  FPictureZoomer.Visible:=Zoomer_Check.Checked;// then
end;

procedure TRegionSelector.DrawCross(Point: TPoint);
const Dist=10;
begin
  Bitmap.Canvas.Pen.Style:=psSolid;
  Bitmap.Canvas.MoveTo(Point.X-Dist,Point.Y);
  Bitmap.Canvas.LineTo(Point.X+Dist,Point.Y);
  Bitmap.Canvas.MoveTo(Point.X,Point.Y-Dist);
  Bitmap.Canvas.LineTo(Point.X,Point.Y+Dist);
end;

end.