Develop and Download Open Source Software

zencart-clone

Browse Subversion Repository

/[zencart-clone]/Unit1.pas

Diff of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1 by yamat0jp, Sun Nov 22 11:18:44 2015 UTC revision 15 by yamat0jp, Fri Aug 5 10:33:26 2016 UTC
# Line 3  unit Unit1; Line 3  unit Unit1;
3  interface  interface
4    
5  uses  uses
6    Classes, SysUtils, IWAppForm, IWApplication, IWColor, IWTypes, IWHTMLControls,    Classes, SysUtils, IWAppForm, IWApplication, IWColor, IWTypes, IWVCLComponent,
   IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompLabel,  
   Vcl.Controls, Vcl.Forms, IWVCLBaseContainer, IWContainer, IWHTMLContainer,  
   IWHTML40Container, IWRegion, 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.IB,  
   FireDAC.Phys.IBDef, Data.DB, FireDAC.Comp.Client, Datasnap.DBClient,  
   Datasnap.Provider, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf,  
   FireDAC.DApt, FireDAC.Comp.DataSet, IWCompGrids, IWDBGrids, IWCompEdit,  
   IWDBStdCtrls, IWCompExtCtrls, IWDBExtCtrls, Unit3, IWVCLComponent,  
7    IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout,    IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout,
8    IWTemplateProcessorHTML, Data.Bind.EngExt, Vcl.Bind.DBEngExt, System.Rtti,    IWTemplateProcessorHTML, Vcl.Controls, Vcl.Forms, Unit2, IWVCLBaseContainer,
9    System.Bindings.Outputs, Vcl.Bind.Editors, Data.Bind.Components,    IWContainer, IWHTMLContainer, IWHTML40Container, IWRegion, IWDBStdCtrls,
10    Data.Bind.DBScope, IWCompListbox, IWCompButton, Web.HTTPApp, Web.HTTPProd,    IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompLabel,
11    Vcl.ImgList, IWImageList, PngImage, IWCompTabControl, IWCompMemo, IWCompText,    IWCompGrids, IWCompText, IWCompTabControl, IWCompButton, IWCompEdit,
12    UserSessionUnit;    IWHTMLControls, IWCompExtCtrls, PngImage, Data.DB,
13      IWCompListbox, IWBaseComponent, IWBaseHTMLComponent, IWBaseHTML40Component,
14      IWCompMenu, Vcl.Menus, System.Variants, Vcl.Dialogs, System.UITypes, Unit8;
15    
16  type  type
17    TTopForm = class(TIWAppForm)    TIWForm1 = class(TIWAppForm)
18      IWRegion1: TIWRegion;      IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;
19      IWLabel1: TIWLabel;      IWLabel1: TIWLabel;
     IWList1: TIWList;  
     IWLink1: TIWLink;  
     IWLabel2: TIWLabel;  
20      IWDBLabel1: TIWDBLabel;      IWDBLabel1: TIWDBLabel;
21      IWFrame1: TIWFrame1;      IWRegion1: TIWRegion;
22        IWRegion2: TIWRegion;
23        IWText1: TIWText;
24        IWGrid1: TIWGrid;
25      IWRegion3: TIWRegion;      IWRegion3: TIWRegion;
     IWLabel3: TIWLabel;  
     IWLabel4: TIWLabel;  
26      IWRegion4: TIWRegion;      IWRegion4: TIWRegion;
27      IWLabel5: TIWLabel;      IWLink1: TIWLink;
28      IWList2: TIWList;      IWLabel2: TIWLabel;
29      IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;      IWList1: TIWList;
30      IWRegion2: TIWRegion;      IWLabel3: TIWLabel;
     IWLabel6: TIWLabel;  
     IWRegion6: TIWRegion;  
31      IWEdit1: TIWEdit;      IWEdit1: TIWEdit;
32      IWButton1: TIWButton;      IWButton1: TIWButton;
     IWImageFile1: TIWImageFile;  
     IWRegion7: TIWRegion;  
     IWLabel8: TIWLabel;  
     IWGrid1: TIWGrid;  
     IWTabControl1: TIWTabControl;  
     IWTabControl1Page0: TIWTabPage;  
     IWTabControl1Page1: TIWTabPage;  
     IWText1: TIWText;  
     IWRegion8: TIWRegion;  
