OSDN Git Service

a5af20349f4bb532efca1575cc316991f1ba5258
[newbbs/newbbs.git] / 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     procedure Button1Click(Sender: TObject);
40     procedure FDTable1AfterInsert(DataSet: TDataSet);
41     procedure FormCreate(Sender: TObject);
42     procedure FDTable1AfterPost(DataSet: TDataSet);
43   private
44     { private \90é\8c¾ }
45   public
46     { public \90é\8c¾ }
47   end;
48
49 var
50   Form2: TForm2;
51
52 implementation
53
54 {$R *.fmx}
55
56 procedure TForm2.Button1Click(Sender: TObject);
57 var
58   s: TStream;
59   bmp: TBitmapSurface;
60   pm: TBitmapCodecSaveParams;
61 begin
62   if OpenDialog1.Execute = true then
63   begin
64     FDTable1.Edit;
65     bmp := TBitmapSurface.Create;
66     try
67       s := FDTable1.CreateBlobStream(FDTable1.FieldByName('source'), bmWrite);
68       Image1.Bitmap.LoadFromFile(OpenDialog1.FileName);
69       bmp.Assign(Image1.Bitmap);
70       pm.Quality := 100;
71       TBitmapCodecManager.SaveToStream(s, bmp, '.jpg', @pm);
72     finally
73       s.Free;
74       bmp.Free;
75     end;
76     FDTable1.Post;
77   end;
78 end;
79
80 procedure TForm2.FDTable1AfterInsert(DataSet: TDataSet);
81 begin
82   FDTable1.FieldByName('name').AsString := 'slide' + FDTable1.FieldByName('id')
83     .AsString + '.jpg';
84 end;
85
86 procedure TForm2.FDTable1AfterPost(DataSet: TDataSet);
87 begin
88   FDTable1.Refresh;
89 end;
90
91 procedure TForm2.FormCreate(Sender: TObject);
92 begin
93   if FDTable1.Exists = false then
94     FDTable1.CreateTable;
95   FDTable1.Open;
96   FDTable1.Refresh;
97 end;
98
99 end.