一応落ち着きました まだファビコンは設定されません なぜでしょう

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

diff --git a/tool/Unit2.pas b/tool/Unit2.pas
index 424e4c5..b1f7fc8 100644 (file)
--- a/tool/Unit2.pas
+++ b/tool/Unit2.pas
@@ -13,10 +13,11 @@ uses
   FireDAC.Comp.DataSet, FireDAC.Comp.Client, System.Rtti,
   System.Bindings.Outputs, Vcl.Bind.Editors, Data.Bind.EngExt,
   Vcl.Bind.DBEngExt, Data.Bind.Components, Data.Bind.DBScope,
-  FireDAC.VCLUI.Wait, FireDAC.Comp.UI, Vcl.DBCtrls, Jpeg, Vcl.Grids,
+  FireDAC.VCLUI.Wait, FireDAC.Comp.UI, Vcl.DBCtrls, Vcl.Grids,
   Vcl.DBGrids,
   FireDAC.Phys.IB, FireDAC.Phys.IBDef, FireDAC.Phys.FB, FireDAC.Phys.FBDef,
-  Vcl.ComCtrls, Vcl.Buttons;
+  Vcl.ComCtrls, Vcl.Buttons, FireDAC.Stan.StorageBin, FireDAC.Stan.StorageXML,
+  Vcl.Imaging.jpeg;
 
 type
   TForm1 = class(TForm)
@@ -25,19 +26,9 @@ type
     Button1: TButton;
     Button2: TButton;
     Button3: TButton;
-    Edit1: TEdit;
-    Label1: TLabel;
     OpenPictureDialog1: TOpenPictureDialog;
-    BindSourceDB1: TBindSourceDB;
-    BindingsList1: TBindingsList;
-    LinkPropertyToFieldCaption: TLinkPropertyToField;
-    LinkControlToField2: TLinkControlToField;
     FDGUIxWaitCursor1: TFDGUIxWaitCursor;
-    DBNavigator1: TDBNavigator;
     DBGrid1: TDBGrid;
-    FDTable1ID: TIntegerField;
-    FDTable1NAME: TWideStringField;
-    FDTable1SOURCE: TBlobField;
     Button4: TButton;
     FDQuery1: TFDQuery;
     Memo1: TMemo;
@@ -68,6 +59,13 @@ type
     FDTable3dbnum: TIntegerField;
     FDTable3database: TWideStringField;
     DataSource1: TDataSource;
+    FDTable1id: TIntegerField;
+    FDTable1name: TWideStringField;
+    FDTable1source: TWideMemoField;
+    Image1: TImage;
+    Button7: TButton;
+    Button8: TButton;
+    OpenPictureDialog2: TOpenPictureDialog;
     procedure Button1Click(Sender: TObject);
     procedure Button4Click(Sender: TObject);
     procedure Button3Click(Sender: TObject);
@@ -81,12 +79,16 @@ type
       State: TDragState; var Accept: Boolean);
     procedure ListBox1EndDrag(Sender, Target: TObject; X, Y: Integer);
     procedure ListBox1StartDrag(Sender: TObject; var DragObject: TDragObject);
+    procedure Button2Click(Sender: TObject);
+    procedure Button7Click(Sender: TObject);
+    procedure Button8Click(Sender: TObject);
   private
     { Private \90é\8c¾ }
     item: Integer;
     procedure combo;
     procedure list;
     procedure itemsCopy;
+    procedure openPicture(mem: TStream; filename: string);
   public
     { Public \90é\8c¾ }
   end;
@@ -103,48 +105,80 @@ uses System.NetEncoding, IdHashSHA, IdHashMessageDigest;
 procedure TForm1.Button1Click(Sender: TObject);
 var
   i: Integer;
-  t: TStream;
+  s, s2: string;
+  t: TMemoryStream;
 begin
-  with FDTable1 do
-  begin
-    for i := 1 to 10 do
+  Button4Click(nil);
+  if OpenPictureDialog1.Execute = true then
+    with FDTable1 do
     begin
-      t := TResourceStream.Create(HInstance, 'Resource_' + i.ToString,
-        RT_RCDATA);
-      AppendRecord([i, Format('slide%d.jpg', [i])]);
-      Edit;
-      FDTable1SOURCE.LoadFromStream(t);
-      Post;
+      t := TMemoryStream.Create;
+      Image1.Picture.Graphic.SaveToStream(t);
+      s := TNetEncoding.Base64.EncodeBytesToString(t.Memory, t.Size);
+      AppendRecord([1, 'BBS_bn.jpg', s]);
+      t.Position := 0;
+      Application.Icon.SaveToStream(t);
+      s := TNetEncoding.Base64.EncodeBytesToString(t.Memory, t.Size);
+      AppendRecord([2, 'favion64.ico', s]);
+      t.Position := 0;
+      i:=1;
+      for s2 in OpenPictureDialog1.Files do
+      begin
+        openPicture(t, s2);
+        s := TNetEncoding.Base64.EncodeBytesToString(t.Memory, t.Size);
+        AppendRecord([i+2, Format('slide%d.jpg', [i]), s]);
+        inc(i);
+      end;
       t.Free;