33      IWEdit2: TIWEdit;      IWEdit2: TIWEdit;
34      IWEdit3: TIWEdit;      IWEdit3: TIWEdit;
     IWLabel9: TIWLabel;  
     IWList3: TIWList;  
35      IWLink2: TIWLink;      IWLink2: TIWLink;
36        IWRegion5: TIWRegion;
37        IWLabel7: TIWLabel;
38        IWRegion6: TIWRegion;
39        IWLabel8: TIWLabel;
40        IWList2: TIWList;
41        IWLabel4: TIWLabel;
42        IWRegion7: TIWRegion;
43        IWLabel5: TIWLabel;
44        IWLabel6: TIWLabel;
45        IWList3: TIWList;
46        IWImage1: TIWImage;
47        IWFrame8: TIWFrame8;
48        IWLink4: TIWLink;
49        IWLink3: TIWLink;
50        IWLink5: TIWLink;
51        IWFrame1: TIWFrame1;
52        IWLink6: TIWLink;
53        IWLink7: TIWLink;
54      procedure IWAppFormRender(Sender: TObject);      procedure IWAppFormRender(Sender: TObject);
55      procedure IWLink1Click(Sender: TObject);      procedure IWLink2Click(Sender: TObject);
56      procedure IWAppFormCreate(Sender: TObject);      procedure IWAppFormCreate(Sender: TObject);
57      procedure IWButton1Click(Sender: TObject);      procedure IWButton1Click(Sender: TObject);
58      procedure IWAppFormDestroy(Sender: TObject);      procedure IWLink1Click(Sender: TObject);
59      procedure IWLink2Click(Sender: TObject);      procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);
60        procedure IWFrame8IWButton1Click(Sender: TObject);
61        procedure IWFrame8IWLink1Click(Sender: TObject);
62        procedure IWLink4Click(Sender: TObject);
63        procedure IWLink3Click(Sender: TObject);
64        procedure IWLink5Click(Sender: TObject);
65        procedure IWLink6Click(Sender: TObject);
66    private    private
67      procedure SetPage(const Value: TPage);      Filter: Boolean;
68      function GetPage: TPage;      function GetPage: Boolean;
69        procedure SetPage(const Value: Boolean);
70      procedure LoadImage;      procedure LoadImage;
71      procedure ClearImage;      procedure ClearImage;
72        function GetThumbnail: Boolean;
73        procedure CallBack(EventParams: TStringList);
74        procedure SetThumbnail(const Value: Boolean);
75    public    public
76      property Page: TPage read GetPage write SetPage;      property Page: Boolean read GetPage write SetPage;
77        property Thumbnail: Boolean read GetThumbnail write SetThumbnail;
78    end;    end;
79    
80    var
81      IWForm1: TIWForm1;
82    
83  implementation  implementation
84    
85  {$R *.dfm}  {$R *.dfm}
86    
87  uses Unit2, ServerController, Unit4, Unit6;  uses Unit3, ServerController, Unit6, Unit4, Unit9, Unit10, Unit5, Unit11;
88    
89    procedure TIWForm1.CallBack(EventParams: TStringList);
90    begin
91      if SameText(EventParams.Values['RetValue'], 'true') = true then
92        TCartForm.Create(WebApplication).Show;
93      IWFrame8.IWEdit1.Text := '0';
94    end;
95    
96  procedure TTopForm.ClearImage;  procedure TIWForm1.ClearImage;
97  var  var
98    i, j: integer;    i: Integer;
99      j: Integer;
100  begin  begin
101    for i := 0 to IWGrid1.ColumnCount - 1 do    for i := 0 to IWGrid1.RowCount - 1 do
102      for j := 0 to IWGrid1.RowCount - 1 do      for j := 0 to IWGrid1.ColumnCount - 1 do
103      begin        IWGrid1.Cell[i, j].Control.Free;
104        IWGrid1.Cell[j, i].Control.Free;    IWGrid1.RowCount := 0;
       IWGrid1.Cell[j, i].Control := nil;  
     end;  
