text tool (draft)

lazpaintcontrols/lazpaintcontrols.lpk

@@ -11,7 +11,7 @@
       </SearchPaths>
     </CompilerOptions>
     <Version Minor="1"/>
-    <Files Count="8">
+    <Files Count="9">
       <Item1>
         <Filename Value="lctoolbars.pas"/>
         <UnitName Value="LCToolbars"/>
@@ -34,7 +34,7 @@
       </Item5>
       <Item6>
         <Filename Value="lcvectorrectshapes.pas"/>
-        <UnitName Value="lcvectorrectshapes"/>
+        <UnitName Value="LCVectorRectShapes"/>
       </Item6>
       <Item7>
         <Filename Value="lcvectorialfillcontrol.pas"/>
@@ -43,8 +43,12 @@
       </Item7>
       <Item8>
         <Filename Value="lcvectorshapes.pas"/>
-        <UnitName Value="lcvectorshapes"/>
+        <UnitName Value="LCVectorShapes"/>
       </Item8>
+      <Item9>
+        <Filename Value="lcvectortextshapes.pas"/>
+        <UnitName Value="lcvectortextshapes"/>
+      </Item9>
     </Files>
     <RequiredPkgs Count="4">
       <Item1>

lazpaintcontrols/lazpaintcontrols.pas

@@ -9,7 +9,7 @@ interface
 uses
   LCToolbars, LCVectorialFill, LCVectorialFillInterface, LCVectorOriginal, 
   LCVectorPolyShapes, LCVectorRectShapes, LCVectorialFillControl, 
-  LCVectorShapes, LazarusPackageIntf;
+  LCVectorShapes, LCVectorTextShapes, LazarusPackageIntf;
 
 implementation
 

lazpaintcontrols/lcvectororiginal.pas

@@ -92,6 +92,7 @@ type
     class function Fields: TVectorShapeFields; virtual;
     class function Usermodes: TVectorShapeUsermodes; virtual;
     class function PreferPixelCentered: boolean; virtual;
+    class function CreateEmpty: boolean; virtual; //create shape even if empty?
     property OnChange: TShapeChangeEvent read FOnChange write FOnChange;
     property OnEditingChange: TShapeEditingChangeEvent read FOnEditingChange write FOnEditingChange;
     property PenColor: TBGRAPixel read GetPenColor write SetPenColor;
