unitasdbgrids.pas

仿速达界面控件

  if DoSetWidth then
  begin
    if ((cvWidth in FAssignedValues) or (Value <> DefaultWidth))
      and (Value <> -1) then
    begin
      FWidth := Value;
      Include(FAssignedValues, cvWidth);
    end;
    Changed(False);
  end;
end;

procedure TColumn.SetVisible(Value: Boolean);
begin
  if Value <> FVisible then
  begin
    FVisible := Value;
    Changed(True);
  end;
end;

procedure TColumn.SetExpanded(Value: Boolean);
const
  Direction         : array[Boolean] of ShortInt = (-1, 1);
var
  Grid              : TCustomASDBGrid;
  WasShowing        : Boolean;
begin
  if Value <> FExpanded then
  begin
    Grid := GetGrid;
    WasShowing := (Grid <> nil) and Grid.Columns[Grid.SelectedIndex].Showing;
    FExpanded := Value;
    Changed(True);
    if (Grid <> nil) and WasShowing then
    begin
      if not Grid.Columns[Grid.SelectedIndex].Showing then
        // The selected cell was hidden by this expand operation
        // Select 1st child (next col = 1) when parent is expanded
        // Select child's parent (prev col = -1) when parent is collapsed
        Grid.MoveCol(Grid.Col, Direction[FExpanded]);
    end;
  end;
end;

function TColumn.Depth: Integer;
var
  Col               : TColumn;
begin
  Result := 0;
  Col := ParentColumn;
  if Col <> nil then
    Result := Col.Depth + 1;
end;

function TColumn.GetExpandable: Boolean;
var
  Fld               : TField;
begin
  Fld := Field;
  Result := (Fld <> nil) and (Fld.DataType in [ftADT, ftArray]);
end;

procedure TColumn.SetChineseCurrencyStyle(const Value: Boolean);
begin
  if FChineseCurrencyStyle <> Value then
  begin
    FChineseCurrencyStyle := Value;
    //if Value then
    //  FButtonStyle := cbsNone;
    Changed(False);
  end;
end;

function TColumn.GetCurrencySymbol: WideString;
begin
  Result := FCurrencySymbol;
end;

procedure TColumn.SetCurrencySymbol(const Value: WideString);
begin
  if Value <> '' then
    FCurrencySymbol := Value[1];
end;

procedure TColumn.SetRowNumber(const Value: Boolean);
begin
  if FRowNumber <> Value then
  begin
    if Value then
      ReadOnly := True;
    FRowNumber := Value;
    if Grid.Showing then
      Grid.Invalidate;
  end;
end;

procedure TColumn.SetRowNumberFrom(const Value: Integer);
begin
  if FRowNumberFrom <> Value then
  begin
    FRowNumberFrom := Value;
    if Grid.Showing then
      Grid.Invalidate;
  end;
end;

function TColumn.GetButtonStyle: TColumnButtonStyle;
begin
  if FChineseCurrencyStyle then
    Result := cbsNone
  else
    Result := FButtonStyle;
end;

{ TASDBGridColumns }

constructor TASDBGridColumns.Create(Grid: TCustomASDBGrid; ColumnClass:
  TColumnClass);
begin
  inherited Create(ColumnClass);
  FGrid := Grid;
end;

function TASDBGridColumns.Add: TColumn;
begin
  Result := TColumn(inherited Add);
end;

function TASDBGridColumns.GetColumn(Index: Integer): TColumn;
begin
  Result := TColumn(inherited Items[Index]);
end;

function TASDBGridColumns.GetOwner: TPersistent;
begin
  Result := FGrid;
end;

procedure TASDBGridColumns.LoadFromFile(const Filename: string);
var
  S                 : TFileStream;
begin
  S := TFileStream.Create(Filename, fmOpenRead);
  try
    LoadFromStream(S);
  finally
    S.Free;
  end;
end;

type
  TColumnsWrapper = class(TComponent)
  private
    FColumns: TASDBGridColumns;
  published
    property Columns: TASDBGridColumns read FColumns write FColumns;
  end;

procedure TASDBGridColumns.LoadFromStream(S: TStream);
var
  Wrapper           : TColumnsWrapper;
begin
  Wrapper := TColumnsWrapper.Create(nil);
  try
    Wrapper.Columns := FGrid.CreateColumns;
    S.ReadComponent(Wrapper);
    Assign(Wrapper.Columns);
  finally
    Wrapper.Columns.Free;
    Wrapper.Free;
  end;
end;

procedure TASDBGridColumns.RestoreDefaults;
var
  I                 : Integer;
begin
  BeginUpdate;
  try
    for I := 0 to Count - 1 do
      Items[I].RestoreDefaults;
  finally
    EndUpdate;
  end;
end;

procedure TASDBGridColumns.RebuildColumns;

  procedure AddFields(Fields: TFields; Depth: Integer);
  var
    I               : Integer;
  begin
    Inc(Depth);
    for I := 0 to Fields.Count - 1 do
    begin
      Add.FieldName := Fields[I].FullName;
      if Fields[I].DataType in [ftADT, ftArray] then
        AddFields((Fields[I] as TObjectField).Fields, Depth);
    end;
  end;

begin
  if Assigned(FGrid) and Assigned(FGrid.DataSource) and
    Assigned(FGrid.Datasource.Dataset) then
  begin
    FGrid.BeginLayout;
    try
      Clear;
      AddFields(FGrid.Datasource.Dataset.Fields, 0);
    finally
      FGrid.EndLayout;
    end
  end
  else
    Clear;
end;

procedure TASDBGridColumns.SaveToFile(const Filename: string);
var
  S                 : TStream;
