FDQueryも使ってそれらしくなってきました。

diff --git a/Unit1.dfm b/Unit1.dfm
index 1e42a70..d3580d6 100644 (file)
--- a/Unit1.dfm
+++ b/Unit1.dfm
@@ -1,6 +1,6 @@
 object DataModule1: TDataModule1
   OldCreateOrder = False
-  Height = 230
+  Height = 231
   Width = 302
   object FDTable1: TFDTable
     Active = True
@@ -80,7 +80,7 @@ object DataModule1: TDataModule1
     end
     object FDTable2DATE: TDateField
       FieldName = 'DATE'
-      Origin = '"DATE"'
+      Origin = 'DATE'
     end
     object FDTable2PASS: TWideStringField
       FieldName = 'PASS'
@@ -194,4 +194,13 @@ object DataModule1: TDataModule1
       Origin = 'SOURCE'
     end
   end
+  object FDQuery1: TFDQuery
+    Connection = FDConnection1
+    SQL.Strings = (
+      'select "DATABASE", title, name, "DATE" from'
+      ' dbname inner join article on dbname.dbnum = article.dbnum'
+      ' where number = 1 order by "DATE";')
+    Left = 160
+    Top = 144
+  end
 end

diff --git a/Unit1.pas b/Unit1.pas
index b8c82fa..1548ed1 100644 (file)
--- a/Unit1.pas
+++ b/Unit1.pas
@@ -10,7 +10,7 @@ uses
   FireDAC.Phys.SQLiteDef, FireDAC.Stan.ExprFuncs, Data.DB, FireDAC.Comp.Client,
   FireDAC.Comp.DataSet, FireDAC.Phys.IB, FireDAC.Phys.IBLiteDef,
   FireDAC.VCLUI.Wait, FireDAC.Comp.UI, FireDAC.Phys.MySQL, FireDAC.Phys.MySQLDef,
-  FireDAC.Phys.IBDef;
+  FireDAC.Phys.IBDef, Data.FMTBcd, Data.DBXInterBase, Data.SqlExpr;
 
 type
   TDataModule1 = class(TDataModule)
@@ -20,7 +20,6 @@ type
     FDTable3: TFDTable;
     FDGUIxWaitCursor1: TFDGUIxWaitCursor;
     DataSource1: TDataSource;
-    FDTable1DATABASE: TWideStringField;
     FDTable1DBNUM: TIntegerField;
     FDTable4: TFDTable;
     FDTable4DBNAME: TIntegerField;
@@ -47,6 +46,8 @@ type
     FDTable5ID: TIntegerField;
     FDTable5NAME: TWideStringField;
     FDTable5SOURCE: TBlobField;
+    FDQuery1: TFDQuery;
+    FDTable1DATABASE: TWideStringField;
   private
     { Private \90é\8c¾ }
   public

diff --git a/WebModuleUnit1.dfm b/WebModuleUnit1.dfm
index d1d98f5..f48e77d 100644 (file)
--- a/WebModuleUnit1.dfm
+++ b/WebModuleUnit1.dfm
@@ -97,6 +97,11 @@ object TWebModule1: TTWebModule1
       Name = 'file'
       PathInfo = '/file'
       OnAction = TWebModule1fileAction
+    end
+    item
+      Name = 'title'
+      PathInfo = '/title'
+      OnAction = TWebModule1titleAction
     end>
   Height = 385
   Width = 436
@@ -361,6 +366,7 @@ object TWebModule1: TTWebModule1
       ''
       #9'<div class="slideshow-indicator"></div>'
       '</div>'
+      '<p>'#12288'<em style="background-color: aqua;">'#12288#12288#12288#12288'</em>'#12539#12539#12539'new!'
       
         '        <p>[ <a href=/index?db=<#dbnum>><#info></a> ] ='#12362#30693#12425#12379' <p>[' +
         ' <a href="/master">master'
@@ -374,6 +380,7 @@ object TWebModule1: TTWebModule1
         'counter.php?id=pybbs" border="0"></a>'
       '<footer>'
       '<p><br>'
