{
  Sources of pictures:
  http://www.peanutgallery.com.au
  http://www.boattrader.com
  http://www.japanesevehicles.com
  http://www.lixano.de
  http://www.furniture.com
  http://www.nokia.com
  http://www.asus.com
  http://www.aser.com
  http://www.samsung.com
  http://www.onlinesports.com

}

unit MFBuy;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, SRVSkinManager, SclRView, StdCtrls, ExtCtrls, SRVButton, SRVSBar,
  SRVEdit, SRVPaintBox, SRVImagesScroll, SRVListBox, SRVComboBox, SRVTypeItems,
  SRVControl, RichView, RVStyle, ImgList, jpeg, SRVPrint;

type
  TfrmBuy = class(TForm)
    Panel1: TPanel;
    srve: TSRichViewEdit;
    SRVSkinManager1: TSRVSkinManager;
    imgScroll: TImageList;
    SRVPrint1: TSRVPrint;
    PrintDialog1: TPrintDialog;
    SRVButton1: TSRVButton;
    SRVButton2: TSRVButton;
    procedure FormCreate(Sender: TObject);
    procedure srveControlAction(Sender: TCustomRichView;
      ControlAction: TRVControlAction; ItemNo: Integer;
      var ctrl: TControl);
    procedure srveCheckControl(Sender: TSRichViewEdit; AControl: TControl);
    procedure FormDestroy(Sender: TObject);
    procedure SRVButton2Click(Sender: TObject);
    procedure SRVButton1Click(Sender: TObject);
  private
    { Private declarations }
    procedure pbPhotoPaint(Sender: TObject; R: TRect; Canvas: TCanvas);
    procedure CategoryChange(Sender: TObject);
    procedure OptionChange(Sender: TObject);
    procedure PhotoScrollChange(Sender: TObject);
    procedure ChangeEditHints(Sender: TSRVEditControl; Text: String;
      EditHints: TStringList; var ItemIndex: Integer);
  public
    { Public declarations }
    CategoryIndex : Integer;
    SubCategoryIndex : Integer;
    isPhotoScroll : TSRVImagesScroll;
    picPhoto : TPicture;
    CanUpdateOption : Boolean;
  end;

var
  frmBuy: TfrmBuy;

implementation

uses MFPreview;

{$R *.dfm}
{------------------------------------------------------------------------------}
procedure TfrmBuy.FormCreate(Sender: TObject);
begin
  CanUpdateOption := True;
  CategoryIndex := -1;
  SubCategoryIndex := -1;
  isPhotoScroll := nil;
  picPhoto := TPicture.Create;
  // Loading a sample document
  srve.LoadRVF('form.rvf');
end;
{------------------------------------------------------------------------------}
procedure TfrmBuy.FormDestroy(Sender: TObject);
begin
  picPhoto.Free;
end;
{------------------------------------------------------------------------------}
// Drawing a product photo on SRVPaintBox
procedure TfrmBuy.pbPhotoPaint(Sender: TObject; R: TRect; Canvas: TCanvas);
var
     X, Y : Integer;
     W, H : Integer;
     scaleW, scaleH : Single;
     Text : string;
begin
  if (picPhoto.Graphic = nil) or picPhoto.Graphic.Empty then begin
    Canvas.Brush.Style := bsSolid;
    Canvas.Pen.Style := psSolid;
    Canvas.Brush.Color := clWhite;
    Canvas.Pen.Color := clBlack;
    Canvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);

    Canvas.Font.Color := clBlack;
    Canvas.Font.Size := 14;
    Canvas.Brush.Style := bsClear;

    Text := 'Select item';
    X := R.Left + ((R.Right - R.Left - Canvas.TextWidth(Text)) div 2);
    Y := R.Top + ((R.Bottom - R.Top - Canvas.TextHeight(Text)) div 2);
    Canvas.TextRect(R, X, Y, Text);
  end else begin
    W := R.Right - R.Left;
    H := R.Bottom - R.Top;
    scaleW := W / picPhoto.Width;
    scaleH := H / picPhoto.Height;
    If (scaleW < scaleH) then
      R := Bounds(R.Left, R.Top + Round(H - picPhoto.Height * scaleW) div 2, W, Round(picPhoto.Height * scaleW))
    else
      R := Bounds(R.Left + Round(W - picPhoto.Width * scaleH) div 2, R.Top, Round(picPhoto.Width * scaleH), H);
    Canvas.StretchDraw(R, picPhoto.Graphic);
  end;
end;
{------------------------------------------------------------------------------}
// Processing loading controls from RVF
procedure TfrmBuy.srveControlAction(Sender: TCustomRichView;
  ControlAction: TRVControlAction; ItemNo: Integer; var ctrl: TControl);
var
  StringList : TStringList;
