Ver Mensaje Individual
  #9  
Antiguo 03-05-2004
CORBATIN CORBATIN is offline
Miembro
 
Registrado: may 2003
Ubicación: España
Posts: 131
Reputación: 21
CORBATIN Va por buen camino
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.
__________________
No hay vientos favorables para quién no conoce su rumbo.
Responder Con Cita