DGRID

Top  Previous  Next

{ TDataGrid       : TStringgrid adattáblázat komponens

                  kibővített adatbeviteli eljárásokkal

Tipus           : DELPHI 1.0 komponens

Szerző          : Agócs László by StellaSOFT 2001

}

 

unit Dgrid;

 

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, StdCtrls, Grids, Szoveg;

 

Type

 

TCustomDataGrid = class(TStringGrid)

private

  FAutoAppendRow   : boolean;     {Automatikus sor hozzáfűzés a tábla végére}

  FCopyAboweRow    : boolean;     {Uj sornál a fölötte lévőt másolja}

  FOEMConversion   : boolean;

  FTitleLabels     : TStrings;    {Fejléc feliratok}

  FRowCount        : longint;

  procedure SetOEMConversion(Value:boolean);

  procedure SetTitleLabels(Value:TStrings);

{    function  GetRowCount:longint;

  procedure SetRowCount(Value:longint);}

protected

  elso             : boolean;     {belépéskor igaz}

  TitleChanged     : boolean;     {Jelzi a fejlécszövegek változását}

  procedure KeyDown(var Key: Word; Shift: TShiftState);override;

  procedure Paint;override;

public

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

{   procedure SaveToFile(fn:string);}

{   procedure SaveToListFile(fn:string;delimeiter:string;tablo:boolean);}

  procedure ColClear;

  procedure RowClear;

  procedure RowClearTo;

  procedure RowClearFrom;

  procedure Clear;

  procedure NewRec;

  procedure InsertRec;

  procedure DeleteRec;

  procedure FillsCol(Value:string);

  procedure InitTitleLabels;

  property AutoAppendRow:boolean read FAutoAppendRow write FAutoAppendRow;

  property CopyAboweRow:boolean read FCopyAboweRow write FCopyAboweRow;

  property OEMConversion : boolean read FOEMConversion write SetOEMConversion;

  property TitleLabels : TStrings read FTitleLabels write SetTitleLabels

           stored True;

{    property RowCount: longint read GetRowCount write SetRowCount;}

end;

 

TDataGrid = class(TCustomDataGrid)

published

  property CopyAboweRow;

  property OEMConversion;

  property TitleLabels;

end;

 

procedure Register;

Function UresStrings(t:TStrings): TStrings;

 

implementation

 

procedure Register;

begin

   RegisterComponents('AL',[TDataGrid]);

end;

 

constructor TCustomDataGrid.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

   DefaultRowHeight := 18;

   FixedRows:=1;

   FixedCols:=1;

   FTitleLabels := TStringList.Create;

   TitleChanged := True;

   FRowCount    := 0;

   elso:=True;

end;

 

destructor TCustomDataGrid.Destroy;

begin

   FTitleLabels.Free;

   inherited Destroy;

end;

 

procedure TCustomDataGrid.Paint;

var i: longint;

begin

If elso then begin

InitTitleLabels;

elso:=False;

end;

If FRowCount<>RowCount then begin

 For i:=1 to RowCount-1 do Rows[i][0]:=IntToStr(i);

 FRowCount:=RowCount

end;

inherited Paint;

end;

 

{function  TCustomDataGrid.GetRowCount:longint;

begin

Result := RowCount;

end;

 

procedure TCustomDataGrid.SetRowCount(Value:longint);

begin

Rowcount := Value;

end;}

 

procedure TCustomDataGrid.SetTitleLabels(Value:TStrings);

begin

FTitleLabels.Assign(Value);

TitleChanged := True;

InitTitleLabels;

end;

 

procedure TCustomDataGrid.InitTitleLabels;

var i: integer;

begin

If TitleChanged then begin

   For i:=0 to ColCount-1 do Cells[i,0]:='';

   For i:=0 to FTitleLabels.Count-1 do Cells[i,0]:=FTitleLabels.Strings[i];

   TitleChanged := False;

end;

end;

 

procedure TCustomDataGrid.Clear;

begin

RowCount:=1;

Newrec;

FixedRows:=1;

