svn/view/Unit1.pas

unit Unit1;

interface

uses
  Classes, SysUtils, IWAppForm, IWApplication, IWColor, IWTypes, IWVCLComponent,
  IWBaseLayoutComponent, IWBaseContainerLayout, IWContainerLayout,
  IWTemplateProcessorHTML, Vcl.Controls, Vcl.Forms, Unit2, IWVCLBaseContainer,
  IWContainer, IWHTMLContainer, IWHTML40Container, IWRegion, IWDBStdCtrls,
  IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl, IWCompLabel,
  IWCompGrids, IWCompText, IWCompTabControl, IWCompButton, IWCompEdit,
  IWHTMLControls, IWCompExtCtrls, PngImage, Data.DB,
  IWCompListbox, IWBaseComponent, IWBaseHTMLComponent, IWBaseHTML40Component,
  IWCompMenu, Vcl.Menus, System.Variants, Vcl.Dialogs, System.UITypes, Unit8;

type
  TIWForm1 = class(TIWAppForm)
    IWTemplateProcessorHTML1: TIWTemplateProcessorHTML;
    IWLabel1: TIWLabel;
    IWDBLabel1: TIWDBLabel;
    IWRegion1: TIWRegion;
    IWRegion2: TIWRegion;
    IWText1: TIWText;
    IWGrid1: TIWGrid;
    IWRegion3: TIWRegion;
    IWRegion4: TIWRegion;
    IWLink1: TIWLink;
    IWLabel2: TIWLabel;
    IWList1: TIWList;
    IWLabel3: TIWLabel;
    IWEdit1: TIWEdit;
    IWButton1: TIWButton;
    IWEdit2: TIWEdit;
    IWEdit3: TIWEdit;
    IWLink2: TIWLink;
    IWRegion5: TIWRegion;
    IWLabel7: TIWLabel;
    IWRegion6: TIWRegion;
    IWLabel8: TIWLabel;
    IWList2: TIWList;
    IWLabel4: TIWLabel;
    IWRegion7: TIWRegion;
    IWLabel5: TIWLabel;
    IWLabel6: TIWLabel;
    IWList3: TIWList;
    IWImage1: TIWImage;
    IWFrame8: TIWFrame8;
    IWLink4: TIWLink;
    IWLink3: TIWLink;
    IWLink5: TIWLink;
    IWFrame1: TIWFrame1;
    IWLink6: TIWLink;
    procedure IWAppFormRender(Sender: TObject);
    procedure IWLink2Click(Sender: TObject);
    procedure IWAppFormCreate(Sender: TObject);
    procedure IWButton1Click(Sender: TObject);
    procedure IWLink1Click(Sender: TObject);
    procedure IWGrid1CellClick(ASender: TObject; const ARow, AColumn: Integer);
    procedure IWFrame8IWButton1Click(Sender: TObject);
    procedure IWFrame8IWLink1Click(Sender: TObject);
    procedure IWLink4Click(Sender: TObject);
    procedure IWLink3Click(Sender: TObject);
    procedure IWLink5Click(Sender: TObject);
    procedure IWLink6Click(Sender: TObject);
  private
    Filter: Boolean;
    function GetPage: Boolean;
    procedure SetPage(const Value: Boolean);
    procedure LoadImage;
    procedure ClearImage;
    function GetThumbnail: Boolean;
    procedure CallBack(EventParams: TStringList);
    procedure SetThumbnail(const Value: Boolean);
  public
    property Page: Boolean read GetPage write SetPage;
    property Thumbnail: Boolean read GetThumbnail write SetThumbnail;
  end;

var
  IWForm1: TIWForm1;

implementation

{$R *.dfm}

uses Unit3, ServerController, Unit6, Unit4, Unit9, Unit10, Unit5;

procedure TIWForm1.CallBack(EventParams: TStringList);
begin
  if SameText(EventParams.Values['RetValue'], 'true') = true then
    TCartForm.Create(WebApplication).Show;
  IWFrame8.IWEdit1.Text := '0';
end;

procedure TIWForm1.ClearImage;
var
  i: Integer;
  j: Integer;
begin
  for i := 0 to IWGrid1.RowCount - 1 do
    for j := 0 to IWGrid1.ColumnCount - 1 do
      IWGrid1.Cell[i, j].Control.Free;
  IWGrid1.RowCount := 0;
end;

function TIWForm1.GetPage: Boolean;
begin
  result := UserSession.FPage;
