rm_dataset.pas

这是一个功能强大

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

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

function TRMUserDataSet.GetFieldDisplayText(const aFieldName: string;
  aConvertNulls: Boolean): WideString;
begin
  Result := '';
  if Assigned(FOnGetFieldDisplayText) then
    FOnGetFieldDisplayText(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;

const
  BUFFER_SIZE = 65534;

procedure TRMUserDataSet.AssignBlobFieldTo(const aFieldName: string; aDest: TObject);
var
  lValue: Variant;
  lStream: TMemoryStream;
  lHeader: TRMGraphicHeader;
  lCount: Integer;
  lbuffer: array[0..BUFFER_SIZE + 1] of byte;
begin
  if not Assigned(FOnGetFieldValue) then Exit;

  FOnGetFieldValue(Self, aFieldName, lValue);
  lStream := TMemoryStream.Create;
  try
    RMVariantToStream(lValue, lStream);

    lCount := lStream.Size;
    if lCount >= SizeOf(TRMGraphicHeader) then
    begin
      lStream.Read(lHeader, SizeOf(lHeader));
      if (lHeader.Count <> 1) or (lHeader.HType <> $0100) or
        (lHeader.Size <> lCount - SizeOf(lHeader)) then
        lStream.Position := 0;
    end
    else
    begin
    end;

    if lStream.Size > 0 then
    begin
      if aDest is TPicture then
      begin
        TPicture(aDest).Graphic.LoadFromStream(lStream);
      end
      else if aDest is TStream then
      begin
        if lStream.Position = 0 then
        begin
          lStream.SaveToStream(TStream(aDest));
        end
        else
        begin
          while true do
          begin
            lCount := lStream.Read(lbuffer, BUFFER_SIZE);
            TStream(aDest).WriteBuffer(lbuffer, lCount);

            if lCount < BUFFER_SIZE then Break;
          end;
        end;

        TStream(aDest).Position := 0;
      end;
    end;
  finally
    lStream.Free;
  end;
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;

function TRMStringsDataset.GetFieldDisplayText(const aFieldName: string;
  aConvertNulls: Boolean): WideString;
begin
  Result := GetFieldValue(aFieldName, aConvertNulls);
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
  if FDataSet <> Value then
  begin
    FDataSet := Value;
//    FFieldAlias.Clear;
  end;
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
  begin
    GetDataSet.First;
  end
  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.GetFieldDisplayLabel(const aFieldName: string): string;
var
  lField: TField;
begin
  Result := '';
  lField := FDataSet.FindField(aFieldName);
  if lField <> nil then
    Result := lField.DisplayLabel;
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;
  lWideField: IWideStringField;
begin
//	if not FDataSet.Active then FDataSet.Open;

  lField := FDataSet.FindField(aFieldName);
  if lField = nil then Exit;

  if Assigned(lField.OnGetText) then
    Result := lField.DisplayText
  else
  begin
    if lField.DataType in [ftLargeint] then
      Result := lField.DisplayText
    else
    begin
      if lField.GetInterface(IWideStringField, lWideField) then
        Result := lWideField.AsWideString
      else if lField is TWideStringField then
      begin
        if not lField.IsNull then
          Result := TWideStringField(lField).Value;
      end
      else
        Result := lField.AsVariant;
    end;
  end;

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

function TRMDBDataSet.GetFieldDisplayText(const aFieldName: string;
  aConvertNulls: Boolean): WideString;
var
  lField: TField;
  lWideField: IWideStringField;
begin
	if not FDataSet.Active then FDataSet.Open;

  lField := FDataSet.FindField(aFieldName);
  if lField <> nil then
  begin
	  if lField.GetInterface(IWideStringField, lWideField) then
  	  Result := lWideField.WideDisplayText
	  else if (lField is TWideStringField) and (not Assigned(lField.OnGetText)) then
  	  Result := _GetAsWideString(lField)
	  else
  	  Result := lField.DisplayText;
  end;
end;
{$HINTS OFF}

procedure TRMDBDataSet.GetFieldsList(aFieldList: TStringList);
var
  i: Integer;
  lField: TField;

  procedure _GetFields;
  var
  	i: Integer;
  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;

begin
  aFieldList.Clear;
  if FDataSet <> nil then
  begin
    try
      if System.IsLibrary then
      	_GetFields
	    else
      FDataSet.GetFieldNames(aFieldList);
    except
      on e: EConvertError do
      begin
      	if not System.IsLibrary then
	        _GetFields;
      end;
    end; {Try}
  end;
end;
{$HINTS ON}

end.