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 7 by yamat0jp, Wed Dec 30 09:56:24 2015 UTC
# Line 11  uses Line 11  uses
11    IWCompGrids, IWCompText, IWCompTabControl, IWCompButton, IWCompEdit,    IWCompGrids, IWCompText, IWCompTabControl, IWCompButton, IWCompEdit,
12    IWHTMLControls, IWCompExtCtrls, UserSessionUnit, PngImage, Data.DB,    IWHTMLControls, IWCompExtCtrls, UserSessionUnit, PngImage, Data.DB,
13    IWCompListbox, IWBaseComponent, IWBaseHTMLComponent, IWBaseHTML40Component,    IWCompListbox, IWBaseComponent, IWBaseHTMLComponent, IWBaseHTML40Component,
14    IWCompMenu, Vcl.Menus, System.Variants;    IWCompMenu, Vcl.Menus, System.Variants, Unit8, Vcl.Dialogs;
15    
16  type  type
17    TIWForm1 = class(TIWAppForm)    TIWForm1 = class(TIWAppForm)
# Line 40  type Line 40  type
40      IWLabel8: TIWLabel;      IWLabel8: TIWLabel;
41      IWList2: TIWList;      IWList2: TIWList;
42      IWLabel4: TIWLabel;      IWLabel4: TIWLabel;
     IWImageFile1: TIWImageFile;  
