wwrcdvw.pas

来自「infopower 4000 for delphi 2006」· PAS 代码 · 共 1,716 行 · 第 1/5 页

unit wwrcdvw;
{
//
// Components : TwwRecordViewDialog
//
// Copyright (c) 1997-2001 by Woll2Woll Software
//
// 7/19/97 - Don't show cancel button in memodialog if readonly
// 7/21/97 - Assign memo fields displaylabel property to memodialog caption
// 7/29/97 - Limit length to field size for auto-created TwwDBEdits
// 1/24/98 - Set label's focus control to control for field
// 8/27/98 - Support TDBImage for ftGraphic fields
// 9/25/98 - MaximizeMemoWidth property now maximizes all blob types
// 10/12/98 - Hadn't checked if nil and got AV's.  -ksw (10/12/98)
// 1/31/99  - Avoid access violation on keydown whenAll fields are reaonly
// 4/9/99 - Resize navigator
// 4/27/99 - Memo fields should not be maximized if rvoMaximizeMemoWidth is false
// 5/19/99 - Memo fields should not be maximized if rvoMaximizeMemoWidth is false (Vertical Display )
// 5/20/99 - Recognize width change in OnAfterCreateControl event
// 6/4/99 -  Honor ReadOnly in checkbox
// 10/5/2000  Fix design-time delete problem with record-view component
// 4/22/02 - Honor OnEnter and OnExit in checkboxes
// 10/21/02 - prevent access violation in recordviewpanel in some cases
//            by only setting modified appropriately.
}

interface

{$i wwIfDef.pas}

uses classes, messages, db, dbtables, forms, wwdbedit, wwdatsrc, stdctrls, extctrls, controls,
     wwcommon, dbctrls, winprocs, wintypes, graphics, wwstr, wwtypes, dialogs, menus,
     sysutils,wwintl, buttons, typinfo, wwmemo, wwDBNavigator,
     wwriched, wwdblook, wwDBDateTimePicker, wwDialog,
     wwframe, wwradiogroup;

