Solved

Delphi Creating and printing a String Grid with Vertical and Horizontal Text and cell lines

Posted on 2010-08-29
19
2,243 Views
Last Modified: 2013-11-23
Using Delphi 2010, I have to create and print a tick sheet with columns and rows from a String Grid. There will be 22 columns.  Column 0 will be 60 characters wide and will contain a row heading, Columns 1 to 20 will be 3 characters wide and column 21 will be about 30 characters wide for entering comments.

I found some exaples from the experts which describes how to print the content of a String Grid,  however:

Problem 1 is that the text for the column headings for columns 1 to 20 has to be vertical.  Can this be done in a String Grid.  Further, when printed, the column headings must repeat on each page.
Problem 2 is that the cell lines need to be printed.

How can I do this?
0
Comment
Question by:HenryM2
  • 9
  • 8
  • 2
19 Comments
 
LVL 36

Expert Comment

by:Geert Gruwez
Comment Utility
the easiest would be to export it to excel
you could format the exported excel as you need
http://www.swissdelphicenter.ch/torry/showcode.php?id=379

other tools would be with reporting,
like quickreport -> but this is difficult and autosizing colums with lines is a lot of work
(in delphi as a component)

i haven't experimented enough with rave reports to know if this can do it too.
(also in delphi as a separate install)

I know fastreports and crystal reports can do it
http://fast-report.com/en/
http://www.businessobjects.com/products/reporting/crystalreports/vcl/default.asp

exporting to html will prove difficult to have the headers on each page
unless there is a css style for that (not that i know of)


or you can use a grid with this export functionality built in
http://www.devexpress.com/Products/VCL/ExQuantumGrid/
http://www.tmssoftware.com/site/gridpack.asp
0
 
LVL 13

Expert Comment

by:aflarin
Comment Utility
Henry, here is a sample with vertical column headers:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids;

type

  TStringGrid = class(Grids.TStringGrid)
  protected
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState); override;
  end;

  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure AngleTextOut(ACanvas: TCanvas; Angle, X, Y: Integer; Rect: TRect; Str: string);
var
  LogRec: TLogFont;
  OldFontHandle,
  NewFontHandle: hFont;
begin
  GetObject(ACanvas.Font.Handle, SizeOf(LogRec), Addr(LogRec));
  LogRec.lfEscapement := Angle*10;
  LogRec.lfOutPrecision:= OUT_TT_ONLY_PRECIS;
  NewFontHandle := CreateFontIndirect(LogRec);
  OldFontHandle := SelectObject(ACanvas.Handle, NewFontHandle);
  ACanvas.TextRect(Rect, X, Y, Str);
  NewFontHandle := SelectObject(ACanvas.Handle, OldFontHandle);
  DeleteObject(NewFontHandle);
end;

{ TStringGrid }

procedure TStringGrid.DrawCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState);
begin
  if ARow = 0 then
    AngleTextOut( Canvas, 90, ARect.Left+2, ARect.Bottom-3, ARect, Cells[ACol, ARow])
  else
    inherited;
end;


{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var
  i, j: Integer;
begin
  with StringGrid1 do
    for i:= 0 to RowCount-1 do
      for j:= 0 to ColCount-1 do
        Cells[j,i]:= 'Cell ' + IntToStr(j) + ' ' + IntToStr(i);
end;

end.
0
 
LVL 36

Expert Comment

by:Geert Gruwez
Comment Utility
aflarin,
i think you missed 3 words ... printing on paper
0
 
LVL 13

Expert Comment

by:aflarin
Comment Utility
Here is quick printing grid as a bitmap, but it doesn't look very well
If you need to print grid more quality, you draw it manually like in this thread:
http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_10822821.html

Or you can use report builders like Rave Report, Quick Report

type
  THackWinControl = class(TWinControl);

function GetControlBitmap( AControl: TWinControl ): TBitmap;
begin
  Result := TBitmap.Create;
  try
    with AControl do
    begin
      Result.Width := ClientWidth;
      Result.Height := ClientHeight;
      Result.Canvas.Lock;
      try
        THackWinControl(AControl).PaintWindow(Result.Canvas.Handle);
      finally
        Result.Canvas.Unlock;
      end;
    end;
  except
    Result.Free;
    raise;
  end;
end;

procedure PrintControl( AControl: TWinControl; X, Y: Integer );
var
  FormImage: TBitmap;
  Info: PBitmapInfo;
  InfoSize: DWORD;
  Image: Pointer;
  ImageSize: DWORD;
  Bits: HBITMAP;
  DIBWidth, DIBHeight: Longint;
  PrintWidth, PrintHeight: Longint;
begin
  Printer.BeginDoc;
  try
    FormImage := GetControlBitmap( AControl );
    try
      with Printer do
      begin
        Bits := FormImage.Handle;
        GetDIBSizes(Bits, InfoSize, ImageSize);
        Info := AllocMem(InfoSize);
        try
          Image := AllocMem(ImageSize);
          try
            GetDIB(Bits, 0, Info^, Image^);
            with Info^.bmiHeader do
            begin
              DIBWidth := biWidth;
              DIBHeight := biHeight;
            end;
            PrintWidth := MulDiv(DIBWidth, PageHeight, DIBHeight);
            if PrintWidth < PageWidth then
              PrintHeight := PageHeight
            else
            begin
              PrintWidth := PageWidth;
              PrintHeight := MulDiv(DIBHeight, PageWidth, DIBWidth);
            end;
            StretchDIBits(Canvas.Handle, x, y, PrintWidth+x, PrintHeight+y, 0, 0,
              DIBWidth, DIBHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
          finally
            FreeMem(Image, ImageSize);
          end;
        finally
          FreeMem(Info, InfoSize);
        end;
      end;
    finally
      FormImage.Free;
    end;
  finally
    Printer.EndDoc;
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  PrintControl( StringGrid1, 100, 100 );
end;
0
 

Author Comment

by:HenryM2
Comment Utility
Aflarin, I am trying to implement your Vertical Column Headers example.  It works fine on its own, but when I implment it in my main application I get the following compiler error:

[DCC Error] ImportExportMngrUnt.pas(302): E2010 Incompatible types: 'SiteDesignerMainUnt.TStringGrid' and 'Grids.TStringGrid'

This is because I have two other String Grids in the application that operates normally.  How can I overcome this?
0
 
LVL 13

Expert Comment

by:aflarin
Comment Utility
Please show the function where the error happens
0
 

Author Comment

by:HenryM2
Comment Utility
I have a StringGrid1 in another Unit.  The error happens on every line with reference to StringGrid1, e.g. GridRemoveColumn(StringGrid1, 1);  The procdeure, below.

procedure TImportExportMngrFrm.ClearBlankLinesAndCols;
Var CellText : String;
Begin
  CellText := StringGrid1.Cells[1,1];
  if CellText = '' Then
  CellText := StringGrid1.Cells[1,2];
  if CellText = '' Then // First Colum Blank
  Begin
    GridRemoveColumn(StringGrid1, 1);
  End;

    CellText := StringGrid1.Cells[2,4];
    if CellText = '' Then
    GridRemoveRow(StringGrid1, 4);

    CellText := StringGrid1.Cells[2,2];
    if CellText = '' Then
    GridRemoveRow(StringGrid1, 2);

    CellText := StringGrid1.Cells[2,1];
    if CellText = '' Then
    GridRemoveRow(StringGrid1, 1);

    CellText := StringGrid1.Cells[2,0];
    if CellText = '' Then
    GridRemoveRow(StringGrid1, 0);
End;
0
 
LVL 13

Expert Comment

by:aflarin
Comment Utility
try to add these lines to interface section of ImportExportMngrUnt.pas

unit ImportExportMngrUnt;

interface

uses
  ...
  SiteDesignerMainUnt;

type
  TStringGrid = SiteDesignerMainUnt.TStringGrid;


if it will cause the circular unit references, it would be better to move my grid to other unit
0
 

Author Comment

by:HenryM2
Comment Utility
Aflarin, I am stil having problems to get this to work.  Problem is that the other String Grids will also have Row 0 text rotated.  If I change the type of the StingGrid for this use of the String Grid to:

type
 TStringGridCustom = class(Grids.TStringGrid)
......

This makes the compiler happy, but now, is it possible to change the type of the VCL String Grid object to  TStringGridCustom instead of TStringGrid.
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 13

Expert Comment

by:aflarin
Comment Utility
>> is it possible to change the type of the VCL String Grid object to  TStringGridCustom instead of TStringGrid.

No, but you can create your own component what descend from TStringGrid and use it instead of TStringGrid.

Here is the same TStringGrid, but you can install it as separate component. Use Component > Install Component menu.

After installing it appears in the Samples palette.
unit VerticalRowGrid;



interface



uses

  Windows, SysUtils, Classes, Controls, Graphics, Grids;



type

  TVerticalRowGrid = class(TStringGrid)

  protected

    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;

  end;



procedure Register;



implementation





procedure AngleTextOut(ACanvas: TCanvas; Angle, X, Y: Integer; Rect: TRect; Str: string);

var

  LogRec: TLogFont;

  OldFontHandle,

  NewFontHandle: hFont;

begin

  GetObject(ACanvas.Font.Handle, SizeOf(LogRec), Addr(LogRec));

  LogRec.lfEscapement := Angle*10;

  LogRec.lfOutPrecision:= OUT_TT_ONLY_PRECIS;

  NewFontHandle := CreateFontIndirect(LogRec);

  OldFontHandle := SelectObject(ACanvas.Handle, NewFontHandle);

  ACanvas.TextRect(Rect, X, Y, Str);

  NewFontHandle := SelectObject(ACanvas.Handle, OldFontHandle);

  DeleteObject(NewFontHandle);

end;



{ TVerticalRowGrid }



procedure TVerticalRowGrid.DrawCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState);

begin

  if ARow = 0 then

    AngleTextOut( Canvas, 90, ARect.Left+2, ARect.Bottom-3, ARect, Cells[ACol, ARow])

  else

    inherited;

end;



procedure Register;

begin

  RegisterComponents('Samples', [TVerticalRowGrid]);

end;



end.

Open in new window

0
 

Author Comment

by:HenryM2
Comment Utility
RAD Studio 2010 now overturned the apple cart.  Component > Install Component menu no longer exists.  Have tried the  Component > New VCL Component and then selecting TStingGrid as the ancesor option in 2010 and then Create Unit,  but no luck to install the new component. It however creates second Tab Page in the IDE also called VerticalRowGrid but with contents as shown below.  Hence the fists PageTab with the code as you sent it to me exists as PageTab VerticalRowGrid  Please help to install this New,Pas unit as a component.

unit VerticalRowGrid;

interface

uses
  SysUtils, Classes, Controls, Grids;

type
  TStringGrid1 = class(TStringGrid)
  private
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
  published
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TStringGrid1]);
end;

end.
0
 
LVL 13

Expert Comment

by:aflarin
Comment Utility
I've created a package under D2009. I think it'll work fine under D2010.

1. Rename .dpr file to dpk file after unpacking. (I couldn't upload to EE .dpk file and had to rename it to .dpr)

2. Open .dpk file into Delphi. The resouce file will be recreated

3. Install it.

4. Add path to VerticalRowGrid to Library path (Tools > Options > Environment Options > Delphi Options > Library - Win32) or copy VerticalRowGrid to existing path where you already have additional Delphi components


VerticalRowGrid.zip
0
 

Author Comment

by:HenryM2
Comment Utility
No it still does not work. I must be doing something wrong installing the component.  It simply does not appear in the Samples Palette.  How does it determine which icon to display in the palette?
0
 
LVL 13

Expert Comment

by:aflarin
Comment Utility
It should have the same icon as TStringGrid.

Did you successfully open .dpk in Delphi?

Did you receive message that new component was installed after clicking Build package?
0
 

Author Comment

by:HenryM2
Comment Utility
OK lets try again:  You say
1. Rename .dpr file to dpk file after unpacking. (I couldn't upload to EE .dpk file and had to rename it to .dpr)
>I did this.

2. Open .dpk file into Delphi. The resouce file will be recreated.
> I am sure it said this.  If I repeat this step now, it opens the Source Code that you sent me.

3. Install it.
> Perhaps this is where I am wrong.  Please explain this step.
0
 
LVL 13

Expert Comment

by:aflarin
Comment Utility
> Please explain this step.

1. Switch to the Project manager View > Project Manager

2. Right click on the package (.bpl)

3. Select Install

You'll receive message that the package was successfully installed and new components was added.
0
 

Author Comment

by:HenryM2
Comment Utility

1. Switch to the Project manager View > Project Manager
>Doing this I see the Source Code that you sent me.

2. Right click on the package (.bpl)
>I appologise for my ignorance but where do I see the package to right click on.
0
 
LVL 13

Accepted Solution

by:
aflarin earned 500 total points
Comment Utility
it is in the top-right corner. Look at the attached image
ProjectManager.PNG
0
 

Author Closing Comment

by:HenryM2
Comment Utility
Thanks for your help.  I guess 2010 caught me out a bit. I will handle the printing side of the Sting Grid as a separate question.
0

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Suggested Solutions

Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now