source upload

This commit is contained in:
Razor12911
2022-01-17 22:16:47 +02:00
parent 12936d065b
commit 098e8c48de
1778 changed files with 1206749 additions and 0 deletions

View File

@@ -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}]}

View File

@@ -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

View File

@@ -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.

View File

@@ -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

View File

@@ -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.

View File

@@ -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

View File

@@ -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.

View File

@@ -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

View File

@@ -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.

Binary file not shown.

After

Width:  |  Height:  |  Size: 5.4 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 6.4 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.9 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 5.1 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 9.7 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 6.1 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 7.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 8.6 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 5.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 6.5 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.4 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 6.1 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 5.9 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 6.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 6.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 6.7 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 6.9 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 5.5 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.4 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.4 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 6.7 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 6.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 9.6 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 5.6 KiB