dblookupgridseh.pas

自己做的用delphi开发的学生成绩管理系统。

        begin
          ListLink.ActiveRecord := Result;
          FieldValue := ListLink.DataSet.FieldValues[FKeyFieldName]; //  FKeyField.Value;
          if VarEquals(FieldValue, KeyValue) then
          begin
            Exit;
            ListLink.ActiveRecord := ActiveRecord;
          end;
        end;
    finally
      ListLink.ActiveRecord := ActiveRecord;
    end;
    Result := -1;
  end;
begin
  if not FInplaceSearchingInProcess then
    StopInplaceSearch;
  FKeyRowVisible := False;
  if ListLink.Active and HandleAllocated and not (csLoading in ComponentState) then
  begin
    NewRow := GetKeyRowIndex;
    if NewRow >= 0 then
    begin
      Inc(NewRow, TopDataOffset);
      if Row <> NewRow then
      begin
        if not (dgAlwaysShowEditor in inherited Options) then HideEditor;
        MoveColRow(Col, NewRow, False, False);
        InvalidateEditor;
      end;
//      Field := SelectedField;
  //    if Assigned(Field) and (Field.Text <> FEditText) then
  //      InvalidateEditor;
      FKeyRowVisible := True;
    end
  end;
end;

function TDBLookupGridEh.GetKeyIndex: Integer;
var
  FieldValue: Variant;
begin
  if not VarIsNull(KeyValue) then
    for Result := 0 to FRecordCount - 1 do
    begin
      ListLink.ActiveRecord := Result;
      FieldValue := ListLink.DataSet.FieldValues[FKeyFieldName]; //  FKeyField.Value;
      ListLink.ActiveRecord := FRecordIndex;
      if VarEquals(FieldValue, KeyValue) then Exit;
    end;
  Result := -1;
end;

function TDBLookupGridEh.CanDrawFocusRowRect: Boolean;
begin
  Result := FKeyRowVisible;
end;

procedure TDBLookupGridEh.KeyDown(var Key: Word; Shift: TShiftState);
var
  Delta, KeyIndex: Integer;
begin
  if CanModify then
  begin
    Delta := 0;
    case Key of
      VK_UP: Delta := -1;
      VK_LEFT: if not HorzScrollBar.IsScrollBarVisible then Delta := -1;
      VK_DOWN: Delta := 1;
      VK_RIGHT: if not HorzScrollBar.IsScrollBarVisible then Delta := 1;
      VK_PRIOR: Delta := 1 - DataRowCount;
      VK_NEXT: Delta := DataRowCount - 1;
      VK_HOME: Delta := -Maxint;
      VK_END: Delta := Maxint;
    end;
    if Delta <> 0 then
    begin
      SearchText := '';
      if (Delta < 0) and (ListLink.DataSet.Bof or SpecRow.Selected) and SpecRow.Visible then
      begin
        SelectSpecRow;
        ListLink.DataSet.First;
        Exit;
      end else if (Delta > 0) and SpecRow.Selected then
        ListLink.DataSet.First;
      if Delta = -Maxint
        then ListLink.DataSet.First
      else if Delta = Maxint
        then ListLink.DataSet.Last
      else
      begin
        KeyIndex := GetKeyIndex;
        if KeyIndex >= 0 then
          ListLink.DataSet.MoveBy(KeyIndex - FRecordIndex)
        else
        begin
          KeyValueChanged;
          Delta := 0;
        end;
        ListLink.DataSet.MoveBy(Delta);
      end;
      SelectCurrent;
    end else
      inherited KeyDown(Key, Shift);
  end else
    inherited KeyDown(Key, Shift);
end;

procedure TDBLookupGridEh.Scroll(Distance: Integer);
begin
  BeginUpdate;
  inherited Scroll(Distance);
  ListLinkDataChanged;
  EndUpdate;
end;

procedure TDBLookupGridEh.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var Cell: TGridCoord;
  ADataBox: TGridRect;
begin
  Cell := MouseCoord(X, Y);
  ADataBox := DataBox;
  if ((Cell.X >= ADataBox.Left) and (Cell.X <= ADataBox.Right) and
    (Cell.Y >= ADataBox.Top) and (Cell.Y <= ADataBox.Bottom)) or
    (SpecRow.Visible and (TopDataOffset - 1 = Cell.Y))
    then
  begin
    if Assigned(OnMouseDown) then OnMouseDown(Self, Button, Shift, X, Y);
    if Button = mbLeft then
    begin
      SearchText := '';
      if not FPopup then
      begin
        SetFocus;
        if not HasFocus then Exit;
      end;
      if CanModify then
        if ssDouble in Shift then
        begin
          if FRecordIndex = (Y - TitleRowHeight) div GetDataRowHeight then DblClick;
        end else
        begin
          if not MouseCapture then Exit;
          FTracking := True;
          FDataTracking := True;
          if Y > TitleRowHeight then
            SelectItemAt(X, Y);
        end;
    end;
  end else
{$IFDEF EH_LIB_5}inherited MouseDown(Button, Shift, X, Y){$ENDIF};
end;

