Ein Stringgrid als Bitmap ausgeben/speichern
Einige kennen sicher die folgende Möglichkeit:
Delphi-Quelltext
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); |
Damit erhält man aber nur den Ausschnitt der aktuell im StringGrid sichtbar ist.
Deshalb habe ich die folgende Funktion programmiert.
Damit kann ein StringGrid incl. aller Bilder, Schriftformate, Textausrichtungen ...,
als Bmp gespeichert, in die Zwischenablage gesetzt oder an ein TImage übergeben werden.
Die Funktion
GridToBmp holt nacheinander, durch das Setzen von TopRow und LeftCol,
das gesamte StringGrid in den sichtbaren Bereich.
Diese Ausschnitte werden dann entsprechend ins Bitmap kopiert.
• Funktionsvariablen
Quelltext
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 |
• Rückgabewert
Quelltext
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. |
Die Grenzen -soweit ich feststellen konnte- der Bitmaperstellung liegen ca. bei 5300 x 5300 = 28.090.000 Pixel,
etwa eine Dateigröße von 110 MB.
Beispielberechnung:
Ein Stringgrid, 50 Spalten mit Spaltenbreite 100 und 200 Zeilen mit Zeilenhöhe 20:
Breite: 50 * ( 100 + 1 ) = 5050 + 2 = 5052 incl. Gitterlinien und Border
Höhe: 200 * ( 20 + 1 ) = 4200 +2 = 4202
Gesamt: 5052 * 4202 = 21.228.504 Pixel
21.228.504 * 4 = 84.914.016 Bytes (Bittiefe 32)
Dazu kommen noch einige Bytes für den Datei-Haeder.
• Funktion
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 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); 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); 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; end;end; |
• Aufruf
Delphi-Quelltext
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); end; Bmp.Free; end; |
//Edit-1: weitere Erklärungen zum Rückgabewert und Beispielberechnung hinzugefügt
Moderiert von delfiphan: Dokumenttitel eingefügt.
Moderiert von jasocul: Beitrag geprüft am 05.05.2006
[meta]StringGrid Bitmap Zwischenablage[/meta]