Hola a todos, lo prometido es deuda, aquí teneis el componente en el que he estado trabajando. Es mi primer componente, así que espero que las críticas sean moderadas. Ha quedado hacer que cuando se cambia el tamaño del ScrollBox en diseño, se re-coloquen los botones que contienen. Esto se consigue volviendo hacer enter sobre el campo CanBotones. También queda pendiente, que si colocamos algún componente en el interior del Scrollbox como por ejemplo un Toolbar, pues que lo respete y no pinte los botones por encima de ellos. Por lo demás creo que esta bastante logrado, pero aquí lo teneis para mejorarlo o para lo que sea, un saludo.
Ahhh, instalar primero el MyButtons y después el MyBox. Yo los he metido en paquetes diferentes para instarlarlos.
Código:
unit MyButtons;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons;
type
TMyButtons = class(TBitBtn)
private
{ Private declarations }
FOrdBoton: integer;
FCodigo: integer;
FFocusColor: TColor;
FNormalColor: TColor;
procedure SetOrdboton (Value: integer);//orden que ocupa en el array
procedure SetCodigo (Value: integer);//campo para introducir un codigo que el usuario quiera utilizar
procedure SetFocusColor(const Value: TColor);//color para el caption al recibir el foco
protected
procedure DoEnter; override;
procedure DoExit; override;
public
{ Public declarations }
constructor Create(AOwner : TComponent);override;
// destructor Destroy;
published
{ Published declarations }
Property OrdBoton: integer read FOrdBoton write SetOrdBoton default 0;
Property Codigo: integer read FCodigo write SetCodigo default 0;
property FocusColor: TColor read FFocusColor write SetFocusColor default clRed;
end;
procedure Register;
implementation
constructor TMyButtons.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FOrdBoton := 0;
FCodigo := 0;
FFocusColor := clRed;
Font.color := ClNavy;
Visible := True;
cursor := crHandPoint;
font.name := 'Times New Roman';
font.Size := 7;
end;
procedure TMyButtons.SetOrdBoton(Value:integer);
begin
if Value < 0 then FOrdBoton := 0
else FOrdBoton := Value;
end;
procedure TMyButtons.SetCodigo(Value: integer);
begin
if Value < 0 then FCodigo := 0
else FCodigo := Value;
end;
procedure TMyButtons.DoEnter;
begin
inherited;
FNormalColor := font.Color;
font.color := FFocusColor;
font.Style := [fsunderline];
end;
procedure TMyButtons.DoExit;
begin
inherited;
font.color := FNormalColor;
font.Style := font.Style-[fsunderline];
end;
procedure TMyButtons.SetFocusColor(const Value: TColor);
begin
if FFocusColor <> Value then
begin
FFocusColor := Value;
if Self.Focused then
begin
FNormalColor := Color;
Font.Color := Value;
end;
end;
end;
procedure Register;
begin
RegisterComponents('Mis Componentes', [TMyButtons]);
end;
end.
Código:
unit MyBox;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, MyButtons,Buttons;
type
TOnPulsarButtons = procedure(sender: Tobject;Ind:integer) of object;
TMyBox = class(TScrollBox)
private
FLdesp:integer;//para colocar separados los botones
FTdesp:integer;//para colocar separados los botones
FMyButtonsWidth: integer;//tamaño de los botones
FMyButtonsHeight: integer;//tamaño de los botones;
FConBotones: boolean;//para saber si el array contiene botones o no
FCantBotones: integer;//valor de la propiedad
FOldWidth: integer;//tamaño anterior
FOldHeight: integer;//tamaño anterior
FOldCantBotones: integer;//guarda el ultimo valor introducido
FOnPulsarButtons : TOnPulsarButtons; {Campo para el evento}
procedure SetCantBotones (Value:integer);//asignar cantidad de botones al Scrollbox
procedure AddBotones(Value: integer);//para añadir los botones
procedure SetMyButtonsHeight(Value: integer);//calcular tamaño de los botones interiores
procedure SetMyButtonsWidth(Value: integer);//calcular tamaño de los botones interiores
procedure SetAncho(Value:integer);//darle el tamaño a los botones
procedure SetLargo(Value:integer);//darle el tamaño a los botones
procedure AjustarSeparacion();//ajustar botones al cambiar el tamaño del Scrollbox
protected
{ Protected declarations }
procedure PulsarButtons(Sender: TObject); dynamic;
public
{ Public declarations }
Botones: array of TMybuttons;//array donde guardo los botones insertados
constructor Create(AOwner : TComponent);override;
destructor destroy;override;
published
{ Published declarations }
property CantBotones: integer read FCantBotones write SetCantBotones default 0;
property MyButtonsWidth: integer read FMyButtonsWidth write SetMyButtonsWidth default 150;
property MyButtonsHeight: integer read FMyButtonsHeight write SetMyButtonsHeight default 50;
property OnPulsarButtons : TOnPulsarButtons read FOnPulsarButtons write FOnPulsarButtons;
end;
procedure Register;
implementation
constructor TMyBox.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FMyButtonsWidth := 150;
FMyButtonsHeight := 50;
FCantBotones := 0;
FOldCantBotones := 0;
FConBotones := false;
end;
destructor TMyBox.destroy;
VAR
x: integer;
begin
if FConBotones then
begin
for x := 0 to FcantBotones-1 do
Botones[x].free;
end;
inherited destroy;
end;
procedure TMyBox.SetMyButtonsWidth(Value: integer);
begin
if (Value <= 0) and (Value = FOldWidth) then FMyButtonsWidth := FOldWidth
else begin
if FCantBotones > 0 then begin
FOldWidth := Value;
FMyButtonsWidth := Value;
SetLargo(Value);
end;
end;
end;
procedure TMyBox.SetMyButtonsHeight(Value: integer);
begin
if (Value <= 0) and (Value = FOldHeight) then FMyButtonsHeight := FOldHeight
else begin
if FCantBotones > 0 then begin
FOldHeight := Value;
FMyButtonsHeight := Value;
SetAncho(Value);
end;
end;
end;
procedure TMyBox.SetAncho(Value:integer);
var
x: integer;
begin
for x := 0 to FCantBotones -1 do
Botones[x].Height := Value;
AjustarSeparacion();
end;
procedure TMyBox.SetLargo(Value:integer);
var
x: integer;
begin
for x := 0 to FCantBotones -1 do
Botones[x].Width := Value;
AjustarSeparacion();
end;
procedure TMyBox.AjustarSeparacion();
var
x,TamMax,ContBot: integer;
begin
TamMax := 0;
ContBot := 1;
FLdesp := 2;
FTdesp := 0;
for x := 0 to FCantBotones -1 do begin
with Botones[x] do
begin
TamMax := (ContBot * Width) + 25;
if TamMax > self.Width then begin
FTdesp := FTdesp+Height+2;
FLdesp := 2;
ContBot := 1;
end;
Left := FLdesp;
Top := 2 + FTdesp;
FLdesp := FLdesp + Width + 2;
inc(Contbot);
end;
end;
end;
procedure TMyBox.PulsarButtons(Sender: TObject);
var
ind: integer;
begin
if Assigned(FOnPulsarButtons) then begin
for ind := 0 to FCantBotones-1 do
if botones[ind].Focused then FOnPulsarButtons(sender,ind);
end;
end;
procedure TMyBox.SetCantBotones (Value:integer);
var
x: integer;
begin
if Value < 0 then FCantBotones := FOldCantBotones
else begin
if FConBotones then
begin
for x := 0 to FcantBotones-1 do
Botones[x].free;
end;
FOldCantBotones := Value;
FCantBotones := Value;
AddBotones(Value);
end;
end;
procedure TMyBox.AddBotones(Value: integer);
var
ind,ContBot,TamMax:integer;
begin
Setlength(Botones,Value);
TamMax := 0;
ContBot := 1;
FLdesp := 2;
FTdesp := 0;
for ind := 0 to Value-1 do begin
Botones[ind] := TMyButtons.Create(self);
with Botones[ind] do
begin
Onclick := PulsarButtons;
caption := 'MyButtons'+inttostr(ind);;
FConBotones := true;
OrdBoton := ind;
Width := 150;
Height := 50;
TamMax := (ContBot * Width) + 25;
if TamMax > self.Width then begin
FTdesp := FTdesp+Height+2;
FLdesp := 2;
ContBot := 1;
end;
Left := FLdesp;
Top := 2 + FTdesp;
FLdesp := FLdesp + Width + 2;
parent := self;
inc(Contbot);
end;
end;
end;
procedure Register;
begin
RegisterComponents('Mis Componentes', [TMyBox]);
end;
end.