利用脚本实现计算字段的一个demo
2012-10-03 13:14
260 查看
dfm文件:
object Form1: TForm1
Left = 262
Top = 108
Width = 979
Height = 563
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object DBGrid1: TDBGrid
Left = 24
Top = 200
Width = 889
Height = 137
DataSource = DataSource1
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
object OnChange: TButton
Left = 64
Top = 88
Width = 75
Height = 25
Caption = 'OnChange'
TabOrder = 1
OnClick = OnChangeClick
end
object Memo1: TMemo
Left = 288
Top = 48
Width = 633
Height = 89
Lines.Strings = (
'BEGIN'
' Cdjmx.Fields[5].Value:=Cdjmx.Fields[4].Value * Cdjmx.Fields[3' +
'].Value;'
'END.')
TabOrder = 2
end
object Button2: TButton
Left = 160
Top = 80
Width = 75
Height = 25
Caption = '编译'
TabOrder = 3
OnClick = Button2Click
end
object DBGrid2: TDBGrid
Left = 16
Top = 384
Width = 881
Height = 113
DataSource = DataSource2
TabOrder = 4
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
object Button1: TButton
Left = 64
Top = 144
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 5
end
object Cdjmx: TClientDataSet
Active = True
Aggregates = <>
Params = <>
ProviderName = 'DataSetProvider1'
Left = 384
Top = 232
end
object DataSetProvider1: TDataSetProvider
DataSet = Qdjmx
Left = 440
Top = 232
end
object DataSource1: TDataSource
DataSet = Cdjmx
Left = 328
Top = 232
end
object ADOQuery1: TADOQuery
ConnectionString =
'Provider=SQLOLEDB.1;Password=dbtest;Persist Security Info=True;' +
'User ID=sa;Initial Catalog=dbtest;Data Source=127.0.0.1'
CursorType = ctStatic
Parameters = <>
SQL.Strings = (
'')
Left = 592
Top = 200
end
object fsPascal1: TfsPascal
Left = 800
Top = 104
end
object fsScript1: TfsScript
SyntaxType = 'PascalScript'
Left = 776
Top = 72
end
object fsDBRTTI1: TfsDBRTTI
Left = 856
Top = 72
end
object DataSource2: TDataSource
DataSet = ClientDataSet1
Left = 184
Top = 392
end
object ClientDataSet1: TClientDataSet
Aggregates = <>
Params = <>
Left = 248
Top = 400
end
object Qdjmx: TUniQuery
Connection = UniConnection1
SQL.Strings = (
'select id,sort,sn,shl,dj,je from TEST')
Left = 480
Top = 232
end
object UniConnection1: TUniConnection
ProviderName = 'SQL Server'
Port = 1433
Database = 'dbtest'
Username = 'sa'
Password = 'dbtest'
Server = '127.0.0.1'
Connected = True
LoginPrompt = False
Left = 520
Top = 240
end
object SQLServerUniProvider1: TSQLServerUniProvider
Left = 680
Top = 168
end
end
pas文件:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, fs_iinterpreter, fs_ipascal, ADODB, Provider,
DBClient, Grids, DBGrids,fs_iformsrtti, fs_idbrtti, MemDS, DBAccess, Uni,
UniProvider, SQLServerUniProvider;
type
TForm1 = class(TForm)
DBGrid1: TDBGrid;
Cdjmx: TClientDataSet;
DataSetProvider1: TDataSetProvider;
DataSource1: TDataSource;
ADOQuery1: TADOQuery;
fsPascal1: TfsPascal;
fsScript1: TfsScript;
OnChange: TButton;
Memo1: TMemo;
Button2: TButton;
fsDBRTTI1: TfsDBRTTI;
DBGrid2: TDBGrid;
DataSource2: TDataSource;
ClientDataSet1: TClientDataSet;
Button1: TButton;
Qdjmx: TUniQuery;
UniConnection1: TUniConnection;
SQLServerUniProvider1: TSQLServerUniProvider;
procedure CdjmxdjChange(Sender: TField);
procedure OnChangeClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.OnChangeClick(Sender: TObject);
begin
if not (Cdjmx.State in [dsEdit,dsInsert]) then Cdjmx.Edit;
fsScript1.Lines := Memo1.Lines;
if fsScript1.Compile then
fsScript1.Execute
else
ShowMessage(fsScript1.ErrorMsg); { show an error message }
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
fsScript1.Lines.Clear;
fsScript1.Clear;
fsScript1.AddClass(TClientDataSet,'TDataSet');
fsScript1.AddClass(TClientDataSet,'TCustomClientDataSet');
fsScript1.AddClass(TForm1,'TForm1');
fsScript1.AddObject('Cdjmx',self.Cdjmx);
fsScript1.Parent := fsGlobalUnit; { frGlobalUnit contains standard types and functions }
Qdjmx.Open;
Cdjmx.FieldByName('SHL').OnChange:=CdjmxdjChange;
Cdjmx.FieldByName('DJ').OnChange:=CdjmxdjChange;
Cdjmx.Edit;
end;
procedure TForm1.CdjmxdjChange(Sender: TField);
begin
if not (Cdjmx.State in [dsEdit,dsInsert]) then Cdjmx.Edit;
//fsScript1.Clear;{ clear all items }
fsScript1.Lines := Memo1.Lines; { script text }
if fsScript1.Compile then { compile the script }
begin
fsScript1.Execute; { execute if compilation was succesfull }
Cdjmx.Post;
end
else
ShowMessage(fsScript1.ErrorMsg); { show an error message }
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if Cdjmx.ChangeCount>0 then Cdjmx.ApplyUpdates(0);
end;
end.
object Form1: TForm1
Left = 262
Top = 108
Width = 979
Height = 563
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object DBGrid1: TDBGrid
Left = 24
Top = 200
Width = 889
Height = 137
DataSource = DataSource1
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
object OnChange: TButton
Left = 64
Top = 88
Width = 75
Height = 25
Caption = 'OnChange'
TabOrder = 1
OnClick = OnChangeClick
end
object Memo1: TMemo
Left = 288
Top = 48
Width = 633
Height = 89
Lines.Strings = (
'BEGIN'
' Cdjmx.Fields[5].Value:=Cdjmx.Fields[4].Value * Cdjmx.Fields[3' +
'].Value;'
'END.')
TabOrder = 2
end
object Button2: TButton
Left = 160
Top = 80
Width = 75
Height = 25
Caption = '编译'
TabOrder = 3
OnClick = Button2Click
end
object DBGrid2: TDBGrid
Left = 16
Top = 384
Width = 881
Height = 113
DataSource = DataSource2
TabOrder = 4
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
object Button1: TButton
Left = 64
Top = 144
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 5
end
object Cdjmx: TClientDataSet
Active = True
Aggregates = <>
Params = <>
ProviderName = 'DataSetProvider1'
Left = 384
Top = 232
end
object DataSetProvider1: TDataSetProvider
DataSet = Qdjmx
Left = 440
Top = 232
end
object DataSource1: TDataSource
DataSet = Cdjmx
Left = 328
Top = 232
end
object ADOQuery1: TADOQuery
ConnectionString =
'Provider=SQLOLEDB.1;Password=dbtest;Persist Security Info=True;' +
'User ID=sa;Initial Catalog=dbtest;Data Source=127.0.0.1'
CursorType = ctStatic
Parameters = <>
SQL.Strings = (
'')
Left = 592
Top = 200
end
object fsPascal1: TfsPascal
Left = 800
Top = 104
end
object fsScript1: TfsScript
SyntaxType = 'PascalScript'
Left = 776
Top = 72
end
object fsDBRTTI1: TfsDBRTTI
Left = 856
Top = 72
end
object DataSource2: TDataSource
DataSet = ClientDataSet1
Left = 184
Top = 392
end
object ClientDataSet1: TClientDataSet
Aggregates = <>
Params = <>
Left = 248
Top = 400
end
object Qdjmx: TUniQuery
Connection = UniConnection1
SQL.Strings = (
'select id,sort,sn,shl,dj,je from TEST')
Left = 480
Top = 232
end
object UniConnection1: TUniConnection
ProviderName = 'SQL Server'
Port = 1433
Database = 'dbtest'
Username = 'sa'
Password = 'dbtest'
Server = '127.0.0.1'
Connected = True
LoginPrompt = False
Left = 520
Top = 240
end
object SQLServerUniProvider1: TSQLServerUniProvider
Left = 680
Top = 168
end
end
pas文件:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, fs_iinterpreter, fs_ipascal, ADODB, Provider,
DBClient, Grids, DBGrids,fs_iformsrtti, fs_idbrtti, MemDS, DBAccess, Uni,
UniProvider, SQLServerUniProvider;
type
TForm1 = class(TForm)
DBGrid1: TDBGrid;
Cdjmx: TClientDataSet;
DataSetProvider1: TDataSetProvider;
DataSource1: TDataSource;
ADOQuery1: TADOQuery;
fsPascal1: TfsPascal;
fsScript1: TfsScript;
OnChange: TButton;
Memo1: TMemo;
Button2: TButton;
fsDBRTTI1: TfsDBRTTI;
DBGrid2: TDBGrid;
DataSource2: TDataSource;
ClientDataSet1: TClientDataSet;
Button1: TButton;
Qdjmx: TUniQuery;
UniConnection1: TUniConnection;
SQLServerUniProvider1: TSQLServerUniProvider;
procedure CdjmxdjChange(Sender: TField);
procedure OnChangeClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.OnChangeClick(Sender: TObject);
begin
if not (Cdjmx.State in [dsEdit,dsInsert]) then Cdjmx.Edit;
fsScript1.Lines := Memo1.Lines;
if fsScript1.Compile then
fsScript1.Execute
else
ShowMessage(fsScript1.ErrorMsg); { show an error message }
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
fsScript1.Lines.Clear;
fsScript1.Clear;
fsScript1.AddClass(TClientDataSet,'TDataSet');
fsScript1.AddClass(TClientDataSet,'TCustomClientDataSet');
fsScript1.AddClass(TForm1,'TForm1');
fsScript1.AddObject('Cdjmx',self.Cdjmx);
fsScript1.Parent := fsGlobalUnit; { frGlobalUnit contains standard types and functions }
Qdjmx.Open;
Cdjmx.FieldByName('SHL').OnChange:=CdjmxdjChange;
Cdjmx.FieldByName('DJ').OnChange:=CdjmxdjChange;
Cdjmx.Edit;
end;
procedure TForm1.CdjmxdjChange(Sender: TField);
begin
if not (Cdjmx.State in [dsEdit,dsInsert]) then Cdjmx.Edit;
//fsScript1.Clear;{ clear all items }
fsScript1.Lines := Memo1.Lines; { script text }
if fsScript1.Compile then { compile the script }
begin
fsScript1.Execute; { execute if compilation was succesfull }
Cdjmx.Post;
end
else
ShowMessage(fsScript1.ErrorMsg); { show an error message }
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if Cdjmx.ChangeCount>0 then Cdjmx.ApplyUpdates(0);
end;
end.
相关文章推荐
- C#利用js脚本实现配置的文本表达式计算
- 利用QtQuick实现UI的一个Demo
- SPCAMLEditor使用系列(3)--利用SPCamlEditor实现 时间字段跟当前时间进行实时比较计算
- 计算一个文本文件有多少行(利用标准IO 函数实现)
- Windows下利用原始套接字实现的一个抓包程序Demo
- sql利用视图实现一个数值型字段的求和问题
- 利用属性动画Animator实现的一个小demo,
- Windows下利用原始套接字实现的一个抓包程序Demo
- 利用KNN算法实现的一个demo
- sqlserver 利用数据库脚本实现取一个表中的数据插入到另一个表
- 利用读写锁简单实现一个缓存demo
- Unity学习笔记——利用脚本实现对一个物体的第三人称观察
- 一个shell脚本,实现利用OpenSSL生成X509证书
- 利用QtQuick实现UI的一个Demo
- 利用redis的订阅和发布来实现实时监控的一个DEMO(Python版本)
- 一个简单的利用ini配置文件以及用户输入的交互进行文件夹内容拷贝的批处理文件脚本的实现
- 利用一个Demo说明Castle+NHibernate的实现
- 利用redis的订阅和发布来实现实时监控的一个DEMO(Python版本)
- iOS利用SDWebImage实现缓存的计算与清理
- 利用qt自带的QDBus实现一个usb设备管理器