uses Grids
//
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;
Beispiel :
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.bmp');
//Clipboard.Assign(Bmp); //in uses clipbrd einbinden !!!
end;
Bmp.Free;
end;
Keine Kommentare:
Kommentar veröffentlichen