ソースを参照

store flattened image, checkbox pen/back, delete shape

Unknown 7 年 前
コミット
c658bbc6ff
4 ファイル変更141 行追加34 行削除
  1. 2 0
      .gitignore
  2. 4 2
      vectoredit/umain.lfm
  3. 85 18
      vectoredit/umain.pas
  4. 50 14
      vectoredit/uvectororiginal.pas

+ 2 - 0
.gitignore

@@ -12,3 +12,5 @@ debug
 lazpaint/backup/
 
 *.lrj
+
+vectoredit/vectoredit

+ 4 - 2
vectoredit/umain.lfm

@@ -1,7 +1,7 @@
 object Form1: TForm1
-  Left = 542
+  Left = 541
   Height = 410
-  Top = 164
+  Top = 139
   Width = 627
   Caption = 'Vector Edit'
   ClientHeight = 410
@@ -62,6 +62,7 @@ object Form1: TForm1
       Width = 45
       Caption = 'Pen'
       Checked = True
+      OnChange = CheckBoxPenChange
       State = cbChecked
       TabOrder = 1
     end
@@ -72,6 +73,7 @@ object Form1: TForm1
       Width = 51
       Caption = 'Back'
       Checked = True
+      OnChange = CheckBoxBackChange
       State = cbChecked
       TabOrder = 2
     end

+ 85 - 18
vectoredit/umain.pas

@@ -30,6 +30,8 @@ type
     procedure BGRAVirtualScreen1MouseUp(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);
     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
+    procedure CheckBoxBackChange(Sender: TObject);
+    procedure CheckBoxPenChange(Sender: TObject);
     procedure FloatSpinEditPenWidthChange(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
@@ -40,6 +42,7 @@ type
       Shift: TShiftState; X, Y: Integer);
   private
     FPenColor, FBackColor: TBGRAPixel;
+    FFlattened: TBGRABitmap;
     function GetBackColor: TBGRAPixel;
     function GetPenColor: TBGRAPixel;
     function GetPenWidth: single;
@@ -47,11 +50,13 @@ type
     procedure ImageChange(ARectF: TRectF);
     procedure OnEditingChange(ASender: TObject; AOriginal: TBGRALayerCustomOriginal);
     procedure OnOriginalChange(ASender: TObject; AOriginal: TBGRALayerCustomOriginal);
+    procedure OnSelectShape(ASender: TObject; AShape: TVectorShape; APreviousShape: TVectorShape);
     procedure SetBackColor(AValue: TBGRAPixel);
     procedure SetPenColor(AValue: TBGRAPixel);
     procedure SetPenWidth(AValue: single);
     procedure UpdateViewCursor(ACursor: TOriginalEditorCursor);
     procedure RenderAndUpdate(ADraft: boolean);
+    procedure UpdateFlattenedImage(ARect: TRect);
     { private declarations }
   public
     { public declarations }
@@ -86,6 +91,7 @@ begin
   img := TBGRALazPaintImage.Create(800,600);
   vectorOriginal := TVectorOriginal.Create;
   vectorLayer := img.AddLayerFromOwnedOriginal(vectorOriginal);
+  vectorOriginal.OnSelectShape:= @OnSelectShape;
   zoom := AffineMatrixScale(4,4);
   img.OnOriginalEditingChange:= @OnEditingChange;
   img.OnOriginalChange:= @OnOriginalChange;
@@ -98,35 +104,42 @@ procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
 var
   topLeftF, bottomRightF: TPointF;
   zoomBounds, r: TRect;
-  flattened: TBGRABitmap;
   rF: TRectF;
 begin
   topLeftF := zoom*PointF(0,0);
   bottomRightF := zoom*PointF(img.Width,img.Height);
   zoomBounds := Rect(round(topLeftF.X),round(topLeftF.Y),round(bottomRightF.X),round(bottomRightF.Y));
   Bitmap.DrawCheckers(zoomBounds, CSSWhite,CSSSilver);
-  flattened := img.ComputeFlatImage;
-  if Assigned(newShape) then
-  begin
-    rF := newShape.GetRenderBounds(vectorTransform);
-    with rF do
-      r := rect(floor(Left),floor(Top),ceil(Right),ceil(Bottom));
-    flattened.ClipRect := r;
-    newShape.Render(flattened, vectorTransform, false);
-    flattened.NoClip;
-  end;
-  Bitmap.StretchPutImage(zoomBounds, flattened, dmDrawWithTransparency);
+  if FFlattened = nil then
+    UpdateFlattenedImage(rect(0,0,img.Width,img.Height));
+  Bitmap.StretchPutImage(zoomBounds, FFlattened, dmDrawWithTransparency);
   img.DrawEditor(Bitmap, vectorLayer, zoom, 8);