@@ -416,6 +417,10 @@ procedure TVectorOriginalEditor.KeyDown(Shift: TShiftState; Key: TSpecialKey; ou
 begin
   if Assigned(FOriginal.SelectedShape) then
   begin
+    AHandled := false;
+    FOriginal.SelectedShape.KeyDown(Shift, Key, AHandled);
+    if AHandled then exit;
+
     if (Key = skReturn) and ([ssShift,ssCtrl,ssAlt]*Shift = []) then
     begin
       FOriginal.DeselectShape;
@@ -426,11 +431,6 @@ begin
     begin
      FOriginal.SelectedShape.Remove;
      AHandled:= true;
-    end else
-    begin
-      AHandled := false;
-      FOriginal.SelectedShape.KeyDown(Shift, Key, AHandled);
-      if AHandled then exit;
     end;
   end;
 
@@ -617,6 +617,11 @@ begin
   result := true;
 end;
 
+class function TVectorShape.CreateEmpty: boolean;
+begin
+  result := false;
+end;
+
 procedure TVectorShape.SetContainer(AValue: TVectorOriginal);
 begin
   if FContainer=AValue then Exit;

lazpaintcontrols/lcvectorrectshapes.pas

@@ -34,6 +34,7 @@ type
     function GetCornerPositition: single; virtual; abstract;
     function GetOrthoRect(AMatrix: TAffineMatrix; out ARect: TRectF): boolean;
     function AllowShearTransform: boolean; virtual;
+    function ShowArrows: boolean; virtual;
   public
     procedure QuickDefine(const APoint1,APoint2: TPointF); override;
     procedure LoadFromStorage(AStorage: TBGRACustomOriginalStorage); override;
@@ -355,6 +356,11 @@ begin
   result := true;
 end;
 
+function TCustomRectShape.ShowArrows: boolean;
+begin
+  result := true;
+end;
+
 procedure TCustomRectShape.QuickDefine(const APoint1, APoint2: TPointF);
 begin
   BeginUpdate;
@@ -395,10 +401,19 @@ begin
   u := FXAxis - FOrigin;
   v := FYAxis - FOrigin;
   AEditor.AddStartMoveHandler(@OnStartMove);
-  AEditor.AddArrow(FOrigin, FXAxis, @OnMoveXAxis);
-  AEditor.AddArrow(FOrigin, FYAxis, @OnMoveYAxis);
-  AEditor.AddArrow(FOrigin, FOrigin - u, @OnMoveXAxisNeg);
-  AEditor.AddArrow(FOrigin, FOrigin - v, @OnMoveYAxisNeg);
+  if ShowArrows then
+  begin
+    AEditor.AddArrow(FOrigin, FXAxis, @OnMoveXAxis);
+    AEditor.AddArrow(FOrigin, FYAxis, @OnMoveYAxis);
+    AEditor.AddArrow(FOrigin, FOrigin - u, @OnMoveXAxisNeg);
+    AEditor.AddArrow(FOrigin, FOrigin - v, @OnMoveYAxisNeg);
+  end else
+  begin
+    AEditor.AddPoint(FXAxis, @OnMoveXAxis);
+    AEditor.AddPoint(FYAxis, @OnMoveYAxis);
+    AEditor.AddPoint(FOrigin - u, @OnMoveXAxisNeg);
+    AEditor.AddPoint(FOrigin - v, @OnMoveYAxisNeg);
+  end;
   d := GetCornerPositition;
   if d <> 0 then
   begin

lazpaintcontrols/lcvectortextshapes.pas

@@ -0,0 +1,724 @@
+unit LCVectorTextShapes;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LCVectorRectShapes, BGRATextBidi, BGRABitmapTypes, LCVectorOriginal, BGRAGraphics,
+  BGRABitmap, BGRALayerOriginal;
+
+type
+
+  { TTextShape }
+
+  TTextShape = class(TCustomRectShape)
+  private
+    FFontBidiMode: TFontBidiMode;
+    FFontEmHeight: single;
+    FFontName: string;
+    FFontStyle: TFontStyles;
+    FHorizAlign: TBidiTextAlignment;
+    FText: string;
+    FSelStart,FSelEnd: integer;
+    FVertAlign: TTextLayout;
+    procedure SetFontBidiMode(AValue: TFontBidiMode);
+    procedure SetFontEmHeight(AValue: single);
+    procedure SetFontName(AValue: string);
+    procedure SetFontStyle(AValue: TFontStyles);
+    procedure SetHorizAlign(AValue: TBidiTextAlignment);
+    procedure SetText(AValue: string);
+    procedure SetVertAlign(AValue: TTextLayout);
+  protected
+    FTextLayout: TBidiTextLayout;
+    FFontRenderer: TBGRACustomFontRenderer;
+    function PenVisible(AAssumePenFill: boolean = false): boolean;
+    function AllowShearTransform: boolean; override;
+    function ShowArrows: boolean; override;
+    function GetTextLayout(AMatrix: TAffineMatrix): TBidiTextLayout;
+    function GetTextLayoutIgnoreMatrix: TBidiTextLayout;
+    function GetFontRenderer(AMatrix: TAffineMatrix): TBGRACustomFontRenderer;
+    function GetTextRenderZoom(AMatrix: TAffineMatrix): single;
+    function GetUntransformedMatrix: TAffineMatrix; //matrix before render transform
+    function IsTextMirrored(ABox: TAffineBox): boolean;
+    procedure SetDefaultFont;
+    function GetCornerPositition: single; override;
+    procedure DeleteTextBefore(ACount: integer);
+    procedure DeleteTextAfter(ACount: integer);
+    procedure DeleteSelectedText;
+    procedure InsertText(ATextUTF8: string);
+  public
+    constructor Create(AContainer: TVectorOriginal); override;
+    procedure QuickDefine(const APoint1,APoint2: TPointF); override;
+    procedure LoadFromStorage(AStorage: TBGRACustomOriginalStorage); override;
+    procedure SaveToStorage(AStorage: TBGRACustomOriginalStorage); override;
+    destructor Destroy; override;
+    class function Fields: TVectorShapeFields; override;
+    class function PreferPixelCentered: boolean; override;
+    class function DefaultFontName: string;
+    class function DefaultFontEmHeight: single;
+    class function CreateEmpty: boolean; override;
+    class function StorageClassName: RawByteString; override;
+    procedure ConfigureEditor(AEditor: TBGRAOriginalEditor); override;
+    procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean); override;
+    function GetRenderBounds({%H-}ADestRect: TRect; AMatrix: TAffineMatrix; AOptions: TRenderBoundsOptions = []): TRectF; override;
+    function PointInShape(APoint: TPointF): boolean; override;
+    function GetIsSlow({%H-}AMatrix: TAffineMatrix): boolean; override;
+    procedure KeyDown({%H-}Shift: TShiftState; {%H-}Key: TSpecialKey; var {%H-}AHandled: boolean); override;
+    procedure KeyPress({%H-}UTF8Key: string; var {%H-}AHandled: boolean); override;
+    property Text: string read FText write SetText;
+    property FontName: string read FFontName write SetFontName;
+    property FontStyle: TFontStyles read FFontStyle write SetFontStyle;
+    property FontEmHeight: single read FFontEmHeight write SetFontEmHeight;
+    property FontBidiMode: TFontBidiMode read FFontBidiMode write SetFontBidiMode;
+    property HorizotalAlignment: TBidiTextAlignment read FHorizAlign write SetHorizAlign;
+    property VerticalAlignment: TTextLayout read FVertAlign write SetVertAlign;
+  end;
+
+function FontStyleToStr(AStyle: TFontStyles): string;
+function StrToFontStyle(AText: string): TFontStyles;
+
+function FontBidiModeToStr(AMode: TFontBidiMode): string;
+function StrToFontBidiMode(AText: string): TFontBidiMode;
+
+implementation
+
+uses BGRATransform, BGRAText, LCVectorialFill, math, BGRAUTF8, BGRAUnicode, Graphics;
+
+function FontStyleToStr(AStyle: TFontStyles): string;
+begin
+  result := '';
+  if fsBold in AStyle then result += 'b';
+  if fsItalic in AStyle then result += 'i';
+  if fsStrikeOut in AStyle then result += 's';
+  if fsUnderline in AStyle then result += 'u';
+end;
+
+function StrToFontStyle(AText: string): TFontStyles;
+var
+  i: Integer;
+begin
+  result := [];
+  for i := 1 to length(AText) do
+    case AText[i] of
+    'b': Include(result, fsBold);
+    'i': Include(result, fsItalic);
+    's': Include(result, fsStrikeOut);
+    'u': Include(result, fsUnderline);
+    end;
+end;
+
+function FontBidiModeToStr(AMode: TFontBidiMode): string;
+begin
+  case AMode of
+  fbmLeftToRight: result := 'ltr';
+  fbmRightToLeft: result := 'rtl';
+  else {fbmAuto} result := 'auto';
+  end;
+end;
+
+function StrToFontBidiMode(AText: string): TFontBidiMode;
+begin
+  if CompareText(AText,'ltr')=0 then result := fbmLeftToRight else
+  if CompareText(AText,'rtl')=0 then result := fbmRightToLeft
+  else result := fbmAuto;
+end;
+
+{ TTextShape }
+
+procedure TTextShape.SetText(AValue: string);
+begin
+  if FText=AValue then Exit;
+  BeginUpdate;
+  FText:=AValue;
+  FSelStart:=0;
+  FSelEnd :=0;
+  FreeAndNil(FTextLayout);
+  EndUpdate;
+end;
+
+procedure TTextShape.SetFontBidiMode(AValue: TFontBidiMode);
+begin
+  if FFontBidiMode=AValue then Exit;
+  BeginUpdate;
+  FFontBidiMode:=AValue;
+  EndUpdate;
+end;
+
+procedure TTextShape.SetFontEmHeight(AValue: single);
+begin
+  if FFontEmHeight=AValue then Exit;
+  BeginUpdate;
+  FFontEmHeight:=AValue;
+  EndUpdate;
+end;
+
+procedure TTextShape.SetFontName(AValue: string);
+begin
+  if FFontName=AValue then Exit;
+  BeginUpdate;
+  FFontName:=AValue;
+  EndUpdate;
+end;
+
+procedure TTextShape.SetFontStyle(AValue: TFontStyles);
+begin
+  if FFontStyle=AValue then Exit;
+  BeginUpdate;
+  FFontStyle:=AValue;
+  EndUpdate;
+end;
+
+procedure TTextShape.SetHorizAlign(AValue: TBidiTextAlignment);
+begin
+  if FHorizAlign=AValue then Exit;
+  BeginUpdate;
+  FHorizAlign:=AValue;
+  EndUpdate;
+end;
+
+procedure TTextShape.SetVertAlign(AValue: TTextLayout);
+begin
+  if FVertAlign=AValue then Exit;
+  BeginUpdate;
+  FVertAlign:=AValue;
+  EndUpdate;
+end;
+
+function TTextShape.PenVisible(AAssumePenFill: boolean): boolean;
+begin
+  result := not PenFill.IsFullyTransparent or AAssumePenFill;
+end;
+
+function TTextShape.AllowShearTransform: boolean;
+begin
+  Result:= true;
+end;
+
+function TTextShape.ShowArrows: boolean;
+begin
+  Result:= false;
+end;
+
+function TTextShape.GetTextLayout(AMatrix: TAffineMatrix): TBidiTextLayout;
+var
+  box: TAffineBox;
+  i: Integer;
+  zoom: Single;
+begin
+  if FTextLayout = nil then
+    FTextLayout := TBidiTextLayout.Create(GetFontRenderer(AMatrix), FText);
+  box := GetAffineBox(AMatrix,false);
+  FTextLayout.FontBidiMode:= FontBidiMode;
+  FTextLayout.TopLeft := PointF(0,0);
+  zoom := GetTextRenderZoom(AMatrix);
+  FTextLayout.AvailableWidth:= box.Width*zoom;
+  FTextLayout.AvailableHeight:= box.Height*zoom;
+  for i := 0 to FTextLayout.ParagraphCount-1 do
+    FTextLayout.ParagraphAlignment[i] := HorizotalAlignment;
+  result:= FTextLayout;
+end;
+
+function TTextShape.GetTextLayoutIgnoreMatrix: TBidiTextLayout;
+begin
+  if FTextLayout = nil then
+    result := GetTextLayout(AffineMatrixIdentity)
+  else
+    result := FTextLayout;
+end;
+
+function TTextShape.GetFontRenderer(AMatrix: TAffineMatrix): TBGRACustomFontRenderer;
+begin
+  if FFontRenderer = nil then
+    FFontRenderer := TLCLFontRenderer.Create;
+
+  FFontRenderer.FontEmHeight := Round(FontEmHeight*GetTextRenderZoom(AMatrix));
+  FFontRenderer.FontName:= FontName;
+  FFontRenderer.FontStyle:= FontStyle;
+  FFontRenderer.FontQuality:= fqFineAntialiasing;
+  result := FFontRenderer;
+end;
+
+function TTextShape.GetTextRenderZoom(AMatrix: TAffineMatrix): single;
+begin
+  //font to be rendered at a sufficient size to avoid stretching
+  result := max(VectLen(AMatrix[1,1],AMatrix[2,1]),
+                VectLen(AMatrix[1,2],AMatrix[2,2]));
+end;
+
+function TTextShape.GetUntransformedMatrix: TAffineMatrix;
+var
+  ab: TAffineBox;
+  u, v: TPointF;
+  lenU, lenV: Single;
+begin
+  ab := GetAffineBox(AffineMatrixIdentity, false);
+  u := ab.TopRight-ab.TopLeft;
+  lenU := VectLen(u);
+  if lenU<>0 then u *= (1/lenU);
+  v := ab.BottomLeft-ab.TopLeft;
+  lenV := VectLen(v);
+  if lenV<>0 then v *= (1/lenV);
+  result := AffineMatrix(u,v,ab.TopLeft);
+end;
+
+function TTextShape.IsTextMirrored(ABox: TAffineBox): boolean;
+var
+  u,v: TPointF;
+begin
+  u := ABox.TopRight-ABox.TopLeft;
+  v := ABox.BottomLeft-ABox.TopLeft;
+  result := u.x*v.y - u.y*v.x < 0;
+end;
+
+procedure TTextShape.SetDefaultFont;
+begin
+  FontName := DefaultFontName;
+  FontEmHeight := DefaultFontEmHeight;
+  FontBidiMode:= fbmAuto;
+  FontStyle := [];
+end;
+
+function TTextShape.GetCornerPositition: single;
+begin
+  result := 1;
+end;
+
+procedure TTextShape.DeleteTextBefore(ACount: integer);
+var
+  delCount, selLeft: Integer;
+begin
+  BeginUpdate;
+  selLeft := Min(FSelStart,FSelEnd);
+  if selLeft > 0 then
+  begin
+    delCount := GetTextLayoutIgnoreMatrix.DeleteTextBefore(selLeft, ACount);
+    FText := GetTextLayoutIgnoreMatrix.TextUTF8;
+    dec(selLeft,ACount);
+  end;
+  FSelStart := selLeft;
+  FSelEnd := selLeft;
+  EndUpdate;
+end;
+
+procedure TTextShape.DeleteTextAfter(ACount: integer);
+var
+  delCount, selRight: Integer;
+begin
+  BeginUpdate;
+  selRight := Max(FSelStart,FSelEnd);
+  if selRight > 0 then
+  begin
+    delCount := GetTextLayoutIgnoreMatrix.DeleteText(selRight, ACount);
+    FText := GetTextLayoutIgnoreMatrix.TextUTF8;
+    inc(selRight,ACount);
+  end;
+  FSelStart := selRight;
+  FSelEnd := selRight;
+  EndUpdate;
+end;
+
+procedure TTextShape.DeleteSelectedText;
+var
+  selLeft: Integer;
+begin
+  if FSelStart <> FSelEnd then
+  begin
+    BeginUpdate;
+    selLeft := Min(FSelStart,FSelEnd);
+    GetTextLayoutIgnoreMatrix.DeleteText(selLeft, Abs(FSelEnd-FSelStart));
+    FText := GetTextLayoutIgnoreMatrix.TextUTF8;
+    FSelStart := selLeft;
+    FSelEnd := selLeft;
+    EndUpdate;
+  end;
+end;
+
+procedure TTextShape.InsertText(ATextUTF8: string);
+var
+  insertCount: Integer;
+begin
+  BeginUpdate;
+  DeleteSelectedText;
+  insertCount := GetTextLayoutIgnoreMatrix.InsertText(ATextUTF8, FSelStart);
+  FText := GetTextLayoutIgnoreMatrix.TextUTF8;
+  Inc(FSelStart, insertCount);
+  FSelEnd := FSelStart;
+  EndUpdate;
+end;
+
+constructor TTextShape.Create(AContainer: TVectorOriginal);
+begin
+  inherited Create(AContainer);
+  SetDefaultFont;
+  FHorizAlign:= btaNatural;
+  FVertAlign:= tlTop;
+  FText := '';
+  FSelStart := 0;
+  FSelEnd := 0;
+end;
+
+procedure TTextShape.QuickDefine(const APoint1, APoint2: TPointF);
+var minSize: single;
+  p2: TPointF;
+begin
+  minSize := GetFontRenderer(AffineMatrixIdentity).TextSize('Hg').cy;
+  p2 := APoint2;
+  if abs(APoint1.x-p2.x) < minSize then
+  begin
+    if p2.x < APoint1.x then p2.x := APoint1.x - minSize else
+      p2.x := APoint1.x + minSize;
+  end;
+  if abs(APoint1.y-p2.y) < minSize then
+  begin
+    if p2.y < APoint1.y then p2.y := APoint1.y - minSize else
+      p2.y := APoint1.y + minSize;
+  end;
+  inherited QuickDefine(APoint1, p2);
+end;
+
+procedure TTextShape.LoadFromStorage(AStorage: TBGRACustomOriginalStorage);
+var
+  font: TBGRACustomOriginalStorage;
+begin
+  BeginUpdate;
+  inherited LoadFromStorage(AStorage);
+  Text := AStorage.RawString['text'];
+  Font := AStorage.OpenObject('font');
+  if Assigned(font) then
+  begin
+    FontName:= AStorage.RawString['name'];
+    FontEmHeight:= AStorage.FloatDef['em-height', DefaultFontEmHeight];
+    FontBidiMode:= StrToFontBidiMode(AStorage.RawString['bidi']);
+    FontStyle:= StrToFontStyle(AStorage.RawString['style']);
+    font.Free;
+  end else
+    SetDefaultFont;
+  EndUpdate;
+end;
+
+procedure TTextShape.SaveToStorage(AStorage: TBGRACustomOriginalStorage);
+var
+  font: TBGRACustomOriginalStorage;
+begin
+  inherited SaveToStorage(AStorage);
+  AStorage.RawString['text'] := Text;
+  font := AStorage.OpenObject('font');
+  if font = nil then font := AStorage.CreateObject('font');
+  AStorage.RawString['name'] := FontName;
+  AStorage.Float['em-height'] := FontEmHeight;
+  AStorage.RawString['bidi'] := FontBidiModeToStr(FontBidiMode);
+  AStorage.RawString['style'] := FontStyleToStr(FontStyle);
+  font.Free;
+end;
+
+destructor TTextShape.Destroy;
+begin
+  FreeAndNil(FTextLayout);
+  FreeAndNil(FFontRenderer);
+  inherited Destroy;
+end;
+
+class function TTextShape.Fields: TVectorShapeFields;
+begin
+  Result:= [vsfPenFill];
+end;
+
+class function TTextShape.PreferPixelCentered: boolean;
+begin
+  Result:= false;
+end;
+
+class function TTextShape.DefaultFontName: string;
+begin
+  result := {$IFDEF WINDOWS}'Arial'{$ELSE}{$IFDEF DARWIN}'Helvetica'{$ELSE}'FreeSans'{$ENDIF}{$ENDIF};
+end;
+
+class function TTextShape.DefaultFontEmHeight: single;
+begin
+  result := 20;
+end;
+
+class function TTextShape.CreateEmpty: boolean;
+begin
+  Result:= true;
+end;
+
+procedure TTextShape.ConfigureEditor(AEditor: TBGRAOriginalEditor);
+var
+  caret: TBidiCaretPos;
+  orientation: TPointF;
+  m: TAffineMatrix;
+  tl: TBidiTextLayout;
+  pts: Array Of TPointF;
+  i: Integer;
+  c: TBGRAPixel;
+begin
+  inherited ConfigureEditor(AEditor);
+  AEditor.AddPolyline(GetAffineBox(AffineMatrixIdentity,true).AsPolygon, true, opsDashWithShadow);
+  tl := GetTextLayout(AffineMatrixIdentity);
+  caret:= tl.GetCaret(FSelEnd);
+  m := GetUntransformedMatrix;
+  if not isEmptyPointF(caret.PreviousTop) and (caret.PreviousRightToLeft<>caret.RightToLeft) then
+  begin
+    orientation := (caret.Bottom-caret.Top)*(1/10);
+    orientation := PointF(-orientation.y,orientation.x);
+    if caret.RightToLeft then orientation := -orientation;
+    AEditor.AddPolyline([m*caret.Bottom,m*caret.Top,m*(caret.Top+orientation)],false, opsSolid);
+  end else
+    AEditor.AddPolyline([m*caret.Bottom,m*caret.Top],false, opsSolid);
+  if FSelStart<>FSelEnd then
+  begin
+    pts := tl.GetTextEnveloppe(FSelStart, FSelEnd);
+    for i := 0 to high(pts) do
+      pts[i] := m*pts[i];
+    c:= clHighlight;
+    c.alpha := 96;
+    AEditor.AddPolyline(pts, true, opsDash, c);
+  end;
+end;
+
+procedure TTextShape.Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix;
+  ADraft: boolean);
+var
+  zoom: Single;
+  m: TAffineMatrix;
+  tl: TBidiTextLayout;
+  fr: TBGRACustomFontRenderer;
+  pad: Integer;
+  sourceRect,transfRectF,sourceInvRect,destF: TRectF;
+  transfRect: TRect;
+  tmpSource, tmpTransf: TBGRABitmap;
+  scan: TBGRACustomScanner;
+begin
+  zoom := GetTextRenderZoom(AMatrix);
+  if zoom = 0 then exit;
+  fr := GetFontRenderer(AMatrix);
+  if fr.FontEmHeight = 0 then exit;
+  pad := fr.FontEmHeight div 2;
+
+  m := AMatrix*                             //global transform
+       GetUntransformedMatrix*              //transform accordng to shape rectangle
+       AffineMatrixScale(1/zoom,1/zoom);    //shrink zoomed text if necessary
+
+  tl := GetTextLayout(AMatrix);
+  sourceRect := RectF(-pad,-pad,tl.AvailableWidth+pad,tl.TotalTextHeight+pad);
+
+  destF := RectF(ADest.ClipRect.Left,ADest.ClipRect.Top,ADest.ClipRect.Right,ADest.ClipRect.Bottom);
+  transfRectF := (m*TAffineBox.AffineBox(sourceRect)).RectBoundsF;
+  transfRectF := TRectF.Intersect(transfRectF, destF);
+
+  if not IsAffineMatrixInversible(m) then exit;
+  sourceInvRect := (AffineMatrixInverse(m)*TAffineBox.AffineBox(transfRectF)).RectBoundsF;
+  sourceRect := TRectF.Intersect(sourceRect,sourceInvRect);
+  if IsEmptyRectF(sourceRect) then exit;
+  sourceRect.Left := floor(sourceRect.Left);
+  sourceRect.Top := floor(sourceRect.Top);
+  sourceRect.Right := floor(sourceRect.Right);
+  sourceRect.Bottom := floor(sourceRect.Bottom);
+
+  m := m*AffineMatrixTranslation(sourceRect.Left,sourceRect.Top);
+  if tl.TotalTextHeight < tl.AvailableHeight then
+  case VerticalAlignment of
+  tlBottom: m *= AffineMatrixTranslation(0, tl.AvailableHeight-tl.TotalTextHeight);
+  tlCenter: m *= AffineMatrixTranslation(0, (tl.AvailableHeight-tl.TotalTextHeight)/2);
+  end;
+
+  tl.TopLeft := PointF(-sourceRect.Left,-sourceRect.Top);
+  if PenFill.FillType = vftSolid then
+  begin
+    tmpSource := TBGRABitmap.Create(round(sourceRect.Width),round(sourceRect.Height));
+    tl.DrawText(tmpSource, PenFill.SolidColor);
+    ADest.PutImageAffine(m, tmpSource, rfHalfCosine, dmDrawWithTransparency);
+    tmpSource.Free;
+  end
+  else
+  begin
+    tmpSource := TBGRABitmap.Create(round(sourceRect.Width),round(sourceRect.Height),BGRABlack);
+    tl.DrawText(tmpSource, BGRAWhite);
+    tmpSource.ConvertToLinearRGB;
+
+    with transfRectF do
+      transfRect := Rect(floor(Left),floor(Top),ceil(Right),ceil(Bottom));
+    tmpTransf := TBGRABitmap.Create(transfRect.Width,transfRect.Height,BGRABlack);
+    tmpTransf.PutImageAffine(AffineMatrixTranslation(-transfRect.Left,-transfRect.Top)*m,
+                             tmpSource, rfHalfCosine, dmDrawWithTransparency);
+    tmpSource.Free;
+
+    scan := PenFill.CreateScanner(AMatrix, ADraft);
+    ADest.FillMask(transfRect.Left, transfRect.Top, tmpTransf, scan, dmDrawWithTransparency);
+    scan.Free;
+    tmpTransf.Free;
+  end;
+end;
+
+function TTextShape.GetRenderBounds(ADestRect: TRect; AMatrix: TAffineMatrix;
+  AOptions: TRenderBoundsOptions): TRectF;
+var
+  ab: TAffineBox;
+  u, v: TPointF;
+  lenU, lenV: Single;
+begin
+  if PenVisible(rboAssumePenFill in AOptions) and
+    (Text <> '') then
+  begin
+    ab := GetAffineBox(AMatrix, false);
+    //add margin for text that would be out of bound (for example italic j)
+    u := ab.TopRight-ab.TopLeft;
+    lenU := VectLen(u);
+    if lenU<>0 then u *= (1/lenU);
+    u *=(FontEmHeight/2);
+    ab.TopLeft -= u;
+    ab.TopRight += u;
+    ab.BottomLeft -= u;
+    v := ab.BottomLeft-ab.TopLeft;
+    lenV := VectLen(v);
+    if lenV<>0 then v *= (1/lenV);
+    v *= (FontEmHeight/2);
+    ab.TopLeft -= v;
+    ab.TopRight -= v;
+    ab.BottomLeft += v;
+    result := ab.RectBoundsF;
+  end
+  else
+    result:= EmptyRectF;
+end;
+
+function TTextShape.PointInShape(APoint: TPointF): boolean;
+begin
+  result := GetAffineBox(AffineMatrixIdentity,true).Contains(APoint);
+end;
+
+function TTextShape.GetIsSlow(AMatrix: TAffineMatrix): boolean;
+begin
+  Result:= true;
+end;
+
+procedure TTextShape.KeyDown(Shift: TShiftState; Key: TSpecialKey;
+  var AHandled: boolean);
+var
+  idxPara: Integer;
+begin
+  if FTextLayout = nil then exit;
+
+  if Key = skDelete then
+  begin
+    if FSelStart <> FSelEnd then DeleteSelectedText
+    else DeleteTextAfter(1);
+    AHandled:= true;
+  end else
+  if Key in [skLeft,skRight] then
+  begin
+    if (Key = skLeft) xor GetTextLayoutIgnoreMatrix.ParagraphRightToLeft[GetTextLayoutIgnoreMatrix.GetParagraphAt(FSelEnd)] then
+    begin
+      BeginUpdate;
+      if FSelEnd > 0 then
+        Dec(FSelEnd, GetTextLayoutIgnoreMatrix.IncludeNonSpacingCharsBefore(FSelEnd,1) );
+      if not (ssShift in Shift) then FSelStart := FSelEnd;
+      EndUpdate;
+    end else
+    begin
+      BeginUpdate;
+      if FSelEnd < GetTextLayoutIgnoreMatrix.CharCount then
+        Inc(FSelEnd, GetTextLayoutIgnoreMatrix.IncludeNonSpacingChars(FSelEnd,1) );
+      if not (ssShift in Shift) then FSelStart := FSelEnd;
+      EndUpdate;
+    end;
+    AHandled := true;
+  end else
+  if Key = skHome then
+  begin
+    BeginUpdate;
+    if ssCtrl in Shift then
+      FSelEnd := 0
+    else
+    begin
+      idxPara := GetTextLayoutIgnoreMatrix.GetParagraphAt(FSelEnd);
+      FSelEnd := GetTextLayoutIgnoreMatrix.ParagraphStartIndex[idxPara];
+    end;
+    if not (ssShift in Shift) then FSelStart := FSelEnd;
+    EndUpdate;
+    AHandled := true;
+  end else
+  if Key = skEnd then
+  begin
+    BeginUpdate;
+    if ssCtrl in Shift then
+      FSelEnd := GetTextLayoutIgnoreMatrix.CharCount
+    else
+    begin
+      idxPara := GetTextLayoutIgnoreMatrix.GetParagraphAt(FSelEnd);
+      FSelEnd := GetTextLayoutIgnoreMatrix.ParagraphEndIndexBeforeParagraphSeparator[idxPara];
+    end;
+    if not (ssShift in Shift) then FSelStart := FSelEnd;
+    EndUpdate;
+    AHandled := true;
+  end else
+  if Key = skReturn then
+  begin
+    if ssShift in Shift then
+      InsertText(UnicodeCharToUTF8(UNICODE_LINE_SEPARATOR))
+    else
+      InsertText(LineEnding);
+    AHandled := true;
+  end else
+  if Key = skTab then
+  begin
+    InsertText(#9);
+    AHandled := true;
+  end{ else
+  If (Key = VK_C) and (ssCtrl in Shift) then
+  begin
+    if SelLength> 0 then
+      SetClipboardAsText(GetTextLayoutIgnoreMatrix.CopyText(SelStart, SelLength));
+    Key := 0;
+  end else
+  If (Key = VK_X) and (ssCtrl in Shift) then
+  begin
+    if SelLength > 0 then
+    begin
+      SetClipboardAsText(GetTextLayoutIgnoreMatrix.CopyText(SelStart, SelLength));
+      DeleteSelection;
+    end;
+    Key := 0;
+  end else
+  If (Key = VK_V) and (ssCtrl in Shift) then
+  begin
+    InsertText(Clipboard.AsText);
+    Key := 0;
+  end else
+  If (Key = VK_A) and (ssCtrl in Shift) then
+  begin
+    SelStart:= 0;
+    SelLength:= GetTextLayoutIgnoreMatrix.CharCount;
+    Key := 0;
+  end};
+end;
+
+procedure TTextShape.KeyPress(UTF8Key: string; var AHandled: boolean);
+begin
+  if UTF8Key = #8 then
+  begin
+    if FSelEnd <> FSelStart then DeleteSelectedText
+    else DeleteTextBefore(1);
+    AHandled := true;
+  end
+  else
+  if UTF8Key >= ' ' then
+  begin
+    InsertText(UTF8Key);
+    AHandled := true;
+  end;
+end;
+
+class function TTextShape.StorageClassName: RawByteString;
+begin
+  result := 'text';
+end;
+
+initialization
+
+  RegisterVectorShape(TTextShape);
+
+end.
+

vectoredit/umain.lfm

@@ -1,5 +1,5 @@
 object Form1: TForm1
-  Left = 597
+  Left = 594
   Height = 622
   Top = 0
   Width = 981
@@ -188,6 +188,16 @@ object Form1: TForm1
         OnClick = ToolButtonClick
         Style = tbsCheck
       end
+      object ToolButtonTextShape: TToolButton
+        Left = 1
+        Hint = 'Text in rectangle'
+        Top = 416
+        Caption = 'ToolButtonTextShape'
+        Grouped = True
+        ImageIndex = 60
+        OnClick = ToolButtonClick
+        Style = tbsCheck
+      end
     end
   end
   object BCPanelToolbar: TBCPanel

vectoredit/umain.pas

@@ -11,7 +11,8 @@ uses
   BCTrackbarUpdown, BCPanel, BCButton, BGRAVirtualScreen, BGRAImageList,
   BGRABitmap, BGRABitmapTypes, BGRAGraphics, BGRALazPaint, BGRALayerOriginal,
   BGRATransform, BGRAGradientScanner, LCVectorOriginal, LCVectorShapes,
-  LCVectorRectShapes, LCVectorPolyShapes, LCVectorialFillControl, LCVectorialFill;
+  LCVectorRectShapes, LCVectorPolyShapes, LCVectorTextShapes,
+  LCVectorialFillControl, LCVectorialFill;
 
 const
   ToolIconSize = 36;
@@ -23,12 +24,12 @@ const
 
 type
   TPaintTool = (ptHand, ptMovePenFillPoint, ptMoveBackFillPoint, ptRectangle, ptEllipse, ptPolyline, ptCurve, ptPolygon, ptClosedCurve,
-                ptPhongShape);
+                ptPhongShape, ptText);
 
 const
   PaintToolClass : array[TPaintTool] of TVectorShapeAny =
     (nil, nil, nil, TRectShape, TEllipseShape, TPolylineShape, TCurveShape, TPolylineShape, TCurveShape,
-     TPhongShape);
+     TPhongShape, TTextShape);
 
 function IsCreateShapeTool(ATool: TPaintTool): boolean;
 
