此代码支持 Delphi 2007+，使用 QJSON 做为序列化的支持库。你可以自己改为使用其它的 JSON库（注：此文写法未完善，仅为示意）。 使用示例： 如上面的示例，由于写成了 class helper，所以保存到 Json 里，直接调用组件实例的 SaveToJson 就可以了，而从 Json 中恢复则直接调
标签： DFM
将一个字符串格式化为 Delphi DFM 格式的字符串
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 |
function StrToDFMStr(S: UnicodeString): UnicodeString; var AHelper: TStringBuilder; ps, ls: PWideChar; L: Integer; AQuoterNeeded: Boolean; const LineLength: Integer = 64; begin ps := PWideChar(S); AHelper := TStringBuilder.Create; try L := 0; AHelper.Append(''''); AQuoterNeeded := True; while ps^ <> #0 do begin if AHelper.Length - L > LineLength then begin if AQuoterNeeded then AHelper.Append(''''); AHelper.Append(SLineBreak); L := AHelper.Length; end; if (ps^ >= ' ') and (ps^ <> '''') and (ps^ < #$128) then begin AHelper.Append(ps^); AQuoterNeeded := True; end else begin begin if AQuoterNeeded then AHelper.Append(''''); AHelper.Append('#').Append(Ord(ps^)); AQuoterNeeded := False; end; end; Inc(ps); end; if AQuoterNeeded then AHelper.Append(''''); Result := AHelper.ToString; finally FreeAndNil(AHelper); end; end; |
DFM->JSON 格式转换
应群友的要求，编写了一个解析 DFM 文件格式，将其转换为 JSON 格式的函数，需要引用 QJSON 和 QString 单元。代码分享给大家，供大家参考：
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 |
function DFM2Json(AFileName: String): TQJson; var ADFMStream, ATemp: TMemoryStream; I: Integer; AObjNode: TQJson; const SSpace: PWideChar = ' '#9; SColon: PWideChar = ':'; SNull: WideChar = #0; function IsTextDFM(S: PAnsiChar): Boolean; begin Result := (AnsiStrLComp(S, 'object', 6) = 0) or (AnsiStrLComp(S, 'inherited', 9) = 0); end; procedure DecodeObject(ALine: PWideChar; var AObjName, AObjClass: QStringW); begin SkipUntilW(ALine, SSpace); AObjName := Trim(DecodeTokenW(ALine, SColon, SNull, True)); AObjClass := Trim(ALine); end; function DecodeDFMString(S: QStringW): QStringW; var ps, pd: PWideChar; V: Int64; begin if Length(S) > 0 then begin ps := PWideChar(S); SetLength(Result, Length(S)); pd := PWideChar(Result); while ps^ <> #0 do begin if ps^ = '#' then begin Inc(ps); if ParseInt(ps, V) > 0 then begin pd^ := WideChar(V); Inc(pd); end; end else if ps^ = '''' then begin Inc(ps); while ps^ <> '''' do begin pd^ := ps^; Inc(pd); Inc(ps); end; Inc(ps); end else begin break; end; end; SetLength(Result, pd - PWideChar(Result)); end else Result := ''; end; procedure DecodePropAndChildren(AParent: TQJson; var ps: PWideChar; AIsCollection: Boolean); var ALine, AName, AValue: QStringW; pl, pv: PWideChar; ATemp: TQJson; ACharset: Longint; AProps: TQJson; AChildren: TQJson; const SObject: PWideChar = 'object'; SInline: PWideChar = 'inline'; SEnd: PWideChar = 'end'; SEqual: PWideChar = '='; SNull: WideChar = #0; SItem: PWideChar = 'item'; SBracket: PWideChar = ')'; begin AProps := AParent; AChildren := nil; repeat ALine := DecodeLineW(ps); pl := PWideChar(ALine); SkipSpaceW(pl); SkipSpaceW(ps); if StartWithW(pl, SObject, True) or StartWithW(pl, SInline, True) then begin DecodeObject(pl, AName, AValue); DecodePropAndChildren(AParent.Add(AName, jdtObject), ps, False); end else if StartWithW(pl, SEnd, True) then Exit else // Property line begin AName := Trim(DecodeTokenW(pl, SEqual, SNull, True)); AValue := Trim(pl); pv := PWideChar(AValue); if (pv^ = '''') or (pv^ = '#') then begin AProps.ForcePath(AName).AsString := DecodeDFMString(AValue); end else if pv^ = '<' then begin Inc(pv); SkipSpaceW(pv); if pv^ <> '>' then begin ATemp := TQJson.Create; ATemp.DataType := jdtArray; try SkipSpaceW(ps); while StartWithW(ps, SItem, True) do begin SkipLineW(ps); DecodePropAndChildren(ATemp.Add, ps, True); end; SkipSpaceW(ps); if ps^ = '>' then SkipLineW(ps); finally if ATemp.Count > 0 then AProps.Add(AName).Assign(ATemp); FreeObject(ATemp); end; end; end else if pv^ = '(' then // Strings begin AValue := ''; while ps^ <> #0 do begin ALine := Trim(DecodeLineW(ps)); if Length(AValue) > 0 then AValue := AValue + SLineBreak + DecodeDFMString(ALine) else AValue := DecodeDFMString(ALine); if (ps^ = ')') or EndWithW(ALine, SBracket, True) then break; end; SkipSpaceW(ps); if ps^ = ')' then SkipLineW(ps); SkipSpaceW(ps); if Length(AValue) > 0 then AProps.ForcePath(AName).AsString := AValue; end else AProps.ForcePath(AName).Value := AValue; end; until Length(ALine) = 0; end; procedure DoConvert(AText: QStringW); var p: PWideChar; AObjectName, ARootClass: QStringW; const SObject: PWideChar = 'object '; SInherited: PWideChar = 'inherited '; begin if Length(AText) > 0 then begin p := PWideChar(AText); if StartWithW(p, SObject, True) or StartWithW(p, SInherited, True) then begin Result := TQJson.Create; try DecodeObject(PWideChar(DecodeLineW(p)), AObjectName, ARootClass); DecodePropAndChildren(Result.Add(ARootClass, jdtObject), p, False); finally if Result.Count = 0 then FreeAndNil(Result); end; end; end; end; begin ADFMStream := TMemoryStream.Create; try ADFMStream.LoadFromFile(AFileName); if PCardinal(ADFMStream.Memory)^ = $30465054 then begin ATemp := TMemoryStream.Create; ATemp.CopyFrom(ADFMStream, 0); ATemp.Position := 0; ADFMStream.Size := 0; ObjectBinaryToText(ATemp, ADFMStream); FreeAndNil(ATemp); ADFMStream.Position := 0; DoConvert(LoadTextW(ADFMStream)); end else if IsTextDFM(ADFMStream.Memory) then DoConvert(LoadTextW(ADFMStream)); finally FreeObject(ADFMStream); end; end; |
用法：
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
procedure TForm1.Button1Click(Sender: TObject); var AJson: TQJson; begin if OpenDialog1.Execute then begin AJson := DFM2Json(OpenDialog1.FileName); if AJson <> nil then begin Memo1.Lines.Text := AJson.AsString; FreeAndNil(AJson); end; end; end; |
一个转换结果示例：