-  flattened.Free;
+end;
+
+procedure TForm1.CheckBoxBackChange(Sender: TObject);
+begin
+  if not CheckBoxBack.Checked and (FBackColor.alpha > 0) then
+    FBackColor := BGRA(FBackColor.red,FBackColor.green,FBackColor.blue,0)
+  else if CheckBoxBack.Checked and (FBackColor.alpha = 0) then
+    FBackColor := BGRA(FBackColor.red,FBackColor.green,FBackColor.blue,255);
+  if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) then
+    vectorOriginal.SelectedShape.BackColor:= FBackColor;
+end;
+
+procedure TForm1.CheckBoxPenChange(Sender: TObject);
+begin
+  if not CheckBoxPen.Checked and (FPenColor.alpha > 0) then
+    FPenColor:= BGRA(FPenColor.red,FPenColor.green,FPenColor.blue,0)
+  else if CheckBoxPen.Checked and (FPenColor.alpha = 0) then
+    FPenColor:= BGRA(FPenColor.red,FPenColor.green,FPenColor.blue,255);
+  if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) then
+    vectorOriginal.SelectedShape.PenColor:= FPenColor;
 end;
 
 procedure TForm1.FloatSpinEditPenWidthChange(Sender: TObject);
 begin
-  if Assigned(vectorOriginal) then
-  begin
-    if Assigned(vectorOriginal.SelectedShape) then
-      vectorOriginal.SelectedShape.PenWidth:= FloatSpinEditPenWidth.Value;
-  end;
+  if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) then
+    vectorOriginal.SelectedShape.PenWidth:= penWidth;
 end;
 
 procedure TForm1.BGRAVirtualScreen1MouseDown(Sender: TObject;
@@ -225,6 +238,7 @@ end;
 procedure TForm1.FormDestroy(Sender: TObject);
 begin
   img.Free;
+  FFlattened.Free;
 end;
 
 procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
@@ -235,6 +249,12 @@ begin
     Key := 0;
     if Assigned(vectorOriginal) then
       vectorOriginal.DeselectShape;
+  end else
+  if Key = VK_DELETE then
+  begin
+    Key := 0;
+    if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) then
+      vectorOriginal.RemoveShape(vectorOriginal.SelectedShape);
   end;
 end;
 
@@ -295,6 +315,8 @@ begin
   if not IsEmptyRectF(ARectF) then
   begin
     r := rect(floor(ARectF.Left),floor(ARectF.Top),ceil(ARectF.Right),ceil(ARectF.Bottom));
+    UpdateFlattenedImage(r);
+
     viewRectF := RectF(zoom* PointF(r.Left,r.Top), zoom* PointF(r.Right,r.Bottom));
     vr := rect(floor(viewRectF.Left),floor(viewRectF.Top),ceil(viewRectF.Right),ceil(viewRectF.Bottom));
     vr.Inflate(1,1);
@@ -313,6 +335,23 @@ begin
   RenderAndUpdate(mouseState * [ssLeft,ssRight] <> []);
 end;
 
+procedure TForm1.OnSelectShape(ASender: TObject; AShape: TVectorShape;
+  APreviousShape: TVectorShape);
+begin
+  if AShape <> nil then
+  begin
+    penColor := AShape.PenColor;
+    backColor := AShape.BackColor;
+    penWidth:= AShape.PenWidth;
+  end;
+  if APreviousShape <> nil then
+    if IsEmptyRectF(APreviousShape.GetRenderBounds(vectorTransform)) then
+    begin
+      vectorOriginal.RemoveShape(APreviousShape);
+      ShowMessage('Empty shape has been deleted');
+    end;
+end;
+
 procedure TForm1.SetBackColor(AValue: TBGRAPixel);
 begin
   FBackColor := AValue;
@@ -368,6 +407,7 @@ begin
   renderedRect := img.RenderOriginalsIfNecessary(ADraft);
   if not IsRectEmpty(renderedRect) then
   begin
+    UpdateFlattenedImage(renderedRect);
     with renderedRect do
       viewRectF := RectF(zoom* PointF(Left,Top), zoom* PointF(Right,Bottom));
     vR := rect(floor(viewRectF.Left),floor(viewRectF.Top),ceil(viewRectF.Right),ceil(viewRectF.Bottom));
@@ -376,5 +416,32 @@ begin
   end;
 end;
 
+procedure TForm1.UpdateFlattenedImage(ARect: TRect);
+var
+  rF: TRectF;
+  r: TRect;
+begin
+  if FFlattened = nil then
+    FFlattened := img.ComputeFlatImage
+  else
+  begin
+    FFlattened.FillRect(ARect,BGRAPixelTransparent,dmSet);
+    FFlattened.ClipRect := ARect;
+    img.Draw(FFlattened, 0,0);
+    FFlattened.NoClip;
+  end;
+
+  if Assigned(newShape) then
+  begin
+    rF := newShape.GetRenderBounds(vectorTransform);
+    with rF do
+      r := rect(floor(Left),floor(Top),ceil(Right),ceil(Bottom));
+    IntersectRect(r, r, ARect);
+    FFlattened.ClipRect := r;
+    newShape.Render(FFlattened, vectorTransform, false);
+    FFlattened.NoClip;
+  end;
+end;
+
 end.
 

+ 50 - 14
vectoredit/uvectororiginal.pas

