[Fmx] TBitmap in TValue speichern

[Rollo62]

Hallo zusammen,

ist das möglich, so das es eine DeepCopy ist und nicht nur als Pointer gespeichert wird ?

Ich möchte TBitmap in einem TValue speicern, so das es später als Bitmapfeld in z.B. ein TImage verwendet werden kann.

Hier habe ich mal dazu gefunden, aber leider nichts zu TBitmap.
http://robstechcorner.blogspot.de/20...-in-depth.html
http://delphi.cjcsoft.net/viewthread.php?tid=43255


Das hier alles hat zumindest nicht funktioniert:

Delphi-Quellcode:

var
  MStrm: TMemoryStream;
  valPic: TValue;
  bmpCopy: TBitmap;


      // Via Variant - kopiert ByteArray, aber das wird natürlich später nicht als Bmp gelesen
      BMPToVariant(bmpCopy, varPic);

      valPic := TValue.From<Variant>(varPic);
      sTest := valPic.ToString;

      // Mit expliziter Angabe - es wird nur der Pointer kopiert
      valPic := TValue.From<TBitmap>(bmpCopy);
      sTest := valPic.ToString;


      // Mit Make - es wird nur der Pointer kopiert
      TValue.Make(@bmpCopy, TypeInfo(TBitmap), valPic);
      sTest := valPic.ToString;


      // So wie es sein sollte - es wird nur der Pointer kopiert
      valPic := TValue.From(bmpCopy);
      sTest := valPic.ToString;

      // Hier soll es rein und sich wie ein normales Bitmapfeld benehmen
      // und per LiveBinding im Image angezeigt werden
      DataGeneratorAdapter1.Fields[4].SetTValue( valPic );

      // Beim ersten Anlegen ist das Bitmap auch da !!!
      // Aber Scroll oder Refresh vernichten es, und es bleibt leer
      //
      // bmpCopy lösche ich übrigen NICHT nach dem Setzen, also sollte auch ein Pointer im DataGeneratorAdapter1
      // mitgeführt werden und ausreichend sein, oder nicht ?

Hat damit schonmal jemand gearbeitet ?


Rollo

[Der schöne Günther]

Ich glaube nicht dass TValue der richtige Ansatz ist. Dadurch gewinnt man doch nichts? Mache es doch über einen (Byte)Stream oder ein Byte-Array:

Delphi-Quellcode:

procedure TForm3.Button1Click(Sender: TObject);
var
   byteStream: TBytesStream;
begin
   byteStream := TBytesStream.Create();
   try
      // Einmal hin...
      Image1.Bitmap.SaveToStream(byteStream);

      // .. und zurück
      byteStream.Seek(0, TSeekOrigin.soBeginning);
      Image2.Bitmap.LoadFromStream(byteStream);
   finally
      byteStream.Destroy();
   end;
end;

[Rollo62]

Das ist ja auch nicht mein Wunschkandidat, aber ich versuche mit dem DataGeneratorAdapter und LiveBindings eine Datenbankschnittstelle hinzubekommen.
Dazu brauche ich wohl TValue.

Edit:

Laut dem http://monkeystyler.com/guide/TGrid es eigentlich funktionieren, zumindest im StringGrid.

Delphi-Quellcode:

//A TValue uses generics to specify the data type to read or write. The example below shows an example of setting data for each of the built in cell types,
procedure TForm1.Grid1GetValue(Sender: TObject; const Col, Row: Integer;
  var Value: TValue);
begin
  if Col = 0 then
    //TTextCell
    Value := TValue.From<String>(IntToStr(Row))
  else if Col = 1 then
    //TCheckCell
    Value := TValue.From<Boolean>((Row mod 2) = 0)
  else if Col = 2 then
    //TProgressCell
    Value := TValue.From<Single>(Row)
  else if Col = 3 then
    //TPopupColumn
    //  - doesn't accept data
  else if Col = 4 then
    //TImageColumn
    Value := TValue.From<TBitmap>(ImageControl1.Bitmap);
    //Or Value := TValue.From<String>('C:/Pictures/Kitten.png');
end;

Aber dann liegt es irgendwo am

Delphi-Quellcode:

DataGeneratorAdapter1.Fields[4].SetTValue( valPic );

und
es geht verloren auf dem Weg zum Image und zur ImageList.

Ich hab nochmal meinen TestCode mit drangehangen.


Rollo

Delphi-Quellcode:

procedure TForm1.Setup_Data(const sType: String);
var
  bmp: TBitmap;
  bmpCopy: TBitmap;

  valPic: TValue;
  dt: Extended;
  sDt: string;
  sTest: String;

  varPic: OleVariant;

begin

  DataGeneratorAdapter1.Fields[0].SetTValue( Random(100) );
  DataGeneratorAdapter1.Fields[1].SetTValue( 'Name ' + Random(100).ToString + ' - ' + sType );

  // TimeStamp string
  sDt := FormatDateTime('YY.MM.DD hh:nn:ss', Now);
  DataGeneratorAdapter1.Fields[2].SetTValue( sDt );


  // TimeStamp TDatetime
  DataGeneratorAdapter1.Fields[3].SetTValue( Now );

  // Pic
  if Assigned(Glyph1.Images) and (Glyph1.ImageIndex < Glyph1.Images.Count) then
    bmp := Glyph1.Images.Bitmap(TSize.Create(512,512), Glyph1.ImageIndex)
  else
    bmp := nil;

  if Assigned(bmp) then
  begin

    bmpCopy := TBitmap.Create;  //TODO: Is this managed and freed by TValue ?? Check

    try
      bmpCopy.Assign( bmp );

// Error
//      S4Bmp_ToStream(bmp, MStrm, '.jpg', 85);
//      MStrm.Position := 0;
//
//      BMPToVariant(bmpCopy, varPic);
//

// Error
//      valPic := TValue.From<Variant>(varPic);
//      sTest := valPic.ToString;
//


// Error
//      valPic := TValue.From<TBitmap>(bmpCopy);
//      sTest := valPic.ToString;
//

// Error
//      TValue.Make(@bmpCopy, TypeInfo(TBitmap), valPic);
//      sTest := valPic.ToString;

// Error - Bitmap ist nur nach erstellen sichtbar, Scroll/Refresh vernichtet es
      valPic := TValue.From(bmpCopy);
      sTest := valPic.ToString;

      DataGeneratorAdapter1.Fields[4].SetTValue( valPic );

    finally
//    bmpCopy.Free;  // Nicht gemacht, weil sonst das Bmp zerstört würde
                     // Aber kann TValue Owner vom Bmp sein ?
    end;

  end;



end;


procedure TForm1.Button1Click(Sender: TObject);
begin

  DataGeneratorAdapter1.Append;

  Setup_Data( 'by append');

  DataGeneratorAdapter1.Post;

end;

[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