procedure TDBLookupGridEh.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if FTracking and FDataTracking then
  begin
    SelectItemAt(X, Y);
    FMousePos := Y;
    TimerScroll;
    if Assigned(OnMouseMove) then OnMouseMove(Self, Shift, X, Y);
  end else
    inherited MouseMove(Shift, X, Y);
end;

procedure TDBLookupGridEh.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if FTracking and FDataTracking then
  begin
    StopTracking;
    if Y > TitleRowHeight then
      SelectItemAt(X, Y);
    if Assigned(OnMouseUp) then OnMouseUp(Self, Button, Shift, X, Y);
  end else
    inherited MouseUp(Button, Shift, X, Y);
end;

procedure TDBLookupGridEh.TimerScroll;
var
  Delta, Distance, Interval: Integer;
begin
  Delta := 0;
  Distance := 0;
  if FMousePos < 0 then
  begin
    Delta := -1;
    Distance := -FMousePos;
  end;
  if FMousePos >= ClientHeight then
  begin
    Delta := 1;
    Distance := FMousePos - ClientHeight + 1;
  end;
  if Delta = 0
    then StopTimer
  else
  begin
    if SpecRow.Visible and (FMousePos < 0) and ListLink.DataSet.Bof then
      SelectSpecRow
    else if ListLink.DataSet.MoveBy(Delta) <> 0 then SelectCurrent;
    Interval := 200 - Distance * 15;
    if Interval < 0 then Interval := 0;
//    SetTimer(Handle, 1, Interval, nil);
//    FTimerActive := True;
    ResetTimer(Interval);
  end;
end;

procedure TDBLookupGridEh.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  BorderSize, TextHeight, SpecRowHeight, Rows, AddLine: Integer;
begin
  BorderSize := GetBorderSize;
  TextHeight := GetDataRowHeight;
  SpecRowHeight := GetSpecRowHeight;
  //if ShowTitles then TitleRowHeight := RowHeights[0] else TitleRowHeight := 0;
  if Assigned(SpecRow) and SpecRow.Visible
    then FSpecRowHeight := SpecRowHeight
    else FSpecRowHeight := 0;
  Rows := (AHeight - BorderSize - TitleRowHeight - FSpecRowHeight) div TextHeight;
  if Rows < 1 then Rows := 1;
  FRowCount := Rows;
  {if Assigned(ListLink) and (ListLink.BufferCount <> Rows) then
  begin
    ListLink.BufferCount := Rows;
    ListLinkDataChanged;
  end;}
  AddLine := 0;
  if dgRowLines in inherited Options then Inc(AddLine, GridLineWidth);
  inherited SetBounds(ALeft, ATop, AWidth, Rows * TextHeight + BorderSize + TitleRowHeight + FSpecRowHeight + AddLine);
end;

function TDBLookupGridEh.GetTitleRowHeight: Integer;
begin
  if ShowTitles then Result := RowHeights[0] else Result := 0;
end;

procedure TDBLookupGridEh.UpdateScrollBar;
var
  Pos, Max: Integer;
  Page: Cardinal;
  ScrollInfo: TScrollInfo;
begin
  if not HandleAllocated then Exit;
  Pos := 0;
  Max := 0;
  Page := 0;
  if not ListLink.Active then
    Max := 2
  else if (ListLink.DataSet <> nil) and ListLink.DataSet.IsSequenced then
  begin
    Page := DataRowCount;
    Max := ListLink.DataSet.RecordCount - 1;
    if ListLink.DataSet.State in [dsInactive, dsBrowse, dsEdit] then
      Pos := ListLink.DataSet.RecNo - ListLink.ActiveRecord - 1;
    //ListLink.ActiveRecord := 0;
    //if FRecordCount <> 0 then ListLink.ActiveRecord := FRecordIndex;
  end else if FRecordCount = DataRowCount then
  begin
    Max := 4;
    if not ListLink.DataSet.BOF then
      if not ListLink.DataSet.EOF then Pos := 2 else Pos := 4;
  end;
  ScrollInfo.cbSize := SizeOf(TScrollInfo);
  ScrollInfo.fMask := SIF_ALL;
  if not GetScrollInfo(Handle, SB_VERT, ScrollInfo) or
    (ScrollInfo.nMin <> 0) or (ScrollInfo.nMax <> Max) or
    (ScrollInfo.nPage <> Page) or (ScrollInfo.nPos <> Pos) then
  begin
    ScrollInfo.nMin := 0;
    ScrollInfo.nMax := Max;
    ScrollInfo.nPos := Pos;
    ScrollInfo.nPage := Page;
    SetScrollInfo(Handle, SB_VERT, ScrollInfo, True);
  end;