begin
  if (ControlAction <> rvcaAfterRVFLoad) then
    exit;
  // Categories
  if (ctrl is TSRVComboBox) and
     (ctrl.Name = 'cmbCategory') then begin
    StringList := TStringList.Create;
    StringList.LoadFromFile(
      ExtractFilePath(Application.ExeName)+'gallery\category.txt');
    TSRVComboBox(ctrl).Style := csDropDownList;
    TSRVComboBox(ctrl).SkinManager := SRVSkinManager1;
    TSRVComboBox(ctrl).ItemSkinSchemeIndex := 1;
    TSRVComboBox(ctrl).ButtonSkinSchemeIndex := 2;
    TSRVComboBox(ctrl).EditSkinSchemeIndex := 3;
    TSRVComboBox(ctrl).SkinSchemeIndex := -1;
    TSRVComboBox(ctrl).HotItemTextColor := clActiveCaption;
    TSRVComboBox(ctrl).SelectedItemTextColor := clWindowText;
    TSRVComboBox(ctrl).EnabledBorderColor := clNone;
    TSRVComboBox(ctrl).DisabledBorderColor := clNone;
    TSRVComboBox(ctrl).MouseInBorderColor := clNone;
    TSRVComboBox(ctrl).FocusedBorderColor := clNone;
    TSRVComboBox(ctrl).Items.Clear;
    TSRVComboBox(ctrl).Items.Assign(StringList);
    TSRVComboBox(ctrl).OnChange := CategoryChange;
    CategoryIndex := -1;
    StringList.Free;
  end;
  // list box with subcategories
  if (ctrl is TSRVListBox) and (ctrl.Name = 'lstOption') then begin
    StringList := TStringList.Create;
    If CategoryIndex <> -1 then
      StringList.LoadFromFile(
        ExtractFilePath(Application.ExeName)+'gallery\' + IntToStr(CategoryIndex) + '.txt');
    TSRVListBox(ctrl).SkinManager := SRVSkinManager1;
    TSRVListBox(ctrl).SkinSchemeIndex := -1;
    TSRVListBox(ctrl).ItemSkinSchemeIndex := 1;
    TSRVListBox(ctrl).HotItemTextColor := clActiveCaption;
    TSRVListBox(ctrl).SelectedItemTextColor := clWindowText;
    TSRVListBox(ctrl).OnClick := OptionChange;
    TSRVListBox(ctrl).Font.Name := 'Arial';
    TSRVListBox(ctrl).Items.Clear;
    TSRVListBox(ctrl).Items.Assign(StringList);
    StringList.Free;
  end;
  // image scroller with product photos
  if (ctrl is TSRVImagesScroll) and (ctrl.Name = 'imgscrPhoto') then begin
    TSRVImagesScroll(ctrl).SkinManager := SRVSkinManager1;
    TSRVImagesScroll(ctrl).SkinSchemeIndex := -1;
    TSRVImagesScroll(ctrl).Color := clWhite;
    TSRVImagesScroll(ctrl).ItemBorderColor := clNone;
    TSRVImagesScroll(ctrl).ImageList := imgScroll;
    TSRVImagesScroll(ctrl).OnChange := PhotoScrollChange;
    TSRVImagesScroll(ctrl).Items.Clear;
    TSRVImagesScroll(ctrl).CloseButton.Visible := False;
  end;
  // Paint box with product photo
  if (ctrl is TSRVPaintBox) and (ctrl.Name = 'pbPhoto') then begin
    TSRVPaintBox(ctrl).OnPaint := pbPhotoPaint;
  end;
  // Emain text box
  if (ctrl is TSRVEdit) and (ctrl.Name = 'txtEMail') then begin
    TSRVEdit(ctrl).OnEditHints := ChangeEditHints;
  end;
  // Buy button
  if (ctrl is TSRVButton) and (ctrl.Name = 'btnBuy') then begin
    TSRVButton(ctrl).SkinManager := SRVSkinManager1;
  end;
end;
{------------------------------------------------------------------------------}
// Changing category
procedure TfrmBuy.CategoryChange(Sender: TObject);
begin
  CategoryIndex := TSRVComboBox(Sender).ItemIndex;
  SubCategoryIndex := -1;
  srve.ProcessControls;
  srve.UpdateBuffer;
end;
{------------------------------------------------------------------------------}
// Changing subcategory
procedure TfrmBuy.OptionChange(Sender: TObject);
begin
  If (SubCategoryIndex = TSRVListBox(Sender).ItemIndex) then
    exit;
  SubCategoryIndex := TSRVListBox(Sender).ItemIndex;
  isPhotoScroll := nil;
  CanUpdateOption := False;
  srve.ProcessControls;
  CanUpdateOption := True;
  srve.UpdateBuffer;
end;
{------------------------------------------------------------------------------}
// Choosing product
procedure TfrmBuy.PhotoScrollChange(Sender: TObject);
begin
  If TSRVImagesScroll(Sender).ItemIndex = -1 then
    picPhoto.Graphic := nil
  else
    with TSRVImagesScroll(Sender) do
      picPhoto.LoadFromFile(TSRVImageScrollItem(Items.Items[ItemIndex]).Link);
  srve.UpdateBuffer;
end;
{------------------------------------------------------------------------------}
// Editing suggesting when entering email
procedure TfrmBuy.ChangeEditHints(Sender: TSRVEditControl; Text: String;
  EditHints: TStringList; var ItemIndex: Integer);
begin
  If Pos('@', Text) = 0 then begin
    EditHints.Append(Text + '@mail.com');
    EditHints.Append(Text + '@gmail.com');
    EditHints.Append(Text + '@yahoo.com');
    EditHints.Append(Text + '@msn.com');
  end;
end;
{------------------------------------------------------------------------------}
// Editing suggesting when entering email
procedure TfrmBuy.srveCheckControl(Sender: TSRichViewEdit;
  AControl: TControl);
var
     StringList : TStringList;
     bmp : TBitmap;
     jpg : TJPEGImage;
     i, Index : Integer;
     FileName : string;
     R : TRect;
     scaleW, scaleH : Single;
begin
  // Loading subcategories
  if (AControl.Name = 'lstOption') and CanUpdateOption then begin
    StringList := TStringList.Create;
    If CategoryIndex <> -1 then
      StringList.LoadFromFile(ExtractFilePath(Application.ExeName)+
       'gallery\' + IntToStr(CategoryIndex) + '.txt');
    TSRVListBox(AControl).SkinManager := SRVSkinManager1;
    TSRVListBox(AControl).Items.Assign(StringList);
    StringList.Free;
  end;
  // Creating thumbnails for product images
  // This is a demo procedure: it ignores subcategories, loads 30 random pictures
  if (AControl.Name = 'imgscrPhoto') then begin
    TSRVImagesScroll(AControl).SkinManager := SRVSkinManager1;
    TSRVImagesScroll(AControl).BeginUpdate;
    TSRVImagesScroll(AControl).Items.Clear;
    imgScroll.Clear;
    imgScroll.Width := TSRVImagesScroll(AControl).ItemWidth;
    imgScroll.Height := TSRVImagesScroll(AControl).ItemHeight;
    bmp := TBitmap.Create;
    bmp.Width := TSRVImagesScroll(AControl).ItemWidth;
    bmp.Height := TSRVImagesScroll(AControl).ItemHeight;
    jpg := TJPEGImage.Create;
    If CategoryIndex <> -1 then
      for i:= 1 to 30 do begin
        Index := Random(50);
        FileName := ExtractFilePath(Application.ExeName)+'gallery\' + IntToStr(CategoryIndex) + '\' + IntToStr(Index) + '.jpg';
        If FileExists(FileName) then begin
          bmp.Canvas.Brush.Color := TSRVImagesScroll(AControl).Color;
          bmp.Canvas.FillRect(bmp.Canvas.ClipRect);
          jpg.LoadFromFile(FileName);
          scaleW := bmp.Width / jpg.Width;
          scaleH := bmp.Height / jpg.Height;
          If (scaleW < scaleH) then
            R := Bounds(0, Round(bmp.Height - jpg.Height * scaleW) div 2, bmp.Width, Round(jpg.Height * scaleW))
          else
            R := Bounds(Round(bmp.Width - jpg.Width * scaleH) div 2, 0, Round(jpg.Width * scaleH), bmp.Height);
          bmp.Canvas.StretchDraw(R, jpg);
          imgScroll.Add(bmp, nil);
          with TSRVImageScrollItem(TSRVImagesScroll(AControl).Items.Add) do begin
            ImageIndex := Index;
            Link := FileName;
          end;
        end;
      end;
    TSRVImagesScroll(AControl).EndUpdate;
    TSRVImagesScroll(AControl).ItemIndex := -1;
    bmp.Destroy;
    jpg.Destroy;
  end;
end;
{------------------------------------------------------------------------------}
// Printing
procedure TfrmBuy.SRVButton2Click(Sender: TObject);
begin
  if PrintDialog1.Execute then
    SRVPrint1.PrintPages(PrintDialog1.FromPage, PrintDialog1.ToPage,
      'Order', PrintDialog1.Copies, PrintDialog1.Collate);
end;
{------------------------------------------------------------------------------}
// Previewing
procedure TfrmBuy.SRVButton1Click(Sender: TObject);
begin
  FPreview.Show;
end;

initialization
  RegisterClass(TSRVButton);
  RegisterClass(TSRVEdit);
  RegisterClass(TSRVPaintBox);
  RegisterClass(TSRVComboBox);
  RegisterClass(TSRVListBox);
  RegisterClass(TSRVImagesScroll);
  RegisterClass(TSRVScrollBar);

end.