end;

 

procedure TCustomDataGrid.ColClear;

begin

If goEditing in Options then

Cols[Col].Assign(UresStrings(Cols[Col]));

end;

 

procedure TCustomDataGrid.RowClear;

begin

If goEditing in Options then begin

Rows[Row].Assign(UresStrings(Rows[Row]));

Cells[0,row]:=IntToStr(row);

end;

end;

 

procedure TCustomDataGrid.RowClearTo;

var i:longint;

begin

If goEditing in Options then begin

For i:=1 to Row-1 do begin

Rows[i].Assign(UresStrings(Rows[i]));

Cells[0,i]:=IntToStr(i);

end;

end;

end;

 

procedure TCustomDataGrid.RowClearFrom;

var i:longint;

begin

If goEditing in Options then begin

For i:=Row to Rowcount do begin

Rows[i].Assign(UresStrings(Rows[i]));

Cells[0,i]:=IntToStr(i);

end;

end;

end;

 

procedure TCustomDataGrid.FillsCol(Value:string);

var i:longint;

begin

If goEditing in Options then begin

For i:=1 to Rowcount do begin

Cells[Col,i]:=Value;

end;

end;

end;

 

procedure TCustomDataGrid.SetOEMConversion(Value:boolean);

var i,j:longint;

begin

If FOEMConversion<>Value then begin

   FOEMConversion := Value;

For i:=1 to Rowcount do

For j:=1 to Colcount do begin

    If FOEMConversion then Cells[j,i]:=ASCIIToWin(Cells[j,i])

    else Cells[j,i]:=WinToASCII(Cells[j,i]);

end;

end;

end;

 

procedure TCustomDataGrid.NewRec;

begin

If goEditing in Options then begin

RowCount:=RowCount+1;

If CopyAboweRow and (Row>1) then

   Rows[RowCount-1].Assign(Rows[RowCount-2])

else

   Rows[RowCount-1].Assign(UresStrings(Rows[RowCount-1]));

  Cells[0,RowCount-1]:=IntToStr(RowCount-1)+'*';

If RowCount-Toprow>VisibleRowCount then TopRow:=RowCount-VisibleRowCount;

Row:=RowCount-1; Col:=1;

end;

end;

 

procedure TCustomDataGrid.InsertRec;

var i:longint;

begin

If goEditing in Options then begin

If (RowCount>1) then begin

RowCount := RowCount+1;

If RowCount>2 then begin

   For i:=RowCount-1 downto Row do begin

       Rows[i].Assign(Rows[i-1]);

       Rows[i][0]:=IntToStr(i);

   end;

end;

If CopyAboweRow {and (Row>1)} then

   Rows[Row].Assign(Rows[Row+1])

else

   Rows[Row].Assign(UresStrings(Rows[Row]));

Rows[Row][0]:=IntToStr(Row)+'*';

end else NewRec;

end;

end;

 

procedure TCustomDataGrid.DeleteRec;

var i:longint;

begin

If goEditing in Options then begin

If (RowCount>2) then begin

   If (Row<RowCount-1) then

   For i:=Row to RowCount-2 do begin

       Rows[i+1][0]:=IntToStr(i);

       Rows[i].Assign(Rows[i+1]);

   end;

   RowCount:=RowCount-1

end else Rows[1].Assign(UresStrings(Rows[1]));

end;

end;

 

procedure TCustomDataGrid.KeyDown(var Key: Word; Shift: TShiftState);

begin

If goEditing in Options then begin

Case Key of

VK_INSERT : InsertRec;

VK_DELETE : DeleteRec;

VK_DOWN   : If (Row=RowCount-1) and AutoAppendRow then NewRec;

VK_ADD    : begin Key:=VK_RETURN; NewRec; end;

end;

end;

inherited KeyDown(Key,Shift);

end;

 

Function UresStrings(t:TStrings): TStrings;

var i:longint;

begin

Result:=TStringList.create;

Result.Assign(t);

For i:=1 to Result.Count-1 do Result[i]:='';

end;

 

end.