105  end;  end;
106    
107  function TTopForm.GetPage: TPage;  function TIWForm1.GetPage: Boolean;
108  begin  begin
109    result := UserSession.FPage;    result := UserSession.FPage;
110  end;  end;
111    
112  procedure TTopForm.IWAppFormCreate(Sender: TObject);  function TIWForm1.GetThumbnail: Boolean;
113    begin
114      result := UserSession.FThumbnail;
115    end;
116    
117    procedure TIWForm1.IWAppFormCreate(Sender: TObject);
118  const  const
119    i = 150;    i = 120;
120  var  var
121    s: integer;    s: Integer;
122  begin  begin
123    s:=DM.FDTable3.FieldByName('BGCOLOR').AsInteger;    IWForm1 := Self;
124    IWLabel1.BGColor := s;    Page := UserSession.FPage;
125      Thumbnail := UserSession.FThumbnail;
126      s := DM.FDTable3.FieldByName('BGCOLOR').AsInteger;
127      IWLabel2.BGColor := s;
128    IWLabel3.BGColor := s;    IWLabel3.BGColor := s;
129    IWLabel5.BGColor := s;    IWLabel5.BGColor := s;
130    IWLabel6.BGColor := s;    IWLabel7.BGColor := s;
131    IWLabel8.BGColor := s;    IWLabel8.BGColor := s;
132    IWRegion1.Width := i;    IWRegion1.Width := i;
133    IWRegion2.Width := i;    IWRegion2.Width := i;
   IWRegion3.Width := i;  
134    IWRegion4.Width := i;    IWRegion4.Width := i;
135      IWRegion5.Width := i;
136      IWRegion6.Width := i;
137    IWRegion7.Width := i;    IWRegion7.Width := i;
138    IWRegion8.Width := i;    WebApplication.RegisterCallBack('callback', CallBack);
   Page := UserSession.FPage;  
 end;  
   
 procedure TTopForm.IWAppFormDestroy(Sender: TObject);  
 begin  
   ClearImage;  
139  end;  end;
140    
141  procedure TTopForm.IWAppFormRender(Sender: TObject);  procedure TIWForm1.IWAppFormRender(Sender: TObject);
142  var  var
143    s: string;    s: string;
144    i, j: integer;    i, j: Integer;
   x: Boolean;  
145  begin  begin
146    IWList1.Items.Clear;    IWList1.Items.Clear;
147    with DM.FDTable2 do    with DM.FDTable2 do
148      if RecordCount > 0 then    begin
149        if Filtered = true then
150      begin      begin
151        First;        FindFirst;
152        while Eof = false do        while Found = true do
153        begin        begin
154          s := FieldByName('CATEGORY').AsString;          s := FieldByName('CATEGORY').AsString;
155          if s = '' then          if s = '' then
156          begin          begin
157            Next;            FindNext;
158            continue;            continue;
159          end;          end;
160          if Filtered = true then          i := IWList1.Items.IndexOfName(s);
161          begin          if i = -1 then
162            i := IWList1.Items.IndexOfName(s);            IWList1.Items.Add(s + '=1')
           if i = -1 then  
             IWList1.Items.Add(s + '=1')  
           else  
           begin  
             j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;  
             IWList1.Items[i] := s + '=' + j.ToString;  
           end;  
         end  
