unit BitmapWindow;

interface

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

type
  TBitmapWindow = class(TGraphicControl)
  private
    FOldParentPos : TPoint;
    FOldParentSize : TPoint;
    FOldMousePos : TPoint;
    FState : TObject;
    FStateNull : TObject;
    FStateNormal : TObject;
    FStateLeftTop : TObject;
    FStateTopLine : TObject;
    FStateRightTop : TObject;
    FStateLeftLine : TObject;
    FStateRightLine : TObject;
    FStateLeftBottom : TObject;
    FStateBottomLine : TObject;
    FStateRightBottom : TObject;
    procedure SetState(const Value: TObject);
    property State : TObject read FState write SetState;
  private
    FCellWidth, FCellHeight : integer;
    procedure do_DrawBackground(Screen:TBitmap);
    procedure do_DrawTopLine(Screen:TBitmap);
    procedure do_DrawBottomLine(Screen:TBitmap);
    procedure do_DrawLeftLine(Screen:TBitmap);
    procedure do_DrawRightLine(Screen:TBitmap);
    procedure do_DrawLeftTop(Screen:TBitmap);
    procedure do_DrawRightTop(Screen:TBitmap);
    procedure do_DrawLeftBottom(Screen:TBitmap);
    procedure do_DrawRightBottom(Screen:TBitmap);
  protected
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseDown(Button:TMouseButton; Shift:TShiftState; X,Y:Integer); override;
    procedure MouseUp(Button:TMouseButton; Shift:TShiftState; X,Y:Integer); override;
  private
    FBitmap : TBitmap;
    FActiveMouse: Boolean;
    procedure SetBitmap(const Value: TBitmap);
    procedure SetActiveMouse(const Value: Boolean);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Align;
    property ShowHint;
    property Bitmap : TBitmap read FBitmap write SetBitmap;
    property ActiveMouse: Boolean read FActiveMouse write SetActiveMouse;
  end;

procedure Register;

implementation

uses
  BMath;

procedure Register;
begin
  RegisterComponents('RyuLib', [TBitmapWindow]);
end;

type
  TState = class (TComponent)
  private
    function Parent:TBitmapWindow;
    procedure set_MouseType(X,Y:integer);
  public
    procedure MouseDown(Button:TMouseButton; Shift:TShiftState; X,Y:Integer); virtual;
    procedure MouseMove(Shift:TShiftState; X,Y:Integer); virtual;
    procedure MouseUp(Button:TMouseButton; Shift:TShiftState; X,Y:Integer); virtual;
  end;

  TStateNull = class(TState)
  public
    procedure MouseDown(Button:TMouseButton; Shift:TShiftState; X,Y:Integer); override;
    procedure MouseMove(Shift:TShiftState; X,Y:Integer); override;
    procedure MouseUp(Button:TMouseButton; Shift:TShiftState; X,Y:Integer); override;
  end;

  TStateNormal = class (TState)
  private
  public
    procedure MouseMove(Shift:TShiftState; X,Y:Integer); override;
  end;

  TStateLeftTop = class (TState)
  private
  public
    procedure MouseMove(Shift:TShiftState; X,Y:Integer); override;
  end;

  TStateTopLine = class (TState)
  private
  public
    procedure MouseMove(Shift:TShiftState; X,Y:Integer); override;
  end;

  TStateRightTop = class (TState)
  private
  public
    procedure MouseMove(Shift:TShiftState; X,Y:Integer); override;
  end;

  TStateLeftLine = class (TState)
  private
  public
    procedure MouseMove(Shift:TShiftState; X,Y:Integer); override;
  end;

  TStateRightLine = class (TState)
  private
  public
    procedure MouseMove(Shift:TShiftState; X,Y:Integer); override;
  end;

  TStateLeftBottom = class (TState)
  private
  public
    procedure MouseMove(Shift:TShiftState; X,Y:Integer); override;
  end;

  TStateBottomLine = class (TState)
  private
  public
    procedure MouseMove(Shift:TShiftState; X,Y:Integer); override;
  end;

  TStateRightBottom = class (TState)
  private
  public
    procedure MouseMove(Shift:TShiftState; X,Y:Integer); override;
  end;


