Develop and Download Open Source Software

Browse Subversion Repository

Diff of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 7 by yamat0jp, Wed Dec 30 09:56:24 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, Unit8, Vcl.Dialogs;    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 48  type Line 47  type
47      IWFrame8: TIWFrame8;      IWFrame8: TIWFrame8;
48      IWLink4: TIWLink;      IWLink4: TIWLink;
49      IWLink3: TIWLink;      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);
# Line 58  type Line 60  type
60      procedure IWFrame8IWLink1Click(Sender: TObject);      procedure IWFrame8IWLink1Click(Sender: TObject);
61      procedure IWLink4Click(Sender: TObject);      procedure IWLink4Click(Sender: TObject);
62      procedure IWLink3Click(Sender: TObject);      procedure IWLink3Click(Sender: TObject);
63        procedure IWLink5Click(Sender: TObject);
64        procedure IWLink6Click(Sender: TObject);
65    private    private
66      Filter: Boolean;      Filter: Boolean;
67      function GetPage: Boolean;      function GetPage: Boolean;
68      procedure SetPage(const Value: Boolean);      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: Boolean 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, Unit4, Unit9;  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 90  begin Line 107  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;
# Line 109  begin Line 133  begin
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 263  begin Line 288  begin
288        AppendRecord([nil, i, UserSession.user_number, UserSession.Serial]);        AppendRecord([nil, i, UserSession.user_number, UserSession.Serial]);
289    end;    end;
290    IWFrame8.IWEdit1.Text := '0';    IWFrame8.IWEdit1.Text := '0';
291    if MessageDlg('カートに移動しますか', mtConfirmation, [mbYes, mbNo], 0) = mrYes then    WebApplication.ShowConfirm('カートに移動しますか', 'callback', '移動', 'はい', 'いいえ');
     TCartForm.Create(WebApplication).Show;  
292  end;  end;
293    
294  procedure TIWForm1.IWFrame8IWLink1Click(Sender: TObject);  procedure TIWForm1.IWFrame8IWLink1Click(Sender: TObject);
295  begin  begin
296    UserSession.Thumbnail := true;    Thumbnail := true;
   IWFrame8.Visible := false;  
   IWGrid1.Visible := true;  
297  end;  end;
298    
299  procedure TIWForm1.IWGrid1CellClick(ASender: TObject;  procedure TIWForm1.IWGrid1CellClick(ASender: TObject;
300    const ARow, AColumn: Integer);    const ARow, AColumn: Integer);
301  begin  begin
302    UserSession.Thumbnail := false;    Thumbnail := false;
   IWFrame8.Visible := true;  
303    IWFrame8.IWEdit1.Text := '1';    IWFrame8.IWEdit1.Text := '1';
   IWLabel6.Visible := false;  
   IWGrid1.Visible := false;  
304    UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);    UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);
305  end;  end;
306    
307  procedure TIWForm1.IWLink1Click(Sender: TObject);  procedure TIWForm1.IWLink1Click(Sender: TObject);
308  begin  begin
309    with TUserForm.Create(WebApplication) do    TUserForm.Create(WebApplication).Show;
   begin  
     Form := Self;  
     Show;  
   end;  
310  end;  end;
311    
312  procedure TIWForm1.IWLink2Click(Sender: TObject);  procedure TIWForm1.IWLink2Click(Sender: TObject);
313  begin  begin
314    if Page = true then    if Page = true then
315        begin    begin
316          if DM.FDTable1.Locate('EMAIL;PASSWORD',      if DM.FDTable1.Locate('EMAIL;PASSWORD',
317            VarArrayOf([IWEdit2.Text, IWEdit3.Text]), [loCaseInsensitive]) = true        VarArrayOf([IWEdit2.Text, IWEdit3.Text]), [loCaseInsensitive]) = true then
318          then      begin
319          begin        Page := false;
320            Page := false;        IWEdit2.Text := '';
321            UserSession.user_number := DM.FDTable1.FieldByName('NUMBER')      end;
322              .AsInteger;      IWEdit3.Text := '';
323            IWEdit2.Text := '';    end
324          end;    else
325          IWEdit3.Text := '';      Page := true;
       end  
       else  
       begin  
         DM.FDTable1.Filtered := false;  
         Page := true;  
         UserSession.user_number := 0;  
       end;  
326  end;  end;
327    
328  procedure TIWForm1.IWLink3Click(Sender: TObject);  procedure TIWForm1.IWLink3Click(Sender: TObject);
# Line 331  begin Line 339  begin
339    TCartForm.Create(WebApplication).Show;    TCartForm.Create(WebApplication).Show;
340  end;  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;
# Line 345  begin Line 364  begin
364    ClearImage;    ClearImage;
365    png := TPngImage.Create;    png := TPngImage.Create;
366    try    try
367      if UserSession.Thumbnail = true then      if Thumbnail = true then
368      begin      begin
369        i := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;        i := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
370        if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then        if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then
# Line 454  begin Line 473  begin
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.7  
changed lines
  Added in v.10

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26