home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / AddOns / Components / TEECHART / DELPHI4.EXE / %MAINDIR% / Examples / 3rdParty / QuickReport / QRDemo2 / teeqr2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-11-17  |  3.4 KB  |  125 lines
  1. unit teeqr2;
  2.  
  3. interface
  4.  
  5. uses
  6.   WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   TeEngine, Series, TeeProcs, Chart, DBChart, QrTee, Qrctrls, DB, DBTables,
  8.   quickrpt, StdCtrls, ExtCtrls, CurvFitt;
  9.  
  10. type
  11.   TForm1 = class(TForm)
  12.     QuickRep1: TQuickRep;
  13.     PageHeaderBand1: TQRBand;
  14.     Customer: TTable;
  15.     DataSource1: TDataSource;
  16.     Orders: TTable;
  17.     DataSource2: TDataSource;
  18.     Label2: TLabel;
  19.     DetailBand1: TQRBand;
  20.     QRLabel1: TQRLabel;
  21.     QRDBText1: TQRDBText;
  22.     QRDBText2: TQRDBText;
  23.     QRLabel2: TQRLabel;
  24.     QRDBChart1: TQRDBChart;
  25.     QRChart1: TQRChart;
  26.     Series1: TBarSeries;
  27.     OrdersOrderNo: TFloatField;
  28.     OrdersCustNo: TFloatField;
  29.     OrdersSaleDate: TDateTimeField;
  30.     OrdersShipDate: TDateTimeField;
  31.     OrdersEmpNo: TIntegerField;
  32.     OrdersShipToContact: TStringField;
  33.     OrdersShipToAddr1: TStringField;
  34.     OrdersShipToAddr2: TStringField;
  35.     OrdersShipToCity: TStringField;
  36.     OrdersShipToState: TStringField;
  37.     OrdersShipToZip: TStringField;
  38.     OrdersShipToCountry: TStringField;
  39.     OrdersShipToPhone: TStringField;
  40.     OrdersShipVIA: TStringField;
  41.     OrdersPO: TStringField;
  42.     OrdersTerms: TStringField;
  43.     OrdersPaymentMethod: TStringField;
  44.     OrdersItemsTotal: TCurrencyField;
  45.     OrdersTaxRate: TFloatField;
  46.     OrdersFreight: TCurrencyField;
  47.     OrdersAmountPaid: TCurrencyField;
  48.     CustomerCustNo: TFloatField;
  49.     CustomerCompany: TStringField;
  50.     CustomerAddr1: TStringField;
  51.     CustomerAddr2: TStringField;
  52.     CustomerCity: TStringField;
  53.     CustomerState: TStringField;
  54.     CustomerZip: TStringField;
  55.     CustomerCountry: TStringField;
  56.     CustomerPhone: TStringField;
  57.     CustomerFAX: TStringField;
  58.     CustomerTaxRate: TFloatField;
  59.     CustomerContact: TStringField;
  60.     CustomerLastInvoiceDate: TDateTimeField;
  61.     QRLabel3: TQRLabel;
  62.     QRLabel4: TQRLabel;
  63.     procedure DetailBand1BeforePrint(Sender: TQRCustomBand;
  64.       var PrintBand: Boolean);
  65.   private
  66.     { Private declarations }
  67.   public
  68.     { Public declarations }
  69.   end;
  70.  
  71. var
  72.   Form1: TForm1;
  73.  
  74. implementation
  75.  
  76. {$R *.DFM}
  77. Uses TeCanvas, QRPrev;
  78.  
  79. procedure TForm1.DetailBand1BeforePrint(Sender: TQRCustomBand;
  80.   var PrintBand: Boolean);
  81. begin
  82.   { this demo changes gradient direction and Bar style .... }
  83.   With QRChart1.Chart do
  84.   begin
  85.     if Gradient.Direction = gdLeftRight then
  86.        Gradient.Direction := gdRightLeft
  87.     else
  88.        Gradient.Direction := gdLeftRight;
  89.  
  90.     if Legend.Alignment=laTop then
  91.        Legend.Alignment:=laLeft else
  92.     if Legend.Alignment=laLeft then
  93.        Legend.Alignment:=laBottom else
  94.     if Legend.Alignment=laBottom then
  95.        Legend.Alignment:=laRight else
  96.     if Legend.Alignment=laRight then
  97.        Legend.Alignment:=laTop;
  98.   end;
  99.  
  100.   { change Bar series style }
  101.   if Series1.BarStyle = bsPyramid then
  102.      Series1.BarStyle := bsRectangle
  103.   else
  104.   if Series1.BarStyle = bsInvPyramid then
  105.      Series1.BarStyle := bsPyramid
  106.   else
  107.      Series1.BarStyle := bsInvPyramid;
  108.  
  109.   { change Bar series color }
  110.   if Series1.SeriesColor = clRed then
  111.      Series1.SeriesColor := clBlue
  112.   else
  113.   if Series1.SeriesColor = clBlue then
  114.      Series1.SeriesColor := clGreen
  115.   else
  116.   if Series1.SeriesColor = clGreen then
  117.      Series1.SeriesColor := clYellow
  118.   else
  119.   if Series1.SeriesColor = clYellow then
  120.      Series1.SeriesColor := clRed;
  121.  
  122. end;
  123.  
  124. end.
  125.