{ TBitmapWindow }

constructor TBitmapWindow.Create(AOwner: TComponent);
begin
  inherited;

  FStateNull := TStateNull.Create(Self);
  FStateNormal := TStateNormal.Create(Self);
  FStateLeftTop := TStateLeftTop.Create(Self);
  FStateTopLine := TStateTopLine.Create(Self);
  FStateRightTop := TStateRightTop.Create(Self);
  FStateLeftLine := TStateLeftLine.Create(Self);
  FStateRightLine := TStateRightLine.Create(Self);
  FStateLeftBottom := TStateLeftBottom.Create(Self);
  FStateBottomLine := TStateBottomLine.Create(Self);
  FStateRightBottom := TStateRightBottom.Create(Self);
  FState := FStateNormal;

  FBitmap := TBitmap.Create;
end;

destructor TBitmapWindow.Destroy;
begin
  FBitmap.Free;

  FState := nil;
  FStateNull.Free;
  FStateNormal.Free;
  FStateLeftTop.Free;
  FStateTopLine.Free;
  FStateRightTop.Free;
  FStateLeftLine.Free;
  FStateRightLine.Free;
  FStateLeftBottom.Free;
  FStateBottomLine.Free;
  FStateRightBottom.Free;

  inherited;
end;

procedure TBitmapWindow.do_DrawBackground(Screen: TBitmap);
var
  Src, Dst : TRect;
  LoopX, LoopY : integer;
begin
  Src := Bounds(FCellWidth, FCellHeight, FCellWidth, FCellHeight);

  for LoopY := 1 to Screen.Height div FCellHeight do
  for LoopX := 1 to Screen.Width div FCellWidth do begin
    Dst := Bounds(FCellWidth*(LoopX-1), FCellHeight*(LoopY-1), FCellWidth, FCellHeight);
    Screen.Canvas.CopyRect(Dst, FBitmap.Canvas, Src);
  end;
end;

procedure TBitmapWindow.do_DrawBottomLine(Screen: TBitmap);
var
  Src, Dst : TRect;
begin
  Src := Bounds(FCellWidth, FCellHeight*2, FCellWidth, FCellHeight);
  Dst := Bounds(0, Screen.Height-FCellHeight, FCellWidth, FCellHeight);

  repeat
    Screen.Canvas.CopyRect(Dst, FBitmap.Canvas, Src);
    Dst := Bounds(Dst.Left + FCellWidth, Dst.Top, FCellWidth, FCellHeight);
  until Dst.Left >= Screen.Width;
end;

procedure TBitmapWindow.do_DrawLeftBottom(Screen: TBitmap);
var
  Src, Dst : TRect;
begin
  Src := Bounds(0, FCellHeight*2, FCellWidth, FCellHeight);
  Dst := Bounds(0, Screen.Height-FCellHeight, FCellWidth, FCellHeight);

  Screen.Canvas.CopyRect(Dst, FBitmap.Canvas, Src);
end;

procedure TBitmapWindow.do_DrawLeftLine(Screen: TBitmap);
var
  Src, Dst : TRect;
begin
  Src := Bounds(0, FCellHeight, FCellWidth, FCellHeight);
  Dst := Bounds(0, 0, FCellWidth, FCellHeight);

  repeat
    Screen.Canvas.CopyRect(Dst, FBitmap.Canvas, Src);
    Dst := Bounds(Dst.Left, Dst.Top+FCellHeight, FCellWidth, FCellHeight);
  until Dst.Top >= Screen.Height;
end;

procedure TBitmapWindow.do_DrawLeftTop(Screen: TBitmap);
var
  Src, Dst : TRect;
begin
  Src := Bounds(0, 0, FCellWidth, FCellHeight);
  Dst := Bounds(0, 0, FCellWidth, FCellHeight);

  Screen.Canvas.CopyRect(Dst, FBitmap.Canvas, Src);
end;

