【高分求助】进来看看。有点麻烦【分不够可以商量】

Eastunfail 2003-10-26 09:16:05
本人正在做一个汇编的IDE,其中基本框架也做好了(感觉还不错,呵呵,语法高亮,代码完成,自动提示等等)。大伙一定要帮忙啊,此软件事关我的终生幸福(保送,呵呵)

这几天在做资源编辑器,也就是要保证完全和Visual Studio兼容可以读取rc资源脚本文件,保存的rc文件也可以被Visual Studio打开。

今天在写常量管理类(TConstCategory,TCategories),基本上写完了。
其中inc文件有类似如下的固定格式:
;#category:test
;#default:test
;#extensive:test
TEST_1 equ 1H
TEST_2 equ 2H
TEST_3 equ 4H
TEST_ALL equ TEST_1 OR TEST_2 OR TEST_3

当我执行这个代码的时候
var t:TCategories;
begin
t:=TCategories.Create ;
try
t.LoadFromFile(ExtractFilePath(Application.ExeName)+'lxcRes.inc' );
lxcAlert(t.ConstToString(t.StringToConst('TEST_ALL','*'),'*'));
finally
t.Free ;
ExitProcess(0);
end;
结果是 TEST_1 OR TEST_2 OR TEST_3 OR TEST_ALL。使用如何的算法可以不输出TEST_1 OR TEST_2 OR TEST_3这些重复了的常量呢??


