[fredo]

Código Delphi [-]
type
  { Forward declarations }
  TRegistros = class;
  THojaTexto = Class;
  TRegistro = Class;  
  { Tipos }
  

  THojaTexto = class(TCustomPanel)
  private
    { Private declarations }
      FColorRegilla,FColorDetalle:TColor;
      FMuestraRegilla:Boolean;
      FDataDetalle,
      FDataCompania,
      FDataDocumento:TDataSource;
      FFilas,
      FColumnas,
      FTopeBandaTitulo,
      FTopeBandaDetalle,
      FTopeBandaFinal,
      FIntervaloX,FIntervaloY:Integer;
      FRegistros:TRegistros;
      procedure SetFilas(Valor:Integer);
      procedure SetIntervalo(Valor:Integer);
      procedure SetColumnas(Valor:Integer);
      procedure SetColor(Color:TColor);
      Procedure SetColorDetalle(Color:TColor);
      procedure SetMuestraRegilla(Mostrar:Boolean);
      procedure SetTopeBandaTitulo(Tope:Integer);
      procedure SetTopeBandaDetalle(Tope:Integer);
      
      Function  GetRegistros:TRegistros;
  protected
    { Protected declarations }
      procedure Paint;override;
      function CanResize(var NewWidth, NewHeight: Integer): Boolean; override;
      procedure Limpiar(color: TColor);
      procedure DibujarBorde(color: TColor);
      procedure DibujarHoja(columnas,filas:integer;Regilla:Boolean;Color:TColor);
  public
    { Public declarations }
      constructor Create(AOwner : TComponent); override;
       destructor Destroy; override;
  published
    { Published declarations }
      Property OnClick;
      Property OnDBLClick;
      Property OnEnter;
      Property OnExit;
      Property OnKeyPress;
      Property OnKeyUp;
      property ColorRegilla:  TColor read FColorRegilla write SetColor default $00FEFAF1;
      property ColorDetalle:  TColor read FColorDetalle write SetColorDetalle;
      property Filas:         Integer read FFilas        write SetFilas default 50;
      property Columnas:      Integer read FColumnas     write SetColumnas default 80;
      Property MuestraRegilla:Boolean read FMuestraRegilla write SetMuestraRegilla default true;
      property Registros:TRegistros Read GetRegistros write FRegistros;
      property DatosCompania:TDataSource read FDataCompania write FDataCompania;
      property DatosDocumentos:TDataSource read FDataDocumento write FDataDocumento;
      property DatosDetalle:TDataSource Read FDataDetalle Write FDataDetalle default nil;
      property TopeBandaTitulo:Integer read FTopeBandaTitulo write SetTopeBandaTitulo default 10;
      property TopeBandaDetalle:Integer read FTopeBandaDetalle write SetTopeBandaDetalle default 30;
      property Align;
      property Anchors;
      property IntervaloX:Integer read FIntervaloX write SetIntervalo;
      property IntervaloY:Integer read FIntervaloY write SetIntervalo;
  end;

  TRegistro = Class(TGraphicControl)
  private
         FNombreRegistro:String;
         FValor:String;
         FLargoMax,
         FX,
         FY,
         FBanda,
         FTipo_Dato:Integer;
         FOrigen:Integer;
         FHojaTexto:THojaTexto;
         FRegistros:TRegistros;
         FDataSource:TDataSource;
  Protected
         procedure Paint; override;
  Public
        Constructor Create(AOwner:TComponent);override;
        destructor Destroy; override;
  Published
        Property OnClick;
        Property OnDBLClick;
        Property Valor:String read FValor write FValor;
        Property LargoMax:Integer read FLargoMax write FLargoMax;
        Property X:Integer read FX write FX;
        Property Y:Integer read FY write FY;
        Property Banda:Integer read FBanda write FBanda;
        Property Tipo_Dato:Integer read FTipo_Dato write FTipo_Dato;
        Property Origen:Integer read FOrigen write FOrigen;
        Property DataSource:TDataSource read FDataSource write FDataSource;
  end;

  TItemRegistros = class(TCollectionItem)
  private
         FName:TComponentName;
         FRegistro:TRegistro;
         Procedure SetRegistro(Value:TRegistro);
  Public
        function GetDisplayName: string; override;
        constructor Create(Collection:TCollection); override;
        destructor Destroy; override;
        Procedure Assign(Source:TPersistent);override;
  Published
        property Name:TComponentName read FName write FName;
        property Registro:TRegistro read FRegistro write FRegistro;
  end;

  TRegistros = Class(TCollection)
  private
         FOwner:TPersistent;
         FHoja:THojaTexto;
         function GetItem(Index:Integer):TRegistro;
         Procedure SetItem(Index:Integer;Value:TRegistro);
         function GetOwner:TPersistent;override;
         function GetCount:Integer;
         Procedure SetHoja(Value:THojaTexto);

  Public
        constructor Create(Owner:TPersistent);
        destructor Destroy; override;
        Function Add:TItemRegistros;
        property Items[Index:Integer]:TRegistro read Getitem write SetItem; default;
  published
        Property HojaTexto:THojaTexto read FHoja write SetHoja;
        property NRegistros: Integer read GetCount;        
  end;


procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('PackAdmin', [THojaTexto]);
  RegisterComponents('PackAdmin', [TRegistro]);
end;

//********************* G E N E R A L ***********************************

//******* I T E M S    R E G I S T R O S ********************************

Procedure TItemRegistros.Assign(Source:TPersistent);
Begin
     if source is TRegistro
     then
     Begin
          FRegistro:=TRegistro(Source);
     end
        else Inherited Assign(Source);
end;

Procedure TItemRegistros.SetRegistro(Value:TRegistro);
Begin
     if value <> FRegistro then
     Begin
          FRegistro:=value;
     end;
end;

constructor TItemRegistros.Create(Collection:TCollection);
Begin
     inherited;
     FName:='Campo'+Inttostr(TRegistros(Collection).NRegistros);
     Assign(TRegistro.Create(TRegistros(Collection).FHoja.Owner));
     with FRegistro do
     Begin
          Name:=TRegistros(Collection).FHoja.Name +'Campo'+Inttostr(TRegistros(Collection).NRegistros);
          Parent:=TRegistros(Collection).FHoja;
          Width:=(FRegistro.FLargoMax*TRegistros(Collection).FHoja.FIntervaloX);
          Height:=TRegistros(Collection).FHoja.FIntervaloY+1;
          Top:=((FRegistro.FY-1)*TRegistros(Collection).FHoja.FIntervaloY)+1;
          Left:=((FRegistro.FX-1)*TRegistros(Collection).FHoja.FIntervaloX);
     end;
end;

destructor TItemRegistros.Destroy;
Begin
     inherited;
     Self.FRegistro.Destroy;
end;

function TItemRegistros.GetDisplayName:string;
begin

     if Self.FName <> ''
     then Result:=Self.FName
     else Result:='Error Libre';
end;




//****************** T R E G I S T R O S **************

Procedure TRegistros.SetHoja(Value:THojaTexto);
var i:Integer;
Begin
     if value <> FHoja
     then
     Begin
          FHoja:=value;
     end;
end;

constructor TRegistros.create(Owner:TPersistent);
Begin
     Fowner:=owner;
     FHoja:= THojaTexto(Owner);
     inherited Create(TItemRegistros);
end;

destructor TRegistros.Destroy;
Begin
     inherited Destroy;
end;

function TRegistros.GetItem(Index:Integer):TRegistro;
begin
     result:=TRegistro(inherited GetItem(Index));
end;

Procedure TRegistros.SetItem(Index:Integer;Value:TRegistro);
begin
     TItemRegistros(inherited Items[index]).FRegistro:=Value;
end;

Function TRegistros.GetOwner:Tpersistent;
begin
     result:=Fowner;
end;

Function TRegistros.Add:TItemRegistros;
begin
     result:=TItemRegistros(Inherited Add);
end;

function TRegistros.GetCount: Integer;
begin
     Result :=self.Count;
end;


//********************T R E G I S T R O**********************************

Constructor TRegistro.Create(AOwner:TComponent);
Begin
     inherited Create(AOwner);
     FValor:='';
     FLargoMax:=15;
     FX:=1;
     FY:=1;
     FBanda:=1;
     FTipo_Dato:=0;
     FOrigen:=0;
     Width:=0;//FLargoMax*FHojaTexto.FIntervaloX ;
     Height:=0;//1*FHojaTexto.FIntervaloY;
end;

destructor TRegistro.Destroy;
Begin
     inherited Destroy;
end;

procedure TRegistro.Paint;
var Rec:TRect;
Begin
     with Canvas do
     begin
          Brush.Color := clBlack;
          Brush.Style := bsSolid;
          FillRect(ClientRect);
          Rec:=ClientRect;
          FillRect(Rect(0, 0, Width, Height));
          Font.Color := ClWhite;
          TextOut(0,0,name);
     end;
end;



//******* T H O J A    T E X T O    ******************

constructor THojaTexto.Create(AOwner : TComponent);
Begin
     inherited Create(AOwner);
     FRegistros:=TRegistros.Create(Self);
     FColorRegilla:=$00FEFAF1;
     FColorDetalle:=$00F8DA94;
     FMuestraRegilla:=true;
     FFilas:=50;
     FColumnas:=80;
     Height := 100;
     Width  := 100;
     FTopeBandaTitulo:=10;
     FTopeBandaDetalle:=30;
     FTopeBandaFinal:=10;
     FDataDetalle:=nil;
     FDataCompania:=nil;
     FDataDocumento:=nil;
end;



Function THojaTexto.GetRegistros:TRegistros;
Begin
     Result:=FRegistros;
end;

procedure THojaTexto.SetIntervalo(Valor:Integer);
Begin
     exit;
