home *** CD-ROM | disk | FTP | other *** search
- (*////////////////////////////////////////////////////////////////////////////
- // Part of AlexSoft VCL/DLL Library. //
- // All rights reserved. (c) Copyright 1998. //
- // Created by: Alex Rabichooc //
- //**************************************************************************//
- // Users of this unit must accept this disclaimer of warranty: //
- // "This unit is supplied as is. The author disclaims all warranties, //
- // expressed or implied, including, without limitation, the warranties //
- // of merchantability and of fitness for any purpose. //
- // The author assumes no liability for damages, direct or //
- // consequential, which may result from the use of this unit." //
- // //
- // This Unit is donated to the public as public domain. //
- // //
- // This Unit can be freely used and distributed in commercial and //
- // private environments provided this notice is not modified in any way. //
- // //
- // If you do find this Unit handy and you feel guilty for using such a //
- // great product without paying someone - sorry :-) //
- // //
- // Please forward any comments or suggestions to Alex Rabichooc at: //
- // //
- // a_rabichooc@yahoo.com or alex@carmez.mldnet.com //
- /////////////////////////////////////////////////////////////////////////////*)
-
- unit dbPrint;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- RaReport, Qrctrls, QuickRpt, ExtCtrls, db, QRaCtrls;
-
- type
- TfmDBPrint = class(TfmRaReport)
- QRSubDetail: TQRaSubDetail;
- QRLbSubData: TQRaLabel;
- QRaHLine1: TQRaHLine;
- QRLbHeader: TQRaLabel;
- QRaHLine2: TQRaHLine;
- QRlbData: TQRaLabel;
- procedure QRLbDataPrint(Sender: TObject; var Value: String);
- procedure FormDestroy(Sender: TObject);
- private
- FBookmark: TBookmark;
- protected
- procedure SetFontSize; dynamic;
- public
- procedure DoPreview;
- constructor Create(AOwner: TComponent); override;
- constructor CreateWithDataSet(AOwner: TComponent; DataSet: TDataSet);
- end;
-
- implementation
- {$R *.DFM}
-
- uses StdUtils, dbForms;
-
- constructor TfmDBPrint.CreateWithDataSet(AOwner: TComponent; DataSet: TDataSet);
- begin
- Inherited Create(AOwner);
- Report.DataSet := DataSet;
- DoPreview;
- end;
-
- procedure TfmDBPrint.SetFontSize;
- var i, L: Integer;
- HText: String;
- begin
- if Report.DataSet <> nil then
- with Report.DataSet do
- begin
- HText := ': ';
- for i := 0 to FieldCount-1 do
- begin
- if Fields[i].Visible then
- begin
- L := Fields[i].DisplayWidth;
- if L < Length(Fields[i].DisplayLabel) then
- L := Length(Fields[i].DisplayLabel);
- HText:= HText+Format('%-*.*s : ', [L, L, Fields[i].DisplayLabel]);
- end;
- end;
- HText := Copy(HText, 1, Length(HText)-1);
- QRLbHeader.Caption := HText;
- QRLbHeader.WidthInChars := Length(HText);
- QRLbData.WidthInChars := Length(HText);
- QRaHLine1.WidthInChars := Length(HText);
- QRaHLine2.WidthInChars := Length(HText);
- end;
- end;
-
- procedure TfmDBPrint.QRLbDataPrint(sender: TObject; var Value: String);
- var i, L: Integer;
- FormatStr: String;
- begin
- if Report.DataSet = nil then exit;
- Value := ': ';
- with Report.DataSet do
- begin
- for i := 0 to FieldCount-1 do
- begin
- if Fields[i].Visible then
- begin
- L := Fields[i].DisplayWidth;
- if L < Length(Fields[i].DisplayLabel) then
- L := Length(Fields[i].DisplayLabel);
- if Fields[i].Alignment = taLeftJustify then
- FormatStr := '%-*.*s : '
- else
- FormatStr := '%*.*s : ';
- Value := Value+Format(FormatStr, [L, L, Fields[i].Text]);
- end;
- end;
- end;
- Value := Copy(Value, 1, Length(Value)-1);
- end;
-
- procedure TfmDBPrint.DoPreview;
- begin
- if Report.DataSet = nil then
- exit;
- FBookmark := Report.DataSet.GetBookmark;
- SetFontSize;
- Report.Preview;
- end;
-
- constructor TfmDBPrint.Create(AOwner: TComponent);
- begin
- Inherited;
- if (Owner is TDefaultForm) and (Report.DataSet = nil) then
- begin
- Report.DataSet := (Owner as TDefaultForm).DataSource.DataSet;
- Report.DataSet.DisableControls;
- (Owner as TDefaultForm).Enabled := False;
- end;
- DoPreview;
- end;
-
- procedure TfmDBPrint.FormDestroy(Sender: TObject);
- begin
- if Report.DataSet = nil then
- exit;
- if (FBookmark <> nil) and Report.DataSet.BookmarkValid(FBookmark) then
- Report.DataSet.GotoBookmark(FBookmark);
- if (Owner is TDefaultForm) and
- (Report.DataSet = (Owner as TDefaultForm).DataSource.DataSet) then
- begin
- Report.DataSet.EnableControls;
- (Owner as TDefaultForm).Enabled := True;
- end;
- end;
-
- end.
-