Q&A

  • delphi3에서는 되는데 5에서는 안되네요(소스)
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.





0  COMMENTS