end;

function TIWForm1.GetThumbnail: Boolean;
begin
  result := UserSession.FThumbnail;
end;

procedure TIWForm1.IWAppFormCreate(Sender: TObject);
const
  i = 120;
var
  s: Integer;
begin
  IWForm1 := Self;
  Page := UserSession.FPage;
  Thumbnail := UserSession.FThumbnail;
  s := DM.FDTable3.FieldByName('BGCOLOR').AsInteger;
  IWLabel2.BGColor := s;
  IWLabel3.BGColor := s;
  IWLabel5.BGColor := s;
  IWLabel7.BGColor := s;
  IWLabel8.BGColor := s;
  IWRegion1.Width := i;
  IWRegion2.Width := i;
  IWRegion4.Width := i;
  IWRegion5.Width := i;
  IWRegion6.Width := i;
  IWRegion7.Width := i;
  WebApplication.RegisterCallBack('callback', CallBack);
end;

procedure TIWForm1.IWAppFormRender(Sender: TObject);
var
  s: string;
  i, j: Integer;
begin
  IWList1.Items.Clear;
  with DM.FDTable2 do
  begin
    if Filtered = true then
    begin
      FindFirst;
      while Found = true do
      begin
        s := FieldByName('CATEGORY').AsString;
        if s = '' then
        begin
          FindNext;
          continue;
        end;
        i := IWList1.Items.IndexOfName(s);
        if i = -1 then
          IWList1.Items.Add(s + '=1')
        else
        begin
          j := IWList1.Items.ValueFromIndex[i].ToInteger + 1;
          IWList1.Items[i] := s + '=' + j.ToString;
        end;
        FindNext;
      end;
    end
    else
    begin
      First;
      while Eof = false do
      begin
        s := FieldByName('CATEGORY').AsString;
        if s = '' then
        begin
          Next;
          continue;
        end;
        i := IWList1.Items.IndexOf(s);
        if i = -1 then
          IWList1.Items.Add(s);
        Next;
      end;
    end;
  end;
  if DM.FDTable2.Filtered = true then
    for i := 0 to IWList1.Items.Count - 1 do
    begin
      s := IWList1.Items.ValueFromIndex[i];
      if s = '1' then
        IWList1.Items[i] := IWList1.Items.Names[i]
      else
        IWList1.Items[i] := IWList1.Items.Names[i] + '(' + s + ')';
    end;
  IWList2.Items.Clear;
  with DM.FDQuery1 do
  begin
    SQL.Clear;
    SQL.Add('select volume,name,price from cart_data join item_data');
    SQL.Add(' on (cart_data.serial = item_data.serial)');
    SQL.Add(' where number = :num;');
    Params.ParamByName('num').AsInteger := UserSession.user_number;
    Open;
    First;
    i := 0;
    while Eof = false do
    begin
      s := Fields.Fields[0].AsString + 'x' + Fields.Fields[1].AsString;
      i := i + Fields.Fields[0].AsInteger * Fields.Fields[2].AsInteger;
      IWList2.Items.Add(s);
      Next;
    end;
    IWList2.Items.Add(i.ToString + '�~');
    Close;
    IWList3.Items.Clear;
    SQL.Clear;
    SQL.Add('select name from recent_data join item_data');
    SQL.Add(' on (recent_data.serial = item_data.serial)');
    SQL.Add(' where number = :num;');
    Params.ParamByName('num').AsInteger := UserSession.user_number;
    Open;
    First;
    while Eof = false do
    begin
      IWList3.Items.Add(Fields.Fields[0].AsString);
      Next;
    end;
    Close;
  end;
  LoadImage;
  if IWGrid1.Visible = true then
    IWLabel6.Visible := Filter;
end;

procedure TIWForm1.IWButton1Click(Sender: TObject);
var
  i: Integer;
begin
  IWFrame8IWLink1Click(Sender);
  if IWEdit1.Text <> '' then
  begin
    DM.FDTable2.Filter := 'NAME like ' + QuotedStr('%' + IWEdit1.Text + '%');
    DM.FDTable2.Filtered := true;
    i := DM.FDTable2.RecordCount;
    IWLabel6.Caption := Format(IWEdit1.Text + '����������������:%d��', [i]);
    if i = 0 then
      DM.FDTable2.Filtered := false;
    Filter := true;
  end
  else
  begin
    DM.FDTable2.Filtered := false;
    Filter := false;
  end;
end;

