wwrcdpnl.pas

InfoPower_Studio 2007 v5.0.1.3 banben

{
//
// Components : TwwRecordViewPanel
//
// Copyright (c) 1998 by Woll2Woll Software
//
// 8/27/98 - Support images with TDBImage
// 9/3/98 - Tab order problem fixed
// 9/18/98 - Re-assigning of parent should scan backwards in notification
// 9/20/98 - Set tab orders for checkbox
// 9/25/98 - MaximizeMemoWidth property now maximizes all blob types
// 10/1/98 - Don't restore parent if parent is being destroyed
// 10/14/98 - Fix readonly problem for horizontal style
// 10/22/98 - Respect width change in OnAfterCreateControl
// 10/23/98 - Set to first wincontrol if active control is recordpanel
// 12/23/98 - Right alignment for labels
// 3/9/99 - If Panel's readonly property for checkbox is True, the checkbox was
//          still editable.
// 12/21/99 - Fix problem where recordviewpanel is blank in some cases
// 1/5/2000 - Fix bug with picture masks for non wwdatasets in horizontal style
// 8/7/2000 - Support background image when custom framing transpancey is enabled.
//            Fixes problem where first edit control was not painting background image
//            in some random cases
// 10/5/2000  Fix design-time delete problem with record-view component
// 9/9/02 -   Don't set MaxLength when have editmask.
// 9/25/06 - Support embedding in DBCtrlGrid
}

unit wwrcdpnl;

{$i wwIfDef.pas}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  wwrcdvw, db, wwdatsrc, stdctrls, wwcommon, wwdbedit, dbctrls, wwstr,
  wwframe, wwintl;

type
  TwwRecordViewPanelStyle = (rvpsVertical, rvpsHorizontal);
  TwwRecordViewPanelOption =
       (rvopHideReadOnly, rvopHideCalculated, rvopUseCustomControls,
                         rvopShortenEditBox, rvopConsistentEditWidth,
                         rvopMaximizeMemoWidth, rvopUseDateTimePicker,
                         rvopLabelsBeneathControl);
  TwwRecordViewPanelOptions = Set of TwwRecordViewPanelOption;
  TwwRecordOnBeforeCreateControl =
     procedure(Sender: TObject; curField: TField; var Accept: boolean) of object;
  TwwRecordOnAfterCreateControl =
     procedure(Sender: TObject; curField: TField; Control: TControl) of object;
  TwwRecordSetControlEffects =
     procedure(Sender: TObject; curField: TField; Control: TControl;
        Frame: TwwEditFrame; ButtonEffects: TwwButtonEffects) of object;

  TwwRecordViewPanel = class(TScrollBox)
  private
     FSelected: TStrings;
     FUseTFields: boolean;
     FEditSpacing: TwwEditSpacing;
     FMargin: TwwMargin;
     FDataLink: TDataLink;
     FOptions: TwwRecordViewPanelOptions;
     FControlOptions: TwwRecordViewControlOptions;
     FLabelFont: TFont;
     FOnBeforeCreateControl: TwwRecordOnBeforeCreateControl;
     FOnAfterCreateControl: TwwRecordOnAfterCreateControl;
     FOnSetControlEffects: TwwRecordSetControlEffects;
     FReadOnlyColor: TColor;
     FStyle: TwwRecordViewPanelStyle;
     FLinesPerMemoControl: integer;
     FParentObject: TWinControl;
     FDefaultEditFrame: TwwEditFrame;

     EditStartOffset: integer;
     CustomControlList: TList;
     InApply: boolean;
     RecreateNextTime: boolean;
     ControlPositions: TList;

     FControlType: TStrings;
     FControlInfoInDataset: boolean;
     FPictureMasks: TStrings;
     FPictureMaskFromDataSet: boolean;
//     FActiveField: string;
     CurLabel: TLabel;
     FController: TwwController;
//     {$ifdef wwdelphi4up}
//     FShowImages: boolean;
//     {$endif}

     procedure SetController(Value: TwwController);
     procedure SetDataSource(value : TDataSource);
     Function GetDataSource: TDataSource;
     Procedure SetLabelFont(val: TFont);
     Function ShowField(field: TField; curFieldReadOnly: boolean): boolean;
     Procedure AddCustomControl(CustomEdit: TWinControl);
     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
     procedure LabelFontChanged(Sender: TObject);
     procedure SetOptions(val: TwwRecordViewPanelOptions);
     Procedure SetControlOptions(val: TwwRecordViewControlOptions);
     procedure SetStyle(val: TwwRecordViewPanelStyle);
     function IsCustomEditCell(curField: TField;
        var customEdit: TWinControl) : boolean;
     Function UseCustomControls: boolean;
     procedure AddControlPosition(Control: TControl; Left, Top, Width, Height: integer);
     procedure SetLinesPerMemoControl(val: integer);
