dblookupgridseh.pas

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

    Assigned((TDBLookupGridColumnEh(FOwner)).Grid)
    then with TDBLookupGridColumnEh(FOwner) do
      Result := GetGrid.SpecRow.Color
  else Result := FColor;
end;

function TGridColumnSpecCellEh.DefaultFont: TFont;
begin
  if Assigned(FOwner) and (FOwner is TDBLookupGridColumnEh) and
    Assigned(TDBLookupGridColumnEh(FOwner).Grid)
    then with TDBLookupGridColumnEh(FOwner) do
      Result := GetGrid.SpecRow.Font
  else Result := FFont;
end;

function TGridColumnSpecCellEh.DefaultText: String;
begin
  if Assigned(FOwner) and (FOwner is TDBLookupGridColumnEh) and
    Assigned(TDBLookupGridColumnEh(FOwner).Grid)
    then with TDBLookupGridColumnEh(FOwner) do
      Result := GetGrid.SpecRow.CellText[Index]
  else Result := FText;
end;

function TGridColumnSpecCellEh.GetColor: TColor;
begin
  if not FColorAssigned
    then Result := DefaultColor
    else Result := FColor;
end;

function TGridColumnSpecCellEh.GetFont: TFont;
var
  Save: TNotifyEvent;
begin
  if not FFontAssigned and (FFont.Handle <> DefaultFont.Handle) then
  begin
    Save := FFont.OnChange;
    FFont.OnChange := nil;
    FFont.Assign(DefaultFont);
    FFont.OnChange := Save;
  end;
  Result := FFont;
end;

procedure TGridColumnSpecCellEh.FontChanged(Sender: TObject);
begin
  FFontAssigned := True;
end;

function TGridColumnSpecCellEh.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

function TGridColumnSpecCellEh.GetText: String;
begin
  if not FTextAssigned
    then Result := DefaultText
    else Result := FText;
end;

function TGridColumnSpecCellEh.IsColorStored: Boolean;
begin
  Result := FColorAssigned;
end;

function TGridColumnSpecCellEh.IsFontStored: Boolean;
begin
  Result := FFontAssigned;
end;

function TGridColumnSpecCellEh.IsTextStored: Boolean;
begin
  Result := FTextAssigned;
end;

