tool/Unit1.pas

   1 unit Unit1;
   2
   3 interface
   4
   5 uses
   6   System.SysUtils, System.Types, System.UITypes, System.Classes,
   7   System.Variants,
   8   FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Ani, FMX.Layouts,
   9   FMX.Gestures, FMX.Graphics, FMX.Surfaces,
  10   FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Param,
  11   FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf,
  12   FireDAC.Stan.Async, FireDAC.DApt, FireDAC.UI.Intf, FireDAC.Stan.Def,
  13   FireDAC.Stan.Pool, FireDAC.Phys, FireDAC.Phys.MySQL, FireDAC.Phys.MySQLDef,
  14   Data.Bind.Controls, Data.Bind.EngExt, FMX.Bind.DBEngExt, System.Rtti,
  15   System.Bindings.Outputs, FMX.Bind.Editors, Data.Bind.Components, Data.DB,
  16   FMX.Controls.Presentation, FMX.Edit, FMX.Bind.Navigator, Data.Bind.DBScope,
  17   FireDAC.Comp.Client, FireDAC.Comp.DataSet, FMX.Objects, FMX.StdCtrls,
  18   FireDAC.FMXUI.Wait, FireDAC.Comp.UI, FireDAC.Comp.BatchMove;
  19
  20 type
  21   TForm2 = class(TForm)
  22     Image1: TImage;
  23     FDTable1: TFDTable;
  24     FDConnection1: TFDConnection;
  25     Edit1: TEdit;
  26     BindingsList1: TBindingsList;
  27     FDGUIxWaitCursor1: TFDGUIxWaitCursor;
  28     BindSourceDB1: TBindSourceDB;
  29     NavigatorBindSourceDB12: TBindNavigator;
  30     LinkControlToField1: TLinkControlToField;
  31     Button1: TButton;
  32     OpenDialog1: TOpenDialog;
  33     Label1: TLabel;
  34     LinkPropertyToFieldText: TLinkPropertyToField;
  35     LinkPropertyToFieldBitmap: TLinkPropertyToField;
  36     FDQuery1: TFDQuery;
  37     Button2: TButton;
  38     Button3: TButton;
  39     procedure Button1Click(Sender: TObject);
  40     procedure FormCreate(Sender: TObject);
  41     procedure Button2Click(Sender: TObject);
  42     procedure Button3Click(Sender: TObject);
  43   private
  44     { private \90é\8c¾ }
  45     procedure streamToField(stream, field: TStream);
  46   public
  47     { public \90é\8c¾ }
  48   end;
  49
  50 var
  51   Form2: TForm2;
  52
  53 implementation
  54
  55 {$R *.fmx}
  56
  57 procedure TForm2.Button1Click(Sender: TObject);
  58 var
  59   s: TStream;
  60   t: TMemoryStream;
  61 begin
  62   if OpenDialog1.Execute = true then
  63   begin
  64     FDTable1.Edit;
  65     s := FDTable1.CreateBlobStream(FDTable1.FieldByName('source'), bmWrite);
  66     t := TMemoryStream.Create;
  67     try
  68       t.LoadFromFile(OpenDialog1.FileName);
  69       streamToField(t, s);
  70       FDTable1.Post;
  71     finally
  72       s.Free;
  73       t.Free;
  74     end;
  75   end;
  76 end;
  77
  78 procedure TForm2.Button2Click(Sender: TObject);
  79 begin
  80   with FDQuery1.SQL do
  81   begin
  82     Clear;
  83     Add('drop table images;');
  84     Add('create table images(id int primary key, name varchar(30), source mediumblob);');
  85   end;
  86   FormCreate(Sender);
  87 end;
  88
  89 procedure TForm2.FormCreate(Sender: TObject);
  90 var
  91   i: Integer;
  92   s, t: TStream;
  93 begin
  94   FDQuery1.ExecSQL;
  95   FDTable1.Open;
  96   if FDTable1.RecordCount = 0 then
  97   begin
  98     for i := 1 to 50 do
  99       FDTable1.AppendRecord([i, Format('slide%d.jpg', [i]), nil]);
 100     FDTable1.First;
 101     FDTable1.CachedUpdates := true;
 102     for i := 1 to 10 do
 103     begin
 104       FDTable1.Edit;
 105       s := FDTable1.CreateBlobStream(FDTable1.FieldByName('source'), bmWrite);
 106       t := TResourceStream.Create(HInstance, Format('Resource_%d', [i]),
 107         RT_RCDATA);
 108       try
 109         streamToField(t, s);
 110         FDTable1.Post;
 111       finally
 112         s.Free;
 113       end;
 114       FDTable1.Next;
 115     end;
 116     FDTable1.ApplyUpdates;
 117     FDTable1.CommitUpdates;
 118     FDTable1.CachedUpdates := false;
 119   end;
 120   FDTable1.First;
 121 end;
 122
 123 procedure TForm2.streamToField(stream, field: TStream);
 124 var
 125   bmp: TBitmapSurface;
 126   pm: TBitmapCodecSaveParams;
 127   img: TBitmap;
 128 begin
 129   pm.Quality := 100;
 130   bmp := TBitmapSurface.Create;
 131   img := TBitmap.Create;
 132   try
 133     img.LoadFromStream(stream);
 134     bmp.Assign(img);
 135     TBitmapCodecManager.SaveToStream(field, bmp, '.jpg', @pm);
 136   finally
 137     bmp.Free;
 138     img.Free;
 139   end;
 140 end;
 141
 142 procedure TForm2.Button3Click(Sender: TObject);
 143 begin
 144   FDTable1.Edit;
 145   FDTable1.FieldByName('source').Assign(nil);
 146   FDTable1.Post;
 147 end;
 148
 149 end.