rm_dataset.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 752 行 · 第 1/2 页

{------------------------------------------------------------------------------}
{ TRMUserDataSet }

function TRMUserDataSet.GetFieldValue(const aFieldName: string;
  aConvertNulls: Boolean): Variant;
begin
  Result := UnAssigned;
  if Assigned(FOnGetFieldValue) then
    FOnGetFieldValue(Self, aFieldName, Result);
end;

procedure TRMUserDataSet.GetFieldsList(aFieldList: TStringList);
begin
  if Assigned(FOnGetFieldsList) then
    FOnGetFieldsList(Self, aFieldList);
end;

function TRMUserDataSet.Active: boolean;
begin
  Result := True;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMStringsDataset }

constructor TRMStringsDataset.Create;
begin
  inherited;
  FStringsSourceType := rmssNone;
end;

procedure TRMStringsDataset.Notification;
begin
  inherited;
  if (AOperation = opRemove) and (AComponent = FStringsSource) then
    FStringsSource := nil;
end;

procedure TRMStringsDataset.SetStringsSource;
begin
  if (Value = nil) or (Value is TComboBox) or (Value is TListBox) or (Value is TMemo) then
  begin
    FStringsSource := Value;
    if FStringsSource is TComboBox then
      FStringsSourceType := rmssComboBox
    else if FStringsSource is TListBox then
      FStringsSourceType := rmssListBox
    else if FStringsSource is TMemo then
      FStringsSourceType := rmssMemo
    else
      FStringsSourceType := rmssNone;
  end;
end;

function TRMStringsDataset.GetStrings;
begin
  Result := nil;
  if FStringsSourceType <> rmssNone then
  begin
    case FStringsSourceType of
      rmssComboBox: Result := TComboBox(FStringsSource).Items;
      rmssListBox: Result := TListBox(FStringsSource).Items;
      rmssMemo: Result := TMemo(FStringsSource).Lines;
    end;
  end
  else
  begin
    if Strings <> nil then
      Result := Strings;
  end;
end;

function TRMStringsDataset.Active;
begin
  Result := True;
end;

function TRMStringsDataset.Eof;
begin
  Result := FCurIndex >= Strings.Count;
end;

function TRMStringsDataset.GetFieldValue(const aFieldName: string;
  aConvertNulls: Boolean): Variant;
begin
  if AnsiCompareText('NAME', aFieldName) = 0 then
    Result := Strings[FCurIndex]
  else if AnsiCompareText('ID', aFieldName) = 0 then
    Result := integer(Strings.Objects[FCurIndex]);
end;

procedure TRMStringsDataset.Init;
begin
  FRecordNo := 0;
  inherited Init;
end;

procedure TRMStringsDataset.First;
begin
  FRecordNo := 0;
  inherited First;
end;

procedure TRMStringsDataset.Last;
begin
  //
end;

procedure TRMStringsDataset.Next;
begin
  if FRecordNo <= Strings.Count then
    Inc(FRecordNo);
  inherited Next;
end;

procedure TRMStringsDataset.Prior;
begin
  if FRecordNo > 0 then
    Dec(FRecordNo);
  inherited Prior;
end;

procedure TRMStringsDataset.GetFieldsList(aFieldList: TStringList);
begin
  aFieldList.Add('NAME');
  aFieldList.Add('ID');
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMDBDataSet }

constructor TRMDBDataSet.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FOpenDataSet := True;
  FBookMark := nil;
end;

destructor TRMDBDataSet.Destroy;
begin
  inherited Destroy;
end;

function TRMDBDataset.IsBlobField(const aFieldName: string): Boolean;
begin
  Result := False;
  if FDataSet <> nil then
    Result := RMIsBlob(FDataset.FindField(aFieldName));
end;

procedure TRMDBDataSet.AssignBlobFieldTo(const aFieldName: string; aDest: TObject);
begin
  RMAssignBlobTo(FDataSet.FindField(aFieldName), aDest);
end;

procedure TRMDBDataSet.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = FDataSet then
      FDataSet := nil;
  end;
end;

procedure TRMDBDataSet.SetDataSet(Value: TDataSet);
begin
  FDataSet := Value;
end;

function TRMDBDataSet.GetDataSet: TDataSet;
begin
  if FDataSet <> nil then
    Result := FDataSet
  else
  begin
    raise EDSError.Create('Unable to open dataset ' + Name);
    Result := nil;
  end;
end;

function TRMDBDataSet.Active: boolean;
begin
  Result := False;
  if FDataSet <> nil then
    Result := FDataSet.Active;
end;

procedure TRMDBDataSet.Init;
begin
  Open;
  if FBookMark <> nil then
    GetDataSet.FreeBookMark(FBookMark);

  FBookmark := DataSet.GetBookmark;
  //	if CurPage.CanDisableControls then
  //	  RMDisableDBControls(TDataSet(GetDataSet));
  FEof := False;