163          else          else
164          begin          begin
165            i := IWList1.Items.IndexOf(s);            j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;
166            if i = -1 then            IWList1.Items[i] := s + '=' + j.ToString;
167              IWList1.Items.Add(s);          end;
168            FindNext;
169          end;
170        end
171        else
172        begin
173          First;
174          while Eof = false do
175          begin
176            s := FieldByName('CATEGORY').AsString;
177            if s = '' then
178            begin
179              Next;
180              continue;
181          end;          end;
182            i := IWList1.Items.IndexOf(s);
183            if i = -1 then
184              IWList1.Items.Add(s);
185          Next;          Next;
186        end;        end;
187      end;      end;
188      end;
189    if DM.FDTable2.Filtered = true then    if DM.FDTable2.Filtered = true then
190      for i := 0 to IWList1.Items.Count - 1 do      for i := 0 to IWList1.Items.Count - 1 do
191      begin      begin
# Line 167  begin Line 195  begin
195        else        else
196          IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';          IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';
197      end;      end;
198    IWList3.Items.Clear;    IWList2.Items.Clear;
199    if Page = Info then    with DM.FDQuery1 do
200    begin    begin
201      with DM.FDQuery1 do      SQL.Clear;
202        SQL.Add('select volume,name,price from cart_data,item_data');
203        SQL.Add(' where cart_data.serial = item_data.serial');
204        SQL.Add(' and number = :num;');
205        ParamByName('num').AsInteger := UserSession.user_number;
206        Open;
207        First;
208        i := 0;
209        while Eof = false do
210      begin      begin
211        SQL.Clear;        s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;
212        SQL.Add('select volume,name,price from cart_data join item_data');        i := i + Fields.Fields[0].AsInteger * Fields.Fields[2].AsInteger;
213        SQL.Add(' on (cart_data.serial = item_data.serial)');        IWList2.Items.Add(s);
214        SQL.Add(' where number = :num;');        Next;
       Params.ParamByName('num').AsInteger := UserSession.user_number;  
       Open;  
       if RecordCount > 0 then  
       begin  
         First;  
         i := 0;  
         while Eof = false do  
         begin  
           s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;  
           inc(i, Fields.Fields[2].AsInteger);  
           IWList3.Items.Add(s);  
           Next;  
         end;  
         IWList3.Items.Add(i.ToString + '円');  
       end;  
       Close;  
215      end;      end;
216      IWList2.Items.Clear;      IWList2.Items.Add(i.ToString + '円');
217      with DM.FDQuery1 do      Close;
218        IWList3.Items.Clear;
219        SQL.Clear;
220        SQL.Add('select name from recent_data,item_data');
221        SQL.Add(' where recent_data.serial = item_data.serial');
222        SQL.Add(' and number = :num;');
223        ParamByName('num').AsInteger := UserSession.user_number;
224        Open;
225        First;
226        while Eof = false do
227      begin      begin
228        SQL.Clear;        IWList3.Items.Add(Fields.Fields[0].AsString);
229        SQL.Add('select name from recent_data join item_data');        Next;
       SQL.Add(' on (recent_data.serial = item_data.serial)');  
       SQL.Add(' where number = :num;');  
       //Params.ParamByName('num').AsInteger:=UserSession.user_number;  
       Open;  
       if RecordCount > 0 then  
       begin  
         First;  
         while Eof = false do  
         begin  
           IWList2.Items.Add(Fields.Fields[0].AsString);  
           Next;  
         end;  
       end;  
       Close;  
230      end;      end;
231        Close;
232    end;    end;
   x := Page = Info;  
   IWRegion4.Visible := x;  
   IWLabel2.Visible := x;  
   IWDBLabel1.Visible := x;  
   IWLink2.Visible := not x;  
233    LoadImage;    LoadImage;
234      if IWGrid1.Visible = true then
235        IWLabel6.Visible := Filter
236      else
237        DM.FDTable2.Locate('SERIAL',UserSession.Serial);
238  end;  end;
239    
240  procedure TTopForm.IWButton1Click(Sender: TObject);  procedure TIWForm1.IWButton1Click(Sender: TObject);
241  const  var
242    filter = 'NAME LIKE ''%s''';    i: Integer;
243  begin  begin
244    if IWEdit1.Text = '' then    IWFrame8IWLink1Click(Sender);
245      DM.FDTable2.Filtered := false    if IWEdit1.Text <> '' then
   else  
246    begin    begin
247      DM.FDTable2.filter := Format(filter, ['%' + IWEdit1.Text + '%']);      DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%' + IWEdit1.Text + '%');
248      DM.FDTable2.Filtered := true;      DM.FDTable2.Filtered := true;
249      IWLabel9.Text := IWEdit1.Text + 'を検索しています';      i := DM.FDTable2.RecordCount;
250        IWLabel6.Caption := Format(IWEdit1.Text + 'を検索しています:%d件', [i]);
251        if i = 0 then
252          DM.FDTable2.Filtered := false;
253        Filter := true;
254      end
255      else
256      begin
257        DM.FDTable2.Filtered := false;
258        Filter := false;
259    end;    end;
   IWLabel9.Visible := DM.FDTable2.Filtered;  
