RxFPC:add filter demo for TRxMemoryData

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5133 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alexs75 2016-09-07 11:15:26 +00:00
parent 5920c0bc2f
commit 731550aa8f
7 changed files with 494 additions and 0 deletions

Binary file not shown.

After

Width:  |  Height:  |  Size: 134 KiB

View File

@ -0,0 +1,85 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="project1"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="FCL"/>
</Item1>
<Item2>
<PackageName Value="rxnew"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="4">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
<Item4>
<Name Value="EDatabaseError"/>
</Item4>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,21 @@
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, rxnew, Unit1
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

View File

@ -0,0 +1,64 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<Version Value="9"/>
<BuildModes Active="Default"/>
<Units Count="2">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="20"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<IsVisibleTab Value="True"/>
<TopLine Value="11"/>
<CursorPos X="8" Y="53"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
</Units>
<JumpHistory Count="8" HistoryIndex="7">
<Position1>
<Filename Value="unit1.pas"/>
</Position1>
<Position2>
<Filename Value="unit1.pas"/>
<Caret Line="2"/>
</Position2>
<Position3>
<Filename Value="unit1.pas"/>
<Caret Line="54" Column="24" TopLine="25"/>
</Position3>
<Position4>
<Filename Value="unit1.pas"/>
<Caret Line="51" Column="31" TopLine="32"/>
</Position4>
<Position5>
<Filename Value="unit1.pas"/>
<Caret Line="58" Column="17" TopLine="39"/>
</Position5>
<Position6>
<Filename Value="unit1.pas"/>
<Caret Line="59" Column="17" TopLine="40"/>
</Position6>
<Position7>
<Filename Value="unit1.pas"/>
<Caret Line="68" Column="3" TopLine="47"/>
</Position7>
<Position8>
<Filename Value="unit1.pas"/>
<Caret Line="69" Column="3" TopLine="48"/>
</Position8>
</JumpHistory>
</ProjectSession>
</CONFIG>

Binary file not shown.

View File