end;

procedure TDBLookupGridEh.UpdateRowCount;
begin
  if FInternalHeightSetting then Exit;
  FInternalHeightSetting := True;
  try
    //Height := RowCount * GetDataRowHeight + GetBorderSize + TitleRowHeight + FSpecRowHeight;
  //if HandleAllocated then UpdateScrollBar;
    inherited UpdateRowCount;
  finally
    FInternalHeightSetting := False;
  end;
  //FRowCount := DataRowCount;
  ListLinkDataChanged;
end;

type TColumnEhCracker = class(TColumnEh) end;

procedure TDBLookupGridEh.ColWidthsChanged;
var i, w: Integer;
begin
  w := 0;
  inherited ColWidthsChanged;
  if FInternalWidthSetting = True then Exit;
  if HandleAllocated and (FGridState = gsColSizing) and AutoFitColWidths then
  begin
    for i := 0 to ColCount - 1 do
    begin
      Inc(w, ColWidths[i]);
      if dgColLines in inherited Options then Inc(w, GridLineWidth);
    end;
    FInternalWidthSetting := True;
    //FAutoFitColWidths := False;
    try
      ClientWidth := w;
      for i := 0 to Columns.Count - 1 do
        TColumnEhCracker(Columns[i]).FInitWidth := Columns[i].Width;
    finally
      FInternalWidthSetting := False;
      //FAutoFitColWidths := True;
    end;
  end;
end;

procedure TDBLookupGridEh.UpdateColumnsList;
var i: Integer;
begin
  if FInternalWidthSetting then Exit;
  FInternalWidthSetting := True;
  try
    if FLGAutoFitColWidths then
      inherited AutoFitColWidths := True;
    for i := 0 to Columns.Count - 1 do
      TColumnEhCracker(Columns[i]).FInitWidth := Columns[i].Width;
    inherited AutoFitColWidths := False;
  finally
    FInternalWidthSetting := False;
  end;
  RowCount := RowCount;
end;

function TDBLookupGridEh.GetUseMultiTitle: Boolean;
begin
  Result := inherited UseMultiTitle;
end;

procedure TDBLookupGridEh.SetUseMultiTitle(const Value: Boolean);
begin
  inherited UseMultiTitle := Value;
  RowCount := RowCount;
end;

{procedure TDBLookupGridEh.RowHeightsChanged;
begin
  if FInternalHeightSetting then Exit;
  inherited RowHeightsChanged;
  Height := RowCount * GetDataRowHeight + GetBorderSize + TitleRowHeight + FSpecRowHeight;
end;}

function TDBLookupGridEh.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
  Result := False;
  if ListLink.DataSet <> nil then
  begin
    ListLink.DataSet.MoveBy(FRecordCount - FRecordIndex);
    Result := True;
  end;
end;

function TDBLookupGridEh.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
  Result := False;
  if ListLink.DataSet <> nil then
  begin
    ListLink.DataSet.MoveBy(-FRecordIndex - 1);
    Result := True;
  end;
end;

procedure TDBLookupGridEh.CreateWnd;
begin
  inherited CreateWnd;
  RowCount := RowCount;
end;

{function TDBLookupGridEh.CalcTitleOffset: Integer;
begin
  Result := inherited CalcTitleOffset;
  if SpecRow.Visible then Result := Result + 1;
end;}

procedure TDBLookupGridEh.DrawSubTitleCell(ACol, ARow: Integer;
   DataCol, DataRow: Integer; CellType: TCellTypeEh; ARect: TRect;
   AState: TGridDrawState; var Highlighted: Boolean);
var //Field: TField;
  S: String;
  AAlignment: TAlignment;
  DrawColumn: TDBLookupGridColumnEh;
begin
  Dec(ACol, IndicatorOffset);
  DrawColumn := TDBLookupGridColumnEh(Columns[ACol]);
  Canvas.Font := SpecRow.Font;
  S := DrawColumn.SpecCell.Text; // SpecRow.CellText[ACol];
  AAlignment := DrawColumn.Alignment;
  if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
  Canvas.Brush.Color := DrawColumn.SpecCell.Color; //SpecRow.Color;
  if SpecRow.Selected then
  begin
    Canvas.Font.Color := clHighlightText;
    Canvas.Brush.Color := clHighlight;
  end;
  WriteCellText(Canvas, ARect, True, 2, 1, S, AAlignment, tlTop, False, False, 0, 0);
  if SpecRow.Selected then
  begin
    Canvas.Font.Color := clWindowText;
    Canvas.Brush.Color := clWindow;
    DrawFocusRect(Canvas.Handle, BoxRect(FixedCols, ARow, ColCount, ARow));
  end;
end;

function TDBLookupGridEh.CellHave3DRect(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState): Boolean;