Foros Club Delphi - Un TShape con personalidad

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)

- Gráficos (https://www.clubdelphi.com/foros/forumdisplay.php?f=8)

- - Un TShape con personalidad (https://www.clubdelphi.com/foros/showthread.php?t=23539)

Un TShape con personalidad

¿Alguien sabe como dibujar un Rectángulo (o otro shape cualquiera) que quede "por encima de todo", en un Formulario, aún de los controles descendientes de TWinControl? Como los shapes son descendientes de TGraphicControl, siempre quedan con partes cubiertas por otros componentes de mayor "peso". En mi caso quiero que una parte del rectángulo quede por encima de un TDBGrid.

Se me ocurre una forma sencilla, que es un TPanel con un TShape y alineación alClient; Ya sea por separado o creando un componente nuevo derivado del TPanel y creando el TShape en su interior.

No se si exactamente te refieres a eso y te puede servir...

en realidad no...

:( ...lamentablemente no me sirve porque lo que yo quiero es un cuadro vacío, es decir un rectangulo dibujado con una linea y el interior transparente. Digamos algo tipo Bevel o un TShape con BrushStyle bsClear.

Creo que tendrás que hechar mano a las regiones, hechale un vistaso en la ayuda a la función CreatePolygonRgn y CombineRgn

Pues nada que te creas una región como la que necesitas y después al TPanel de Neftali le aplicas un SetWindowRgn y listo.

Espero te de resultado esta idea.

saludos.

Pensé en eso, pero no quería hacer sufrir tanto al windows con regiones irregulares, pensé que había formas más sencillas...

Cita:

Empezado por elcigarra

pero no quería hacer sufrir tanto al windows con regiones irregulares.

Alguna vez windows se ha apiadado de ti y no ha utilizado sus congelaciones regulares:D

Cita:

Empezado por elcigarra

pensé que había formas más sencillas

Bueno puede ser, quizás otro integrante de estos foros pueda ayudarte con otra idea.

Saludos

Un ejemplito para si te decides:D

Pon en tu form un TPanel de 40 por 40, lo puedes pintar de azul para que se distinga bien y en el Oncreate de tu form

Código Delphi [-]procedure TForm1.FormCreate(Sender: TObject);
Var
Reg1,Reg2{,RegDest} : HRGN;
begin
Reg1:=CreateEllipticRgn(0,0,40,40);
Reg2:=CreateEllipticRgn(2,2,38,38);
//RegDest := Reg1;
CombineRgn(Reg1,Reg1,Reg2,RGN_DIFF);
SetWindowRgn(Panel1.Handle,Reg1,True); 
end;

Saludos

a falta de mejores ideas...

A falta de mejor opción, decidí quedarme con la opción de las regiones de yusnerqui y hacerle pagar a Windows alguna de las que me debe. Por si a alguien le sirve, me hice un componente y lo bauticé "SuperBevel" porque no se me ocurrió un nombre mejor. Una de las utilidades de este cuadro es p. ej. darle un movimiento y simular el efecto que hace el Word cuando guarda un documento, o enmarcar un comentario transparente tipo Hint. Bueno... como sea, considérenlo suyo :) .

Código:

unit SuperBevel;

interface

uses

  SysUtils, Classes, Controls, Messages, Graphics, Windows;

type

  TSuperBevel = class(TCustomControl)

  private

        FBtnPoints : array[1..2] of TPoint;

        FRegion : THandle;

        FLineWidth: Integer;

        FColor: TColor;

        procedure FreeRegion;

        procedure SetLineWidth(Value: Integer);

        procedure SetColor(Value: TColor);

  protected

        procedure Paint; override;

        function CreateRegion(x1,y1,x2,y2: Integer): THandle;

  public

        constructor Create(AOwner: TComponent); override;

        destructor Destroy; override;

  published

        Property LineWidth: Integer read FLineWidth write SetLineWidth;

        property Color: TColor read FColor write SetColor;

  end;

procedure Register;

implementation

constructor TSuperBevel.Create(AOwner: TComponent);

begin

  inherited Create(AOwner);

  FRegion := 0;

  FLineWidth:=1;

  Width := 200;

  Height := 100;

end;

destructor TSuperBevel.Destroy;

begin

  if FRegion <> 0 then FreeRegion;

  inherited Destroy;

end;

function TSuperBevel.CreateRegion(x1,y1,x2,y2: Integer): THandle;

var

Excl: THandle;

begin

  Result := CreateRectRGN(x1, y1, x2, y2);

  Excl := CreateRectRGN(x1+FLineWidth,y1+FLineWidth,x2-FLineWidth,y2-FLineWidth);

  try

        CombineRGN(Result, Result, Excl, RGN_DIFF);

  finally

        DeleteObject(Excl);

  end;

end;

procedure TSuperBevel.FreeRegion;

begin

  if FRegion <> 0 then

        DeleteObject(FRegion);

  FRegion := 0;

end;

procedure TSuperBevel.Paint;

var

  i: Integer;

begin

  Canvas.Pen.Width:=1;

  Canvas.Pen.Color:=FColor;

  Canvas.Brush.Color:=FColor;

  Canvas.Brush.Style:=bsSolid;

  Canvas.Pen.Style:=psSolid;

  Canvas.Rectangle(0, 0, Width, Height);

  FRegion := CreateRegion(0,0,width,height);

  SetWindowRGN(Handle, FRegion, True);

end;

procedure TSuperBevel.SetLineWidth(Value: Integer);

begin

  if (FLineWidth <> Value) and (Value > 0) then begin

        FLineWidth := Value;

        Invalidate;

  end;

end;

procedure TSuperBevel.SetColor(Value: TColor);

begin

  if FColor <> Value then begin

        FColor := Value;

        Invalidate;

  end;

end;

procedure Register;

begin

  RegisterComponents('Samples', [TSuperBevel]);

end;

end.