もしかするとMySQLコミュニティーエディションでは実現できないのかもしれません

[newbbs/newbbs.git] / tool / Unit1.pas

diff --git a/tool/Unit1.pas b/tool/Unit1.pas
index 35eee89..e237471 100644 (file)
--- a/tool/Unit1.pas
+++ b/tool/Unit1.pas
@@ -15,7 +15,7 @@ uses
   System.Bindings.Outputs, FMX.Bind.Editors, Data.Bind.Components, Data.DB,
   FMX.Controls.Presentation, FMX.Edit, FMX.Bind.Navigator, Data.Bind.DBScope,
   FireDAC.Comp.Client, FireDAC.Comp.DataSet, FMX.Objects, FMX.StdCtrls,
-  FireDAC.FMXUI.Wait, FireDAC.Comp.UI;
+  FireDAC.FMXUI.Wait, FireDAC.Comp.UI, FireDAC.Comp.BatchMove;
 
 type
   TForm2 = class(TForm)
@@ -32,16 +32,16 @@ type
     OpenDialog1: TOpenDialog;
     Label1: TLabel;
     LinkPropertyToFieldText: TLinkPropertyToField;
-    FDTable1id: TFDAutoIncField;
-    FDTable1name: TWideStringField;
-    FDTable1source: TBlobField;
     LinkPropertyToFieldBitmap: TLinkPropertyToField;
+    FDQuery1: TFDQuery;
+    Button2: TButton;
+    FDBatchMove1: TFDBatchMove;
     procedure Button1Click(Sender: TObject);
-    procedure FDTable1AfterInsert(DataSet: TDataSet);
     procedure FormCreate(Sender: TObject);
-    procedure FDTable1AfterPost(DataSet: TDataSet);
+    procedure Button2Click(Sender: TObject);
   private
     { private \90é\8c¾ }
+    procedure streamToField(stream, field: TStream);
   public
     { public \90é\8c¾ }
   end;
@@ -56,44 +56,82 @@ implementation
 procedure TForm2.Button1Click(Sender: TObject);
 var
   s: TStream;
-  bmp: TBitmapSurface;
-  pm: TBitmapCodecSaveParams;
+  t: TMemoryStream;
 begin
   if OpenDialog1.Execute = true then
   begin
     FDTable1.Edit;
-    bmp:=TBitmapSurface.Create;
+    s := FDTable1.CreateBlobStream(FDTable1.FieldByName('source'), bmWrite);
+    t := TMemoryStream.Create;
     try
-      s := FDTable1.CreateBlobStream(FDTable1.FieldByName('source'), bmWrite);
-      Image1.Bitmap.LoadFromFile(OpenDialog1.FileName);
-      bmp.Assign(Image1.Bitmap);
-      pm.Quality:=100;
-      TBitmapCodecManager.SaveToStream(s,bmp,'.jpg',@pm);
+      t.LoadFromFile(OpenDialog1.FileName);
+      streamToField(t, s);
+      FDTable1.Post;
     finally
       s.Free;
-      bmp.Free;
+      t.Free;
     end;
-    FDTable1.Post;
   end;
 end;
 
-procedure TForm2.FDTable1AfterInsert(DataSet: TDataSet);
+procedure TForm2.Button2Click(Sender: TObject);
 begin
-  FDTable1.FieldByName('name').AsString := 'slide' + FDTable1.FieldByName('id')
-    .AsString + '.jpg';
+  with FDQuery1.SQL do
+  begin
+    Clear;
+    Add('drop table images;');
+    Add('create table images(id int primary key, name varchar(10), source mediumblob);');
+  end;
+  FormCreate(Sender);
 end;
 
-procedure TForm2.FDTable1AfterPost(DataSet: TDataSet);
+procedure TForm2.FormCreate(Sender: TObject);
+var
+  i: Integer;
+  s, t: TStream;
 begin
-  FDTable1.Refresh;
+  FDQuery1.ExecSQL;
+  FDTable1.Open;
+  if FDTable1.RecordCount = 0 then
+  begin
+    for i := 1 to 50 do
+      FDTable1.AppendRecord([i, Format('slide%d.jpg', [i]), nil]);
+    FDTable1.First;
+    for i := 1 to 10 do
+    begin
+      FDTable1.Edit;
+      s := FDTable1.CreateBlobStream(FDTable1.FieldByName('source'), bmWrite);
+      t := TResourceStream.Create(HInstance, Format('Resource_%d', [i]),
+        RT_RCDATA);
+      try
+        streamToField(t,s);
+        FDTable1.Post;
+      finally
+        s.Free;
+      end;
+      FDTable1.Next;
+    end;
+  end;
+  FDTable1.First;
 end;
 
-procedure TForm2.FormCreate(Sender: TObject);
+procedure TForm2.streamToField(stream, field: TStream);
+var
+  bmp: TBitmapSurface;
+  pm: TBitmapCodecSaveParams;
+  img: TBitmap;
 begin
-  if FDTable1.Exists = false then
-    FDTable1.CreateTable;
-  FDTable1.Open;
-  FDTable1.Refresh;
+  pm.Quality := 100;
+  bmp := TBitmapSurface.Create;
+  img:=TBitmap.Create;
+  try
+    img.LoadFromStream(stream);
+    bmp.Assign(img);
+    TBitmapCodecManager.SaveToStream(field, bmp, '.jpg', @pm);
+  finally
+    bmp.Free;
+    img.Free;
+  end;
 end;
 
 end.