+      Refresh;
     end;
-    ApplyUpdates;
-    CommitUpdates;
-  end;
+end;
+
+procedure TForm1.Button2Click(Sender: TObject);
+begin
+  if FDTable1.Exists = true then
+    FDQuery1.ExecSQL('drop table images;');
+  FDQuery1.ExecSQL;
 end;
 
 procedure TForm1.Button3Click(Sender: TObject);
 var
-  s: TStream;
+  s: TMemoryStream;
+  p: TBytes;
   j: TJpegImage;
+  i: TIcon;
 begin
-  s := FDTable1.CreateBlobStream(FDTable1.FieldByName('source'), bmRead);
-  j := TJpegImage.Create;
-  j.LoadFromStream(s);
-  Canvas.Draw(0, 0, j);
+  if (FDTable1.Bof = true) or (FDTable1.Eof = true) then
+    Exit;
+  p := TNetEncoding.Base64.DecodeStringToBytes(FDTable1.FieldByName('source')
+    .AsString);
+  s := TMemoryStream.Create;
+  s.WriteBuffer(p, Length(p));
+  s.Position := 0;
+  if ExtractFileExt(FDTable1.FieldByName('name').AsString) = '.ico' then
+  begin
+    i := TIcon.Create;
+    i.LoadFromStream(s);
+    Canvas.Draw(0, 0, i);
+    i.Free;
+  end
+  else
+  begin
+    j := TJpegImage.Create;
+    j.LoadFromStream(s);
+    Canvas.Draw(0, 0, j);
+    j.Free;
+  end;
   s.Free;
-  j.Free;
 end;
 
 procedure TForm1.Button4Click(Sender: TObject);
 begin
   with FDTable1 do
   begin
-    repeat
+    while not((Bof = true) and (Eof = true)) do
       Delete;
-    until (Bof = true) and (Eof = true);
-    ApplyUpdates;
-    Reconcile;
-    CommitUpdates;
+    Refresh;
   end;
 end;
 
@@ -158,11 +192,8 @@ begin
   Edit3.Text := '\94n\8e­,\88¢\95Û,\8e\80\82Ë,\8eE\82·';
   Edit6.Text := 'admin';
   ComboBox1.Text := 'info';
-  ComboBox1Select(nil);
   UpDown1.Position := 30;
-  UpDown1Click(nil, btNext);
   CheckBox1.Checked := false;
-  CheckBox1Click(nil);
   ListBox1.Items.Clear;
   ListBox1.Items.Add('info');
   ListBox1.Items.Add('master');
@@ -212,6 +243,23 @@ begin
   end;
 end;
 
+procedure TForm1.Button7Click(Sender: TObject);
+begin
+  with OpenPictureDialog2 do
+  begin
+    FilterIndex := 0;
+    if Execute = true then
+      Image1.Picture.LoadFromFile(filename);
+  end;
+end;
+
+procedure TForm1.Button8Click(Sender: TObject);
+begin
+  OpenPictureDialog2.FilterIndex := 7;
+  if OpenPictureDialog2.Execute = true then
+    Application.Icon.LoadFromFile(OpenPictureDialog2.filename);
+end;
+
 procedure TForm1.combo;
 var
   i: Integer;
@@ -237,12 +285,8 @@ end;
 
 procedure TForm1.FormCreate(Sender: TObject);
 begin
-  if FDTable1.Exists = false then
-  begin
-    FDTable1.Close;
-    FDQuery1.ExecSQL;
-    FDTable1.Open;
-  end;
+  FDQuery1.ExecSQL;
+  FDTable1.Open;
   if FDTable2.Exists = false then
     FDTable2.CreateTable;
   FDTable2.Open;
@@ -337,6 +381,27 @@ begin
   item := ListBox1.ItemIndex;
 end;
 
+procedure TForm1.openPicture(mem: TStream; filename: string);
+var
+  jpg: TJpegImage;
+  bmp: TBitmap;
+begin
+  jpg := TJpegImage.Create;
+  bmp := TBitmap.Create;
+  try
+    jpg.LoadFromFile(filename);
+    bmp.Height := 465;
+    bmp.Width := Trunc(465 * jpg.Width / jpg.Height);
+    bmp.Canvas.StretchDraw(Rect(0, 0, bmp.Width, 465), jpg);
+    jpg.Assign(bmp);
+    jpg.SaveToStream(mem);
+    mem.Position := 0;
+  finally
+    jpg.Free;
+    bmp.Free;
+  end;
+end;
+
 procedure TForm1.SpeedButton1Click(Sender: TObject);
 var
   s: string;