@@ -76,6 +76,7 @@ type
     procedure SetPenColor(AValue: TBGRAPixel); override;
     procedure SetPenWidth(AValue: single); override;
     function PenVisible: boolean;
+    function BackVisible: boolean;
   public
     constructor Create;
     procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean); override;
@@ -87,7 +88,7 @@ type
     class function StorageClassName: RawByteString; override;
   end;
 
-  TVectorOriginalSelectShapeEvent = procedure(ASender: TObject; AShape: TVectorShape) of object;
+  TVectorOriginalSelectShapeEvent = procedure(ASender: TObject; AShape: TVectorShape; APreviousShape: TVectorShape) of object;
 
   { TVectorOriginal }
 
@@ -109,6 +110,7 @@ type
     destructor Destroy; override;
     procedure Clear;
     function AddShape(AShape: TVectorShape): integer;
+    function RemoveShape(AShape: TVectorShape): boolean;
     procedure SelectShape(AIndex: integer);
     procedure DeselectShape;
     procedure MouseClick(APoint: TPointF);
@@ -375,6 +377,11 @@ begin
   result := (FPenWidth>0) and (FPenColor.alpha>0);
 end;
 
+function TRectShape.BackVisible: boolean;
+begin
+  result := FBackColor.alpha <> 0;
+end;
+
 constructor TRectShape.Create;
 begin
   FPenColor := BGRAPixelTransparent;
@@ -391,10 +398,13 @@ begin
   pts := GetAffineBox(AMatrix, true).AsPolygon;
 
   multi := TBGRAMultishapeFiller.Create;
+  multi.PolygonOrder:= poLastOnTop;
   multi.FillMode:= fmWinding;
   multi.Antialiasing:= not ADraft;
-  if FBackColor.alpha > 0 then
+  If BackVisible then
+  begin
     multi.AddPolygon(pts, FBackColor);
+  end;
   if PenVisible then
   begin
     pts := ComputeStroke(pts,true);
@@ -406,13 +416,18 @@ end;
 
 function TRectShape.GetRenderBounds(AMatrix: TAffineMatrix): TRectF;
 begin
-  result := inherited GetRenderBounds(AMatrix);
-  if PenVisible then
+  if not BackVisible and not PenVisible then
+    result:= EmptyRectF
+  else
   begin
-    result.Left -= PenWidth*0.5;
-    result.Top -= PenWidth*0.5;
-    result.Right += PenWidth*0.5;
-    result.Bottom += PenWidth*0.5;
+    result := inherited GetRenderBounds(AMatrix);
+    if PenVisible then
+    begin
+      result.Left -= PenWidth*0.5;
+      result.Top -= PenWidth*0.5;
+      result.Right += PenWidth*0.5;
+      result.Bottom += PenWidth*0.5;
+    end;
   end;
 end;
 
@@ -422,13 +437,13 @@ var
   box: TAffineBox;
 begin
   box := GetAffineBox(AffineMatrixIdentity, true);
-  if box.Contains(APoint) then exit(true);
-  if not result and PenVisible then
+  if BackVisible and box.Contains(APoint) then
+    result := true else
+  if PenVisible then
   begin
     pts := ComputeStroke(box.AsPolygon, true);
     result:= IsPointInPolygon(pts, APoint, true);
-  end
-  else
+  end else
     result := false;
 end;
 
@@ -572,29 +587,50 @@ begin
   NotifyChange(AShape.GetRenderBounds(AffineMatrixIdentity));
 end;
 
+function TVectorOriginal.RemoveShape(AShape: TVectorShape): boolean;
+var
+  idx: LongInt;
+  r: TRectF;
+begin
+  idx := FShapes.IndexOf(AShape);
+  if idx = -1 then exit(false);
+  if AShape = SelectedShape then DeselectShape;
+  r := AShape.GetRenderBounds(AffineMatrixIdentity);
+  FShapes.Delete(idx);
+  FDeletedShapes.Add(AShape);
+  DiscardFrozenShapes;
+  NotifyChange(r);
+end;
+
 procedure TVectorOriginal.SelectShape(AIndex: integer);
+var
+  prev: TVectorShape;
 begin
   if (AIndex < 0) or (AIndex >= FShapes.Count) then
     raise ERangeError.Create('Index out of bounds');
   if FSelectedShape <> FShapes[AIndex] then
   begin
+    prev := FSelectedShape;
     FSelectedShape := FShapes[AIndex];
     DiscardFrozenShapes;
     NotifyEditorChange;
     if Assigned(FOnSelectShape) then
-      FOnSelectShape(self, FSelectedShape);
+      FOnSelectShape(self, FSelectedShape, prev);
   end;
 end;
 
 procedure TVectorOriginal.DeselectShape;
+var
+  prev: TVectorShape;
 begin
   if FSelectedShape <> nil then
   begin
+    prev := FSelectedShape;
     FSelectedShape := nil;
     DiscardFrozenShapes;
     NotifyEditorChange;
     if Assigned(FOnSelectShape) then
-      FOnSelectShape(self, FSelectedShape);
+      FOnSelectShape(self, FSelectedShape, prev);
   end;
 end;