(495) 925-0049, ITShop - 229-0436, 925-0049
 

 
 
 
 
 

Delphi-

Delphi :

  • .
  • : ini- xml-.

( Project -> Languages). Delphi, . , .

, .

, : , , Delphi.

:

  • Delphi.
  • , , , Windows.

, Delphi . , , , Delphi.

:

  • Delphi. , .
  • - , Delphi . .
:
    , .
  • Delphi.
  • , .

: ini-, xml- .

, , , .

xml.

xml-

, XMLWorks: http://www.DelphiHome.com/xml.

, , .

:

  • ;
  • ;
  • .

.

2 :
1- . . . . .
2- . xml-.

, , .

, , , .

, . . , , TDBEdit, TDBDateTimeEditE, TDBLookupComboboxEh, .. , .

, , xml- .

function GenSQLLang(SelfInp: TObject): String;
Var
i, b: integer;
BandTmp: TcxGridDBBandedTableView;
begin
if (SelfInp is TComponent) then
Begin
With (SelfInp as TComponent) Do
Begin
Result:=ObjectToXMLElements_Lang(SelfInp,-4);
Result:=Result+Chr(13)+';
for i:=0 to ComponentCount-1 Do
begin
if (Trim(Components[i].Name)<>')And
(not((RusCompare(Components[i].ClassName,'TSaveDBGridEh'))
Or(RusCompare(Components[i].ClassName,'TpFIBTransaction'))
Or(RusCompare(Components[i].ClassName,'TpFIBStoredProc'))
Or(RusCompare(Components[i].ClassName,'TDBEdit'))
Or(RusCompare(Components[i].ClassName,'TDBDateTimeEditEh'))
Or(RusCompare(Components[i].ClassName,'TDBLookupComboboxEh'))
Or(RusCompare(Components[i].ClassName,'TDBComboBoxEh'))
)) then
begin
Result:=Result+Chr(13)+'<'+
Components[i].Name+'>'+Chr(13)+
ObjectToXMLElements_Lang(Components[i],4)+'+Chr(13);
end;
end;
Result:=Result+'+Chr(13)+Chr(13);
End;
End;
end;

xml :

function ObjectToXMLElements_Lang(const aObject:TObject; Space_Inp: integer): String;
var
i : Integer;
s : string;
StringList : TStringList;
Props: TList;
IsLangSet: Boolean;
begin
result := ';
StringList := TStringList.Create;
try
Props := GetPropertyList(aObject.ClassInfo);
try
for i := 0 to Props.Count-1 do
begin
s := GetPropAsString_Lang(AObject, PPropInfo(Props.Items[i]), IsLangSet, Space_Inp+4);
if (IsLangSet) And (UpperCase(PPropInfo(Props.Items[i]).Name) <> UpperCase('Name')) And
(Trim(PPropInfo(Props.Items[i]).Name) <> '') then
StringList.Add(Space(Space_Inp)+'<' + PPropInfo(Props.Items[i]).Name + '>' + s + Space(Space_Inp)+'<' + PPropInfo(Props.Items[i]).Name + '>');
end;
result := StringList.Text;
finally
Props.Free;
end;
finally
StringList.Free;
end;
end;

xml :

function GetPropAsString_Lang(const Instance: TObject; const PropInfo: PPropInfo; Var IsLangSet: Boolean; Space_Inp: Integer): string;
var
ObjectProp : TObject;
Intf: IXMLWorksObject;
begin
if (not Assigned(PropInfo^.PropType^))Or(UpperCase(Trim(PropInfo^.PropType^.Name))='NAME')
then Exit;
result := '';
IsLangSet:=False;
case PropInfo^.PropType^.Kind of
tkString,
tkLString,
tkWString:
Begin
IsLangSet:=True;
if AnsiSameText(PropInfo^.PropType^.Name, 'XMLString') then
result := Trim(GetStrProp(Instance, PropInfo))
else if AnsiSameText(PropInfo^.PropType^.Name, 'XMLMIMEString') then
result := Base64Encode(GetStrProp(Instance, PropInfo))
else begin
result := StrToXML(Trim(GetStrProp(Instance, PropInfo)));
end;
End;
tkInt64: ;
tkSet,
tkInteger: ;
tkFloat: ;
tkVariant: begin
IsLangSet:=True;
if GetVariantProp(Instance, PropInfo)=null
then result := StrToXML('')
else result := VariantToXML(Trim(GetVariantProp(Instance, PropInfo)));
end;
tkChar,
tkWChar: begin
IsLangSet:=True;
result := StrToXML(Chr(GetOrdProp(Instance, PropInfo)));
end;
tkEnumeration: ;
tkClass: begin
end;
tkInterface: begin
IsLangSet:=True;
result := InterfaceToXML(GetIntfProp_Lang(Instance, PropInfo));
end;
end;
end;

, :

function GetIntfProp_Lang(Instance: TObject; PropInfo: PPropInfo): IUnknown;
asm
{ -> EAX Pointer to instance}
{ EDX Pointer to property info }
{ ECX Pointer to result interface }
PUSH ESI
PUSH EDI
MOV EDI,EDX

MOV EDX,[EDI].TPropInfo.Index { pass index in EDX }
CMP EDX,$80000000
JNE @@hasIndex
MOV EDX,ECX { pass value in EDX }
@@hasIndex:
MOV ESI,[EDI].TPropInfo.GetProc
CMP [EDI].TPropInfo.GetProc.Byte[3],$FE
JA @@isField
JB @@isStaticMethod
@@isVirtualMethod:
MOVSX ESI,SI { sign extend slot offset }
ADD ESI,[EAX] { vmt + slot offset}
CALL DWORD PTR [ESI]
MP @@exit
@@isStaticMethod:
CALL ESI
JMP @@exit
@@isField:
AND ESI,$00FFFFFF
ADD EAX, ESI
MOV EDX,[EAX]
MOV EAX, ECX
CALL AssignIntf
@@exit:
POP EDI
POP ESI
end;

function GetIntfProp(Instance: TObject; PropInfo: PPropInfo): IUnknown;
asm
{ -> EAX Pointer to instance}
{ EDX Pointer to property info }
{ ECX Pointer to result interface }
PUSH ESI
PUSH EDI
MOV EDI,EDX
MOV EDX,[EDI].TPropInfo.Index { pass index in EDX }
CMP EDX,$80000000
JNE @@hasIndex
MOV EDX,ECX { pass value in EDX }
@@hasIndex:
MOV ESI,[EDI].TPropInfo.GetProc
CMP [EDI].TPropInfo.GetProc.Byte[3],$FE
JA @@isField
JB @@isStaticMethod
@@isVirtualMethod:
MOVSX ESI,SI { sign extend slot offset }
ADD ESI,[EAX] { vmt + slot offset }
CALL DWORD PTR [ESI]
JMP @@exit
@@isStaticMethod:
CALL ESI

JMP @@exit
@@isField:
AND ESI,$00FFFFFF
ADD EAX, ESI
MOV EDX,[EAX]
MOV EAX, ECX
CALL AssignIntf

@@exit:
POP EDI
POP ESI
end;

xml-

, .

, :

Procedure DecodeSQLLang(SelfInp: TObject;StrInp: String);
Var
PosTmp, PosTmp2: integer;
i: integer;
StrTmp: String;
begin
PosTmp:=0;
if SelfInp is TComponent then
With SelfInp as TComponent Do
Begin
PosTmp:=Pos('ComponentsForm', StrInp);
if PosTmp=0
then StrTmp:=Copy(StrInp,1,Length(StrInp))
else StrTmp:=Copy(StrInp,1,PosTmp-2);
setXMLObject_Lang(SelfInp, StrInp);
for i:=0 to ComponentCount-1 Do
begin
if (Trim(Components[i].Name)<>')And
(not((RusCompare(Components[i].ClassName,'TSaveDBGridEh'))
Or(RusCompare(Components[i].ClassName,'TpFIBTransaction'))
Or(RusCompare(Components[i].ClassName,'TpFIBStoredProc'))
Or(RusCompare(Components[i].ClassName,'TDBEdit'))
Or(RusCompare(Components[i].ClassName,'TDBDateTimeEditEh'))
Or(RusCompare(Components[i].ClassName,'TDBLookupComboboxEh'))
Or(RusCompare(Components[i].ClassName,'TDBComboBoxEh'))
)) then begin
StrTmp:=RFastParseTagXML(StrInp,Components[i].Name);
setXMLObject_Lang(Components[i], StrTmp);
end;
end;
End;
End;

:

function RFastParseTagXML(const Source, Tag: AnsiString{; var Index: Integer}): AnsiString;
var
NestLevel: Integer;
StartTag, StopTag: AnsiString;
StartLen, StopLen, SourceLen: Integer;
StartIndex, StopIndex: Integer;
begin
SourceLen := Length(Source);
StartIndex := 0;
result := '';
if (StartIndex < SourceLen) then
begin
StartTag := '<' + Tag + '>';
StartLen := Length(StartTag);
if StartLen > 2 then
begin
StopTag := ''
StopLen := Length(StopTag);
StartIndex := Pos(StartTag,Source);
StopIndex := Pos(StopTag,Source);
result := Copy(Source, StartIndex+StartLen, StopIndex-StartIndex-StartLen{- 1});
end;
end;
end;

:

procedure setPropAsString_Lang(Instance: TObject; PropInfo: PPropInfo; const value: string);
var
ObjectProp : TObject;
Intf: IXMLWorksObject;
vTemp : variant;
StrTmp: String;
begin
// No property
if (PropInfo = Nil) OR (value = '') or
// a read only simple type
((PropInfo^.SetProc = NIL) and not (PropInfo^.PropType^.Kind in [tkClass, tkInterface]))
then exit;
case PropInfo^.PropType^.Kind of
tkString,
tkLString,
tkWString:
if AnsiSameText(PropInfo^.PropType^.Name, 'XMLString') then
SetStrProp(Instance, PropInfo, Value)
else if AnsiSameText(PropInfo^.PropType^.Name, 'XMLMIMEString') then
SetStrProp(Instance, PropInfo, Base64Decode(Value))
else SetStrProp(Instance, PropInfo, XMLToStr(Value));
tkSet, tkInteger:
if AnsiSameText(PropInfo^.PropType^.Name, 'XMLRGBTColor') then
SetOrdProp(Instance, PropInfo, SwapRandB(StrToInt(XMLToStr(Value))))
else SetOrdProp(Instance, PropInfo, StrToInt(XMLToStr(Value)));
tkFloat: SetFloatProp(Instance, PropInfo, StrToFloat(XMLToStr(Value)));
tkVariant:
begin
vTemp := GetVariantProp(Instance,PropInfo);
XMLToVariant(value,vTemp);
SetVariantProp(Instance, PropInfo, vTemp);
end;
tkInt64: SetInt64Prop(Instance, PropInfo, StrToInt64(XMLToStr(Value)));
tkChar,
tkWChar:
begin
StrTmp:=XMLToStr(Value);
if Length(StrTmp)>0 then
SetOrdProp(Instance, PropInfo, Ord({XMLToStr(Value)}StrTmp[1]));
end;
tkEnumeration: SetOrdProp(Instance, PropInfo, GetEnumValue(PropInfo^.PropType^, XMLToStr(Value)));
tkClass :
begin
try
ObjectProp := TObject(GetOrdProp(Instance, PropInfo));
if Assigned(ObjectProp) then
begin
if ObjectProp.GetInterface(IXMLWorksObject, Intf) then
Intf.ElementText := Value
else if (ObjectProp is TXMLCollection) then
TXMLCollection(ObjectProp).ElementText := Value
else if (ObjectProp is TXMLCollectionItem) then
TXMLCollectionItem(ObjectProp).ElementText := Value
else if (ObjectProp is TXMLObject) then
TXMLObject(ObjectProp).ElementText := Value
else if (ObjectProp is TXMLList) then
TXMLList(ObjectProp).ElementText := Value
else if (ObjectProp is TStrings) then
TStrings(ObjectProp).CommaText := XMLToStr(Value)
end;
except
on e: Exception do
raise EXMLException.Create('(' + e.Message + ')Error with property - ' + PropInfo^.Name);
end;
end;
tkInterface: XMLtoInterface(Value,GetIntfProp(Instance, PropInfo));
{
Types not supported :
tkRecord
tkArray
tkDynArray
tkMethod
tkUnknown
}
end;
end;

:

procedure setXMLObject_Lang(Instance: TObject; p_sXML: AnsiString);
var
CurrentTagIndex, OverAllIndex: Integer;
CurrentTag, CurrentTagContent :string;
begin
try
CurrentTagIndex := 1;
OverallIndex := 1;
repeat
CurrentTag := FastParseTag(p_sXML, '<' , '>', OverallIndex);
CurrentTagContent := FastParseTagXML(p_sXML, CurrentTag, CurrentTagIndex);
if (Length(CurrentTag) > 0) then
SetPropAsString_Lang(Instance, GetPropInfo(Instance.ClassInfo, CurrentTag), CurrentTagContent);
OverAllIndex := CurrentTagIndex;
until (OverAllIndex<1) or (OverAllIndex > Length(p_sXML));
except
on EXMLException do
raise;
on e : Exception do
raise EXMLException.Create('(' + e.Message + ')Error Processing XML - '
+CurrentTag+' ('+CurrentTagContent+') '+iif_Str(Assigned(Instance),Instance.ClassName,'));
end;
end;

.

, :

Function LangPath: String;
Begin
Result:=NormalDir(NormalDir(ExtractFilePath(Application.ExeName))
+'Langs'+User_Sets.LangInterface);
End;

:
User_Sets.LangInterface - . .
NormalDir - . JVCL. .

:

Procedure SaveLangTranslate(ObjInp: TObject{; LangInp: String});
Var
TransTmp: String;
begin
TransTmp:=GenSQLLang(ObjInp);
if not DirectoryExists(LangPath) then
ForceDirectories(LangPath);
SaveStringToFile(TransTmp, LangPath{+Trim(LangInp)}+ObjInp.ClassName+'.xml');
End;

:

Procedure LoadLangTranslate(ObjInp: TObject{; LangInp: String});
Var TransTmp: String;
begin
TransTmp:=LoadStringFromFile(LangPath{+Trim(LangInp)}+ObjInp.ClassName+'.xml');
DecodeSQLLang(ObjInp,TransTmp);
end;

,

. xml. TXMLCollectionItem TXMLCollection.

(TXMLCollectionItem):

TCorp_Const_StringCollectionItem = class(TXMLCollectionItem)
private
FIndexName: String;
FMessString: String;

public
destructor Destroy; Override;
published
property IndexName: String read FIndexName write FIndexName;
property MessString: String read FMessString write FMessString;
end;

(TXMLCollection):

TCorp_Const_StringCollection = class(TXMLCollection)
private
FLangInfo: String;
public
constructor Create;
destructor Destroy; Override;
Function AddNewItem: TCorp_Const_StringCollectionItem;
Procedure AddString(IndexNameInp, MessStringInp: String);
Procedure AddIfNotExist(IndexNameInp, MessStringInp: String);
function GetItemByIndex(index:integer): TCorp_Const_StringCollectionItem;
function GetItemByName(NameInp: String): TCorp_Const_StringCollectionItem;
function GetMessByName(NameInp: String): String;
procedure Assign(Source: TPersistent); override;
published
Property LangInfo: String read FLangInfo write FLangInfo;
End;
...

var Corp_Const_String: TCorp_Const_StringCollection;
...

constructor TCorp_Const_StringCollection.Create;
begin
inherited Create(TCorp_Const_StringCollectionItem);
FLangInfo:='Uk';
end;

destructor TCorp_Const_StringCollection.Destroy;
begin
Clear;
inherited;
end;

function TCorp_Const_StringCollection.AddNewItem: TCorp_Const_StringCollectionItem;
begin
Result:=TCorp_Const_StringCollectionItem.Create(Self);
end;

procedure TCorp_Const_StringCollection.AddString(IndexNameInp, MessStringInp: String);
begin
With AddNewItem Do
Begin
IndexName:=IndexNameInp;
MessString:=MessStringInp;
End;
end;

procedure TCorp_Const_StringCollection.AddIfNotExist(IndexNameInp, MessStringInp: String);
Var ItemTmp: TCorp_Const_StringCollectionItem;
begin
ItemTmp:=GetItemByName(IndexNameInp);
if not Assigned(ItemTmp) then
begin
Corp_Const_String.AddString(IndexNameInp, MessStringInp);
end
else begin
ItemTmp.IndexName:=IndexNameInp;
ItemTmp.MessString:=MessStringInp;
end;
end;

function TCorp_Const_StringCollection.GetItemByIndex(index: integer): TCorp_Const_StringCollectionItem;
begin
result:=TCorp_Const_StringCollectionItem(items[index])
end;

function TCorp_Const_StringCollection.GetItemByName(NameInp: String): TCorp_Const_StringCollectionItem;
var i: integer;
begin
result:=nil;
for i:=0 to Count-1 Do
begin
if RusUpperCase(Trim(GetItemByIndex(i).IndexName))=RusUpperCase(Trim(NameInp))
then result:=GetItemByIndex(i);
end;
end;

function TCorp_Const_StringCollection.GetMessByName(NameInp: String): String;
Var CorpConstTmp: TCorp_Const_StringCollectionItem;
begin
CorpConstTmp:=GetItemByName(NameInp);
if not Assigned(CorpConstTmp)
then Result:='{NameInp}
else Result:=CorpConstTmp.MessString;
end;

procedure TCorp_Const_StringCollection.Assign(Source: TPersistent);
begin
inherited Assign(Source);
end;

:

Procedure Gen_Corp_String;
Begin
if not Assigned(Corp_Const_String)
then Corp_Const_String:=TCorp_Const_StringCollection.Create;
// Corp_Const_String.Clear;
Corp_Const_String.AddIfNotExist('1', '- -');
Corp_Const_String.AddIfNotExist('2', ' !');
Corp_Const_String.AddIfNotExist('3', ' .');
Corp_Const_String.AddIfNotExist('4', '- !');
Corp_Const_String.AddIfNotExist('5', ' !');
...
End;



  »
   »
   
  » : 26.05.2009 
 

   WWW.ITSHOP.RU
Enterprise Connectors (1 Year term)
Delphi Professional Named User
Allround Automation PL/SQL Developer - Annual Service Contract - Single user
TeeGrid VCL/FMX Source Code single license
Zend Guard 1 Year Subscription
 
...
 
   WWW.ITSHOP.RU
 
...
 
   WWW.ITSHOP.RU
 
...
 
3D | 3D    WWW.ITSHOP.RU
 
...
 
 
 Subscribe.ru
: CASE, RAD, ERP, OLAP
ITShop.ru - , , ,
Microsoft Access
CASE-
Oracle " "
Visual ++
 
IT-
 
 
 
 
" - , "
 
 
Download
 
 
 
 



    
rambler's top100 Rambler's Top100