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