adbpanel.pas

来自「delphi编程控件」· PAS 代码 · 共 2,248 行 · 第 1/5 页

unit adbpanel;
(*
 COPYRIGHT (c) RSD Software 1997 - 98
 All Rights Reserved.
*)

interface
uses Classes, SysUtils, Windows, Messages, DB, Controls, Graphics,
  StdCtrls, Forms, adbtempl, comctrls, commctrl, aincsrch, menus;
{$I aclver.inc}

type

TCustomAutoDBPanel = class;
TAutoPanelLayout = class;
TAutoPanelPage = class;
TAutoPanelPages = class;
TAutoPanelControls = class;
TAutoPanelControl = class;
TAutoPanelField = class;
TAutoPanelFields = class;


TAutoPanelControl = class(TCollectionItem)
private
  Controls : TAutoPanelControls;
  FIsDown : Boolean;
  FPanelField : TAutoPanelField;
  FControl : TWinControl;
  FLabel : TLabel;
  FCreated : Boolean;
  FLeft : Integer;
  FDBDefControl : TAutoDBDefControl;

  function GetAlignment : TAlignment;
  function GetCaption : String;
  function GetField : TField;
  function GetFont : TFont;
  function GetDBDefControl : TAutoDBDefControl;
  function GetPanelLayout : TAutoPanelLayout;
  function GetRect : TRect;
  function GetTop : Integer;
  procedure SetCreated(Value : Boolean);

  procedure ReadFieldIndex(Reader: TReader);
  procedure WriteFieldIndex(Writer: TWriter);
protected
  procedure DefineProperties(Filer: TFiler); override;

  property Created : Boolean read FCreated write SetCreated;
  property IsDown : Boolean read FIsDown;
  property Rect : TRect read GetRect;
  property Top : Integer read GetTop;
public
  constructor Create(Collection : TCollection); override;
  destructor Destroy; override;
  procedure Assign(Source: TPersistent); override;

  property Alignment : TAlignment read GetAlignment;
  property Caption : String read GetCaption;
  property Field : TField read GetField;
  property Font : TFont read GetFont;

  property DBDefControl : TAutoDBDefControl read GetDBDefControl;
  property PanelLayout : TAutoPanelLayout read GetPanelLayout;
end;

TAutoPanelControls = class(TCollection)
private
  FPage : TAutoPanelPage;

  function GetItem(Index : Integer) : TAutoPanelControl;
  procedure SetItem(Index : Integer; Value : TAutoPanelControl);

  function GetPanelLayout : TAutoPanelLayout;
  function GetPages : TAutoPanelPages;
protected
  property Pages : TAutoPanelPages read GetPages;
  procedure Update(Item: TCollectionItem); override;
  {$IFDEF DELPHI4}
  function  GetOwner: TPersistent; override; 
  {$ENDIF}
public
  constructor Create(APage : TAutoPanelPage);
  function Add(APanelField : TAutoPanelField) : TAutoPanelControl;
  procedure Assign(Source: TPersistent); override;

  property PanelLayout : TAutoPanelLayout read GetPanelLayout;
  property Page : TAutoPanelPage read FPage;
  property Items[Index : Integer] : TAutoPanelControl read GetItem write SetItem; default;
end;

TPanelPageValue = (ppvAlignment, ppvColor, ppvControlLayout, ppvLabelLayout);
TPanelPageValues = set of TPanelPageValue;
TAutoControlLayout = (pclHorz, pclVert);
TAutoLabelLayout = (pllLeft, pllUp);

TAutoPanelPage = class(TCollectionItem)
private
  Pages : TAutoPanelPages;
  FControls : TAutoPanelControls;
  FAlignment : TAlignment;
  FCaption : String;
  FColor : TColor;
  FControlLayout : TAutoControlLayout;
  FLabelLayout : TAutoLabelLayout;
  FAssignedValues : TPanelPageValues;
  FMaxLabelWidth : Integer;

  function GetPanelLayout : TAutoPanelLayout;
  function GetAlignment : TAlignment;
  function GetColor : TColor;
  function GetControlLayout : TAutoControlLayout;
  function GetLabelLayout : TAutoLabelLayout;
  procedure SetAlignment(Value : TAlignment);
  procedure SetColor(Value : TColor);
  procedure SetCaption(Value : String);
  procedure SetControls(Value : TAutoPanelControls);
  procedure SetControlLayout(Value : TAutoControlLayout);
  procedure SetLabelLayout(Value : TAutoLabelLayout);

  function IsAlignmentStored : Boolean;
  function IsColorStored : Boolean;
  function IsControlLayoutStored : Boolean;
  function IsLabelLayoutStored : Boolean;
  procedure Changed;