type
  TwwRecordViewForm = class(TForm)
    procedure FormDeactivate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    Deactivated: boolean;
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  public
    { Public declarations }
     DlgComponent: TComponent;
     RecordPanel, NavigatorPanel, ButtonPanel: TPanel;
     Navigator: TwwDBNavigator;  { -ksw (6/17/98) }
     ScrollBox: TScrollBox;
  end;


  TwwRecordViewStyle = (rvsVertical, rvsHorizontal);
  TwwRecordViewOption = (rvoHideReadOnly, rvoHideCalculated, rvoHideNavigator, rvoUseCustomControls,
                         rvoShortenEditBox, rvoModalForm, rvoStayOnTopForm, rvoConsistentEditWidth,
                         rvoEnterToTab, rvoConfirmCancel,
                         rvoCloseIsCancel, rvoMaximizeMemoWidth,
                         rvoSetControlMinWidth, rvoUseDateTimePicker,
                         rvoLabelsBeneathControl);
  TwwRecordViewOptions = Set of TwwRecordViewOption;

  TwwRecordViewControlOption = (rvcTransparentLabels,
                         rvcTransparentButtons, rvcFlatButtons);
  TwwRecordViewControlOptions = Set of TwwRecordViewControlOption;

  TwwRecordViewOKCancelOption = (rvokShowOKCancel, rvokAutoPostRec, rvokAutoCancelRec);
  TwwRecordViewOKCancelOptions = Set of TwwRecordViewOKCancelOption;

  TwwCloseAction = (rvcOK,rvcCancel,rvcControlMenuClose);
  TwwCloseActions = Set of TwwCloseAction;
  TwwCancelEvent = Procedure(Form: TForm; var CanClose: boolean) of object;

  TwwOnBeforeCreateControlEvent =
     procedure(Form: TwwRecordViewForm; curField: TField; var Accept: boolean) of object;
  TwwOnAfterCreateControlEvent =
     procedure(Form: TwwRecordViewForm; curField: TField; Control: TControl) of object;
  TwwOnSetControlEffectsEvent =
     procedure(Form: TwwRecordViewForm; curField: TField; Control: TControl;
        Frame: TwwEditFrame; ButtonEffects: TwwButtonEffects) of object;
  TwwOnInitFormEvent = procedure(Form: TwwRecordViewForm) of object;
  TwwRecordCustomPaintEvent = procedure(Sender: TScrollBox; Canvas: TCanvas) of object;

  TwwMargin = class(TPersistent)
  private
     FBottomOffset, FTopOffset, FLeftOffset, FRightOffset: integer;
     procedure SetLeftOffset(val: integer);
     procedure SetRightOffset(val: integer);
     procedure SetTopOffset(val: integer);
     procedure SetBottomOffset(val: integer);
  public
     Owner: TComponent;

  published
     property BottomOffset: integer read FBottomOffset write SetBottomOffset
        default 5;
     property TopOffset: integer read FTopOffset write SetTopOffset
        default 5;
     property LeftOffset: integer read FLeftOffset write SetLeftOffset
        default 5;
     property RightOffset: integer read FRightOffset write SetRightOffset
        default 5;
  end;

  TwwVertEditSpacing = class(TPersistent)
  private
     FBetweenLabelEdit, FBetweenRow: integer;
     procedure SetBetweenLabelEdit(val: integer);
     procedure SetBetweenRow(val: integer);
  public
     Owner: TComponent;
  published
     property BetweenLabelEdit: integer read FBetweenLabelEdit write SetBetweenLabelEdit
          default 5;
     property BetweenRow: integer read FBetweenRow write SetBetweenRow
          default 2;
  end;

  TwwHorzEditSpacing = class(TPersistent)
  private
     FBetweenLabelEdit, FBetweenEditsInRow, FBetweenRow, FLabelIndent: integer;
     procedure SetBetweenEditsInRow(val: integer);
     procedure SetBetweenLabelEdit(val: integer);
     procedure SetBetweenRow(val: integer);
     procedure SetLabelIndent(val: integer);
  public
     Owner: TComponent;
  published
     property BetweenEditsInRow: integer read FBetweenEditsInRow write SetBetweenEditsInRow
          default 5;
     property BetweenLabelEdit: integer read FBetweenLabelEdit write SetBetweenLabelEdit
          default 1;
     property BetweenRow: integer read FBetweenRow write SetBetweenRow
          default 2;
     property LabelIndent: integer read FLabelIndent write SetLabelIndent
          default 1;
  end;

  TwwEditSpacing = class(TPersistent)
  private
     FHorizontalView: TwwHorzEditSpacing;
     FVerticalView: TwwVertEditSpacing;
  public
     destructor Destroy; override;
  published
     property HorizontalView: TwwHorzEditSpacing read FHorizontalView write FHorizontalView;
     property VerticalView: TwwVertEditSpacing read FVerticalView write FVerticalView;
  end;

{  TwwFormPosition = class(TPersistent)
  private
     FLeft, FTop: integer;
     FWidth, FHeight: integer;
  published
     property Left: integer read FLeft write FLeft;
     property Top: integer read FTop write FTop;
     property Width: integer read FWidth write FWidth;
     property Height: integer read FHeight write FHeight;
  end;
}
  TwwRecordViewDialog= class(TwwCustomDialog)
  private
     FController: TwwController;
     FOldNavParent: TWinControl;
     FSelected: TStrings;
     FUseTFields: boolean;
     FControlList: TList;
     FLabelList: TList;
     FEditSpacing: TwwEditSpacing;
     FMargin: TwwMargin;
     FFormPosition: TwwFormPosition;
     FBorderStyle: TFormBorderStyle;
     FDataLink: TDataLink;
     FOptions: TwwRecordViewOptions;
     FControlOptions: TwwRecordViewControlOptions;
     FOKCancelOptions: TwwRecordViewOKCancelOptions;
     FFont: TFont;
     FLabelFont: TFont;
     FOnBeforeCreateControl: TwwOnBeforeCreateControlEvent;
     FOnAfterCreateControl: TwwOnAfterCreateControlEvent;
     FOnSetControlEffects: TwwOnSetControlEffectsEvent;
     FOnInitDialog: TwwOnInitFormEvent;
     FOnCloseDialog: TwwOnInitFormEvent;
     FOnResizeDialog: TwwOnInitFormEvent;