//     {$ifdef wwdelphi4up}
//     procedure SetShowImages(val: boolean);
//     {$endif}
     procedure SetPictureMasks(val: TStrings);
     procedure SetControlType(val: TStrings);

  protected
     function IsSingleLineEditControl(EditControl: TWinControl): boolean; virtual;
     procedure DoOnBeforeCreateControl(Sender: TObject; curField: TField;
               var accept: boolean); virtual;
     procedure DoOnAfterCreateControl(Sender: TObject; curField: TField;
               Control: TControl); virtual;
     procedure DoSetControlEffects(
        Sender : TObject; curfield: TField;
        control: TControl; Frame: TwwEditFrame; ButtonEffects: TwwButtonEffects);
     procedure Notification(AComponent: TComponent;
       Operation: TOperation); override;
     Procedure DisplayVertical(Recreate: boolean);
     Procedure DisplayHorizontal(Recreate: boolean);
     procedure Resize; override;
     procedure LinkActive(Value: Boolean); virtual;
     procedure FreeNonCustomControls(DestroyControls: boolean);
     Function Apply(Recreate: boolean): boolean; virtual;
     procedure CreateParams(var Params: TCreateParams); override;
     function HasFrame(Control: TWinControl): boolean;
     function HasButtonEffects(Control: TWinControl): boolean;
     procedure CreateWnd; override;
  public
     Patch: Variant;
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     Procedure RefreshControls;
     Procedure RecreateControls;
     Procedure ClearControls;  { Call before changing dataset at runtime }
  published
     property Controller : TwwController read FController write SetController;
    {$ifdef wwDelphi4Up}
     property Anchors;
     property Constraints;
     {$endif}

     property ControlInfoInDataset: boolean
            read FControlInfoInDataset write FControlInfoInDataSet default True;
     property ControlType : TStrings read FControlType write SetControlType;
     property PictureMaskFromDataSet: boolean
              read FPictureMaskFromDataSet write FPictureMaskFromDataSet default True;
     property PictureMasks: TStrings read FPictureMasks write SetPictureMasks;

     property DataSource: TDataSource read GetDataSource write SetDataSource;
     property EditFrame: TwwEditFrame read FDefaultEditFrame write FDefaultEditFrame;
     property EditSpacing: TwwEditSpacing read FEditSpacing write FEditSpacing;
     property Margin: TwwMargin read FMargin write FMargin;
//     {$ifdef wwdelphi4up}
//     property ShowImages: boolean read FShowImages write SetShowImages default True;
//     {$endif}
     property Style : TwwRecordViewPanelStyle read FStyle write SetStyle default rvpsVertical;
     property Options: TwwRecordViewPanelOptions read FOptions write SetOptions
              default [rvopShortenEditBox, rvopUseCustomControls,
                       rvopMaximizeMemoWidth, rvopUseDateTimePicker];
     property ControlOptions: TwwRecordViewControlOptions read FControlOptions write SetControlOptions;
     property LabelFont: TFont read FlabelFont write SetLabelFont;
     property ReadOnlyColor: TColor read FReadOnlyColor write FReadOnlyColor default clInactiveCaptionText;
     property Selected: TStrings read FSelected write FSelected;
     property LinesPerMemoControl: integer read FLinesPerMemoControl write SetLinesPerMemoControl default 2;
//     property ActiveField: string read FActiveField write FActiveField;

     property OnBeforeCreateControl: TwwRecordOnBeforeCreateControl
              read FOnBeforeCreateControl write FOnBeforeCreateControl;
     property OnAfterCreateControl: TwwRecordOnAfterCreateControl
              read FOnAfterCreateControl write FOnAfterCreateControl;
     property OnSetControlEffects: TwwRecordSetControlEffects
              read FOnSetControlEffects write FOnSetControlEffects;
  protected
     function CreateDefaultEditControl(AOwner: TComponent): TCustomedit; virtual;
  end;

procedure Register;

implementation

uses wwriched, wwdbdatetimepicker,
{$ifdef wwDelphi6Up}
variants,
{$endif}
wwradiogroup;

type
  TwwRecordViewDataLink = class(TDataLink)
  private
    FRecordViewPanel: TwwRecordViewPanel;
  protected
    procedure ActiveChanged; override;
    procedure LayoutChanged; override;
  public
    constructor Create(ARecordViewPanel: TwwRecordViewPanel);
  end;

