OSDN Git Service

なやみながらですね。
[newbbs/newbbs.git] / tool / Unit2.pas
index e6eede7..03a2a3e 100644 (file)
@@ -4,7 +4,7 @@ interface
 
 uses
   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
-  System.Classes, Vcl.Graphics,
+  System.Types, System.Classes, Vcl.Graphics,
   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, FireDAC.Stan.Intf, FireDAC.Stan.Option,
   FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def,
   FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.MySQL,
@@ -13,10 +13,10 @@ 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.ComCtrls, Vcl.Buttons, FireDAC.Stan.StorageBin, FireDAC.Stan.StorageXML;
 
 type
   TForm1 = class(TForm)
@@ -33,12 +33,7 @@ type
     LinkPropertyToFieldCaption: TLinkPropertyToField;
     LinkControlToField2: TLinkControlToField;
     FDGUIxWaitCursor1: TFDGUIxWaitCursor;
-    DBNavigator1: TDBNavigator;
-    DataSource1: TDataSource;
     DBGrid1: TDBGrid;
-    FDTable1ID: TIntegerField;
-    FDTable1NAME: TWideStringField;
-    FDTable1SOURCE: TBlobField;
     Button4: TButton;
     FDQuery1: TFDQuery;
     Memo1: TMemo;
@@ -46,29 +41,53 @@ type
     Edit3: TEdit;
     Label2: TLabel;
     FDTable2: TFDTable;
-    BindSourceDB2: TBindSourceDB;
-    LinkControlToField1: TLinkControlToField;
     Edit4: TEdit;
-    LinkControlToField5: TLinkControlToField;
     Button5: TButton;
     Edit5: TEdit;
     UpDown1: TUpDown;
     Edit6: TEdit;
-    LinkControlToField4: TLinkControlToField;
     ComboBox1: TComboBox;
     Button6: TButton;
     Label3: TLabel;
-    Label4: TLabel;
+    Bevel1: TBevel;
+    ListBox1: TListBox;
+    SpeedButton1: TSpeedButton;
+    Edit2: TEdit;
+    FDTable2title: TWideStringField;
+    FDTable2title2: TWideStringField;
+    FDTable2mente: TSmallintField;
+    FDTable2info: TIntegerField;
+    FDTable2count: TIntegerField;
+    FDTable2password: TWideStringField;
+    FDTable2ng: TWideStringField;
+    FDTable3: TFDTable;
+    FDTable3dbnum: TIntegerField;
+    FDTable3database: TWideStringField;
+    DataSource1: TDataSource;
+    FDTable1id: TIntegerField;
+    FDTable1name: TWideStringField;
+    FDTable1source: TWideMemoField;
     procedure Button1Click(Sender: TObject);
     procedure Button4Click(Sender: TObject);
     procedure Button3Click(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure Button6Click(Sender: TObject);
-    procedure ComboBox1Select(Sender: TObject);
-    procedure CheckBox1Click(Sender: TObject);
-    procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
+    procedure Button5Click(Sender: TObject);
+    procedure SpeedButton1Click(Sender: TObject);
+    procedure ListBox1KeyDown(Sender: TObject; var Key: Word;
+      Shift: TShiftState);
+    procedure ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
+      State: TDragState; var Accept: Boolean);
+    procedure ListBox1EndDrag(Sender, Target: TObject; X, Y: Integer);
+    procedure ListBox1StartDrag(Sender: TObject; var DragObject: TDragObject);
+    procedure Button2Click(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;
@@ -78,42 +97,56 @@ var
 
 implementation
 
-uses System.NetEncoding, IdHashSHA, IdHashMessageDigest;
+uses System.NetEncoding, IdHashSHA, IdHashMessageDigest, Jpeg;
 
 {$R *.dfm}
 
 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
+  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;
+      i:=RecordCount+1;
+      for s2 in OpenPictureDialog1.Files do
+      begin
+        openPicture(t, s2);
+        s := TNetEncoding.Base64.EncodeBytesToString(t.Memory, t.Size);
+        AppendRecord([i, 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;
 begin
-  s := FDTable1.CreateBlobStream(FDTable1.FieldByName('source'), bmRead);
+  if (FDTable1.Bof = true) or (FDTable1.Eof = true) then
+    Exit;
+  p := TNetEncoding.Base64.DecodeStringToBytes(FDTable1.FieldByName('source')
+    .AsString);
   j := TJpegImage.Create;
+  s := TMemoryStream.Create;
+  s.WriteBuffer(p, Length(p));
+  s.Position := 0;
   j.LoadFromStream(s);
   Canvas.Draw(0, 0, j);
-  s.Free;
   j.Free;
 end;
 
@@ -121,16 +154,36 @@ 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;
 
+procedure TForm1.Button5Click(Sender: TObject);
+var
+  i: Integer;
+begin
+  Edit4.Text := '\82Æ\82é\82Ë\81`\82Ç\8d\86';
+  Memo1.Lines.Text :=
+    '<h1 style=color:maron;text-align:center;font-style:italic>\82Æ\82é\82Ë\81`\82Ç\8d\86</h1>';
+  Edit3.Text := '\94n\8e­,\88¢\95Û,\8e\80\82Ë,\8eE\82·';
+  Edit6.Text := 'admin';
+  ComboBox1.Text := 'info';
+  UpDown1.Position := 30;
+  CheckBox1.Checked := false;
+  ListBox1.Items.Clear;
+  ListBox1.Items.Add('info');
+  ListBox1.Items.Add('master');
+  for i := 1 to 10 do
+    ListBox1.Items.Add('\8cf\8e¦\94Â' + i.ToString);
+  list;
+  itemsCopy;
+end;
+
 procedure TForm1.Button6Click(Sender: TObject);
+var
+  i: Integer;
   function hash(str: string): string;
   begin
     with TIdHashSHA1.Create do
@@ -144,66 +197,184 @@ procedure TForm1.Button6Click(Sender: TObject);
   end;
 
 begin
-  if Edit6.Text <> '' then
-    FDTable2.FieldByName('password').AsString := hash(hash(Edit6.Text));
-  FDTable2.Post;
-  FDTable2.Edit;
+  list;
+  FDTable3.ApplyUpdates;
+  FDTable3.CommitUpdates;
+  with FDTable2 do
+  begin
+    Edit;
+    if Edit6.Text <> '' then
+      FieldByName('password').AsString := hash(hash(Edit6.Text));
+    if CheckBox1.Checked = true then
+      i := 1
+    else
+      i := 0;
+    FieldByName('mente').AsInteger := i;
+    if ComboBox1.Items.IndexOf(ComboBox1.Text) = -1 then
+      ComboBox1.ItemIndex := 0;
+    FieldByName('info').AsInteger := FDTable3.Lookup('database',
+      ComboBox1.Text, 'dbnum');
+    FieldByName('count').AsInteger := UpDown1.Position;
+    Post;
+    ApplyUpdates;
+    CommitUpdates;
+  end;
 end;
 
-procedure TForm1.CheckBox1Click(Sender: TObject);
+procedure TForm1.combo;
 var
   i: Integer;
-begin
-  if CheckBox1.Checked = true then
-    i := 1
-  else
-    i := 0;
-  FDTable2.FieldByName('mente').AsInteger := i;
-end;
-
-procedure TForm1.ComboBox1Select(Sender: TObject);
-begin
-  FDQuery1.Open('select * from dbname');
-  FDTable2.FieldByName('info').AsInteger := FDQuery1.Lookup('database',
-    ComboBox1.Text, 'dbnum');
-  FDQuery1.Close;
-end;
-
-procedure TForm1.FormCreate(Sender: TObject);
-var
   s: string;
 begin
-  if FDTable1.Exists = false then
-  begin
-    FDTable1.Close;
-    FDQuery1.ExecSQL;
-    FDTable1.Open;
-  end;
-  FDTable1.Refresh;
-  FDTable2.Refresh;
   ComboBox1.Items.Clear;
-  with FDQuery1 do
+  with FDTable3 do
   begin
-    Open('select * from dbname;');
+    First;
     while Eof = false do
     begin
       s := FieldByName('database').AsString;
-      if s <> 'master' then
-        ComboBox1.Items.Add(s);
+      ComboBox1.Items.Add(s);
       Next;
     end;
     ComboBox1.Text := Lookup('dbnum', FDTable2.FieldByName('info').AsInteger,
       'database');
-    Close;
   end;
+  ListBox1.Items.Text := ComboBox1.Items.Text;
+  i := ComboBox1.Items.IndexOf('master');
+  ComboBox1.Items.Delete(i);
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  FDQuery1.ExecSQL;
+  FDTable1.Open;
+  if FDTable2.Exists = false then
+    FDTable2.CreateTable;
+  FDTable2.Open;
+  FDTable1.Refresh;
+  FDTable2.Refresh;
+  Edit4.Text := FDTable2.FieldByName('title').AsString;
+  Memo1.Lines.Text := FDTable2.FieldByName('title2').AsString;
+  Edit3.Text := FDTable2.FieldByName('ng').AsString;
+  with FDTable3 do
+  begin
+    if Exists = false then
+      CreateTable;
+    Open;
+    if (Bof = true) and (Eof = true) then
+    begin
+      list;
+      ApplyUpdates;
+      CommitUpdates;
+    end;
+    Refresh;
+  end;
+  combo;
   CheckBox1.Checked := FDTable2.FieldByName('mente').AsInteger = 1;
   UpDown1.Position := FDTable2.FieldByName('count').AsInteger;
-  FDTable2.Edit;
 end;
 
-procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
+procedure TForm1.itemsCopy;
+var
+  i: Integer;
+  s: string;
+begin
+  ComboBox1.Items.Clear;
+  for i := 0 to ListBox1.Items.Count - 1 do
+  begin
+    s := ListBox1.Items[i];
+    if s <> 'master' then
+      ComboBox1.Items.Add(s);
+  end;
+  if (ComboBox1.Items.IndexOf(ComboBox1.Text) = -1) and
+    (ComboBox1.Items.Count > 0) then
+    ComboBox1.ItemIndex := 0;
+end;
+
+procedure TForm1.list;
+var
+  i: Integer;
+begin
+  with FDTable3 do
+  begin
+    First;
+    while (Bof = false) or (Eof = false) do
+      Delete;
+    for i := 0 to ListBox1.Items.Count - 1 do
+      AppendRecord([i, ListBox1.Items[i]]);
+  end;
+end;
+
+procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
+  State: TDragState; var Accept: Boolean);
+begin
+  Accept := Source is TListBox;
+end;
+
+procedure TForm1.ListBox1EndDrag(Sender, Target: TObject; X, Y: Integer);
+var
+  i: Integer;
+begin
+  i := ListBox1.ItemAtPos(Point(X, Y), true);
+  if ((X > 0) or (Y > 0)) and (i > -1) then
+  begin
+    ListBox1.Items.Move(item, i);
+    itemsCopy;
+  end;
+end;
+
+procedure TForm1.ListBox1KeyDown(Sender: TObject; var Key: Word;
+  Shift: TShiftState);
+var
+  i: Integer;
 begin
-  FDTable2.FieldByName('count').AsInteger := UpDown1.Position;
+  i := ListBox1.ItemIndex;
+  if (Key = VK_DELETE) and (i > -1) and (ListBox1.Items[i] <> 'master') then
+  begin
+    ListBox1.Items.Delete(i);
+    itemsCopy;
+  end;
+end;
+
+procedure TForm1.ListBox1StartDrag(Sender: TObject;
+  var DragObject: TDragObject);
+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;
+begin
+  s := Edit2.Text;
+  if (s <> '') and (ListBox1.Items.IndexOf(s) = -1) then
+  begin
+    ListBox1.Items.Add(s);
+    ComboBox1.Items.Add(s);
+    Edit2.Text := '';
+    ListBox1.ItemIndex := ListBox1.Items.Count - 1;
+  end;
 end;
 
 end.