43      IWRegion7: TIWRegion;      IWRegion7: TIWRegion;
44      IWLabel5: TIWLabel;      IWLabel5: TIWLabel;
45      IWLabel6: TIWLabel;      IWLabel6: TIWLabel;
46      IWList3: TIWList;      IWList3: TIWList;
47        IWImage1: TIWImage;
48        IWFrame8: TIWFrame8;
49        IWLink4: TIWLink;
50        IWLink3: TIWLink;
51      procedure IWAppFormRender(Sender: TObject);      procedure IWAppFormRender(Sender: TObject);
52      procedure IWLink2Click(Sender: TObject);      procedure IWLink2Click(Sender: TObject);
53      procedure IWAppFormCreate(Sender: TObject);      procedure IWAppFormCreate(Sender: TObject);
54      procedure IWButton1Click(Sender: TObject);      procedure IWButton1Click(Sender: TObject);
55      procedure IWLink1Click(Sender: TObject);      procedure IWLink1Click(Sender: TObject);
56        procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);
57        procedure IWFrame8IWButton1Click(Sender: TObject);
58        procedure IWFrame8IWLink1Click(Sender: TObject);
59        procedure IWLink4Click(Sender: TObject);
60        procedure IWLink3Click(Sender: TObject);
61    private    private
62      function GetPage: TPage;      Filter: Boolean;
63      procedure SetPage(const Value: TPage);      function GetPage: Boolean;
64        procedure SetPage(const Value: Boolean);
65      procedure LoadImage;      procedure LoadImage;
66      procedure ClearImage;      procedure ClearImage;
67    public    public
68      property Page: TPage read GetPage write SetPage;      property Page: Boolean read GetPage write SetPage;
69    end;    end;
70    
71  implementation  implementation
72    
73  {$R *.dfm}  {$R *.dfm}
74    
75  uses Unit3, ServerController, Unit6;  uses Unit3, ServerController, Unit6, Unit4, Unit9;
76    
77  procedure TIWForm1.ClearImage;  procedure TIWForm1.ClearImage;
78  var  var
# Line 73  begin Line 82  begin
82    for i := 0 to IWGrid1.RowCount - 1 do    for i := 0 to IWGrid1.RowCount - 1 do
83      for j := 0 to IWGrid1.ColumnCount - 1 do      for j := 0 to IWGrid1.ColumnCount - 1 do
84        IWGrid1.Cell[i, j].Control.Free;        IWGrid1.Cell[i, j].Control.Free;
85      IWGrid1.RowCount := 0;
86  end;  end;
87    
88  function TIWForm1.GetPage: TPage;  function TIWForm1.GetPage: Boolean;
89  begin  begin
90    result := UserSession.FPage;    result := UserSession.FPage;
91  end;  end;
# Line 91  begin Line 101  begin
101    IWLabel2.BGColor := s;    IWLabel2.BGColor := s;
102    IWLabel3.BGColor := s;    IWLabel3.BGColor := s;
103    IWLabel5.BGColor := s;    IWLabel5.BGColor := s;
104      IWLabel7.BGColor := s;
105      IWLabel8.BGColor := s;
106    IWRegion1.Width := i;    IWRegion1.Width := i;
107    IWRegion2.Width := i;    IWRegion2.Width := i;
108    IWRegion4.Width := i;    IWRegion4.Width := i;
# Line 157  begin Line 169  begin
169          IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';          IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';
170      end;      end;
171    IWList2.Items.Clear;    IWList2.Items.Clear;
172    if Page = TPage.Info then    if Page = false then
173    begin    begin
174      with DM.FDQuery1 do      with DM.FDQuery1 do
175      begin      begin
# Line 172  begin Line 184  begin
184        while Eof = false do        while Eof = false do
185        begin        begin
186          s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;          s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;
187          i := i + Fields.Fields[2].AsInteger;          i := i + Fields.Fields[0].AsInteger * Fields.Fields[2].AsInteger;
188          IWList2.Items.Add(s);          IWList2.Items.Add(s);
189          Next;          Next;
190        end;        end;
# Line 195  begin Line 207  begin
207      end;      end;
208    end;    end;
209    LoadImage;    LoadImage;
210      if IWGrid1.Visible = true then
211        IWLabel6.Visible := Filter;
212  end;  end;
213    
214  procedure TIWForm1.IWButton1Click(Sender: TObject);  procedure TIWForm1.IWButton1Click(Sender: TObject);
215    var
216      i: Integer;
217  begin  begin
218    DM.FDTable2.Filtered := false;    IWFrame8IWLink1Click(Sender);
219    if IWEdit1.Text <> '' then    if IWEdit1.Text <> '' then
220    begin    begin
221      DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%'+IWEdit1.Text+'%');      DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%' + IWEdit1.Text + '%');
222      DM.FDTable2.Filtered := true;      DM.FDTable2.Filtered := true;
223      IWLabel6.Caption := IWEdit1.Text + 'を検索しています';      i := DM.FDTable2.RecordCount;
224        IWLabel6.Caption := Format(IWEdit1.Text + 'を検索しています:%d件', [i]);
225        if i = 0 then
226          DM.FDTable2.Filtered := false;
227        Filter := true;
228      end
229      else
230      begin
231        DM.FDTable2.Filtered := false;
232        Filter := false;
233    end;    end;
234    IWLabel6.Visible := DM.FDTable2.Filtered;  end;
235    
236    procedure TIWForm1.IWFrame8IWButton1Click(Sender: TObject);
237    var
238      i: Integer;
239    begin
240      if TryStrToInt(IWFrame8.IWEdit1.Text, i) = false then
241      begin
242        WebApplication.ShowMessage('個数が不正です');
243        Exit;
244      end;
245      if i = 0 then
246      begin
247        WebApplication.ShowMessage('１個以上のご注文が必要です');
248        Exit;
249      end;
250      with DM.FDQuery1 do
251      begin
252        SQL.Clear;
253        SQL.Add('select * from cart_data;');
254        Open;
255        if Locate('NUMBER;SERIAL', VarArrayOf([UserSession.user_number,
256          UserSession.Serial]), []) = true then
257        begin
258          Edit;
259          FieldByName('VOLUME').AsInteger := FieldByName('VOLUME').AsInteger + i;
260          Post;
261        end
262        else
263          AppendRecord([nil, i, UserSession.user_number, UserSession.Serial]);
264      end;
265      IWFrame8.IWEdit1.Text := '0';
266      if MessageDlg('カートに移動しますか', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
267        TCartForm.Create(WebApplication).Show;
268    end;
269    
270    procedure TIWForm1.IWFrame8IWLink1Click(Sender: TObject);
271    begin
272      UserSession.Thumbnail := true;
273      IWFrame8.Visible := false;
274      IWGrid1.Visible := true;
275    end;
276    
277    procedure TIWForm1.IWGrid1CellClick(ASender: TObject;
278      const ARow, AColumn: Integer);
279    begin
280      UserSession.Thumbnail := false;
281      IWFrame8.Visible := true;
282      IWFrame8.IWEdit1.Text := '1';
283      IWLabel6.Visible := false;
284      IWGrid1.Visible := false;
285      UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);
286  end;  end;
287    
288  procedure TIWForm1.IWLink1Click(Sender: TObject);  procedure TIWForm1.IWLink1Click(Sender: TObject);
289  begin  begin
290    TUserForm.Create(WebApplication).Show;    with TUserForm.Create(WebApplication) do
291      begin
292        Form := Self;
293        Show;
294      end;
295  end;  end;
296    
297  procedure TIWForm1.IWLink2Click(Sender: TObject);  procedure TIWForm1.IWLink2Click(Sender: TObject);
298  begin  begin
299    case Page of    if Page = true then
     Main:  