procedure TBitmapWindow.do_DrawRightBottom(Screen: TBitmap);
var
  Src, Dst : TRect;
begin
  Src := Bounds(FCellWidth*2, FCellHeight*2, FCellWidth, FCellHeight);
  Dst := Bounds(Screen.Width-FCellWidth, Screen.Height-FCellHeight, FCellWidth, FCellHeight);

  Screen.Canvas.CopyRect(Dst, FBitmap.Canvas, Src);
end;

procedure TBitmapWindow.do_DrawRightLine(Screen: TBitmap);
var
  Src, Dst : TRect;
begin
  Src := Bounds(FCellWidth*2, FCellHeight, FCellWidth, FCellHeight);
  Dst := Bounds(Screen.Width-FCellWidth, 0, FCellWidth, FCellHeight);

  repeat
    Screen.Canvas.CopyRect(Dst, FBitmap.Canvas, Src);
    Dst := Bounds(Dst.Left, Dst.Top+FCellHeight, FCellWidth, FCellHeight);
  until Dst.Top >= Screen.Height;
end;

procedure TBitmapWindow.do_DrawRightTop(Screen: TBitmap);
var
  Src, Dst : TRect;
begin
  Src := Bounds(FCellWidth*2, 0, FCellWidth, FCellHeight);
  Dst := Bounds(Screen.Width-FCellWidth, 0, FCellWidth, FCellHeight);

  Screen.Canvas.CopyRect(Dst, FBitmap.Canvas, Src);
end;

procedure TBitmapWindow.do_DrawTopLine(Screen: TBitmap);
var
  Src, Dst : TRect;
begin
  Src := Bounds(FCellWidth, 0, FCellWidth, FCellHeight);
  Dst := Bounds(0, 0, FCellWidth, FCellHeight);

  repeat
    Screen.Canvas.CopyRect(Dst, FBitmap.Canvas, Src);
    Dst := Bounds(Dst.Left + FCellWidth, Dst.Top, FCellWidth, FCellHeight);
  until Dst.Left >= Screen.Width;
end;

procedure TBitmapWindow.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;

  TState(State).MouseDown(Button, Shift, X, Y);
end;

procedure TBitmapWindow.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited;

  TState(State).MouseMove(Shift, X, Y);
end;

procedure TBitmapWindow.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;

  TState(State).MouseUp(Button, Shift, X, Y);
end;


procedure TBitmapWindow.Paint;
var
  Screen : TBitmap;
begin
  inherited;

  FCellWidth := FBitmap.Width div 3;
  FCellHeight := FBitmap.Height div 3;
  if FCellWidth * FCellHeight = 0 then Exit;

  if csDesigning in ComponentState then
  with inherited Canvas do begin
    Pen.Style := psDash;
    Brush.Style := bsClear;
    Rectangle(0, 0, Width, Height);
  end;

  Screen := TBitmap.Create;
  try
    Screen.Width := Width;
    Screen.Height := Height;

    do_DrawBackground(Screen);
    do_DrawTopLine(Screen);
    do_DrawBottomLine(Screen);
    do_DrawLeftLine(Screen);
    do_DrawRightLine(Screen);
    do_DrawLeftTop(Screen);
    do_DrawRightTop(Screen);
    do_DrawLeftBottom(Screen);
    do_DrawRightBottom(Screen);

    Canvas.Draw(0, 0, Screen);
  finally
    Screen.Free;
  end;
end;

procedure TBitmapWindow.SetActiveMouse(const Value: Boolean);
begin
  FActiveMouse := Value;
  if FActiveMouse then FState := FStateNormal
  else FState := FStateNull;
end;

procedure TBitmapWindow.SetBitmap(const Value: TBitmap);
begin
  FBitmap.Assign(Value);
  Repaint;
end;

procedure TBitmapWindow.SetState(const Value: TObject);
begin
  FState := Value;
end;

{ TState }