@@ -55,6 +56,7 @@ type
     ShapeMoveUp: TAction;
     ToolBarBackFill: TToolBar;
     ToolBarPenFill: TToolBar;
+    ToolButtonTextShape: TToolButton;
     VectorImageList24: TBGRAImageList;
     ActionList: TActionList;
     EditCopy: TAction;
@@ -226,7 +228,7 @@ type
     vectorOriginal: TVectorOriginal;
     zoom: TAffineMatrix;
     newShape: TVectorShape;
-    justDown: boolean;
+    justDown, shapeAdded: boolean;
     newStartPoint: TPointF;
     newButton: TMouseButton;
     vectorLayer: Integer;
@@ -644,9 +646,18 @@ begin
   begin
     vectorOriginal.DeselectShape;
     newShape := CreateShape(newStartPoint,ptF);
+    shapeAdded := false;
     rF := newShape.GetRenderBounds(InfiniteRect, vectorTransform);
     ImageChange(rF);
     justDown := false;
+    if IsEmptyRectF(rF) and newShape.CreateEmpty then
+    begin
+      vectorOriginal.DeselectShape;
+      vectorOriginal.AddShape(newShape);
+      vectorOriginal.SelectShape(newShape);
+      currentTool:= ptHand;
+      shapeAdded := true;
+    end;
   end else
   if Assigned(newShape) then
   begin
