[Fmx] TBitmap in TValue speichern

[Rollo62]

Ok, das Problem kommt wohl nicht von TValue, sondern aus dem Generator.

Das TValue wird richtig gesetzt, aber beim nächsten ReLoad durch den Generator wird dafür wieder versucht ein simuliertes (Prototyp) Bitmap zu laden.
Dazu wird ein Dictionary verwendet mit Integer-Key, zu jedem Key wird dann der Generator aufgerufen.

Trotzdem versuche ich noch das hinzubekommen um Daten von Aussen (aus einem Dataset) reinzubringen,
ich hoffe das man irgendeine der Klassen ableiten muss und dann das Nutzen kann.

Hiermit wird ein Feldwert geholt

Delphi-Quellcode:

function TTypedListValueGeneratorDelegate<T>.GetValue(var AFree: Boolean): TValue;
var
  LValue: T;
begin
  if (FValuesList <> nil) and (FValuesList.Count > 0) then
    Result := TValue.From<T>(FValuesList[FValueCounter mod FValuesList.Count])
  else
  begin
    // Create default value
    LValue := TValue.Empty.AsType<T>;
    Result := TValue.From<T>(LValue);
  end;

  // Allow owner to override return value
  if Assigned(FGetValue) then
  begin
    Assert(not AFree);
    Result := FGetValue(Result, AFree);  // Und hier werden die Generator-Werte abgerufen
    if AFree then
    begin
      Assert(Result.IsObject);
    end;
  end;
end;

// Darin wird die anonyme Prozedur aufgerufen

function TBitmapGenerator.CreateDelegate: TValueGeneratorDelegate;
const
  cCount = 50;
var
  ADelegate: TValueGeneratorDelegateWithEvents;
  LList: TList<Integer>;
  I: Integer;
begin
  ADelegate := nil;
  case FieldType of
    ftBitmap,
    ftString:
    begin
      LList := TList<integer>.Create;
      try
        for I := 1 to cCount do
          LList.Add(I);
        ADelegate := TTypedListValueGeneratorDelegate<Integer>.Create(Options, LList.ToArray);
        if FieldType = ftBitmap then
          ADelegate.OnGetValue :=
            function(AValue: TValue; var AFree: Boolean): TValue
            begin
              Result := GetBitmapSurface(AValue.AsInteger, AFree);  // Hier wird das Bitmap neu erzeugt
            end
        else
          ADelegate.OnGetValue :=
            function(AValue: TValue; var AFree: Boolean): TValue
            begin
              Result := Format('Bitmap%d', [AValue.AsInteger]);
            end
      finally
        LList.Free;
      end;
    end;
  else
    Assert(False);
  end;
  Result := ADelegate;
end;


// Darin sieht es so aus
function TCacheBitmapGenerator.GetBitmapSurface(AIndex: Integer; var AFree: Boolean): TInternalBitmapSurface;
var
  LStream: TStream;
begin
  Result := TInternalBitmapSurface.Create;
  if not FCacheSurface.TryGetValue(AIndex, LStream) then
  begin
    LStream := MakeBitmapStream(AIndex);  // Hier wird vom Integer-Index ein Bmp generiert
    FCacheSurface.Add(AIndex, LStream);
  end;
  Result.LoadFromStream(LStream);
  AFree := True;
end;

// Das wird per Stream gemacht
function TBitmapGenerator.MakeBitmapStream(
  AIndex: Integer): TStream;
var
  LBitmap: TBitmap;
begin
  Result := TMemoryStream.Create;
  try
    LBitmap := MakeBitmap(AIndex);  // Hier passiert die falsche Simulation
    try
      LBitmap.SaveToStream(Result);
    finally
      LBitmap.Free;
    end;
  except
    Result.Free;
    raise;
  end;
end;


// Da werden dann die Sample-Bitmaps erzeugt
function TBitmapGenerator.MakeBitmap(AIndex: Integer): TBitmap;
var
  BMP   : TBitmap;
  C     : TCanvas;
  LColor: TAlphaColor;
  LWidth: Integer;
  LHeight: Integer;
  LColorIndex: Integer;
  LText: string;
  LRect: TRectF;
begin
  LWidth := 100;
  LHeight := 100;
  LColorIndex := AIndex mod Length(CColorValues);
  Assert(LColorIndex >= 0);
  Assert(LColorIndex < Length(CColorValues));
  LColor := CColorValues[LColorIndex];

  BMP := TBitmap.Create(LWidth,LHeight);
  C := BMP.Canvas;

  C.BeginScene({nil});
  try

    C.Fill.Color := LColor;
    C.Stroke.Color := LColor;
    C.FillRect(RectF(0,0,LWidth,LHeight),0,0,[],1);

    C.Fill.Color := TAlphaColorRec.Black;
    C.Stroke.Color := TAlphaColorRec.Black;
    C.Stroke.Thickness := 5;
    C.DrawRectSides(RectF(0,0,LWidth,LHeight), 0, 0, [TCorner.TopLeft, TCorner.TopRight, TCorner.BottomLeft, TCorner.BottomRight],
      1, [TSide.Top, TSide.Left, TSide.Bottom, TSide.Right], TCornerType.Round);

    C.Fill.Color := TAlphaColorRec.Black;
    C.Stroke.Color := TAlphaColorRec.Black;
    C.Font.Size := 24;
    LText := IntToStr(AIndex);
    LRect := RectF(0,0, LWidth, LHeight);
    C.MeasureText(LRect, LText, False, [], TTextAlign.Leading, TTextAlign.Leading);
    C.FillText(RectF(0, 0, LWidth, LRect.Height + 20), LText, False, 1, [], TTextAlign.Center, TTextAlign.Center);
  finally
    C.EndScene;
  end;

  Result := BMP;
end;

Hat vielleicht jemand eine Idee wie man ein Bitmap von aussen echt Speichern könnte,
das TValue ist ja vorhanden.

Rollo