一个拼图工具的制作思路 回复 "AlwaysBug" 的问题

测试简图:

---

功能简介:
1、双击左窗口可打开源图像;
2、框选左窗口可把图像选取复制到右窗口;
3、剪取的图块可以移动, 可配合 Ctrl 单选或多选, 可用 Delete 删除选择的图块;
4、双击右窗口可保存拼好的图像.

---

功能实现:
1、MoveImage 主要完成 "图块" 的功能;
2、ImageBox 主要完成源图像及选取功能;
3、其他有主模块 Unit1 完成.

---

窗体:

---

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 350
  ClientWidth = 671
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  OnKeyUp = FormKeyUp
  PixelsPerInch = 96
  TextHeight = 13
  object Splitter1: TSplitter
    Left = 361
    Top = 0
    Height = 350
    ExplicitLeft = 272
    ExplicitTop = 128
    ExplicitHeight = 100
  end
  object ScrollBox1: TScrollBox
    Left = 0
    Top = 0
    Width = 361
    Height = 350
    Align = alLeft
    TabOrder = 0
    OnClick = ScrollBox1Click
    OnDblClick = ScrollBox1DblClick
    ExplicitHeight = 328
    object Image1: TImage
      Left = 3
      Top = 3
      Width = 25
      Height = 25
      OnMouseEnter = Image1MouseEnter
    end
  end
end

Unit1:

---

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ExtDlgs, MoveImage, ImageBox;

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Splitter1: TSplitter;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Image1MouseEnter(Sender: TObject);
    procedure ScrollBox1Click(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure ScrollBox1DblClick(Sender: TObject);
  end;

var
  Form1: TForm1;
  ImageBox1: TImageBox;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  ImageBox1 := TImageBox.Create(Self);
  with ImageBox1 do begin
    Parent := Self;
    Align := alClient;
    OutImage := Image1;
  end;
  ScrollBox1.Color := clWhite;
  ScrollBox1.DoubleBuffered := True;
  KeyPreview := True;
  List := TList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to List.Count - 1 do TMoveImage(List[i]).Free;
  List.Free;
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  i: Integer;
begin
  if Key = VK_DELETE then for i := List.Count - 1 downto 0 do
  if TMoveImage(List[i]).Selected then
    begin
      TMoveImage(List[i]).Free;
      List.Delete(i);
    end;
end;

procedure TForm1.Image1MouseEnter(Sender: TObject);
var
  mi: TMoveImage;
begin
  Image1.Visible := False;
  mi := TMoveImage.Create(ScrollBox1);
  with mi do begin
    Parent := ScrollBox1;
    Left := Image1.Left;
    Top := Image1.Top;
    Width := Image1.Width;
    Height := Image1.Height;
    Picture.Bitmap.Assign(Image1.Picture.Bitmap);
  end;
  List.Add(mi);
end;

procedure TForm1.ScrollBox1Click(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to List.Count - 1 do
    TMoveImage(List[i]).Selected := False;
end;

procedure TForm1.ScrollBox1DblClick(Sender: TObject);
var
  i: Integer;
begin
  with TSavePictureDialog.Create(nil) do if Execute then
  begin
    with TBitmap.Create do
    begin
      Width := ScrollBox1.HorzScrollBar.Range + 20;
      Height := ScrollBox1.VertScrollBar.Range + 20;
      for i := 0 to List.Count - 1 do
      begin
        TMoveImage(List[i]).Selected := False;
        Canvas.Draw(TMoveImage(List[i]).Left,
                    TMoveImage(List[i]).Top,
                    TMoveImage(List[i]).Picture.Bitmap);
      end;
      SaveToFile(FileName);
      Free;
    end;
    Free;
  end;
end;

end.

ImageBox:

---

unit ImageBox;

interface

uses
  Windows, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, ExtDlgs;

type
  TImageBox = class(TScrollBox)
  private
    FImage: TImage;
    FShape: TShape;
    FBitmap: TBitmap;
    FFlag: Boolean;
    FOutImage: TImage;
    procedure SetOutImage(const Value: TImage);
  protected
    procedure ImageBoxDblClick(Sender: TObject);
    procedure ImageBoxMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X: Integer; Y: Integer);
    procedure ImageBoxMouseMove(Sender: TObject; Shift: TShiftState;
      X: Integer; Y: Integer);
    procedure ImageBoxMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X: Integer; Y: Integer);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Bitmap: TBitmap read FBitmap;
    property OutImage: TImage read FOutImage write SetOutImage;
  published
  end;

implementation

{ TImageBox }