@ -0,0 +1,246 @@
object Form1: TForm1
Left = 455
Height = 746
Top = 191
Width = 1039
Caption = 'Form1'
ClientHeight = 746
ClientWidth = 1039
OnCreate = FormCreate
Position = poScreenCenter
SessionProperties = 'Edit1.Text'
LCLVersion = '1.7'
object CheckBox1: TCheckBox
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
Left = 6
Height = 24
Top = 6
Width = 99
BorderSpacing.Around = 6
Caption = 'CheckBox1'
OnChange = CheckBox1Change
TabOrder = 0
end
object Edit1: TEdit
AnchorSideLeft.Control = Label1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = CheckBox1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 119
Height = 37
Top = 36
Width = 914
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6
TabOrder = 1
Text = 'Edit1'
end
object Label1: TLabel
AnchorSideLeft.Control = CheckBox1
AnchorSideBottom.Control = Edit1
AnchorSideBottom.Side = asrBottom
Left = 6
Height = 20
Top = 53
Width = 107
Anchors = [akLeft, akBottom]
Caption = 'Filter expression'
ParentColor = False
end
object RxDBGrid1: TRxDBGrid
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Edit1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Memo1
Left = 0
Height = 521
Top = 79
Width = 1039
ColumnDefValues.BlobText = '(данные)'
TitleButtons = False
AutoSort = True
Columns = <
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'ID'
Width = 90
FieldName = 'ID'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Нет)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
end
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'NAME'
Width = 500
FieldName = 'NAME'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Нет)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
end
item
Title.Alignment = taCenter
Title.Orientation = toHorizontal
Title.Caption = 'CODE'
Width = 100
FieldName = 'CODE'
EditButtons = <>
Filter.DropDownRows = 0
Filter.EmptyValue = '(Нет)'
Filter.EmptyFont.Style = [fsItalic]
Filter.ItemIndex = -1
Footers = <>
end>
KeyStrokes = <
item
Command = rxgcShowFindDlg
ShortCut = 16454
Enabled = True
end
item
Command = rxgcShowColumnsDlg
ShortCut = 16471
Enabled = True
end
item
Command = rxgcShowFilterDlg
ShortCut = 16468
Enabled = True
end
item
Command = rxgcShowSortDlg
ShortCut = 16467
Enabled = True
end
item
Command = rxgcShowQuickFilter
ShortCut = 16465
Enabled = True
end
item
Command = rxgcHideQuickFilter
ShortCut = 16456
Enabled = True
end
item
Command = rxgcSelectAll
ShortCut = 16449
Enabled = True
end
item
Command = rxgcDeSelectAll
ShortCut = 16429
Enabled = True
end
item
Command = rxgcInvertSelection
ShortCut = 16426
Enabled = True
end
item
Command = rxgcOptimizeColumnsWidth
ShortCut = 16427
Enabled = True
end
item
Command = rxgcCopyCellValue
ShortCut = 16451
Enabled = True
end>
FooterOptions.DrawFullLine = False
OptionsRx = [rdgAllowColumnsForm, rdgAllowDialogFind, rdgAllowQuickFilter]
Anchors = [akTop, akLeft, akRight, akBottom]
Color = clWindow
DrawFullLine = False
FocusColor = clRed
SelectedColor = clHighlight
GridLineStyle = psSolid
DataSource = DataSource1
Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColumnMove, dgColLines, dgRowLines, dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit]
ParentColor = False
TabOrder = 2
end
object Memo1: TMemo
Left = 0
Height = 146
Top = 600
Width = 1039
Align = alBottom
Lines.Strings = (
'Memo1'
)
ReadOnly = True
TabOrder = 3
end
object RxMemoryData1: TRxMemoryData
FieldDefs = <
item
Name = 'ID'
DataType = ftInteger
end
item
Name = 'NAME'
DataType = ftString
Size = 100
end
item
Name = 'CODE'
DataType = ftInteger
end>
PacketRecords = 0
left = 328
top = 270
object RxMemoryData1ID: TLongintField
FieldKind = fkData
FieldName = 'ID'
Index = 0
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
object RxMemoryData1NAME: TStringField
FieldKind = fkData
FieldName = 'NAME'
Index = 1
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
Size = 100
end
object RxMemoryData1CODE: TLongintField
FieldKind = fkData
FieldName = 'CODE'
Index = 2
LookupCache = False
ProviderFlags = [pfInUpdate, pfInWhere]
ReadOnly = False
Required = False
end
end
object DataSource1: TDataSource
DataSet = RxMemoryData1
left = 288
top = 272
end
object RxIniPropStorage1: TRxIniPropStorage
StoredValues = <>
SeparateFiles = True
left = 471
top = 27
end
end

View File

@ -0,0 +1,78 @@
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, rxdbgrid, rxmemds, RxIniPropStorage, Forms,
Controls, Graphics, Dialogs, StdCtrls, db;
type
{ TForm1 }
TForm1 = class(TForm)
CheckBox1: TCheckBox;
DataSource1: TDataSource;
Edit1: TEdit;
Label1: TLabel;
Memo1: TMemo;
RxDBGrid1: TRxDBGrid;
RxIniPropStorage1: TRxIniPropStorage;
RxMemoryData1: TRxMemoryData;
RxMemoryData1CODE: TLongintField;
RxMemoryData1ID: TLongintField;
RxMemoryData1NAME: TStringField;
procedure CheckBox1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
RxMemoryData1.Open;
for i:=1 to 20 do
begin
RxMemoryData1.Append;
RxMemoryData1ID.AsInteger:=i;
RxMemoryData1NAME.AsString:='Line '+IntToStr(I);
if i mod 4 = 0 then
RxMemoryData1CODE.Clear
else
RxMemoryData1CODE.AsInteger:=100 + i * 10;
RxMemoryData1.Post;
end;
end;
procedure TForm1.CheckBox1Change(Sender: TObject);
begin
Edit1.Enabled:=not CheckBox1.Checked;
try
if CheckBox1.Checked then
RxMemoryData1.Filter:=Edit1.Text;
RxMemoryData1.Filtered:=CheckBox1.Checked;
except
on E:Exception do
Memo1.Lines.Text:=E.Message;
end; mon
end;
end.