home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 25 / nopv25.iso / 040A / CGRID32.ZIP / CGREPORT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-24  |  29.7 KB  |  1,071 lines
  1. unit CGreport;
  2. {$DEFINE DELPHI2}
  3.  
  4. interface
  5.  
  6. uses
  7.   Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  8.   CGrid,WinProcs,WinTypes, Extctrls,
  9. {$IFDEF DELPHI2}
  10.   QuickRep;
  11. {$ELSE}
  12.   Printers;
  13. {$ENDIF}
  14.  
  15. Const
  16.   PAGEBUFSZ = 70;
  17.   DEFAULTHEIGHT=24;
  18.   PAGERATIO = 6.25;
  19.   XCELLMARGIN = 2;
  20.   YCELLMARGIN = 2;
  21. type
  22.   TPrintXCellEvent = procedure (Sender: TObject; Col, Row: Longint;
  23.     var Xcell : string) of object;
  24.   TLogoPosition = (lpBeforeText,lpAfterText);
  25.   PLongint = ^Longint;
  26.  
  27.   TCGridReport = class(TComponent)
  28.   private
  29.     FDBCrossGrid : TDBCrossGrid;
  30.     FLeftMargin: integer;
  31.     FRightMargin: integer;
  32.     FTopMargin : integer;
  33.     FBottomMargin : integer;
  34.     FHeaderHeight : integer;
  35. {
  36.     FHeaderColor : TColor;
  37. }
  38.     FHeaderFont : TFont;
  39.     FHeaderText : String;
  40.     FHeaderAlign : TAlignment;
  41.     FHeaderLogo : TImage;
  42.     FHeaderLogoPos : TLogoPosition;
  43.     FHeaderLogoWidth : integer;
  44.     FFooterHeight : integer;
  45. {
  46.     FFooterColor : TColor;
  47. }
  48.     FFooterFont : TFont;
  49.     FFooterText : String;
  50.     FFooterAlign : TAlignment;
  51.     FFooterLogo : TImage;
  52.     FFooterLogoPos : TLogoPosition;
  53.     FFooterLogoWidth : integer;
  54.     FLineStyle : TPenStyle;
  55.     FOnPrintXCell : TPrintXCellEvent;
  56.     Fpratiox : double;
  57.     Fpratioy : double;
  58.     procedure DrawOutline(
  59.        torgx,torgy,twidth,theight : integer;
  60.        startrow,endrow,startcol,endcol : integer);
  61.     procedure DrawPicture(descanvas : TCanvas;simage : TImage;ARect : TRect);
  62.     procedure SetDBCrossGrid(Const Value : TDBCrossGrid);
  63.     procedure SetHeaderFont(Const Value : TFont);
  64.     procedure SetHeaderHeight(Const Value : Integer);
  65.     procedure SetFooterFont(Const Value : TFont);
  66.     procedure SetFooterHeight(Const Value : Integer);
  67.     function  GetCell(ACol,ARow : Longint) : String;
  68.   protected
  69.     { Protected declarations }
  70.   public
  71.     constructor Create(AOwner: TComponent); override;
  72.     destructor destroy; override;
  73.     procedure Print;
  74. {$IFDEF DELPHI2}
  75.     procedure Preset;
  76.     procedure Preview;
  77. {$ENDIF}
  78.     procedure CreateHTML(filename:String);
  79.     procedure CreateASCII(filename:String; sep : string);
  80.   published
  81.     property DBCrossGrid : TDBCrossGrid read FDBCrossGrid write SetDBCrossGrid;
  82.     property LeftMargin: integer read FLeftMargin write FLeftMargin;
  83.     property RightMargin: integer read FRightMargin write FRightMargin;
  84.     property TopMargin : integer read FTopMargin write FTopMargin;
  85.     property BottomMargin : integer read FBottomMargin write FBottomMargin;
  86.     property HeaderHeight : integer read FHeaderHeight write SetHeaderHeight;
  87. {
  88.     property HeaderColor : TColor read FHeaderColor write FHeaderColor;
  89. }
  90.     property HeaderFont : TFont read FHeaderFont write SetHeaderFont;
  91.     property HeaderText : String read FHeaderText write FHeaderText;
  92.     property HeaderAlign : TAlignment read FHeaderAlign write FHeaderAlign;
  93.     property HeaderLogo : TImage read FHeaderLogo write FHeaderLogo;
  94.     property HeaderLogoPos : TLogoPosition read FHeaderLogoPos write FHeaderLogoPos;
  95.     property HeaderLogoWidth : integer read FHeaderLogoWidth
  96.         write FHeaderLogoWidth;
  97.     property FooterHeight : integer read FFooterHeight write SetFooterHeight;
  98. {
  99.     property FooterColor : TColor read FFooterColor write FFooterColor;
  100. }
  101.     property FooterFont : TFont read FFooterFont write SetFooterFont;
  102.     property FooterText : String read FFooterText Write FFooterText;
  103.     property FooterAlign : TAlignment read FFooterAlign write FFooterAlign;
  104.     property FooterLogo : TImage read FFooterLogo write FFooterLogo;
  105.     property FooterLogoPos : TLogoPosition read FFooterLogoPos write FFooterLogoPos;
  106.     property FooterLogoWidth : integer read FFooterLogoWidth 
  107.         write FFooterLogoWidth;
  108.     property LineStyle : TPenStyle read FLineStyle write FLineStyle; 
  109.     property OnPrintXCell: TPrintXCellEvent read FOnPrintXCell write FOnPrintXCell;
  110.   end;
  111.  
  112. implementation
  113. procedure xxx(Index : Integer; arrayp : PLongint;
  114.   var count : Integer);
  115. begin
  116. end;
  117.  
  118. procedure TCGridReport.DrawOutline(
  119.    torgx,torgy,twidth,theight : integer;
  120.    startrow,endrow,startcol,endcol : integer
  121.    );
  122.   function GetTotalWidth(scol,ecol: integer) : Integer;
  123.   var
  124.     twidth : integer;
  125.     i : integer;
  126.   begin
  127.     twidth := 0;
  128.     for i := scol to ecol do
  129.       twidth := twidth + FDBCrossGrid.ColWidths[i];
  130.     Result := twidth;
  131.   end;
  132.  
  133.   function GetTotalHeight(srow,erow: integer) : Integer;
  134.   var
  135.     theight : integer;
  136.     i : integer;
  137.   begin
  138.     theight := 0;
  139.     for i := srow to erow do
  140.       theight := theight + FDBCrossGrid.RowHeights[i];
  141.     Result := theight;
  142.   end;
  143.  
  144. var
  145.   i,j : integer;
  146.   x1,y1,x2,y2 : integer;
  147.   x3,y3,x4,y4 : integer;
  148.   ntheight,ntwidth : integer;
  149.   fixedh,fixedw : integer;
  150.   ncrow, nccol : integer;
  151.   norgx,norgy : integer;
  152.   nstartrow,nstartcol : integer;
  153.   cnt,cnt1 : Integer;
  154.   arrayp,arrayi : PLongint;
  155.   colcnt : Longint;
  156. begin
  157. {$IFDEF DELPHI2 }
  158.   QRPrinter.Canvas.Pen.Style := psSolid;
  159. {$ELSE}
  160.   Printer.Canvas.Pen.Style := psSolid;
  161. {$ENDIF}
  162.   nstartrow := startrow;
  163.   nstartcol := startcol;
  164.   With FDBCrossGrid do
  165.     begin
  166.       ncrow := FixedRows;
  167.       nccol := GetNumCrossCols;
  168.     end;
  169.   fixedw := GetTotalWidth(startcol,nccol-1);
  170.   fixedh := GetTotalHeight(startrow,ncrow-1);
  171.  
  172.   ntwidth := GetTotalWidth(startcol,endcol);
  173.   ntheight := GetTotalHeight(startrow,endrow);
  174.  
  175. {$IFDEF DELPHI2 }
  176.   QRPrinter.Canvas.Rectangle(
  177.       Trunc(torgx * Fpratiox),
  178.     Trunc(torgy * Fpratioy),
  179.     Trunc((torgx+ntwidth) * Fpratiox),
  180.     Trunc((torgy+ntheight) * Fpratioy));
  181. {$ELSE}
  182.   Printer.Canvas.Rectangle(
  183.       Trunc(torgx * Fpratiox),
  184.     Trunc(torgy * Fpratioy),
  185.     Trunc((torgx+ntwidth) * Fpratiox),
  186.     Trunc((torgy+ntheight) * Fpratioy));
  187. {$ENDIF}
  188. {
  189. ** draw fixed fixed area
  190. }
  191.   if((startrow < ncrow) and (startcol < nccol)) then
  192.     begin
  193.       x1 := torgx;
  194.       x2 := torgx + fixedw;
  195.       y1 := torgy + fixedh;
  196.       y2 := torgy + fixedh;
  197. {$IFDEF DELPHI2 }
  198.       QRPrinter.Canvas.PolyLine([
  199.           point(Trunc(x1*Fpratiox),Trunc(y1*Fpratioy)),
  200.     point(Trunc(x2*Fpratiox),Trunc(y2*Fpratioy))]);
  201. {$ELSE}
  202.       Printer.Canvas.PolyLine([
  203.           point(Trunc(x1*Fpratiox),Trunc(y1*Fpratioy)),
  204.     point(Trunc(x2*Fpratiox),Trunc(y2*Fpratioy))]);
  205. {$ENDIF}
  206.       x1 := torgx + fixedw;
  207.       x2 := torgx + fixedw;
  208.       y1 := torgy ;
  209.       y2 := torgy + fixedh;
  210. {$IFDEF DELPHI2 }
  211.       QRPrinter.Canvas.PolyLine([
  212.           point(Trunc(x1*Fpratiox),Trunc(y1*Fpratioy)),
  213.     point(Trunc(x2*Fpratiox),Trunc(y2*Fpratioy))]);
  214. {$ELSE}
  215.       Printer.Canvas.PolyLine([
  216.           point(Trunc(x1*Fpratiox),Trunc(y1*Fpratioy)),
  217.     point(Trunc(x2*Fpratiox),Trunc(y2*Fpratioy))]);
  218. {$ENDIF}
  219.     end;
  220. {
  221. ** draw fixed rows
  222. }
  223.   colcnt := FDBCrossGrid.GetColCount;
  224.   if(startrow < ncrow) then
  225.     begin
  226.       x1 := torgx + fixedw;
  227.       y1 := torgy;
  228.       x2 := torgx + ntwidth;
  229.       y2 := torgy;
  230.       arrayp := AllocMem(colcnt*(sizeof(Longint)));
  231.       if(arrayp = nil) then
  232.         begin
  233.           messagedlg('Not enough memory for draw fixed rows',mtError,[mbAbort],0);
  234.           exit;
  235.         end;
  236.       for i := startrow to ncrow - 1 do
  237.         begin
  238.       x3 := x1;
  239.       x4 := x1;
  240.       y3 := y1;
  241.           y4 := y3;
  242.           for j := i to ncrow - 1 do
  243.             y4 := y4 + FDBCrossGrid.RowHeights[j];
  244.           FDBCrossGrid.GetFixedRowDataes(i,Pointer(arrayp),cnt);
  245.           arrayi := arrayp;
  246.           cnt1 := 0;
  247.           while((arrayi^ < startcol) and (cnt1 < cnt)) do
  248.         begin
  249.               Inc(arrayi);
  250.               Inc(cnt1);
  251.         end;
  252.       for j := startcol to endcol - 1 do
  253.         begin
  254.               if(j < nccol ) then
  255.                 continue;
  256.               x3 := x3 + FDBCrossGrid.ColWidths[j];
  257.               x4 := x3;
  258.           if(j < arrayi^) then
  259.             continue;
  260.           if(cnt1 < cnt) then
  261.         begin
  262.                   Inc(arrayi);
  263.           Inc(cnt1);
  264.         end;
  265. {$IFDEF DELPHI2}
  266.               QRPrinter.Canvas.PolyLine([
  267.                  point(Trunc(x3*Fpratiox),Trunc(y3*Fpratioy)), 
  268.             point(Trunc(x4*Fpratiox),Trunc(y4*Fpratioy))]);
  269. {$ELSE}
  270.               Printer.Canvas.PolyLine([
  271.                  point(Trunc(x3*Fpratiox),Trunc(y3*Fpratioy)), 
  272.             point(Trunc(x4*Fpratiox),Trunc(y4*Fpratioy))]);
  273. {$ENDIF}
  274.         end;
  275.           y1 := y1 + FDBCrossGrid.RowHeights[i];
  276.           y2 := y2 + FDBCrossGrid.RowHeights[i];
  277. {$IFDEF DELPHI2}
  278.           QRPrinter.Canvas.PolyLine([
  279.             point(Trunc(x1*Fpratiox),Trunc(y1*Fpratioy)), 
  280.             point(Trunc(x2*Fpratiox),Trunc(y2*Fpratioy))]);
  281. {$ELSE}
  282.           Printer.Canvas.PolyLine([
  283.             point(Trunc(x1*Fpratiox),Trunc(y1*Fpratioy)), 
  284.             point(Trunc(x2*Fpratiox),Trunc(y2*Fpratioy))]);
  285. {$ENDIF}
  286.         end;
  287.       FreeMem(arrayp,colcnt*(sizeof(Longint)));
  288.       arrayp := nil;
  289.       nstartrow := ncrow;
  290.     end;
  291. {
  292. ** draw fixed cols
  293. }
  294.   if(startcol < nccol) then
  295.     begin
  296.       x1 := torgx;
  297.       y1 := torgy + fixedh;
  298.       x2 := torgx;
  299.       y2 := torgy + ntheight;
  300.       arrayp := AllocMem(FDBCrossGrid.GetRowCount*(sizeof(Longint)));
  301.       if(arrayp = nil) then
  302.         begin
  303.           messagedlg('Not enough memory for draw fixed cols',mtError,[mbAbort],0);
  304.           exit;
  305.         end;
  306.       for i := startcol to nccol - 1 do
  307.         begin
  308.       x3 := x1;
  309.       x4 := x1;
  310.       y3 := y1;
  311.       y4 := y3;
  312.           for j := i to nccol - 1 do
  313.             x4 := x4 + FDBCrossGrid.ColWidths[j];
  314.           FDBCrossGrid.GetFixedColDataes(i,Pointer(arrayp),cnt,1);
  315.           arrayi := arrayp;
  316.           cnt1 := 0;
  317.           while((arrayi^ < startrow) and (cnt1 < cnt)) do
  318.             begin
  319.               Inc(arrayi);
  320.               Inc(cnt1);
  321.             end;
  322.       for j := startrow to endrow - 1 do
  323.         begin
  324.               if(j < ncrow ) then
  325.                 continue;
  326.               y3 := y3 + FDBCrossGrid.RowHeights[j];
  327.               y4 := y3;
  328.               if(j < arrayi^) then
  329.                 continue;
  330.               if(cnt1 < cnt) then
  331.                 begin
  332.                   Inc(arrayi);
  333.                   Inc(cnt1);
  334.                 end;
  335. {$IFDEF DELPHI2}
  336.               QRPrinter.Canvas.PolyLine([
  337.                  point(Trunc(x3*Fpratiox),Trunc(y3*Fpratioy)), 
  338.             point(Trunc(x4*Fpratiox),Trunc(y4*Fpratioy))]);
  339. {$ELSE}
  340.               Printer.Canvas.PolyLine([
  341.                  point(Trunc(x3*Fpratiox),Trunc(y3*Fpratioy)), 
  342.             point(Trunc(x4*Fpratiox),Trunc(y4*Fpratioy))]);
  343. {$ENDIF}
  344.         end;
  345.           x1 := x1 + FDBCrossGrid.ColWidths[i];
  346.           x2 := x2 + FDBCrossGrid.ColWidths[i];
  347. {$IFDEF DELPHI2}
  348.           QRPrinter.Canvas.PolyLine([
  349.             point(Trunc(x1*Fpratiox),Trunc(y1*Fpratioy)), 
  350.             point(Trunc(x2*Fpratiox),Trunc(y2*Fpratioy))]);
  351. {$ELSE}
  352.           Printer.Canvas.PolyLine([
  353.             point(Trunc(x1*Fpratiox),Trunc(y1*Fpratioy)), 
  354.             point(Trunc(x2*Fpratiox),Trunc(y2*Fpratioy))]);
  355. {$ENDIF}
  356.         end;
  357.       FreeMem(arrayp,FDBCrossGrid.GetRowCount*(sizeof(Longint)));
  358.       arrayp := nil;
  359.       nstartcol := nccol;
  360.     end;
  361.  
  362. {$IFDEF DELPHI2}
  363.   QRPrinter.Canvas.Pen.Style := FLineStyle;
  364. {$ELSE}
  365.   Printer.Canvas.Pen.Style := FLineStyle;
  366. {$ENDIF}
  367.   if(goCGVertLine in FDBCrossGrid.CGOptions) then
  368.     begin
  369.       x1 := torgx + fixedw + FDBCrossGrid.ColWidths[nstartcol];
  370.       y1 := torgy + fixedh;
  371.       x2 := torgx + fixedw + FDBCrossGrid.ColWidths[nstartcol];
  372.       y2 := torgy + ntheight;
  373.       for i := nstartcol + 1 to endcol do
  374.         begin
  375. {$IFDEF DELPHI2 }
  376.          QRPrinter.Canvas.PolyLine([
  377.             point(Trunc(x1*Fpratiox),Trunc(y1*Fpratioy)), 
  378.             point(Trunc(x2*Fpratiox),Trunc(y2*Fpratioy))]);
  379. {$ELSE}
  380.          Printer.Canvas.PolyLine([
  381.             point(Trunc(x1*Fpratiox),Trunc(y1*Fpratioy)), 
  382.             point(Trunc(x2*Fpratiox),Trunc(y2*Fpratioy))]);
  383. {$ENDIF}
  384.       x1 := x1 + FDBCrossGrid.ColWidths[i];
  385.       x2 := x2 + FDBCrossGrid.ColWidths[i];
  386.     end
  387.     end;
  388.   if(goCGHorzLine in FDBCrossGrid.CGOptions) then
  389.     begin
  390.       x1 := torgx + fixedw;
  391.       y1 := torgy + fixedh + FDBCrossGrid.RowHeights[nstartrow];
  392.       x2 := torgx + ntwidth;
  393.       y2 := torgy + fixedh + FDBCrossGrid.RowHeights[nstartrow];
  394.       for i := nstartrow+1 to endrow do
  395.         begin
  396. {$IFDEF DELPHI2}
  397.           QRPrinter.Canvas.PolyLine([
  398.             point(Trunc(x1*Fpratiox),Trunc(y1*Fpratioy)), 
  399.             point(Trunc(x2*Fpratiox),Trunc(y2*Fpratioy))]);
  400. {$ELSE}
  401.           Printer.Canvas.PolyLine([
  402.             point(Trunc(x1*Fpratiox),Trunc(y1*Fpratioy)), 
  403.             point(Trunc(x2*Fpratiox),Trunc(y2*Fpratioy))]);
  404. {$ENDIF}
  405.       y1 := y1 + FDBCrossGrid.RowHeights[i];
  406.       y2 := y2 + FDBCrossGrid.RowHeights[i];
  407.     end
  408.     end;      
  409. end;
  410.  
  411. procedure TCGridReport.DrawPicture(descanvas : TCanvas;simage : TImage;ARect : TRect);
  412. var
  413.   cwidth,cheight : integer;
  414.   desrect : TRect;
  415.   srcrect : TRect;
  416. begin
  417.     cwidth := ARect.right - ARect.left;
  418.     cheight := ARect.bottom - ARect.top;
  419.     with simage.picture do
  420.       begin
  421.       srcrect.left := 0;
  422.       srcrect.top  := 0;
  423.       srcrect.right  := Width;
  424.       srcrect.bottom  := Height;
  425.  
  426.       if Width > cwidth then
  427.     begin
  428.       desrect.left := ARect.left;
  429.       desrect.right := ARect.right;
  430.     end
  431.     else
  432.     begin
  433.       desrect.left := ARect.left + (cwidth - Width) div 2;
  434.       desrect.right := ARect.right - (cwidth - Width) div 2;
  435.     end;
  436.  
  437.       if Height > cheight then
  438.     begin
  439.       desrect.top := ARect.top;
  440.       desrect.bottom := ARect.bottom;
  441.     end
  442.     else
  443.     begin
  444.       desrect.top := ARect.top + (cheight - Height) div 2;
  445.       desrect.bottom := ARect.bottom - (cheight - Height) div 2;
  446.     end;
  447.       end;
  448.  descanvas.draw(desrect.left,desrect.top,simage.picture.graphic);
  449. end;
  450.  
  451. constructor TCGridReport.Create(AOwner: TComponent);
  452. begin
  453.   inherited Create(AOwner);
  454.   FHeaderHeight := DEFAULTHEIGHT;
  455.   FFooterHeight := DEFAULTHEIGHT;
  456.   FHeaderFont := TFont.Create;
  457.   FFooterFont := TFont.Create;
  458. end;
  459.  
  460. destructor TCGridReport.destroy;
  461. begin
  462.   FHeaderFont.Free;
  463.   FFooterFont.Free;
  464.   inherited Destroy;
  465. end;
  466.  
  467. function TCGridReport.GetCell(ACol,ARow : Longint) : String;
  468. var 
  469.   data : string;
  470. begin
  471.   if(Assigned(FOnPrintXCell)) then
  472.     FOnPrintXCell(Self,ACol,ARow,data)
  473.   else
  474.     data := FDBCrossGrid.GetXCell(ACol,ARow);
  475.   Result := data;
  476. end;
  477.  
  478. procedure TCGridReport.SetDBCrossGrid(Const Value : TDBCrossGrid);
  479. begin
  480.   FDBCrossGrid := Value;
  481. end;
  482.  
  483. procedure TCGridReport.SetHeaderFont(Const Value : TFont);
  484. begin
  485.   FHeaderFont.Assign(Value);
  486. end;
  487.  
  488. procedure TCGridReport.SetHeaderHeight(Const Value : Integer);
  489. begin
  490.   if(Value < DEFAULTHEIGHT) then
  491.     begin
  492.       messagedlg('Minimum HeaderHeight should be larger then ' + 
  493.         inttostr(DEFAULTHEIGHT), mtinformation,[mbOK],0);
  494.       exit;
  495.     end;
  496.   FHeaderHeight := Value;
  497. end;
  498.  
  499. procedure TCGridReport.SetFooterFont(Const Value : TFont);
  500. begin
  501.   FFooterFont.Assign(Value);
  502. end;
  503.  
  504. procedure TCGridReport.SetFooterHeight(Const Value : Integer);
  505. begin
  506.   if(Value < DEFAULTHEIGHT) then
  507.     begin
  508.       messagedlg('Minimum FooterHeight should be larger then ' + 
  509.         inttostr(DEFAULTHEIGHT), mtinformation,[mbOK],0);
  510.       exit;
  511.     end;
  512.   FFooterHeight := Value;
  513. end;
  514.  
  515. {$IFDEF DELPHI2}
  516. procedure TCGridReport.Preset;
  517. {$ELSE}
  518. procedure TCGridReport.Print;
  519. {$ENDIF}
  520. var
  521.    x,y,x1: integer;
  522.    idx,idy,idw,idz : Longint;
  523.    data : string;
  524.    rowcnt , colcnt : Longint;
  525.    colarray : TDoubles;
  526.    rowarray : TDoubles;
  527.    tablew : integer;
  528.    tableh : integer;
  529.    tablex : integer;
  530.    tabley : integer;
  531.    workf: double;
  532.    worki,workj : integer;
  533.    startrow,endrow,startcol,endcol : integer;
  534.    firstpage : Boolean;
  535.    headerx, headery : integer;
  536.    footerx, footery : integer;
  537.    pwidth, pheight : integer;
  538.    ccols,crows : integer;
  539.    tlen : integer;
  540.    LeftMH, RightMH : integer;
  541.    LeftMF, RightMF : integer;
  542.    drect : TRect;
  543. begin
  544.   if (FDBCrossGrid = nil) then
  545.     begin
  546.       messagedlg('DBCrossGrid property is empty',mtinformation,[mbOK],0);
  547.       exit;
  548.     end;
  549. {$IFDEF DELPHI2}
  550.   Fpratiox := 1;
  551.   Fpratioy := 1;
  552. {$ELSE}
  553.   Fpratiox := GetDeviceCaps(Printer.Handle,LOGPIXELSX) / Screen.pixelsperinch;
  554.   Fpratioy := GetDeviceCaps(Printer.Handle,LOGPIXELSY) / Screen.pixelsperinch;
  555. {$ENDIF}
  556.   firstpage := True;
  557.   colarray := TDoubles.Create;
  558.   rowarray := TDoubles.Create;
  559.   x := 0;
  560.   y := 0;
  561. {$IFDEF DELPHI2}
  562.   QRPrinter.Cleanup;
  563.   QRPrinter.BeginDoc;
  564.   pwidth := QRPrinter.PageWidth;
  565.   pheight := QRPrinter.PageHeight;
  566. {$ELSE}
  567.   Printer.BeginDoc;
  568.   pwidth := Trunc(Printer.PageWidth /Fpratiox);
  569.   pheight := Trunc(Printer.PageHeight / Fpratioy);
  570. {$ENDIF}
  571.   rowcnt := FDBCrossGrid.GetRowCount;
  572.   colcnt := FDBCrossGrid.GetColCount;
  573.   ccols := FDBCrossGrid.GetNumCrossCols;
  574.   crows := FDBCrossGrid.GetNumCrossRows;
  575. {
  576. // calculate table width and tableheigth
  577. }
  578.   tablex := LeftMargin;
  579.   tabley := TopMargin + HeaderHeight;
  580.   tablew := pwidth - tablex - RightMargin;
  581.   tableh := pheight - tabley - FooterHeight - BottomMargin;
  582. {
  583. // calculate headerx and headery
  584. }
  585. {$IFDEF DELPHI2}
  586.   QRPrinter.canvas.Font := HeaderFont;
  587.   worki := Trunc(QRPrinter.Canvas.TextWidth(HeaderText) / Fpratiox);
  588.   workj := Trunc(QRPrinter.Canvas.TextHeight(HeaderText) / Fpratioy);
  589. {$ELSE}
  590.   Printer.canvas.Font := HeaderFont;
  591.   worki := Trunc(Printer.Canvas.TextWidth(HeaderText) / Fpratiox);
  592.   workj := Trunc(Printer.Canvas.TextHeight(HeaderText) / Fpratioy);
  593. {$ENDIF}
  594.   if(workj > FHeaderHeight) then
  595.     headery := TopMargin
  596.   else
  597.     headery := TopMargin + Trunc((FHeaderHeight - workj) / 2);
  598.   if FHeaderLogoPos = lpBeforeText then
  599.     begin
  600.       LeftMH := LeftMargin + FHeaderLogoWidth;
  601.       RightMH := RightMargin;
  602.     end
  603.   else
  604.     begin
  605.       LeftMH := LeftMargin;
  606.       RightMH := RightMargin + FHeaderLogoWidth;
  607.     end;
  608.   case HeaderAlign of
  609.     taLeftJustify:
  610.       headerx := LeftMH;
  611.     taRightJustify:
  612.       headerx := tablew - RightMH - worki;
  613.     taCenter:
  614.       headerx := LeftMH + Trunc((tablew - LeftMH - RightMH)/2) - Trunc(worki/2);
  615.   end;
  616.   if(headerx < LeftMH) then
  617.     headerx := LeftMH;
  618. {
  619. // calculate footerx and footery
  620. }
  621. {$IFDEF DELPHI2}
  622.   QRPrinter.canvas.Font := FFooterFont;
  623.   worki := Trunc(QRPrinter.Canvas.TextWidth(FFooterText) / Fpratiox);
  624.   workj := Trunc(QRPrinter.Canvas.TextHeight(FFooterText) / Fpratioy);
  625. {$ELSE}
  626.   Printer.canvas.Font := FFooterFont;
  627.   worki := Trunc(Printer.Canvas.TextWidth(FFooterText) / Fpratiox);
  628.   workj := Trunc(Printer.Canvas.TextHeight(FFooterText) / Fpratioy);
  629. {$ENDIF}
  630.   if(workj > FFooterHeight) then
  631.     footery := pheight - BottomMargin - FFooterHeight
  632.   else
  633.     footery := pheight - BottomMargin - FFooterHeight + 
  634.         Trunc((FFooterHeight - workj) / 2);
  635.   if FFooterLogoPos = lpBeforeText then
  636.     begin
  637.       LeftMF := LeftMargin + FFooterLogoWidth;
  638.       RightMF := RightMargin;
  639.     end
  640.   else
  641.     begin
  642.       LeftMF := LeftMargin;
  643.       RightMF := RightMargin + FFooterLogoWidth + PAGEBUFSZ;
  644.     end;
  645.   case FooterAlign of
  646.     taLeftJustify:
  647.       footerx := LeftMF;
  648.     taRightJustify:
  649.       footerx := tablew - RightMF - 4 - worki;
  650.     taCenter:
  651.       footerx := LeftMF + Trunc((tablew - PAGEBUFSZ - FFooterLogoWidth - LeftMF)/2) 
  652.           - Trunc(worki/2);
  653.   end;
  654.   if(footerx < LeftMF) then
  655.     footerx := LeftMF;
  656. {
  657. // calculte the colarray and rowarray
  658. }
  659.   worki := 0;
  660.   for idx := 0 to colcnt - 1 do
  661.     begin
  662.       worki := worki + FDBCrossGrid.ColWidths[idx];
  663.       if(worki > tablew) then
  664.         begin
  665.           workf := idx - 1;
  666.           colarray.add(workf);
  667.           worki := FDBCrossGrid.ColWidths[idx];
  668.         end;
  669.     end;
  670.   workf := colcnt - 1;
  671.   colarray.add(workf);
  672.   worki := 0;
  673.   for idy := 0 to rowcnt - 1 do
  674.     begin
  675.       worki := worki + FDBCrossGrid.RowHeights[idy];
  676.       if(worki > tableh) then
  677.         begin
  678.           workf := idy - 1;
  679.           rowarray.add(workf);
  680.           worki := FDBCrossGrid.RowHeights[idy];
  681.         end;
  682.     end;
  683.   workf := rowcnt - 1;
  684.   rowarray.add(workf);
  685.   for idw := 0 to rowarray.count - 1 do
  686.     begin
  687.       if idw = 0 then
  688.         startrow := 0
  689.       else
  690.         startrow := trunc(rowarray.Get(idw-1) + 1) ;
  691.       endrow := trunc(rowarray.Get(idw));
  692. {
  693. ** start print all pages
  694. }
  695.       for idz := 0 to colarray.count - 1 do
  696.         begin
  697.           if(idz = 0) then
  698.             startcol := 0
  699.           else
  700.             startcol := trunc(colarray.Get(idz-1) + 1);
  701.           endcol := trunc(colarray.Get(idz));
  702.           y := tabley;
  703.       if(not firstpage) then
  704. {$IFDEF DELPHI2}
  705.             QRPrinter.NewPage
  706. {$ELSE}
  707.             Printer.NewPage
  708. {$ENDIF}
  709.       else
  710.         firstpage := False;
  711. {
  712. ** print the line
  713. }
  714.           DrawOutline(tablex,tabley,tablew,tableh,
  715.           startrow,endrow,startcol,endcol);
  716. {
  717. ** printer the header and footer
  718. }
  719. {
  720.         QRPrinter.Canvas.Pen.Color := HeaderColor;
  721. }
  722. {$IFDEF DELPHI2}
  723.         QRPrinter.Canvas.Font := HeaderFont;
  724.           QRPrinter.Canvas.TextOut(
  725.           Trunc(headerx * Fpratiox),
  726.         Trunc(headery * Fpratioy),
  727.           HeaderText);
  728. {$ELSE}
  729.         Printer.Canvas.Font := HeaderFont;
  730.           Printer.Canvas.TextOut(
  731.           Trunc(headerx * Fpratiox),
  732.         Trunc(headery * Fpratioy),
  733.           HeaderText);
  734. {$ENDIF}
  735. { ** print Header Logo ** }
  736.           if(FHeaderLogo <> nil) then
  737.         begin
  738.           drect.Top := TopMargin;
  739.           drect.Bottom := TopMargin + FHeaderHeight;
  740.           if FHeaderLogoPos = lpBeforeText then
  741.             begin
  742.               drect.Left := LeftMargin;
  743.               drect.Right := LeftMargin + FHeaderLogoWidth;
  744.         end
  745.           else
  746.             begin
  747.                   drect.Right := pwidth - RightMargin;
  748.               drect.Left := drect.Right - FHeaderLogoWidth;
  749.         end;
  750.                drect.Top := Trunc(drect.Top * Fpratioy);
  751.                drect.Bottom := Trunc(drect.Bottom * Fpratioy);
  752.                drect.Left := Trunc(drect.Left * Fpratiox);
  753.                drect.Right := Trunc(drect.Right * Fpratiox);
  754. {$IFDEF DELPHI2}
  755.           DrawPicture(QRPrinter.Canvas,FHeaderLogo,drect);
  756. {$ELSE}
  757.           DrawPicture(Printer.Canvas,FHeaderLogo,drect);
  758. {$ENDIF}
  759.         end;
  760. {
  761.         QRPrinter.Canvas.Pen.Color := FooterColor;
  762. }
  763. {$IFDEF DELPHI2}
  764.         QRPrinter.Canvas.Font := FooterFont;
  765.           QRPrinter.Canvas.TextOut(
  766.           Trunc(footerx * Fpratiox),
  767.         Trunc(footery * Fpratioy),
  768.           FooterText);
  769.           QRPrinter.Canvas.TextOut(
  770.           Trunc((pwidth - RightMargin - PAGEBUFSZ) *  Fpratiox),
  771.         Trunc(footery * Fpratioy),
  772.         'Page:' + inttostr(idw+1) + '-' + inttostr(idz+1) );
  773. {$ELSE}
  774.         Printer.Canvas.Font := FooterFont;
  775.           Printer.Canvas.TextOut(
  776.           Trunc(footerx * Fpratiox),
  777.         Trunc(footery * Fpratioy),
  778.           FooterText);
  779.           Printer.Canvas.TextOut(
  780.           Trunc((pwidth - RightMargin - PAGEBUFSZ) *  Fpratiox),
  781.         Trunc(footery * Fpratioy),
  782.         'Page:' + inttostr(idw+1) + '-' + inttostr(idz+1) );
  783. {$ENDIF}
  784. { ** print Footer Logo ** }
  785.           if(FFooterLogo <> nil) then
  786.         begin
  787.               drect.Top := pheight - BottomMargin - FFooterHeight;
  788.           drect.Bottom := drect.Top + FFooterHeight;
  789.           if FFooterLogoPos = lpBeforeText then
  790.             begin
  791.               drect.Left := LeftMargin;
  792.               drect.Right := LeftMargin + FFooterLogoWidth;
  793.         end
  794.           else
  795.             begin
  796.               drect.Left := pwidth - RightMF;
  797.                   drect.Right := drect.left + FFooterLogoWidth;
  798.         end;
  799.                drect.Top := Trunc(drect.Top * Fpratioy);
  800.                drect.Bottom := Trunc(drect.Bottom * Fpratioy);
  801.                drect.Left := Trunc(drect.Left * Fpratiox);
  802.                drect.Right := Trunc(drect.Right * Fpratiox);
  803. {$IFDEF DELPHI2}
  804.           DrawPicture(QRPrinter.Canvas,FFooterLogo,drect);
  805. {$ELSE}
  806.           DrawPicture(Printer.Canvas,FFooterLogo,drect);
  807. {$ENDIF}
  808.         end;
  809. {
  810. ** print the cell data
  811. }
  812. {$IFDEF DELPHI2}
  813.       QRPrinter.Canvas.Font := FDBCrossGrid.Font;
  814. {$ELSE}
  815.       Printer.Canvas.Font := FDBCrossGrid.Font;
  816. {$ENDIF}
  817. {
  818.       QRPrinter.Canvas.Pen.Color := FDBCrossGrid.Color;
  819. }
  820.           for idx := startrow to endrow do
  821.             begin
  822.               x := tablex;
  823.               for idy := startcol to endcol do
  824.                 begin
  825.           if(Assigned(FOnPrintXCell)) then
  826.             FOnPrintXCell(Self,idy,idx,data)
  827.           else
  828.                     data := FDBCrossGrid.GetVXCell(idy,idx);
  829. {$IFDEF DELPHI2}
  830.           tlen := Trunc((QRPrinter.Canvas.TextWidth(data) + 2 * XCELLMARGIN)/ Fpratiox);
  831. {$ELSE}
  832.           tlen := Trunc((Printer.Canvas.TextWidth(data) + 2 * XCELLMARGIN)/ Fpratiox);
  833. {$ENDIF}
  834.                   if(((idx < crows) or (idy < ccols)) and
  835.              ((idx >= crows) or (idy >= ccols))) then
  836.             begin { alien center }
  837.               x1 := x + trunc(FDBCrossGrid.ColWidths[idy] / 2) - 
  838.                         trunc(tlen / 2) + XCELLMARGIN;
  839.             end
  840.           else
  841.             begin { alieng right }
  842.               x1 := x + (FDBCrossGrid.ColWidths[idy] - tlen);
  843.             end ;
  844.           if(x1 < x) then
  845.             x1 := x;
  846. {$IFDEF DELPHI2}
  847.                   QRPrinter.Canvas.TextOut(
  848.               Trunc(x1 * Fpratiox),
  849.             Trunc((y + YCELLMARGIN) * Fpratioy),
  850.             data);
  851. {$ELSE}
  852.                   Printer.Canvas.TextOut(
  853.               Trunc(x1 * Fpratiox),
  854.             Trunc((y  + YCELLMARGIN)* Fpratioy),
  855.             data);
  856. {$ENDIF}
  857.                   x := x + FDBCrossGrid.ColWidths[idy];
  858.                 end;
  859.               y := y + FDBCrossGrid.RowHeights[idx];
  860.             end;
  861.         end;
  862.     end;
  863. {$IFDEF DELPHI2}
  864.   QRPrinter.Enddoc;
  865. {$ELSE}
  866.   Printer.Enddoc;
  867. {$ENDIF}
  868.   colarray.free;
  869.   rowarray.free;
  870. end;
  871.  
  872. {$IFDEF DELPHI2}
  873. procedure TCGridReport.Print;
  874. begin
  875.   QRPrinter.Print;
  876. end;
  877.  
  878. procedure TCGridReport.Preview;
  879. begin
  880.   QRPrinter.Preview;
  881. end;
  882. {$ENDIF}
  883.  
  884. procedure TCGridReport.CreateHTML(filename : String);
  885. var
  886.   ff : TextFile ;
  887.   nccol, ncrow : integer;
  888.   ss,sval : string;
  889.   ii,jj,kk : integer;
  890.   ident : integer;
  891.   rowcnt,colcnt : Longint;
  892.   cnt,cnt1 : Integer;
  893.   arrayp,arrayi,arrayj : PLongint;
  894.   skip : Boolean;
  895. begin
  896.   if (FDBCrossGrid = nil) then
  897.     begin
  898.       messagedlg('DBCrossGrid property is empty',mtinformation,[mbOK],0);
  899.       exit;
  900.     end;
  901.   rowcnt := FDBCrossGrid.GetRowCount;
  902.   colcnt := FDBCrossGrid.GetColCount;
  903.   With FDBCrossGrid do
  904.     begin
  905.       ncrow := FixedRows;
  906.       nccol := GetNumCrossCols;
  907.     end;
  908.   AssignFile(ff,filename);
  909.   Rewrite(ff);
  910.   writeln(ff,'<html>');
  911.   writeln(ff,'<body>');
  912.   writeln(ff,'<table border=1>');
  913.   ss := '<caption><h1 align=center>' + HeaderText + '</h1></caption>';
  914.   writeln(ff,ss);
  915. {
  916. ** output the fixed rows
  917. }
  918.   arrayp := AllocMem(colcnt*(sizeof(Longint)));
  919.   if(arrayp = nil) then
  920.     begin
  921.       messagedlg('Not enough memory for draw fixed rows',mtError,[mbAbort],0);
  922.       exit;
  923.     end;
  924.   for ii := 0 to ncrow - 1 do
  925.     begin
  926.       writeln(ff,'<tr>');
  927.       FDBCrossGrid.GetFixedRowDataes(ii,Pointer(arrayp),cnt);
  928.       arrayi := arrayp;
  929.       jj := 0;
  930.       cnt1 := 0;
  931.       while (jj < colcnt) do
  932.         begin
  933.              if(Assigned(FOnPrintXCell)) then
  934.         FOnPrintXCell(Self,jj,ii,ss)
  935.       else
  936.             sval := FDBCrossGrid.GetXCell(jj,ii);
  937.       if((jj < nccol) or (cnt1 >= cnt)) then
  938.             begin
  939.           ss := '<th>';
  940.               jj := jj + 1;
  941.             end
  942.       else
  943.         begin
  944.           ident := arrayi^ - jj + 1;
  945.           Inc(arrayi);
  946.               Inc(cnt1);
  947.               jj := jj + ident;
  948.           ss := '<th colspan=' + inttostr(ident) + '>';
  949.         end;
  950.       writeln(ff,ss);
  951.       writeln(ff,sval);
  952.       writeln(ff,'</th>');
  953.     end;
  954.       writeln(ff,'</tr>');
  955.     end;
  956.   FreeMem(arrayp,colcnt*(sizeof(Longint)));
  957.   arrayp := nil;
  958. {
  959. ** output the fixed cols and cell data
  960. }
  961.   arrayp := AllocMem(rowcnt*(sizeof(Longint)));
  962.   if(arrayp = nil) then
  963.     begin
  964.       messagedlg('Not enough memory for draw fixed cols',mtError,[mbAbort],0);
  965.       exit;
  966.     end;
  967.   for jj := ncrow to rowcnt - 1 do
  968.     begin
  969.       writeln(ff,'<tr>');
  970.       for ii := 0 to colcnt - 1 do
  971.         begin
  972.       sval := GetCell(ii,jj);
  973.           if(ii < nccol) then
  974.         begin
  975.           FDBCrossGrid.GetFixedColDataes(ii,Pointer(arrayp),cnt,2);
  976.           arrayi := arrayp;
  977.           {
  978.           ** for Fixed Columns, default Skip
  979.           }
  980.           skip := True;
  981.           ident := 1;
  982.           for kk := 0 to cnt - 1 do
  983.             begin
  984.           if(arrayi^ >= jj) then
  985.             begin
  986.               if(arrayi^ = jj) then
  987.                 begin
  988.               if kk = (cnt - 1) then
  989.                 ident := rowcnt - jj
  990.               else
  991.                             begin
  992.                               arrayj := arrayi;
  993.                               Inc(arrayj);
  994.                   ident := arrayj^ - arrayi^;
  995.                             end;
  996.               skip := False;
  997.             end
  998.               else
  999.             skip := True;
  1000.               break;
  1001.             end;
  1002.                   Inc(arrayi);
  1003.         end;
  1004.  
  1005.           if(skip) then
  1006.             continue;
  1007.               ss := '<th rowspan=' + inttostr(ident) + '>';
  1008.         end
  1009.       else
  1010.         begin
  1011.               ss := '<td>';
  1012.         end;
  1013.       writeln(ff,ss);
  1014.       writeln(ff,sval);
  1015.           if(ii < nccol) then
  1016.             writeln(ff,'</th>')
  1017.       else
  1018.             writeln(ff,'</td>');
  1019.         end;
  1020.       writeln(ff,'</tr>');
  1021.     end;
  1022.   FreeMem(arrayp,rowcnt*(sizeof(Longint)));
  1023.   arrayp := nil;
  1024.   writeln(ff,'</table>');
  1025.   writeln(ff,'</body>');
  1026.   writeln(ff,'</html>');
  1027.   Closefile(ff);
  1028. end;
  1029.  
  1030. procedure TCGridReport.CreateASCII(filename : String; sep : String);
  1031. var
  1032.   ff : TextFile ;
  1033.   irow, icol : Longint;
  1034.   arow, acol : Longint;
  1035.   srow, scol : Longint;
  1036.   ii, jj : Longint;
  1037.   ncrow : Longint;
  1038.   rowcnt, colcnt : Longint;
  1039.   ss : string;
  1040. begin
  1041.   if (FDBCrossGrid = nil) then
  1042.     begin
  1043.       messagedlg('DBCrossGrid property is empty',mtinformation,[mbOK],0);
  1044.       exit;
  1045.     end;
  1046.   With FDBCrossGrid do
  1047.     begin
  1048.       srow := FixedRows;
  1049.       ncrow := GetNumCrossRows;
  1050.       scol := GetNumCrossCols;
  1051.       rowcnt := GetRowCount;
  1052.       colcnt := GetColCount;
  1053.     end;
  1054.   AssignFile(ff,filename);
  1055.   Rewrite(ff);
  1056.   for irow := srow to rowcnt - 1 do
  1057.     for icol := scol to colcnt - 1 do
  1058.       begin
  1059.         ss := '';
  1060.     for ii := 0 to scol - 1 do
  1061.       ss := ss + GetCell(ii,irow) + sep;
  1062.     for ii := 0 to ncrow - 1 do
  1063.       ss := ss + GetCell(icol,ii) + sep;
  1064.         ss := ss + GetCell(icol,irow);
  1065.         writeln(ff,ss);
  1066.       end;
  1067.   Closefile(ff);
  1068. end;
  1069.  
  1070. end.
  1071.