procedure TGridColumnSpecCellEh.SetColor(const Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    FColorAssigned := True;
  end;
end;

procedure TGridColumnSpecCellEh.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
end;

procedure TGridColumnSpecCellEh.SetText(const Value: String);
begin
  if FText <> Value then
  begin
    FText := Value;
    FTextAssigned := True;
  end;
end;

procedure TGridColumnSpecCellEh.Assign(Source: TPersistent);
begin
  if Source is TGridColumnSpecCellEh then
  begin
    Text := TGridColumnSpecCellEh(Source).Text;
    Color := TGridColumnSpecCellEh(Source).Color;
    if TGridColumnSpecCellEh(Source).FFontAssigned then
      Font := TGridColumnSpecCellEh(Source).Font;
  end else
    inherited Assign(Source);
end;

{ TDBLookupGridColumnEh }

constructor TDBLookupGridColumnEh.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FSpecCell := TGridColumnSpecCellEh.Create(Self);
end;

destructor TDBLookupGridColumnEh.Destroy;
begin
  FSpecCell.Free;
  inherited Destroy;
end;

function TDBLookupGridColumnEh.GetGrid: TDBLookupGridEh;
begin
  Result := TDBLookupGridEh(inherited Grid);
end;

procedure TDBLookupGridColumnEh.SetIndex(Value: Integer);
var i: Integer;
  s: String;

  procedure SetSpecCell;
  var ss: TStringList;
    i: Integer;
  begin
    with Grid as TDBLookupGridEh do
    begin
      ss := TStringList.Create;
      try
        for i := 0 to Columns.Count - 1 do
          ss.Add(SpecRow.CellText[i]);
        ss.Move(Index, Value);
        s := '';
        for i := 0 to Columns.Count - 1 do
          s := s + ss[i] + ';';
        Delete(s, Length(s), 1);
        SpecRow.CellsText := s;
      finally
        ss.Free;
      end;
    end;
  end;

begin
  with Grid as TDBLookupGridEh do
  begin
    if SeenPassthrough and DataLink.Active and (Index <> Value) then
    begin
      BeginUpdate;
      try
        if Index = ListFieldIndex then
          ListFieldIndex := Value
        else
        begin
          if ListFieldIndex > Index then
            ListFieldIndex := ListFieldIndex - 1;
          if ListFieldIndex >= Value then
            ListFieldIndex := ListFieldIndex + 1;
        end;
        SetSpecCell;
        IsStored := True;
        try
          inherited SetIndex(Value);
        finally
          IsStored := False;
        end;
        s := '';
        for i := 0 to Columns.Count - 1 do
          s := s + Columns[i].Field.FieldName + ';';
        Delete(s, Length(s), 1);
        ListField := s;
      finally
        EndUpdate;
      end;
    end else
    begin
      if DataLink.Active and (Index <> Value) then
        SetSpecCell;
      inherited SetIndex(Value);
    end;
  end
end;

procedure TDBLookupGridColumnEh.SetSpecCell(const Value: TGridColumnSpecCellEh);
begin
  FSpecCell.Assign(Value);
end;

procedure TDBLookupGridColumnEh.SetWidth(Value: Integer);
begin
  if SeenPassthrough then
  begin
    IsStored := True;
    try
      inherited SetWidth(Value);
    finally
      IsStored := False;
    end;
  end else
    inherited SetWidth(Value);
end;

{ TDBLookupGridEh }

constructor TDBLookupGridEh.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable]; //Really not Replicatable, only for CtrlGrid 
//  if NewStyleControls
//    then ControlStyle := [csOpaque]
//    else ControlStyle := [csOpaque, csFramed];
  ParentColor := False;
  TabStop := True;
  FLookupSource := TDataSource.Create(Self);
  FDataLink := TLookupGridDataLinkEh.Create;
  FDataLink.FDBLookupGrid := Self;
  FListFields := TList.Create;
  FKeyValue := Null;
  FSpecRow := TSpecRowEh.Create(Self);
  FSpecRow.OnChanged := SpecRowChanged;
  inherited Options := [dgColLines, dgRowSelect];
  OptionsEh := OptionsEh + [dghTraceColSizing];
  FOptions := [dlgColLinesEh];
  HorzScrollBar.Tracking := True;
  VertScrollBar.Tracking := True;
  Flat := True;
  //UseMultiTitle := True;
  ReadOnly := True;
  DrawMemoText := True;
  TabStop := False;
  FLGAutoFitColWidths := False;
  //HorzScrollBar.Visible := True;
  VTitleMargin := 5;
  ReadOnly := False;
end;

destructor TDBLookupGridEh.Destroy;
begin
  FSpecRow.Free;
  FListFields.Free;
  FListFields := nil;
  FDataLink.FDBLookupGrid := nil;
  FDataLink.Free;
  FDataLink := nil;
  inherited Destroy;
end;

function TDBLookupGridEh.CanModify: Boolean;
  function MasterFieldsCanModify: Boolean;
  var i: Integer;
  begin
    Result := True;
    for i := 0 to Length(FMasterFields) - 1 do
      if not FMasterFields[i].CanModify then
      begin
        Result := False;
        Exit;
      end;
  end;
begin
  Result := FListActive and not ReadOnly and ((FDataLink.DataSource = nil) or
    (Length(FMasterFields) <> 0) and MasterFieldsCanModify);
end;

procedure TDBLookupGridEh.CheckNotCircular;
begin
  if ListLink.Active and ListLink.DataSet.IsLinkedTo(DataSource) then
    DatabaseError(SCircularDataLink);
end;

procedure TDBLookupGridEh.CheckNotLookup;
begin
  if FLookupMode then DatabaseError(SPropDefByLookup);
  if FDataLink.DataSourceFixed then DatabaseError(SDataSourceFixed);
end;