//     FOnBeforePaint: TwwRecordCustomPaintEvent;
     FCaption: string;
     FReadOnlyColor: TColor;
     FStyle: TwwRecordViewStyle;
     FMenu: TMainMenu;
//     FNavigatorVisibleButtons: TButtonSet;
     FNavigatorButtons: TwwNavButtonNavStylesEx;
     FNavigatorFlat: boolean;
     FNavigator: TwwDBNavigator; { -ksw (6/17/98) }
     FOnCancelWarning: TwwCancelEvent;
     FLinesPerMemoControl: integer;

     EditStartOffset: integer;
     FormWidth, FormHeight: integer; { Scrollable range }
     CloseAction: TwwCloseAction;
     CustomControlList: TList;

     FControlType: TStrings;
     FControlInfoInDataset: boolean;
     FPictureMasks: TStrings;
     FPictureMaskFromDataSet: boolean;
     FDefaultEditFrame: TwwEditFrame;

     CurLabel: TLabel;

     procedure SetController(Value: TwwController);
     procedure SetNavParent(NewParent: TWinControl; SaveOld: Boolean);
     procedure SetDataSource(value : TDataSource);
     Function GetDataSource: TDataSource;
     Procedure SetLabelFont(val: TFont);
     Procedure SetFont(val: TFont);
     procedure SetNavigator(Value: TwwDBNavigator);
     Function ShowField(field: TField; curFieldReadOnly: boolean): boolean;
     procedure FormShow(Sender: TObject);
     procedure FormResize(Sender: TObject);
     Procedure CreateMainMenu(Form: TwwRecordViewForm; mm: TMainMenu);
     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
     Procedure AddCustomControl(CustomEdit: TWinControl);
     Function IsModified: boolean;
     function IsCheckBox(curField: TField; var checkboxOn, checkboxOff: string): boolean;
     procedure SetPictureMasks(val: TStrings);
     procedure SetControlType(val: TStrings);
     procedure InitPictureMask(EditControl: TWinControl; curField: TField);
  protected
     function IsSingleLineEditControl(EditControl: TWinControl): boolean; virtual;
     procedure DoOnBeforeCreateControl(form: TwwRecordViewForm; curField: TField; var accept: boolean); virtual;
     procedure DoOnAfterCreateControl(form: TwwRecordViewForm; curField: TField; Control: TControl); virtual;
     procedure DoSetControlEffects(form: TwwRecordViewForm; curfield: TField;
       control: TControl; Frame: TwwEditFrame; ButtonEffects: TwwButtonEffects); virtual;

     procedure DoInitDialog(Form: TwwRecordViewForm); virtual;
     procedure DoCloseDialog(Form: TwwRecordViewForm); virtual;
     procedure Notification(AComponent: TComponent;
       Operation: TOperation); override;
     Procedure DisplayVertical;
     Procedure DisplayHorizontal;
     Procedure DoCancelWarning(var CanClose: boolean); virtual;

     procedure SetNavigatorVisibleButtons(Value: TButtonSet);
     function HasFrame(Control: TWinControl): boolean;
     function HasButtonEffects(Control: TWinControl): boolean;
     function IsControlModified(Control: TWinControl): boolean;
//     procedure DefineProperties(Filer: TFiler); override;
//     procedure NavVisButtonsReadProc(Reader: TReader);
//     procedure NavVisButtonsWriteProc(Writer: TWriter);
  public
     OKBtn: TButton;
     CancelBtn: TButton;
     RecordViewForm: TwwRecordViewForm;
     Patch: Variant;

     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     function GetPrimaryDataSet: TDataSet; override;
     Function Execute: boolean; override;
     procedure OKBtnClick(Sender: TObject); virtual;
     procedure CancelBtnClick(Sender: TObject); virtual;
  published
     property Controller : TwwController read FController write SetController;
     property ControlType : TStrings read FControlType write SetControlType;
     property ControlInfoInDataset: boolean
            read FControlInfoInDataset write FControlInfoInDataSet default True;
     property PictureMaskFromDataSet: boolean
             read FPictureMaskFromDataSet write FPictureMaskFromDataSet default True;
     property PictureMasks: TStrings read FPictureMasks write SetPictureMasks;
     property EditFrame: TwwEditFrame read FDefaultEditFrame write FDefaultEditFrame;
     property DataSource: TDataSource read GetDataSource write SetDataSource;
     property EditSpacing: TwwEditSpacing read FEditSpacing write FEditSpacing;
     property Margin: TwwMargin read FMargin write FMargin;
     property BorderStyle: TFormBorderStyle read FBorderStyle write FBorderStyle default bsSizeable;
     property FormPosition: TwwFormPosition read FFormPosition write FFormPosition;
     property NavigatorButtons: TwwNavButtonNavStylesEx read FNavigatorButtons write FNavigatorButtons;
     property NavigatorVisibleButtons: TButtonSet write SetNavigatorVisibleButtons stored False;