protected
public
  constructor Create(Collection : TCollection); override;
  destructor Destroy; override;
  procedure Assign(Source: TPersistent); override;

  procedure RestoreDefaults;
  function DefaultAlignment : TAlignment;
  function DefaultColor : TColor;
  function DefaultControlLayout : TAutoControlLayout;
  function DefaultLabelLayout : TAutoLabelLayout;

  property AssignedValues : TPanelPageValues read FAssignedValues;
  property PanelLayout : TAutoPanelLayout read GetPanelLayout;
published
  property Alignment : TAlignment read GetAlignment write SetAlignment stored IsAlignmentStored;
  property Caption : String read FCaption write SetCaption;
  property Color : TColor read GetColor write SetColor stored IsColorStored;
  property ControlLayout : TAutoControlLayout read GetControlLayout write
           SetControlLayout stored IsControlLayoutStored;
  property LabelLayout : TAutoLabelLayout read GetLabelLayout write
           SetLabelLayout  stored IsLabelLayoutStored;
  property Controls : TAutoPanelControls read FControls write SetControls;
end;

TAutoPanelPages = class(TCollection)
private
  FPanelLayout : TAutoPanelLayout;

  function GetItem(Index : Integer) : TAutoPanelPage;
  function GetPanelOwner : TComponent;
  procedure SetItem(Index : Integer; Value : TAutoPanelPage);
protected
  {$IFDEF DELPHI4}
  function  GetOwner: TPersistent; override; 
  {$ENDIF}
public
  constructor Create(APanelLayout : TAutoPanelLayout);
  destructor Destroy; override;
  function Add : TAutoPanelPage;
  procedure Assign(Source: TPersistent); override;

  property PanelLayout : TAutoPanelLayout read FPanelLayout;
  property Items[Index : Integer] : TAutoPanelPage read GetItem write SetItem; default;
  property Owner : TComponent read GetPanelOwner;
end;

TPanelFieldValue = (pfvColor, pfvFont, pfvAlignment, pfvReadOnly, pfvCaption);
TPanelFieldValues = set of TPanelFieldValue;

TAutoPanelFieldClass = class of TAutoPanelField;

TAutoPanelField = class(TCollectionItem)
private
  FControl : TAutoPanelControl;
  FField : TField;
  FFieldName : string;
  FColor : TColor;
  FFont : TFont;
  FAlignment : TAlignment;
  FReadonly : Boolean;
  FCaption : String;
  FAssignedValues : TPanelFieldValues;
  FCustomized : Boolean;

  procedure FontChanged(Sender : TObject);
  function GetAlignment : TAlignment;
  function GetCaption : String;
  function GetColor : TColor;
  function GetField : TField;
  function GetFont : TFont;
  function GetReadOnly : Boolean;

  function GetDBDefControl : TAutoDBDefControl;

  function IsAlignmentStored : Boolean;
  function IsCaptionStored : Boolean;
  function IsColorStored : Boolean;
  function IsReadOnlyStored : Boolean;

  procedure SetAlignment(Value : TAlignment);
  procedure SetCaption(Value : String);
  procedure SetColor(Value : TColor);
  procedure SetField(Value : TField);
  procedure SetFieldName(const Value : String);
  procedure SetFont(Value : TFont);
  procedure SetReadOnly(Value : Boolean);
protected
  function  GetPanelLayout : TAutoPanelLayout;
  procedure RefreshDefaultFont;

  property InternalFont : TFont read GetFont;  
public
  constructor Create(Collection : TCollection); override;
  destructor Destroy; override;
  procedure Assign(Source : TPersistent); override;

  function IsFontStored : Boolean;

  function DefaultAlignment : TAlignment;
  function DefaultCaption : String;
  function DefaultColor : TColor;
  function DefaultFont : TFont;
  function DefaultReadOnly : Boolean;

  procedure RestoreDefaults;

  property AssignedValues : TPanelFieldValues read FAssignedValues;
  property Customized : Boolean read FCustomized;
  property DBDefControl : TAutoDBDefControl read GetDBDefControl;
  property Field : TField read GetField write SetField;
  property PanelLayout : TAutoPanelLayout read GetPanelLayout;
