Drawing Transparent rectangle

[aby]

Hi,

I want to draw a transparent alpha blended rectangles.

I've searched this forum and found an example which only fills a rectangle with opac colors.

sgImage1.Canvas.Brush.Color := clRed;

Could you modify this example to draw semi transparent transculent rectangles

Here it goes the example.

Thanks

Aby
...DXFImage, DXFConv, SGImage, sgConsts;


TForm1 = <b>class</b>(TForm)
...
FImg: TsgDXFImage;
...

TForm1.Open1Click(Sender: TObject);
begin
if not OpenDialog1.Execute then Exit;
sgImage1.LoadFromFile(OpenDialog1.FileName);
if sgImage1.Picture.Graphic is TsgDXFImage then
FImg := TsgDXFImage(sgImage1.Picture.Graphic)
else
FImg := nil;
sgImage1.Align := alClient;
end;

procedure TForm1.btnSelectAllClick(Sender: TObject);
var
I: Integer;
vPolyLine: TsgDXFPolyline;
vTRect: TRect;
vColor: TColor;
begin
if FImg = nil then Exit;
vColor := sgImage1.Canvas.Brush.Color;
sgImage1.Canvas.Brush.Color := clRed;
for I := 0 to FImg.Converter.Sections[csEntities].Count - 1 do
begin
if FImg.Converter.Sections[csEntities].Entities[I] <b> TsgDXFPolyline then
begin
vPolyLine := TsgDXFPolyline(FImg.Converter.Sections[csEntities].Entities[I]);
if (vPolyLine.Count = 4) and (vPolyLine.Closed = True) and (vPolyLine.Layer.Name = 'WWW') then
begin
vTRect.TopLeft := FImg.GetPoint(vPolyLine.Points[2]);
vTRect.BottomRight := FImg.GetPoint(vPolyLine.Points[0]);
vTRect.BottomRight.X := vTRect.BottomRight.X + 1;
vTRect.TopLeft.Y := vTRect.TopLeft.Y + 1;
sgImage1.Canvas.FillRect(vTRect);
end;
end;
end;
sgImage1.Canvas.Brush.Color := vColor;
end
end.

[support]

Hello.
This is the example of semi-transparent rectangles using CAD Import VCL 7 library.

Code: Select all


...
uses
  ... DXFConv, CADImage, sgConsts;

type
  TForm1 = class(TForm)
    procedure FormPaint(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    ...
    FImg: TsgCADImage;
    ...
  public
    ...
  end;

...

procedure AddBoundary(const APolygon: TsgCADPolyPolygon; const Offset: TF2DPoint);
var
  vPoints: TList;
  vPoint: PF2DPoint;
begin
  vPoints := TList.Create;
  APolygon.Boundaries.Add(vPoints);

  New(vPoint);
  vPoints.Add(vPoint);
  vPoint^ := MakeF2DPoint(0 + Offset.X, 0 + Offset.Y);

  New(vPoint);
  vPoints.Add(vPoint);
  vPoint^ := MakeF2DPoint(100 + Offset.X, 0 + Offset.Y);

  New(vPoint);
  vPoints.Add(vPoint);
  vPoint^ := MakeF2DPoint(100 + Offset.X, 100 + Offset.Y);

  New(vPoint);
  vPoints.Add(vPoint);
  vPoint^ := MakeF2DPoint(0 + Offset.X, 100 + Offset.Y);


  New(vPoint);
  vPoints.Add(vPoint);
  vPoint^ := PF2DPoint(vPoints.First)^;
end;

function GetTransparenColor(const AColor: TColor; const Opacity: Double): Integer;
begin
  Result := (AColor and $FFFFFF) or (Round($FF * Opacity)) shl 24;
end;


procedure TForm1.FormCreate(Sender: TObject);
var
  vGPolygon1, vGPolygon2: TsgCADGradientPolygon;
begin
  FImg := TsgCADImage.Create;
  FImg.CurrentLayout := FImg.Layouts[0];

  vGPolygon1 := TsgCADGradientPolygon.Create;
  FImg.CurrentLayout.AddEntity(vGPolygon1);
  vGPolygon1.GradientName := 'LINEAR';
  vGPolygon1.GradientAngle := 15;
  vGPolygon1.Color := clBlue;
  vGPolygon1.GradientColor := clRed;
  AddBoundary(vGPolygon1, MakeF2DPoint(0,0));
  FImg.Converter.Loads(vGPolygon1);

  vGPolygon2 := TsgCADGradientPolygon.Create;
  FImg.CurrentLayout.AddEntity(vGPolygon2);
  vGPolygon2.GradientName := 'LINEAR';
  vGPolygon2.GradientAngle := 15;
  vGPolygon2.Color := GetTransparenColor(clBlue, 0.0);
  vGPolygon2.GradientColor := GetTransparenColor(clRed, 0.9);
  AddBoundary(vGPolygon2, MakeF2DPoint(50,50));
  FImg.Converter.Loads(vGPolygon2);

  FImg.GetExtents;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if FImg <> nil then
    Fimg.Free;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  if (FImg = nil) then Exit;
  Canvas.StretchDraw(ClientRect, FImg);
end;

...


[aby]

I am disappointed. This example is good for drawing opac rectangles not for transparent, is no different from the other.

If the polygon on the top is transparent/translucent than you can see the bottom polygon through when they overlap. In this example there is no
transparency you can not see the bottom component in overlapping areas, the top component is opac and does not show the beneath rectangle.

Besides you are not using any GDI + stuff..

My conclusion is there is no support for GDI stuff and is not implemented in your library and you can not draw trasparent rectangles.

[aby]

Hi,

I'm afraid the given example is a scribble. it would paint only one time itself. You would loose everything you paint when you call the next paint method.

GDI and transparent stuff can be easly implemented by users if the library would allow to write a handler to OnDraw event.

There is OnDraw event but at the moment this can not be done, it is an obselete feature.

Aby

[support]

Hello.
So, these rectangles are opac and there isn't transparency here? May be you better use our library which wasn't modified by you. Also is it possible to receive such rectangles without using GDIPlus?

Alexander.

[nobig28]

Si el polígono en la parte superior es transparente / traslúcido que usted puede ver el polígono de fondo a través de cuando se superponen. En este ejemplo no hay
la transparencia no se puede ver el componente de fondo en zonas superpuestas, el componente de arriba es opaca y no se muestra bajo el rectángulo.

[support]

Hello.

If you need to draw transparent figures with GDI, you may use xor pen mode or any:

Code: Select all

...
procedure TForm1.FormClick(Sender: TObject);
begin
  Canvas.Brush.Color := not clRed and $FFFFFF;
  Canvas.Brush.Style := bsSolid;
  Canvas.Pen.Mode := pmXor;
  Canvas.Rectangle(120, 80, 300, 300);
end;
...


But this is not the best way. For drawing transparent objects easier to use GDIPlus library.

And some about OnDraw event.
Thanks for your advice. This is a very useful feature. However, it needs refinement. The fact that we may need more advanced features of this function, such as: OnBeforeDraw and OnAfterDraw, for example.
We plan to add this feature in next release of library.

Best regards,

Anton.