valedit.pas

这是不可多得的源代码

procedure TValueListEditor.RowMoved(FromIndex, ToIndex: Longint);
begin
  Strings.Move(FromIndex, ToIndex);
  inherited RowMoved(FromIndex, ToIndex);
end;

procedure TValueListEditor.DoOnValidate;
begin
  if Assigned(FOnValidate) and InplaceEditor.Modified then
  begin
    FOnValidate(Self, Col, Row, GetCell(0, Row), GetCell(1, Row)); ///!!!
  end;
end;

function TValueListEditor.SelectCell(ACol, ARow: Integer): Boolean;
begin
  { Delete any blank rows when moving to a new row }
  if (ARow <> Row) and (Strings.Count > 0) and IsEmptyRow and not FDeleting then
  begin
    Result := (ARow < Row);
    DeleteRow(Row);
    { When the selected cell is below, we need to adjust for the deletion }
    if not Result then
      FocusCell(ACol, ARow - 1, True);
  end else
  begin
    DoOnValidate;
    Result := inherited SelectCell(ACol, ARow) and
              ((goRowSelect in Options) or (keyEdit in KeyOptions) or (ACol > 0));
  end;
end;

procedure TValueListEditor.KeyDown(var Key: Word; Shift: TShiftState);

  function InsertOK: Boolean;
  begin
    Result := (Length(Cells[0, Row]) > 0) and (keyAdd in KeyOptions)
  end;

  procedure SetRow(NewRow: Integer);
  begin
    Row := NewRow;
    Key := 0;
  end;

begin
  case Key of
    VK_DOWN:
      if Shift = [ssCtrl] then
        SetRow(RowCount - 1)
      else if (Shift = []) and (Row = RowCount - 1) and InsertOK then
        SetRow(InsertRow('', '', True));
    VK_UP:
      if Shift = [ssCtrl] then SetRow(FixedRows);
    VK_INSERT:
      if InsertOK then SetRow(InsertRow('', '', False));
    VK_DELETE:
      if (Shift = [ssCtrl]) and (keyDelete in KeyOptions) then
      begin
        DeleteRow(Row);
        Key := 0;
      end;
    VK_ESCAPE:
      RestoreCurrentRow;
  end;
  inherited KeyDown(Key, Shift);
end;


function TValueListEditor.GetOptions: TGridOptions;
begin
  Result := inherited Options;
end;

procedure TValueListEditor.SetOptions(const Value: TGridOptions);
begin
  if goColMoving in Value then
    raise Exception.CreateRes(@SNoColumnMoving);
  inherited Options := Value;
end;

procedure TValueListEditor.CreateWnd;
begin
  inherited;
  { Clear the default vertical scrollbar since this will affect the client
    width of the control which will cause problems when calculating the
    column widths in the AdjustColWidths function }
  SetScrollRange(Handle, SB_VERT, 0, 0, False);
end;

procedure TValueListEditor.DoExit;
begin
  try
    DoOnValidate;
  except
    SetFocus;
    raise;
  end;
  inherited;
  HideEdit;
end;

procedure TValueListEditor.CMShowingChanged(var Message: TMessage);
begin
  inherited;
  if Showing then
    AdjustColWidths;
end;

{ TValueListStrings }

constructor TValueListStrings.Create(AEditor: TValueListEditor);
begin
  FEditor := AEditor;
  inherited Create;
end;

procedure TValueListStrings.Assign(Source: TPersistent);
var
  I: Integer;
  ItemProp: TItemProp;
  SrcStrings: TStrings;
  ValStrings: TValueListStrings;
begin
  inherited;
  if Source is TValueListStrings then
  begin
    ValStrings := TValueListStrings(Source);
    for I := 0 to Count - 1 do
    begin
      ItemProp := ValStrings.FindItemProp(I);
      if Assigned(ItemProp) then
        ItemProps[I] := ItemProp;
    end;
  end
  else if Source is TStrings then
  begin
    SrcStrings := TStrings(Source);
    { See if the source strings have TItemProp clases stored in the data }
    for I := 0 to Count - 1 do
    begin
      if (SrcStrings.Objects[I] <> nil) and
          (SrcStrings.Objects[I] is TItemProp) then
        ItemProps[I] := TItemProp(SrcStrings.Objects[I]);
    end;
  end;
end;

procedure TValueListStrings.Changing;
begin
  inherited;
  if (UpdateCount = 0) and Assigned(FEditor) and (FEditor.FEditUpdate = 0) then
    FEditor.StringsChanging;
end;

procedure TValueListStrings.Changed;
begin
  inherited;
  if (UpdateCount = 0) and Assigned(FEditor) then
    FEditor.Refresh;
end;

function TValueListStrings.KeyIsValid(const Key: string; RaiseError: Boolean = True): Boolean;
var
  Index: Integer;
begin
  Result := True;
  if Pos('=', Key) <> 0 then
    raise Exception.CreateRes(@SNoEqualsInKey);
  if Assigned(FEditor) and (keyUnique in FEditor.KeyOptions) then
  begin
    if Key <> '' then
    begin
      Index := IndexOfName(Key);
      Result := (Index = -1);
      if not Result and RaiseError then
        raise Exception.CreateResFmt(@SKeyConflict, [Key]);
    end;
  end;
end;

procedure TValueListStrings.Clear;
var
  I: Integer;
begin
  inherited;
  for I := 0 to Length(FItemProps) - 1 do
    FItemProps[I].Free;
  SetLength(FItemProps, 0);
end;