300        begin        begin
301          if DM.FDTable1.Locate('EMAIL;PASSWORD',          if DM.FDTable1.Locate('EMAIL;PASSWORD',
302            VarArrayOf([IWEdit2.Text, IWEdit3.Text]), [loCaseInsensitive]) = true            VarArrayOf([IWEdit2.Text, IWEdit3.Text]), [loCaseInsensitive]) = true
303          then          then
304          begin          begin
305            Page := Info;            Page := false;
306            UserSession.user_number := DM.FDTable1.FieldByName('NUMBER')            UserSession.user_number := DM.FDTable1.FieldByName('NUMBER')
307              .AsInteger;              .AsInteger;
308            IWEdit2.Text := '';            IWEdit2.Text := '';
309          end;          end;
310          IWEdit3.Text := '';          IWEdit3.Text := '';
311        end;        end
312      Info:        else
313        begin        begin
314          DM.FDTable1.Filtered := false;          DM.FDTable1.Filtered := false;
315          Page := Main;          Page := true;
316            UserSession.user_number := 0;
317        end;        end;
318    end;
319    
320    procedure TIWForm1.IWLink3Click(Sender: TObject);
321    begin
322      with TMyPage.Create(WebApplication) do
323      begin
324        Form := Self;
325        Show;
326    end;    end;
327  end;  end;
328    
329    procedure TIWForm1.IWLink4Click(Sender: TObject);
330    begin
331      TCartForm.Create(WebApplication).Show;
332    end;
333    
334  procedure TIWForm1.LoadImage;  procedure TIWForm1.LoadImage;
335  var  var
336    s: TStream;    s: TStream;
337    png: TPngImage;    png: TPngImage;
338    pic: TIWImageFile;    pic: TIWImage;
339    i: Integer;    i: Integer;
340    j: Integer;    j: Integer;
341    k: Integer;    x: Boolean;
342      t: string;
343  label label1;  label label1;
344  begin  begin
345    ClearImage;    ClearImage;
346    exit;    png := TPngImage.Create;
   png:=TPngImage.Create;  