+      '<p><a href=/title>'#12479#12452#12488#12523#34920#31034'</a>'
       '<p><a href="/help">'#20351#12356#26041#26696#20869
       '</a>'
       '<p><a href=/search>'#26908#32034'</a>'
@@ -1833,4 +1840,81 @@ object TWebModule1: TTWebModule1
     Left = 176
     Top = 88
   end
+  object js5: TPageProducer
+    HTMLDoc.Strings = (
+      ''
+      '$(function(){'
+      #9'$('#39'div'#39').on('#39'click'#39',function(){'
+      #9#9'var $title = $(this),'
+      #9#9#9'span1 = 1500,'
+      #9#9#9'span2 = 200;'
+      #9#9'$title.css('#39'font-size'#39','#39'2em'#39');'
+      #9#9'$({deg:5}).animate({deg:365},{'
+      #9#9#9'duration:500,'
+      #9#9#9'progress:function(){'
+      #9#9#9#9'$title.css({'
+      #9#9#9#9#9#39'-webkit-transform'#39':'#39'rotate('#39'+this.deg+'#39'deg)'#39','
+      #9#9#9#9#9#39'-ms-transform'#39':'#39'rotate('#39'+this.deg+'#39'deg)'#39','
+      #9#9#9#9#9#39'ransform'#39':'#39'rotate('#39'+this.deg+'#39'deg)'#39
+      #9#9#9#9'});'
+      #9#9#9'}'
+      #9#9'});'
+      #9#9'$({deg:5}).delay(span1).animate({deg:0},{'
+      #9#9#9'duration:span2,'
+      #9#9#9'progress:function(){'
+      #9#9#9#9'$title.css({'#9
+      #9#9#9#9#9#39'-webkit-transform'#39':'#39'rotate('#39'+this.deg+'#39'deg)'#39','
+      #9#9#9#9#9#39'-ms-transform'#39':'#39'rotate('#39'+this.deg+'#39'deg)'#39','
+      #9#9#9#9#9#39'transform'#39':'#39'rotate('#39'+this.deg+'#39'deg)'#39
+      #9#9#9#9'});'
+      #9#9#9'}'
+      #9#9'});'
+      #9#9'$title.delay(span1+span2).animate({'#39'font-size'#39':'#39'1em'#39'},1);'
+      #9'});'
+      '});'
+      '')
+    Left = 104
+    Top = 272
+  end
+  object title: TPageProducer
+    HTMLDoc.Strings = (
+      '<!doctype html>'
+      '<html>'
+      '<head>'
+      '<meta charset=utf-8>'
+      '<title>'#12479#12452#12488#12523#34920#31034'</title>'
+      
+        '<script type="text/javascript" src="//ajax.googleapis.com/ajax/l' +
+        'ibs/jquery/2.1.4/jquery.min.js"></script>'
+      
+        '<link rel="stylesheet" href="//ajax.googleapis.com/ajax/libs/jqu' +
+        'eryui/1.10.4/themes/smoothness/jquery-ui.css" />'
+      
+        '<script src="//ajax.googleapis.com/ajax/libs/jqueryui/1.10.4/jqu' +
+        'ery-ui.min.js"></script>'
+      '<script>'
+      '<!--'
+      '<#js id=5>'
+      '-->'
+      '</script>'
+      '</head>'
+      '<body>'
+      '<#main>'
+      '<p style=text-align:center><a href=/>'#25147#12427'</a>'
+      '</body>'
+      '</html>')
+    OnHTMLTag = titleHTMLTag
+    Left = 48
+    Top = 256
+  end
+  object ti: TDataSetPageProducer
+    HTMLDoc.Strings = (
+      '<p><em><#database>'#8595'</em>'
+      '<div>'#12479#12452#12488#12523': '#39'<#title> , '#35352#20107#25968': <#count> , '#26356#26032#26178#21051': <#date></div><p>'
+      '')
+    DataSet = DataModule1.FDQuery1
+    OnHTMLTag = tiHTMLTag
+    Left = 48
+    Top = 320
+  end
 end