260  end;  end;
261    
262  procedure TTopForm.IWLink1Click(Sender: TObject);  procedure TIWForm1.IWFrame8IWButton1Click(Sender: TObject);
263  const  var
264    filter = 'EMAIL = ''%s'' and PASSWORD = ''%s''';    i, j: Integer;
265      s: string;
266    begin
267      if TryStrToInt(IWFrame8.IWEdit1.Text, i) = false then
268      begin
269        WebApplication.ShowMessage('個数が不正です');
270        Exit;
271      end;
272      if i = 0 then
273      begin
274        WebApplication.ShowMessage('１個以上のご注文が必要です');
275        Exit;
276      end;
277      s := WebApplication.Request.CookieFields.Values['user_cookie'];
278      if s = '' then
279      begin
280        DM.FDTable1.Last;
281        j := DM.FDTable1.FieldByName('NUMBER').AsInteger + 1;
282        while DM.FDTable1.Lookup('NUMBER', j, 'NUMBER') = j do
283          inc(j);
284        UserSession.user_number := j;
285        DM.FDTable1.AppendRecord([nil, nil, nil, nil, nil, nil,
286          UserSession.user_number, Date]);
287        WebApplication.Response.Cookies.AddCookie('user_cookie',
288          UserSession.user_number.ToString, '/', Date + 10);
289      end;
290      with DM.FDQuery1 do
291      begin
292        Open('select * from cart_data;');
293        if Locate('NUMBER;SERIAL', VarArrayOf([UserSession.user_number,
294          UserSession.Serial]), []) = true then
295        begin
296          Edit;
297          FieldByName('VOLUME').AsInteger := FieldByName('VOLUME').AsInteger + i;
298          Post;
299        end
300        else
301          AppendRecord([nil, i, UserSession.user_number, UserSession.Serial]);
302      end;
303      WebApplication.ShowConfirm('カートに移動しますか', 'callback', '移動', 'はい', 'いいえ');
304    end;
305    
306    procedure TIWForm1.IWFrame8IWLink1Click(Sender: TObject);
307    begin
308      Thumbnail := true;
309    end;
310    
311    procedure TIWForm1.IWGrid1CellClick(ASender: TObject;
312      const ARow, AColumn: Integer);
313    begin
314      Thumbnail := false;
315      UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);
316    end;
317    
318    procedure TIWForm1.IWLink1Click(Sender: TObject);
319    begin
320      TUserForm.Create(WebApplication).Show;
321    end;
322    
323    procedure TIWForm1.IWLink2Click(Sender: TObject);
324    var
325      i: Integer;
326  begin  begin
327    case Page of    if Page = true then
328      Main:    begin
329        i := UserSession.user_number;
330        if (DM.FDTable1.Locate('EMAIL;PASSWORD',
331          VarArrayOf([IWEdit2.Text, UserSession.hash(IWEdit3.Text)]),
332          [loCaseInsensitive]) = true) and
333          (DM.FDTable1.FieldByName('EMAIL').AsString <> '') then
334        begin
335          IWEdit2.Text := '';
336          UserSession.user_number := DM.FDTable1.FieldByName('NUMBER').AsInteger;
337          if i <> 0 then
338        begin        begin
339          DM.FDTable1.filter := Format(filter, [IWEdit2.Text, IWEdit3.Text]);          with DM.FDQuery1 do
         DM.FDTable1.Filtered := true;  
         if DM.FDTable1.RecordCount = 1 then  
340          begin          begin
341            IWLink1.Caption := 'ログアウト';            Open('select * from user_data where number = :num', [i]);
342            Page := Info;            Delete;
343            UserSession.user_number := DM.FDTable1.FieldByName('NUMBER')            Open('select number from cart_data where number = :num;', [i]);
344              .AsInteger;            First;
345            IWEdit2.Text := '';            while Eof = false do
346              begin
347                Edit;
348                FieldByName('number').AsInteger := UserSession.user_number;
349                Next;
350              end;
351          end;          end;
         IWEdit3.Text := '';  
       end;  
     Info:  
       begin  
         DM.FDTable1.Filtered := false;  
         IWLink1.Caption := 'ログイン';  
         Page := Main;  
         DM.FDQuery1.Params.ParamByName('num').AsInteger := 0;  
