valedit.pas

这是不可多得的源代码

{*******************************************************}
{                                                       }
{       Borland Delphi Visual Component Library         }
{                                                       }
{  Copyright (c) 2000,2001 Borland Software Corporation }
{                                                       }
{*******************************************************}

unit ValEdit;

interface

uses Windows, SysUtils, Classes, Messages, Controls, Grids, StdCtrls;

type

{ Forward Declarations }

  TItemProp = class;
  TValueListStrings = class;

{ TValueListEditor }

  TDisplayOption = (doColumnTitles, doAutoColResize, doKeyColFixed);
  TDisplayOptions = set of TDisplayOption;

  TKeyOption = (keyEdit, keyAdd, keyDelete, keyUnique);
  TKeyOptions = set of TKeyOption;

  TGetPickListEvent = procedure(Sender: TObject; const KeyName: string;
    Values: TStrings) of object;

  TOnValidateEvent = procedure(Sender: TObject; ACol, ARow: Longint;
    const KeyName, KeyValue: string) of object;

  TValueListEditor = class(TCustomDrawGrid)
  private
    FTitleCaptions: TStrings;
    FStrings: TValueListStrings;
    FKeyOptions: TKeyOptions;
    FDisplayOptions: TDisplayOptions;
    FDropDownRows: Integer;
    FDupKeySave: string;
    FDeleting: Boolean;
    FAdjustingColWidths: Boolean;
    FEditUpdate: Integer;
    FCountSave: Integer;
    FEditList: TInplaceEditList;
    FOnGetPickList: TGetPickListEvent;
    FOnEditButtonClick: TNotifyEvent;
    FOnValidate: TOnValidateEvent;
    procedure DisableEditUpdate;
    procedure EnableEditUpdate;
    function GetItemProp(const KeyOrIndex: Variant): TItemProp;
    function GetKey(Index: Integer): string;
    function GetValue(const Key: string): string;
    function GetOnStringsChange: TNotifyEvent;
    function GetOnStringsChanging: TNotifyEvent;
    function GetStrings: TStrings;
    procedure PutItemProp(const KeyOrIndex: Variant; const Value: TItemProp);
    procedure SetDisplayOptions(const Value: TDisplayOptions);
    procedure SetDropDownRows(const Value: Integer);
    procedure SetKey(Index: Integer; const Value: string);
    procedure SetKeyOptions(Value: TKeyOptions);
    procedure SetTitleCaptions(const Value: TStrings);
    procedure SetValue(const Key, Value: string);
    procedure SetOnStringsChange(const Value: TNotifyEvent);
    procedure SetOnStringsChanging(const Value: TNotifyEvent);
    procedure SetOnEditButtonClick(const Value: TNotifyEvent);
    function GetOptions: TGridOptions;
    procedure SetOptions(const Value: TGridOptions);
    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
  protected
    procedure AdjustColWidths; virtual;
    procedure AdjustRowCount; virtual;
    procedure ColWidthsChanged; override;
    function CanEditModify: Boolean; override;
    function CreateEditor: TInplaceEdit; override;
    procedure CreateWnd; override;
    procedure DoExit; override;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState); override;
    procedure DoOnValidate; virtual;
    procedure EditListGetItems(ACol, ARow: Integer; Items: TStrings);
    function GetCell(ACol, ARow: Integer): string; virtual;
    function GetColCount: Integer;
    function GetEditLimit: Integer; override;
    function GetEditMask(ACol, ARow: Longint): string; override;
    function GetEditStyle(ACol, ARow: Longint): TEditStyle; override;
    function GetEditText(ACol, ARow: Integer): string; override;
    function GetPickList(Values: TStrings; ClearFirst: Boolean = True): Boolean;
    function GetRowCount: Integer;
    function IsEmptyRow: Boolean;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Resize; override;
    procedure RowMoved(FromIndex, ToIndex: Longint); override;
    function SelectCell(ACol, ARow: Longint): Boolean; override;
    procedure SetCell(ACol, ARow: Integer; const Value: string); virtual;
    procedure SetEditText(ACol, ARow: Integer; const Value: string); override;
    procedure SetStrings(const Value: TStrings); virtual;
    procedure StringsChanging; dynamic;
    function TitleCaptionsStored: Boolean;
    property EditList: TInplaceEditList read FEditList;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DeleteRow(ARow: Integer); override;
    function FindRow(const KeyName: string; var Row: Integer): Boolean;
    function InsertRow(const KeyName, Value: string; Append: Boolean): Integer;
    procedure Refresh;
    function RestoreCurrentRow: Boolean;
    property Cells[ACol, ARow: Integer]: string read GetCell write SetCell;
    property ColCount read GetColCount;
    property ItemProps[const KeyOrIndex: Variant]: TItemProp read GetItemProp write PutItemProp;
    property Keys[Index: Integer]: string read GetKey write SetKey;
    property RowCount: Integer read GetRowCount;
    property Values[const Key: string]: string read GetValue write SetValue;
    property VisibleColCount;
    property VisibleRowCount;
  published
    property Align;
    property Anchors;
    property BiDiMode;
    property BorderStyle;
    property Color;
    property Constraints;
    property Ctl3D;
    property DefaultColWidth default 150;
    property DefaultDrawing;
    property DefaultRowHeight default 18;
    property DisplayOptions: TDisplayOptions read FDisplayOptions
      write SetDisplayOptions default [doColumnTitles, doAutoColResize, doKeyColFixed];
    property DragCursor;
    property DragKind;
    property DragMode;
    property DropDownRows: Integer read FDropDownRows write SetDropDownRows default 8;
    property Enabled;
    property FixedColor;
    property FixedCols default 0;
    property Font;
    property GridLineWidth;
    property KeyOptions: TKeyOptions read FKeyOptions write SetKeyOptions default [];
    property Options: TGridOptions read GetOptions write SetOptions default [goFixedVertLine, goFixedHorzLine,
      goVertLine, goHorzLine, goColSizing, goEditing, goAlwaysShowEditor,
      goThumbTracking];
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ScrollBars;
    property ShowHint;
    property Strings: TStrings read GetStrings write SetStrings;
    property TabOrder;
    property TitleCaptions: TStrings read FTitleCaptions write SetTitleCaptions stored TitleCaptionsStored;
    property Visible;

    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawCell;
    property OnEditButtonClick: TNotifyEvent read FOnEditButtonClick
      write SetOnEditButtonClick;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetEditMask;
    property OnGetEditText;
    property OnGetPickList: TGetPickListEvent read FOnGetPickList write FOnGetPickList;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnRowMoved;
    property OnSelectCell;
    property OnSetEditText;
    property OnStartDock;
    property OnStartDrag;
    property OnStringsChange: TNotifyEvent read GetOnStringsChange
      write SetOnStringsChange;
    property OnStringsChanging: TNotifyEvent read GetOnStringsChanging
      write SetOnStringsChanging;
    property OnTopLeftChanged;
    property OnValidate: TOnValidateEvent read FOnValidate write FOnValidate;
  end;

  (*$HPPEMIT 'class DELPHICLASS TItemProp;' *)

