1:
2:
3:
4:
5:

  Image1.Width := StringGrid1.Width;
  Image1.Height := StringGrid1.Height;
  Image1.Canvas.CopyRect(Rect(0,0,StringGrid1.Width,StringGrid1.Height),
                         Canvas,
                         StringGrid1.BoundsRect);					

1:
2:
3:
4:
5:
6:
7:
8:

SG: TStringGrid;     > StringGrid, das dargestellt werden soll
Fixed: Boolean;      > Wie sollen fixierte Spalten/Zeilen dargestellt werden:
                       True  = wie fixierte Spalten/Zeilen (FixedColor)
                       False = wie Normal-Zellen (Color)
Bmp: TBitmap;        > Das TBitmap zur Ausgabe
Border: Integer;     > Die Ausgabe mit einem Rahmen in X-Breite(Pixel) versehen
                       0 = kein Rahmen
BorderColor: TColor; > Farbe des Rahmens					

1:
2:
3:
4:
5:

: Boolean     > True, wenn ein Bitmap in der Größe 
                des vollständigen StringGrids erstellt werden konnte.

                Kann das Bitmap nicht erzeugt werden, 
                zeigt die Funktion eine Fehlermeldung an und gibt False zurück.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:

function GridToBmp(SG: TStringGrid;Fixed: Boolean;Bmp: TBitmap;Border: Integer;BorderColor: TColor): Boolean;

var oldGridRect : TGridRect;
    oldLeftCol, oldTopRow : LongInt;
    oldFixedCols, oldfixedRows,
    xSum, ySum,
    z : Integer;
    RectGrid, RectTemp, RectBmp : TRect;
  //****************************************************************************
  {} procedure NextHorzRange(RangeRowBeginn,RangeRowEnd: Integer);
  {} begin
  {}   with SG do
  {}     begin
  {}     LeftCol := LeftCol+VisibleColCount;
  {}     Repaint;
  {}     RectGrid := CellRect(LeftCol,RangeRowBeginn);
  {}     RectTemp := CellRect(LeftCol+VisibleColCount-1,RangeRowEnd+VisibleRowCount-1);
  {}     RectGrid.Right := RectTemp.Right+1;
  {}     RectGrid.Bottom := RectTemp.Bottom+1;
  {}     RectBmp.Left := RectBmp.Right;
  {}     RectBmp.Right := RectBmp.Right+RectGrid.Right-RectGrid.Left;
  {}     Bmp.Canvas.CopyRect(rectBmp,Canvas,RectGrid);
  {}     end;
  {} end;
  //****************************************************************************
begin
  xSum := 0;
  ySum := 0;
  with SG do
    begin
    oldGridRect := Selection;
    oldLeftCol := LeftCol;
    oldTopRow := TopRow;
    if Fixed = False then
      begin
      oldFixedCols := FixedCols;
      oldFixedRows := FixedRows;
      FixedCols := 0;
      FixedRows := 0;
      end;
    Selection:= TGridRect(Rect(-1,-1,-1,-1));
    for z := 0 to ColCount-1 do
      inc(xSum,ColWidths[z]+1);
    for z := 0 to RowCount-1 do
      inc(ySum,RowHeights[z]+1);
    try//except
      Bmp.Width := xSum+(Border*2);
      Bmp.Height := ySum+(Border*2);
      Bmp.Canvas.Pen.Color := BorderColor;
      Bmp.Canvas.Brush.Color := BorderColor;
      Bmp.Canvas.Rectangle(0,0,Bmp.Width,Bmp.Height);
      //ersten horizontalen Bereich bearbeiten
      LeftCol := FixedCols;
      TopRow := FixedRows;
      Repaint;
      RectGrid := CellRect(0,0);
      RectTemp := CellRect(FixedCols+VisibleColCount-1,FixedRows+VisibleRowCount-1);
      RectGrid.Right := RectTemp.Right+1;
      RectGrid.Bottom := RectTemp.Bottom+1;
      RectBmp.Left := Border;
      RectBmp.Top := Border;
      RectBmp.Right := RectGrid.Right+Border;
      RectBmp.Bottom := RectGrid.Bottom+Border;
      Bmp.Canvas.CopyRect(RectBmp,Canvas,RectGrid);
      while LeftCol+VisibleColCount < ColCount do
        NextHorzRange(0,FixedRows);
      //weitere horizontale Bereiche bis Ende StringGrid bearbeiten
      while TopRow+VisibleRowCount < RowCount do
        begin
        LeftCol := FixedCols;
        TopRow := TopRow+VisibleRowCount;
        Repaint;
        RectGrid := CellRect(0,TopRow);
        RectTemp := CellRect(FixedCols+VisibleColCount-1,TopRow+VisibleRowCount-1);
        RectGrid.Right := RectTemp.Right+1;
        RectGrid.Bottom := RectTemp.Bottom+1;
        RectBmp.Top := RectBmp.Bottom;
        RectBmp.Left := Border;
        RectBmp.Right := RectGrid.Right+Border;
        RectBmp.Bottom := RectBmp.Top+RectGrid.Bottom-RectGrid.Top;
        Bmp.Canvas.CopyRect(RectBmp,Canvas,RectGrid);
        while LeftCol+VisibleColCount < ColCount do
          NextHorzRange(TopRow,TopRow);
        end;
      LeftCol := oldLeftCol;
      TopRow := oldTopRow;
      if Fixed = False then
        begin
        FixedCols := oldFixedCols;
        FixedRows := oldFixedRows;
        end;
      Selection := oldGridRect;
      Result := True;
    except
      on e:EOutOfResources do
        begin
        Result := False;
        showmessage('EOutOfResources: Bitmap konnte nicht erstellt werden');
        end
        else
          begin 
          Result := False;
          showmessage('Unbekannter Fehler');
          end;
    end;//Ende except
  end;//Ende with
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:

procedure TForm1.Button1Click(Sender: TObject);
var Bmp : TBitmap;
begin
  Bmp := TBitmap.Create;
  if GridToBmp(StringGrid1,True,Bmp,1,clBlack) then
    begin
    Image1.Picture.Bitmap.Assign(Bmp);
    //oder
    //Bmp.SaveToFile('C:\Temp\StringGrid.bmp');
    //Clipboard.Assign(Bmp); //in uses clipbrd einbinden !!!
    end;
  Bmp.Free;
end;