end;

procedure TRMDBDataSet.Exit;
begin
  try
    if FBookMark <> nil then
    begin
      if (FRangeBegin = rmrbCurrent) or (FRangeEnd = rmreCurrent) then
        GetDataSet.GotoBookmark(FBookMark);
      GetDataSet.FreeBookMark(FBookmark);
    end;
  finally
    FBookMark := nil;
    Close;
  end;
end;

procedure TRMDBDataSet.First;
begin
  if FRangeBegin = rmrbFirst then
    GetDataSet.First
  else if FRangeBegin = rmrbCurrent then
    GetDataSet.GotoBookMark(FBookMark);

  FEof := False;
  inherited First;
end;

procedure TRMDBDataSet.Last;
begin
  if FRangeEnd = rmreLast then
    GetDataSet.Last
  else if FRangeEnd = rmreCurrent then
    GetDataSet.GotoBookMark(FBookMark);

  FEof := True;
  inherited Last;
end;

procedure TRMDBDataSet.Next;
var
  liBookMark: TBookmark;
begin
  FEof := False;
  if FRangeEnd = rmreCurrent then
  begin
    liBookMark := GetDataSet.GetBookMark;
    if GetDataSet.CompareBookMarks(liBookMark, FBookMark) = 0 then
      FEof := True;
    GetDataSet.FreeBookMark(liBookMark);
    if not FEof then
    begin
      GetDataSet.Next;
      inherited Next;
    end;
    System.Exit;
  end;
  GetDataSet.Next;
  inherited Next;
end;

procedure TRMDBDataSet.MoveBy(Distance: Integer);
begin
  GetDataSet.MoveBy(Distance);
end;

procedure TRMDBDataSet.Prior;
begin
  GetDataSet.Prior;
  inherited Prior;
end;

function TRMDBDataSet.EOF: Boolean;
begin
  Result := inherited EOF or FEof or GetDataSet.EOF;
end;

procedure TRMDBDataSet.Open;
begin
  if FOpenDataSet then GetDataSet.Open;
  if Assigned(FOnOpen) then FOnOpen(Self);
end;

procedure TRMDBDataSet.Close;
begin
  if Assigned(FOnClose) then FOnClose(Self);
  if FCloseDataSet then GetDataSet.Close;
end;

function TRMDBDataSet.FieldIsNull(const aFieldName: string): Boolean;
var
  lField: TField;
begin
  lField := FDataSet.FindField(aFieldName);
  Result := (lField <> nil) and lField.IsNull;
end;

function TRMDBDataSet.FieldWidth(const aFieldName: string): Integer;
var
  lField: TField;
begin
  Result := 0;
  lField := FDataSet.FindField(aFieldName);
  if lField <> nil then
    Result := lField.DisplayWidth;
end;

function TRMDBDataSet.GetFieldValue(const aFieldName: string;
  aConvertNulls: Boolean): Variant;
var
  lField: TField;
begin
  lField := FDataSet.FindField(aFieldName);
  if lField = nil then Exit;

  if Assigned(lField.OnGetText) then
    Result := lField.DisplayText
  else
  begin
    {$IFDEF Delphi4}
    if lField.DataType in [ftLargeint] then
      Result := lField.DisplayText
    else
      {$ENDIF}
      Result := lField.AsVariant;
    //    if F.DataType in [ftCurrency{$IFDEF Delphi4}, ftLargeint{$ENDIF}] then
    //      Result := F.DisplayText
    //    else
    //      Result := F.AsVariant;
  end;

  if (Result = Null) and aConvertNulls {(not RMUseNull)} then
  begin
    if lField.DataType in [ftString{$IFDEF Delphi4}, ftWideString{$ENDIF}] then
      Result := ''
    else if lField.DataType = ftBoolean then
      Result := False
    else
      Result := 0;
  end;
end;

{$HINTS OFF}

procedure TRMDBDataSet.GetFieldsList(aFieldList: TStringList);
var
  i: Integer;
begin
  aFieldList.Clear;
  if FDataSet = nil then Exit;

  try
    FDataSet.GetFieldNames(aFieldList);
  except
    on e: EConvertError do
    begin
		  aFieldList.Clear;
      if FDataSet.FieldList.Count > 0 then
      begin
        for i := 0 to FDataSet.FieldList.Count - 1 do
          aFieldList.Add(FDataSet.FieldList[i].FieldName);
      end
      else
      begin
        FDataSet.FieldDefs.Update;
        for i := 0 to FDataSet.FieldDefList.Count - 1 do
          aFieldList.Add(FDataSet.FieldDefList[i].Name);
      end;
    end;
  end;
end;
{$HINTS ON}

end.