{ TValueListStrings }

  TItemProps = array of TItemProp;

  TValueListStrings = class(TStringList)
  private
    FItemProps: TItemProps;
    FEditor: TValueListEditor;
    function GetItemProp(const KeyOrIndex: Variant): TItemProp;
    procedure PutItemProp(const KeyOrIndex: Variant; const Value: TItemProp);
  protected
    procedure Changed; override;
    procedure Changing; override;
    function FindItemProp(const KeyOrIndex: Variant; Create: Boolean = False): TItemProp;
    procedure InsertItem(Index: Integer; const S: string; AObject: TObject); override;
    procedure Put(Index: Integer; const S: String); override;
  public
    constructor Create(AEditor: TValueListEditor); reintroduce;
    procedure Assign(Source: TPersistent); override;
    function KeyIsValid(const Key: string; RaiseError: Boolean = True): Boolean;
    procedure Clear; override;
    procedure CustomSort(Compare: TStringListSortCompare); override;
    procedure Delete(Index: Integer); override;
    procedure Exchange(Index1, Index2: Integer); override;
    property ItemProps[const KeyOrIndex: Variant]: TItemProp read GetItemProp write PutItemProp;
  end;

{ TItemProp }

  TItemProp = class(TPersistent)
  private
    FEditor: TValueListEditor;
    FEditMask: string;
    FEditStyle: TEditStyle;
    FPickList: TStrings;
    FMaxLength: Integer;
    FReadOnly: Boolean;
    FKeyDesc: string;
    function GetPickList: TStrings;
    procedure PickListChange(Sender: TObject);
    procedure SetEditMask(const Value: string);
    procedure SetMaxLength(const Value: Integer);
    procedure SetReadOnly(const Value: Boolean);
    procedure SetEditStyle(const Value: TEditStyle);
    procedure SetPickList(const Value: TStrings);
    procedure SetKeyDesc(const Value: string);
  protected
    procedure AssignTo(Dest: TPersistent); override;
    procedure UpdateEdit;
  public
    constructor Create(AEditor: TValueListEditor);
    destructor Destroy; override;
    function HasPickList: Boolean;
  published
    property EditMask: string read FEditMask write SetEditMask;
    property EditStyle: TEditStyle read FEditStyle write SetEditStyle;
    property KeyDesc: string read FKeyDesc write SetKeyDesc;
    property PickList: TStrings read GetPickList write SetPickList;
    property MaxLength: Integer read FMaxLength write SetMaxLength;
    property ReadOnly: Boolean read FReadOnly write SetReadOnly;
  end;