procedure TValueListStrings.CustomSort(Compare: TStringListSortCompare);
var
  I, OldIndex: Integer;
  OldOrder: TList;
  OldProps: TItemProps;
begin
  OldOrder := TList.Create;
  try
    { Preserve the existing order so we can re-associate the ItemProps }
    OldOrder.Count := Count;
    OldProps := Copy(FItemProps, 0, Count);
    for I := 0 to Count - 1 do
      OldOrder[I] := Pointer(Get(I));
    { Do the Sort }
    inherited;
    { Find and move the ItemProps }
    for I := 0 to Count - 1 do
    begin
      OldIndex := OldOrder.IndexOf(Pointer(Get(I)));
      FItemProps[I] := OldProps[OldIndex];
    end;
  finally
    OldOrder.Free;
  end;
  FEditor.InvalidateEditor;
end;

procedure TValueListStrings.Delete(Index: Integer);
begin
  Changing;
  inherited;
  FItemProps[Index].Free;
  if Index < Count then
    System.Move(FItemProps[Index + 1], FItemProps[Index],
      (Count - Index) * SizeOf(TItemProp));
  SetLength(FItemProps, Count);
  Changed;
end;

procedure TValueListStrings.Exchange(Index1, Index2: Integer);
var
  Item: TItemProp;
begin
  Changing;
  inherited;
  Item := FItemProps[Index1];
  FItemProps[Index1] := FItemProps[Index2];
  FItemProps[Index2] := Item;
  Changed;
end;

function TValueListStrings.FindItemProp(const KeyOrIndex: Variant;
  Create: Boolean = False): TItemProp;
var
  Index: Integer;
begin
  if Count > 0 then
  begin
    if VarIsOrdinal(KeyOrIndex) then
      Index := KeyOrIndex
    else
    begin
      Index := IndexOfName(KeyOrIndex);
      if Create and (Index = -1) then
        raise Exception.CreateResFmt(@SKeyNotFound, [KeyOrIndex]);
    end;
    Result := FItemProps[Index];
    if Create and not Assigned(Result) then
    begin
      Result := TItemProp.Create(FEditor);
      FItemProps[Index] := Result;
    end;
  end
  else
    Result := nil;
end;

procedure TValueListStrings.InsertItem(Index: Integer; const S: string;
  AObject: TObject);
var
  OldCount: Integer;
begin
  KeyIsValid(ExtractName(S));
  Changing;
  OldCount := Count;
  inherited;
  SetLength(FItemProps, Count);
  if Index < OldCount then
    System.Move(FItemProps[Index], FItemProps[Index + 1],
      (OldCount - Index) * SizeOf(TItemProp));
  FItemProps[Index] := nil;
  Changed;
end;

function TValueListStrings.GetItemProp(const KeyOrIndex: Variant): TItemProp;
begin
  Result := FindItemProp(KeyOrIndex, True);
end;

procedure TValueListStrings.Put(Index: Integer; const S: String);
var
  Name: string;
begin
  Name := ExtractName(S);
  KeyIsValid(Name, IndexOfName(Name) <> Index);
  inherited;
end;

procedure TValueListStrings.PutItemProp(const KeyOrIndex: Variant;
  const Value: TItemProp);
begin
  FindItemProp(KeyOrIndex, True).Assign(Value);
end;

{ TItemProp }

constructor TItemProp.Create(AEditor: TValueListEditor);
begin
  FEditor := AEditor;
end;

destructor TItemProp.Destroy;
begin
  inherited;
  FPickList.Free;
end;

procedure TItemProp.AssignTo(Dest: TPersistent);
begin
  if Dest is TItemProp then
    with Dest as TItemProp do
    begin
      EditMask := Self.EditMask;
      EditStyle := Self.EditStyle;
      PickList.Assign(Self.PickList);
      MaxLength := Self.MaxLength;
      ReadOnly := Self.ReadOnly;
      KeyDesc := Self.KeyDesc;
    end
  else
    inherited;
end;

procedure TItemProp.SetEditMask(const Value: string);
begin
  FEditMask := Value;
  UpdateEdit;
end;

procedure TItemProp.SetEditStyle(const Value: TEditStyle);
begin
  FEditStyle := Value;
  UpdateEdit;
end;

procedure TItemProp.SetKeyDesc(const Value: string);
begin
  FKeyDesc := Value;
end;

procedure TItemProp.SetMaxLength(const Value: Integer);
begin
  FMaxLength := Value;
  UpdateEdit;
end;

function TItemProp.HasPickList: Boolean;
begin
  Result := Assigned(FPickList) and (FPickList.Count > 0);
end;

function TItemProp.GetPickList: TStrings;
begin
  if not Assigned(FPickList) then
  begin
    FPickList := TStringList.Create;
    TStringList(FPickList).OnChange := PickListChange;
  end;
  Result := FPickList;
end;

procedure TItemProp.SetPickList(const Value: TStrings);
begin
  GetPickList.Assign(Value);
  UpdateEdit;
end;

procedure TItemProp.SetReadOnly(const Value: Boolean);
begin
  FReadOnly := Value;
  UpdateEdit;
end;

procedure TItemProp.UpdateEdit;
begin
  if Assigned(FEditor) and FEditor.EditorMode and
     (FEditor.FStrings.UpdateCount = 0) then
    FEditor.InvalidateEditor;
end;

procedure TItemProp.PickListChange(Sender: TObject);
begin
  if (EditStyle = esSimple) and (PickList.Count > 0) then
    EditStyle := esPickList
  else if (EditStyle = esPickList) and (PickList.Count = 0) then
    EditStyle := esSimple;
end;

end.