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 3 by yamat0jp, Sat Dec 26 07:30:17 2015 UTC revision 10 by yamat0jp, Sat Jan 16 23:06:35 2016 UTC
# Line 9  uses Line 9  uses
9    IWContainer, IWHTMLContainer, IWHTML40Container, IWRegion, IWDBStdCtrls,    IWContainer, IWHTMLContainer, IWHTML40Container, IWRegion, IWDBStdCtrls,
10    IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompLabel,    IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompLabel,
11    IWCompGrids, IWCompText, IWCompTabControl, IWCompButton, IWCompEdit,    IWCompGrids, IWCompText, IWCompTabControl, IWCompButton, IWCompEdit,
12    IWHTMLControls, IWCompExtCtrls, UserSessionUnit, PngImage, Data.DB,    IWHTMLControls, IWCompExtCtrls, PngImage, Data.DB,
13    IWCompListbox, IWBaseComponent, IWBaseHTMLComponent, IWBaseHTML40Component,    IWCompListbox, IWBaseComponent, IWBaseHTMLComponent, IWBaseHTML40Component,
14    IWCompMenu, Vcl.Menus, System.Variants;    IWCompMenu, Vcl.Menus, System.Variants, Vcl.Dialogs, System.UITypes, Unit8;
15    
16  type  type
17    TIWForm1 = class(TIWAppForm)    TIWForm1 = class(TIWAppForm)
     IWFrame1: TIWFrame1;  
18      IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;      IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;
19      IWLabel1: TIWLabel;      IWLabel1: TIWLabel;
20      IWDBLabel1: TIWDBLabel;      IWDBLabel1: TIWDBLabel;
# Line 40  type Line 39  type
39      IWLabel8: TIWLabel;      IWLabel8: TIWLabel;
40      IWList2: TIWList;      IWList2: TIWList;
41      IWLabel4: TIWLabel;      IWLabel4: TIWLabel;
     IWImageFile1: TIWImageFile;  
42      IWRegion7: TIWRegion;      IWRegion7: TIWRegion;
43      IWLabel5: TIWLabel;      IWLabel5: TIWLabel;
44      IWLabel6: TIWLabel;      IWLabel6: TIWLabel;
45      IWList3: TIWList;      IWList3: TIWList;
46        IWImage1: TIWImage;
47        IWFrame8: TIWFrame8;
48        IWLink4: TIWLink;
49        IWLink3: TIWLink;
50        IWLink5: TIWLink;
51        IWFrame1: TIWFrame1;
52        IWLink6: TIWLink;
53      procedure IWAppFormRender(Sender: TObject);      procedure IWAppFormRender(Sender: TObject);
54      procedure IWLink2Click(Sender: TObject);      procedure IWLink2Click(Sender: TObject);
55      procedure IWAppFormCreate(Sender: TObject);      procedure IWAppFormCreate(Sender: TObject);
56      procedure IWButton1Click(Sender: TObject);      procedure IWButton1Click(Sender: TObject);
57      procedure IWLink1Click(Sender: TObject);      procedure IWLink1Click(Sender: TObject);
58        procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);
59        procedure IWFrame8IWButton1Click(Sender: TObject);
60        procedure IWFrame8IWLink1Click(Sender: TObject);
61        procedure IWLink4Click(Sender: TObject);
62        procedure IWLink3Click(Sender: TObject);
63        procedure IWLink5Click(Sender: TObject);
64        procedure IWLink6Click(Sender: TObject);
65    private    private
66      function GetPage: TPage;      Filter: Boolean;
67      procedure SetPage(const Value: TPage);      function GetPage: Boolean;
68        procedure SetPage(const Value: Boolean);
69      procedure LoadImage;      procedure LoadImage;
70      procedure ClearImage;      procedure ClearImage;
71        function GetThumbnail: Boolean;
72        procedure CallBack(EventParams: TStringList);
73        procedure SetThumbnail(const Value: Boolean);
74    public    public
75      property Page: TPage read GetPage write SetPage;      property Page: Boolean read GetPage write SetPage;
76        property Thumbnail: Boolean read GetThumbnail write SetThumbnail;
77    end;    end;
78    
79    var
80      IWForm1: TIWForm1;
81    
82  implementation  implementation
83    
84  {$R *.dfm}  {$R *.dfm}
85    
86  uses Unit3, ServerController, Unit6;  uses Unit3, ServerController, Unit6, Unit4, Unit9, Unit10, Unit5;
87    
88    procedure TIWForm1.CallBack(EventParams: TStringList);
89    begin
90      if SameText(EventParams.Values['RetValue'], 'true') = true then
91        TCartForm.Create(WebApplication).Show;
92    end;
93    
94  procedure TIWForm1.ClearImage;  procedure TIWForm1.ClearImage;
95  var  var
# Line 73  begin Line 99  begin
99    for i := 0 to IWGrid1.RowCount - 1 do    for i := 0 to IWGrid1.RowCount - 1 do
100      for j := 0 to IWGrid1.ColumnCount - 1 do      for j := 0 to IWGrid1.ColumnCount - 1 do
101        IWGrid1.Cell[i, j].Control.Free;        IWGrid1.Cell[i, j].Control.Free;
102      IWGrid1.RowCount := 0;
103  end;  end;
104    
105  function TIWForm1.GetPage: TPage;  function TIWForm1.GetPage: Boolean;
106  begin  begin
107    result := UserSession.FPage;    result := UserSession.FPage;
108  end;  end;
109    
110    function TIWForm1.GetThumbnail: Boolean;
111    begin
112      result := UserSession.FThumbnail;
113    end;
114    
115  procedure TIWForm1.IWAppFormCreate(Sender: TObject);  procedure TIWForm1.IWAppFormCreate(Sender: TObject);
116  const  const
117    i = 120;    i = 120;
118  var  var
119    s: Integer;    s: Integer;
120  begin  begin
121      IWForm1 := Self;
122    Page := UserSession.FPage;    Page := UserSession.FPage;
123      Thumbnail := UserSession.FThumbnail;
124    s := DM.FDTable3.FieldByName('BGCOLOR').AsInteger;    s := DM.FDTable3.FieldByName('BGCOLOR').AsInteger;
125    IWLabel2.BGColor := s;    IWLabel2.BGColor := s;
126    IWLabel3.BGColor := s;    IWLabel3.BGColor := s;
127    IWLabel5.BGColor := s;    IWLabel5.BGColor := s;
128      IWLabel7.BGColor := s;
129      IWLabel8.BGColor := s;
130    IWRegion1.Width := i;    IWRegion1.Width := i;
131    IWRegion2.Width := i;    IWRegion2.Width := i;
132    IWRegion4.Width := i;    IWRegion4.Width := i;
133    IWRegion5.Width := i;    IWRegion5.Width := i;
134    IWRegion6.Width := i;    IWRegion6.Width := i;
135    IWRegion7.Width := i;    IWRegion7.Width := i;
136      WebApplication.RegisterCallBack('callback', CallBack);
137  end;  end;
138    
139  procedure TIWForm1.IWAppFormRender(Sender: TObject);  procedure TIWForm1.IWAppFormRender(Sender: TObject);
# Line 157  begin Line 194  begin
194          IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';          IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';
195      end;      end;
196    IWList2.Items.Clear;    IWList2.Items.Clear;
197    if Page = TPage.Info then    if Page = false then
198    begin    begin
199      with DM.FDQuery1 do      with DM.FDQuery1 do
200      begin      begin
# Line 172  begin Line 209  begin
209        while Eof = false do        while Eof = false do
210        begin        begin
211          s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;          s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;
212          i := i + Fields.Fields[2].AsInteger;          i := i + Fields.Fields[0].AsInteger * Fields.Fields[2].AsInteger;
213          IWList2.Items.Add(s);          IWList2.Items.Add(s);
214          Next;          Next;
215        end;        end;
# Line 195  begin Line 232  begin
232      end;      end;
233    end;    end;
234    LoadImage;    LoadImage;
235      if IWGrid1.Visible = true then
236        IWLabel6.Visible := Filter;
237  end;  end;
238    
239  procedure TIWForm1.IWButton1Click(Sender: TObject);  procedure TIWForm1.IWButton1Click(Sender: TObject);
240    var
241      i: Integer;
242  begin  begin
243    DM.FDTable2.Filtered := false;    IWFrame8IWLink1Click(Sender);
244    if IWEdit1.Text <> '' then    if IWEdit1.Text <> '' then
245    begin    begin
246      DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%'+IWEdit1.Text+'%');      DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%' + IWEdit1.Text + '%');
247      DM.FDTable2.Filtered := true;      DM.FDTable2.Filtered := true;
248      IWLabel6.Caption := IWEdit1.Text + 'を検索しています';      i := DM.FDTable2.RecordCount;
249        IWLabel6.Caption := Format(IWEdit1.Text + 'を検索しています:%d件', [i]);
250        if i = 0 then
251          DM.FDTable2.Filtered := false;
252        Filter := true;
253      end
254      else
255      begin
256        DM.FDTable2.Filtered := false;
257        Filter := false;
258      end;
259    end;
260    
261    procedure TIWForm1.IWFrame8IWButton1Click(Sender: TObject);
262    var
263      i: Integer;
264    begin
265      if TryStrToInt(IWFrame8.IWEdit1.Text, i) = false then
266      begin
267        WebApplication.ShowMessage('個数が不正です');
268        Exit;
269    end;    end;
270    IWLabel6.Visible := DM.FDTable2.Filtered;    if i = 0 then
271      begin
272        WebApplication.ShowMessage('１個以上のご注文が必要です');
273        Exit;
274      end;
275      with DM.FDQuery1 do
276      begin
277        SQL.Clear;
278        SQL.Add('select * from cart_data;');
279        Open;
280        if Locate('NUMBER;SERIAL', VarArrayOf([UserSession.user_number,
281          UserSession.Serial]), []) = true then
282        begin
283          Edit;
284          FieldByName('VOLUME').AsInteger := FieldByName('VOLUME').AsInteger + i;
285          Post;
286        end
287        else
288          AppendRecord([nil, i, UserSession.user_number, UserSession.Serial]);
289      end;
290      IWFrame8.IWEdit1.Text := '0';
291      WebApplication.ShowConfirm('カートに移動しますか', 'callback', '移動', 'はい', 'いいえ');
292    end;
293    
294    procedure TIWForm1.IWFrame8IWLink1Click(Sender: TObject);
295    begin
296      Thumbnail := true;
297    end;
298    
299    procedure TIWForm1.IWGrid1CellClick(ASender: TObject;
300      const ARow, AColumn: Integer);
301    begin
302      Thumbnail := false;
303      IWFrame8.IWEdit1.Text := '1';
304      UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);
305  end;  end;
306    
307  procedure TIWForm1.IWLink1Click(Sender: TObject);  procedure TIWForm1.IWLink1Click(Sender: TObject);
# Line 216  end; Line 311  end;
311    
312  procedure TIWForm1.IWLink2Click(Sender: TObject);  procedure TIWForm1.IWLink2Click(Sender: TObject);
313  begin  begin
314    case Page of    if Page = true then
315      Main:    begin
316        begin      if DM.FDTable1.Locate('EMAIL;PASSWORD',
317          if DM.FDTable1.Locate('EMAIL;PASSWORD',        VarArrayOf([IWEdit2.Text, IWEdit3.Text]), [loCaseInsensitive]) = true then
318            VarArrayOf([IWEdit2.Text, IWEdit3.Text]), [loCaseInsensitive]) = true      begin
319          then        Page := false;
320          begin        IWEdit2.Text := '';
321            Page := Info;      end;
322            UserSession.user_number := DM.FDTable1.FieldByName('NUMBER')      IWEdit3.Text := '';
323              .AsInteger;    end
324            IWEdit2.Text := '';    else
325          end;      Page := true;
326          IWEdit3.Text := '';  end;
327        end;  
328      Info:  procedure TIWForm1.IWLink3Click(Sender: TObject);
329        begin  begin
330          DM.FDTable1.Filtered := false;    with TMyPage.Create(WebApplication) do
331          Page := Main;    begin
332        end;      Form := Self;
333        Show;
334    end;    end;
335  end;  end;
336    
337    procedure TIWForm1.IWLink4Click(Sender: TObject);
338    begin
339      TCartForm.Create(WebApplication).Show;
340    end;
341    
342    procedure TIWForm1.IWLink5Click(Sender: TObject);
343    begin
344      TIWForm10.Create(WebApplication).Show;
345    end;
346    
347    procedure TIWForm1.IWLink6Click(Sender: TObject);
348    begin
349      Page:=true;
350      TIWForm3.Create(WebApplication).Show;
351    end;
352    
353  procedure TIWForm1.LoadImage;  procedure TIWForm1.LoadImage;
354  var  var
355    s: TStream;    s: TStream;
356    png: TPngImage;    png: TPngImage;
357    pic: TIWImageFile;    pic: TIWImage;
358    i: Integer;    i: Integer;
359    j: Integer;    j: Integer;
360    k: Integer;    x: Boolean;
361      t: string;
362  label label1;  label label1;
363  begin  begin
364    ClearImage;    ClearImage;
365    exit;    png := TPngImage.Create;
   png:=TPngImage.Create;  
366    try    try
367      IWGrid1.RowCount := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;      if Thumbnail = true then
368      k := 1;      begin
369      for i := 0 to IWGrid1.RowCount - 1 do        i := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
370        for j := 0 to IWGrid1.ColumnCount - 1 do        if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then
371        begin          inc(i);
372          s := DM.FDTable2.CreateBlobStream        IWGrid1.RowCount := i;
373            (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);        if DM.FDTable2.Filtered = false then
374          try          DM.FDTable2.Last
375            png.LoadFromStream(s);        else
376            pic := TIWImageFile.Create(IWGrid1);          DM.FDTable2.FindLast;
377            pic.Picture.Assign(png);        for i := 0 to IWGrid1.RowCount - 1 do
378            IWGrid1.Cell[i, j].Control := pic;          for j := 0 to IWGrid1.ColumnCount - 1 do
379            IWGrid1.Cell[i, j].Text := k.ToString;          begin
380            inc(k);            if DM.FDTable2.Filtered = false then
381          finally            begin
382            s.Free;              if DM.FDTable2.Bof = true then
383                  goto label1;
384              end
385              else if DM.FDTable2.Found = false then
386                goto label1;
387              if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then
388              begin
389                s := DM.FDTable2.CreateBlobStream
390                  (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
391                try
392                  png.LoadFromStream(s);
393                finally
394                  s.Free;
395                end;
396                pic := TIWImage.Create(IWGrid1);
397                pic.Picture.Assign(png);
398                IWGrid1.Cell[i, j].Control := pic;
399              end;
400              t := DM.FDTable2.FieldByName('NAME').AsString;
401              if Length(t) > 10 then
402                t := Copy(t, 1, 8) + '..';
403              IWGrid1.Cell[i, j].Tag :=
404                Pointer(DM.FDTable2.FieldByName('SERIAL').AsInteger);
405              IWGrid1.Cell[i, j].Text := t;
406              IWGrid1.Cell[i, j].Alignment := taCenter;
407              IWGrid1.Cell[i, j].Clickable := true;
408              if DM.FDTable2.Filtered = false then
409                DM.FDTable2.Prior
410              else
411                DM.FDTable2.FindPrior;
412          end;          end;
413          if DM.FDTable2.Bof = true then      label1:
414            goto label1;      end
415        else if (DM.FDTable2.Locate('SERIAL', UserSession.Serial, []) = true) and
416          (DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil) then
417        begin
418          s := DM.FDTable2.CreateBlobStream
419            (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
420          try
421            png.LoadFromStream(s);
422            IWFrame8.IWImage1.Picture.Assign(png);
423          finally
424            s.Free;
425        end;        end;
426    label1:      end
427        else
428          IWFrame8.IWImage1.Picture.Assign(nil);
429    finally    finally
430      png.Free;      png.Free;
431    end;    end;
432    png := nil;    png := nil;
433    s := nil;    s := nil;
434    Randomize;    Randomize;
435      if DM.FDTable2.Filtered = true then
436      begin
437        x := true;
438        DM.FDTable2.Filtered := false;
439      end
440      else
441        x := false;
442    DM.FDTable2.Last;    DM.FDTable2.Last;
443      if DM.FDTable2.Bof = true then
444        Exit;
445    DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));    DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));
446    s := DM.FDTable2.CreateBlobStream    if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then
447      (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);    begin
448    png := TPngImage.Create;      s := DM.FDTable2.CreateBlobStream
449    try        (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
450      png.LoadFromStream(s);      png := TPngImage.Create;
451      IWImageFile1.Picture.Assign(png);      try
452    finally        png.LoadFromStream(s);
453      png.Free;        IWImage1.Picture.Assign(png);
454      s.Free;      finally
455          png.Free;
456          s.Free;
457        end;
458    end;    end;
459      if x = true then
460        DM.FDTable2.Filtered := true;
461    IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;    IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;
462  end;  end;
463    
464  procedure TIWForm1.SetPage(const Value: TPage);  procedure TIWForm1.SetPage(const Value: Boolean);
 var  
   x: Boolean;  
465  begin  begin
466    UserSession.FPage := Value;    UserSession.FPage := Value;
467    x := Value = Info;    IWRegion7.Visible := not Value;
468    IWRegion7.Visible := x;    IWDBLabel1.Visible := not Value;
469    IWLabel6.Visible := x;    IWLink3.Visible := not Value;
470    IWDBLabel1.Visible := x;    IWLink1.Visible := Value;
471    IWLink1.Visible := not x;    IWText1.Visible := Value;
472    IWText1.Visible := not x;    if Value = false then
   if x = true then  
473    begin    begin
474      IWLabel1.Caption := 'ようこそ';      IWLabel1.Caption := 'ようこそ';
475      IWLink2.Caption := 'ログアウト';      IWLink2.Caption := 'ログアウト';
476        UserSession.user_number := DM.FDTable1.FieldByName('NUMBER').AsInteger;
477    end    end
478    else    else
479    begin    begin
480      IWLabel1.Caption := 'ようこそゲスト様';      IWLabel1.Caption := 'ようこそゲスト様';
481      IWLink2.Caption := 'ログイン';      IWLink2.Caption := 'ログイン';
482        Thumbnail := true;
483        IWText1.Text := '';
484        DM.FDTable2.Filtered := false;
485        Filter := false;
486        UserSession.user_number:=0;
487    end;    end;
488  end;  end;
489    
490    procedure TIWForm1.SetThumbnail(const Value: Boolean);
491    begin
492      UserSession.FThumbnail := Value;
493      IWGrid1.Visible := Value;
494      IWFrame8.Visible := not Value;
495    end;
496    
497  initialization  initialization
498    
499  TIWForm1.SetAsMainForm;  TIWForm1.SetAsMainForm;
Legend:
Removed from v.3  
changed lines
  Added in v.10
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help