352        end;        end;
353          Page := false;
354        end;
355        IWEdit3.Text := '';
356      end
357      else
358        Page := true;
359    end;
360    
361    procedure TIWForm1.IWLink3Click(Sender: TObject);
362    begin
363      with TMyPage.Create(WebApplication) do
364      begin
365        Form := Self;
366        Show;
367    end;    end;
   IWLabel9.Visible := UserSession.user_number <> 0;  
368  end;  end;
369    
370  procedure TTopForm.IWLink2Click(Sender: TObject);  procedure TIWForm1.IWLink4Click(Sender: TObject);
371  begin  begin
372    UserSession.FPage := Info;    TCartForm.Create(WebApplication).Show;
373    TUserForm.Create(WebApplication).Show;  end;
374    
375    procedure TIWForm1.IWLink5Click(Sender: TObject);
376    begin
377      TIWForm10.Create(WebApplication).Show;
378  end;  end;
379    
380  procedure TTopForm.LoadImage;  procedure TIWForm1.IWLink6Click(Sender: TObject);
381    begin
382      Page := true;
383      if Sender = IWLink6 then
384        TAdminPage.Create(WebApplication).Show
385      else
386        TAdminFile.Create(WebApplication).Show;
387    end;
388    
389    procedure TIWForm1.LoadImage;
390  var  var
391    i, j, k: integer;    s: TStream;
392    png: TPngImage;    png: TPngImage;
393    pic: TIWImageFile;    pic: TIWImage;
394    st: TStream;    i: Integer;
395      j: Integer;
396      t: string;
397  label label1;  label label1;
398  begin  begin
399    ClearImage;    ClearImage;
400    if DM.FDTable2.RecordCount > 0 then    png := TPngImage.Create;
401    begin    try
402      IWGrid1.RowCount := (DM.FDTable2.RecordCount div IWGrid1.ColumnCount) + 1;      if Thumbnail = true then
403      k := 1;      begin
404      DM.FDTable2.Last;        i := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
405      png := TPngImage.Create;        if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then
406      try          inc(i);
407          IWGrid1.RowCount := i;
408          if DM.FDTable2.Filtered = false then
409            DM.FDTable2.Last
410          else
411            DM.FDTable2.FindLast;
412        for i := 0 to IWGrid1.RowCount - 1 do        for i := 0 to IWGrid1.RowCount - 1 do
       begin  
