type
TRegistros = class;
THojaTexto = Class;
TRegistro = Class;
THojaTexto = class(TCustomPanel)
private
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
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
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
published
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;
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;
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;
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; Height:=0;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;
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
Canvas.Brush.Color:=FColorDetalle; 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.