附代码(其中lxc开头的都是我自己写的一些实用函数,这个代码中使用到的有:
function lxcTraceBox(args:array of const)用来跟踪lxcTraceBox参数的,在开发环境下会弹出每个参数的值。在EXE中不会弹出
function lxcHashCode(const s:string),得到字符串s的哈西码,用于搜索加速的
function lxcAlert()系列函数有三个重载,类似ShowMessage
function lxcCompressString(const s:string)去掉首位空格,并将连续的制表符和空格替换为1个空格
function lxcIsNumber(s:string;HexStyle:LHexStyle=hsAuto):boolean;判断s是否是数字,支持16进制和10进制,支持Pascal,C,ASM,Basic语法的16进制风格或自动识别
function lxcStrToInt(s:string;HexStyle:LHexStyle=hsAuto):Integer;同上,不过是将字符串转换为数字
procedure lxcSplit(s:string;splitter:char;var st:TStringList;const quote:char=#0);类似TStringList的Delimm属性进行分割字符串,不过功能要强大些
):
unit untResConst;

interface
uses Classes,Windows,SysUtils,StrUtils,untGlobal;
type
PResConst=^TResConst;
{Structure for storing const}
TResConst=record
sName:String[30];
lName:Cardinal;
Value:Cardinal;
end;
//used to manage TConstCategory
TCategories=class;
//a category for a serie of consts
TConstCategory=class
private
FList:TList;
FID:Cardinal;
FName:string;
public
function AddConst(Name:string;Value:Cardinal):integer;
function SeekConst(Name:string):Cardinal;
function IsExist(Name:string):boolean;
procedure Append(Category:TConstcategory);
constructor Create(Name:string);
destructor Free;
//Category ID, for seeking quicker
property ID:Cardinal read FID;
//name for this category
property Name:string read FName;

end;
TCategories=class
private
FCategories:TList;
FDefault:TConstCategory;
FExtensive:TConstCategory;
class function _Hash(s:string):cardinal;
public
function IsExistCategory(Name:string):boolean;
procedure LoadFromFile(const FileName:string);
function SeekCategory(Name:string):TConstCategory;
function SeekConst(Name:string;Category:string):Cardinal;
function ConstToString(Value:Cardinal;Category:string;Extensive:Boolean=false):string;
function StringToConst(Str:String;Category:string;Extensive:Boolean=false):cardinal;
function IsExistConst(Name:string;Category:string):boolean;
property Extensive:TConstCategory read FExtensive;
property Default:TConstCategory read FDefault;
constructor Create;
destructor Free;
end;
implementation
uses lxcGlobal;
...全文
32 11 打赏 收藏 转发到动态 举报
写回复
用AI写文章
11 条回复
切换为时间正序
请发表友善的回复…
发表回复
duxin 2003-10-27
  • 打赏
  • 举报
回复
眼镜 你也杀了我吧
Eastunfail 2003-10-26
  • 打赏
  • 举报
回复
主要问题还是在“ConstToString”中 :(


p.s. 这个类是用来管理Windows控件风格常量。而不是控件ID。

因为 lxcRes.inc里面全部都是保存者类似:
WS_POPUPWINDOW equ WS_POPUP OR WS_BORDER OR WS_SYSMENU
的东东。

只是想要求读取资源脚本的STYLE指令时,读入的是WS_POPUPWINDOW,而写入的不是WS_POPUP OR WS_BORDER OR WS_SYSMENU
OR WS_POPUPWINDOW
pankun 2003-10-26
  • 打赏
  • 举报
回复
我晕,太长了,没时间看啊...
不过我以前做程序间碟时要检查窗口风格常量时也碰到过类似问题.我的思路是这样的:
比如有一个常量A, 如果里面包含了Test_ALL的话,我就先输出Test_ALL,再把A xor Text_ALL,再继续判断,这样Test_1, Test_2, Test_3就不会重复了..
reallike 2003-10-26
  • 打赏
  • 举报
回复
另外,你最好弄成一个文件给大家看啊。

从明天开始正式要给公司干一些事情了。

接触和外界的联系,比如上Csdn……

空闲了再帮你。
Eastunfail 2003-10-26
  • 打赏
  • 举报
回复
怎么了?注释不算少啊,较良好的编程风格,应该容易理解这个代码的啊
reallike 2003-10-26
  • 打赏
  • 举报
回复
兄弟啊,不好意思,我想帮你,

可是无奈公司现在正紧张工作,

无暇分神,先帮你顶再说。

算法你也去问问Aogo,他也在做这个。
Eastunfail 2003-10-26
  • 打赏
  • 举报
回复
贴出来才觉得这个有点长了(363行)................
FrameSniper 2003-10-26
  • 打赏
  • 举报
回复
眼睛,你杀了我吧!
Eastunfail 2003-10-26
  • 打赏
  • 举报
回复
{Seek const}
function TCategories.SeekConst(Name:string;Category:string):Cardinal;
var hash,cate:cardinal;i,j:integer;SeekAll:Boolean;
begin
hash:=_Hash(Name);
SeekAll:=AnsiCompareText(Category,'*')=0;
cate:=_Hash(Category);
for i:=0 to FCategories.Count -1 do
if (FDefault=FCategories.Items[i]) or SeekAll or (TConstCategory(FCategories.Items[i]).FID =cate) then
for j:=0 to TConstCategory(FCategories.Items[i]).FList.Count -1 do
if PResConst(TConstCategory(FCategories.Items[i]).FList.Items[j]).lName =hash then
begin
Result:=PResConst(TConstCategory(FCategories.Items[i]).FList.Items[j]).Value ;
exit;
end;
Result:=0;
end;

{Conclude whether a const is existing}
function TCategories.IsExistConst(Name:string;Category:string):Boolean;
var hash,cate:cardinal;i,j:integer;SeekAll:Boolean;
begin
hash:=_Hash(Name);
SeekAll:=AnsiCompareText(Category,'*')=0;
cate:=_Hash(Category);
Result:=true;
for i:=0 to FCategories.Count -1 do//iterate all categories
if (FDefault=FCategories.Items[i]) or SeekAll or (TConstCategory(FCategories.Items[i]).FID =cate) then//desired one or seek all?
for j:=0 to TConstCategory(FCategories.Items[i]).FList.Count -1 do//iterate all consts
if PResConst(TConstCategory(FCategories.Items[i]).FList.Items[j]).lName =hash then//desired const
exit;
Result:=false;
end;

{Convert a const to string}
function TCategories.ConstToString(Value:Cardinal;Category:string;Extensive:Boolean=false):string;
var cate:cardinal;i,j:integer;SeekAll:Boolean;s:string;tmp:cardinal;
begin
cate:=_Hash(Category);
s:='';
SeekAll:=AnsiCompareText(Category,'*')=0;
for i:=0 to FCategories.Count -1 do//iterate all categories
if (FDefault=FCategories.Items[i]) or SeekAll or (TConstCategory(FCategories.Items[i]).FID =cate) then//desired one or seek all?
for j:=0 to TConstCategory(FCategories.Items[i]).FList.Count -1 do//iterate all consts
begin
tmp:=PResConst(TConstCategory(FCategories.Items[i]).FList.Items[j]).Value ;
if (tmp and Value)=tmp then//desired const
s:=s+' OR ' + PResConst(TConstCategory(FCategories.Items[i]).FList.Items[j]).sName;
end;
if Length(s)<>0 then delete(s,1,4);
Result:=s;
end;
{Conver a string to const}
function TCategories.StringToConst(Str:String;Category:string;Extensive:Boolean=false):cardinal;
var st:TStringList;i,m,n:integer;hash,cate:cardinal;SeekAll:Boolean;Found:boolean;
value:cardinal;sErr:string;list:TList;
foundCount:integer;RecogSet:set of byte;
begin
st:=TStringList.Create ;
RecogSet:=[];
st.Clear ;
if Pos('_EX_',str)>0 then asm int 3;end;
lxcSplit(StringReplace(Str,' OR ','|',[rfReplaceAll,rfIgnoreCase]),'|',st);
foundCount:=0;
value:=0;
SeekAll:=AnsiCompareText(Category,'*')=0;
cate:=_Hash(Category);
for i:=0 to st.Count -1 do
begin
hash:=_Hash(st.Strings[i]);
Found:=false;
for m:=0 to FCategories.Count -1 do//iterate all categories
begin
list:=TConstCategory(FCategories.Items[m]).FList;
lxcTraceBox(['TRACE'#13,'Name:',TConstCategory(FCategories.Items[m]).Name,' idx:',m,' Count:',list.count,#13'Category:',FCategories.Items[m]]);
if (FDefault=FCategories.Items[m]) or SeekAll or (TConstCategory(FCategories.Items[m]).FID =cate) then
//desired one or seek all or default one?
for n:=0 to List.Count -1 do//iterate all consts
if PResConst(List.Items[n]).lName =hash then//desired const
begin
//found!
Found:=true;
value:=value or PResConst(List.Items[n]).Value ;
Inc(foundCount);
RecogSet:=RecogSet+[i];
break;
end;
end;
end;
sErr:='';
for i:=0 to st.Count -1 do
if not(i in RecogSet) then
sErr:=sErr+' And '+st.strings[i];
if sErr<>'' then Delete(sErr,1,5);
i:=st.Count ;
st.Free ;
if sErr<>'' then
raise exception.CreateFmt('Unrecognized const "%s" found!',[sErr]);
Result:=Value;
end;
{Constructor for TCategories}
constructor TCategories.Create;
begin
FCategories:=TList.Create ;
FDefault:=nil;
end;
{Destructor for TCategories}
destructor TCategories.Free;
var i:integer;
begin
for i:=FCategories.Count -1 downto 0 do //destruct all categories
begin
TConstCategory(FCategories.Items[i]).Free ;
FCategories.Delete(i);
end;
FCategories.Free ;
end;
end.
Eastunfail 2003-10-26
  • 打赏
  • 举报
回复
{Load a assembler's include file .inc}
procedure TCategories.LoadFromFile(const FileName:string);
var st:TStringList;i,iPos:integer;s,sName:string;Category,Category2:TConstCategory;
sValue:string;lValue:Cardinal;
begin
st:=TStringList.Create ;
st.LoadFromFile(FileName);
lValue:=0;
Category:=nil;
for i:=0 to st.Count -1 do//iterate all lines
begin
s:=lxcCompressString(Trim(st.Strings[i]));
if Length(s)=0 then continue;//empty line
if AnsiCompareText(Copy(s,1,7),';#break')=0 then//stop reading the rest of lines
break;
if AnsiCompareText(Copy(s,1,11),';#Category:')= 0 then //category sign
begin
sName:=s;
Delete(sName,1,11);
if not IsExistCategory(sName) then//category not exists
begin
Category:=TConstCategory.Create(sName);
FCategories.Add(Category);
continue;
end;
Category:=SeekCategory(sName);
continue;//continue
end;
if AnsiCompareText(Copy(s,1,7),';#Copy:')= 0 then //copy instruction
begin
sName:=s;
Delete(sName,1,7);
Category2:=self.SeekCategory(sName);
if not Assigned(Category) then// oh God! the source category is not exist!!!
begin
lxcAlert('Error definition in lxcRes.inc!'#13#10'No source category is specified when call copy instruction!');
continue;
end;
if Not Assigned(Category2) then //not found the destination category
begin//create new one
Category2:=TConstCategory.Create(sName);
FCategories.Add(Category2);
end;
Category2.Append(Category);//add category to the end of category2
continue;
end;
if AnsiCompareText(Copy(s,1,10),';#default:')=0 then //default instruction
begin
sName:=s;
Delete(sName,1,10);
Category2:=self.SeekCategory(sName);
if not assigned(Category2) then//not exists,create one
begin
Category2:=TConstCategory.Create(sName);
FCategories.Add(Category2);
end;
FDefault:=Category2;
continue;
end;
s:=RemoveComment(s);
if Length(s)= 0 then continue; // skip commented line
//e.g. WS_BORDER equ 00800000H
iPos:=AnsiPos(' equ ',s);
if iPos=0 then// It's strange, neither a comment nor a valid constance definition statement
continue;//Ignore it!
if Not Assigned(Category) then
if Assigned(FDefault) then Category:=FDefault;
//get name
sName:=Copy(s,1,iPos-1);
//get value
sValue:=Copy(s,iPos+5,Length(s)-ipos);
if lxcIsNumber(sValue,hsAsm)then //sValue is a assembler style number!
begin
Category.AddConst(sName,lxcStrToInt(sValue,hsAsm));//add to category and continue next loop
continue;
end;
try
lxcTraceBox(['Name:',Category.Name,' Count:',Category.FList.Count,#13#10'Category:',Category]);
lValue:=self.StringToConst(sValue,'*');
except//not found
lxcAlert('Error on parsing "%s"',[sName]);
end;
Category.AddConst(sName,lValue);
end;

end;
{Seek a category, if not exists, return nil}
function TCategories.SeekCategory(Name:string):TConstCategory;
var i:integer;code:cardinal;
begin
code:=TCategories._Hash(name);
for i:=0 to FCategories.Count -1 do
if TConstCategory(FCategories.Items[i]).FID =code then
begin
Result:=TConstCategory(Fcategories.items[i]);
exit;
end;
Result:=nil;
// raise Exception.CreateFmt('Category %s cannot be found!',[Name]);
end;
Eastunfail 2003-10-26
  • 打赏
  • 举报
回复
{Implementation of TConstCategory}

{Append a category to the end of list}
procedure TConstCategory.Append(Category:TConstCategory);
var i:integer;tmp:PResConst;
begin
for i:=0 to Category.FList.Count -1 do
begin
GetMem(tmp,Sizeof(TResConst));
with PResConst(Category.FList.Items[i])^ do
begin
tmp^.sName :=sName;
tmp^.lName :=lName;
tmp^.Value :=Value;
end; // with
FList.Add(tmp);
end;
end;
{Constructor for TConstCategory}
constructor TConstCategory.Create(Name:string);
begin
FID:=TCategories._Hash(name);
FList:=TList.Create ;
FName:=Name;
lxcTraceBox(['TConstcategory.Create:',self,' Name:',Name]);
end;
{Destructor for TConstCategory}
destructor TConstCategory.Free ;
var i:integer;
begin
for i:=FList.Count-1 downto 0 do
begin
FreeMem(FList.Items[i]);//Dispose from memory
FList.Delete(i);//Remove from list
end;
FList.Free ;//Destruct FList
end;
{Add a const}
function TConstCategory.AddConst(Name:string;Value:Cardinal):integer;
var tmp:PResConst;
begin
if self.IsExist(Name) then //Already exists
raise Exception.CreateFmt('Constant %s was already exists!',[Name]);
GetMem(tmp,sizeof(TResConst));//allocate memory for a TResConst
tmp^.sName :=Name;
tmp^.lName :=TCategories._Hash(name);
tmp^.Value :=Value;
Result:=FList.Add(tmp);
// lxcTraceBox(['Trace'#13#10,'AddConst:',Result]);
end;
{Is a specified const existing??}
function TConstCategory.IsExist(Name:string):boolean;
var code:Cardinal;i:integer;
begin
code:=TCategories._Hash(name);
Result:=true;
for i:=0 to FList.Count -1 do//iterate for each TResConst
if PResConst(FList.Items[i])^.lName =code then exit;
Result:=false;
end;
{Seek a const's value, if not exists, a exception will be throwed}
function TConstCategory.SeekConst(Name:string):Cardinal;
var code:Cardinal;i:integer;
begin
code:=TCategories._Hash(name);
for i:=0 to FList.Count -1 do
if PResConst(FList.Items[i])^.lName =code then
begin
Result:=PResConst(FList.Items[i])^.Value ;
exit;
end;
Raise exception.CreateFmt('Constant %s cannot be found!',[Name]);
end;

{Implementation of TCategories}

{static funtion method, get hash code for string s}
class function TCategories._Hash(s:string):cardinal;
begin
Result:=lxcHashCode(LowerCase(Trim(s)));//the lxcHashCode is existing in my lxcGlobal.pas, just get a unique cardinal integer
end;
{Name is a existing category??}
function TCategories.IsExistCategory(Name:string):boolean;
var i:integer;code:cardinal;
begin
code:=TCategories._Hash(name);
Result:=true;
for i:=0 to FCategories.Count -1 do
if TConstCategory(FCategories.Items[i]).FID =code then exit;
Result:=false;
end;

16,748

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 语言基础/算法/系统设计
社区管理员
  • 语言基础/算法/系统设计社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