Ver Mensaje Individual
  #8  
Antiguo 21-07-2005
elcigarra elcigarra is offline
Miembro
 
Registrado: may 2005
Posts: 269
Reputación: 20
elcigarra Va por buen camino
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.
Responder Con Cita