您的位置:首页 > 其它

利用脚本实现计算字段的一个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.
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: