Improve company productivity with a Business Account.Sign Up

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

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

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
HenryM2
Asked:
HenryM2
  • 9
  • 8
  • 2
1 Solution
 
Geert GOracle dbaCommented:
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
 
aflarinCommented:
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
 
Geert GOracle dbaCommented:
aflarin,
i think you missed 3 words ... printing on paper
0
Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

 
aflarinCommented:
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
 
HenryM2Author Commented:
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
 
aflarinCommented:
Please show the function where the error happens
0
 
HenryM2Author Commented:
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
 
aflarinCommented:
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
 
HenryM2Author Commented:
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
 
aflarinCommented:
>> 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
 
HenryM2Author Commented:
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
 
aflarinCommented:
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
 
HenryM2Author Commented:
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
 
aflarinCommented:
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
 
HenryM2Author Commented:
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
 
aflarinCommented:
> 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
 
HenryM2Author Commented:

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
 
aflarinCommented:
it is in the top-right corner. Look at the attached image
ProjectManager.PNG
0
 
HenryM2Author Commented:
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

The 14th Annual Expert Award Winners

The results are in! Meet the top members of our 2017 Expert Awards. Congratulations to all who qualified!

  • 9
  • 8
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now