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;
  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     FDTable1id: TFDAutoIncField;
  36     FDTable1name: TWideStringField;
  37     FDTable1source: TBlobField;
  38     LinkPropertyToFieldBitmap: TLinkPropertyToField;
  39     FDQuery1: TFDQuery;
  40     procedure Button1Click(Sender: TObject);
  41     procedure FDTable1AfterInsert(DataSet: TDataSet);
  42     procedure FormCreate(Sender: TObject);
  43     procedure FDTable1AfterPost(DataSet: TDataSet);
  44   private
  45     { private \90é\8c¾ }
  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   bmp: TBitmapSurface;
  61   pm: TBitmapCodecSaveParams;
  62   img: TBitmap;
  63 begin
  64   if OpenDialog1.Execute = true then
  65   begin
  66     if FDTable1.RecordCount = 0 then
  67       FDTable1.Append;
  68     FDTable1.Edit;
  69     bmp := TBitmapSurface.Create;
  70     img := TBitmap.Create;
  71     try
  72       s := FDTable1.CreateBlobStream(FDTable1.FieldByName('source'), bmWrite);
  73       img.LoadFromFile(OpenDialog1.FileName);
  74       bmp.Assign(img);
  75       pm.Quality := 100;
  76       TBitmapCodecManager.SaveToStream(s, bmp, '.jpg', @pm);
  77       FDTable1.Post;
  78     finally
  79       s.Free;
  80       bmp.Free;
  81       img.Free;
  82     end;
  83   end;
  84 end;
  85
  86 procedure TForm2.FDTable1AfterInsert(DataSet: TDataSet);
  87 begin
  88   FDTable1.FieldByName('name').AsString := 'slide' + FDTable1.FieldByName('id')
  89     .AsString + '.jpg';
  90 end;
  91
  92 procedure TForm2.FDTable1AfterPost(DataSet: TDataSet);
  93 begin
  94   FDTable1.Refresh;
  95 end;
  96
  97 procedure TForm2.FormCreate(Sender: TObject);
  98 begin
  99   FDQuery1.ExecSQL;
 100   FDTable1.Open;
 101   FDTable1.Refresh;
 102 end;
 103
 104 end.