procedure TIWForm1.IWFrame8IWButton1Click(Sender: TObject);
var
  i, j: Integer;
  s: string;
begin
  if TryStrToInt(IWFrame8.IWEdit1.Text, i) = false then
  begin
    WebApplication.ShowMessage('�������s������');
    Exit;
  end;
  if i = 0 then
  begin
    WebApplication.ShowMessage('�P�����������������K�v����');
    Exit;
  end;
  s := WebApplication.Request.CookieFields.Values['user_cookie'];
  if s = '' then
  begin
    DM.FDTable1.Last;
    j := DM.FDTable1.FieldByName('NUMBER').AsInteger + 1;
    while DM.FDTable1.Lookup('NUMBER', j, 'NUMBER') = j do
      inc(j);
    UserSession.user_number := j;
    DM.FDTable1.AppendRecord([nil, nil, nil, nil, nil,
      UserSession.user_number, Date]);
    WebApplication.Response.Cookies.AddCookie('user_cookie',
      UserSession.user_number.ToString, '/', Date + 10);
  end;
  with DM.FDQuery1 do
  begin
    SQL.Clear;
    SQL.Add('select * from cart_data;');
    Open;
    if Locate('NUMBER;SERIAL', VarArrayOf([UserSession.user_number,
      UserSession.Serial]), []) = true then
    begin
      Edit;
      FieldByName('VOLUME').AsInteger := FieldByName('VOLUME').AsInteger + i;
      Post;
    end
    else
      AppendRecord([nil, i, UserSession.user_number, UserSession.Serial]);
  end;
  WebApplication.ShowConfirm('�J�[�g��������������', 'callback', '����', '����', '������');
end;

procedure TIWForm1.IWFrame8IWLink1Click(Sender: TObject);
begin
  Thumbnail := true;
end;

procedure TIWForm1.IWGrid1CellClick(ASender: TObject;
  const ARow, AColumn: Integer);
begin
  Thumbnail := false;
  IWFrame8.IWEdit1.Text := '1';
  UserSession.Serial := Integer(IWGrid1.Cell[ARow, AColumn].Tag);
end;

procedure TIWForm1.IWLink1Click(Sender: TObject);
begin
  TUserForm.Create(WebApplication).Show;
end;

procedure TIWForm1.IWLink2Click(Sender: TObject);
var
  i: Integer;
begin
  if Page = true then
  begin
    i := UserSession.user_number;
    if (DM.FDTable1.Locate('EMAIL;PASSWORD',
      VarArrayOf([IWEdit2.Text, UserSession.hash(IWEdit3.Text)]),
      [loCaseInsensitive]) = true) and
      (DM.FDTable1.FieldByName('EMAIL').AsString <> '') then
    begin
      IWEdit2.Text := '';
      UserSession.user_number := DM.FDTable1.FieldByName('NUMBER').AsInteger;
      if i <> 0 then
      begin
        with DM.FDQuery1 do
        begin
          SQL.Clear;
          SQL.Add('select * from user_data where number = :num');
          Params.ParamByName('num').AsInteger := i;
          Open;
          Delete;
          SQL.Clear;
          SQL.Add('select number from cart_data where number = :num;');
          Params.ParamByName('num').AsInteger := i;
          Open;
          First;
          while Eof = false do
          begin
            Edit;
            FieldByName('number').AsInteger := UserSession.user_number;
            Next;
          end;
        end;
      end;
      Page := false;
    end;
    IWEdit3.Text := '';
  end
  else
    Page := true;
end;

procedure TIWForm1.IWLink3Click(Sender: TObject);
begin
  with TMyPage.Create(WebApplication) do
  begin
    Form := Self;
    Show;
  end;
end;

procedure TIWForm1.IWLink4Click(Sender: TObject);
begin
  TCartForm.Create(WebApplication).Show;
end;

procedure TIWForm1.IWLink5Click(Sender: TObject);
begin
  TIWForm10.Create(WebApplication).Show;
end;

procedure TIWForm1.IWLink6Click(Sender: TObject);
begin
  Page := true;
  TIWForm3.Create(WebApplication).Show;
end;

procedure TIWForm1.LoadImage;
var
  s: TStream;
  png: TPngImage;
  pic: TIWImage;
  i: Integer;
  j: Integer;
  x: Boolean;
  t: string;
