?? dxjs_dbvalidation.pas
字號:
fLoaded := False;
if (AOwner = nil) or
not (AOwner is TForm) then begin
raise Exception.Create('Parent must be TForm!');
Exit;
end;
fParent := AOwner as TForm;
fOzzHook:=Nil;
if (csDesigning in ComponentState) or
(csLoading in ComponentState) then Exit;
fOzzHook := TOzzPersist.Create(nil);
fOzzHook.Suspended:=False;
fOzzHook.ComponentList := TStringList.Create;
fOzzHook.OnExitValidate := InternalExitValidate;
fOzzHook.OnEnterValidate := InternalEnterValidate;
fOzzHook.BeforePostValidate := InternalBeforePostValidate;
fOzzHook.JavaScript := TDXJavaScript.Create(nil);
fOzzHook.JavaScript.AddRoutine('GetFieldValue', @__GetFieldValue);
fOzzHook.JavaScript.AddRoutine('SetFocus', @__SetFocus);
fOzzHook.JavaScript.AddRoutine('RaiseError', @__RaiseError);
BinTree := TDXBinarySearchTree.Create(DXCompareFunc, DXDisposeProc);
end;
destructor TDXJS_DBValidation.Destroy;
var
I: Integer;
DSList: TStringList;
OriginalInstance: Pointer;
begin
(*
if not (csDesigning in ComponentState) then begin
try
fOzzHook.ComponentList.Free;
DSList := TStringList.Create;
DSList.Sorted := True;
DSList.Duplicates := dupIgnore;
for I := 0 to fParent.ComponentCount - 1 do begin
if GetPropInfo(fParent.Components[I], 'Datasource') <> nil then begin
OriginalInstance := GetObjectProp(fParent.Components[I], 'DataSource');
if OriginalInstance <> nil then
if DSList.IndexOf(TDataSource(OriginalInstance).DataSet.Name) < 0 then begin
DSList.Add(TDataSource(OriginalInstance).DataSet.Name);
fOzzHook.RemoveDatasetJavaScript(TDataSource(OriginalInstance).DataSet,
TDataSource(OriginalInstance).DataSet.Name);
end;
end;
fOzzHook.RemoveJavaScript(fParent.Components[I],
fParent.Components[I].Name);
end;
fOzzHook.Free;
DSList.Free;
// BinTree.Clear;
// BinTree.Free;
except
;
end;
end;
*)
inherited Destroy;
end;
procedure TDXJS_DBValidation.InternalExitValidate(Sender: TObject);
var
BinTreeItem: PDXLinkList;
Query: PDXLinkList;
{$ifdef VARIANTS}
MyNull:Variant;
{$endif}
begin
if fOzzHook.Suspended then exit;
// DXString.ProcessWindowsMessageQueue;
New(Query);
Query^.ComponentName := TComponent(Sender).Name;
BinTreeItem := BinTree.Find(Query);
Dispose(Query);
with fOzzHook do begin
JavaScript.AddObject('self', TComponent(Sender));
JavaScript.AddProperty(TComponent(Sender).ClassType,
'dbvalue',
@__GetText,
@__SetText);
if not JavaScript.Compiled then JavaScript.Compile;
// JavaScript.SourceDump;
{$ifdef VARIANTS}
MyNull:=Null;
JavaScript.CallFunction(TComponent(Sender).Name + 'OnExit', MyNull);
{$else}
JavaScript.CallFunction(TComponent(Sender).Name + 'OnExit', Null);
{$endif}
if Assigned(BinTreeItem) then begin
if Assigned(BinTreeItem^.OldOnExit) then
BinTreeItem^.OldOnExit(Sender);
end;
// DXString.ProcessWindowsMessageQueue;
end;
end;
procedure TDXJS_DBValidation.InternalEnterValidate(Sender: TObject);
var
BinTreeItem: PDXLinkList;
Query: PDXLinkList;
{$ifdef VARIANTS}
MyNull:Variant;
{$endif}
begin
if fOzzHook.Suspended then exit;
// DXString.ProcessWindowsMessageQueue;
New(Query);
Query^.ComponentName := TComponent(Sender).Name;
BinTreeItem := BinTree.Find(Query);
Dispose(Query);
with fOzzHook do begin
JavaScript.AddObject('self', TComponent(Sender));
JavaScript.AddProperty(TComponent(Sender).ClassType,
'dbvalue',
@__GetText,
@__SetText);
if not JavaScript.Compiled then JavaScript.Compile;
// JavaScript.SourceDump;
{$ifdef VARIANTS}
MyNull:=Null;
JavaScript.CallFunction(TComponent(Sender).Name + 'OnEnter', MyNull);
{$else}
JavaScript.CallFunction(TComponent(Sender).Name + 'OnEnter', Null);
{$endif}
if Assigned(BinTreeItem) then begin
if Assigned(BinTreeItem^.OldOnEnter) then
BinTreeItem^.OldOnEnter(Sender);
end;
// DXString.ProcessWindowsMessageQueue;
end;
end;
procedure TDXJS_DBValidation.InternalBeforePostValidate(DataSet: TDataSet);
var
BinTreeItem: PDXLinkList;
Query: PDXLinkList;
{$ifdef VARIANTS}
MyNull:Variant;
{$endif}
begin
if fOzzHook.Suspended then exit;
// DXString.ProcessWindowsMessageQueue;
New(Query);
Query^.ComponentName := DataSet.Name;
BinTreeItem := BinTree.Find(Query);
Dispose(Query);
with fOzzHook do begin
if not JavaScript.Compiled then JavaScript.Compile;
// JavaScript.SourceDump;
try
{$ifdef VARIANTS}
MyNull:=Null;
JavaScript.CallFunction(DataSet.Name + 'BeforePost', MyNull);
{$else}
JavaScript.CallFunction(DataSet.Name + 'BeforePost', Null);
{$endif}
if Assigned(BinTreeItem) then begin
if Assigned(BinTreeItem^.OldBeforePost) then
BinTreeItem^.OldBeforePost(DataSet);
end;
except
raise;
end;
// DXString.ProcessWindowsMessageQueue;
end;
end;
procedure TDXJS_DBValidation.LinkFieldsandDatasets(SourceCode: TStream);
var
I: Integer;
RunTimeMethod: TMethod;
RunTimeMethod2: TMethod;
RunTimeMethod3: TMethod;
PropInfo: PPropInfo;
BinTreeItem: PDXLinkList;
Query: PDXLinkList;
DSList: TStringList;
Done: Boolean;
Ws: string;
{$IFDEF DUMP_BASE_SCRIPT}
StrList: TStringList;
{$ENDIF}
{$ifdef VARIANTS}
MyNull:Variant;
{$endif}
begin
if (csDesigning in ComponentState) or
(csLoading in ComponentState) then Exit;
// DXString.ProcessWindowsMessageQueue;
BinTree.Clear;
// skim the source for "blank" functions and drop them!
fOzzHook.ComponentList.Clear;
if SourceCode.Size > 0 then begin
DSList := TStringList.Create;
DSList.LoadFromStream(SourceCode);
Done := False;
I := 0;
while not Done do begin
Ws := DSList[I];
// drop blank function??
if Lowercase(FetchByChar(Ws, #32, False)) = 'function' then begin
fOzzHook.ComponentList.Add(FetchByChar(Ws, #32, False));
Ws := DSList[I + 1];
if Ws = '{' then begin
Ws := DSList[I + 2];
if Ws = '}' then begin
DSList.Delete(I);
DSList.Delete(I);
DSList.Delete(I);
fOzzHook.ComponentList.Delete(fOzzHook.ComponentList.Count - 1);
Dec(I);
end;
end;
end
// drop commented lines??
else begin
Ws := DSList[I];
if Copy(Ws, 1, 2) = '//' then begin
DSList.Delete(I);
Dec(I);
end
else
if Ws = '' then begin
DSList.Delete(I);
Dec(I);
end;
end;
Inc(I);
if I > DSList.Count - 5 then Done := True;
end;
TMemoryStream(SourceCode).Clear;
DSList.SaveToStream(SourceCode);
SourceCode.Seek(0, 0);
DSList.Free;
end;
{$IFDEF DUMP_BASE_SCRIPT}
StrList := TStringList.Create;
{$ENDIF}
if SourceCode.Size > 0 then begin
fOzzHook.JavaScript.LoadFromStream(SourceCode);
fOzzHook.JavaScript.Compile;
fLoaded := True;
end;
New(BinTreeItem);
BinTreeItem^.ComponentName := 'PARENT_FORM';
BinTreeItem^.DBAncestorLike := -1;
BinTreeItem^.OriginalInstance := fParent;
BinTreeItem^.DataFieldName := '';
BinTreeItem^.OldOnExit := nil;
BinTreeItem^.OldOnEnter := nil;
BinTreeItem^.OldBeforePostHooked:=False;
BinTreeItem^.OldBeforePost := nil;
BinTree.Insert(BinTreeItem);
DSList := TStringList.Create;
DSList.Sorted := True;
DSList.Duplicates := dupIgnore;
PropInfo := GetPropInfo(fOzzHook, 'OnExitValidate');
if PropInfo <> nil then begin
RunTimeMethod := GetMethodProp(fOzzHook, 'OnExitValidate');
RunTimeMethod2 := GetMethodProp(fOzzHook, 'OnEnterValidate');
RunTimeMethod3 := GetMethodProp(fOzzHook, 'BeforePostValidate');
end;
for I := 0 to fParent.ComponentCount - 1 do begin
New(Query);
Query^.ComponentName := fParent.Components[I].Name;
BinTreeItem := BinTree.Find(Query);
Dispose(Query);
if Assigned(BinTreeItem) then BinTree.Delete(BinTreeItem);
New(BinTreeItem);
BinTreeItem^.ComponentName := fParent.Components[I].Name;
try
// Will Only Link what is acceptable, otherwise exception out!
PropInfo := GetPropInfo(fParent.Components[I], 'DataSource');
BinTreeItem^.DBAncestorLike := -1;
if PropInfo <> nil then begin
BinTreeItem^.OriginalInstance := GetObjectProp(fParent.Components[I], 'DataSource');
if DSList.IndexOf(TDataSource(BinTreeItem^.OriginalInstance).DataSet.Name) < 0 then begin
DSList.Add(TDataSource(BinTreeItem^.OriginalInstance).DataSet.Name);
fOzzHook.ApplyDatasetJavaScript(TDataSource(BinTreeItem^.OriginalInstance).DataSet,
TDataSource(BinTreeItem^.OriginalInstance).DataSet.Name, RunTimeMethod3);
{$IFDEF DUMP_BASE_SCRIPT}
StrList.Add('function ' + TDataSource(BinTreeItem^.OriginalInstance).DataSet.Name + 'BeforePost()');
StrList.Add('{');
StrList.Add('}');
StrList.Add('');
{$ENDIF}
end;
BinTreeItem^.DBAncestorLike := 6;
try
BinTreeItem^.DataFieldName := GetStrProp(fParent.Components[I], 'Datafield');
BinTreeItem^.OldOnExit := nil;
BinTreeItem^.OldOnEnter := nil;
BinTreeItem^.OldBeforePost := nil;
BinTreeItem^.OldBeforePostHooked:=False;
BinTree.Insert(BinTreeItem);
fOzzHook.ApplyJavaScript(fParent.Components[I],
fParent.Components[I].Name, RunTimeMethod, RunTimeMethod2);
{$IFDEF DUMP_BASE_SCRIPT}
StrList.Add('function ' + fParent.Components[I].Name + 'OnExit()');
StrList.Add('{');
StrList.Add('}');
StrList.Add('');
StrList.Add('function ' + fParent.Components[I].Name + 'OnEnter()');
StrList.Add('{');
StrList.Add('}');
StrList.Add('');
{$ENDIF}
except
StrList.Insert(0, '// Not Added: ' + fParent.Components[I].Name);
end;
end;
except
if BinTreeItem^.DBAncestorLike < 0 then Dispose(BinTreeItem);
end;
end;
fOzzHook.JavaScript.AddObject(fParent.Name,
fParent);
{$ifdef VARIANTS}
MyNull:=Null;
fOzzHook.JavaScript.CallFunction('OnFormCreate', MyNull);
{$else}
fOzzHook.JavaScript.CallFunction('OnFormCreate', Null);
{$endif}
// DXString.ProcessWindowsMessageQueue;
{$IFDEF DUMP_BASE_SCRIPT}
StrList.Insert(0, '//////////////////////////////////////////////////////////');
while DSList.Count > 0 do begin
StrList.Insert(0, '// Datasource: ' + DSList[0]);
DSList.Delete(0);
end;
StrList.Insert(0, '// Primary Form Instance: ' + fParent.Name);
StrList.Insert(0, '// Special Objects...');
StrList.Insert(0, '//////////////////////////////////////////////////////////');
StrList.Insert(0, '// Skeleton Created ' + DateTimeToStr(Now));
StrList.Insert(0, '// Auto-created Skeleton, contains ' + IntegerToString(BinTree.Count) + ' supported variable(s)');
StrList.Insert(0, '//////////////////////////////////////////////////////////');
StrList.Add('function OnFormCreate()');
StrList.Add('{');
StrList.Add('}');
StrList.Add('');
StrList.SaveToFile('C:\' + fParent.Name + '.jsbase');
StrList.Free;
{$ENDIF}
DSList.Free;
end;
procedure TDXJS_DBValidation.OnActivateRehook;
var
I: Integer;
DSList: TStringList;
RunTimeMethod3: TMethod;
PropInfo: PPropInfo;
BinTreeItem: PDXLinkList;
Query: PDXLinkList;
OriginalInstance:Pointer;
begin
if (csDesigning in ComponentState) or
(csLoading in ComponentState) then Exit;
DSList := TStringList.Create;
DSList.Sorted := True;
DSList.Duplicates := dupIgnore;
PropInfo := GetPropInfo(fOzzHook, 'OnExitValidate');
if PropInfo <> nil then begin
RunTimeMethod3 := GetMethodProp(fOzzHook, 'BeforePostValidate');
end;
for I := 0 to fParent.ComponentCount - 1 do begin
try
OriginalInstance:=GetObjectProp(fParent.Components[I],'DataSource');
If OriginalInstance<>Nil then Begin
New(Query);
Query^.ComponentName :=TDataSource(OriginalInstance).DataSet.Name;
BinTreeItem := BinTree.Find(Query);
Dispose(Query);
if DSList.IndexOf(TDataSource(OriginalInstance).DataSet.Name)<0 then begin
If Assigned(BinTreeItem) then begin
BinTree.Delete(BinTreeItem);
End;
DSList.Add(TDataSource(OriginalInstance).DataSet.Name);
fOzzHook.ApplyDatasetJavaScript(TDataSource(OriginalInstance).DataSet,
TDataSource(OriginalInstance).DataSet.Name, RunTimeMethod3);
end;
End;
except
;
end;
end;
// ShowMessage('Rehooked:'+#13+DSList.Text);
DSList.Free;
end;
procedure TDXJS_DBValidation.SetfSuspend(value:boolean);
Begin
if Assigned(fOzzHook) then fOzzHook.Suspended:=Value;
End;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -