source upload
@@ -0,0 +1,24 @@
|
||||
{"name":"CHATEAU DE SAINT COSME","year":"2009","grapes":"Grenache / Syrah","country":"France","region":"Southern Rhone","description":"The aromas of fruit and spice give one a hint of the light drinkability of this lovely wine, which makes an excellent complement to fish dishes.","picture":"saint_cosme.jpg","items":[{"sku":"Type A","quantity":1,"price":10.5},{"sku":"Type B","quantity":3,"price":13.5}]}
|
||||
{"name":"LAN RIOJA CRIANZA","year":"2006","grapes":"Tempranillo","country":"Spain","region":"Rioja","description":"A resurgence of interest in boutique vineyards has opened the door for this excellent foray into the dessert wine market. Light and bouncy, with a hint of black truffle, this wine will not fail to tickle the taste buds.","picture":"lan_rioja.jpg","items":[{"sku":"Type A","quantity":2,"price":8.5},{"sku":"Type B","quantity":5,"price":23.5}]}
|
||||
{"name":"MARGERUM SYBARITE","year":"2010","grapes":"Sauvignon Blanc","country":"USA","region":"California Central Cosat","description":"The cache of a fine Cabernet in ones wine cellar can now be replaced with a childishly playful wine bubbling over with tempting tastes of black cherry and licorice. This is a taste sure to transport you back in time.","picture":"margerum.jpg","items":[{"sku":"Type A","quantity":2,"price":10.5}]}
|
||||
{"name":"OWEN ROE \"EX UMBRIS\"","year":"2009","grapes":"Syrah","country":"USA","region":"Washington","description":"A one-two punch of black pepper and jalapeno will send your senses reeling, as the orange essence snaps you back to reality. Don't miss this award-winning taste sensation.","picture":"ex_umbris.jpg","items":[{"sku":"Type A","quantity":1,"price":10.5},{"sku":"Type B","quantity":3,"price":13.5},{"sku":"Type B","quantity":9,"price":13.5}]}
|
||||
{"name":"REX HILL","year":"2009","grapes":"Pinot Noir","country":"USA","region":"Oregon","description":"One cannot doubt that this will be the wine served at the Hollywood award shows, because it has undeniable star power. Be the first to catch the debut that everyone will be talking about tomorrow.","picture":"rex_hill.jpg","items":[{"sku":"Type A","quantity":1,"price":10.5},{"sku":"Type B","quantity":3,"price":13.5}]}
|
||||
{"name":"VITICCIO CLASSICO RISERVA","year":"2007","grapes":"Sangiovese Merlot","country":"Italy","region":"Tuscany","description":"Though soft and rounded in texture, the body of this wine is full and rich and oh-so-appealing. This delivery is even more impressive when one takes note of the tender tannins that leave the taste buds wholly satisfied.","picture":"viticcio.jpg","items":[{"sku":"Type A","quantity":1,"price":10.5}]}
|
||||
{"name":"CHATEAU LE DOYENNE","year":"2005","grapes":"Merlot","country":"France","region":"Bordeaux","description":"Though dense and chewy, this wine does not overpower with its finely balanced depth and structure. It is a truly luxurious experience for the senses.","picture":"le_doyenne.jpg","items":[{"sku":"Type A","quantity":1,"price":10.5},{"sku":"Type B","quantity":3,"price":13.5},{"sku":"Type B","quantity":9,"price":13.5}]}
|
||||
{"name":"DOMAINE DU BOUSCAT","year":"2009","grapes":"Merlot","country":"France","region":"Bordeaux","description":"The light golden color of this wine belies the bright flavor it holds. A true summer wine, it begs for a picnic lunch in a sun-soaked vineyard.","picture":"bouscat.jpg","items":[{"sku":"Type A","quantity":1,"price":10.5},{"sku":"Type B","quantity":3,"price":13.5}]}
|
||||
{"name":"BLOCK NINE","year":"2009","grapes":"Pinot Noir","country":"USA","region":"California","description":"With hints of ginger and spice, this wine makes an excellent complement to light appetizer and dessert fare for a holiday gathering.","picture":"block_nine.jpg","items":[{"sku":"Type A","quantity":8,"price":18.5},{"sku":"Type B","quantity":3,"price":19.5}]}
|
||||
{"name":"DOMAINE SERENE","year":"2007","grapes":"Pinot Noir","country":"USA","region":"Oregon","description":"Though subtle in its complexities, this wine is sure to please a wide range of enthusiasts. Notes of pomegranate will delight as the nutty finish completes the picture of a fine sipping experience.","picture":"domaine_serene.jpg","items":[{"sku":"Type A","quantity":1,"price":19.5},{"sku":"Type B","quantity":3,"price":15.5}]}
|
||||
{"name":"BODEGA LURTON","year":"2011","grapes":"Pinot Gris","country":"Argentina","region":"Mendoza","description":"Solid notes of black currant blended with a light citrus make this wine an easy pour for varied palates.","picture":"bodega_lurton.jpg","items":[{"sku":"Type A","quantity":10,"price":10.5},{"sku":"Type B","quantity":30,"price":18.5}]}
|
||||
{"name":"LES MORIZOTTES","year":"2009","grapes":"Chardonnay","country":"France","region":"Burgundy","description":"Breaking the mold of the classics, this offering will surprise and undoubtedly get tongues wagging with the hints of coffee and tobacco in perfect alignment with more traditional notes. Sure to please the late-night crowd with the slight jolt of adrenaline it brings.","picture":"morizottes.jpg","items":[{"sku":"Type A","quantity":1,"price":10.5}]}
|
||||
{"name":"ARGIANO NON CONFUNDITUR","year":"2009","grapes":"Cabernet Sauvignon","country":"Italy","region":"Tuscany","description":"Like a symphony, this cabernet has a wide range of notes that will delight the taste buds and linger in the mind.","picture":"argiano.jpg","items":[{"sku":"Type A","quantity":1,"price":10.5},{"sku":"Type B","quantity":3,"price":13.5},{"sku":"Type B","quantity":9,"price":13.5}]}
|
||||
{"name":"DINASTIA VIVANCO ","year":"2008","grapes":"Tempranillo","country":"Spain","region":"Rioja","description":"Whether enjoying a fine cigar or a nicotine patch, don't pass up a taste of this hearty Rioja, both smooth and robust.","picture":"dinastia.jpg","items":[{"sku":"Type A","quantity":1,"price":18.5},{"sku":"Type B","quantity":8,"price":15.5}]}
|
||||
{"name":"PETALOS BIERZO","year":"2009","grapes":"Mencia","country":"Spain","region":"Castilla y Leon","description":"For the first time, a blend of grapes from two different regions have been combined in an outrageous explosion of flavor that cannot be missed.","picture":"petalos.jpg","items":[{"sku":"Type A","quantity":10,"price":10.5},{"sku":"Type B","quantity":38,"price":13.5}]}
|
||||
{"name":"SHAFER RED SHOULDER RANCH","year":"2009","grapes":"Chardonnay","country":"USA","region":"California","description":"Keep an eye out for this winery in coming years, as their chardonnays have reached the peak of perfection.","picture":"shafer.jpg","items":[{"sku":"Type A","quantity":15,"price":10.5},{"sku":"Type B","quantity":93,"price":13.5}]}
|
||||
{"name":"PONZI","year":"2010","grapes":"Pinot Gris","country":"USA","region":"Oregon","description":"For those who appreciate the simpler pleasures in life, this light pinot grigio will blend perfectly with a light meal or as an after dinner drink.","picture":"ponzi.jpg","items":[{"sku":"Type A","quantity":1,"price":10.5}]}
|
||||
{"name":"HUGEL","year":"2010","grapes":"Pinot Gris","country":"France","region":"Alsace","description":"Fresh as new buds on a spring vine, this dewy offering is the finest of the new generation of pinot grigios. Enjoy it with a friend and a crown of flowers for the ultimate wine tasting experience.","picture":"hugel.jpg","items":[{"sku":"Type A","quantity":1,"price":10.5},{"sku":"Type B","quantity":3,"price":13.5},{"sku":"Type c","quantity":9,"price":13.5}]}
|
||||
{"name":"FOUR VINES MAVERICK","year":"2011","grapes":"Zinfandel","country":"USA","region":"California","description":"o yourself a favor and have a bottle (or two) of this fine zinfandel on hand for your next romantic outing. The only thing that can make this fine choice better is the company you share it with.","picture":"fourvines.jpg","items":[{"sku":"Type A","quantity":1,"price":10.5},{"sku":"Type B","quantity":3,"price":13.5}]}
|
||||
{"name":"QUIVIRA DRY CREEK VALLEY","year":"2009","grapes":"Zinfandel","country":"USA","region":"California","description":"Rarely do you find a zinfandel this oakey from the Sonoma region. The vintners have gone to extremes to duplicate the classic flavors that brought high praise in the early '90s.","picture":"quivira.jpg","items":[{"sku":"Type A","quantity":1,"price":10.5},{"sku":"Type B","quantity":3,"price":13.5},{"sku":"Type C","quantity":9,"price":13.5}]}
|
||||
{"name":"CALERA 35TH ANNIVERSARY","year":"2010","grapes":"Pinot Noir","country":"USA","region":"California","description":"Fruity and bouncy, with a hint of spice, this pinot noir is an excellent candidate for best newcomer from Napa this year.","picture":"calera.jpg","items":[{"sku":"Type A","quantity":1,"price":10.5},{"sku":"Type B","quantity":3,"price":13.5}]}
|
||||
{"name":"CHATEAU CARONNE STE GEMME","year":"2010","grapes":"Cabernet Sauvignon","country":"France","region":"Bordeaux","description":"Find a sommelier with a taste for chocolate and he's guaranteed to have this cabernet on his must-have list.","picture":"caronne.jpg","items":[{"sku":"Type A","quantity":1,"price":18.5},{"sku":"Type B","quantity":8,"price":19.5}]}
|
||||
{"name":"MOMO MARLBOROUGH","year":"2010","grapes":"Sauvignon Blanc","country":"New Zealand","region":"South Island","description":"Best served chilled with melon or a nice salty prosciutto, this sauvignon blanc is a staple in every Italian kitchen, if not on their wine list. Request the best, and you just may get it.","picture":"momo.jpg","items":[{"sku":"Type A","quantity":1,"price":10.5},{"sku":"Type B","quantity":3,"price":13.5}]}
|
||||
{"name":"WATERBROOK","year":"2009","grapes":"Merlot","country":"USA","region":"Washington","description":"Legend has it the gods didn't share their ambrosia with mere mortals. This merlot may be the closest we've ever come to a taste of heaven.","picture":"waterbrook.jpg","items":[{"sku":"Type A","quantity":1,"price":10.5},{"sku":"Type B","quantity":3,"price":13.5},{"sku":"Type C","quantity":9,"price":13.5}]}
|
@@ -0,0 +1,121 @@
|
||||
object Items: TItems
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 286
|
||||
Height = 361
|
||||
ActiveControl = StringGrid
|
||||
Caption = 'Items Details'
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
OldCreateOrder = False
|
||||
OnCreate = FormCreate
|
||||
DesignSize = (
|
||||
278
|
||||
334)
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object Label1: TLabel
|
||||
Left = 8
|
||||
Top = 196
|
||||
Width = 23
|
||||
Height = 13
|
||||
Anchors = [akLeft, akBottom]
|
||||
Caption = 'SKU:'
|
||||
end
|
||||
object Label2: TLabel
|
||||
Left = 8
|
||||
Top = 222
|
||||
Width = 46
|
||||
Height = 13
|
||||
Anchors = [akLeft, akBottom]
|
||||
Caption = 'Quantity:'
|
||||
end
|
||||
object Label3: TLabel
|
||||
Left = 8
|
||||
Top = 248
|
||||
Width = 27
|
||||
Height = 13
|
||||
Anchors = [akLeft, akBottom]
|
||||
Caption = 'Price:'
|
||||
end
|
||||
object StringGrid: TStringGrid
|
||||
Left = 8
|
||||
Top = 8
|
||||
Width = 265
|
||||
Height = 173
|
||||
Anchors = [akLeft, akTop, akRight, akBottom]
|
||||
DefaultColWidth = 50
|
||||
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSelect]
|
||||
TabOrder = 7
|
||||
end
|
||||
object edtName: TEdit
|
||||
Left = 63
|
||||
Top = 193
|
||||
Width = 121
|
||||
Height = 21
|
||||
Anchors = [akLeft, akBottom]
|
||||
TabOrder = 0
|
||||
end
|
||||
object btnAdd: TButton
|
||||
Left = 193
|
||||
Top = 191
|
||||
Width = 75
|
||||
Height = 25
|
||||
Anchors = [akLeft, akBottom]
|
||||
Caption = 'Add'
|
||||
Default = True
|
||||
TabOrder = 3
|
||||
OnClick = btnAddClick
|
||||
end
|
||||
object btnDelete: TButton
|
||||
Left = 193
|
||||
Top = 218
|
||||
Width = 75
|
||||
Height = 25
|
||||
Anchors = [akLeft, akBottom]
|
||||
Caption = 'Delete'
|
||||
TabOrder = 4
|
||||
OnClick = btnDeleteClick
|
||||
end
|
||||
object Button1: TButton
|
||||
Left = 193
|
||||
Top = 248
|
||||
Width = 76
|
||||
Height = 25
|
||||
Caption = 'Save'
|
||||
TabOrder = 5
|
||||
OnClick = Button1Click
|
||||
end
|
||||
object edtCity: TMaskEdit
|
||||
Left = 63
|
||||
Top = 219
|
||||
Width = 95
|
||||
Height = 21
|
||||
AutoSelect = False
|
||||
AutoSize = False
|
||||
EditMask = '999;1;_'
|
||||
MaxLength = 3
|
||||
TabOrder = 1
|
||||
Text = ' '
|
||||
end
|
||||
object edtEmail: TMaskEdit
|
||||
Left = 61
|
||||
Top = 246
|
||||
Width = 86
|
||||
Height = 21
|
||||
TabOrder = 2
|
||||
end
|
||||
object Button2: TButton
|
||||
Left = 104
|
||||
Top = 288
|
||||
Width = 75
|
||||
Height = 25
|
||||
Caption = 'Button2'
|
||||
TabOrder = 6
|
||||
OnClick = Button2Click
|
||||
end
|
||||
end
|
@@ -0,0 +1,131 @@
|
||||
unit Form2;
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, Grids, StdCtrls, Mask;
|
||||
|
||||
type
|
||||
TItems = class(TForm)
|
||||
StringGrid: TStringGrid;
|
||||
edtName: TEdit;
|
||||
btnAdd: TButton;
|
||||
Label1: TLabel;
|
||||
Label2: TLabel;
|
||||
Label3: TLabel;
|
||||
btnDelete: TButton;
|
||||
Button1: TButton;
|
||||
edtCity: TMaskEdit;
|
||||
edtEmail: TMaskEdit;
|
||||
Button2: TButton;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure btnAddClick(Sender: TObject);
|
||||
procedure btnDeleteClick(Sender: TObject);
|
||||
procedure Button1Click(Sender: TObject);
|
||||
procedure Button2Click(Sender: TObject);
|
||||
private
|
||||
procedure DeleteStringGridRow(n: Integer; var Grid: TStringGrid);
|
||||
public
|
||||
end;
|
||||
|
||||
var
|
||||
Items: TItems;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
procedure TItems.FormCreate(Sender: TObject);
|
||||
begin
|
||||
StringGrid.ColCount := 4;
|
||||
StringGrid.RowCount := 2;
|
||||
StringGrid.FixedRows := 1;
|
||||
StringGrid.ColWidths[0] := 50;
|
||||
StringGrid.ColWidths[1] := 100;
|
||||
StringGrid.ColWidths[2] := 50;
|
||||
StringGrid.ColWidths[3] := 50;
|
||||
|
||||
StringGrid.DefaultRowHeight := StringGrid.Canvas.TextHeight('X') + 8;
|
||||
|
||||
StringGrid.Cells[0, 0] := 'Row';
|
||||
StringGrid.Cells[1, 0] := 'SKU';
|
||||
StringGrid.Cells[2, 0] := 'Quantity';
|
||||
StringGrid.Cells[3, 0] := 'Price';
|
||||
end;
|
||||
|
||||
procedure TItems.btnAddClick(Sender: TObject);
|
||||
begin
|
||||
if Trim(edtName.Text) = '' then begin
|
||||
ShowMessage('Name Required');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if (StringGrid.RowCount > 2) or (StringGrid.Cells[1, StringGrid.RowCount-1] > '') then
|
||||
StringGrid.RowCount := StringGrid.RowCount + 1;
|
||||
|
||||
StringGrid.Cells[0, StringGrid.RowCount-1] := IntToStr(StringGrid.RowCount-1);
|
||||
StringGrid.Cells[1, StringGrid.RowCount-1] := edtName.Text;
|
||||
StringGrid.Cells[2, StringGrid.RowCount-1] := edtCity.Text;
|
||||
StringGrid.Cells[3, StringGrid.RowCount-1] := edtEmail.Text;
|
||||
|
||||
edtName.Text := '';
|
||||
edtCity.Text := '';
|
||||
edtEmail.Text := '';
|
||||
|
||||
ActiveControl := edtName;
|
||||
end;
|
||||
|
||||
|
||||
procedure TItems.btnDeleteClick(Sender: TObject);
|
||||
begin
|
||||
if (StringGrid.Row > 0)
|
||||
and (StringGrid.Cells[1, StringGrid.RowCount-1] > '')
|
||||
and (MessageDlg(Format('Delete %s?', [StringGrid.Cells[1, StringGrid.Row]]), mtConfirmation, [mbYes, mbNo], 0) = mrYes) then begin
|
||||
DeleteStringGridRow(StringGrid.Row, StringGrid);
|
||||
if StringGrid.RowCount < 2 then
|
||||
StringGrid.RowCount := 2;
|
||||
end;
|
||||
|
||||
ActiveControl := StringGrid;
|
||||
end;
|
||||
|
||||
procedure TItems.DeleteStringGridRow(n: Integer; var Grid: TStringGrid);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
if Grid.RowCount > Grid.FixedRows + 1 then begin
|
||||
for i := (n + 1) to Grid.RowCount do
|
||||
Grid.Rows[i-1] := Grid.Rows[i];
|
||||
Grid.RowCount := Grid.RowCount -1;
|
||||
end else
|
||||
Grid.Rows[n].Delete(Grid.Row);
|
||||
end;
|
||||
procedure TItems.Button1Click(Sender: TObject);
|
||||
begin
|
||||
close;
|
||||
end;
|
||||
|
||||
type
|
||||
TTableData = record
|
||||
header: String[25]; //the header of the column (row 0)
|
||||
value : String[25]; //the string value of the data
|
||||
number: Integer; //the y-pos of the data in the table
|
||||
end;
|
||||
|
||||
procedure TItems.Button2Click(Sender: TObject);
|
||||
var
|
||||
i, j: Integer;
|
||||
arrData : TTableData;
|
||||
tableData : array of TTableData;
|
||||
Total_Firma:array of array[0..3] of string;
|
||||
CSV : TStrings;
|
||||
begin
|
||||
end;
|
||||
// for i:= 0 to StringGrid1.RowCount - 1 do begin
|
||||
// for j:=0 to StringGrid1.ColCount - 1 do begin
|
||||
// ShowMessage(tableData[i,j].header+': '+tableData[i,j].value);
|
||||
// end;
|
||||
// end;
|
||||
//end;
|
||||
|
||||
end.
|
@@ -0,0 +1,402 @@
|
||||
object FrmServidor: TFrmServidor
|
||||
Left = 93
|
||||
Top = 85
|
||||
Width = 801
|
||||
Height = 598
|
||||
Caption = 'mORMot + MongoDB'
|
||||
Color = clCaptionText
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
OldCreateOrder = False
|
||||
OnCreate = FormCreate
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object Label1: TLabel
|
||||
Left = 0
|
||||
Top = 536
|
||||
Width = 793
|
||||
Height = 35
|
||||
Align = alBottom
|
||||
Alignment = taCenter
|
||||
Color = clBtnHighlight
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clRed
|
||||
Font.Height = -29
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = [fsBold]
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object bmp1: TImage
|
||||
Left = 6
|
||||
Top = 8
|
||||
Width = 781
|
||||
Height = 526
|
||||
Stretch = True
|
||||
end
|
||||
object title: TLabel
|
||||
Left = 228
|
||||
Top = 11
|
||||
Width = 503
|
||||
Height = 52
|
||||
Caption = 'mORMot WINE CELLAR'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clMaroon
|
||||
Font.Height = -43
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
end
|
||||
object txtItems: TLabel
|
||||
Left = 207
|
||||
Top = 456
|
||||
Width = 3
|
||||
Height = 13
|
||||
Visible = False
|
||||
end
|
||||
object Label2: TLabel
|
||||
Left = 452
|
||||
Top = 306
|
||||
Width = 31
|
||||
Height = 13
|
||||
Caption = 'Label2'
|
||||
end
|
||||
object status: TLabel
|
||||
Left = 23
|
||||
Top = 62
|
||||
Width = 3
|
||||
Height = 13
|
||||
end
|
||||
object bmp2: TImage
|
||||
Left = 151
|
||||
Top = 25
|
||||
Width = 32
|
||||
Height = 32
|
||||
AutoSize = True
|
||||
OnClick = btnSearchClick
|
||||
end
|
||||
object L1: TLabel
|
||||
Left = 461
|
||||
Top = 323
|
||||
Width = 23
|
||||
Height = 13
|
||||
Caption = 'NEW'
|
||||
end
|
||||
object Label3: TLabel
|
||||
Left = 510
|
||||
Top = 323
|
||||
Width = 25
|
||||
Height = 13
|
||||
Caption = 'SAVE'
|
||||
end
|
||||
object Label4: TLabel
|
||||
Left = 556
|
||||
Top = 321
|
||||
Width = 36
|
||||
Height = 13
|
||||
Caption = 'DELETE'
|
||||
end
|
||||
object Label5: TLabel
|
||||
Left = 609
|
||||
Top = 322
|
||||
Width = 25
|
||||
Height = 13
|
||||
Caption = 'PREV'
|
||||
end
|
||||
object Label6: TLabel
|
||||
Left = 706
|
||||
Top = 322
|
||||
Width = 25
|
||||
Height = 13
|
||||
Caption = 'NEXT'
|
||||
end
|
||||
object Panel1: TPanel
|
||||
Left = 580
|
||||
Top = 81
|
||||
Width = 169
|
||||
Height = 155
|
||||
BevelInner = bvSpace
|
||||
BevelOuter = bvLowered
|
||||
TabOrder = 14
|
||||
object photo: TImage
|
||||
Left = 2
|
||||
Top = 2
|
||||
Width = 165
|
||||
Height = 151
|
||||
Align = alTop
|
||||
Stretch = True
|
||||
OnClick = photoClick
|
||||
end
|
||||
end
|
||||
object txtID: TLabeledEdit
|
||||
Left = 196
|
||||
Top = 46
|
||||
Width = 183
|
||||
Height = 24
|
||||
EditLabel.Width = 11
|
||||
EditLabel.Height = 13
|
||||
EditLabel.Caption = 'ID'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clNavy
|
||||
Font.Height = -13
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
TabOrder = 8
|
||||
Visible = False
|
||||
end
|
||||
object txtname: TLabeledEdit
|
||||
Left = 196
|
||||
Top = 86
|
||||
Width = 266
|
||||
Height = 22
|
||||
EditLabel.Width = 27
|
||||
EditLabel.Height = 13
|
||||
EditLabel.Caption = 'Name'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clMaroon
|
||||
Font.Height = -12
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
TabOrder = 2
|
||||
end
|
||||
object txtgrapes: TLabeledEdit
|
||||
Left = 196
|
||||
Top = 124
|
||||
Width = 132
|
||||
Height = 22
|
||||
EditLabel.Width = 34
|
||||
EditLabel.Height = 13
|
||||
EditLabel.Caption = 'Grapes'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clNavy
|
||||
Font.Height = -12
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 4
|
||||
end
|
||||
object txtcountry: TLabeledEdit
|
||||
Left = 330
|
||||
Top = 124
|
||||
Width = 114
|
||||
Height = 22
|
||||
EditLabel.Width = 39
|
||||
EditLabel.Height = 13
|
||||
EditLabel.Caption = 'Country'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clNavy
|
||||
Font.Height = -12
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 5
|
||||
end
|
||||
object txtregion: TLabeledEdit
|
||||
Left = 450
|
||||
Top = 125
|
||||
Width = 106
|
||||
Height = 22
|
||||
EditLabel.Width = 33
|
||||
EditLabel.Height = 13
|
||||
EditLabel.Caption = 'Region'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clNavy
|
||||
Font.Height = -12
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 6
|
||||
end
|
||||
object txtyear: TLabeledEdit
|
||||
Left = 468
|
||||
Top = 85
|
||||
Width = 87
|
||||
Height = 22
|
||||
EditLabel.Width = 22
|
||||
EditLabel.Height = 13
|
||||
EditLabel.Caption = 'Year'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clNavy
|
||||
Font.Height = -12
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 3
|
||||
end
|
||||
object txtphoto: TLabeledEdit
|
||||
Left = 580
|
||||
Top = 251
|
||||
Width = 169
|
||||
Height = 21
|
||||
EditLabel.Width = 28
|
||||
EditLabel.Height = 13
|
||||
EditLabel.Caption = 'Photo'
|
||||
TabOrder = 9
|
||||
Visible = False
|
||||
end
|
||||
object txtdescription: TMemo
|
||||
Left = 196
|
||||
Top = 164
|
||||
Width = 361
|
||||
Height = 62
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clNavy
|
||||
Font.Height = -12
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 7
|
||||
end
|
||||
object txtitem1: TEdit
|
||||
Left = 364
|
||||
Top = 338
|
||||
Width = 85
|
||||
Height = 21
|
||||
TabOrder = 10
|
||||
end
|
||||
object txtitem2: TEdit
|
||||
Left = 453
|
||||
Top = 338
|
||||
Width = 121
|
||||
Height = 21
|
||||
TabOrder = 11
|
||||
end
|
||||
object txtitem3: TEdit
|
||||
Left = 581
|
||||
Top = 338
|
||||
Width = 121
|
||||
Height = 21
|
||||
TabOrder = 12
|
||||
end
|
||||
object StringGrid1: TStringGrid
|
||||
Left = 194
|
||||
Top = 229
|
||||
Width = 252
|
||||
Height = 77
|
||||
BorderStyle = bsNone
|
||||
Color = clCaptionText
|
||||
ColCount = 1
|
||||
FixedCols = 0
|
||||
RowCount = 1
|
||||
FixedRows = 0
|
||||
Options = []
|
||||
TabOrder = 13
|
||||
end
|
||||
object Memo1: TMemo
|
||||
Left = 200
|
||||
Top = 336
|
||||
Width = 543
|
||||
Height = 108
|
||||
TabOrder = 1
|
||||
end
|
||||
object txtsearch: TEdit
|
||||
Left = 19
|
||||
Top = 25
|
||||
Width = 131
|
||||
Height = 33
|
||||
AutoSize = False
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clMaroon
|
||||
Font.Height = -13
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
end
|
||||
object ToolBar1: TToolBar
|
||||
Left = 448
|
||||
Top = 278
|
||||
Width = 296
|
||||
Height = 45
|
||||
Align = alCustom
|
||||
ButtonHeight = 43
|
||||
ButtonWidth = 30
|
||||
EdgeBorders = []
|
||||
EdgeInner = esNone
|
||||
EdgeOuter = esNone
|
||||
Flat = True
|
||||
Indent = 1
|
||||
TabOrder = 15
|
||||
object btnClear: TBitBtn
|
||||
Left = 1
|
||||
Top = 0
|
||||
Width = 50
|
||||
Height = 43
|
||||
TabOrder = 0
|
||||
OnClick = btnClearClick
|
||||
end
|
||||
object btnSave: TBitBtn
|
||||
Left = 51
|
||||
Top = 0
|
||||
Width = 50
|
||||
Height = 43
|
||||
TabOrder = 1
|
||||
OnClick = btnSaveClick
|
||||
end
|
||||
object btnDelete: TBitBtn
|
||||
Left = 101
|
||||
Top = 0
|
||||
Width = 50
|
||||
Height = 43
|
||||
TabOrder = 2
|
||||
OnClick = btnDeleteClick
|
||||
end
|
||||
object btnPrev: TBitBtn
|
||||
Left = 151
|
||||
Top = 0
|
||||
Width = 50
|
||||
Height = 43
|
||||
TabOrder = 3
|
||||
OnClick = btnPrevClick
|
||||
Layout = blGlyphTop
|
||||
end
|
||||
object pag: TLabel
|
||||
Left = 201
|
||||
Top = 0
|
||||
Width = 44
|
||||
Height = 43
|
||||
Alignment = taCenter
|
||||
AutoSize = False
|
||||
Caption = ' '
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clMaroon
|
||||
Font.Height = -19
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
end
|
||||
object btnNext: TBitBtn
|
||||
Left = 245
|
||||
Top = 0
|
||||
Width = 50
|
||||
Height = 43
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clMaroon
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 4
|
||||
OnClick = btnNextClick
|
||||
Margin = 0
|
||||
end
|
||||
end
|
||||
object btnItems: TBitBtn
|
||||
Left = 420
|
||||
Top = 232
|
||||
Width = 25
|
||||
Height = 21
|
||||
TabOrder = 16
|
||||
OnClick = btnItemsClick
|
||||
end
|
||||
object OpenPictureDialog1: TOpenPictureDialog
|
||||
FileName = 'warley.jpg'
|
||||
Left = 685
|
||||
Top = 228
|
||||
end
|
||||
end
|
@@ -0,0 +1,343 @@
|
||||
unit mormotMongo;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Variants, Controls, Forms, Dialogs,
|
||||
mORMot, mORMotUI, SynCommons, SynMongoDB, jpeg,
|
||||
Grids, Buttons, ToolWin, ExtDlgs, ComCtrls, ExtCtrls, StdCtrls, Classes;
|
||||
|
||||
type
|
||||
TFrmServidor = class(TForm)
|
||||
Memo1: TMemo;
|
||||
txtname: TLabeledEdit;
|
||||
txtgrapes: TLabeledEdit;
|
||||
txtcountry: TLabeledEdit;
|
||||
txtregion: TLabeledEdit;
|
||||
txtyear: TLabeledEdit;
|
||||
txtphoto: TLabeledEdit;
|
||||
Panel1: TPanel;
|
||||
photo: TImage;
|
||||
txtdescription: TMemo;
|
||||
txtID: TLabeledEdit;
|
||||
bmp1: TImage;
|
||||
Label1: TLabel;
|
||||
title: TLabel;
|
||||
txtItems: TLabel;
|
||||
txtitem1: TEdit;
|
||||
txtitem2: TEdit;
|
||||
txtitem3: TEdit;
|
||||
StringGrid1: TStringGrid;
|
||||
OpenPictureDialog1: TOpenPictureDialog;
|
||||
txtsearch: TEdit;
|
||||
Label2: TLabel;
|
||||
status: TLabel;
|
||||
bmp2: TImage;
|
||||
ToolBar1: TToolBar;
|
||||
btnClear: TBitBtn;
|
||||
btnSave: TBitBtn;
|
||||
btnDelete: TBitBtn;
|
||||
btnPrev: TBitBtn;
|
||||
pag: TLabel;
|
||||
btnNext: TBitBtn;
|
||||
L1: TLabel;
|
||||
Label3: TLabel;
|
||||
Label4: TLabel;
|
||||
Label5: TLabel;
|
||||
Label6: TLabel;
|
||||
btnItems: TBitBtn;
|
||||
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure photoClick(Sender: TObject);
|
||||
procedure btnClearClick(Sender: TObject);
|
||||
procedure btnSaveClick(Sender: TObject);
|
||||
procedure btnDeleteClick(Sender: TObject);
|
||||
procedure btnSearchClick(Sender: TObject);
|
||||
procedure btnPrevClick(Sender: TObject);
|
||||
procedure btnNextClick(Sender: TObject);
|
||||
procedure btnItemsClick(Sender: TObject);
|
||||
protected
|
||||
private
|
||||
{ Private declarations }
|
||||
fClient: TMongoClient;
|
||||
fDB: TMongoDatabase;
|
||||
fCollection : TMongoCollection;
|
||||
fGrid: TSQLTableToGrid;
|
||||
procedure InicializaMongo;
|
||||
procedure ShowRecord(b : Variant);
|
||||
procedure OnGridDblClick(Sender: TObject);
|
||||
public
|
||||
{ Public declarations }
|
||||
published
|
||||
end;
|
||||
|
||||
const
|
||||
NoConnectMsg = 'Unable to connect to a MongoDB server running on localhost';
|
||||
|
||||
var
|
||||
FrmServidor: TFrmServidor;
|
||||
page: Integer;
|
||||
str : string;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
uses form2;
|
||||
|
||||
procedure InsertRow(VGrid: TStringGrid);
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
VGrid.RowCount:= VGrid.RowCount + 1;
|
||||
for I:= 0 to VGrid.ColCount - 1 do
|
||||
VGrid.Cells[I, VGrid.RowCount - 1]:= '';
|
||||
VGrid.Row:= VGrid.RowCount - 1;
|
||||
end;
|
||||
|
||||
procedure DeleteRow(ARowIndex: Integer; AGrid: TStringGrid);
|
||||
var
|
||||
i, j: Integer;
|
||||
begin
|
||||
with AGrid do
|
||||
begin
|
||||
if (ARowIndex = RowCount) then
|
||||
RowCount := RowCount - 1
|
||||
else
|
||||
begin
|
||||
for i := ARowIndex to RowCount do
|
||||
for j := 0 to ColCount do
|
||||
Cells[j, i] := Cells[j, i + 1];
|
||||
RowCount := RowCount - 1;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure MoveRowUp(vgrid: TStringGrid; vrow:integer);
|
||||
var
|
||||
s: string;
|
||||
i:integer;
|
||||
begin
|
||||
if vrow=1 then exit;
|
||||
for i:=0 to vgrid.colcount-1 do
|
||||
begin
|
||||
s:=vgrid.cells[i,vrow-1];
|
||||
vgrid.cells[i,vrow-1]:=vgrid.cells[i,vrow];
|
||||
vgrid.cells[i,vrow]:=s;
|
||||
end;
|
||||
vgrid.row:= vrow -1;
|
||||
vgrid.repaint;
|
||||
end;
|
||||
|
||||
procedure MoveRowDown(vgrid: TStringGrid; vrow:integer);
|
||||
var
|
||||
s: string;
|
||||
i:integer;
|
||||
begin
|
||||
if vrow= vgrid.rowcount-1 then exit;
|
||||
for i:=0 to vgrid.colcount-1 do
|
||||
begin
|
||||
s:=vgrid.cells[i,vrow+1];
|
||||
vgrid.cells[i,vrow+1]:=vgrid.cells[i,vrow];
|
||||
vgrid.cells[i,vrow]:=s;
|
||||
end;
|
||||
vgrid.row:=vrow +1;
|
||||
vgrid.repaint;
|
||||
end;
|
||||
|
||||
procedure ClearStringGrid(const Grid: TStringGrid);
|
||||
var
|
||||
c : Integer;
|
||||
begin
|
||||
for c := 0 to Pred(Grid.RowCount-1) do
|
||||
Grid.Cols[c].Clear;
|
||||
Grid.RowCount := 1;
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.FormCreate(Sender: TObject);
|
||||
begin
|
||||
bmp1.Picture.Bitmap.LoadFromResourceName(HInstance, 'BMP1');
|
||||
bmp2.Picture.Bitmap.LoadFromResourceName(HInstance, 'BMP2');
|
||||
btnPrev.Glyph.LoadFromResourceName(HInstance, 'BMP3');
|
||||
btnNext.Glyph.LoadFromResourceName(HInstance, 'BMP4');
|
||||
btnClear.Glyph.LoadFromResourceName(HInstance, 'BMP5');
|
||||
btnDelete.Glyph.LoadFromResourceName(HInstance, 'BMP6');
|
||||
btnSave.Glyph.LoadFromResourceName(HInstance, 'BMP7');
|
||||
btnItems.Glyph.LoadFromResourceName(HInstance, 'BMP8');
|
||||
|
||||
InicializaMongo;
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.photoClick(Sender: TObject);
|
||||
begin
|
||||
OpenPictureDialog1.Execute();
|
||||
photo.Picture.LoadFromFile(ExtractFileName(OpenPictureDialog1.FileName));
|
||||
txtphoto.Text := ExtractFileName(OpenPictureDialog1.FileName);
|
||||
if txtphoto.Text <> '' then btnSave.Enabled := true;
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.btnClearClick(Sender: TObject);
|
||||
begin
|
||||
ClearStringGrid(StringGrid1);
|
||||
txtID .Text := ObjectId();
|
||||
txtname.Text := '';
|
||||
txtyear.Text := '';
|
||||
txtgrapes.Text := '';
|
||||
txtcountry.Text := '';
|
||||
txtregion.Text := '';
|
||||
txtdescription.Lines.Clear;
|
||||
txtphoto.Text := 'warley.jpg';
|
||||
txtItems.Caption := '[{"sku":"","quantity":0,"price":0.0}]';
|
||||
photo.Picture.Assign(nil);
|
||||
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.btnSaveClick(Sender: TObject);
|
||||
var
|
||||
DBObject : variant;
|
||||
begin
|
||||
TDocVariant.New(DBObject);
|
||||
begin
|
||||
DBObject.Clear;
|
||||
DBObject._id := ObjectId(txtID.Text);
|
||||
DBObject.name := txtname.Text;
|
||||
DBObject.year := txtyear.Text;
|
||||
DBObject.grapes := txtgrapes.Text;
|
||||
DBObject.country := txtcountry.Text;
|
||||
DBObject.region := txtregion.Text;
|
||||
DBObject.description := txtdescription.Lines.Text;
|
||||
DBObject.picture := txtphoto.Text;
|
||||
DBObject.items := _JSON(txtItems.Caption);
|
||||
if txtID.Text = '' then DBObject._id := ObjectId() else DBObject._id := ObjectId(txtID.Text);
|
||||
if (MessageDlg('Save this record?', mtWarning, [mbYes, MbNo], 0) = mrYes) then
|
||||
begin
|
||||
fCollection.Save(DBObject);
|
||||
btnPrev.Click;
|
||||
btnDelete.Enabled := true;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.btnDeleteClick(Sender: TObject);
|
||||
begin
|
||||
if txtID.Text <>'' then
|
||||
if MessageDlg('Are you sure delete this record?', mtWarning, [mbYes, MbNo], 0) = mrYes then
|
||||
begin
|
||||
fCollection.RemoveOne(ObjectId(txtID.Text));
|
||||
btnDelete.Enabled := false;
|
||||
btnClear.Click;
|
||||
end;
|
||||
btnPrev.Click; btnDelete.Enabled := true;
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.InicializaMongo;
|
||||
var
|
||||
DBObject : variant;
|
||||
begin
|
||||
fClient := TMongoClient.Create('localhost',27017);
|
||||
fDB := fClient.Database['winedb'];
|
||||
fCollection := fDB.Collection['wines'];
|
||||
if fCollection.Count <> 0 then
|
||||
page := 0;
|
||||
pag.Caption := IntToStr(page);
|
||||
btnSearchClick(self);
|
||||
DBObject := fCollection.FindJSON(null, null);
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.ShowRecord(b : Variant);
|
||||
var
|
||||
fTableJSON : RawUTF8;
|
||||
aTable :TSQLTable;
|
||||
begin
|
||||
txtID.Text := ( b._id );
|
||||
txtname.Text := VariantToUTF8( b.name );
|
||||
txtyear.Text := string(VariantToUTF8(b.year ));
|
||||
txtgrapes.Text := string(VariantToUTF8(b.grapes ));
|
||||
txtcountry.Text := string(VariantToUTF8(b.country ));
|
||||
txtregion.Text := string(VariantToUTF8(b.region ));
|
||||
txtdescription.Text := string( VariantToUTF8(b.description )) ;
|
||||
photo.Picture.LoadFromFile({GetCurrentDir+}'E:\mormot\SQLite3\Samples\projMongo\srv\pics\'+ b.picture );
|
||||
txtphoto.Text := string(VariantToUTF8(b.picture ));
|
||||
if not b.Exists('items')then ClearStringGrid(StringGrid1) else
|
||||
fTableJSON := b.items;
|
||||
StringGrid1.width := 290;
|
||||
txtItems.Caption := fTableJSON;
|
||||
aTable := TSQLTableJSON.Create('',fTableJSON);
|
||||
fGrid := TSQLTableToGrid.Create(StringGrid1, aTable, nil);
|
||||
StringGrid1.Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSelect];
|
||||
// fGrid.SetAlignedByType(sftCurrency,alRight);
|
||||
// fGrid.OnValueText := OnText;
|
||||
fGrid.SetFieldFixedWidth(70);
|
||||
fGrid.FieldTitleTruncatedNotShownAsHint := true;
|
||||
// StringGrid1.Options := StringGrid1.Options-[goRowSelect];
|
||||
StringGrid1.OnDblClick := self.OnGridDblClick;
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.btnPrevClick(Sender: TObject);
|
||||
var DBObject : variant;
|
||||
begin
|
||||
if fCollection.Count = 0 then
|
||||
begin btnClearClick(self);
|
||||
exit;
|
||||
end;
|
||||
dec(page);
|
||||
if page < 0 then page := 0;
|
||||
pag.caption := IntToStr(page+1);
|
||||
str := txtsearch.Text;
|
||||
|
||||
DBObject := fCollection.FindDoc('{name:?}',[BSONVariant('{"$regex": "'+str+'", $options: "i"}')],1,page) ;
|
||||
ShowRecord(DBObject);
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.btnNextClick(Sender: TObject);
|
||||
var DBObject : variant;
|
||||
cnt : integer;
|
||||
begin
|
||||
str := txtsearch.Text;
|
||||
cnt := fCollection.FindCount('{name:?}',[],[BSONVariant('{"$regex": "'+str+'", $options: "i"}')]) ;
|
||||
|
||||
if fCollection.Count = 0 then exit;
|
||||
if page < cnt-1 then inc(page);
|
||||
pag.caption := IntToStr(page+1);
|
||||
|
||||
DBObject := fCollection.FindDoc('{name:?}',[BSONVariant('{"$regex": "'+str+'", $options: "i"}')],1,page) ;
|
||||
ShowRecord(DBObject);
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.OnGridDblClick(Sender: TObject);
|
||||
var
|
||||
doc : Variant;
|
||||
i : integer;
|
||||
s : string;
|
||||
csv : TStringList;
|
||||
begin
|
||||
csv:= TStringList.create;
|
||||
s:= ',';
|
||||
for i := 1 to StringGrid1.RowCount-1 do begin
|
||||
fGrid.Table.ToDocVariant(i,doc);
|
||||
csv.add (doc);
|
||||
end;
|
||||
ShowMessage(csv.GetText);
|
||||
//txtItem1.Text := fGrid.Table.GetU(StringGrid1.Row,0);
|
||||
//txtItem2.Text := fGrid.Table.GetU(StringGrid1.Row,1);
|
||||
//txtItem3.Text := fGrid.Table.GetU(StringGrid1.Row,2);
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.btnSearchClick(Sender: TObject);
|
||||
var
|
||||
cnt : integer;
|
||||
begin
|
||||
str := txtsearch.Text;
|
||||
cnt := fCollection.FindCount('{name:?}',[],[BSONVariant('{"$regex": "'+str+'", $options: "i"}')]) ;
|
||||
page := 0;
|
||||
pag.Caption := '0';
|
||||
status.Caption := 'Found: '+ IntToStr(cnt) + ' docs';
|
||||
if cnt <> 0 then btnPrev.Click;
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.btnItemsClick(Sender: TObject);
|
||||
begin
|
||||
Items.show;;
|
||||
end;
|
||||
|
||||
end.
|
@@ -0,0 +1,19 @@
|
||||
Wine Cellar Application
|
||||
=======================
|
||||
|
||||
powered by Delphi mORMot and MongoDB
|
||||
------------------------------------
|
||||
|
||||
*by warleyalex*
|
||||
|
||||
Bye, bye Chile. After a tense match, Brazil breathes giant siggt of relief, defeats Chile on penaults.
|
||||
If you don't know Chile is fortunate to have climate conditions that are ideal for good wine grapes.
|
||||
|
||||
Guess what? I've created an Wine Cellar application powered by Delphi *mORMot* and *MongoDB*.
|
||||
http://mormot.net
|
||||
http://mongodb.org
|
||||
|
||||
You can take a look at the introduction video:
|
||||
http://youtu.be/qiFq7-Kp6X8
|
||||
|
||||
http://synopse.info/forum/viewtopic.php?pid=11293#p11293
|
@@ -0,0 +1,15 @@
|
||||
program mongoproj;
|
||||
|
||||
uses
|
||||
Forms,
|
||||
mormotMongo in 'mormotMongo.pas'{FrmServidor},
|
||||
Form2 in 'Form2.pas';
|
||||
|
||||
{$R *.res}
|
||||
{$R 'btn.res'}
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TFrmServidor, FrmServidor);
|
||||
Application.CreateForm(TItems, Items);
|
||||
Application.Run;
|
||||
end.
|
@@ -0,0 +1,402 @@
|
||||
object FrmServidor: TFrmServidor
|
||||
Left = 93
|
||||
Top = 85
|
||||
Width = 801
|
||||
Height = 598
|
||||
Caption = 'mORMot + MongoDB'
|
||||
Color = clCaptionText
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
OldCreateOrder = False
|
||||
OnCreate = FormCreate
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object Label1: TLabel
|
||||
Left = 0
|
||||
Top = 536
|
||||
Width = 793
|
||||
Height = 35
|
||||
Align = alBottom
|
||||
Alignment = taCenter
|
||||
Color = clBtnHighlight
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clRed
|
||||
Font.Height = -29
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = [fsBold]
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object bmp1: TImage
|
||||
Left = 6
|
||||
Top = 8
|
||||
Width = 781
|
||||
Height = 526
|
||||
Stretch = True
|
||||
end
|
||||
object title: TLabel
|
||||
Left = 228
|
||||
Top = 11
|
||||
Width = 503
|
||||
Height = 52
|
||||
Caption = 'mORMot WINE CELLAR'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clMaroon
|
||||
Font.Height = -43
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
end
|
||||
object txtItems: TLabel
|
||||
Left = 207
|
||||
Top = 456
|
||||
Width = 3
|
||||
Height = 13
|
||||
Visible = False
|
||||
end
|
||||
object Label2: TLabel
|
||||
Left = 452
|
||||
Top = 306
|
||||
Width = 31
|
||||
Height = 13
|
||||
Caption = 'Label2'
|
||||
end
|
||||
object status: TLabel
|
||||
Left = 23
|
||||
Top = 62
|
||||
Width = 3
|
||||
Height = 13
|
||||
end
|
||||
object bmp2: TImage
|
||||
Left = 151
|
||||
Top = 25
|
||||
Width = 32
|
||||
Height = 32
|
||||
AutoSize = True
|
||||
OnClick = btnSearchClick
|
||||
end
|
||||
object L1: TLabel
|
||||
Left = 461
|
||||
Top = 323
|
||||
Width = 23
|
||||
Height = 13
|
||||
Caption = 'NEW'
|
||||
end
|
||||
object Label3: TLabel
|
||||
Left = 510
|
||||
Top = 323
|
||||
Width = 25
|
||||
Height = 13
|
||||
Caption = 'SAVE'
|
||||
end
|
||||
object Label4: TLabel
|
||||
Left = 556
|
||||
Top = 321
|
||||
Width = 36
|
||||
Height = 13
|
||||
Caption = 'DELETE'
|
||||
end
|
||||
object Label5: TLabel
|
||||
Left = 609
|
||||
Top = 322
|
||||
Width = 25
|
||||
Height = 13
|
||||
Caption = 'PREV'
|
||||
end
|
||||
object Label6: TLabel
|
||||
Left = 706
|
||||
Top = 322
|
||||
Width = 25
|
||||
Height = 13
|
||||
Caption = 'NEXT'
|
||||
end
|
||||
object Panel1: TPanel
|
||||
Left = 580
|
||||
Top = 81
|
||||
Width = 169
|
||||
Height = 155
|
||||
BevelInner = bvSpace
|
||||
BevelOuter = bvLowered
|
||||
TabOrder = 14
|
||||
object photo: TImage
|
||||
Left = 2
|
||||
Top = 2
|
||||
Width = 165
|
||||
Height = 151
|
||||
Align = alTop
|
||||
Stretch = True
|
||||
OnClick = photoClick
|
||||
end
|
||||
end
|
||||
object txtID: TLabeledEdit
|
||||
Left = 196
|
||||
Top = 46
|
||||
Width = 183
|
||||
Height = 24
|
||||
EditLabel.Width = 11
|
||||
EditLabel.Height = 13
|
||||
EditLabel.Caption = 'ID'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clNavy
|
||||
Font.Height = -13
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
TabOrder = 8
|
||||
Visible = False
|
||||
end
|
||||
object txtname: TLabeledEdit
|
||||
Left = 196
|
||||
Top = 86
|
||||
Width = 266
|
||||
Height = 22
|
||||
EditLabel.Width = 27
|
||||
EditLabel.Height = 13
|
||||
EditLabel.Caption = 'Name'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clMaroon
|
||||
Font.Height = -12
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
TabOrder = 2
|
||||
end
|
||||
object txtgrapes: TLabeledEdit
|
||||
Left = 196
|
||||
Top = 124
|
||||
Width = 132
|
||||
Height = 22
|
||||
EditLabel.Width = 34
|
||||
EditLabel.Height = 13
|
||||
EditLabel.Caption = 'Grapes'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clNavy
|
||||
Font.Height = -12
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 4
|
||||
end
|
||||
object txtcountry: TLabeledEdit
|
||||
Left = 330
|
||||
Top = 124
|
||||
Width = 114
|
||||
Height = 22
|
||||
EditLabel.Width = 39
|
||||
EditLabel.Height = 13
|
||||
EditLabel.Caption = 'Country'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clNavy
|
||||
Font.Height = -12
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 5
|
||||
end
|
||||
object txtregion: TLabeledEdit
|
||||
Left = 450
|
||||
Top = 125
|
||||
Width = 106
|
||||
Height = 22
|
||||
EditLabel.Width = 33
|
||||
EditLabel.Height = 13
|
||||
EditLabel.Caption = 'Region'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clNavy
|
||||
Font.Height = -12
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 6
|
||||
end
|
||||
object txtyear: TLabeledEdit
|
||||
Left = 468
|
||||
Top = 85
|
||||
Width = 87
|
||||
Height = 22
|
||||
EditLabel.Width = 22
|
||||
EditLabel.Height = 13
|
||||
EditLabel.Caption = 'Year'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clNavy
|
||||
Font.Height = -12
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 3
|
||||
end
|
||||
object txtphoto: TLabeledEdit
|
||||
Left = 580
|
||||
Top = 251
|
||||
Width = 169
|
||||
Height = 21
|
||||
EditLabel.Width = 28
|
||||
EditLabel.Height = 13
|
||||
EditLabel.Caption = 'Photo'
|
||||
TabOrder = 9
|
||||
Visible = False
|
||||
end
|
||||
object txtdescription: TMemo
|
||||
Left = 196
|
||||
Top = 164
|
||||
Width = 361
|
||||
Height = 62
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clNavy
|
||||
Font.Height = -12
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 7
|
||||
end
|
||||
object txtitem1: TEdit
|
||||
Left = 364
|
||||
Top = 338
|
||||
Width = 85
|
||||
Height = 21
|
||||
TabOrder = 10
|
||||
end
|
||||
object txtitem2: TEdit
|
||||
Left = 453
|
||||
Top = 338
|
||||
Width = 121
|
||||
Height = 21
|
||||
TabOrder = 11
|
||||
end
|
||||
object txtitem3: TEdit
|
||||
Left = 581
|
||||
Top = 338
|
||||
Width = 121
|
||||
Height = 21
|
||||
TabOrder = 12
|
||||
end
|
||||
object StringGrid1: TStringGrid
|
||||
Left = 194
|
||||
Top = 229
|
||||
Width = 252
|
||||
Height = 77
|
||||
BorderStyle = bsNone
|
||||
Color = clCaptionText
|
||||
ColCount = 1
|
||||
FixedCols = 0
|
||||
RowCount = 1
|
||||
FixedRows = 0
|
||||
Options = []
|
||||
TabOrder = 13
|
||||
end
|
||||
object Memo1: TMemo
|
||||
Left = 200
|
||||
Top = 336
|
||||
Width = 543
|
||||
Height = 108
|
||||
TabOrder = 1
|
||||
end
|
||||
object txtsearch: TEdit
|
||||
Left = 19
|
||||
Top = 25
|
||||
Width = 131
|
||||
Height = 33
|
||||
AutoSize = False
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clMaroon
|
||||
Font.Height = -13
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
end
|
||||
object ToolBar1: TToolBar
|
||||
Left = 448
|
||||
Top = 278
|
||||
Width = 296
|
||||
Height = 45
|
||||
Align = alCustom
|
||||
ButtonHeight = 43
|
||||
ButtonWidth = 30
|
||||
EdgeBorders = []
|
||||
EdgeInner = esNone
|
||||
EdgeOuter = esNone
|
||||
Flat = True
|
||||
Indent = 1
|
||||
TabOrder = 15
|
||||
object btnClear: TBitBtn
|
||||
Left = 1
|
||||
Top = 0
|
||||
Width = 50
|
||||
Height = 43
|
||||
TabOrder = 0
|
||||
OnClick = btnClearClick
|
||||
end
|
||||
object btnSave: TBitBtn
|
||||
Left = 51
|
||||
Top = 0
|
||||
Width = 50
|
||||
Height = 43
|
||||
TabOrder = 1
|
||||
OnClick = btnSaveClick
|
||||
end
|
||||
object btnDelete: TBitBtn
|
||||
Left = 101
|
||||
Top = 0
|
||||
Width = 50
|
||||
Height = 43
|
||||
TabOrder = 2
|
||||
OnClick = btnDeleteClick
|
||||
end
|
||||
object btnPrev: TBitBtn
|
||||
Left = 151
|
||||
Top = 0
|
||||
Width = 50
|
||||
Height = 43
|
||||
TabOrder = 3
|
||||
OnClick = btnPrevClick
|
||||
Layout = blGlyphTop
|
||||
end
|
||||
object pag: TLabel
|
||||
Left = 201
|
||||
Top = 0
|
||||
Width = 44
|
||||
Height = 43
|
||||
Alignment = taCenter
|
||||
AutoSize = False
|
||||
Caption = ' '
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clMaroon
|
||||
Font.Height = -19
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = [fsBold]
|
||||
ParentFont = False
|
||||
end
|
||||
object btnNext: TBitBtn
|
||||
Left = 245
|
||||
Top = 0
|
||||
Width = 50
|
||||
Height = 43
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clMaroon
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 4
|
||||
OnClick = btnNextClick
|
||||
Margin = 0
|
||||
end
|
||||
end
|
||||
object btnItems: TBitBtn
|
||||
Left = 420
|
||||
Top = 232
|
||||
Width = 25
|
||||
Height = 21
|
||||
TabOrder = 16
|
||||
OnClick = btnItemsClick
|
||||
end
|
||||
object OpenPictureDialog1: TOpenPictureDialog
|
||||
FileName = 'warley.jpg'
|
||||
Left = 685
|
||||
Top = 228
|
||||
end
|
||||
end
|
@@ -0,0 +1,343 @@
|
||||
unit mormotMongo;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Variants, Controls, Forms, Dialogs,
|
||||
mORMot, mORMotUI, SynCommons, SynMongoDB, jpeg,
|
||||
Grids, Buttons, ToolWin, ExtDlgs, ComCtrls, ExtCtrls, StdCtrls, Classes;
|
||||
|
||||
type
|
||||
TFrmServidor = class(TForm)
|
||||
Memo1: TMemo;
|
||||
txtname: TLabeledEdit;
|
||||
txtgrapes: TLabeledEdit;
|
||||
txtcountry: TLabeledEdit;
|
||||
txtregion: TLabeledEdit;
|
||||
txtyear: TLabeledEdit;
|
||||
txtphoto: TLabeledEdit;
|
||||
Panel1: TPanel;
|
||||
photo: TImage;
|
||||
txtdescription: TMemo;
|
||||
txtID: TLabeledEdit;
|
||||
bmp1: TImage;
|
||||
Label1: TLabel;
|
||||
title: TLabel;
|
||||
txtItems: TLabel;
|
||||
txtitem1: TEdit;
|
||||
txtitem2: TEdit;
|
||||
txtitem3: TEdit;
|
||||
StringGrid1: TStringGrid;
|
||||
OpenPictureDialog1: TOpenPictureDialog;
|
||||
txtsearch: TEdit;
|
||||
Label2: TLabel;
|
||||
status: TLabel;
|
||||
bmp2: TImage;
|
||||
ToolBar1: TToolBar;
|
||||
btnClear: TBitBtn;
|
||||
btnSave: TBitBtn;
|
||||
btnDelete: TBitBtn;
|
||||
btnPrev: TBitBtn;
|
||||
pag: TLabel;
|
||||
btnNext: TBitBtn;
|
||||
L1: TLabel;
|
||||
Label3: TLabel;
|
||||
Label4: TLabel;
|
||||
Label5: TLabel;
|
||||
Label6: TLabel;
|
||||
btnItems: TBitBtn;
|
||||
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure photoClick(Sender: TObject);
|
||||
procedure btnClearClick(Sender: TObject);
|
||||
procedure btnSaveClick(Sender: TObject);
|
||||
procedure btnDeleteClick(Sender: TObject);
|
||||
procedure btnSearchClick(Sender: TObject);
|
||||
procedure btnPrevClick(Sender: TObject);
|
||||
procedure btnNextClick(Sender: TObject);
|
||||
procedure btnItemsClick(Sender: TObject);
|
||||
protected
|
||||
private
|
||||
{ Private declarations }
|
||||
fClient: TMongoClient;
|
||||
fDB: TMongoDatabase;
|
||||
fCollection : TMongoCollection;
|
||||
fGrid: TSQLTableToGrid;
|
||||
procedure InicializaMongo;
|
||||
procedure ShowRecord(b : Variant);
|
||||
procedure OnGridDblClick(Sender: TObject);
|
||||
public
|
||||
{ Public declarations }
|
||||
published
|
||||
end;
|
||||
|
||||
const
|
||||
NoConnectMsg = 'Unable to connect to a MongoDB server running on localhost';
|
||||
|
||||
var
|
||||
FrmServidor: TFrmServidor;
|
||||
page: Integer;
|
||||
str : string;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
uses form2;
|
||||
|
||||
procedure InsertRow(VGrid: TStringGrid);
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
VGrid.RowCount:= VGrid.RowCount + 1;
|
||||
for I:= 0 to VGrid.ColCount - 1 do
|
||||
VGrid.Cells[I, VGrid.RowCount - 1]:= '';
|
||||
VGrid.Row:= VGrid.RowCount - 1;
|
||||
end;
|
||||
|
||||
procedure DeleteRow(ARowIndex: Integer; AGrid: TStringGrid);
|
||||
var
|
||||
i, j: Integer;
|
||||
begin
|
||||
with AGrid do
|
||||
begin
|
||||
if (ARowIndex = RowCount) then
|
||||
RowCount := RowCount - 1
|
||||
else
|
||||
begin
|
||||
for i := ARowIndex to RowCount do
|
||||
for j := 0 to ColCount do
|
||||
Cells[j, i] := Cells[j, i + 1];
|
||||
RowCount := RowCount - 1;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure MoveRowUp(vgrid: TStringGrid; vrow:integer);
|
||||
var
|
||||
s: string;
|
||||
i:integer;
|
||||
begin
|
||||
if vrow=1 then exit;
|
||||
for i:=0 to vgrid.colcount-1 do
|
||||
begin
|
||||
s:=vgrid.cells[i,vrow-1];
|
||||
vgrid.cells[i,vrow-1]:=vgrid.cells[i,vrow];
|
||||
vgrid.cells[i,vrow]:=s;
|
||||
end;
|
||||
vgrid.row:= vrow -1;
|
||||
vgrid.repaint;
|
||||
end;
|
||||
|
||||
procedure MoveRowDown(vgrid: TStringGrid; vrow:integer);
|
||||
var
|
||||
s: string;
|
||||
i:integer;
|
||||
begin
|
||||
if vrow= vgrid.rowcount-1 then exit;
|
||||
for i:=0 to vgrid.colcount-1 do
|
||||
begin
|
||||
s:=vgrid.cells[i,vrow+1];
|
||||
vgrid.cells[i,vrow+1]:=vgrid.cells[i,vrow];
|
||||
vgrid.cells[i,vrow]:=s;
|
||||
end;
|
||||
vgrid.row:=vrow +1;
|
||||
vgrid.repaint;
|
||||
end;
|
||||
|
||||
procedure ClearStringGrid(const Grid: TStringGrid);
|
||||
var
|
||||
c : Integer;
|
||||
begin
|
||||
for c := 0 to Pred(Grid.RowCount-1) do
|
||||
Grid.Cols[c].Clear;
|
||||
Grid.RowCount := 1;
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.FormCreate(Sender: TObject);
|
||||
begin
|
||||
bmp1.Picture.Bitmap.LoadFromResourceName(HInstance, 'BMP1');
|
||||
bmp2.Picture.Bitmap.LoadFromResourceName(HInstance, 'BMP2');
|
||||
btnPrev.Glyph.LoadFromResourceName(HInstance, 'BMP3');
|
||||
btnNext.Glyph.LoadFromResourceName(HInstance, 'BMP4');
|
||||
btnClear.Glyph.LoadFromResourceName(HInstance, 'BMP5');
|
||||
btnDelete.Glyph.LoadFromResourceName(HInstance, 'BMP6');
|
||||
btnSave.Glyph.LoadFromResourceName(HInstance, 'BMP7');
|
||||
btnItems.Glyph.LoadFromResourceName(HInstance, 'BMP8');
|
||||
|
||||
InicializaMongo;
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.photoClick(Sender: TObject);
|
||||
begin
|
||||
OpenPictureDialog1.Execute();
|
||||
photo.Picture.LoadFromFile(ExtractFileName(OpenPictureDialog1.FileName));
|
||||
txtphoto.Text := ExtractFileName(OpenPictureDialog1.FileName);
|
||||
if txtphoto.Text <> '' then btnSave.Enabled := true;
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.btnClearClick(Sender: TObject);
|
||||
begin
|
||||
ClearStringGrid(StringGrid1);
|
||||
txtID .Text := ObjectId();
|
||||
txtname.Text := '';
|
||||
txtyear.Text := '';
|
||||
txtgrapes.Text := '';
|
||||
txtcountry.Text := '';
|
||||
txtregion.Text := '';
|
||||
txtdescription.Lines.Clear;
|
||||
txtphoto.Text := 'warley.jpg';
|
||||
txtItems.Caption := '[{"sku":"","quantity":0,"price":0.0}]';
|
||||
photo.Picture.Assign(nil);
|
||||
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.btnSaveClick(Sender: TObject);
|
||||
var
|
||||
DBObject : variant;
|
||||
begin
|
||||
TDocVariant.New(DBObject);
|
||||
begin
|
||||
DBObject.Clear;
|
||||
DBObject._id := ObjectId(txtID.Text);
|
||||
DBObject.name := txtname.Text;
|
||||
DBObject.year := txtyear.Text;
|
||||
DBObject.grapes := txtgrapes.Text;
|
||||
DBObject.country := txtcountry.Text;
|
||||
DBObject.region := txtregion.Text;
|
||||
DBObject.description := txtdescription.Lines.Text;
|
||||
DBObject.picture := txtphoto.Text;
|
||||
DBObject.items := _JSON(txtItems.Caption);
|
||||
if txtID.Text = '' then DBObject._id := ObjectId() else DBObject._id := ObjectId(txtID.Text);
|
||||
if (MessageDlg('Save this record?', mtWarning, [mbYes, MbNo], 0) = mrYes) then
|
||||
begin
|
||||
fCollection.Save(DBObject);
|
||||
btnPrev.Click;
|
||||
btnDelete.Enabled := true;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.btnDeleteClick(Sender: TObject);
|
||||
begin
|
||||
if txtID.Text <>'' then
|
||||
if MessageDlg('Are you sure delete this record?', mtWarning, [mbYes, MbNo], 0) = mrYes then
|
||||
begin
|
||||
fCollection.RemoveOne(ObjectId(txtID.Text));
|
||||
btnDelete.Enabled := false;
|
||||
btnClear.Click;
|
||||
end;
|
||||
btnPrev.Click; btnDelete.Enabled := true;
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.InicializaMongo;
|
||||
var
|
||||
DBObject : variant;
|
||||
begin
|
||||
fClient := TMongoClient.Create('localhost',27017);
|
||||
fDB := fClient.Database['winedb'];
|
||||
fCollection := fDB.Collection['wines'];
|
||||
if fCollection.Count <> 0 then
|
||||
page := 0;
|
||||
pag.Caption := IntToStr(page);
|
||||
btnSearchClick(self);
|
||||
DBObject := fCollection.FindJSON(null, null);
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.ShowRecord(b : Variant);
|
||||
var
|
||||
fTableJSON : RawUTF8;
|
||||
aTable :TSQLTable;
|
||||
begin
|
||||
txtID.Text := ( b._id );
|
||||
txtname.Text := VariantToUTF8( b.name );
|
||||
txtyear.Text := string(VariantToUTF8(b.year ));
|
||||
txtgrapes.Text := string(VariantToUTF8(b.grapes ));
|
||||
txtcountry.Text := string(VariantToUTF8(b.country ));
|
||||
txtregion.Text := string(VariantToUTF8(b.region ));
|
||||
txtdescription.Text := string( VariantToUTF8(b.description )) ;
|
||||
photo.Picture.LoadFromFile({GetCurrentDir+}'E:\mormot\SQLite3\Samples\projMongo\srv\pics\'+ b.picture );
|
||||
txtphoto.Text := string(VariantToUTF8(b.picture ));
|
||||
if not b.Exists('items')then ClearStringGrid(StringGrid1) else
|
||||
fTableJSON := b.items;
|
||||
StringGrid1.width := 290;
|
||||
txtItems.Caption := fTableJSON;
|
||||
aTable := TSQLTableJSON.Create('',fTableJSON);
|
||||
fGrid := TSQLTableToGrid.Create(StringGrid1, aTable, nil);
|
||||
StringGrid1.Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSelect];
|
||||
// fGrid.SetAlignedByType(sftCurrency,alRight);
|
||||
// fGrid.OnValueText := OnText;
|
||||
fGrid.SetFieldFixedWidth(70);
|
||||
fGrid.FieldTitleTruncatedNotShownAsHint := true;
|
||||
// StringGrid1.Options := StringGrid1.Options-[goRowSelect];
|
||||
StringGrid1.OnDblClick := self.OnGridDblClick;
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.btnPrevClick(Sender: TObject);
|
||||
var DBObject : variant;
|
||||
begin
|
||||
if fCollection.Count = 0 then
|
||||
begin btnClearClick(self);
|
||||
exit;
|
||||
end;
|
||||
dec(page);
|
||||
if page < 0 then page := 0;
|
||||
pag.caption := IntToStr(page+1);
|
||||
str := txtsearch.Text;
|
||||
|
||||
DBObject := fCollection.FindDoc('{name:?}',[BSONVariant('{"$regex": "'+str+'", $options: "i"}')],1,page) ;
|
||||
ShowRecord(DBObject);
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.btnNextClick(Sender: TObject);
|
||||
var DBObject : variant;
|
||||
cnt : integer;
|
||||
begin
|
||||
str := txtsearch.Text;
|
||||
cnt := fCollection.FindCount('{name:?}',[],[BSONVariant('{"$regex": "'+str+'", $options: "i"}')]) ;
|
||||
|
||||
if fCollection.Count = 0 then exit;
|
||||
if page < cnt-1 then inc(page);
|
||||
pag.caption := IntToStr(page+1);
|
||||
|
||||
DBObject := fCollection.FindDoc('{name:?}',[BSONVariant('{"$regex": "'+str+'", $options: "i"}')],1,page) ;
|
||||
ShowRecord(DBObject);
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.OnGridDblClick(Sender: TObject);
|
||||
var
|
||||
doc : Variant;
|
||||
i : integer;
|
||||
s : string;
|
||||
csv : TStringList;
|
||||
begin
|
||||
csv:= TStringList.create;
|
||||
s:= ',';
|
||||
for i := 1 to StringGrid1.RowCount-1 do begin
|
||||
fGrid.Table.ToDocVariant(i,doc);
|
||||
csv.add (doc);
|
||||
end;
|
||||
ShowMessage(csv.GetText);
|
||||
//txtItem1.Text := fGrid.Table.GetU(StringGrid1.Row,0);
|
||||
//txtItem2.Text := fGrid.Table.GetU(StringGrid1.Row,1);
|
||||
//txtItem3.Text := fGrid.Table.GetU(StringGrid1.Row,2);
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.btnSearchClick(Sender: TObject);
|
||||
var
|
||||
cnt : integer;
|
||||
begin
|
||||
str := txtsearch.Text;
|
||||
cnt := fCollection.FindCount('{name:?}',[],[BSONVariant('{"$regex": "'+str+'", $options: "i"}')]) ;
|
||||
page := 0;
|
||||
pag.Caption := '0';
|
||||
status.Caption := 'Found: '+ IntToStr(cnt) + ' docs';
|
||||
if cnt <> 0 then btnPrev.Click;
|
||||
end;
|
||||
|
||||
procedure TFrmServidor.btnItemsClick(Sender: TObject);
|
||||
begin
|
||||
Items.show;;
|
||||
end;
|
||||
|
||||
end.
|
After Width: | Height: | Size: 5.4 KiB |
After Width: | Height: | Size: 6.4 KiB |
After Width: | Height: | Size: 4.9 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 5.1 KiB |
After Width: | Height: | Size: 9.7 KiB |
After Width: | Height: | Size: 6.1 KiB |
After Width: | Height: | Size: 7.3 KiB |
After Width: | Height: | Size: 8.6 KiB |
After Width: | Height: | Size: 5.2 KiB |
After Width: | Height: | Size: 6.5 KiB |
After Width: | Height: | Size: 3.4 KiB |
After Width: | Height: | Size: 6.1 KiB |
After Width: | Height: | Size: 4.3 KiB |
After Width: | Height: | Size: 4.3 KiB |
After Width: | Height: | Size: 5.9 KiB |
After Width: | Height: | Size: 6.3 KiB |
After Width: | Height: | Size: 6.2 KiB |
After Width: | Height: | Size: 6.7 KiB |
After Width: | Height: | Size: 6.9 KiB |
After Width: | Height: | Size: 5.5 KiB |
After Width: | Height: | Size: 4.4 KiB |
After Width: | Height: | Size: 4.4 KiB |
After Width: | Height: | Size: 6.7 KiB |
After Width: | Height: | Size: 6.3 KiB |
After Width: | Height: | Size: 9.6 KiB |
After Width: | Height: | Size: 5.6 KiB |