diff --git a/WebModuleUnit1.pas b/WebModuleUnit1.pas
index 1438fb8..8334404 100644 (file)
--- a/WebModuleUnit1.pas
+++ b/WebModuleUnit1.pas
@@ -4,7 +4,7 @@ interface
 
 uses System.SysUtils, System.Classes, Web.HTTPApp, Web.DSProd, Web.HTTPProd,
   Web.DBWeb, System.Variants, System.NetEncoding, System.RegularExpressions,
-  Data.DB;
+  Data.DB, Web.DBXpressWeb;
 
 type
   TTWebModule1 = class(TWebModule)
@@ -30,6 +30,9 @@ type
     js3: TPageProducer;
     js4: TPageProducer;
     adhead: TPageProducer;
+    js5: TPageProducer;
+    title: TPageProducer;
+    ti: TDataSetPageProducer;
     procedure indexHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
       TagParams: TStrings; var ReplaceText: string);
     procedure TWebModule1indexpageAction(Sender: TObject; Request: TWebRequest;
@@ -90,6 +93,12 @@ type
       Response: TWebResponse; var Handled: Boolean);
     procedure TWebModule1fileAction(Sender: TObject; Request: TWebRequest;
       Response: TWebResponse; var Handled: Boolean);
+    procedure titleHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
+      TagParams: TStrings; var ReplaceText: string);
+    procedure TWebModule1titleAction(Sender: TObject; Request: TWebRequest;
+      Response: TWebResponse; var Handled: Boolean);
+    procedure tiHTMLTag(Sender: TObject; Tag: TTag; const TagString: string;
+      TagParams: TStrings; var ReplaceText: string);
   private
     { private \90é\8c¾ }
     ss: TStringList;
@@ -267,7 +276,7 @@ begin
   else if TagString = 'header' then
   begin
     i := DataModule1.FDTable3.FieldByName('count').AsInteger;
-    if 10 * i < DataModule1.FDTable2.RecordCount then
+    if 10 * i <= DataModule1.FDTable2.RecordCount then
       ReplaceText := '<h1>\82±\82ê\88È\8fã\93\8a\8de\82Å\82«\82Ü\82¹\82ñ.</h1>'
     else
       ReplaceText := header.Content;
@@ -459,6 +468,35 @@ begin
     ReplaceText := css2.Content;
 end;
 
+procedure TTWebModule1.tiHTMLTag(Sender: TObject; Tag: TTag;
+  const TagString: string; TagParams: TStrings; var ReplaceText: string);
+begin
+  if TagString = 'count' then
+  begin
+    DataModule1.FDTable1.Locate('database',
+      DataModule1.FDQuery1.FieldByName('database').AsString);
+    ReplaceText := DataModule1.FDTable2.RecordCount.ToString;
+  end;
+end;
+
+procedure TTWebModule1.titleHTMLTag(Sender: TObject; Tag: TTag;
+  const TagString: string; TagParams: TStrings; var ReplaceText: string);
+begin
+  if TagString = 'js' then
+    ReplaceText := detail(TagString, TagParams.Values['id'])
+  else
+    with DataModule1.FDQuery1 do
+    begin
+      Open;
+      while Eof = false do
+      begin
+        ReplaceText := ReplaceText + ti.Content;
+        Next;
+      end;
+      Close;
+    end;
+end;
+
 procedure TTWebModule1.topHTMLTag(Sender: TObject; Tag: TTag;
   const TagString: string; TagParams: TStrings; var ReplaceText: string);
 var
@@ -922,6 +960,13 @@ begin
   Response.Content := search.Content;
 end;
 
+procedure TTWebModule1.TWebModule1titleAction(Sender: TObject;
+  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
+begin
+  Response.ContentType := 'text/html;charset=utf-8';
+  Response.Content := title.Content;
+end;
+
 procedure TTWebModule1.TWebModule1topAction(Sender: TObject;
   Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 begin