unit StripedText; interface uses DrawObjects,DrawEngine,PCTypesUtils,Windows, Messages, SysUtils, Classes, Graphics,Dialogs,Math; Type TStripedText = class(TText) procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override; Function duplicate:TFigure; override; class function CreateFromShadow(aOwner: TComponent;LHandle: Integer; Shadow: TFigure): TFigure;override; Procedure Initialize;override; end; implementation { TStripedText } uses PCDrawing; class function TStripedText.CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure; var enterstr: string; cad: TPCDrawing; begin cad := TPCDrawing (aOwner); if InputQuery('Striped Text Tool', 'Enter Text', EnterStr) then begin result := TStripedText.Create(shadow.ap1.x,shadow.ap1.y, cad.DefaultTextHeight,0, enterstr,cad.Font.name, cad.font.charset,Cad.DefaultPenColor,LHandle,mydsNormal,aOwner); TText(result).Font.Style := Cad.Font.Style; end else result := nil; end; procedure TStripedText.draw(DEngine: TPCDrawEngine; isGrayed: Boolean); var Layer: TLayer; acolor : TColor; a : integer; TestX,TestY1,TestY2: Double; TopY : boolean; lMult: integer; points: TDoublePointArr; xlen: Double; nLen,nH: Integer; p: TDoublePointArr; //tReg: Integer; tReg: HRGN; bRect: TDoublerect; i1,i2: Double; p1,p2: TDoublePOint; z: Double; begin aColor := color; if (aColor = -255) and (LayerHandle <> 0) then begin aColor := TLayer(LayerHandle).TextColor; end; if (isGrayed) then acolor := GrayedColor; font.Color := acolor; DEngine.canvas.Pen.color := clBlack; z := 0; TestX := 0; TestY1:= 100; TestY2 := 200; DEngine.ConvertPoint(TestX,TestY1,z); DEngine.ConvertPoint(TestX,TestY2,z); if TestY2 > TestY1 then topY := true else topY := false; if TopY then lMult := 1 else lMult := -1; if DrawStyle = dsTrace then begin DEngine.Canvas.Pen.Mode := pmXor; GetPointArray(points); DEngine.drawpolygon(points,clLime,1,1,0,0,RegHandle); end else begin DEngine.Canvas.Pen.Mode := pmCopy; BeginPath(DEngine.Canvas.Handle); if fKeepA then begin DEngine.drawtext(ap1,ap2,ap3,ap4,lMult*angle,text,font,height,0,cSpace,nH,nLen); fKeepA := False; end else DEngine.drawtext(ap1,ap2,ap3,ap4,lMult*angle,text,font,height,CWidth,cSpace,nH,nLen); TextHeight := nH; TextLength := nLen; DEngine.Canvas.Pen.Color := color; DEngine.Canvas.Pen.Width := Width; DEngine.Canvas.Pen.Style := TPenStyle(style); DEngine.Canvas.Brush.Color := brc; DEngine.Canvas.Brush.Style := TBrushStyle(brs); EndPath(DEngine.Canvas.Handle); tReg := PathToRegion(DEngine.Canvas.Handle); SelectClipRgn(DEngine.Canvas.handle,tReg); Brect := GetBoundRect; i1 := Min(Brect.top,bRect.Bottom); i2 := Max(Brect.top,bRect.Bottom); repeat p1 := DoublePoint(brect.left,i1); p2 := DoublePoint(brect.right,i1); DEngine.drawline(p1,p2); i1 := i1 + 1; until i1> i2; SelectClipRgn(DEngine.Canvas.handle,0); DeleteObject(tReg); end; RegHandle := 0; if DrawStyle = mydsNormal then begin if Modified then begin SetRegionPoints; Modified := False; end; ResetRegion; if Reghandle = 0 then begin SetLength(p,4); p[0] := ap1;p[1] := ap2;p[2] := ap3;p[3] := ap4; RegHandle := DEngine.PolygonRegion(p); end; end; //Tolik 24/05/2019 -- SetLength(Points, 0); // end; function TStripedText.duplicate: TFigure; begin result := inherited duplicate; end; procedure TStripedText.Initialize; begin inherited; Outlined := True; end; end.