unit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ExtCtrls, JPeg, ExtDlgs, StdCtrls, G32, G32_Image, G32_Layers,
  G32_RangeBars, G32_Filters, G32_Transforms;

type
  TMainForm = class(TForm)
    ImgView: TImgView32;
    SidePanel: TPanel;
    MainMenu: TMainMenu;
    mnFileNew: TMenuItem;
    mnFile: TMenuItem;
    mnFileOpen: TMenuItem;
    mnLayers: TMenuItem;
    mnNewBitmapLayer: TMenuItem;
    mnDelete: TMenuItem;
    OpenPictureDialog1: TOpenPictureDialog;
    pnlImage: TPanel;
    ScaleCombo: TComboBox;
    Label1: TLabel;
    Panel2: TPanel;
    ImageInterpolate: TCheckBox;
    pnlBitmapLayer: TPanel;
    Panel3: TPanel;
    Label2: TLabel;
    LayerOpacity: TGaugeBar;
    LayerInterpolate: TCheckBox;
    mnNewBitmapRGBA: TMenuItem;
    LayerRescale: TButton;
    LayerResetScale: TButton;
    Cropped: TCheckBox;
    mnNewCustomLayer: TMenuItem;
    mnMagnifier: TMenuItem;
    PnlMagn: TPanel;
    Label3: TLabel;
    Panel4: TPanel;
    MagnOpacity: TGaugeBar;
    SaveDialog1: TSaveDialog;
    Label4: TLabel;
    MagnMagnification: TGaugeBar;
    Label5: TLabel;
    MagnRotation: TGaugeBar;
    MagnInterpolate: TCheckBox;
    mnSimpleDrawing: TMenuItem;
    mnArrange: TMenuItem;
    mnBringFront: TMenuItem;
    mnSendBack: TMenuItem;
    N1: TMenuItem;
    mnLevelUp: TMenuItem;
    mnLevelDown: TMenuItem;
    N2: TMenuItem;
    mnScaled: TMenuItem;
    N4: TMenuItem;
    mnFlatten: TMenuItem;
    procedure mnFileNewClick(Sender: TObject);
    procedure mnFileOpenClick(Sender: TObject);
    procedure mnNewBitmapLayerClick(Sender: TObject);
    procedure mnDeleteClick(Sender: TObject);
    procedure ScaleComboChange(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure mnLayersClick(Sender: TObject);
    procedure ImageInterpolateClick(Sender: TObject);
    procedure LayerOpacityChange(Sender: TObject);
    procedure LayerInterpolateClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure mnNewBitmapRGBAClick(Sender: TObject);
    procedure LayerRescaleClick(Sender: TObject);
    procedure LayerResetScaleClick(Sender: TObject);
    procedure CroppedClick(Sender: TObject);
    procedure mnMagnifierClick(Sender: TObject);
    procedure MagnChange(Sender: TObject);
    procedure mnSimpleDrawingClick(Sender: TObject);
    procedure mnArrangeClick(Sender: TObject);
    procedure mnScaledClick(Sender: TObject);
    procedure mnReorder(Sender: TObject);
    procedure ImgViewMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
    procedure ImgViewPaintStage(Sender: TObject; Buffer: TBitmap32;
      StageNum: Cardinal);
    procedure mnFlattenClick(Sender: TObject);
    procedure ImgViewMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure ImgViewMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
  private
    FSelection: TPositionedLayer;
    procedure SetSelection(Value: TPositionedLayer);
    procedure WMEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND;
  protected
    RBLayer: TRubberbandLayer;
    function CreatePositionedLayer: TPositionedLayer;
    procedure LayerMouseDown(Sender: TObject; Buttons: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure RBResizing(Sender: TObject; const OldLocation: TFloatRect; var NewLocation: TFloatRect; DragState: TDragState; Shift: TShiftState);
    procedure PaintMagnifierHandler(Sender: TObject; Buffer: TBitmap32);
    procedure PaintSimpleDrawingHandler(Sender: TObject; Buffer: TBitmap32);
  public
    procedure CreateNewImage(AWidth, AHeight: Integer; FillColor: TColor32);
    procedure OpenImage(const FileName: string);
    property Selection: TPositionedLayer read FSelection write SetSelection;
  end;

var
  MainForm: TMainForm;

implementation

uses NewImageUnit, RGBALoaderUnit, Math;

{$R *.DFM}

{ TForm1 }

procedure TMainForm.CreateNewImage(AWidth, AHeight: Integer; FillColor: TColor32);
begin
  with ImgView do
  begin
    Selection := nil;
    RBLayer := nil;
    Layers.Clear;
    Scale := 1;
    Bitmap.SetSize(AWidth, AHeight);
    Bitmap.Clear(FillColor);
    pnlImage.Visible := not Bitmap.Empty;
  end;
end;

function TMainForm.CreatePositionedLayer: TPositionedLayer;
var
  P: TPoint;
begin
  // get coordinates of the center of viewport
  with ImgView.GetViewportRect do
    P := ImgView.ControlToBitmap(Point((Right + Left) div 2, (Top + Bottom) div 2));

  Result := TPositionedLayer.Create(ImgView.Layers);
  Result.Location := FloatRect(P.X - 32, P.Y - 32, P.X + 32, P.Y + 32);
  Result.Scaled := True;
  Result.MouseEvents := True;
  Result.OnMouseDown := LayerMouseDown;
end;

procedure TMainForm.CroppedClick(Sender: TObject);
begin
  if Selection is TBitmapLayer then
    TBitmapLayer(Selection).Cropped := Cropped.Checked;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  // by default, PST_CLEAR_BACKGND is executed at this stage,
  // which, in turn, calls ExecClearBackgnd method of ImgView.
  // Here I substitute PST_CLEAR_BACKGND with PST_CUSTOM, so force ImgView
  // to call the OnPaintStage event instead of performing default action.
  with ImgView.PaintStages[0]^ do
  begin
    if Stage = PST_CLEAR_BACKGND then Stage := PST_CUSTOM;
  end;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  Selection := nil;
  RBLayer := nil;
end;

procedure TMainForm.ImageInterpolateClick(Sender: TObject);
const
  STRETCH_FILTER: array [Boolean] of TStretchFilter = (sfNearest, sfLinear);
begin
  ImgView.Bitmap.StretchFilter := STRETCH_FILTER[ImageInterpolate.Checked];
end;

procedure TMainForm.LayerInterpolateClick(Sender: TObject);
const
  STRETCH_FILTER: array [Boolean] of TStretchFilter = (sfNearest, sfLinear);
begin
  if Selection is TBitmapLayer then
  begin
    TBitmapLayer(Selection).Bitmap.StretchFilter := STRETCH_FILTER[LayerInterpolate.Checked];
  end;
end;

procedure TMainForm.LayerMouseDown(Sender: TObject; Buttons: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Sender <> nil then Selection := TPositionedLayer(Sender);
end;

procedure TMainForm.LayerOpacityChange(Sender: TObject);
begin
  if Selection is TBitmapLayer then
    TBitmapLayer(Selection).Bitmap.MasterAlpha := LayerOpacity.Position;
end;

procedure TMainForm.LayerRescaleClick(Sender: TObject);
var
  T: TBitmap32;
begin
  // resize the layer's bitmap to the size of the layer
  if Selection is TBitmapLayer then
    with TBitmapLayer(Selection) do
    begin
      T := TBitmap32.Create;
      T.Assign(Bitmap);
      with Rect(Location) do
        Bitmap.SetSize(Right - Left, Bottom - Top);
      T.StretchFilter := sfLinear;
      T.DrawMode := dmOpaque;
      T.DrawTo(Bitmap, Rect(0, 0, Bitmap.Width, Bitmap.Height));
      T.Free;
      LayerResetScaleClick(Self);
    end;
end;

procedure TMainForm.LayerResetScaleClick(Sender: TObject);
var
  L: TFloatRect;
begin
  // resize the layer to the size of its bitmap
  if Selection is TBitmapLayer then
    with RBLayer, TBitmapLayer(Selection).Bitmap do
    begin
      L := Location;
      L.Right := L.Left + Width;
      L.Bottom := L.Top + Height;
      Location := L;
      Changed;
    end;
end;

procedure TMainForm.MagnChange(Sender: TObject);
begin
  ImgView.Invalidate;
end;

procedure TMainForm.mnArrangeClick(Sender: TObject);
var
  B: Boolean;
begin
  B := Selection <> nil;
  mnBringFront.Enabled := B and (Selection.Index < ImgView.Layers.Count - 2);
  mnSendBack.Enabled := B and (Selection.Index > 0);
  mnLevelUp.Enabled := B and (Selection.Index < ImgView.Layers.Count - 2);
  mnLevelDown.Enabled := B and (Selection.Index > 0);
  mnScaled.Enabled := B;
  mnScaled.Checked := B and Selection.Scaled;
  mnDelete.Enabled := B;
end;

procedure TMainForm.mnDeleteClick(Sender: TObject);
var
  ALayer: TPositionedLayer;
begin
  if Selection <> nil then
  begin
    ALayer := Selection;
    Selection := nil;
    ALayer.Free;
  end;
end;

procedure TMainForm.mnFileNewClick(Sender: TObject);
begin
  with NewImageForm do
  begin
    ShowModal;
    if ModalResult = mrOK then
      CreateNewImage(UpDown1.Position, UpDown2.Position, Color32(Panel1.Color));
  end;
end;

procedure TMainForm.mnFileOpenClick(Sender: TObject);
begin
  with OpenPictureDialog1 do
    if Execute then OpenImage(FileName);
end;

procedure TMainForm.mnLayersClick(Sender: TObject);
var
  B: Boolean;
begin
  B := not ImgView.Bitmap.Empty;
  mnNewBitmapLayer.Enabled := B;
  mnNewBitmapRGBA.Enabled := B;
  mnNewCustomLayer.Enabled := B;
  mnFlatten.Enabled := B and (ImgView.Layers.Count > 0);
end;

procedure TMainForm.mnMagnifierClick(Sender: TObject);
var
  L: TPositionedLayer;
begin
  L := CreatePositionedLayer;
  L.OnPaint := PaintMagnifierHandler;
  L.Tag := 2;
  Selection := L;
end;

procedure TMainForm.mnNewBitmapLayerClick(Sender: TObject);
var
  B: TBitmapLayer;
  P: TPoint;
  W, H: Single;
begin
  with OpenPictureDialog1 do
    if Execute then
    begin
      B := TBitmapLayer.Create(ImgView.Layers);
      with B do
      try
        Bitmap.LoadFromFile(FileName);
        Bitmap.DrawMode := dmBlend;

        with ImgView.GetViewportRect do
          P := ImgView.ControlToBitmap(Point((Right + Left) div 2, (Top + Bottom) div 2));

        W := Bitmap.Width / 2;
        H := Bitmap.Height / 2;

        with ImgView.Bitmap do
          Location := FloatRect(P.X - W, P.Y - H, P.X + W, P.Y + H);

        Scaled := True;
        OnMouseDown := LayerMouseDown;
      except
        Free;
        raise;
      end;
      Selection := B;
    end;
end;

procedure TMainForm.mnNewBitmapRGBAClick(Sender: TObject);
var
  B: TBitmapLayer;
  P: TPoint;
  Tmp: TBitmap32;
  W, H: Single;
begin
  with RGBALoaderForm do
  begin
    ImgRGB.Bitmap.Delete;
    ImgRGB.Scale := 1;
    ImgAlpha.Bitmap.Delete;
    ImgAlpha.Scale := 1;
    ShowModal;
    if (ModalResult = mrOK) and not ImgRGB.Bitmap.Empty then
    begin
      B := TBitmapLayer.Create(ImgView.Layers);
      B.Bitmap := ImgRGB.Bitmap;
      B.Bitmap.DrawMode := dmBlend; 

      if not ImgAlpha.Bitmap.Empty then
      begin
        Tmp := TBitmap32.Create;
        try
          Tmp.SetSize(B.Bitmap.Width, B.Bitmap.Height);
          ImgAlpha.Bitmap.DrawTo(Tmp, Rect(0, 0, Tmp.Width, Tmp.Height));

          // combine Alpha into already loaded RGB colors
          IntensityToAlpha(B.Bitmap, Tmp);
        finally
          Tmp.Free;
        end;
      end;

      with ImgView.GetViewportRect do
        P := ImgView.ControlToBitmap(Point((Right + Left) div 2, (Top + Bottom) div 2));

      with B do
      begin
        W := Bitmap.Width / 2;
        H := Bitmap.Height / 2;

        with ImgView.Bitmap do
          Location := FloatRect(P.X - W, P.Y - H, P.X + W, P.Y + H);

        Scaled := True;
        OnMouseDown := LayerMouseDown;
      end;
      Selection := B;
    end;
  end;
end;

procedure TMainForm.mnReorder(Sender: TObject);
begin
  // note that the top-most layer is occupied with the rubber-banding layer
  if Selection <> nil then
    case TMenuItem(Sender).Tag of
      1: // Bring to front, do not use BringToFront here, see note above
        Selection.Index := ImgView.Layers.Count - 2; 
      2: Selection.SendToBack;
      3: Selection.Index := Selection.Index + 1; // up one level
      4: Selection.Index := Selection.Index - 1; // down one level
    end;
end;

procedure TMainForm.mnSimpleDrawingClick(Sender: TObject);
var
  L: TPositionedLayer;
begin
  L := CreatePositionedLayer;
  L.OnPaint := PaintSimpleDrawingHandler;
  L.Tag := 1;
  Selection := L;
end;

procedure TMainForm.OpenImage(const FileName: string);
begin
  with ImgView do
  try
    Selection := nil;
    RBLayer := nil;
    Layers.Clear;
    Scale := 1;
    Bitmap.LoadFromFile(FileName);
  finally
    pnlImage.Visible := not Bitmap.Empty;
  end;
end;

procedure TMainForm.PaintMagnifierHandler(Sender: TObject; Buffer: TBitmap32);
var
  Magnification, Rotation: Single;
  SrcRect, DstRect: TFloatRect;
  R: TRect;
  T: TAffineTransformation;
  B: TBitmap32;
  W2, H2: Single;
  I: Integer;
begin
  if Sender is TPositionedLayer then
    with TPositionedLayer(Sender) do
    begin
      Magnification := Power(10, (MagnMagnification.Position / 50));
      Rotation := -MagnRotation.Position;

      DstRect := GetAdjustedLocation;
      R := Rect(DstRect);
      B := TBitmap32.Create;
      try
        with R do
        begin
          B.SetSize(Right - Left, Bottom - Top);
          W2 := (Right - Left) / 2;
          H2 := (Bottom - Top) / 2;
        end;

        SrcRect := DstRect;
        with SrcRect do
        begin
          Left := Left - H2;
          Right := Right + H2;
          Top := Top - W2;
          Bottom := Bottom + W2;
        end;

        T := TAffineTransformation.Create;
        try
          T.SrcRect := SrcRect;
          T.Translate(-R.Left, -R.Top);

          T.Translate(-W2, -H2);
          T.Scale(Magnification, Magnification);
          T.Rotate(0, 0, Rotation);
          T.Translate(W2, H2);

          if MagnInterpolate.Checked then
          begin
            Buffer.BeginUpdate;
            Buffer.StretchFilter := sfLinear;
            Transform(B, Buffer, T);
            Buffer.StretchFilter := sfNearest;
            Buffer.EndUpdate;
          end
          else
             Transform(B, Buffer, T);

          B.ResetAlpha;
          B.DrawMode := dmBlend;
          B.MasterAlpha := MagnOpacity.Position;
          B.DrawTo(Buffer, R);

          // draw frame
          for I := 0 to 4 do
          begin
             with R do Buffer.RaiseRectTS(Left, Top, Right, Bottom, 35 - I * 8);
             InflateRect(R, -1, -1);
          end;
        finally
          T.Free;
        end;
      finally
        B.Free;
      end;
    end;
end;

procedure TMainForm.PaintSimpleDrawingHandler(Sender: TObject; Buffer: TBitmap32);
var
  Cx, Cy: Single;
  W2, H2: Single;
  I: Integer;
begin
  if Sender is TPositionedLayer then
    with TPositionedLayer(Sender).GetAdjustedLocation do
    begin
      W2 := (Right - Left) / 2;
      H2 := (Bottom - Top) / 2;
      Cx := Left + W2;
      Cy := Top + H2;
      Buffer.PenColor := clRed32;
      Buffer.MoveToF(Cx,Cy);
      for I := 0 to 240 do
      begin
        Buffer.LineToFS(Cx + W2 * I / 200 * Cos(I / 8), Cy + H2 * I / 200 * Sin(I / 8));
      end;
    end;
end;

procedure TMainForm.ScaleComboChange(Sender: TObject);
var
  S: string;
  I: Integer;
begin
  S := ScaleCombo.Text;
  S := StringReplace(S, '%', '', [rfReplaceAll]);
  S := StringReplace(S, ' ', '', [rfReplaceAll]);
  if S = '' then Exit;
  I := StrToIntDef(S, -1);
  if (I < 1) or (I > 2000) then I := Round(ImgView.Scale * 100)
  else ImgView.Scale := I / 100;
  ScaleCombo.Text := IntToStr(I) + '%';
  ScaleCombo.SelStart := Length(ScaleCombo.Text) - 1;
end;

procedure TMainForm.SetSelection(Value: TPositionedLayer);
begin
  if Value <> FSelection then
  begin
    if RBLayer <> nil then
    begin
      RBLayer.ChildLayer := nil;
      RBLayer.LayerOptions := LOB_NO_UPDATE;
      pnlBitmapLayer.Visible := False;
      pnlMagn.Visible := False;
      ImgView.Invalidate;
    end;

    FSelection := Value;

    if Value <> nil then
    begin
      if RBLayer = nil then
      begin
        RBLayer := TRubberBandLayer.Create(ImgView.Layers);
        RBLayer.MinHeight := 1;
        RBLayer.MinWidth := 1;
      end
      else RBLayer.BringToFront;
      RBLayer.ChildLayer := Value;
      RBLayer.LayerOptions := LOB_VISIBLE or LOB_MOUSE_EVENTS or LOB_NO_UPDATE;
      RBLayer.OnResizing := RBResizing;

      if Value is TBitmapLayer then
        with TBitmapLayer(Value) do
        begin
          pnlBitmapLayer.Visible := True;
          LayerOpacity.Position := Bitmap.MasterAlpha;
          LayerInterpolate.Checked := Bitmap.StretchFilter = sfLinear;
        end
      else if Value.Tag = 2 then
      begin
        // tag = 2 for magnifiers
        pnlMagn.Visible := True;
      end;
    end;
  end;
end;

procedure TMainForm.WMEraseBkgnd(var Msg: TMessage);
begin
  // disable form background cleaning
  Msg.Result := 1;
end;

procedure TMainForm.mnScaledClick(Sender: TObject);
begin
  if Selection <> nil then Selection.Scaled := not Selection.Scaled;
  RBLayer.Scaled := Selection.Scaled;
end;

procedure TMainForm.ImgViewMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
begin
  if Layer = nil then
  begin
    Selection := nil;
    ReleaseCapture;
  end;
end;

procedure TMainForm.ImgViewPaintStage(Sender: TObject; Buffer: TBitmap32;
  StageNum: Cardinal);
const
  Colors: array [Boolean] of TColor32 = ($FFFFFFFF, $FFB0B0B0);
var
  W: Integer;
  I, J: Integer;
  P: PColor32;
  OddY: Integer;
begin
  with ImgView.Buffer do
  begin
    Clear;
    P := PixelPtr[0, 0];
    for J := 0 to Height - 1 do
    begin
      OddY := (J shr 3) and $1;
      for I := 0 to Width - 1 do
      begin
        P^ := Colors[(I shr 3) and $1 = OddY];
        Inc(P);
      end;
    end;
  end;

end;

procedure TMainForm.RBResizing(Sender: TObject;
  const OldLocation: TFloatRect; var NewLocation: TFloatRect;
  DragState: TDragState; Shift: TShiftState);
var
  w, h, cx, cy: Single;
  nw, nh, r: Single;

begin
  if DragState = dsMove then Exit; // we are interested only in scale operations
  if Shift = [] then Exit; // special processing is not required

  if ssCtrl in Shift then
  begin
    { make changes symmetrical }

    with OldLocation do
    begin
      cx := (Left + Right) / 2;
      cy := (Top + Bottom) / 2;
      w := Right - Left;
      h := Bottom - Top;
    end;

    with NewLocation do
    begin
      nw := w / 2;
      nh := h / 2;
      case DragState of
        dsSizeL: nw := cx - Left;
        dsSizeT: nh := cy - Top;
        dsSizeR: nw := Right - cx;
        dsSizeB: nh := Bottom - cy;
        dsSizeTL: begin nw := cx - Left; nh := cy - Top; end;
        dsSizeTR: begin nw := Right - cx; nh := cy - Top; end;
        dsSizeBL: begin nw := cx - Left; nh := Bottom - cy; end;
        dsSizeBR: begin nw := Right - cx; nh := Bottom - cy; end;
      end;
      if nw < 2 then nw := 2;
      if nh < 2 then nh := 2;

      Left := cx - nw;
      Right := cx + nw;
      Top := cy - nh;
      Bottom := cy + nh;
    end;
  end;
end;

procedure TMainForm.mnFlattenClick(Sender: TObject);
var
  B: TBitmap32;
  W, H: Integer;
begin
  { deselect everything }
  Selection := nil;
  W := ImgView.Bitmap.Width;
  H := ImgView.Bitmap.Height;

  { Create a new bitmap to store a flattened image }
  B := TBitmap32.Create;
  try
    B.SetSize(W, H);
    ImgView.PaintTo(B, Rect(0, 0, W, H));

    { destroy all the layers of the original image... }
    ImgView.Layers.Clear;
    RBLayer := nil; // note that RBLayer reference is destroyed here as well.
                    // The rubber band will be recreated during the next
                    // SetSelection call. Alternatively, you can delete
                    // all the layers except the rubber band.

    { ...and overwrite it with the flattened one }
    ImgView.Bitmap := B;
  finally
    B.Free;
  end;
end;

procedure TMainForm.ImgViewMouseWheelUp(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
var
  s: Single;
begin
  s := ImgView.Scale / 1.1;
  if s < 0.2 then s := 0.2;
  ImgView.Scale := s;
  ScaleCombo.Text := IntToStr(Round(s * 100)) + '%';
end;

procedure TMainForm.ImgViewMouseWheelDown(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
var
  s: Single;
begin
  s := ImgView.Scale * 1.1;
  if s > 20 then s := 20;
  ImgView.Scale := s;
  ScaleCombo.Text := IntToStr(Round(s * 100)) + '%';
end;

end.