413          for j := 0 to IWGrid1.ColumnCount - 1 do          for j := 0 to IWGrid1.ColumnCount - 1 do
414          begin          begin
415            st := DM.FDTable2.CreateBlobStream            if DM.FDTable2.Filtered = false then
416              (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);            begin
417            try              if DM.FDTable2.Bof = true then
418              png.LoadFromStream(st);                goto label1;
419              pic := TIWImageFile.Create(Self);            end
420              else if DM.FDTable2.Found = false then
421                goto label1;
422              if DM.FDTable2.FieldByName('THUMBNAIL').IsNull = false then
423              begin
424                s := DM.FDTable2.CreateBlobStream
425                  (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
426                try
427                  png.LoadFromStream(s);
428                finally
429                  s.Free;
430                end;
431                pic := TIWImage.Create(IWGrid1);
432              pic.Picture.Assign(png);              pic.Picture.Assign(png);
433              IWGrid1.Cell[i, j].Control := pic;              IWGrid1.Cell[i, j].Control := pic;
             IWGrid1.Cell[i, j].Text := k.ToString;  
             inc(k);  
             DM.FDTable2.Prior;  
           finally  
             st.Free;  
434            end;            end;
435            if DM.FDTable2.Bof = true then            t := DM.FDTable2.FieldByName('NAME').AsString;
436              goto label1;            if Length(t) > 10 then
437                t := Copy(t, 1, 8) + '..';
438              IWGrid1.Cell[i, j].Tag :=
439                Pointer(DM.FDTable2.FieldByName('SERIAL').AsInteger);
440              IWGrid1.Cell[i, j].Text := t;
441              IWGrid1.Cell[i, j].Alignment := taCenter;
442              IWGrid1.Cell[i, j].Clickable := true;
443              if DM.FDTable2.Filtered = false then
444                DM.FDTable2.Prior
445              else
446                DM.FDTable2.FindPrior;
447          end;          end;
       end;  
448      label1:      label1:
449        end
450        else if DM.FDTable2.Locate('SERIAL', UserSession.Serial, []) = true then
451          if DM.FDTable2.FieldByName('IMAGE').IsNull = false then
452          begin
453            s := DM.FDTable2.CreateBlobStream
454              (DM.FDTable2.FieldByName('IMAGE'), bmRead);
455            try
456              png.LoadFromStream(s);
457            finally
458              s.Free;
459            end;
460            IWFrame8.IWImage1.Picture.Assign(png);
461          end
462          else
463            IWFrame8.IWImage1.Picture.Assign(nil);
464      finally
465        png.Free;
466      end;
467      Randomize;
468      DM.FDTableView.Filter := 'DATE > '+QuotedStr(DateTimeToStr(Date-10));
469      DM.FDTableView.First;
470      DM.FDTableView.MoveBy(Random(DM.FDTableView.RecordCount));
471      if DM.FDTableView.FieldByName('THUMBNAIL').IsNull = false then
472      begin
473        s := DM.FDTableView.CreateBlobStream
474          (DM.FDTableView.FieldByName('THUMBNAIL'), bmRead);
475        png := TPngImage.Create;
476        try
477          png.LoadFromStream(s);
478          IWImage1.Picture.Assign(png);
479      finally      finally
480        png.Free;        png.Free;
481          s.Free;
482      end;      end;
   end  
   else  
     IWGrid1.RowCount := 0;  
   st := nil;  
   png := nil;  
   Randomize;  
   DM.FDTable2.Last;  
   DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));  
   st := DM.FDTable2.CreateBlobStream  
     (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);  
   png := TPngImage.Create;  
   try  
     png.LoadFromStream(st);  
     IWImageFile1.Picture.Assign(png);  
   finally  
     st.Free;  
     png.Free;  
483    end;    end;
484    IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;    IWLabel4.Caption := DM.FDTableView.FieldByName('NAME').AsString;
485  end;  end;
486    
487  procedure TTopForm.SetPage(const Value: TPage);  procedure TIWForm1.SetPage(const Value: Boolean);
 var  
   s: string;  
488  begin  begin
489    UserSession.FPage := Value;    UserSession.FPage := Value;
490    case Value of    IWRegion7.Visible := not Value;
491      Main:    IWDBLabel1.Visible := not Value;
492        s := 'toppage.htm';    IWLink3.Visible := not Value;
493      Info:    IWLink1.Visible := Value;
494        s := 'mypage.htm';    IWText1.Visible := Value;
495      if Value = false then
496      begin
497        IWLabel1.Caption := 'ようこそ';
498        IWLink2.Caption := 'ログアウト';
499        WebApplication.Response.Cookies.AddCookie('user_cookie',
500          UserSession.user_number.ToString, '/', Date + 10);
501      end
502      else
503      begin
504        IWLabel1.Caption := 'ようこそゲスト様';
505        IWLink2.Caption := 'ログイン';
506        Thumbnail := true;
507        IWText1.Text := '';
508        DM.FDTable2.Filtered := false;
509        Filter := false;
510        if DM.FDTable1.FieldByName('EMAIL').AsString <> '' then
511        begin
512          WebApplication.Response.Cookies.AddCookie('user_cookie', '0', '/',
513            Date - 1);
514          UserSession.user_number := 0;
515        end;
516    end;    end;
517    IWTemplateProcessorHTML1.Templates.Default := s;  end;
518    
519    procedure TIWForm1.SetThumbnail(const Value: Boolean);
520    begin
521      UserSession.FThumbnail := Value;
522      IWGrid1.Visible := Value;
523      IWFrame8.Visible := not Value;
524  end;  end;
525    
526  initialization  initialization
527    
528  TTopForm.SetAsMainForm;  TIWForm1.SetAsMainForm;
529    
530  end.  end.
Legend:
Removed from v.1  
changed lines
  Added in v.15
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help