现在我想从外部DFM中动态创建Form，其他都搞定了，就是遇到一个很棘手问题：
假设这个Form的类是TForm1，但是由于我没有办法RegisterClass(TForm1)（因为我程序中没有TForm1的类，只是这个DFM中有），会导致一个错误说我TForm1没有注册，假设将TForm1变为TForm是没有问题的，如果我有办法欺骗Delphi Runtime创建一个ClassName='TForm1'的类然后注册就可以，但是我试了许多方法，诸如使用vmtClassName试图改变其名称但失败了（好像是内存不能写但Evaluate居然可以～），也试图自己产生一个TClass然后注册但是很复杂，请问谁有这方面的经验？不胜感激！
假设这个Form的类是TForm1，但是由于我没有办法RegisterClass(TForm1)（因为我程序中没有TForm1的类，只是这个DFM中有），会导致一个错误说我TForm1没有注册，假设将TForm1变为TForm是没有问题的，如果我有办法欺骗Delphi Runtime创建一个ClassName='TForm1'的类然后注册就可以，但是我试了许多方法，诸如使用vmtClassName试图改变其名称但失败了（好像是内存不能写但Evaluate居然可以～），也试图自己产生一个TClass然后注册但是很复杂，请问谁有这方面的经验？不胜感激！
关键是没有什么用处，不知道你的具体需求是怎样的比如说，是怎样的Form，Form是自定义的，还是默认从TForm上继承的？Form上是否只有控件？没有事件？如果单单是想载入一些Form的属性以及上面的控件，问题应该不大
不过没什么用途
1. 不支持Class、Interface定义，但可以通过嵌入编译方式将类、接口加入脚本
2. 暂不支持forward函数
3. 暂不区分unit/program分别，interface/implementation的定义都是公开的，暂不支持单元的interface函数定义预定义（忽略）
4. 暂不支持sets类型定义，但支持已内置集合的字符串方式使用
5. 暂对指针操作不完备
6. 不支持with语法主要实现如下功能：
1. 基本语法：类型声明、变量声明、赋值、循环(for/repeat/while/)、分支(if/case)、函数/过程
2. 支持SEH：try..except..end和try..finally..end
3. 支持二进制回调函数(Callback)定义和调用
4. 支持函数类型声明和传递
5. 支持DLL函数定义和调用
6. 支持OLE/ActiveX调用
7. 提供内置调试功能
8. 支持嵌入编译方式将类、接口加入到脚本功能，支持这些类、接口的定义和使用
9. 支持对象事件的脚本绑定
10. 已导入Controls, StdCtrls, ExtCtrls, Forms, Grids, Mask, DB, ADODB 等多个界面单元
11. 支持ZipCompress，多种加密数据方法
12. COM接口支持GetUnkVar/SetUnkVar，可以在运行阶段动态取得、修改用户变量
13. COM接口支持GetUnkProp/SetUnkProp，可以在运行阶段动态取得、设置界面、内部属性
14. 支持SetLocalVar/GetLocalVar，可以在运行阶段通过名字字符串取得、设置变量
15. 支持中文标识符（变量、类型、函数）
16. 支持装载外部DFM绑定脚本
program LoadForm;{
版本历史:
日期 修改人 内容
2004-08-27 神秘人 初始版本
}uses
SysUtils, Dialogs, Forms;var
cForm: TForm;procedure Button1Click(Sender: TObject);
begin
ShowMsg('Button1Click');
end;procedure Edit1Change(Sender: TObject);
begin
ShowMsg('Edit1Change');
end;begin // 主程序入口
cForm := LoadComponentFromFile('D:\Edward\SOURCE\AW\TestForm.dfm');
if cForm<>nil then
cForm.ShowModal;
end.
/////////////////////////program ADOTest;{
版本历史:
日期 修改人 原因
2004/06/07 神秘人 初始版本
}uses
SysUtils, Dialogs, ExtDialogs, Classes, DB, ADODB; procedure MyBeforeOpen(DataSet: TDataSet);
begin
ShowMsg(Format('Before Open, Class=%s, State=%d', [DataSet.ClassName, DataSet.State]));
end; procedure MyAfterOpen(DataSet: TDataSet);
begin
ShowMsg('After Open, State='+IntToStr(DataSet.State));
end;var
cQry: TADOQuery;
cDS: TClientDataSet;
begin // 主程序入口
cQry := TADOQuery.Create(nil);
cQry.ConnectionString := 'Provider=SQLOLEDB.1;Data Source=127.0.0.1;Password=tmc1234;Persist Security Info=True;User ID=tmc;Initial Catalog=tmc';
AttachEvent(cQry, 'BeforeOpen', MyBeforeOpen);
AttachEvent(cQry, 'AfterOpen', MyAfterOpen);
cQry.SQL.Clear;
cQry.SQL.Add ('select * from idtbl');
cQry.Active := TRUE;
cDS := TClientDataSet.Create(nil);
SelectFromDataSet ('idtbl rows',cQry,'',cDS);
end.////////////////////////////////function 校验日期型数据项为空(yEltNames: OpenArray): Boolean;
var
I: Integer;
dt: TDateTime;
begin
for I:=Low(yEltNames) to High(yEltNames) do
begin
dt := GetUnkVar(yEltNames[I]);
if dt = 0 then
begin
ShowMessage('请录入' + yEltNames[I]);
Result := TRUE;
Exit;
end;
end;
Result := FALSE;
end;program Backup;{
版本历史:
日期 修改人 原因
2004-06-29 EdGuo 初始版本
}uses
FileUtils, Dialogs, DirUtils, SysUtils, OS, Compress;var
bAborted: Boolean; function MyProgress (sFile: string; nCur, nTotal: Integer; sToPath: string): Integer;
var
n: Integer;
begin
if nCur>=nTotal then n := 0 else
n := nCur div 16384;
if Odd(n) then
begin
Result := 0;
end else
begin
if UpdateProgressTitle(sFile+#13+'复制到:'+sToPath, nTotal, nCur) then
Result := 0 else
begin
Result := 1;
bAborted := TRUE;
end;
end;
end; function Pack (sPath: string): Boolean;
var
sParam, sPW, sFile: string;
nExitCode: Integer;
b: Boolean;
cZip: TZipper;
begin
Result := FALSE;
sPW := '';
sFile := 'c:\backup.zip';
if InputNewPassword(sPW, 4, '输入备份密码') then
begin
lblInputFile:
if InputQuery('输入', '目标文件名:', sFile) then
begin
if sFile<>'' then
begin
if FileExists(sFile) then
begin
b := FALSE;
case AskUser('文件已存在:'+sFile+#13+'是:覆盖, 否:重新输入, 取消:取消操作') of
1: DeleteFile(sFile, FALSE);
2: b := TRUE; // should not use goto in case statement
3: Exit;
end;
if b then goto lblInputFile;
end; cZip := TZipper.Create(sFile);
cZip.BaseDirectory := sPath;
cZip.Password := sPW;
cZip.ShowProgress := TRUE;
cZip.Replace := TRUE;
cZip.Recurse := TRUE;
cZip.AddFiles ('*.*');
try
cZip.Save;
except
end;
cZip.Free;
Result := TRUE; {
sPath := AddDirSlash(sPath)+'*.*';
sParam := Format('rar a -r -p%s %s %s',[sPW, sFile, sPath]);
nExitCode := -1;
if Run(sParam, $22, 0, nExitCode) then
begin
if nExitCode=0 then
Result := TRUE;
end;
}
end;
end;
end;
end;var
sSource, sTarget: string;begin // 主程序入口
if ParamCount<2 then
begin
ShowMsgTimeOut('错误','没有定义源和目标路径',5);
Halt(1);
end else
begin
sSource := ParamStr(1);
sTarget := ParamStr(2);
bAborted := FALSE;
BeginProgress('正在复制...', 2, '复制进度', 0);
FileCopyList(sSource, sTarget,
// '*.pas',
'*.pas;*.dfm;*.dpr;*.inc;*.cfg;*.dof;*.bpg;*.dpk;*.rc;*.res;*.r32;*.bmp;*.dcr;*.tlb;*.jpg;*.txt;*.obj',
TRUE, 7, MyProgress);
EndProgress;
if not bAborted then
begin
if Pack (sTarget) then
ShowmsgTimeOut('信息','完成备份:'+sSource+#13+'到:'+sTarget,5);
DelDir (sTarget, true, true);
end;
end;
end./////////////////////////////program all1;
uses
SysUtils,Classes,Dialogs,Math,DateTimeUtils,StrUtils,
COMObj,Variants,EncdDecd,DB,ADODB,XML,IniFiles,
ExtDialogs,Graphics,Controls,StdCtrls,Forms,Mask,Masks,
ExtCtrls,Grids,DirUtils,FileUtils,ConwinAW,AWWizard,Encrypt,
Compress,DebugLog,OS,Hardware,Chinese,CRC,Validate,
CWSPlugin;begin
Sleep(20);
end.////////////////////////////program NCall;{
版本历史:
日期 修改人 内容
2004-07-08 神秘人 初始版本
}uses
SysUtils, Dialogs;
procedure test1(var n1: Integer);
begin
if n1>100 then Exit;
n1 := n1+1;
test2(n1);
end; procedure test2(var n2: Integer);
begin
if n2>100 then Exit;
n2 := n2+2;
test1(n2);
end;
var
n3: Integer;
begin // 主程序入口
test1(n3);
end.////////////////////////////////////
program MyForm1;{
版本历史:
日期 修改人 内容
2004-08-09 神秘人 初始版本
}uses
SysUtils, Dialogs, Graphics, Controls, StdCtrls, Forms, Mask;var
cForm: TForm;
cBtn: TButton;
cEdit: TMaskEdit; procedure OnOKClick (cSender: TObject);
var
cMyBtn: TButton;
r: TRect;
begin
cMyBtn := cSender;
ShowMsg(Format('Call from %s, EditText=%s',[cMyBtn.Caption, cEdit.Text]));
if AskUser1('是否OK?')=1 then cForm.ModalResult := mrOK else
begin
r := cForm.BoundsRect;
r.Left := r.Left+30;
r.Right := r.Right+30;
r.Top := r.Top+25;
r.Bottom := r.Bottom+25;
cForm.BoundsRect := r;
end;
end;begin // 主程序入口
cForm := TForm.Create (nil);
cForm.SetBounds (30, 100, 300, 200); cForm.Caption := 'test form';
cEdit := TMaskEdit.Create (cForm);
cEdit.EditMask := '9999-99-99';
cEdit.Top := 10;
cEdit.Left := 10;
cEdit.Width := 100;
cForm.InsertControl(cEdit);
cBtn := TButton.Create (cForm);
cBtn.SetBounds (30, 50, 80, 25);
cBtn.Caption := '&Hello';
//cBtn.ModalResult := mrOK;
AttachEvent(cBtn, 'OnClick', OnOKClick);
cForm.InsertControl(cBtn); if cForm.ShowModal=mrOK then
ShowMsg('World!');
cForm.Free;
end.
/////////////////////program CaseTest; // todo: 修改名称{
版本历史:
日期 修改人 原因
2004-06-26 神秘人 初始版本
}uses
SysUtils, Dialogs;var
s: string;
n1,n2: Integer;
begin // 主程序入口
case Random(5) of
0: s := 'what';
1: s := 'is';
2: s := 'What';
else s := 'it';
end; n1 := 0;
case s of // Lowercase(s)
'what':
begin
case n1+Random(8) of
n1..n1+2:
begin
ShowMsg('n1..n1+2');
end;
n1+3,n1+4:
begin
ShowMsg('n1+3, n1+4');
end;
else
begin
ShowMsg('else 2');
end;
end;
ShowMsg('case WHAT');
end;
'is':
begin
ShowMsg('case IS');
end;
else
ShowMsg('else: '+s);
end;
end.
我真TMD silly!之前已经发觉TReader如果传入非空的Root就不会调用FindClass，但是因为使用TForm.Create而导致Resource错误所以没用，后来发觉只要使用TForm.CreateNew造假就行了，现在问题解决了，虽然还不能面对所有情况，但是只要能应付TForm就够了，因为最大的目的是用来做界面。真愚昧！Thanks anyway.
不知道你有何优势呢？
商业上没优势就难有市场了
我以前也花了一点功夫在上面，VCL FORM既然可以串行化DFM格式，自然也可以串行化
XML格式；可以为分布式系统提供多种可能性；也可以成一种文档编辑查看工具。。
呵呵。吹远了。。
◎可控性：你的程序员被限制在你的开发环境中，避免了许多不必要的错误，其错误状态也更易于捕捉
◎可维护性：脚本可以存储在任何地方，在我们是我们自己开发的网络文件系统(NFS)并通过自己的应用服务器存取，一旦更新就能全部更新。可以对不同的客户编写不同的同类型脚本，其发布和修改成本是很低的，甚至对高级客户而言可以由他们自己修改/创建 （我们的脚本支持中文identifier)
◎对程序员更低的要求: 只需要稍微懂Delphi培训2周就可以开始工作，可以把大量的工作交给其他人而他们不必要对技术过分的认知。
◎如果你有版本控制，我认为脚本的版本比二进制版本要稍微直观点。
……