end;

Procedure THojaTexto.SetFilas(Valor:Integer);
Begin
     if valor <> FFilas
     then
     Begin
          FFilas:=valor;
          Repaint;
     end;
end;

Procedure THojaTexto.SetColumnas(Valor:Integer);
Begin
     if valor <> FColumnas
     then
     Begin
          FColumnas:=valor;
          Repaint;
     end;
end;

Procedure THojaTexto.SetColor(Color:Tcolor);
Begin
     if FColorRegilla <> Color then
     Begin
          FColorRegilla:=Color;
          Repaint;
     end;
end;

Procedure THojaTexto.SetColorDetalle(Color:Tcolor);
Begin
     if FColorDetalle <> Color then
     Begin
          FColorDetalle:=Color;
          Repaint;
     end;
end;

procedure THojaTexto.SetMuestraRegilla(Mostrar:Boolean);
Begin
     if Mostrar <> FMuestraRegilla
     then
     Begin
          FMuestraRegilla:=Mostrar;
          Repaint;
     end;
end;

function THojaTexto.CanResize(var NewWidth, NewHeight: Integer): Boolean;
begin
  result := inherited CanResize(NewWidth, NewHeight);
  if result then
  begin
    if NewWidth < FFilas then
      NewWidth := FFilas;

    if NewHeight < FColumnas then
      NewHeight := FColumnas;
  end;
end;


procedure THojaTexto.SetTopeBandaTitulo(Tope:Integer);
Begin
     if tope <> FTopeBandaTitulo
     then
     Begin
          FTopeBandaTitulo:=Tope;
          RePaint;
     end;
end;

procedure THojaTexto.SetTopeBandaDetalle(Tope:Integer);
Begin
     if tope <> FTopeBandaDetalle
     then
     Begin
          FTopeBandaDetalle:=Tope;
          RePaint;
     end;
end;

procedure THojaTexto.Paint;
Begin
     DibujarHoja(FColumnas,FFilas,FMuestraRegilla,FColorRegilla);
     DibujarBorde(FColorRegilla);
end;


procedure THojaTexto.Limpiar(color: TColor);
begin
     Canvas.Brush.Color := color;
     Canvas.Brush.Style := bsSolid;
     Canvas.FillRect(Rect(0, 0, Width, Height));
end;


procedure THojaTexto.DibujarBorde(color: TColor);
begin
     Canvas.Pen.Color := color;
     Canvas.Pen.Style := psSolid;
     Canvas.Brush.Style := bsClear;
     Canvas.Rectangle(0, 0, Width, Height);
end;

procedure THojaTexto.DibujarHoja(columnas,filas:integer;Regilla:Boolean;Color:TColor);
var ancho, alto, i, j, x, y: integer;
    margenX, margenY, margenAcumX, margenAcumY: integer;
     sobraX, sobraY: integer;

Begin
     Limpiar(clWhite);
     Canvas.Pen.Color := color;
     Canvas.Pen.Style := psInsideFrame  ;
     Canvas.Pen.Width:=1;

     ancho := Width  div columnas;
     alto  := Height div filas;

     FIntervaloX:=ancho;
     FIntervaloY:=alto;

     sobraX := Width mod columnas;
     margenX := 1;
     margenAcumX := 0;

     if Regilla then
     Begin
          for i:=1 to columnas do
          begin
               if sobraX = 0
               then margenX := 0;

               x := (i-1) * ancho + margenX + margenAcumX;
               sobraY  := Height mod filas;
               margenY := 1;
               margenAcumY := 0;

               for j:=1 to filas do
               begin
                    if sobraY = 0
                    then margenY := 0;

                    y := (j-1) * alto + margenY + margenAcumY;
                    if (FTopeBandaTitulo < j) and ((FTopeBandaDetalle+FTopeBandaTitulo) > j)
                    Then
                    Begin
                         // ***************** Dibuja Zona Detalle ******************
                         Canvas.Brush.Color:=FColorDetalle; // amarillo
                         Canvas.Brush.Style := bsSolid;
                         Canvas.FillRect(Rect(x, y, ancho + margenX + x, alto + margenY + y));
                         Canvas.Brush.Style:=BsClear;
                         If (FTopeBandaTitulo+1) = j
                         then
                         begin
                              Canvas.Pen.Color := clBlack;
                              Canvas.Rectangle(x, y, ancho + margenX + x, alto + margenY + y);
                         end;
                    end
                    else
                    Begin
                         Canvas.Pen.Color := color;
                         Canvas.Rectangle(x, y, ancho + margenX + x, alto + margenY + y);
                    end;

                    if sobraY > 0
                    then Dec(sobraY);
                     Inc(margenAcumY, margenY);
               end;

               Inc(margenAcumX, margenX);
               if sobraX > 0
               then Dec(sobraX);
          end;
     end;
end;

destructor THojaTexto.Destroy;
begin
     FRegistros.Free;
     inherited;
end;

end.