label label1;
begin
  ClearImage;
  png := TPngImage.Create;
  try
    if Thumbnail = true then
    begin
      i := DM.FDTable2.RecordCount div IWGrid1.ColumnCount;
      if DM.FDTable2.RecordCount mod IWGrid1.ColumnCount > 0 then
        inc(i);
      IWGrid1.RowCount := i;
      if DM.FDTable2.Filtered = false then
        DM.FDTable2.Last
      else
        DM.FDTable2.FindLast;
      for i := 0 to IWGrid1.RowCount - 1 do
        for j := 0 to IWGrid1.ColumnCount - 1 do
        begin
          if DM.FDTable2.Filtered = false then
          begin
            if DM.FDTable2.Bof = true then
              goto label1;
          end
          else if DM.FDTable2.Found = false then
            goto label1;
          if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then
          begin
            s := DM.FDTable2.CreateBlobStream
              (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
            try
              png.LoadFromStream(s);
            finally
              s.Free;
            end;
            pic := TIWImage.Create(IWGrid1);
            pic.Picture.Assign(png);
            IWGrid1.Cell[i, j].Control := pic;
          end;
          t := DM.FDTable2.FieldByName('NAME').AsString;
          if Length(t) > 10 then
            t := Copy(t, 1, 8) + '..';
          IWGrid1.Cell[i, j].Tag :=
            Pointer(DM.FDTable2.FieldByName('SERIAL').AsInteger);
          IWGrid1.Cell[i, j].Text := t;
          IWGrid1.Cell[i, j].Alignment := taCenter;
          IWGrid1.Cell[i, j].Clickable := true;
          if DM.FDTable2.Filtered = false then
            DM.FDTable2.Prior
          else
            DM.FDTable2.FindPrior;
        end;
    label1:
    end
    else if (DM.FDTable2.Locate('SERIAL', UserSession.Serial, []) = true) and
      (DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil) then
    begin
      s := DM.FDTable2.CreateBlobStream
        (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
      try
        png.LoadFromStream(s);
        IWFrame8.IWImage1.Picture.Assign(png);
      finally
        s.Free;
      end;
    end
    else
      IWFrame8.IWImage1.Picture.Assign(nil);
  finally
    png.Free;
  end;
  png := nil;
  s := nil;
  Randomize;
  if DM.FDTable2.Filtered = true then
  begin
    x := true;
    DM.FDTable2.Filtered := false;
  end
  else
    x := false;
  DM.FDTable2.Last;
  if DM.FDTable2.Bof = true then
    Exit;
  DM.FDTable2.MoveBy(-Random(DM.FDTable2.RecordCount div 5));
  if DM.FDTable2.FieldByName('THUMBNAIL').AsBytes <> nil then
  begin
    s := DM.FDTable2.CreateBlobStream
      (DM.FDTable2.FieldByName('THUMBNAIL'), bmRead);
    png := TPngImage.Create;
    try
      png.LoadFromStream(s);
      IWImage1.Picture.Assign(png);
    finally
      png.Free;
      s.Free;
    end;
  end;
  if x = true then
    DM.FDTable2.Filtered := true;
  IWLabel4.Caption := DM.FDTable2.FieldByName('NAME').AsString;
end;

procedure TIWForm1.SetPage(const Value: Boolean);
begin
  UserSession.FPage := Value;
  IWRegion7.Visible := not Value;
  IWDBLabel1.Visible := not Value;
  IWLink3.Visible := not Value;
  IWLink1.Visible := Value;
  IWText1.Visible := Value;
  if Value = false then
  begin
    IWLabel1.Caption := '��������';
    IWLink2.Caption := '���O�A�E�g';
    WebApplication.Response.Cookies.AddCookie('user_cookie',
      UserSession.user_number.ToString, '/', Date + 10);
  end
  else
  begin
    IWLabel1.Caption := '���������Q�X�g�l';
    IWLink2.Caption := '���O�C��';
    Thumbnail := true;
    IWText1.Text := '';
    DM.FDTable2.Filtered := false;
    Filter := false;
    if DM.FDTable1.FieldByName('EMAIL').AsString <> '' then
    begin
      WebApplication.Response.Cookies.AddCookie('user_cookie',
        UserSession.user_number.ToString, '/', Date - 1);
      UserSession.user_number := 0;
    end;
  end;
end;

procedure TIWForm1.SetThumbnail(const Value: Boolean);
begin
  UserSession.FThumbnail := Value;
  IWGrid1.Visible := Value;
  IWFrame8.Visible := not Value;
end;

initialization

TIWForm1.SetAsMainForm;

end.