repoedit.pas

一个报表控件TRepoEdit

{*********************************************}
{*   RepoEdit -  QuickReport Editor          *}
{*   for Delphi 4                            *}
{*   (R) Copyright                           *}
{*   Borzov Vladimir [e-mail]           *}
{*   v4.7                                    *}
{*********************************************}

unit RepoEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  db, DBTables,
  QuickRPT,QRCTRLS,QRPRNTR,
  extctrls,Buttons,StdCtrls,printers,comctrls,
  VarConfirmUnit,
  PanelUnit,{bvUtils,}menus{,qrExcelF1},PreviewUnit,waitun,REgistry;

const DefaultFileName:string='bvReport.db'; // can redefine in program source

var TaReport:TTable;
    function TaRepNameForm:TField;
    function TaRepNamecomp:tField;
    Function TaRepValue:TMemoField;

procedure ExecuteReport(pMain:TWinControl;pOnNeedData:tnotifyevent=nil{;pPreviewStyle:TFormStyle=fsMDIForm});

const RepoEditPath:string=''; // Directory of taReport

const DefaultVariantName='(default)';
const REPORTPOPUPNAME='POPUPREPORT_BV';

type bvVarExistsException=Exception;


var
    IniFile:TReginiFile;

type
  TDopParam = class(TComponent)
  public
     ParamName:string;
     Value:string;
     constructor Create(AOwner:TComponent); override;
  end;

type TRectLab=(rlTopLeft,rlTop,rlTopRight,
               rlRight,
               rlBottomRight,rlBottom,rlBottomLeft,
               rlLeft);

type
  TRectLabel=class(TCustomControl)
  private
//    OldX,OldY:integer;
  protected
    procedure Paint; override;
  public
    ID:tRectLab;
  end;

  tEnabledLab=class(TCustomControl)
  protected
    procedure paint;override;
  public
    constructor create(AOwner:tComponent); override;
    procedure dblclickhandle(Sender:TObject);
    procedure HintHandle;
  end;

  TSelectedFrame=class(TWinControl)
  private
//    Canvas:TCanvas;
  public
//    CurrentRect : TRect;
    constructor Create(Owner:TComponent); override;
    destructor Destroy; override;
    procedure MoveFrame(ALeft, AUp : integer);
    procedure SizeFrame(ALeft, AUp, ARight, ADown : integer);
    procedure PaintFrame;
  end;

type
  TRepoEdit = class(TComponent)
  private
    { Private declarations }
    FEnabled:boolean;
    FThReport:tQuickRep;
    FThForm:TForm;
    FthPanel:TPanelForm;
    FCurrentVariant:integer;
    FOnNeedCount:TNotifyEvent;
    FOnNeedData:TNotifyEvent;

    EdF:TForm;
//    ThConfirmForm:TVarConfirmForm;
    CannotMouseDown:boolean;

    FAppendObj:TQRPrintable;

    PopupX,PopupY:integer;
    OldX,OldY:integer;

    FSelected:TWinControl;

    ThRect:array[TRectLab] of TRectlabel;

    thFrame:TSelectedFrame;

    thEnabledLab:TEnabledLab;

    thStatusBar:TStatusbar;

    IsEditing:boolean;

//    FVarC:integer;

//    function GetThForm:TForm;
//    PreviewStyle:TFormStyle;

    procedure BtnParamClick(Sender: TObject);
    procedure BtnSaveClick(Sender: TObject);
    procedure BtnChangeNameClick(Sender: TObject);
    procedure BtnCancelClick(Sender: TObject);
    procedure BtnSeeAllClick(Sender: TObject);

    function GetVariantCount:integer;
//    function GetThCount:integer;

    function VariantStr:string;

    procedure OnShowPopup(Sender:TObject);
    procedure OnEnabledItemClick(Sender:TObject);
    procedure OnPropertyItemClick(Sender:TObject);
    procedure OnDeleteItemClick(Sender:TObject);
    procedure SetAppendOBJ(Value:TQRPrintable);

    function GetMainWin:TComponent;

    procedure MouseUpHandler(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : integer);
    procedure MouseDownHandler(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : integer);
    procedure MouseMoveHandler(Sender : TObject; Shift : TShiftState; X, Y : integer);
//    procedure PaintHANDLER(Sender: TOBJECT);
    procedure DblClickHandler(Sender:TObject);
    function FindComp(x:integer=-1000000;y:integer=-1000000):TWinControl;
    function GetContr(const Pos: TPoint;ParComp:TWinControl): TWinControl;

    procedure SetSelected(Value:TWinControl);

    procedure HideRect;
    procedure ShowRect;
    procedure thFormClose(Sender: TObject; var Action: TCloseAction);
  protected
    { Protected declarations }
    procedure Loaded; override;
  public
    { Public declarations }
    ThPopupMenu:TPopupMenu;

    procedure SetEvents(AControl : TWinControl=nil);

    procedure SetHints(value:boolean;AControl : TWinControl=nil);

    function CorrectName:string;
    procedure SetRectCoord(thleft:integer=-1000000;thright:integer=-1000000;thtop:integer=-1000000;thbottom:integer=-1000000);

    procedure RestoreReport;
    procedure SaveReport;
    function RestoreNotFrontBack(ThCompName:string):integer;
    procedure SaveNotFrontBack(ThCompName:string;Value:integer);
