rxdbctrl.pas

修改后的RxLib控件源码

  finally
    StrDispose(Row);
  end;
end;

function TBookmarkList.Find(const Item: TBookmark; var Index: Longint): Boolean;
var
  L, H, I, C: Longint;
  P: PChar;
begin
  if (Compare(Item, FCache) = 0) 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(TBookmark(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;
  StrDispose(FCache);
  FCache := nil;
  P := PChar(Item);
  if P <> nil then begin
    Dec(P, 2);
    FCache := StrAlloc(Word(Pointer(P)^));
    Move(Item^, FCache^, Word(Pointer(P)^));
  end;
  FCacheIndex := Index;
  FCacheFind := Result;
end;

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

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

function TBookmarkList.IndexOf(const Item: TBookmark): Longint;
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: Longint;
begin
  with TRxDBGrid(FGrid).Datalink.Dataset do begin
    DisableControls;
    try
      for I := FList.Count - 1 downto 0 do begin
        if FList[I] <> nil then begin
          GotoBookmark(TBookmark(FList[I]));
          Delete;
          StrDispose(FList[I]);
        end;
        FList.Delete(I);
      end;
      ListChanged;
    finally
      EnableControls;
    end;
  end;
end;

function TBookmarkList.Refresh: Boolean;
var
  I: Longint;
begin
  Result := False;
  with TRxDBGrid(FGrid).DataLink.Dataset do
  try
    CheckBrowseMode;
    for I := FList.Count - 1 downto 0 do
      if DbiSetToBookmark(Handle, Pointer(FList[I])) <> 0 then begin
        Result := True;
        StrDispose(FList[I]);
        FList.Delete(I);
      end;
    ListChanged;
  finally
    UpdateCursorPos;
    if Result then FGrid.Invalidate;
  end;
end;

procedure TBookmarkList.SetCurrentRowSelected(Value: Boolean);
var
  Index: Longint;
  Current: TBookmark;
begin
  Current := CurrentRow;
  Index := 0;
  if (Current = nil) or (Find(Current, Index) = Value) then begin
    if Current <> nil then StrDispose(Current);
    Exit;
  end;
  if Value then begin
    try
      FList.Insert(Index, Current);
    except
      StrDispose(Current);
      raise;
    end;
  end
  else begin
    if (Index < FList.Count) and (Index >= 0) then begin
      StrDispose(FList[Index]);
      FList.Delete(Index);
    end;
    StrDispose(Current);
  end;
  ListChanged;
  TRxDBGrid(FGrid).InvalidateRow(TRxDBGrid(FGrid).Row);
  GridInvalidateRow(TRxDBGrid(FGrid), TRxDBGrid(FGrid).Row);
end;

procedure TBookmarkList.ListChanged;
begin
  if FCache <> nil then StrDispose(FCache);
  FCache := nil;
  FCacheIndex := -1;
end;

{$ENDIF WIN32}

type
  TBookmarks = class(TBookmarkList);

{ TRxDBGrid }

constructor TRxDBGrid.Create(AOwner: TComponent);
var
  Bmp: TBitmap;
begin
  inherited Create(AOwner);
  inherited DefaultDrawing := False;
  Options := DefRxGridOptions;
  Bmp := TBitmap.Create;
  try
    Bmp.Handle := LoadBitmap(hInstance, bmMultiDot);
{$IFDEF WIN32}
    FMsIndicators := TImageList.CreateSize(Bmp.Width, Bmp.Height);
{$ELSE}
    FMsIndicators := TImageList.Create(Bmp.Width, Bmp.Height);
    Bmp.Monochrome := False;
{$ENDIF}
    FMsIndicators.AddMasked(Bmp, clWhite);
    Bmp.Handle := LoadBitmap(hInstance, bmMultiArrow);
{$IFNDEF WIN32}
    Bmp.Monochrome := False;
{$ENDIF}
    FMsIndicators.AddMasked(Bmp, clWhite);
  finally
    Bmp.Free;
  end;
  FIniLink := TIniLink.Create;
  FIniLink.OnSave := IniSave;
  FIniLink.OnLoad := IniLoad;
  FShowGlyphs := True;
  FDefaultDrawing := True;
  FClearSelection := True;
{$IFNDEF WIN32}
  FBookmarks := TBookmarkList.Create(Self);
  FPressedCol := -1;
{$ENDIF}
  //牟孝金
  FTitleExtended := False;
  FTitleLines := 1;
  FTitleLineColor := clGray;
  FTitleColor := clBtnFace;
  
end;

destructor TRxDBGrid.Destroy;
begin
  FIniLink.Free;
{$IFNDEF WIN32}
  if FSelectionAnchor <> nil then StrDispose(FSelectionAnchor);
  FSelectionAnchor := nil;
  FBookmarks.Free;
  FBookmarks := nil;
{$ENDIF}
  FMsIndicators.Free;
  inherited Destroy;
end;

function TRxDBGrid.GetImageIndex(Field: TField): Integer;
var
  AOnGetText: TFieldGetTextEvent;
  AOnSetText: TFieldSetTextEvent;
begin
  Result := -1;
  if FShowGlyphs and Assigned(Field) then begin
    if (not ReadOnly) and Field.CanModify then begin
      { Allow editing of memo fields if OnSetText and OnGetText
        events are assigned }
      AOnGetText := Field.OnGetText;
      AOnSetText := Field.OnSetText;
      if Assigned(AOnSetText) and Assigned(AOnGetText) then Exit;
    end;
    case Field.DataType of
      ftBytes, ftVarBytes, ftBlob: Result := Ord(gpBlob);
      ftMemo: Result := Ord(gpMemo);
      ftGraphic: Result := Ord(gpPicture);
{$IFDEF WIN32}
      ftTypedBinary: Result := Ord(gpBlob);
      ftFmtMemo: Result := Ord(gpMemo);
      ftParadoxOle, ftDBaseOle: Result := Ord(gpOle);
{$ENDIF}
{$IFDEF RX_D3}
      ftCursor: Result := Ord(gpData);
{$ENDIF}
{$IFDEF RX_D4}
      ftReference, ftDataSet: Result := Ord(gpData);
{$ENDIF}
{$IFDEF RX_D5}
      ftOraClob: Result := Ord(gpMemo);
      ftOraBlob: Result := Ord(gpBlob);
{$ENDIF}
    end;
  end;
end;

function TRxDBGrid.ActiveRowSelected: Boolean;
var
{$IFDEF WIN32}
  Index: Integer;
{$ELSE}
  Index: Longint;
  Bookmark: TBookmark;
{$ENDIF}
begin
  Result := False;
  if MultiSelect and Datalink.Active then begin
{$IFDEF WIN32}
    Result := SelectedRows.Find(Datalink.DataSet.Bookmark, Index);
{$ELSE}
    Bookmark := Datalink.Dataset.GetBookmark;
    try
      Result := SelectedRows.Find(Bookmark, Index);
    finally
      StrDispose(Bookmark);
    end;
{$ENDIF}
  end;
end;

function TRxDBGrid.HighlightCell(DataCol, DataRow: Integer;
  const Value: string; AState: TGridDrawState): Boolean;
begin
  Result := ActiveRowSelected;
  if not Result then
    Result := inherited HighlightCell(DataCol, DataRow, Value, AState);
end;

procedure TRxDBGrid.ToggleRowSelection;
begin
  if MultiSelect and Datalink.Active then
    with SelectedRows do CurrentRowSelected := not CurrentRowSelected;
end;

function TRxDBGrid.GetSelCount: Longint;
begin
  if MultiSelect and (Datalink <> nil) and Datalink.Active then
    Result := SelectedRows.Count
  else Result := 0;
end;

procedure TRxDBGrid.SelectAll;
var
  ABookmark: TBookmark;
begin
  if MultiSelect and DataLink.Active then begin
    with Datalink.Dataset do begin
      if (BOF and EOF) then Exit;
      DisableControls;
      try
        ABookmark := GetBookmark;
        try
          First;
          while not EOF do begin
            SelectedRows.CurrentRowSelected := True;
            Next;
          end;
        finally
          try
            GotoBookmark(ABookmark);
          except
          end;
          FreeBookmark(ABookmark);
        end;
      finally
        EnableControls;
      end;
    end;
  end;
end;

procedure TRxDBGrid.UnselectAll;
begin
  if MultiSelect then begin
    SelectedRows.Clear;
    FSelecting := False;
  end;
end;

procedure TRxDBGrid.GotoSelection(Index: Longint);
begin
  if MultiSelect and DataLink.Active and (Index < SelectedRows.Count) and
    (Index >= 0) then
    Datalink.DataSet.GotoBookmark(Pointer(SelectedRows[Index]));
end;

{$IFNDEF WIN32}
function TRxDBGrid.GetIndicatorOffset: Byte;
begin
  Result := 0;
  if dgIndicator in Options then Inc(Result);
end;
{$ENDIF WIN32}

procedure TRxDBGrid.LayoutChanged;
var
  ACol: Longint;
begin
  ACol := Col;
  inherited LayoutChanged;
  if Datalink.Active and (FixedCols > 0) then
{$IFDEF RX_D4}
    Col := Min(Max(CalcLeftColumn, ACol), ColCount - 1);
{$ELSE}
    Col := Min(Max(inherited FixedCols, ACol), ColCount - 1);
{$ENDIF}
end;

{$IFDEF WIN32}
procedure TRxDBGrid.ColWidthsChanged;
var
  ACol: Longint;
begin
  ACol := Col;
  inherited ColWidthsChanged;
  if Datalink.Active and (FixedCols > 0) then
{$IFDEF RX_D4}
    Col := Min(Max(CalcLeftColumn, ACol), ColCount - 1);
{$ELSE}
    Col := Min(Max(inherited FixedCols, ACol), ColCount - 1);
{$ENDIF}
end;
{$ENDIF}

function TRxDBGrid.CreateEditor: TInplaceEdit;
begin
  Result := inherited CreateEditor;
  TEdit(Result).OnChange := EditChanged;
end;

function TRxDBGrid.GetTitleOffset: Byte;
{$IFDEF RX_D4}
var
  I, J: Integer;
{$ENDIF}
begin
  Result := 0;
  if dgTitles in Options then begin
    Result := 1;
{$IFDEF RX_D4}
    if (Datalink <> nil) and (Datalink.Dataset <> nil) and
      Datalink.Dataset.ObjectView then
    begin
      for I := 0 to Columns.Count - 1 do begin
        if Columns[I].Showing then begin
          J := Columns[I].Depth;
          if J >= Result then Result := J + 1;
        end;
      end;
    end;
{$ENDIF}
  end;
end;


procedure TRxDBGrid.SetTitleLines(Value: Integer);
begin
  if (FTitleLines <> Value) and (Value > 0) then
    begin
    FTitleLines := Value;
    if FTitleExtended then SetColumnAttributes;
    end;
end;

procedure TRxDBGrid.SetTitleLineColor(Value: TColor);
begin
  if FTitleLineColor <> Value then
    begin
    FTitleLineColor := Value;
    if FTitleExtended then Invalidate;
    end;
end;

procedure TRxDBGrid.SetTitleColor(Value: TColor);
begin
  if FTitleColor <> Value then
    begin
    FTitleColor := Value;
    if FTitleExtended then Invalidate;
    end;
end;

procedure TRxDBGrid.SetTitleExtended(Value: Boolean);
begin
  if (FTitleExtended <> Value) then
  begin
    FTitleExtended := Value;
    if FTitleExtended then
    begin
      FTitleButtons := False;
      //FFixedBorder := False;
    end;
    //FFixedBorder := not FTitleExtended;
    SetColumnAttributes;
  end;
end;

procedure TRxDBGrid.SetColumnAttributes;
var
 I, J, K, N: Integer;
begin
  inherited SetColumnAttributes;
  SetFixedCols(FFixedCols);