//              write FNavigatorVisibleButtons
//              default [nbFirst,nbPrior,nbNext,nbLast,nbinsert,
//                        nbDelete,nbEdit,nbPost,nbCancel,nbRefresh];
     property Style : TwwRecordViewStyle read FStyle write FStyle default rvsVertical;
     property Options: TwwRecordViewOptions read FOptions write FOptions
              default [rvoShortenEditBox, rvoUseCustomControls,
                       rvoModalForm, rvoConfirmCancel, rvoCloseIsCancel,
                       rvoMaximizeMemoWidth, rvoUseDateTimePicker];
     property ControlOptions: TwwRecordViewControlOptions read FControlOptions write FControlOptions;
     property OKCancelOptions: TwwRecordViewOKCancelOptions read FOKCancelOptions write FOKCancelOptions
              default [rvokShowOKCancel, rvokAutoPostRec, rvokAutoCancelRec];
     property LabelFont: TFont read FlabelFont write SetLabelFont;
     property Font: TFont read FFont write SetFont;
     property OnBeforeCreateControl: TwwOnBeforeCreateControlEvent
              read FOnBeforeCreateControl write FOnBeforeCreateControl;
     property OnAfterCreateControl: TwwOnAfterCreateControlEvent
              read FOnAfterCreateControl write FOnAfterCreateControl;
     property OnSetControlEffects: TwwOnSetControlEffectsEvent
              read FOnSetControlEffects write FOnSetControlEffects;
//     property OnBeforePaint : TwwRecordCustomPaintEvent read FOnBeforePaint write FOnBeforePaint;
     property OnInitDialog: TwwOnInitFormEvent read FOnInitDialog write FOnInitDialog;
     property OnCloseDialog: TwwOnInitFormEvent read FOnCloseDialog write FOnCloseDialog;
     property OnResizeDialog: TwwOnInitFormEvent read FOnResizeDialog write FOnResizeDialog;
     property Caption: string read FCaption write FCaption;
     property ReadOnlyColor: TColor read FReadOnlyColor write FReadOnlyColor default clInactiveCaptionText;
     property Menu: TMainMenu read FMenu write FMenu;
     property Selected: TStrings read FSelected write FSelected;
     property NavigatorFlat: boolean read FNavigatorFlat write FNavigatorFlat default False;
     property Navigator: TwwDBNavigator read FNavigator write SetNavigator;
     property OnCancelWarning: TwwCancelEvent read FOnCancelWarning write FOnCancelWarning;
     property LinesPerMemoControl: integer read FLinesPerMemoControl write FLinesPerMemoControl default 2;
  protected
     function CreateDefaultEditControl(AOwner: TComponent): TCustomedit; virtual;
  end;

  TwwDBCheckBox =class(TDBCheckBox)
  protected
     procedure DoEnter; override;
     procedure DoExit; override;
  public
     LabelControl: TLabel;
  end;

  TwwLabel =class(TLabel)
  protected
     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  end;

  TwwDBMemo = class(TDBMemo)
    protected
     procedure KeyDown(var key: word; shift: TShiftState); override;
  end;

  TwwDBEditMemo = class(TwwDBCustomEdit)
    public
     constructor Create(AOwner: TComponent); override;
     procedure KeyDown(var key: word; shift: TShiftState); override;
    published
     property AutoSize;
     property BorderStyle;
     property DataField;
     property DataSource;
     property Frame;
  end;

  TwwCustomControlItem=class