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 18 by yamat0jp, Sat Aug 27 11:00:30 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);      Filter: Boolean;
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 DM.FDTable2.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      for i := 0 to IWList1.Items.Count - 1 do      for i := 0 to IWList1.Items.Count - 1 do
187      begin      begin
188        s := IWList1.Items.ValueFromIndex[i];        s := IWList1.Items.ValueFromIndex[i];
189        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 + ')';  
190      end;      end;
191    IWList3.Items.Clear;    IWList2.Items.Clear;
192    if Page = Info then    with DM.FDQuery1 do
193    begin    begin
194      with DM.FDQuery1 do      SQL.Clear;
195        SQL.Add('select volume,name,price from cart_data,item_data');
196        SQL.Add(' where cart_data.serial = item_data.serial');
197        SQL.Add(' and number = :num;');
198        ParamByName('num').AsInteger := UserSession.user_number;
199        Open;
200        First;
201        i := 0;
202        while Eof = false do
203      begin      begin
204        SQL.Clear;        s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;
205        SQL.Add('select volume,name,price from cart_data join item_data');        i := i + Fields.Fields[0].AsInteger * Fields.Fields[2].AsInteger;
206        SQL.Add(' on (cart_data.serial = item_data.serial)');        IWList2.Items.Add(s);
207        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;  
208      end;      end;
209      IWList2.Items.Clear;      IWList2.Items.Add(i.ToString + '円');
210      with DM.FDQuery1 do      Close;
211        IWList3.Items.Clear;
212        SQL.Clear;
213        SQL.Add('select name from recent_data,item_data');
214        SQL.Add(' where recent_data.serial = item_data.serial');
215        SQL.Add(' and number = :num;');
216        ParamByName('num').AsInteger := UserSession.user_number;
217        Open;
218        First;
219        while Eof = false do
220      begin      begin
221        SQL.Clear;        IWList3.Items.Add(Fields.Fields[0].AsString);
222        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;  
223      end;      end;
224        Close;
225    end;    end;
   x := Page = Info;  
   IWRegion4.Visible := x;  
   IWLabel2.Visible := x;  
   IWDBLabel1.Visible := x;  
   IWLink2.Visible := not x;  
226    LoadImage;    LoadImage;
227      if IWGrid1.Visible = false then
228        DM.FDTable2.Locate('SERIAL', UserSession.Serial);
229  end;  end;
230    
231  procedure TTopForm.IWButton1Click(Sender: TObject);  procedure TIWForm1.IWButton1Click(Sender: TObject);
232  const  var
233    filter = 'NAME LIKE ''%s''';    i: Integer;
234    label searchout;
235  begin  begin
236    if IWEdit1.Text = '' then    IWFrame8IWLink1Click(Sender);
237      DM.FDTable2.Filtered := false    if IWEdit1.Text <> '' then
238      begin
239        DM.FDTable2.Filter := table2filter + ' and NAME like ' +
240          QuotedStr('%' + IWEdit1.Text + '%');
241        i := DM.FDTable2.RecordCount;
242        if i = 0 then
243          goto searchout
244        else
245        begin
246          IWLabel6.Caption := Format(IWEdit1.Text + 'を検索しています:%d件', [i]);
247          IWLabel6.Visible := true;
248        end;
249      end
250    else    else
251    begin    begin
252      DM.FDTable2.filter := Format(filter, ['%' + IWEdit1.Text + '%']);    searchout:
253      DM.FDTable2.Filtered := true;      DM.FDTable2.Filter := table2filter;
254      IWLabel9.Text := IWEdit1.Text + 'を検索しています';      IWLabel6.Visible := false;
255    end;    end;
   IWLabel9.Visible := DM.FDTable2.Filtered;  
