[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 801
  • Last Modified:

capturing image of a scrolling TstringGrid

Hi
I want to capture (to a bitmap)  the contents of a scrolling Tstringgrid which is in my Delphi app, from within that app.

The stringrid has fixed columns and rows, and to capture it fully it needs to be scrolled vertically and horizontally.  And the rows are of varying heights and the columns of varying widths.

I have hacked around this with WM_HSCROLL and WM_VSCROLL messages, but the approach does not look promising.  I think there should be a better way.

The problems so far are the fixed cols and rows, so I cannot just grab the image control in blocks with StringGrid.PaintTo and 'append' it . Also using SB_PAGEDOWN does not seem to scroll down 'the full height of the control', but one fewer rows. And I don't know how many SB_PAGEDOWN messages to issue

I also don't know the dimensions of the scrollbars to subtract them off.


Here is the code so far  - it does not look good.  Anyone able to help?

procedure TForm1.FormCreate(Sender: TObject);
var _row, _col : integer;

begin
 activeControl := Checkbox1;  application.processmessages;
  with stringGrid1 do begin
  options :=options +[goRowsizing,goColSizing];
  color := clYellow;
    rowcount := 100;
    colcount := 20;
    for _col := 0 to colcount - 1 do begin
    colwidths[_col] := 65 + random(20);
      for _row := 0 to rowcount - 1 do begin
        cells[_col, _row] := 'col ' + inttostr(_col) + ' row ' + inttostr(_row);
      end;                              // end for
    end;                                // end for
      for _row := 0 to rowcount - 1 do begin
       rowheights[_row] := 50+random(20);
      end;                              // end for
    col :=19;   // shove the selected cell off screen ??
    row :=20;
  end;
end;



procedure TForm1.btnGrabBitmapClick(Sender: TObject);
var bm         : Tbitmap;
var x,y,wid, hight : integer;
begin

    bm := Tbitmap.create;
    bm.PixelFormat:=pf24bit;
    bm.height :=1000;   // unknown at this stage
    bm.width :=1000;

    bm.canvas.lock;

           wid := stringgrid1.width;
           wid := wid-18; // a guess at the scrollbar width

           hight := stringgrid1.height;
           hight := hight-18;
        //   hight := hight-stringgrid1.Rowheights[0]; // adjust for non scrolling row
          x :=0; y :=0;
   // scroll to top left
       sendmessage(stringgrid1.handle,WM_HSCROLL,SB_LEFT,0);
       sendmessage(stringgrid1.handle,WM_VSCROLL,SB_TOP,0);


       stringgrid1.PaintTo(bm.canvas.handle,x,y);

       // vertical scrolling
       sendmessage(stringgrid1.handle,WM_VSCROLL,SB_PAGEDOWN,0);
       inc(y,hight);
       stringgrid1.PaintTo(bm.canvas.handle,x,y);

       sendmessage(stringgrid1.handle,WM_VSCROLL,SB_PAGEDOWN,0);
       inc(y,hight);
       stringgrid1.PaintTo(bm.canvas.handle,x,y);

       sendmessage(stringgrid1.handle,WM_VSCROLL,SB_PAGEDOWN,0);
       inc(y,hight);
       stringgrid1.PaintTo(bm.canvas.handle,x,y);

       (*
         horizontal scrolling

       // scroll right by the width of the window (supposedly)
       sendmessage(stringgrid1.handle,WM_HSCROLL,SB_PAGERIGHT,0);
       inc(x,wid);
       stringgrid1.PaintTo(bm.canvas.handle,x,y);

       // repeat .. but when do we stop??
       sendmessage(stringgrid1.handle,WM_HSCROLL,SB_PAGERIGHT,0);
       inc(x,wid);
       stringgrid1.PaintTo(bm.canvas.handle,x,y);

       sendmessage(stringgrid1.handle,WM_HSCROLL,SB_PAGERIGHT,0);
       inc(x,wid);
       stringgrid1.PaintTo(bm.canvas.handle,x,y);
       *)
bm.Canvas.Unlock;

  bm.saveTofile('test.bmp');
  bm.free;

end;

end.


0
Mutley2003
Asked:
Mutley2003
1 Solution
 
Pierre CorneliusCommented:
Try this:

procedure SaveStringGridToBmp(AGrid: TStringGrid; AFilename: string);
var i, w,h, w2,h2: integer;
    bm: TBitmap;
begin
  w:= AGrid.Width;
  h:= AGrid.Height;
  w2:= 0; h2:= 0;
  for i:= 0 to AGrid.ColCount-1 do w2:= w2 + AGrid.ColWidths[i]+1;  //+1 for gridline
  for i:= 0 to AGrid.RowCount-1 do h2:= h2 + AGrid.RowHeights[i]+1; //+1 for gridline

  try
    AGrid.Width := w2;
    AGrid.Height:= h2;
    bm := Tbitmap.create;
    try
      bm.PixelFormat:=pf24bit;
      bm.height:= h2;
      bm.width := w2;
      AGrid.PaintTo(bm.canvas,0,0);
      bm.saveTofile(AFilename);
    finally
      bm.free;
    end;
  finally
    AGrid.Height:= h;
    AGrid.Width:= w;
  end;
end;
0
 
Mutley2003Author Commented:
sorry not to get back to you sooner - that looks like a VERY good idea. Smart.

testing it now.. works like a dream. I made a couple of minor changes
a) scrolling to the top left before capture
b) needed a handle in the call to PaintTo

Thanks a lot. Much appreciated


procedure SaveStringGridToBmp(AGrid: TStringGrid; AFilename: string);
var i, w,h, w2,h2: integer;
    bm: TBitmap;
begin
 sendmessage(agrid.handle,WM_HSCROLL,SB_LEFT,0);
       sendmessage(agrid.handle,WM_VSCROLL,SB_TOP,0);
  w:= AGrid.Width;
  h:= AGrid.Height;
  w2:= 0; h2:= 0;
  for i:= 0 to AGrid.ColCount-1 do w2:= w2 + AGrid.ColWidths[i]+1;  //+1 for gridline
  for i:= 0 to AGrid.RowCount-1 do h2:= h2 + AGrid.RowHeights[i]+1; //+1 for gridline

  try
    AGrid.Width := w2;
    AGrid.Height:= h2;
    bm := Tbitmap.create;
    try
      bm.PixelFormat:=pf24bit;
      bm.height:= h2;
      bm.width := w2;
      AGrid.PaintTo(bm.canvas.handle,0,0);
      bm.saveTofile(AFilename);
    finally
      bm.free;
    end;
  finally
    AGrid.Height:= h;
    AGrid.Width:= w;
  end;
end;
0

Featured Post

New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now