implementation

uses Forms, Dialogs, TypInfo, Variants, Consts;

{$IFDEF LINUX}
function VarTypeIsOrdinal(const VType: TVarType): Boolean;
begin
  Result := (VType and varTypeMask) in [varSmallInt, varInteger, varByte];
end;

function VarIsOrdinal(const V: Variant): Boolean;
begin
  Result := VarTypeIsOrdinal(TVarData(V).VType);
end;
{$ENDIF}

{ TValueListEditor }

constructor TValueListEditor.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FStrings := TValueListStrings.Create(Self);
  FTitleCaptions := TStringList.Create;
  FTitleCaptions.Add(SKeyCaption);
  FTitleCaptions.Add(SValueCaption);
  ColCount := 2;
  inherited RowCount := 2;
  FixedCols := 0;
  DefaultColWidth := 150;
  DefaultRowHeight := 18;
  Width := 306;
  Height := 300;
  Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
    goColSizing, goEditing, goAlwaysShowEditor, goThumbTracking];
  FDisplayOptions := [doColumnTitles, doAutoColResize, doKeyColFixed];
  Col := 1;
  FDropDownRows := 8;
end;

destructor TValueListEditor.Destroy;
begin
  inherited;
  FTitleCaptions.Free;
  FStrings.Free;
end;

function TValueListEditor.CreateEditor: TInplaceEdit;
begin
  FEditList := TInplaceEditList.Create(Self);
  EditList.DropDownRows := FDropDownRows;
  EditList.OnEditButtonClick := FOnEditButtonClick;
  EditList.OnGetPickListitems := EditListGetItems;
  Result := FEditList;
end;

{ Helper Functions }

function FormatLine(const Key, Value: string): string;
begin
  Result := Format('%s=%s', [Key, Value]);
end;

function TValueListEditor.IsEmptyRow: Boolean;
begin
  Result := ((Row - FixedRows) < Strings.Count) and
    (Cells[0, Row] = '') and (Cells[1, Row] = '');
end;

function TValueListEditor.FindRow(const KeyName: string;
  var Row: Integer): Boolean;
begin
  Row := Strings.IndexOfName(KeyName);
  Result := Row <> -1;
  if Result then Inc(Row, FixedRows);
end;

{ Property Set/Get }

function TValueListEditor.GetColCount: Integer;
begin
  Result := inherited ColCount;
end;

function TValueListEditor.GetRowCount: Integer;
begin
  Result := inherited RowCount;
end;

function TValueListEditor.GetCell(ACol, ARow: Integer): string;
var
  Index: Integer;
  ValPos: Integer;
begin
  if (ARow = 0) and (doColumnTitles in DisplayOptions) then
  begin
    if ACol < FTitleCaptions.Count then
      Result := FTitleCaptions[ACol] else
      Result := '';
  end
  else if Strings.Count = 0 then
    Result := ''
  else
  begin
    Index := ARow - FixedRows;
    if ACol = 0 then
      Result := Strings.Names[Index]
    else
    begin
      Result := Strings.Strings[Index];
      ValPos := Pos('=', Result);
      if ValPos > 0 then
        Delete(Result, 1, ValPos);
    end;
  end;
end;

procedure TValueListEditor.SetCell(ACol, ARow: Integer;
  const Value: string);
var
  Index: Integer;
  Line: string;
begin
  Index := ARow - FixedRows;
  if ACol = 0 then
    Line := FormatLine(Value, Cells[1, ARow]) else
    Line := FormatLine(Cells[0, ARow], Value);
  if Index >= Strings.Count then
    Strings.Add(Line) else
    Strings[Index] := Line;
end;

procedure TValueListEditor.SetDropDownRows(const Value: Integer);
begin
  FDropDownRows := Value;
  if Assigned(EditList) then
    EditList.DropDownRows := Value;
end;

function TValueListEditor.GetKey(Index: Integer): string;
begin
  Result := GetCell(0, Index);
end;