procedure TState.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  if Parent.Parent = nil then Exit;

  Parent.FOldParentPos := Point(Parent.Parent.Left, Parent.Parent.Top);
  Parent.FOldParentSize := Point(Parent.Parent.Width, Parent.Parent.Height);
  GetCursorPos(Parent.FOldMousePos);

  if Parent.FCellWidth * Parent.FCellHeight = 0 then begin
    Parent.State := Parent.FStateNormal;
    Exit;
  end;

  with Parent do
    if BoxIn(X, Y, 0, 0, FCellWidth, FCellHeight) then State := FStateLeftTop
    else if BoxIn(X, Y, FCellWidth, 0, Width-FCellWidth, FCellHeight) then State := FStateTopLine
    else if BoxIn(X, Y, Width-FCellWidth, 0, Width, FCellHeight) then State := FStateRightTop
    else if BoxIn(X, Y, 0, FCellHeight, FCellWidth, Height-FCellHeight) then State := FStateLeftLine
    else if BoxIn(X, Y, Width-FCellWidth, FCellHeight, Width, Height-FCellHeight) then State := FStateRightLine
    else if BoxIn(X, Y, 0, Height-FCellHeight, FCellWidth, Height) then State := FStateLeftBottom
    else if BoxIn(X, Y, FCellWidth, Height-FCellHeight, Width-FCellWidth, Height) then State := FStateBottomLine
    else if BoxIn(X, Y, Width-FCellWidth, Height-FCellHeight, Width, Height) then State := FStateRightBottom
    else State := FStateNormal;
end;

procedure TState.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  set_MouseType(X, Y)
end;

procedure TState.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  Parent.State := Parent.FStateNormal;
end;

function TState.Parent: TBitmapWindow;
begin
  Result := Pointer(Owner);
end;

procedure TState.set_MouseType(X,Y:integer);
begin
  if Parent.FCellWidth * Parent.FCellHeight = 0 then begin
    Parent.Cursor := crDefault;
    Exit;
  end;

  with Parent do
    if BoxIn(X, Y, 0, 0, FCellWidth, FCellHeight) then Cursor := crSizeNWSE
    else if BoxIn(X, Y, FCellWidth, 0, Width-FCellWidth, FCellHeight) then Cursor := crSizeNS
    else if BoxIn(X, Y, Width-FCellWidth, 0, Width, FCellHeight) then Cursor := crSizeNESW
    else if BoxIn(X, Y, 0, FCellHeight, FCellWidth, Height-FCellHeight) then Cursor := crSizeWE
    else if BoxIn(X, Y, Width-FCellWidth, FCellHeight, Width, Height-FCellHeight) then Cursor := crSizeWE
    else if BoxIn(X, Y, 0, Height-FCellHeight, FCellWidth, Height) then Cursor := crSizeNESW
    else if BoxIn(X, Y, FCellWidth, Height-FCellHeight, Width-FCellWidth, Height) then Cursor := crSizeNS
    else if BoxIn(X, Y, Width-FCellWidth, Height-FCellHeight, Width, Height) then Cursor := crSizeNWSE
    else Cursor := crDefault;
end;

{ TStateNormal }

procedure TStateNormal.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  iX, iY : integer;
  MousePos : TPoint;
begin
  inherited;
  if Parent.Parent = nil then Exit;
  if Shift <> [ssLeft] then Exit;

  GetCursorPos(MousePos);

  iX := MousePos.X - Parent.FOldMousePos.X;
  iY := MousePos.Y - Parent.FOldMousePos.Y;

  Parent.Parent.Left := Parent.FOldParentPos.X + iX;
  Parent.Parent.Top  := Parent.FOldParentPos.Y + iY;
end;

{ TStateLeftTop }

procedure TStateLeftTop.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  iX, iY : integer;
  MousePos : TPoint;
begin
  inherited;
  if Parent.Parent = nil then Exit;
  if Shift <> [ssLeft] then Exit;

  GetCursorPos(MousePos);

  iX := MousePos.X - Parent.FOldMousePos.X;
  iY := MousePos.Y - Parent.FOldMousePos.Y;

  Parent.Parent.Left := Parent.FOldParentPos.X + iX;
  Parent.Parent.Top  := Parent.FOldParentPos.Y + iY;
  Parent.Parent.Width := Parent.FOldParentSize.X - iX;
  Parent.Parent.Height := Parent.FOldParentSize.Y - iY;
