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