StringGrid

Code:

procedure SaveGrid;

var

f: textfile;

x, y: integer;

begin

assignfile(f, 'Filename');

rewrite(f);

writeln(f, stringgrid.colcount);

writeln(f, stringgrid.rowcount);

for X := 0 to stringgrid.colcount - 1 do

   for y := 0 to stringgrid.rowcount - 1 do

     writeln(F, stringgrid.cells[x, y]);

closefile(f);

end;

Code:

//Сначала нужно обработать событие OnDrawCell компонента TStringGrid:

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

var

i, x, y: Integer;

begin

if gdFixed in State then

   Exit;

if ARow > 1 then

   Exit;

{Draw row 1 with text from cell 1,1 spanning all cells in the row}

with sender as TStringGrid do

begin

   {Extend rect to include grid line on right, if not last cell in row}

   if aCol < Pred(ColCount) then

     Rect.Right := Rect.Right + GridlineWidth;

   {Figure out where the text of the first cell would start

   relative to the current cells rect}

   y := Rect.Top + 2;

   x := Rect.Left + 2;

   for i:= 1 to aCol - 1 do

     x := x - ColWidths[i] - GridlineWidth;

   {Paint cell pale yellow}

   Canvas.Brush.Color := $7FFFFF;

   Canvas.Brush.Style := bsSolid;

   Canvas.FillRect( Rect );

   {Paint text of cell 1,1 clipped to current cell}

   Canvas.TextRect( Rect, x, y, Cells[1, 1] );

end;

end;

//По созданию окна изобразим следующее

procedure TForm1.FormCreate(Sender: TObject);

var

i, k: Integer;

begin

with StringGrid1 do

begin

   cells[1, 1] := 'A rather long line which will span cells';

   for i:= 1 to colcount-1 do

     for k:= 2 to rowcount -1 do

       cells[i,k] := Format( 'Cell[%d, %d]', [i, k]);

end;

end;

Code:

procedure TFormHistory.ListHistoryDrawCell(Sender: TObject; Col, Row: Integer;

         Rect: TRect; State: TGridDrawState);

var

S: string;

DrawRect: TRect;

CurrentColor: TColor;

begin

// Определяем цвет строки в зависимости типа Imcoming

if (Sender as TStrinGgrid).Cells[COLUMN_INCOMING , Row ] = '1' then

   CurrentColor:=clBlue

else

   CurrentColor:=clMaroon;

if (Sender as TStrinGgrid).Row = Row then

   CurrentColor := clHighlightText;

(Sender as TStrinGgrid).Canvas.font.color := CurrentColor;

S:= (Sender as TStrinGgrid).Cells[ Col, Row ];

if (Col = COLUMN_MESSAGE ) and (Row <> ROW_HEADER) then

begin

   if Length(S) > 0 then

   begin

     DrawRect:=Rect;

     DrawText((Sender as TStrinGgrid).Canvas.Handle, Pchar(S), Length(S),

     DrawRect, dt_calcrect or dt_wordbreak or dt_left );

     if (DrawRect.bottom - DrawRect.top) > (Sender as TStrinGgrid).RowHeights[Row] then

       (Sender as TStrinGgrid).RowHeights

     else

     begin

       DrawRect.Right:=Rect.Right;

       (Sender as TStrinGgrid).Canvas.FillRect( DrawRect );

       DrawText((Sender as TStrinGgrid).Canvas.Handle, Pchar(S),

                 Length(S), DrawRect, dt_wordbreak or dt_left);

     end;

   end;

end

else

   if Row <> ROW_HEADER then

     (Sender as TStrinGgrid).Canvas.Textout(rect.left+3, rect.top+3 , S );

end;

Code:

{ With OLE Automation }

uses

  ComObj;

function RefToCell(ARow, ACol: Integer): string;

begin

  Result := Chr(Ord('A') + ACol - 1) + IntToStr(ARow);

end;

function SaveAsExcelFile(AGrid: TStringGrid; ASheetName, AFileName: string): Boolean;

const

  xlWBATWorksheet = -4167;

var

  Row, Col: Integer;

  GridPrevFile: string;

  XLApp, Sheet, Data: OLEVariant;

  i, j: Integer;

begin

  // Prepare Data

Data := VarArrayCreate([1, AGrid.RowCount, 1, AGrid.ColCount], varVariant);

  for i := 0 to AGrid.ColCount - 1 do

    for j := 0 to AGrid.RowCount - 1 do

      Data[j + 1, i + 1] := AGrid.Cells[i, j];

  // Create Excel-OLE Object

Result := False;

  XLApp := CreateOleObject('Excel.Application');

  try

    // Hide Excel

   XLApp.Visible := False;

    // Add new Workbook

   XLApp.Workbooks.Add(xlWBatWorkSheet);

    Sheet := XLApp.Workbooks[1].WorkSheets[1];

    Sheet.Name := ASheetName;

    // Fill up the sheet

   Sheet.Range[RefToCell(1, 1), RefToCell(AGrid.RowCount,

      AGrid.ColCount)].Value := Data;

    // Save Excel Worksheet

   try

      XLApp.Workbooks[1].SaveAs(AFileName);

      Result := True;

    except

      // Error ?

   end;

  finally

    // Quit Excel

   if not VarIsEmpty(XLApp) then

    begin

      XLApp.DisplayAlerts := False;

      XLApp.Quit;

      XLAPP := Unassigned;

      Sheet := Unassigned;

    end;

  end;

end;

// Example:

procedure TForm1.Button1Click(Sender: TObject);

begin

  if SaveAsExcelFile(stringGrid1, 'My Stringgrid Data', 'c:\MyExcelFile.xls') then

    ShowMessage('StringGrid saved!');

end;

Code:

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);

var

s: string;

c: Byte;

begin

with StringGrid1 do

   s := Cells[Col, Row];

if Length(s) = 0 then

begin

   if Key in ['a'..'z'] then

   begin

     c := Ord(Key) - 32;

     Key := Chr(c);

   end;

   exit;

end;

if s[Length(s)] = ' ' then

   if Key in ['a'..'z'] then

   begin

     c := Ord(Key) - 32;

     Key := Chr(c);

   end;

end;

//В обработчике события onKeyPress сделайте следующее:

if length(field.text) = 0 then

key := upCase (key);