@@ -691,23 +702,36 @@ begin
     begin
       vectorOriginal.DeselectShape;
       vectorOriginal.AddShape(CreateShape(newStartPoint,newStartPoint), vsuCreate);
+    end else
+    if IsCreateShapeTool(currentTool) and PaintToolClass[currentTool].CreateEmpty then
+    begin
+      vectorOriginal.DeselectShape;
+      addedShape := CreateShape(newStartPoint,newStartPoint);
+      vectorOriginal.AddShape(addedShape);
+      vectorOriginal.SelectShape(addedShape);
+      currentTool:= ptHand;
     end else
       vectorOriginal.MouseClick(newStartPoint);
     justDown:= false;
   end
   else if Assigned(newShape) and (Button = newButton) then
   begin
-    rF := newShape.GetRenderBounds(InfiniteRect, vectorTransform);
-    if not IsEmptyRectF(rF) or (vsuCreate in newShape.Usermodes) then
-    begin
-      addedShape := newShape;
-      newShape := nil;
-      vectorOriginal.AddShape(addedShape, vsuCreate);
-    end
+    if shapeAdded then
+      newShape := nil
     else
     begin
-      FreeAndNil(newShape);
-      ShowMessage('Shape is empty and was not added');
+      rF := newShape.GetRenderBounds(InfiniteRect, vectorTransform);
+      if not IsEmptyRectF(rF) or (vsuCreate in newShape.Usermodes) then
+      begin
+        addedShape := newShape;
+        newShape := nil;
+        vectorOriginal.AddShape(addedShape, vsuCreate);
+      end
+      else
+      begin
+        FreeAndNil(newShape);
+        ShowMessage('Shape is empty and was not added');
+      end;
     end;
   end;
 end;
@@ -715,6 +739,7 @@ end;
 procedure TForm1.FormDestroy(Sender: TObject);
 begin
   RemoveExtendedStyleControls;
+  if (newShape <> nil) and not shapeAdded then FreeAndNil(newShape);
   img.Free;
   FFlattened.Free;
   FPenStyleMenu.Free;
@@ -799,6 +824,7 @@ begin
   if ToolButtonPolygon.Down then FCurrentTool:= ptPolygon;
   if ToolButtonClosedCurve.Down then FCurrentTool:= ptClosedCurve;
   if ToolButtonPhongShape.Down then FCurrentTool:= ptPhongShape;
+  if ToolButtonTextShape.Down then FCurrentTool:= ptText;
 
   if currentTool <> ptMoveBackFillPoint then ButtonMoveBackFillPoints.Down := false;
   if currentTool <> ptMovePenFillPoint then ButtonMovePenFillPoints.Down := false;