256  end;  end;
257    
258  procedure TTopForm.IWLink1Click(Sender: TObject);  procedure TIWForm1.IWFrame8IWButton1Click(Sender: TObject);
259  const  var
260    filter = 'EMAIL = ''%s'' and PASSWORD = ''%s''';    i, j: Integer;
261      s: string;
262  begin  begin
263    case Page of    if TryStrToInt(IWFrame8.IWEdit1.Text, i) = false then
264      Main:    begin
265        begin      WebApplication.ShowMessage('個数が不正です');
266          DM.FDTable1.filter := Format(filter, [IWEdit2.Text, IWEdit3.Text]);      Exit;
267          DM.FDTable1.Filtered := true;    end;
268          if DM.FDTable1.RecordCount = 1 then    if i = 0 then
269          begin    begin
270            IWLink1.Caption := 'ログアウト';      WebApplication.ShowMessage('１個以上のご注文が必要です');
271            Page := Info;      Exit;
272            UserSession.user_number := DM.FDTable1.FieldByName('NUMBER')    end;
273              .AsInteger;    s := WebApplication.Request.CookieFields.Values['user_cookie'];
274            IWEdit2.Text := '';    if s = '' then
275          end;    begin
276          IWEdit3.Text := '';      DM.FDTable1.Last;
277        end;      j := DM.FDTable1.FieldByName('NUMBER').AsInteger + 1;
278      Info:      while DM.FDTable1.Lookup('NUMBER', j, 'NUMBER') = j do
279        begin        inc(j);
280          DM.FDTable1.Filtered := false;      UserSession.user_number := j;
281          IWLink1.Caption := 'ログイン';      DM.FDTable1.AppendRecord([nil, nil, nil, nil, nil, nil,
282          Page := Main;        UserSession.user_number, Date]);
283          DM.FDQuery1.Params.ParamByName('num').AsInteger := 0;      WebApplication.Response.Cookies.AddCookie('user_cookie',
284        end;        UserSession.user_number.ToString, '/', Date + 10);
285    end;    end;
286    IWLabel9.Visible := UserSession.user_number <> 0;    with DM.FDQuery1 do
287      begin
288        Open('select * from cart_data;');
289        if Locate('NUMBER;SERIAL', VarArrayOf([UserSession.user_number,
290          UserSession.Serial]), []) = true then
291        begin
292          Edit;
293          FieldByName('VOLUME').AsInteger := FieldByName('VOLUME').AsInteger + i;
294          Post;
295        end
296        else
297          AppendRecord([nil, i, UserSession.user_number, UserSession.Serial]);
298      end;
299      WebApplication.ShowConfirm('カートに移動しますか', 'callback', '移動', 'はい', 'いいえ');
300  end;  end;
301    
302  procedure TTopForm.IWLink2Click(Sender: TObject);  procedure TIWForm1.IWFrame8IWLink1Click(Sender: TObject);
303    begin
304      Thumbnail := true;
305    end;
306    
307    procedure TIWForm1.IWGrid1CellClick(ASender: TObject;
308      const ARow, AColumn: Integer);
309    begin
310      Thumbnail := false;
311      UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);
312    end;
313    
314    procedure TIWForm1.IWLink1Click(Sender: TObject);
315  begin  begin
   UserSession.FPage := Info;  
316    TUserForm.Create(WebApplication).Show;    TUserForm.Create(WebApplication).Show;
317  end;  end;
318    
319  procedure TTopForm.LoadImage;  procedure TIWForm1.IWLink2Click(Sender: TObject);
320  var  var
321    i, j, k: integer;    i: Integer;
   png: TPngImage;  
   pic: TIWImageFile;  
   st: TStream;  
 label label1;  
322  begin  begin
323    ClearImage;    if Page = true then
   if DM.FDTable2.RecordCount > 0 then  
324    begin    begin
325      IWGrid1.RowCount := (DM.FDTable2.RecordCount div IWGrid1.ColumnCount) + 1;      i := UserSession.user_number;
326      k := 1;      if (DM.FDTable1.Locate('EMAIL;PASSWORD',
327      DM.FDTable2.Last;        VarArrayOf([IWEdit2.Text, UserSession.hash(IWEdit3.Text)]),
328      png := TPngImage.Create;        [loCaseInsensitive]) = true) and
329      try        (DM.FDTable1.FieldByName('EMAIL').AsString <> '') then
330        for i := 0 to IWGrid1.RowCount - 1 do      begin
331          IWEdit2.Text := '';
332          UserSession.user_number := DM.FDTable1.FieldByName('NUMBER').AsInteger;
333          if i <> 0 then
334        begin        begin
335          for j := 0 to IWGrid1.ColumnCount - 1 do          with DM.FDQuery1 do
336          begin          begin
337            st := DM.FDTable2.CreateBlobStream            Open('select * from user_data where number = :num', [i]);
338              (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);            Delete;
339            try            Open('select number from cart_data where number = :num;', [i]);
340              png.LoadFromStream(st);            First;
341              pic := TIWImageFile.Create(Self);            while Eof = false do
342              pic.Picture.Assign(png);            begin
343              IWGrid1.Cell[i, j].Control := pic;              Edit;
344              IWGrid1.Cell[i, j].Text := k.ToString;              FieldByName('number').AsInteger := UserSession.user_number;
345              inc(k);              Next;
             DM.FDTable2.Prior;  
           finally  
             st.Free;  
346            end;            end;
           if DM.FDTable2.Bof = true then  
             goto label1;  
347          end;          end;
348        end;        end;
349      label1:        Page := false;
     finally  
       png.Free;  
350      end;      end;
351        IWEdit3.Text := '';
352    end    end
353    else    else
354      IWGrid1.RowCount := 0;      Page := true;
355    st := nil;  end;
356    png := nil;  
357    Randomize;  procedure TIWForm1.IWLink3Click(Sender: TObject);
358    DM.FDTable2.Last;  begin
359    DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));    with TMyPage.Create(WebApplication) do
360    st := DM.FDTable2.CreateBlobStream    begin
361      (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);      Form := Self;
362    png := TPngImage.Create;      Show;
   try  
     png.LoadFromStream(st);  
     IWImageFile1.Picture.Assign(png);  
   finally  
     st.Free;  
     png.Free;  
363    end;    end;
   IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;  
364  end;  end;
365    
366  procedure TTopForm.SetPage(const Value: TPage);  procedure TIWForm1.IWLink4Click(Sender: TObject);
367    begin
368      TCartForm.Create(WebApplication).Show;
369    end;
370    
371    procedure TIWForm1.IWLink5Click(Sender: TObject);
372    begin
373      TIWForm10.Create(WebApplication).Show;
374    end;
375    
376    procedure TIWForm1.IWLink6Click(Sender: TObject);
377    begin
378      Page := true;
379      if Sender = IWLink6 then
380        TAdminPage.Create(WebApplication).Show
381      else
382        TAdminFile.Create(WebApplication).Show;
383    end;
384    
385    procedure TIWForm1.IWLink8Click(Sender: TObject);
386    begin
387      TMasterForm.Create(WebApplication).Show;
388    end;
389    
390    procedure TIWForm1.LoadImage;
391  var  var
392    s: string;    pic: TIWImage;
393      i: Integer;
394      j: Integer;
395      t: string;
396    label label1;
397    begin
398      ClearImage;
399      if Thumbnail = true then
400      begin
401        i := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
402        if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then
403          inc(i);
404        IWGrid1.RowCount := i;
405        DM.FDTable2.FindLast;
406        for i := 0 to IWGrid1.RowCount - 1 do
407          for j := 0 to IWGrid1.ColumnCount - 1 do
408          begin
409            if DM.FDTable2.Found = false then
410              goto label1;
411            pic := TIWImage.Create(IWGrid1);
412            UserSession.FieldToImg(pic.Picture,
413              DM.FDTable2.FieldByName('THUMBNAIL'));
414            IWGrid1.Cell[i, j].Control := pic;
415            t := DM.FDTable2.FieldByName('NAME').AsString;
416            if Length(t) > 10 then
417              t := Copy(t, 1, 8) + '..';
418            IWGrid1.Cell[i, j].Tag :=
419              Pointer(DM.FDTable2.FieldByName('SERIAL').AsInteger);
420            IWGrid1.Cell[i, j].Text := t;
421            IWGrid1.Cell[i, j].Alignment := taCenter;
422            IWGrid1.Cell[i, j].Clickable := true;
423            DM.FDTable2.FindPrior;
424          end;
425      label1:
426      end
427      else if DM.FDTable2.Locate('SERIAL', UserSession.Serial, []) = true then
428        UserSession.FieldToImg(IWFrame8.IWImage1.Picture,
429          DM.FDTable2.FieldByName('IMAGE'));
430      Randomize;
431      DM.FDTableView.Filter := 'DATE > ' + QuotedStr(DateTimeToStr(Date - 10));
432      DM.FDTableView.First;
433      DM.FDTableView.MoveBy(Random(DM.FDTableView.RecordCount));
434      UserSession.FieldToImg(IWImage1.Picture,
435        DM.FDTableView.FieldByName('THUMBNAIL'));
436      IWLabel4.Caption := DM.FDTableView.FieldByName('NAME').AsString;
437    end;
438    
439    procedure TIWForm1.SetPage(const Value: Boolean);
440  begin  begin
441    UserSession.FPage := Value;    UserSession.FPage := Value;
442    case Value of    IWRegion7.Visible := not Value;
443      Main:    IWDBLabel1.Visible := not Value;
444        s := 'toppage.htm';    IWLink3.Visible := not Value;
445      Info:    IWLink1.Visible := Value;
446        s := 'mypage.htm';    IWText1.Visible := Value;
447      if Value = false then
448      begin
449        IWLabel1.Caption := 'ようこそ';
450        IWLink2.Caption := 'ログアウト';
451        WebApplication.Response.Cookies.AddCookie('user_cookie',
452          UserSession.user_number.ToString, '/', Date + 10);
453      end
454      else
455      begin
456        IWLabel1.Caption := 'ようこそゲスト様';
457        IWLink2.Caption := 'ログイン';
458        Thumbnail := true;
459        IWText1.Text := '';
460        DM.FDTable2.Filtered := false;
461        Filter := false;
462        if DM.FDTable1.FieldByName('EMAIL').AsString <> '' then
463        begin
464          WebApplication.Response.Cookies.AddCookie('user_cookie', '0', '/',
465            Date - 1);
466          UserSession.user_number := 0;
467        end;
468    end;    end;
469    IWTemplateProcessorHTML1.Templates.Default := s;  end;
470    
471    procedure TIWForm1.SetThumbnail(const Value: Boolean);
472    begin
473      UserSession.FThumbnail := Value;
474      IWGrid1.Visible := Value;
475      IWFrame8.IWEdit1.Text := '1';
476      IWFrame8.Visible := not Value;
477  end;  end;
478    
479  initialization  initialization
480    
481  TTopForm.SetAsMainForm;  TIWForm1.SetAsMainForm;
482    
483  end.  end.
Legend:
Removed from v.1  
changed lines
  Added in v.18
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help