end;

{ TStateTopLine }

procedure TStateTopLine.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  iY : integer;
  MousePos : TPoint;
begin
  inherited;
  if Parent.Parent = nil then Exit;
  if Shift <> [ssLeft] then Exit;

  GetCursorPos(MousePos);

  iY := MousePos.Y - Parent.FOldMousePos.Y;

  Parent.Parent.Top  := Parent.FOldParentPos.Y + iY;
  Parent.Parent.Height := Parent.FOldParentSize.Y - iY;
end;

{ TStateRightTop }

procedure TStateRightTop.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  iX, iY : integer;
  MousePos : TPoint;
begin
  inherited;
  if Parent.Parent = nil then Exit;
  if Shift <> [ssLeft] then Exit;

  GetCursorPos(MousePos);

  iX := MousePos.X - Parent.FOldMousePos.X;
  iY := MousePos.Y - Parent.FOldMousePos.Y;

  Parent.Parent.Top  := Parent.FOldParentPos.Y + iY;
  Parent.Parent.Width := Parent.FOldParentSize.X + iX;
  Parent.Parent.Height := Parent.FOldParentSize.Y - iY;
end;

{ TStateLeftLine }

procedure TStateLeftLine.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  iX : integer;
  MousePos : TPoint;
begin
  inherited;
  if Parent.Parent = nil then Exit;
  if Shift <> [ssLeft] then Exit;

  GetCursorPos(MousePos);

  iX := MousePos.X - Parent.FOldMousePos.X;

  Parent.Parent.Left := Parent.FOldParentPos.X + iX;
  Parent.Parent.Width := Parent.FOldParentSize.X - iX;
end;

{ TStateRightLine }

procedure TStateRightLine.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  iX : integer;
  MousePos : TPoint;
begin
  inherited;
  if Parent.Parent = nil then Exit;
  if Shift <> [ssLeft] then Exit;

  GetCursorPos(MousePos);

  iX := MousePos.X - Parent.FOldMousePos.X;

  Parent.Parent.Width := Parent.FOldParentSize.X + iX;
end;

{ TStateLeftBottom }

procedure TStateLeftBottom.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  iX, iY : integer;
  MousePos : TPoint;
begin
  inherited;
  if Parent.Parent = nil then Exit;
  if Shift <> [ssLeft] then Exit;

  GetCursorPos(MousePos);

  iX := MousePos.X - Parent.FOldMousePos.X;
  iY := MousePos.Y - Parent.FOldMousePos.Y;

  Parent.Parent.Left := Parent.FOldParentPos.X + iX;
  Parent.Parent.Width := Parent.FOldParentSize.X - iX;
  Parent.Parent.Height := Parent.FOldParentSize.Y + iY;
end;

{ TStateBottomLine }

procedure TStateBottomLine.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  iY : integer;
  MousePos : TPoint;
begin
  inherited;
  if Parent.Parent = nil then Exit;
  if Shift <> [ssLeft] then Exit;

  GetCursorPos(MousePos);

  iY := MousePos.Y - Parent.FOldMousePos.Y;

  Parent.Parent.Height := Parent.FOldParentSize.Y + iY;
end;

{ TStateRightBottom }

procedure TStateRightBottom.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  iX, iY : integer;
  MousePos : TPoint;
begin
  inherited;
  if Parent.Parent = nil then Exit;
  if Shift <> [ssLeft] then Exit;

  GetCursorPos(MousePos);

  iX := MousePos.X - Parent.FOldMousePos.X;
  iY := MousePos.Y - Parent.FOldMousePos.Y;

  Parent.Parent.Width := Parent.FOldParentSize.X + iX;
  Parent.Parent.Height := Parent.FOldParentSize.Y + iY;
end;

{ TStateNull }

procedure TStateNull.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
end;

procedure TStateNull.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
end;

procedure TStateNull.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
end;

end.