procedure TDBLookupGridEh.UpdateDataFields;
  function MasterFieldNames: String;
  var i: Integer;
  begin
    Result := '';
    for i := 0 to Length(FMasterFields) - 1 do
      if Result = '' then
        Result := FMasterFields[i].FieldName else
        Result := Result + ';' + FMasterFields[i].FieldName;
  end;
begin
  //FDataField := nil;
  //FMasterField := nil;
  FMasterFieldNames := '';
  if FDataLink.Active and (FDataFieldName <> '') then
  begin
    CheckNotCircular;
    FDataFields := GetFieldsProperty(FDataLink.DataSet, Self, FDataFieldName);
    if (Length(FDataFields) = 1) and (FDataFields[0].FieldKind = fkLookup)
      then FMasterFields := GetFieldsProperty(FDataLink.DataSet, Self, FDataFields[0].KeyFields)
      else FMasterFields := FDataFields;
    FMasterFieldNames := MasterFieldNames;
  end;
  SetLookupMode((Length(FDataFields) = 1) and (FDataFields[0].FieldKind = fkLookup));
  DataLinkRecordChanged(nil);
end;

procedure TDBLookupGridEh.DataLinkRecordChanged(Field: TField);
  function FieldFound(Value: TField): Boolean;
  var i: Integer;
  begin
    Result := False;
    for i := 0 to Length(FMasterFields) - 1 do
      if FMasterFields[i] = Value then
      begin
        Result := True;
        Exit;
      end;
  end;
begin
  if (Field = nil) or FieldFound(Field) then
    if Length(FMasterFields) > 0
      then SetKeyValue(FDataLink.DataSet.FieldValues[FMasterFieldNames])
      else SetKeyValue(Null);
end;

function TDBLookupGridEh.GetBorderSize: Integer;
//var
//  Params: TCreateParams;
//  R: TRect;
begin
  Result := 0;
  if not HandleAllocated then Exit;
  Result := Height - ClientHeight;
  {CreateParams(Params);
  SetRect(R, 0, 0, 0, 0);
  AdjustWindowRectEx(R, Params.Style, False, Params.ExStyle);
  Result := R.Bottom - R.Top; // + FBorderWidth*2;
  }
end;

function TDBLookupGridEh.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

function TDBLookupGridEh.GetKeyFieldName: string;
begin
  if FLookupMode then Result := '' else Result := FKeyFieldName;
end;

function TDBLookupGridEh.GetListSource: TDataSource;
begin
  if FLookupMode then Result := nil else Result := ListLink.DataSource;
end;

function TDBLookupGridEh.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

function TDBLookupGridEh.GetDataRowHeight: Integer;
begin
  Result := DefaultRowHeight;
  if dgRowLines in inherited Options then Inc(Result, GridLineWidth);
end;

function TDBLookupGridEh.GetSpecRowHeight: Integer;
{var
  DC: HDC;
  SaveFont: HFont;
  Metrics: TTextMetric;}
begin
  Result := DefaultRowHeight;
  if dgRowLines in inherited Options then Inc(Result, GridLineWidth);
  {Result := 0;
  if not Assigned(SpecRow) then Exit;
  DC := GetDC(0);
  SaveFont := SelectObject(DC, SpecRow.Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  Result := Metrics.tmHeight;}
end;

procedure TDBLookupGridEh.KeyValueChanged;
begin
  if not SpecRow.Visible then
    SpecRow.Selected := False
  else
  begin
    SpecRow.Selected := VarEquals(FKeyValue, SpecRow.Value);
    if not FLockPosition and not SpecRow.Selected and SpecRow.ShowIfNotInKeyList then
      if not LocateKey
        then SpecRow.Selected := True
        else ListLinkDataChanged
  end;

  if ListActive and not FLockPosition then
    if not LocateKey and not SpecRow.Selected then
      ListLink.DataSet.First
    else
      ListLinkDataChanged;

  if FListField <> nil then
    if SpecRow.Visible and SpecRow.Selected
      then FSelectedItem := SpecRow.CellText[ListFieldIndex]
      else FSelectedItem := FListField.DisplayText