published
  property  Alignment : TAlignment read GetAlignment write SetAlignment
     stored IsAlignmentStored;
  property Caption : String read GetCaption write SetCaption stored IsCaptionStored;
  property Color : TColor read GetColor write SetColor stored IsColorStored;
  property FieldName : String read FFieldName write SetFieldName;
  property Font : TFont read FFont write SetFont stored IsFontStored;
  property ReadOnly : Boolean read GetReadOnly write SetReadOnly
      stored IsReadOnlyStored;
end;

TAutoPanelFields = class(TCollection)
private
  FPanelLayout : TAutoPanelLayout;

  function GetField(Index : Integer): TAutoPanelField;
  function GetCustomized : Boolean;
  procedure SetField(Index : Integer; Value : TAutoPanelField);
  procedure SetCustomized(Value : Boolean);
protected
  procedure Update(Item : TCollectionItem); override;
  {$IFDEF DELPHI4}
  function  GetOwner: TPersistent; override; 
  {$ENDIF}
public
  constructor Create(APanelLayout : TAutoPanelLayout);
  function Add : TAutoPanelField;
  procedure Assign(Source: TPersistent); override;
  procedure RestoreDefaults;
  procedure RebuildFields;
  function FieldByFieldName(AFieldName : String) : TAutoPanelField;

  property Customized : Boolean read GetCustomized write SetCustomized;
  property PanelLayout : TAutoPanelLayout read FPanelLayout;
  property Items[Index : Integer]: TAutoPanelField read GetField write SetField; default;
end;

TAutoDBPanelDataLink = class(TDataLink)
private
  FPanelLayout : TAutoPanelLayout;
  FFieldCount : Integer;
  FFieldMapSize : Integer;
  FFieldMap : Pointer;
  FModified : Boolean;
  FSparseMap : Boolean;

  function GetDefaultFields: Boolean;
  function GetFields(I: Integer): TField;
protected
  procedure ActiveChanged; override;
  procedure DataSetChanged; override;
  procedure DataSetScrolled(Distance: Integer); override;
  procedure EditingChanged; override;
  procedure RecordChanged(Field: TField); override;
  procedure UpdateData; override;
  function  GetMappedIndex(ColIndex: Integer): Integer;
public
  constructor Create(APanelLayout : TAutoPanelLayout);
  destructor Destroy; override;
  function AddMapping(const FieldName: string): Boolean;
  procedure ClearMapping;
  procedure Modified;
  procedure Reset;
  property DefaultFields: Boolean read GetDefaultFields;
  property FieldCount: Integer read FFieldCount;
  property Fields[I: Integer]: TField read GetFields;
  property SparseMap: Boolean read FSparseMap write FSparseMap;
end;

TAutoPanelOption = (apoScrollBar);
TAutoPanelOptions = set of TAutoPanelOption;

TAutoPanelIncSearch = class(TCustomAutoControlIncSearch)
private
  FPanelLayout : TAutoPanelLayout;
protected
  function GetDBControl : TWinControl; override;
  function GetDataSource : TDataSource; override;
  function GetField : TField; override;
published
  property CaseInsensitive;
  property HotKey;
end;

TAutoPanelLayout = class(TPersistent)
private
  FDataLink : TAutoDBPanelDataLink;
  FDataSource : TDataSource;
  FPages : TAutoPanelPages;
  FFields : TAutoPanelFields;
  FFont : TFont;
  FOwner : TComponent;
  FRepository : TAutoRepository;
  FReadOnly : Boolean;
  FUpdatedCount : Integer;
  FOptions : TAutoPanelOptions;
  FControlLayout : TAutoControlLayout;
  FLabelLayout : TAutoLabelLayout;
  FAssignFlag : Boolean;
  FIncSearch : TAutoPanelIncSearch;
  FLinkActiveChanging : Boolean;

  function GetDataSet : TDataSet;
  function GetDataSource : TDataSource;
  function GetPanel : TCustomAutoDBPanel;
  procedure SetDataSource(Value : TDataSource);
  procedure SetRepository(Value : TAutoRepository);
  procedure SetFont(Value : TFont);
  procedure SetFields(Value : TAutoPanelFields);
  procedure SetControlLayout(Value : TAutoControlLayout);
  procedure SetIncSearch(Value : TAutoPanelIncSearch);
  procedure SetLabelLayout(Value : TAutoLabelLayout);

  procedure SetOptions(Value : TAutoPanelOptions);
  procedure SetPages(Value : TAutoPanelPages);
  procedure ReadCustomized(Reader: TReader);
  procedure WriteCustomized(Writer: TWriter);
protected
  procedure DefineProperties(Filer: TFiler); override;
  procedure UpdateCustomizingFields;

  function CanUpdateLayout : Boolean;
  procedure BeginUpdateLayout;
  procedure EndUpdateLayout;
  procedure UpdateLayout(Immediate : Boolean);
  procedure UpdateControlLayout;
  procedure DestroyControls;
  function IsDestroying : Boolean;

  procedure LinkActive(Active : Boolean);
  procedure Scroll(Distance : Integer);
  procedure DataChanged;
  procedure RecordChanged(Field: TField);
  procedure FieldNotification(AField : TField);
  procedure FontChanged(Sender : TObject);
  {$IFDEF DELPHI4}
  function  GetOwner: TPersistent; override; 
  {$ENDIF}
public
  constructor Create(AOwner : TComponent);
  destructor Destroy; override;
  procedure Assign(Source: TPersistent); override;

  property DataSet : TDataSet read GetDataSet;
  property Panel : TCustomAutoDBPanel read GetPanel;
  property Owner : TComponent read FOwner;
  property Repository : TAutoRepository read FRepository;
published
  property DataSource : TDataSource read GetDataSource write SetDataSource;
  //Fields should be defined before Pages
  property Fields : TAutoPanelFields read FFields write SetFields;
  property IncSearch : TAutoPanelIncSearch read FIncSearch write SetIncSearch;
  property Pages : TAutoPanelPages read FPages write SetPages;
  property Font : TFont read FFont write SetFont;
  property ControlLayout : TAutoControlLayout read FControlLayout write SetControlLayout;
  property LabelLayout : TAutoLabelLayout read FLabelLayout write SetLabelLayout;
  property Options : TAutoPanelOptions read FOptions write SetOptions;
  property ReadOnly : Boolean read FReadOnly write FReadOnly;
end;

TCustomAutoDBPanel = class(TCustomControl)
private
  FPanelLayout : TAutoPanelLayout;
  FScrollBoxes : TList;
  FPageControl : TPageControl;
  FDownControl : TAutoPanelControl;
  FIsCustomizing : Boolean;
  FDragImage: TImageList;
  FDragRect : TRect;
  FAccept : Boolean;
  FDragPanelField : TAutoPanelField;
  FDragControl : TAutoPanelControl;
  FIsDragging : Boolean;
  FLayoutUpdating : Boolean;
  FDestroying : Boolean;
  FLoadedUpdateLayout : Boolean;

  function GetActivePage : TAutoPanelPage;
  function GetActiveScrollBox : TScrollBox;
  function GetRepository : TAutoRepository;
  function GetPages : TAutoPanelPages;
  function GetSelectedField : TField;
  procedure SetPanelLayout(Value : TAutoPanelLayout);
  procedure SetRepository(Value : TAutoRepository);
  procedure SetDownControl(Value : TAutoPanelControl);
  procedure UpdateVertScrollBar;

  procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;

  procedure OnCloseCustomizingForm(Sender: TObject; var Action: TCloseAction);
  procedure OnGBClickCustomizingForm(Sender: TObject);
protected
  procedure CreateParams(var Params: TCreateParams); override;
  procedure CreateWnd; override;
  procedure Loaded; override;
  procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  procedure WndProc(var Message : TMessage); override;

  procedure UpdateLayout;
  procedure UpdateScrollBoxesControls;
  procedure UpdateScrollBoxesLayout;
  procedure UpdateScrollBoxLayout(Index : Integer);
  procedure InvalidateActiveScrollBox;

  procedure DoControlDragging;
  function GetDragOverControl(p : TPoint) : TAutoPanelControl;
  procedure EndDrag(Flag : Boolean);
  procedure StartDrag;

  property ActivePage :  TAutoPanelPage read GetActivePage;
  property ActiveScrollBox : TScrollBox read GetActiveScrollBox;
  property DownControl : TAutoPanelControl read FDownControl write SetDownControl;