dblookupgridseh.pas

考勤管理是企业内部管理的重要环节和基础

    UpdateColumnsList;
  end;
end;

procedure TDBLookupGridEh.SetKeyValue(const Value: Variant);
begin
  if not VarEquals(FKeyValue, Value) then
  begin
    FKeyValue := Value;
    KeyValueChanged;
  end
end;

procedure TDBLookupGridEh.SetListFieldName(const Value: string);
begin
  if FListFieldName <> Value then
  begin
    FListFieldName := Value;
    UpdateListFields;
    UpdateColumnsList;
  end;
end;

procedure TDBLookupGridEh.SetListSource(Value: TDataSource);
begin
  CheckNotLookup;
  inherited DataSource := Value;
  {ListLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);}
end;

procedure TDBLookupGridEh.SetLookupMode(Value: Boolean);
begin
  if FLookupMode <> Value then
    if Value then
    begin
      FMasterFields := GetFieldsProperty(FDataFields[0].DataSet, Self, FDataFields[0].KeyFields);
      FLookupSource.DataSet := FDataFields[0].LookupDataSet;
      FKeyFieldName := FDataFields[0].LookupKeyFields;
      FLookupMode := True;
      ListLink.DataSource := FLookupSource;
    end else
    begin
      ListLink.DataSource := nil;
      FLookupMode := False;
      FKeyFieldName := '';
      FLookupSource.DataSet := nil;
      FMasterFields := FDataFields;
    end;
end;

procedure TDBLookupGridEh.SetReadOnly(Value: Boolean);
begin
  FDataLink.ReadOnly := Value;
end;

procedure TDBLookupGridEh.WMGetDlgCode(var Message: TMessage);
begin
  Message.Result := DLGC_WANTARROWS or DLGC_WANTCHARS;
end;

procedure TDBLookupGridEh.WMKillFocus(var Message: TMessage);
begin
  FHasFocus := False;
  inherited;
  Invalidate;
end;

procedure TDBLookupGridEh.WMSetFocus(var Message: TMessage);
begin
  SearchText := '';
  FHasFocus := True;
  inherited;
  Invalidate;
end;

function TDBLookupGridEh.GetDataField: TField;
begin
  if Length(FDataFields) = 0
    then Result := nil
    else Result := FDataFields[0];
end;

procedure TDBLookupGridEh.SetSpecRow(const Value: TSpecRowEh);
begin
  FSpecRow.Assign(Value);
end;

procedure TDBLookupGridEh.SpecRowChanged(Sender: TObject);
begin
  if not (csLoading in ComponentState) then
    Invalidate;
end;

function TDBLookupGridEh.GetListLink: TGridDataLinkEh;
begin
  Result := inherited DataLink;
end;

procedure TDBLookupGridEh.LinkActive(Value: Boolean);
begin
  UpdateListFields;
  inherited LinkActive(Value);
  UpdateColumnsList;
end;

procedure TDBLookupGridEh.DataChanged;
begin
  inherited DataChanged;
  ListLinkDataChanged;
end;

procedure TDBLookupGridEh.LayoutChanged;
begin
  if AcquireLayoutLock then
  try
    //UpdateListFields;
    inherited LayoutChanged;
  finally
    EndLayout;
  end;
end;

procedure TDBLookupGridEh.SelectCurrent;
begin
  FLockPosition := True;
  try
    if not VarEquals(ListLink.DataSet.FieldValues[FKeyFieldName],KeyValue) then
      SelectKeyValue(ListLink.DataSet.FieldValues[FKeyFieldName]);
  finally
    FLockPosition := False;
  end;
end;

procedure TDBLookupGridEh.SelectItemAt(X, Y: Integer);
var
  Delta: Integer;
  Cell: TGridCoord;
  ADataBox: TGridRect;
begin
  if FSpecRow.Visible and (Y > TitleRowHeight) and (Y <= TitleRowHeight + FSpecRowHeight) then
  begin
    SelectSpecRow;
  end else
  begin
    if Y < TitleRowHeight + FSpecRowHeight then Exit; //Y := TitleRowHeight + FSpecRowHeight;
    if Y >= ClientHeight then Y := ClientHeight - 1;
    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) then
    begin
      Delta := (Cell.Y - TitleOffset) - FRecordIndex;
      //if (Delta <> 0) {or (KeyValue = Null)} then
      //begin
        ListLink.DataSet.MoveBy(Delta);
        SelectCurrent;
      //end;
    end;
  end;
end;

procedure TDBLookupGridEh.SelectSpecRow;
begin
  FLockPosition := True;
  try
    if not VarEquals(FSpecRow.Value,KeyValue) then
      SelectKeyValue(FSpecRow.Value);
    SpecRow.Selected := True;
  finally
    FLockPosition := False;
  end;
end;

procedure TDBLookupGridEh.SetRowCount(Value: Integer);
var NewHeight: Integer;
begin
  if Value < 1 then Value := 1;
  if Value > 100 then Value := 100;
  NewHeight := 0;
  if dgTitles in inherited Options then NewHeight := RowHeights[0];
  if dgRowLines in inherited Options then Inc(NewHeight, GridLineWidth);
  Inc(NewHeight, DefaultRowHeight*Value);
  if dgRowLines in inherited Options then Inc(NewHeight, Value*GridLineWidth);
  Inc(NewHeight, GetBorderSize);
  Height := NewHeight + FSpecRowHeight;
end;

procedure TDBLookupGridEh.SetShowTitles(const Value: Boolean);
begin
  if ShowTitles <> Value then
  begin
    if Value
      then inherited Options := inherited Options + [dgTitles]
      else inherited Options := inherited Options - [dgTitles];
    //if ShowTitles then TitleRowHeight := RowHeights[0] else TitleRowHeight := 0;
    //if HandleAllocated then
    Height := RowCount * GetDataRowHeight + GetBorderSize + TitleRowHeight + FSpecRowHeight;
  end;
end;

function TDBLookupGridEh.GetShowTitles: Boolean;
begin
  Result := dgTitles in inherited Options;
end;

function TDBLookupGridEh.HighlightCell(DataCol, DataRow: Integer;
  const Value: string; AState: TGridDrawState): Boolean;
begin
  Result := False;
  if not VarIsNull(KeyValue) and ListLink.Active and
        VarEquals(ListLink.DataSet.FieldValues[FKeyFieldName], KeyValue) then
    Result := (UpdateLock = 0);
end;

procedure TDBLookupGridEh.UpdateActive;
var
  NewRow: Integer;
//  Field: TField;
  function GetKeyRowIndex: Integer;
  var
    FieldValue: Variant;
    ActiveRecord: Integer;
  begin
    ActiveRecord := ListLink.ActiveRecord;
    try
      if not VarIsNull(KeyValue) then
        for Result := 0 to FRecordCount - 1 do
        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,TitleOffset);
      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 (TitleOffset-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;
  end;
end;

procedure TDBLookupGridEh.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  BorderSize, TextHeight, SpecRowHeight, Rows: 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;}
  inherited SetBounds(ALeft, ATop, AWidth, Rows * TextHeight + BorderSize + TitleRowHeight + FSpecRowHeight);
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.nPos <> Pos) 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;