constructor TwwRecordViewDataLink.Create(ARecordViewPanel: TwwRecordViewPanel);
begin
  inherited Create;
  FRecordViewPanel:= ARecordViewPanel;
end;

procedure TwwRecordViewDataLink.LayoutChanged;
begin
//  FRecordViewPanel.LinkActive(Active);
end;

procedure TwwRecordViewDataLink.ActiveChanged;
begin
   FRecordViewPanel.RecreateControls;
end;

procedure TwwRecordViewPanel.LinkActive(Value: Boolean);
begin
   Apply(True);
end;

constructor TwwRecordViewPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle:= ControlStyle + [csReplicatable]; 
  FDataLink:= TwwRecordViewDataLink.create(self);
  FEditSpacing:= TwwEditSpacing.create;
  FParentObject:= Nil;
  with FEditSpacing do begin
     VerticalView:= TwwVertEditSpacing.create;
     VerticalView.BetweenRow:= 2;
     VerticalView.BetweenLabelEdit:= 5;
     VerticalView.Owner:= self;
     HorizontalView:= TwwHorzEditSpacing.create;
     HorizontalView.BetweenRow:= 2;
     HorizontalView.BetweenLabelEdit:= 1;
     HorizontalView.BetweenEditsInRow:= 5;
     HorizontalView.LabelIndent:= 1;
     HorizontalView.Owner:= self;
  end;

  FMargin:= TwwMargin.create;
  with FMargin do begin
     LeftOffset:= 5;
     RightOffset:=5;
     TopOffset:= 5;
     BottomOffset:=5;
     Owner:= self;
  end;

  FOptions:= [rvopShortenEditBox, rvopUseCustomControls,
              rvopMaximizeMemoWidth, rvopUseDateTimePicker];
//  FShowImages:= True;
  FLabelFont:= TFont.create;
  FLabelFont.OnChange := LabelFontChanged;
//  FCaption:= 'Record View';
  FReadOnlyColor:= clInactiveCaptionText;
  FStyle:= rvpsVertical;
  FSelected:= TStringList.create;
  FUseTFields:= False;
  CustomControlList:= TList.create;
  ControlPositions:= TList.create;
  FLinesPerMemoControl:= 2;

  FControlType:= TStringList.create;
  FControlInfoInDataset:= True;
  FPictureMasks:= TStringList.create;
  FPictureMaskFromDataSet:= True;

  Patch:= VarArrayCreate([0, 1], varVariant);
  Patch[0]:= False;
  Patch[1]:= True;

  FDefaultEditFrame:= TwwEditFrame.create(self);
end;

type
  TControlPosition = class
     control: TControl;
     Left, Top, Width, Height: integer;
  end;


destructor TwwRecordViewPanel.Destroy;
var i: integer;
begin
  FDefaultEditFrame.Free;
  FDataLink.free;
  FDataLink:= nil;
  FEditSpacing.Free;
  FMargin.Free;
  FLabelFont.Free;
  FSelected.Free;
  FreeNonCustomControls(True);
  for i:= 0 to CustomControlList.count-1 do TwwCustomControlItem(CustomControlList[i]).Free;
  CustomControlList.Free;
  CustomControlList:= nil; // 10/5/00
  for i:= 0 to ControlPositions.count-1 do TControlPosition(ControlPositions[i]).Free;
  ControlPositions.Free;
  FControlType.Free;
  FPictureMasks.Free;

  inherited destroy;
end;


procedure TwwRecordViewPanel.SetDataSource(value : TDataSource);
var OldControlCount: integer;
begin
   OldControlCount:= ControlCount;
   FDataLink.dataSource:= value;
   if (ControlCount=OldControlCount) then
     LinkActive(FDataLink.Active);
end;

Function TwwRecordViewPanel.GetDataSource: TDataSource;
begin
   Result:= FdataLink.dataSource as TDataSource;
end;

procedure TwwRecordViewPanel.setLabelFont(val: TFont);
begin
    FLabelFont.assign(Val);
    Apply(False);
end;

procedure TwwRecordViewPanel.DoSetControlEffects(
   Sender : TObject; curfield: TField;
   control: TControl; Frame: TwwEditFrame; ButtonEffects: TwwButtonEffects);
begin
   if Assigned(FOnSetControlEffects) then
      FOnSetControlEffects(Sender, curfield, control, Frame, ButtonEffects);
end;

procedure TwwRecordViewPanel.DoOnAfterCreateControl(