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

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

diff --git a/tool/Unit1.pas b/tool/Unit1.pas
index 3e71e2d..e237471 100644 (file)
--- a/tool/Unit1.pas
+++ b/tool/Unit1.pas
@@ -3,17 +3,19 @@ unit Unit1;
 interface
 
 uses
-  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
-  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Ani, FMX.Layouts, FMX.Gestures,
+  System.SysUtils, System.Types, System.UITypes, System.Classes,
+  System.Variants,
+  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Ani, FMX.Layouts,
+  FMX.Gestures, FMX.Graphics, FMX.Surfaces,
   FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Param,
   FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf,
   FireDAC.Stan.Async, FireDAC.DApt, FireDAC.UI.Intf, FireDAC.Stan.Def,
   FireDAC.Stan.Pool, FireDAC.Phys, FireDAC.Phys.MySQL, FireDAC.Phys.MySQLDef,
-  Data.Bind.Controls, Data.Bind.EngExt, Fmx.Bind.DBEngExt, System.Rtti,
-  System.Bindings.Outputs, Fmx.Bind.Editors, Data.Bind.Components, Data.DB,
-  FMX.Controls.Presentation, FMX.Edit, Fmx.Bind.Navigator, Data.Bind.DBScope,
+  Data.Bind.Controls, Data.Bind.EngExt, FMX.Bind.DBEngExt, System.Rtti,
+  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)
@@ -23,15 +25,23 @@ type
     Edit1: TEdit;
     BindingsList1: TBindingsList;
     FDGUIxWaitCursor1: TFDGUIxWaitCursor;
-    BindSourceDB12: TBindSourceDB;
+    BindSourceDB1: TBindSourceDB;
     NavigatorBindSourceDB12: TBindNavigator;
-    LinkPropertyToFieldBitmap: TLinkPropertyToField;
     LinkControlToField1: TLinkControlToField;
+    Button1: TButton;
+    OpenDialog1: TOpenDialog;
+    Label1: TLabel;
+    LinkPropertyToFieldText: TLinkPropertyToField;
+    LinkPropertyToFieldBitmap: TLinkPropertyToField;
+    FDQuery1: TFDQuery;
+    Button2: TButton;
+    FDBatchMove1: TFDBatchMove;
+    procedure Button1Click(Sender: TObject);
     procedure FormCreate(Sender: TObject);
+    procedure Button2Click(Sender: TObject);
   private
-    FGestureOrigin: TPointF;
-    FGestureInProgress: Boolean;
     { private \90é\8c¾ }
+    procedure streamToField(stream, field: TStream);
   public
     { public \90é\8c¾ }
   end;
@@ -43,9 +53,85 @@ implementation
 
 {$R *.fmx}
 
+procedure TForm2.Button1Click(Sender: TObject);
+var
+  s: TStream;
+  t: TMemoryStream;
+begin
+  if OpenDialog1.Execute = true then
+  begin
+    FDTable1.Edit;
+    s := FDTable1.CreateBlobStream(FDTable1.FieldByName('source'), bmWrite);
+    t := TMemoryStream.Create;
+    try
+      t.LoadFromFile(OpenDialog1.FileName);
+      streamToField(t, s);
+      FDTable1.Post;
+    finally
+      s.Free;
+      t.Free;
+    end;
+  end;
+end;
+
+procedure TForm2.Button2Click(Sender: TObject);
+begin
+  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.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.streamToField(stream, field: TStream);
+var
+  bmp: TBitmapSurface;
+  pm: TBitmapCodecSaveParams;
+  img: TBitmap;
+begin
+  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.