From 94bd981f7f2081079e3b47cf81d3238db18e09b1 Mon Sep 17 00:00:00 2001 From: jesus Date: Fri, 18 Oct 2013 02:23:32 +0000 Subject: [PATCH] Lazreport, fix Report shape tool has black shadow, issue #14127 git-svn-id: trunk@43271 - --- components/lazreport/source/lr_shape.pas | 169 ++++++++++++++++++++++- 1 file changed, 168 insertions(+), 1 deletion(-) diff --git a/components/lazreport/source/lr_shape.pas b/components/lazreport/source/lr_shape.pas index 16e31d99b6..59afc0292b 100644 --- a/components/lazreport/source/lr_shape.pas +++ b/components/lazreport/source/lr_shape.pas @@ -19,7 +19,7 @@ uses Graphics,GraphType, Controls, Forms, Dialogs,Buttons, StdCtrls, - LCLType,LR_Class, ExtCtrls, ButtonPanel; + LCLType,LCLIntf,LR_Class, ExtCtrls, ButtonPanel; type @@ -49,6 +49,7 @@ type procedure SaveToStream(Stream: TStream); override; procedure LoadFromXML(XML: TLrXMLConfig; const Path: String); override; procedure SaveToXML(XML: TLrXMLConfig; const Path: String); override; + function GetClipRgn(rt: TfrRgnType): HRGN; override; published property FillColor; @@ -84,6 +85,40 @@ implementation uses LR_Const; +procedure DumpRgn(Msg:string;Rgn: HRGN); +var + res: LongInt; + R: TRect; + y: LongInt; + x: LongInt; + ch: char; + //Line: string; +begin + res := GetRgnBox(Rgn, @R); + //SetLength(Line, R.Right-R.Left+1; + WriteLn(msg); + Write(' '); + for x := R.Left to R.Right do begin + ch := chr(ord('0')+(x div 10)); + if ch='0' then + ch := ' '; + Write(ch); + end; WriteLn; + Write(' '); + for x := R.Left to R.Right do + Write(Chr(ord('0')+(x mod 10))); WriteLn; + + for y := R.Top to R.Bottom do begin + Write(y:3,' '); + for x :=R.Left to R.Right do begin + if PtInRegion(Rgn, X, Y) then + Write('1') //Line[x-R.Left+1] := '1' + else + Write('0'); //Line[x-R.Left+1] := '0'; + end; WriteLn; + end; +end; + constructor TfrShapeView.Create(AOwnerPage: TfrPage); begin inherited Create(AOwnerPage); @@ -142,8 +177,15 @@ end; procedure TfrShapeView.Draw(aCanvas: TCanvas); var FillC: Integer; + OldPen: TPen; + OldBrush: TBrush; begin + OldPen := TPen.Create; + OldPen.Assign(aCanvas.Pen); + OldBrush := TBrush.Create; + OldBrush.Assign(aCanvas.Brush); BeginDraw(aCanvas); + aCanvas.AntialiasingMode:=amOn; Memo1.Assign(Memo); BeginUpdate; try @@ -157,6 +199,10 @@ begin RestoreCoord; finally EndUpdate; + aCanvas.Brush.Assign(OldBrush); + aCanvas.Pen.Assign(OldPen); + OldBrush.Free; + OldPen.Free; end; end; @@ -186,6 +232,127 @@ begin XML.SetValue(Path+'ShapeType/Value', GetSaveProperty('ShapeType')); end; +function TfrShapeView.GetClipRgn(rt: TfrRgnType): HRGN; +const + Delta = 10; +var + x1, y1, xp, yp : Integer; + Pts : Array[0..6] of TPoint; + min, bx, by, bx1, by1, w1, w2: Integer; +begin + w1 := Round(FrameWidth / 2); + w2 := Round((FrameWidth - 1) / 2); + + bx:=x; + by:=y; + bx1:=x+dx+1; + by1:=y+dy+1; + + case ShapeType of + + frstRoundRect: + begin + Inc(bx1, w2); + Inc(by1, w2); + Dec(bx, w1); + Dec(by, w1); + + min := dx; + if dy < dx then + min := dy; + + if rt=rtExtended then begin + min := min + 2 * delta; + result := CreateRoundRectRgn(bx-delta, by-delta, bx1+delta, by1+delta, min div 4, min div 4) + end + else + result := CreateRoundRectRgn(bx, by, bx1, by1, min div 4, min div 4); + end; + + frstEllipse, frstRectangle: + begin + Inc(bx1, w2); + Inc(by1, w2); + Dec(bx, w1); + Dec(by, w1); + if rt=rtExtended then begin + if ShapeType=frstRectangle then + result := CreateRectRgn(bx-Delta, by-Delta, bx1 + Delta, by1 + Delta) + else + result := CreateEllipticRgn(bx-Delta, by-Delta, bx1 + Delta, by1 + Delta) + end else begin + if ShapeType=frstRectangle then + result := CreateRectRgn(bx, by, bx1, by1) + else + result := CreateEllipticRgn(bx, by, bx1, by1); + end; + end; + + frstTriangle: + begin + Inc(bx1, w2); + Inc(by1, w2); + Dec(bx, w1); + Dec(by, w1); + xp := bx + (bx1 - bx) div 2; + if rt=rtExtended then + begin + Pts[0]:=Point(bx1+Delta, by1+Delta); + Pts[1]:=Point(bx-Delta, by1+Delta); + Pts[2]:=Point(xp, by-Delta); + Pts[3]:=Point(bx1+Delta, by1+Delta); + end else begin + Pts[0]:=Point(bx1, by1); + Pts[1]:=Point(bx, by1); + Pts[2]:=Point(xp, by); + Pts[3]:=Point(bx1, by1); + end; + result := CreatePolygonRgn(@Pts, 4, 1); + end; + + frstDiagonal1: //Line(x,y,x1,y1); + begin + if w1=0 then + w1 := 1; // avoid disappearing line + if rt=rtExtended then + begin + Pts[0]:=Point(bx-w1-Delta, by); + Pts[1]:=Point(bx+w2+Delta, by); + Pts[2]:=Point(bx1+w2+Delta, by1); + Pts[3]:=Point(bx1-w1-Delta, by1); + Pts[4]:=Point(bx-w1-Delta, by); + end else begin + Pts[0]:=Point(bx-w1, by); + Pts[1]:=Point(bx+w2, by); + Pts[2]:=Point(bx1+w2, by1); + Pts[3]:=Point(bx1-w1, by1); + Pts[4]:=Point(bx-w1, by); + end; + result := CreatePolygonRgn(@Pts, 5, 1); + end; + + frstDiagonal2: //Line(x,y1,x1,y); + begin + if w1=0 then + w1 := 1; // avoid disappearing line + if rt=rtExtended then begin + Pts[0]:=Point(bx-w1-Delta, by1); + Pts[1]:=Point(bx+w2+Delta, by1); + Pts[2]:=Point(bx1+w2+Delta, by); + Pts[3]:=Point(bx1-w1-Delta, by); + Pts[4]:=Point(bx-w1-Delta,by); + end else begin + Pts[0]:=Point(bx-w1, by1); + Pts[1]:=Point(bx+w2, by1); + Pts[2]:=Point(bx1+w2, by); + Pts[3]:=Point(bx1-w1, by); + Pts[4]:=Point(bx-w1,by1); + end; + result := CreatePolygonRgn(@Pts, 5, 1); + end + end; +end; + {------------------------------------------------------------------------} procedure TfrShapeForm.ShowEditor(t: TfrView);