//    function RestoreFileName(ThComp:TComponent):String;
  //  procedure SaveFileName(ThComp:TComponent;Value:String);
    function DeleteSaved(ThComp:string):boolean;
    function DeleteSavedReport(DeleteReport:boolean):boolean;
    constructor Create(Aowner:TComponent); override;
//    constructor CreateDisable(Aowner:TComponent);
    destructor Destroy; override;
    procedure Edit;

    procedure Execute;
    function DoReport(NeedFree:boolean=false):integer;
    function DoReportBtn(Btn:integer;NeedFree:boolean=false):integer;

    procedure SetDopParam(Sender:TComponent;ParamName,ParamValue:string);
    function GetDopParam(Sender:TComponent;ParamName:string):string;
    procedure SaveDopParams(Sender:TComponent;ParamList:TStringList);

    procedure CheckData;

    property ThForm:TForm read FThForm;
    property ThReport:TQuickRep read FThReport;
    property ThPanel:TPanelForm read fThPanel write FthPanel;

    property AppendOBJ:TQRPrintable read FAppendOBJ write SetAppendOBJ;

    property MainWin:TComponent read GetMainWin;
//    property ThCount:integer read GetThCount;

    property Selected:TWinControl read fSelected write SetSelected;

  published
    { Published declarations }
    property CurrentVariant:integer read FCurrentVariant write FCurrentVariant;
    property Enabled:boolean read FEnabled write FEnabled;
    property VariantCount:integer read GetVariantCount;
    property OnNeedCount:TNotifyEvent read FOnNeedCount write FOnNeedCount;
    property OnNeedData:TNotifyEvent read FOnNeedData write FOnNeedData;
//    procedure PreviewProc(Sender:TObject);
  end;




const EnabledItemNum=0;
      DeleteItemNum=2;
      PropertyItemNum=4;



procedure Register;

function IniCheck:boolean;
//function IniCheckStructure:boolean;
function DeleteAllIndexes:boolean;
//procedure SetCurrentPreviewInterFace(Value:RepoEditPreviewType);  // 0 - Standard, 1-bvRepoEdit PreviewForm
//function GetCurrentPreviewInterFace:RepoEditPreviewType;

implementation

uses SeeAllUnit,SaveVarConfirmUnit,NewVariantUnit,
     GetNameUnit,qrExport,MessUnit,confirmunit1,actnlist,stdactns,EditFormUnit;


function TableExists(Table:TTable):boolean;
var Thext:string;
    ThPath:string;
    MyStringList:TStringList;
begin
  with Table do begin
    Result := Active;
    if Result or (TableName = '') then Exit;

    Thext:=ExtractFileExt(Table.TableName);
    ThPath:=ExtractFilePath(Table.TableName);

    if (ThPath<>'') or (databaseName='') then begin
       Result:=(ThExt<>'') and FileExists(Table.TableName)
               or (ThExt='') and (FileExists(Table.TableName+'.DB')
                                  or
                                  FileExists(Table.TableName+'.DBF')
                                  or
                                  FileExists(Table.TableName+'.TXT')
                                  )
    end
    else begin
       MyStringList := TStringList.Create;
       try
         Session.GetTableNames(databaseName,'' {*.db;*.dbf;*.txt'},
                               True, False, MyStringList);
         { Add the table names to a list box }
         if ThExt<>'' then Result:=(MyStringList.IndexOf(Tablename)>-1)
         else Result:=(MyStringList.IndexOf(Tablename+'.db')>-1)
                      or
                      (MyStringList.IndexOf(Tablename+'.dbf')>-1)
                      or
                      (MyStringList.IndexOf(Tablename+'.txt')>-1)
       finally
         MyStringList.Free;
       end;
    end;
  end;
end;

function CalcOffsetRect(AControl : TControl) : TRect;
Var thW,thH:integer;
begin
  Result:=AControl.BoundsRect;
  thW:=Result.right-Result.left;
  thH:=Result.Bottom-result.Top;
  AControl := AControl.Parent;
  while not (AControl is TQuickRep) and (AControl <> nil) do
  begin
    Result.left := Result.left + AControl.Left;
    Result.top := Result.top + AControl.Top;
    AControl := AControl.Parent;
  end;
  Result.right:=Result.Left+thW;
  Result.bottom:=Result.Top+thH;
end;

procedure SetOffsetCoord(AControl : TControl;ThRect:TRect);
Var thW,thH:integer;
    thControl:TControl;
begin
//  AControl.BoundsRect:=ThRect;
  thW:=thRect.right-thRect.left;
  thH:=thRect.Bottom-thRect.Top;
  thControl := AControl.Parent;