git-svn-id: https://svn.code.sf.net/p/kolmck/code@8 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
314
Addons/MCKReport.pas
Normal file
314
Addons/MCKReport.pas
Normal file
@ -0,0 +1,314 @@
|
||||
unit MCKReport;
|
||||
|
||||
interface
|
||||
|
||||
uses KOL, Windows, Messages, Dialogs, Forms, Classes, Controls, Graphics, SysUtils,
|
||||
mirror, mckCtrls, KOLReport;
|
||||
|
||||
type
|
||||
TKOLReport = class( TKOLObj )
|
||||
private
|
||||
FOnNewBand: TOnEvent;
|
||||
FOnPrint: TOnEvent;
|
||||
FOnNewPage: TOnEvent;
|
||||
FDoubleBufferedPreview: Boolean;
|
||||
FDocumentName: String;
|
||||
procedure SetOnNewBand(const Value: TOnEvent);
|
||||
procedure SetOnNewPage(const Value: TOnEvent);
|
||||
procedure SetOnPrint(const Value: TOnEvent);
|
||||
procedure SetDoubleBufferedPreview(const Value: Boolean);
|
||||
procedure SetDocumentName(const Value: String);
|
||||
protected
|
||||
function AdditionalUnits: String; override;
|
||||
procedure AssignEvents( SL: TStringList; const AName: String ); override;
|
||||
procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
|
||||
published
|
||||
property OnPrint: TOnEvent read FOnPrint write SetOnPrint;
|
||||
property OnNewPage: TOnEvent read FOnNewPage write SetOnNewPage;
|
||||
property OnNewBand: TOnEvent read FOnNewBand write SetOnNewBand;
|
||||
property DoubleBufferedPreview: Boolean read FDoubleBufferedPreview write SetDoubleBufferedPreview;
|
||||
property DocumentName: String read FDocumentName write SetDocumentName;
|
||||
end;
|
||||
|
||||
TKOLBand = class( TKOLPanel )
|
||||
private
|
||||
FFrames: TFrames;
|
||||
procedure SetFrames(const Value: TFrames);
|
||||
protected
|
||||
function SetupParams( const AName, AParent: String ): String; override;
|
||||
function AdditionalUnits: String; override;
|
||||
function NoDrawFrame: Boolean; override;
|
||||
procedure Set_VA(const Value: TVerticalAlign); override;
|
||||
public
|
||||
constructor Create( AOwner: TComponent ); override;
|
||||
procedure Paint; override;
|
||||
published
|
||||
property Frames: TFrames read FFrames write SetFrames;
|
||||
end;
|
||||
|
||||
TKOLReportLabel = class( TKOLLabel )
|
||||
private
|
||||
FFrames: TFrames;
|
||||
procedure SetFrames(const Value: TFrames);
|
||||
protected
|
||||
function SetupParams( const AName, AParent: String ): String; override;
|
||||
function AdditionalUnits: String; override;
|
||||
function TypeName: String; override;
|
||||
function NoDrawFrame: Boolean; override;
|
||||
function AdjustVerticalAlign( Value: TVerticalAlign ): TVerticalAlign; override;
|
||||
public
|
||||
constructor Create( AOwner: TComponent ); override;
|
||||
procedure Paint; override;
|
||||
function BorderNeeded: Boolean; override;
|
||||
published
|
||||
property Frames: TFrames read FFrames write SetFrames;
|
||||
property Border;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
{$R KOLReport.dcr}
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents( 'KOLAddons', [ TKOLReport, TKOLBand, TKOLReportLabel ] );
|
||||
end;
|
||||
|
||||
function CalcFrames( const Frames: TFrames ): String;
|
||||
begin
|
||||
Result := '';
|
||||
if frLeft in Frames then
|
||||
Result := 'frLeft,';
|
||||
if frTop in Frames then
|
||||
Result := Result + 'frTop,';
|
||||
if frRight in Frames then
|
||||
Result := Result + 'frRight,';
|
||||
if frBottom in Frames then
|
||||
Result := Result + 'frBottom,';
|
||||
if Result <> '' then
|
||||
Delete( Result, Length( Result ), 1 );
|
||||
Result := '[' + Result + ']';
|
||||
end;
|
||||
|
||||
type
|
||||
TFakeControl = class( TControl )
|
||||
public
|
||||
property Color;
|
||||
end;
|
||||
|
||||
{ TKOLReport }
|
||||
|
||||
function TKOLReport.AdditionalUnits: String;
|
||||
begin
|
||||
Result := inherited AdditionalUnits + ', KOLReport';
|
||||
end;
|
||||
|
||||
procedure TKOLReport.AssignEvents(SL: TStringList; const AName: String);
|
||||
begin
|
||||
inherited;
|
||||
DoAssignEvents( SL, AName, [ 'OnPrint', 'OnNewPage', 'OnNewBand' ],
|
||||
[ @ OnPrint, @ OnNewPage, @ OnNewBand ] );
|
||||
end;
|
||||
|
||||
procedure TKOLReport.SetDocumentName(const Value: String);
|
||||
begin
|
||||
FDocumentName := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLReport.SetDoubleBufferedPreview(const Value: Boolean);
|
||||
begin
|
||||
FDoubleBufferedPreview := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLReport.SetOnNewBand(const Value: TOnEvent);
|
||||
begin
|
||||
FOnNewBand := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLReport.SetOnNewPage(const Value: TOnEvent);
|
||||
begin
|
||||
FOnNewPage := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLReport.SetOnPrint(const Value: TOnEvent);
|
||||
begin
|
||||
FOnPrint := Value;
|
||||
Change;
|
||||
end;
|
||||
|
||||
procedure TKOLReport.SetupFirst(SL: TStringList; const AName, AParent,
|
||||
Prefix: String);
|
||||
begin
|
||||
inherited;
|
||||
if DoubleBufferedPreview then
|
||||
SL.Add( Prefix + AName + '.DoubleBufferedPreview := TRUE;' );
|
||||
if Trim( DocumentName ) <> '' then
|
||||
SL.Add( Prefix + AName + '.DocumentName := ' + String2PascalStrExpr( DocumentName ) + ';' );
|
||||
end;
|
||||
|
||||
{ TKOLBand }
|
||||
|
||||
function TKOLBand.AdditionalUnits: String;
|
||||
begin
|
||||
Result := inherited AdditionalUnits + ', KOLReport';
|
||||
end;
|
||||
|
||||
constructor TKOLBand.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
EdgeStyle := esNone;
|
||||
if (AOwner <> nil) and (AOwner is TControl) and
|
||||
(TFakeControl(AOwner).Color = clWhite) then
|
||||
else
|
||||
begin
|
||||
ParentColor := FALSE;
|
||||
Color := clWhite;
|
||||
end;
|
||||
if (AOwner <> nil) and (AOwner is TControl) and
|
||||
(TFakeControl(AOwner).Font.Color = clBlack) and
|
||||
(TFakeControl(AOwner).Font.Name = 'Arial') then
|
||||
else
|
||||
begin
|
||||
ParentFont := FALSE;
|
||||
Font.Color := clBlack;
|
||||
Font.FontName := 'Arial';
|
||||
end;
|
||||
Width := 400;
|
||||
Height := 40;
|
||||
Border := 1;
|
||||
end;
|
||||
|
||||
function TKOLBand.NoDrawFrame: Boolean;
|
||||
begin
|
||||
Result := TRUE;
|
||||
end;
|
||||
|
||||
procedure TKOLBand.Paint;
|
||||
var W, H, B: Integer;
|
||||
begin
|
||||
inherited;
|
||||
Canvas.Brush.Color := Font.Color;
|
||||
W := ClientWidth;
|
||||
H := ClientHeight;
|
||||
B := Border;
|
||||
if frLeft in Frames then
|
||||
Canvas.FillRect( Rect( 0, 0, B, H ) );
|
||||
if frTop in Frames then
|
||||
Canvas.FillRect( Rect( 0, 0, W, B ) );
|
||||
if frRight in Frames then
|
||||
Canvas.FillRect( Rect( W - B, 0, W, H ) );
|
||||
if frBottom in Frames then
|
||||
Canvas.FillRect( Rect( 0, H - B, W, H ) );
|
||||
end;
|
||||
|
||||
procedure TKOLBand.SetFrames(const Value: TFrames);
|
||||
begin
|
||||
FFrames := Value;
|
||||
Change;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
function TKOLBand.SetupParams(const AName, AParent: String): String;
|
||||
begin
|
||||
Result := AParent + ', ' + CalcFrames( Frames );
|
||||
end;
|
||||
|
||||
procedure TKOLBand.Set_VA(const Value: TVerticalAlign);
|
||||
begin
|
||||
fVerticalAlign := Value;
|
||||
Change;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
{ TKOLReportLabel }
|
||||
|
||||
function TKOLReportLabel.AdditionalUnits: String;
|
||||
begin
|
||||
Result := inherited AdditionalUnits + ', KOLReport';
|
||||
end;
|
||||
|
||||
function TKOLReportLabel.AdjustVerticalAlign(
|
||||
Value: TVerticalAlign): TVerticalAlign;
|
||||
begin
|
||||
Result := Value;
|
||||
end;
|
||||
|
||||
function TKOLReportLabel.BorderNeeded: Boolean;
|
||||
begin
|
||||
Result := TRUE;
|
||||
end;
|
||||
|
||||
constructor TKOLReportLabel.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
if (AOwner <> nil) and (AOwner is TControl) and
|
||||
(TFakeControl(AOwner).Color = clWhite) then
|
||||
else
|
||||
begin
|
||||
ParentColor := FALSE;
|
||||
Color := clWhite;
|
||||
end;
|
||||
if (AOwner <> nil) and (AOwner is TControl) and
|
||||
(TFakeControl(AOwner).Font.Color = clBlack) and
|
||||
(TFakeControl(AOwner).Font.Name = 'Arial') then
|
||||
else
|
||||
begin
|
||||
ParentFont := FALSE;
|
||||
Font.Color := clBlack;
|
||||
Font.FontName := 'Arial';
|
||||
end;
|
||||
Border := 1;
|
||||
DefaultAutoSize := TRUE;
|
||||
AutoSize := TRUE;
|
||||
end;
|
||||
|
||||
function TKOLReportLabel.NoDrawFrame: Boolean;
|
||||
begin
|
||||
Result := TRUE;
|
||||
end;
|
||||
|
||||
procedure TKOLReportLabel.Paint;
|
||||
var W, H, B: Integer;
|
||||
begin
|
||||
inherited;
|
||||
Canvas.Brush.Color := Font.Color;
|
||||
W := ClientWidth;
|
||||
H := ClientHeight;
|
||||
B := Border;
|
||||
if frLeft in Frames then
|
||||
Canvas.FillRect( Rect( 0, 0, B, H ) );
|
||||
if frTop in Frames then
|
||||
Canvas.FillRect( Rect( 0, 0, W, B ) );
|
||||
if frRight in Frames then
|
||||
Canvas.FillRect( Rect( W - B, 0, W, H ) );
|
||||
if frBottom in Frames then
|
||||
Canvas.FillRect( Rect( 0, H - B, W, H ) );
|
||||
end;
|
||||
|
||||
procedure TKOLReportLabel.SetFrames(const Value: TFrames);
|
||||
begin
|
||||
FFrames := Value;
|
||||
Change;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
function TKOLReportLabel.SetupParams(const AName, AParent: String): String;
|
||||
begin
|
||||
Result := inherited SetupParams( AName, AParent ) + ', ' + CalcFrames( Frames );
|
||||
end;
|
||||
|
||||
function TKOLReportLabel.TypeName: String;
|
||||
begin
|
||||
if WordWrap then
|
||||
Result := 'WordWrapReportLabel'
|
||||
else
|
||||
Result := 'ReportLabel';
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user