list index bound(0)라는 에서가 나오네요.
컴파일은 잘되고 component로 등록시하고 compile하면 error이 발생합니다.
===============================================================
unit DMGrid;
interface
uses
SysUtils,
WinTypes,
WinProcs,
Messages,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
Grids;
type
TGridColorEvent = procedure (Sender: TObject; ARow, ACol: Longint;
ARect: TRect;
AState: TGridDrawState;
ABrush: TBrush; AFont: TFont ) of object;
TDMGrid = class(TStringGrid)
private
{ Private declarations }
FIsV: Boolean;
FOldMax,FNewMax:LongInt;
FFixedColAlignment: TAlignment;
FFixedRowAlignment: TAlignment;
FHCol: TStrings;
FHRow: TStrings;
FOnGetCellColor: TGridColorEvent;
procedure InitHCol;
procedure InitHRow;
procedure SetFixedColAlignment(Value: TAlignment);
procedure SetHCol(Value: TStrings);
procedure SetHRow(Value: TStrings);
procedure DrawCell(ACol, ARow : Longint; ARect : TRect;
AState : TGridDrawState); override;
function dm_SaveToTextFile(FN,D: string):Boolean;
protected
{ Protected declarations }
procedure Loaded; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure RowMoved(FromIndex, ToIndex: LongInt); override;
procedure ColumnMoved(FromIndex, ToIndex: LongInt); override;
procedure InsertRow(ToIndex: LongInt);
procedure DeleteRow(DIndex: LongInt);
procedure SetFixedColWidth(Value:Boolean);
procedure MoveTo(ACol, ARow: longint);
procedure SaveToTextFile;
published
{ Published declarations }
property FixedColAlignment: TAlignment read FFixedColAlignment
write SetFixedColAlignment default taLeftJustify;
property HCol: TStrings read FHCol write SetHCol;
property HRow: TStrings read FHRow write SetHRow;
property OnGetCellColor: TGridColorEvent read FOnGetCellColor write FOnGetCellColor;
end;
procedure Register;
var
nColCnt: Integer;
nRowCnt: Integer;
implementation
procedure Register;
begin
RegisterComponents('New Compnt', [TDMGrid]);
end;
constructor TDMGrid.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FFixedColAlignment := taLeftJustify;
FHCol:=TStringList.Create;
FHRow:=TStringList.Create;
nColCnt := 1;
nRowCnt := 1;
FIsV := False;
FOldMax := 0; FNewMax := 0;
end;
destructor TDMGrid.Destroy;
begin
inherited Destroy;
end;
procedure TDMGrid.RowMoved(FromIndex, ToIndex: LongInt);
begin
inherited RowMoved(FromIndex, ToIndex);
end;
procedure TDMGrid.ColumnMoved(FromIndex, ToIndex: LongInt);
begin
inherited ColumnMoved(FromIndex, ToIndex);
end;
procedure TDMGrid.InsertRow(ToIndex: LongInt);
begin
HideEditor;
RowCount := RowCount+1;
RowMoved(RowCount, ToIndex);
end;
procedure TDMGrid.DeleteRow(DIndex: LongInt);
begin
HideEditor;
RowMoved(DIndex,RowCount);
Rows[RowCount].Clear;
RowCount := RowCount-1;
end;
procedure TDMGrid.MoveTo(ACol, ARow: longint);
begin
MoveColRow(ACol, ARow, True, True);
end;
procedure TDMGrid.InitHCol;
var
I: Integer;
begin
if (FHCol <> nil) then begin
I:=0;
while (I < FHCol.Count) and (I < ColCount) do begin
Cells[I, 0]:=FHCol[I];
inc(I);
end
end;
if (FHCol.Count > 0) then begin
for I := 0 to FHCol.Count-1 do
Cells[I,0] := FHCol[I];
for i := FHCol.COunt to ColCount-1 do
Cells[I,0] := '';
end else
for I := 0 to ColCount-1 do
Cells[I,0] := '';
end;
procedure TDMGrid.InitHRow;
var
I: Integer;
begin
if (FHRow <> nil) then begin
I:=0;
while (I < FHRow.Count) and (I < (ColCount - 1)) do begin
Cells[0, I + 1]:=FHRow[I];
inc(I);
end;
end;
if (FHRow.Count > 0) then begin
for I := 0 to FHRow.Count-1 do
Cells[0,I+1] := FHRow[I];
for i := FHRow.Count to RowCount-1 do
Cells[0,I+1] := '';
end else
for I := 0 to RowCount-1 do
Cells[0,I+1] := '';
end;
procedure TDMGrid.Loaded;
begin
inherited Loaded;
initHCol;
initHRow;
end;
procedure TDMGrid.SetFixedColWidth(Value:Boolean);
begin
if Value then begin
FIsV := True;
Visible := False;
Invalidate;
Update;
Visible := True;
end else begin
FIsV := False;
Visible := False;
Invalidate;
Update;
Visible := True;
end;
end;
procedure TDMGrid.SetFixedColAlignment(Value: TAlignment);
begin
if FFixedColAlignment <> Value then
FFixedColAlignment := Value;
Refresh;
end;
procedure TDMGrid.SetHCol(Value: TStrings);
begin
FHCol.Assign(Value);
InitHCol;
nColCnt := 1;
nRowCnt := 1;
Refresh;
end;
procedure TDMGrid.SetHRow(Value: TStrings);
begin
FHRow.Assign(Value);
InitHRow;
nColCnt := 1;
nRowCnt := 1;
Refresh;
end;
procedure TDMGrid.SaveToTextFile;
begin
end;
procedure TDMGrid.DrawCell(ACol, ARow : Longint; ARect : TRect;
AState : TGridDrawState);
var
CellValue, Temp,Tmp: String;
Words: Array[1..5] of String;
N, I, X, Y, Index: Integer;
Text: array[0..255] of Char;
GridW,Extra: LongInt;
rExtra: Real;
begin
GridW := 0; Extra := 0; rExtra := 0;
if FIsV then begin
for ACol:=0 to ColCount-1 do begin
for ARow:=0 to RowCount-1 do begin
if (ARow = 0) and (Pos('!',Cells[ACol, ARow]) > 0) then begin
Tmp := Copy(Cells[ACol,ARow],1,Length(Cells[ACol,ARow])-2);
FOldMax := CanVas.TextWidth(Tmp)+5;
end else
FOldMax := CanVas.TextWidth(Cells[ACol,ARow])+5;
if FOldMax > FNewMax then
FNewMax := FOldMax;
end;
ColWidths[ACol] := FNewMax;
FOldMax := 0; FNewMax := 0;
end;
for ACol:=0 to ColCount-1 do begin
GridW := GridW+ColWidths[ACol];
end;
if GridW < Width then begin
rExtra := (Width - GridW)/ColCount-1;
Extra := Round( rExtra );
for ACol:=0 to ColCount-2 do begin
ColWidths[ACol] := ColWidths[ACol]+Extra;
end;
if Extra > rExtra then
ColWidths[ColCount-1] := ColWidths[ColCount-1]+Extra-3
else
ColWidths[ColCount-1] := ColWidths[ColCount-1]+Extra-2;
end;
FIsV := False;
Exit;
end;
if Assigned(FOnGetCellColor) then
FOnGetCellColor(Self, ARow, ACol, ARect, AState, Canvas.Brush, Canvas.Font);
if (ARow = 0) and (ColCount > 0) then begin
if Pos('!',Cells[ACol, ARow]) = 0 then begin
CellValue:=Cells[ACol, ARow];
StrPCopy(Text, Cells[ACol,ARow]);
end else begin
CellValue:=Copy(Cells[ACol, ARow],1,Pos('!',Cells[ACol,ARow])-1);
StrPCopy(Text, Copy(Cells[ACol,ARow],1,Pos('!',Cells[ACol,ARow])-1));
end;
if N > 5 then N:=5;
Canvas.FillRect(ARect);
if FFixedColAlignment = taLeftJustify then begin
SetTextAlign(Canvas.Handle,TA_LEFT);
X:=ARect.Left + 2;
Y:=ARect.Top+2;
end else if FFixedColAlignment = taRightJustify then begin
SetTextAlign(Canvas.Handle,TA_RIGHT);
X:=ARect.Right - 2;
Y:=ARect.Top+2;
end else if FFixedColAlignment = taCenter then begin
SetTextAlign(Canvas.Handle,TA_CENTER);
X := ARect.Left + ((ARect.Right - ARect.Left) div 2);
Y := ARect.Top + 2;
end;
for I:=1 to N do begin
ExtTextOut(Canvas.Handle, X, Y, ETO_CLIPPED or ETO_OPAQUE,
@ARect, Text, StrLen(Text), nil);
Y:=Y + Canvas.TextHeight(Words[I]);
end;
end else if (ARow > 0) and (ColCount > 0) then begin
if Pos('!',Cells[ACol,0]) > 0 then begin
Index := StrToInt(Copy(Cells[ACol,0],Pos('!',Cells[ACol,0])+1,1));
CellValue:=Cells[ACol, ARow];
StrPCopy(Text, Cells[ACol,ARow]);
Canvas.FillRect(ARect);
case Index of
0: begin
SetTextAlign(Canvas.Handle,TA_LEFT);
X:=ARect.Left + 2;
Y:=ARect.Top+2;
end;
1: begin
SetTextAlign(Canvas.Handle,TA_RIGHT);
X:=ARect.Right - 2;
Y:=ARect.Top+2;
end;
2: begin
SetTextAlign(Canvas.Handle,TA_CENTER);
X := ARect.Left + ((ARect.Right - ARect.Left) div 2);
Y := ARect.Top + 2;
end;
end;
ExtTextOut(Canvas.Handle, X, Y, ETO_CLIPPED or ETO_OPAQUE,
@ARect, Text, StrLen(Text), nil);
end else begin
inherited DrawCell(ACol, ARow, ARect, AState);
StrPCopy(Text, Cells[ACol,ARow]);
CellValue:=Cells[ACol, ARow];
Canvas.FillRect(ARect);
SetTextAlign(Canvas.Handle,TA_LEFT);
X:=ARect.Left + 2;
Y:=ARect.Top+2;
ExtTextOut(Canvas.Handle, X, Y, ETO_CLIPPED or ETO_OPAQUE,
@ARect, Text, StrLen(Text), nil);
end;
end;
end;
function TDMGrid.dm_SaveToTextFile(FN,D: string):Boolean;
var
F: TextFile;
I,J: Integer;
S,S2: Array[0..255] of Char;
begin
Screen.Cursor := crHourGlass;
if D = '' then D := #9;
AssignFile(F,FN);
ReWrite(F);
for I:=0 to RowCount-1 do begin
for J:=0 to ColCount-1 do begin
if I = 0 then begin
if Pos('!',Cells[J,I]) > 0 then
StrPCopy(S,Copy(Cells[J,I],1,Pos('!',Cells[J,I])-1 ))
else
StrPCopy(S,Cells[J,I]);
end else
StrPCopy(S,Cells[J,I]);
if (J < ColCount-1) then
StrCat(S,StrPCopy(S2,D))
else
StrCat(S,StrPCopy(S2,#13#10));
Write(F,StrPas(S));
end;
end;
Flush(F);
CloseFile(F);
Screen.Cursor := crDefault;
Result := True;
end;
end.