constructor TImageBox.Create(AOwner: TComponent);
begin
  inherited;
  OnDblClick := ImageBoxDblClick;
  OnMouseDown := ImageBoxMouseDown;
  OnMouseMove := ImageBoxMouseMove;
  OnMouseUp := ImageBoxMouseUp;

  FImage := TImage.Create(Self);
  FImage.Parent := Self;
  FImage.AutoSize := True;
  FImage.OnDblClick := OnDblClick;
  FImage.OnMouseDown := ImageBoxMouseDown;
  FImage.OnMouseMove := ImageBoxMouseMove;
  FImage.OnMouseUp := ImageBoxMouseUp;

  FShape := TShape.Create(Self);
  FShape.Parent := Self;
  FShape.Brush.Style := bsClear;
  FShape.Pen.Style := psDot;
  FShape.BoundsRect := Rect(0, 0, 0, 0);
  FShape.BringToFront;

  FBitmap := TBitmap.Create;
end;

procedure TImageBox.ImageBoxDblClick(Sender: TObject);
begin
  FFlag := False;
  with TOpenPictureDialog.Create(nil) do if Execute then
  begin
    FImage.Picture.LoadFromFile(FileName);
    Free;
  end;
end;

destructor TImageBox.Destroy;
begin
  FImage.Free;
  FShape.Free;
  FBitmap.Free;
  inherited;
end;

procedure TImageBox.ImageBoxMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  cx,cy: Integer;
begin
  FFlag := True;
  cx := X - HorzScrollBar.Position;
  cy := Y - VertScrollBar.Position;
  FShape.BoundsRect := Rect(cx, cy, cx, cy);
end;

procedure TImageBox.ImageBoxMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  cx,cy: Integer;
begin
  if FFlag then
  begin
    cx := X - HorzScrollBar.Position;
    cy := Y - VertScrollBar.Position;
    if FFlag then FShape.BoundsRect := Rect(FShape.Left, FShape.Top, cx, cy);
  end else
    FShape.BoundsRect := Rect(0, 0, 0, 0);
end;

procedure TImageBox.ImageBoxMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  R: TRect;
begin
  if not FFlag then Exit;
  FFlag := False;
  if FShape.Width * FShape.Height < 100 then Exit;

  if FShape.Width < 0 then
  begin
    FShape.Left := FShape.Left + FShape.Width;
    FShape.Width := -FShape.Width;
  end;
  if FShape.Height < 0 then
  begin
    FShape.Top := FShape.Top + FShape.Height;
    FShape.Height := -FShape.Height;
  end;
  FBitmap.Width  := FShape.Width;
  FBitmap.Height := FShape.Height;
  R := FShape.BoundsRect;
  OffsetRect(R, HorzScrollBar.Position, VertScrollBar.Position);
  FBitmap.Canvas.CopyRect(FShape.ClientRect, FImage.Canvas, R);
  if Assigned(FOutImage) then with FOutImage do
  begin
    AutoSize := True;
    Picture.Bitmap.Assign(FBitmap);
    Left := (Parent.ClientWidth - FOutImage.Width) div 2;
    Top := (Parent.ClientHeight - Height) div 2;
    Visible := True;
  end;
end;

procedure TImageBox.SetOutImage(const Value: TImage);
begin
  FOutImage := Value;
end;

end.

MoveImage:

---

unit MoveImage;

interface

uses
  Windows, Classes, Graphics, Controls, ExtCtrls;

type
  TMoveImage = class(TImage)
  private
    FFlag: Boolean;
    FX,FY: Integer;
    FSelected: Boolean;
    procedure SetSelected(const Value: Boolean);
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    property Selected: Boolean read FSelected write SetSelected;
  end;

var
  List: TList;

implementation

{ TMoveImage }

constructor TMoveImage.Create(AOwner: TComponent);
begin
  inherited;
  Parent := TWinControl(AOwner);
  Left := (TWinControl(AOwner).ClientWidth - Width) div 2;
  Top := (TWinControl(AOwner).ClientHeight - Height) div 2;
end;

procedure TMoveImage.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  FFlag := True;
  FX := X;
  FY := Y;
  Selected := True;
end;

procedure TMoveImage.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
begin
  inherited;
  if FFlag then
  begin
    Left := Left + X - FX;
    Top := Top + Y - FY;
    for i := 0 to List.Count - 1 do
      if (TMoveImage(List[i]) <> Self) and (TMoveImage(List[i]).Selected) then
      begin
        TMoveImage(List[i]).Left := TMoveImage(List[i]).Left + X - FX;
        TMoveImage(List[i]).Top := TMoveImage(List[i]).Top + Y - FY;
      end;
  end;
end;

procedure TMoveImage.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  FFlag := False;
  if not (ssCtrl in Shift) then
    Selected := False;
end;

procedure TMoveImage.SetSelected(const Value: Boolean);
var
  bit: TBitmap;
begin
  if Value <> FSelected then
  begin
    FSelected := Value;
    bit := TBitmap.Create;
    bit.Width := Width;
    bit.Height := Height;
    BitBlt(Canvas.Handle, 0, 0, Width, Height, bit.Canvas.Handle, 0, 0, SRCINVERT);
    Repaint;
    bit.Free;
  end;
end;

end.