[Lazarus] patch for lazreport (TfrPictureView.getBlob)

[FreeMan]

Why need this modify?
 I have over then 1000 rows table, but I have just 3 glyph. not 
checkbox, but can think same. Integer values  can 1-2-3. but user can 
will see graphic. for showing in lazreport, Have to add TBlobField and 
have to add glyph to all rows each time, This mean loose time and loose 
memory.
My patch check "DBImageRead" event is assigned,  if DBImageRead is 
assigned then Blob controls are starting. So, If some used this event 
and after apply this patch, no need change them codes.
I actived, TfrPictureView has no need blob field defined, can define any 
field of dataset in report, in design.

procedure TForm1.TfrReport1DBImageRead(Sender: TObject; S: TStream; var 
GraphExt: string);
begin
  Tmem_Stream.Clear;
  Tmem_Stream.Position := 0;
  GraphExt := 'bmp';
  Tmem_Stream.LoadFromFile('test.bmp');// or what ever code
{or Dataset is work synchronize so I can use dataset's any field
if myQuery.FieldByName('Test_Int').asInteger=1 then 
Tmem_Stream.LoadFromFile('test1.bmp');// etc
}
  S.CopyFrom(Tmem_Stream, Tmem_Stream.Size);
  S.Position := 0;// Have to. 'cos getblob not set
end;

I wish add to parameter TfrTField in DBImageRead event, but, when apply 
patch, have to change code, so I didn't add.
maybe lazreport's chief can add new notify event


Index: .
===================================================================
--- .	(gözden geçirme 47037)
+++ .	(çalışan kopya)
@@ -5682,12 +5682,16 @@
 
   Picture.Clear;
 
-  if b.IsNull then
+  if b.IsNull and
+    not assigned(CurReport.OnDBImageRead) and//FreeMan
+    not frIsBlob(b)then//FreeMan
     exit;
 
   // todo: TBlobField.AssignTo is not implemented yet
-  s := TDataset(FDataSet).CreateBlobStream(TField(b),bmRead);
-  if (s=nil) or (s.Size = 0) then
+  if frIsBlob(b)//FreeMan
+    then s := TDataset(FDataSet).CreateBlobStream(TField(b),bmRead)
+    else s := TMemoryStream.Create; //FreeMan
+  if (s=nil) or ((s.Size = 0)and not assigned(CurReport.OnDBImageRead)) then
   begin
     s.Free;
     exit;
@@ -5716,6 +5720,7 @@
       // In particular, returning an invalid identifier while the stream has
       // a image header will not work.
       CurReport.OnDBImageRead(self,s,GraphExt);
+      if (s=nil) or (s.Size = 0)then Exit;//(FreeMan) Not need crash and no need error message
       GraphExtToClass;
       end
     else
@@ -9645,8 +9650,16 @@
   DebugLn('TfrReport.InternalOnEnterRect View=%s',[ViewInfo(View)]);
   {$ENDIF}
   with View do
-    if (FDataSet <> nil) and frIsBlob(TfrTField(FDataSet.FindField(FField))) then
-      GetBlob(TfrTField(FDataSet.FindField(FField)));
+  begin//FreeMan
+    if (FDataSet <> nil)then
+    begin
+      if View is TfrPictureView then
+        GetBlob(TfrTField(FDataSet.FindField(FField)))
+        else
+          if frIsBlob(TfrTField(FDataSet.FindField(FField)))then
+            GetBlob(TfrTField(FDataSet.FindField(FField)));
+    end;
+  end;//FreeMan
   DoEnterRect(Memo, View);
 end;
 
--
_______________________________________________
Lazarus mailing list
Lazarus@lists.lazarus.freepascal.org
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus