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