347    try    try
348      IWGrid1.RowCount := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;      if UserSession.Thumbnail = true then
349      k := 1;      begin
350      for i := 0 to IWGrid1.RowCount - 1 do        i := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
351        for j := 0 to IWGrid1.ColumnCount - 1 do        if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then
352        begin          inc(i);
353          s := DM.FDTable2.CreateBlobStream        IWGrid1.RowCount := i;
354            (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);        if DM.FDTable2.Filtered = false then
355          try          DM.FDTable2.Last
356            png.LoadFromStream(s);        else
357            pic := TIWImageFile.Create(IWGrid1);          DM.FDTable2.FindLast;
358            pic.Picture.Assign(png);        for i := 0 to IWGrid1.RowCount - 1 do
359            IWGrid1.Cell[i, j].Control := pic;          for j := 0 to IWGrid1.ColumnCount - 1 do
360            IWGrid1.Cell[i, j].Text := k.ToString;          begin
361            inc(k);            if DM.FDTable2.Filtered = false then
362          finally            begin
363            s.Free;              if DM.FDTable2.Bof = true then
364                  goto label1;
365              end
366              else if DM.FDTable2.Found = false then
367                goto label1;
368              if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then
369              begin
370                s := DM.FDTable2.CreateBlobStream
371                  (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
372                try
373                  png.LoadFromStream(s);
374                finally
375                  s.Free;
376                end;
377                pic := TIWImage.Create(IWGrid1);
378                pic.Picture.Assign(png);
379                IWGrid1.Cell[i, j].Control := pic;
380              end;
381              t := DM.FDTable2.FieldByName('NAME').AsString;
382              if Length(t) > 10 then
383                t := Copy(t, 1, 8) + '..';
384              IWGrid1.Cell[i, j].Tag :=
385                Pointer(DM.FDTable2.FieldByName('SERIAL').AsInteger);
386              IWGrid1.Cell[i, j].Text := t;
387              IWGrid1.Cell[i, j].Alignment := taCenter;
388              IWGrid1.Cell[i, j].Clickable := true;
389              if DM.FDTable2.Filtered = false then
390                DM.FDTable2.Prior
391              else
392                DM.FDTable2.FindPrior;
393          end;          end;
394          if DM.FDTable2.Bof = true then      label1:
395            goto label1;      end
396        else if (DM.FDTable2.Locate('SERIAL', UserSession.Serial, []) = true) and
397          (DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil) then
398        begin
399          s := DM.FDTable2.CreateBlobStream
400            (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
401          try
402            png.LoadFromStream(s);
403            IWFrame8.IWImage1.Picture.Assign(png);
404          finally
405            s.Free;
406        end;        end;
407    label1:      end
408        else
409          IWFrame8.IWImage1.Picture.Assign(nil);
410    finally    finally
411      png.Free;      png.Free;
412    end;    end;
413    png := nil;    png := nil;
414    s := nil;    s := nil;
415    Randomize;    Randomize;
416      if DM.FDTable2.Filtered = true then
417      begin
418        x := true;
419        DM.FDTable2.Filtered := false;
420      end
421      else
422        x := false;
423    DM.FDTable2.Last;    DM.FDTable2.Last;
424      if DM.FDTable2.Bof = true then
425        Exit;
426    DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));    DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));
427    s := DM.FDTable2.CreateBlobStream    if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then
428      (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);    begin
429    png := TPngImage.Create;      s := DM.FDTable2.CreateBlobStream
430    try        (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
431      png.LoadFromStream(s);      png := TPngImage.Create;
432      IWImageFile1.Picture.Assign(png);      try
433    finally        png.LoadFromStream(s);
434      png.Free;        IWImage1.Picture.Assign(png);
435      s.Free;      finally
436          png.Free;
437          s.Free;
438        end;
439    end;    end;
440      if x = true then
441        DM.FDTable2.Filtered := true;
442    IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;    IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;
443  end;  end;
444    
445  procedure TIWForm1.SetPage(const Value: TPage);  procedure TIWForm1.SetPage(const Value: Boolean);
 var  
   x: Boolean;  
446  begin  begin
447    UserSession.FPage := Value;    UserSession.FPage := Value;
448    x := Value = Info;    IWRegion7.Visible := not Value;
449    IWRegion7.Visible := x;    IWDBLabel1.Visible := not Value;
450    IWLabel6.Visible := x;    IWLink3.Visible := not Value;
451    IWDBLabel1.Visible := x;    IWLink1.Visible := Value;
452    IWLink1.Visible := not x;    IWText1.Visible := Value;
453    IWText1.Visible := not x;    if Value = false then
   if x = true then  
454    begin    begin
455      IWLabel1.Caption := 'ようこそ';      IWLabel1.Caption := 'ようこそ';
456      IWLink2.Caption := 'ログアウト';      IWLink2.Caption := 'ログアウト';
Legend:
Removed from v.3  
changed lines
  Added in v.7
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help