begin
  S := TFileStream.Create(Filename, fmCreate);
  try
    SaveToStream(S);
  finally
    S.Free;
  end;
end;

procedure TASDBGridColumns.SaveToStream(S: TStream);
var
  Wrapper           : TColumnsWrapper;
begin
  Wrapper := TColumnsWrapper.Create(nil);
  try
    Wrapper.Columns := Self;
    S.WriteComponent(Wrapper);
  finally
    Wrapper.Free;
  end;
end;

procedure TASDBGridColumns.SetColumn(Index: Integer; Value: TColumn);
begin
  Items[Index].Assign(Value);
end;

procedure TASDBGridColumns.SetState(NewState: TASDBGridColumnsState);
begin
  if NewState = State then
    Exit;
  if NewState = csDefault then
    Clear
  else
    RebuildColumns;
end;

procedure TASDBGridColumns.Update(Item: TCollectionItem);
var
  Raw               : Integer;
begin
  if (FGrid = nil) or (csLoading in FGrid.ComponentState) then
    Exit;
  if Item = nil then
  begin
    FGrid.LayoutChanged;
  end
  else
  begin
    Raw := FGrid.DataToRawColumn(Item.Index);
    FGrid.InvalidateCol(Raw);
    FGrid.ColWidths[Raw] := TColumn(Item).Width;
  end;
end;

function TASDBGridColumns.InternalAdd: TColumn;
begin
  Result := Add;
  Result.IsStored := False;
end;

function TASDBGridColumns.GetState: TASDBGridColumnsState;
begin
  Result := TASDBGridColumnsState((Count > 0) and Items[0].IsStored);
end;

{ TBookmarkList }

constructor TBookmarkList.Create(AGrid: TCustomASDBGrid);
begin
  inherited Create;
  FList := TStringList.Create;
  FList.OnChange := StringsChanged;
  FGrid := AGrid;
end;

destructor TBookmarkList.Destroy;
begin
  Clear;
  FList.Free;
  inherited Destroy;
end;

procedure TBookmarkList.Clear;
begin
  if FList.Count = 0 then
    Exit;
  FList.Clear;
  FGrid.Invalidate;
end;

function TBookmarkList.Compare(const Item1, Item2: TBookmarkStr): Integer;
begin
  with FGrid.Datalink.Datasource.Dataset do
    Result := CompareBookmarks(TBookmark(Item1), TBookmark(Item2));
end;

function TBookmarkList.CurrentRow: TBookmarkStr;
begin
  if not FLinkActive then
    RaiseGridError(sDataSetClosed);
  Result := FGrid.Datalink.Datasource.Dataset.Bookmark;
end;

function TBookmarkList.GetCurrentRowSelected: Boolean;
var
  Index             : Integer;
begin
  Result := Find(CurrentRow, Index);
end;

function TBookmarkList.Find(const Item: TBookmarkStr; var Index: Integer):
  Boolean;
var
  L, H, I, C        : Integer;
begin
  if (Item = FCache) and (FCacheIndex >= 0) then
  begin
    Index := FCacheIndex;
    Result := FCacheFind;
    Exit;
  end;
  Result := False;
  L := 0;
  H := FList.Count - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    C := Compare(FList[I], Item);
    if C < 0 then
      L := I + 1
    else
    begin
      H := I - 1;
      if C = 0 then
      begin
        Result := True;
        L := I;
      end;
    end;
  end;
  Index := L;
  FCache := Item;
  FCacheIndex := Index;
  FCacheFind := Result;
end;

function TBookmarkList.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TBookmarkList.GetItem(Index: Integer): TBookmarkStr;
begin
  Result := FList[Index];
end;

function TBookmarkList.IndexOf(const Item: TBookmarkStr): Integer;
begin
  if not Find(Item, Result) then
    Result := -1;
end;

procedure TBookmarkList.LinkActive(Value: Boolean);
begin
  Clear;
  FLinkActive := Value;
end;

procedure TBookmarkList.Delete;
var
  I                 : Integer;
begin
  with FGrid.Datalink.Datasource.Dataset do
  begin
    DisableControls;
    try
      for I := FList.Count - 1 downto 0 do
      begin
        Bookmark := FList[I];
        Delete;
        FList.Delete(I);
      end;
    finally
      EnableControls;
    end;
  end;
end;

function TBookmarkList.Refresh: Boolean;
var
  I                 : Integer;
begin
  Result := False;
  with FGrid.DataLink.Datasource.Dataset do
  try
    CheckBrowseMode;
    for I := FList.Count - 1 downto 0 do
      if not BookmarkValid(TBookmark(FList[I])) then
      begin
        Result := True;
        FList.Delete(I);
      end;
  finally
    UpdateCursorPos;
    if Result then
      FGrid.Invalidate;
  end;
end;

procedure TBookmarkList.SetCurrentRowSelected(Value: Boolean);
var
  Index             : Integer;
  Current           : TBookmarkStr;
begin
  Current := CurrentRow;
  if (Length(Current) = 0) or (Find(Current, Index) = Value) then
    Exit;
  if Value then
    FList.Insert(Index, Current)
  else
    FList.Delete(Index);
  FGrid.InvalidateRow(FGrid.Row);
end;

procedure TBookmarkList.StringsChanged(Sender: TObject);
begin
  FCache := '';
  FCacheIndex := -1;
end;

{ TCustomASDBGrid }

var
  DrawBitmap        : TBitmap;
  UserCount         : Integer;

procedure UsesBitmap;
begin
  if UserCount = 0 then
    DrawBitmap := TBitmap.Create;
  Inc(UserCount);
end;

procedure ReleaseBitmap;
begin
  D