dblookupgridseh.pas

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

  else FSelectedItem := '';
end;

procedure TDBLookupGridEh.UpdateListFields;
var
  DataSet: TDataSet;
  ResultField: TField;
  i: Integer;
begin
  try
    FListActive := False;
    //FKeyField := nil;
    FListField := nil;
    FListFields.Clear;
    if ListLink.Active and (FKeyFieldName <> '') then
    begin
      CheckNotCircular;
      DataSet := ListLink.DataSet;
      FKeyFields := GetFieldsProperty(DataSet, Self, FKeyFieldName);
      try
        DataSet.GetFieldList(FListFields, FListFieldName);
      except
        DatabaseErrorFmt(SFieldNotFound, [Self.Name, FListFieldName]);
      end;
      if FLookupMode then
      begin
        ResultField := GetFieldProperty(DataSet, Self, FDataFields[0].LookupResultField);
        if FListFields.IndexOf(ResultField) < 0 then
          FListFields.Insert(0, ResultField);
        FListField := ResultField;
      end else
      begin
        if FListFields.Count = 0 then
          for i := 0 to Length(FKeyFields) - 1 do FListFields.Add(FKeyFields[i]);
        if (FListFieldIndex >= 0) and (FListFieldIndex < FListFields.Count) then
          FListField := FListFields[FListFieldIndex] else
          FListField := FListFields[0];
      end;
      FListActive := True;
    end;

    if FLookupMode
      then FKeyFieldName := Field.LookupKeyFields
      else FKeyFieldName := KeyField;
    if ListLink.Active and (FKeyFieldName <> '') then
    begin
      DataSet := ListLink.DataSet;
      FKeyFields := GetFieldsProperty(DataSet, Self, FKeyFieldName);
      if FLookupMode then
      begin
        ResultField := GetFieldProperty(DataSet, Self, Field.LookupResultField);
        FListField := ResultField;
      end else
      begin
        if (ListFieldIndex >= 0) and (ListFieldIndex < ListFields.Count)
          then FListField := ListFields[ListFieldIndex]
          else FListField := ListFields[0];
      end;
    end;

  finally
    if ListActive
      then KeyValueChanged
      else ListLinkDataChanged;
  end;
end;

procedure TDBLookupGridEh.ListLinkDataChanged;
begin
  if ListActive then
  begin
    FRecordIndex := ListLink.ActiveRecord;
    FRecordCount := ListLink.RecordCount;
    FKeySelected := not VarIsNull(KeyValue) or
      not ListLink.DataSet.BOF;
  end else
  begin
    FRecordIndex := 0;
    FRecordCount := 0;
    FKeySelected := False;
  end;
  if HandleAllocated then
  begin
    UpdateScrollBar; //
    LayoutChanged;
    //UpdateActive;
    //Invalidate;
  end;
end;

function TDBLookupGridEh.LocateKey: Boolean;
var
  KeySave: Variant;
begin
  Result := False;
  try
    KeySave := FKeyValue;
    if not VarIsNull(FKeyValue) and (ListLink.DataSet <> nil) and
      ListLink.DataSet.Active and CompatibleVarValue(FKeyFields, FKeyValue) and
      ListLink.DataSet.Locate(FKeyFieldName, FKeyValue, []) then
    begin
      Result := True;
      FKeyValue := KeySave;
    end;
  except
  end;
end;

procedure TDBLookupGridEh.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if (FDataLink <> nil) and (AComponent = DataSource)
      then DataSource := nil;
//    if (ListLink <> nil) and (AComponent = ListSource)
//      then ListSource := nil;
  end;
end;

procedure TDBLookupGridEh.ProcessSearchKey(Key: Char);
var
  TickCount: Integer;
  S: string;
  CharMsg: TMsg;
begin
  if (FListField <> nil) and (FListField.FieldKind in [fkData, fkInternalCalc]) and
    (FListField.DataType in [ftString]) then
    case Key of
      #8, #27: SearchText := '';
      #32..#255:
        if CanModify then
        begin
          TickCount := GetTickCount;
          if TickCount - SearchTickCount > 2000 then SearchText := '';
          SearchTickCount := TickCount;
          if SysLocale.FarEast and (Key in LeadBytes) then
            if PeekMessage(CharMsg, Handle, WM_CHAR, WM_CHAR, PM_REMOVE) then
            begin
              if CharMsg.Message = WM_Quit then
              begin
                PostQuitMessage(CharMsg.wparam);
                Exit;
              end;
              SearchText := SearchText + Key;
              Key := Char(CharMsg.wParam);
            end;
          if Length(SearchText) < 32 then
          begin
            S := SearchText + Key;
            try
              if ListLink.DataSet.Locate(FListField.FieldName, S,
                [loCaseInsensitive, loPartialKey]) then
              begin
                SelectKeyValue(ListLink.DataSet.FieldValues[FKeyFieldName] {FKeyField.Value});
                SearchText := S;
              end;
            except
              { If you attempt to search for a string larger than what the field
                can hold, and exception will be raised.  Just trap it and
                reset the SearchText back to the old value. }
              SearchText := S;
            end;
          end;
        end;
    end;
end;

procedure TDBLookupGridEh.SelectKeyValue(const Value: Variant);
begin
  if Length(FMasterFields) > 0 then
  begin
    if FDataLink.Edit then
      FDataLink.DataSet.FieldValues[FMasterFieldNames] := Value;
  end else
    SetKeyValue(Value);
  UpdateActive;
  Repaint;
  Click;
end;

procedure TDBLookupGridEh.SetDataFieldName(const Value: string);
begin
  if FDataFieldName <> Value then
  begin
    FDataFieldName := Value;
    UpdateDataFields;
  end;
end;

procedure TDBLookupGridEh.SetDataSource(Value: TDataSource);
begin
  if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
    FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

procedure TDBLookupGridEh.SetKeyFieldName(const Value: string);
begin
  CheckNotLookup;
  if FKeyFieldName <> Value then
  begin
    FKeyFieldName := Value;
    UpdateListFields;
    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;

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 - TopDataOffset) - 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.HighlightDataCellColor(DataCol, DataRow: Integer; const Value: string;
  AState: TGridDrawState; var AColor: TColor; AFont: TFont): Boolean;
begin
  Result := False;
  if not VarIsNull(KeyValue) and ListLink.Active and
    VarEquals(ListLink.DataSet.FieldValues[FKeyFieldName], KeyValue) then
    Result := (UpdateLock = 0);
  if Result then
  begin
    AColor := clHighlight;
    AFont.Color := clHighlightText;
  end;  
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