Changeset 173
- Timestamp:
- Jun 15, 2024, 11:02:39 AM (6 months ago)
- Location:
- trunk
- Files:
-
- 4 added
- 23 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/FormContact.pas
r165 r173 259 259 260 260 uses 261 Core, Common, FormImage, FormNameDetails, DataFile ;261 Core, Common, FormImage, FormNameDetails, DataFile, NameDetails; 262 262 263 263 resourcestring -
trunk/Languages/vCardStudio.cs.po
r168 r173 1009 1009 1010 1010 #: tformfindduplicity.buttonmerge.caption 1011 msgctxt "tformfindduplicity.buttonmerge.caption" 1011 1012 msgid "Merge" 1012 1013 msgstr "Sloučit" … … 1155 1156 msgstr "Zobrazení" 1156 1157 1158 #: tformmerge.buttoncancel.caption 1159 #, fuzzy 1160 msgctxt "tformmerge.buttoncancel.caption" 1161 msgid "Cancel" 1162 msgstr "Zrušit" 1163 1164 #: tformmerge.buttonok.caption 1165 #, fuzzy 1166 msgctxt "tformmerge.buttonok.caption" 1167 msgid "OK" 1168 msgstr "OK" 1169 1170 #: tformmerge.caption 1171 #, fuzzy 1172 msgctxt "tformmerge.caption" 1173 msgid "Merge" 1174 msgstr "Sloučit" 1175 1176 #: tformmerge.listview1.columns[0].caption 1177 msgid "Id" 1178 msgstr "" 1179 1180 #: tformmerge.listview1.columns[1].caption 1181 msgid "File name" 1182 msgstr "" 1183 1157 1184 #: tformnamedetails.buttoncancel.caption 1158 1185 msgctxt "tformnamedetails.buttoncancel.caption" -
trunk/Languages/vCardStudio.pot
r168 r173 999 999 1000 1000 #: tformfindduplicity.buttonmerge.caption 1001 msgctxt "tformfindduplicity.buttonmerge.caption" 1001 1002 msgid "Merge" 1002 1003 msgstr "" … … 1145 1146 msgstr "" 1146 1147 1148 #: tformmerge.buttoncancel.caption 1149 msgctxt "tformmerge.buttoncancel.caption" 1150 msgid "Cancel" 1151 msgstr "" 1152 1153 #: tformmerge.buttonok.caption 1154 msgctxt "tformmerge.buttonok.caption" 1155 msgid "OK" 1156 msgstr "" 1157 1158 #: tformmerge.caption 1159 msgctxt "tformmerge.caption" 1160 msgid "Merge" 1161 msgstr "" 1162 1163 #: tformmerge.listview1.columns[0].caption 1164 msgid "Id" 1165 msgstr "" 1166 1167 #: tformmerge.listview1.columns[1].caption 1168 msgid "File name" 1169 msgstr "" 1170 1147 1171 #: tformnamedetails.buttoncancel.caption 1148 1172 msgctxt "tformnamedetails.buttoncancel.caption" -
trunk/Languages/vCardStudio.sv.po
r168 r173 1017 1017 1018 1018 #: tformfindduplicity.buttonmerge.caption 1019 msgctxt "tformfindduplicity.buttonmerge.caption" 1019 1020 msgid "Merge" 1020 1021 msgstr "" … … 1166 1167 msgstr "Vy" 1167 1168 1169 #: tformmerge.buttoncancel.caption 1170 #, fuzzy 1171 msgctxt "tformmerge.buttoncancel.caption" 1172 msgid "Cancel" 1173 msgstr "Avbryt" 1174 1175 #: tformmerge.buttonok.caption 1176 #, fuzzy 1177 msgctxt "tformmerge.buttonok.caption" 1178 msgid "OK" 1179 msgstr "Ok" 1180 1181 #: tformmerge.caption 1182 msgctxt "tformmerge.caption" 1183 msgid "Merge" 1184 msgstr "" 1185 1186 #: tformmerge.listview1.columns[0].caption 1187 msgid "Id" 1188 msgstr "" 1189 1190 #: tformmerge.listview1.columns[1].caption 1191 msgid "File name" 1192 msgstr "" 1193 1168 1194 #: tformnamedetails.buttoncancel.caption 1169 1195 msgctxt "tformnamedetails.buttoncancel.caption" -
trunk/Packages/Common/Common.pas
r164 r173 53 53 function ComputerName: string; 54 54 procedure DeleteFiles(APath, AFileSpec: string); 55 function EndsWith(Text, What: string): Boolean; 55 56 function Explode(Separator: Char; Data: string): TStringArray; 56 57 procedure ExecuteProgram(Executable: string; Parameters: array of string); … … 87 88 procedure SearchFiles(AList: TStrings; Dir: string; 88 89 FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil); 90 procedure SortStrings(Strings: TStrings); 89 91 function SplitString(var Text: string; Count: Word): string; 90 92 function StripTags(const S: string): string; 93 function StartsWith(Text, What: string): Boolean; 91 94 function TryHexToInt(Data: string; out Value: Integer): Boolean; 92 95 function TryBinToInt(Data: string; out Value: Integer): Boolean; 93 procedure SortStrings(Strings: TStrings);94 96 95 97 96 98 implementation 99 100 function StartsWith(Text, What: string): Boolean; 101 begin 102 Result := Copy(Text, 1, Length(Text)) = What; 103 end; 104 105 function EndsWith(Text, What: string): Boolean; 106 begin 107 Result := Copy(Text, Length(Text) - Length(What) + 1, MaxInt) = What; 108 end; 97 109 98 110 function BinToInt(BinStr : string) : Int64; -
trunk/Packages/Common/Languages/DataFile.cs.po
r172 r173 21 21 msgid "Data file" 22 22 msgstr "Datový soubor" 23 -
trunk/Packages/Common/Languages/DebugLog.cs.po
r172 r173 16 16 msgid "Filename not defined" 17 17 msgstr "Neurčen soubor" 18 -
trunk/Packages/Common/Languages/FindFile.cs.po
r172 r173 16 16 msgid "Directory not found" 17 17 msgstr "Adresář nenalezen" 18 -
trunk/Packages/Common/Languages/FormAbout.cs.po
r172 r173 27 27 msgstr "Verze" 28 28 29 #: tformabout.caption30 msgid "About"31 msgstr "O aplikaci" -
trunk/Packages/Common/Languages/FormAbout.pot
r172 r173 14 14 msgstr "" 15 15 16 #: tformabout.caption17 msgid "About"18 msgstr ""19 -
trunk/Packages/Common/Languages/JobProgressView.cs.po
r172 r173 43 43 msgid "Total estimated time: %s" 44 44 msgstr "Celkový odhadovaný čas: %s" 45 -
trunk/Packages/Common/Languages/Languages.cs.po
r172 r173 977 977 msgstr "Čínština" 978 978 979 #: languages.slang_zh_hans 980 msgid "Simplified Chinese" 981 msgstr "" 982 983 #: languages.slang_zh_hant 984 msgid "Traditional Chinese" 985 msgstr "" 986 979 987 #: languages.slang_zu 980 988 msgctxt "languages.slang_zu" 981 989 msgid "Zulu" 982 990 msgstr "Zuluština" 991 -
trunk/Packages/Common/Languages/Languages.pot
r148 r173 776 776 msgstr "" 777 777 778 #: languages.slang_zh_hans 779 msgid "Simplified Chinese" 780 msgstr "" 781 782 #: languages.slang_zh_hant 783 msgid "Traditional Chinese" 784 msgstr "" 785 778 786 #: languages.slang_zu 779 787 msgid "Zulu" -
trunk/Packages/Common/Languages/Pool.cs.po
r172 r173 21 21 msgid "Unknown object for release from pool" 22 22 msgstr "Neznýmý objekt pro uvolnění ze zásobníku" 23 -
trunk/Packages/Common/Languages/ResetableThread.cs.po
r172 r173 16 16 msgid "WaitFor error" 17 17 msgstr "Chyba WaitFor" 18 -
trunk/Packages/Common/Languages/ScaleDPI.cs.po
r172 r173 17 17 msgid "Wrong DPI [%d,%d]" 18 18 msgstr "Chybné DPI [%d,%d]" 19 -
trunk/Packages/Common/Languages/TestCase.cs.po
r172 r173 26 26 msgid "Passed" 27 27 msgstr "Prošlo" 28 -
trunk/Packages/Common/Languages/Threading.cs.po
r172 r173 17 17 msgid "Current thread ID %d not found in virtual thread list." 18 18 msgstr "Aktuální vlákno ID %d nenalezeno v seznamu virtuálních vláken." 19 -
trunk/Packages/VCard/VCard.lpk
r152 r173 61 61 <UnitName Value="VCardProcessor"/> 62 62 </Item> 63 <Item> 64 <Filename Value="NameDetails.pas"/> 65 <UnitName Value="NameDetails"/> 66 </Item> 63 67 </Files> 64 68 <i18n> -
trunk/Packages/VCard/VCard.pas
r170 r173 8 8 9 9 type 10 TNamePartKind = (npNone, npPrefix, npFirst, npMiddle, npLast, npSuffix);11 12 TNamePart = record13 Index: Integer;14 Text: string;15 PartKind: TNamePartKind;16 NamePart: ^TNamePart;17 Previous: ^TNamePart;18 Next: ^TNamePart;19 end;20 21 TNameParts = array of TNamePart;22 23 { TNameDetails }24 25 TNameDetails = class26 private27 function GetAsNameParts: TNameParts;28 function GetDetail(NamePartKind: TNamePartKind): string;29 function IsSuffix(Text: string): Boolean;30 public31 Prefix: string;32 First: string;33 Middle: string;34 Last: string;35 Suffix: string;36 procedure Split(FullName: string);37 function GetCombined: string;38 end;39 40 10 TErrorEvent = procedure (Text: string; Line: Integer) of object; 41 11 … … 394 364 end; 395 365 396 function StartsWith(Text, What: string): Boolean;397 begin398 Result := Copy(Text, 1, Length(Text)) = What;399 end;400 401 function EndsWith(Text, What: string): Boolean;402 begin403 Result := Copy(Text, Length(Text) - Length(What) + 1, MaxInt) = What;404 end;405 406 366 function EncodeEscaped(Text: string): string; 407 367 var … … 479 439 end; 480 440 481 { TNameDetails }482 483 function IsNumber(Text: string): Boolean;484 var485 Value: Integer;486 begin487 Result := TryStrToInt(Text, Value);488 end;489 490 function IsRomanNumber(Text: string): Boolean;491 var492 I: Integer;493 begin494 Result := True;495 for I := 1 to Length(Text) do496 if not (Text[I] in ['I', 'V', 'X', 'L', 'C', 'D', 'M']) then begin497 Result := False;498 Break;499 end;500 end;501 502 procedure SearchPart(var NameParts: TNameParts; var NamePart: TNamePart);503 var504 I: Integer;505 begin506 for I := 0 to Length(NameParts) - 1 do begin507 if (NameParts[I].PartKind = npNone) and (NameParts[I].Text = NamePart.Text) then begin508 NameParts[I].PartKind := NamePart.PartKind;509 NameParts[I].NamePart := @NamePart;510 NamePart.NamePart := @NameParts[I];511 Break;512 end;513 end;514 end;515 516 procedure SearchPartBackward(var NameParts: TNameParts; var NamePart: TNamePart);517 var518 I: Integer;519 begin520 for I := Length(NameParts) - 1 downto 0 do begin521 if (NameParts[I].PartKind = npNone) and (NameParts[I].Text = NamePart.Text) then begin522 NameParts[I].PartKind := NamePart.PartKind;523 NameParts[I].NamePart := @NamePart;524 NamePart.NamePart := @NameParts[I];525 Break;526 end;527 end;528 end;529 530 function UsedInNameParts(NamePart: TNamePartKind; NameParts: TNameParts): Boolean;531 var532 I: Integer;533 begin534 I := 0;535 while (I < Length(NameParts)) and (NameParts[I].PartKind <> NamePart) do Inc(I);536 Result := I < Length(NameParts);537 end;538 539 441 { TVCard } 540 442 … … 795 697 FreeAndNil(Contacts); 796 698 inherited; 797 end;798 799 function TNameDetails.GetAsNameParts: TNameParts;800 var801 I: Integer;802 K: TNamePartKind;803 Parts: TStringArray;804 begin805 Result := Default(TNameParts);806 for K := Low(TNamePartKind) to High(TNamePartKind) do begin807 if GetDetail(K) <> '' then begin808 Parts := Explode(' ', GetDetail(K));809 for I := 0 to Length(Parts) - 1 do begin810 SetLength(Result, Length(Result) + 1);811 Result[Length(Result) - 1].Text := Parts[I];812 Result[Length(Result) - 1].PartKind := K;813 Result[Length(Result) - 1].Index := Length(Result) - 1;814 end;815 end;816 end;817 818 // Update previous and next links819 for I := 0 to Length(Result) - 1 do begin820 if I > 0 then821 Result[I].Previous := @Result[I - 1];822 if (I + 1) < Length(Result) then823 Result[I].Next := @Result[I + 1];824 end;825 end;826 827 function TNameDetails.GetDetail(NamePartKind: TNamePartKind): string;828 begin829 case NamePartKind of830 npPrefix: Result := Prefix;831 npFirst: Result := First;832 npMiddle: Result := Middle;833 npLast: Result := Last;834 npSuffix: Result := Suffix;835 end;836 end;837 838 function TNameDetails.IsSuffix(Text: string): Boolean;839 begin840 Result := (Pos('.', Text) > 0) or IsNumber(Text) or841 IsRomanNumber(Text);842 end;843 844 procedure TNameDetails.Split(FullName: string);845 var846 Parts: TStringArray;847 NewNameParts: TNameParts;848 OldNameParts: TNameParts;849 I: Integer;850 J: Integer;851 Text: string;852 NextKind: TNamePartKind;853 begin854 OldNameParts := GetAsNameParts;855 856 Text := FullName;857 while Pos(' ', FullName) > 0 do858 FullName := StringReplace(FullName, ' ', ' ', [rfReplaceAll]);859 Text := Trim(Text);860 861 Parts := Explode(' ', Text);862 NewNameParts := Default(TNameParts);863 SetLength(NewNameParts, Length(Parts));864 for I := 0 to Length(NewNameParts) - 1 do begin865 NewNameParts[I].Index := I;866 NewNameParts[I].PartKind := npNone;867 NewNameParts[I].Text := Parts[I];868 if I > 0 then869 NewNameParts[I].Previous := @NewNameParts[I - 1];870 if (I + 1) < Length(NewNameParts) then871 NewNameParts[I].Next := @NewNameParts[I + 1];872 end;873 874 // Match existing parts875 for I := 0 to Length(OldNameParts) - 1 do begin876 if OldNameParts[I].Text <> '' then877 SearchPart(NewNameParts, OldNameParts[I]);878 end;879 880 // Check incorrect matches881 for I := 0 to Length(OldNameParts) - 1 do begin882 for J := I + 1 to Length(OldNameParts) - 1 do883 if Assigned(OldNameParts[I].NamePart) and Assigned(OldNameParts[J].NamePart) and884 (OldNameParts[I].NamePart^.Index >= OldNameParts[J].NamePart^.Index) then begin885 if Abs(I - OldNameParts[I].NamePart^.Index) >886 Abs(J - OldNameParts[J].NamePart^.Index) then begin887 OldNameParts[I].NamePart^.PartKind := npNone;888 OldNameParts[I].NamePart^.NamePart := nil;889 OldNameParts[I].NamePart := nil;890 end else begin891 OldNameParts[J].NamePart^.PartKind := npNone;892 OldNameParts[J].NamePart^.NamePart := nil;893 OldNameParts[J].NamePart := nil;894 end;895 end;896 end;897 for I := Length(OldNameParts) - 1 downto 0 do begin898 for J := I - 1 downto 0 do899 if Assigned(OldNameParts[I].NamePart) and Assigned(OldNameParts[J].NamePart) and900 (OldNameParts[I].NamePart^.Index <= OldNameParts[J].NamePart^.Index) then begin901 if Abs(I - OldNameParts[I].NamePart^.Index) >902 Abs(J - OldNameParts[J].NamePart^.Index) then begin903 OldNameParts[I].NamePart^.PartKind := npNone;904 OldNameParts[I].NamePart^.NamePart := nil;905 OldNameParts[I].NamePart := nil;906 end else begin907 OldNameParts[J].NamePart^.PartKind := npNone;908 OldNameParts[J].NamePart^.NamePart := nil;909 OldNameParts[J].NamePart := nil;910 end;911 end;912 end;913 914 // Match existing parts backqards915 for I := Length(OldNameParts) - 1 downto 0 do begin916 if (OldNameParts[I].Text <> '') and not Assigned(OldNameParts[I].NamePart) then917 SearchPartBackward(NewNameParts, OldNameParts[I]);918 end;919 920 // Match uncertain parts921 for I := 0 to Length(OldNameParts) - 1 do922 if not Assigned(OldNameParts[I].NamePart) then begin923 if Assigned(OldNameParts[I].Next) and924 Assigned(OldNameParts[I].Next^.NamePart) and925 Assigned(OldNameParts[I].Next^.NamePart^.Previous) and926 (OldNameParts[I].Next^.NamePart^.Previous^.PartKind = npNone) then begin927 OldNameParts[I].NamePart := OldNameParts[I].Next^.NamePart^.Previous;928 OldNameParts[I].Next^.NamePart^.Previous^.NamePart := @OldNameParts[I];929 OldNameParts[I].Next^.NamePart^.Previous^.PartKind := OldNameParts[I].PartKind;930 end else931 if Assigned(OldNameParts[I].Previous) and932 Assigned(OldNameParts[I].Previous^.NamePart) and933 Assigned(OldNameParts[I].Previous^.NamePart^.Next) and934 (OldNameParts[I].Previous^.NamePart^.Next^.PartKind = npNone) then begin935 OldNameParts[I].NamePart := OldNameParts[I].Previous^.NamePart^.Next;936 OldNameParts[I].Previous^.NamePart^.Next^.NamePart := @OldNameParts[I];937 OldNameParts[I].Previous^.NamePart^.Next^.PartKind := OldNameParts[I].PartKind;938 end;939 end;940 941 // Mark new unknown parts according existing parts942 for I := Length(Parts) - 1 downto 0 do943 if (NewNameParts[I].PartKind = npNone) and944 Assigned(NewNameParts[I].Next) and945 (NewNameParts[I].Next^.PartKind <> npNone) then begin946 if (NewNameParts[I].Next^.PartKind = npFirst) and947 EndsWith(NewNameParts[I].Text, '.') then begin948 NewNameParts[I].PartKind := npPrefix;949 end else NewNameParts[I].PartKind := NewNameParts[I].Next^.PartKind;950 end;951 952 // Mark unknown parts according to neighbouring parts953 for I := 0 to Length(Parts) - 1 do954 if (NewNameParts[I].PartKind = npNone) and955 Assigned(NewNameParts[I].Previous) and956 (NewNameParts[I].Previous^.PartKind <> npNone) then begin957 if (NewNameParts[I].Previous^.PartKind in [npLast, npMiddle]) and958 IsSuffix(NewNameParts[I].Text) then begin959 NewNameParts[I].PartKind := npSuffix;960 end else961 if (NewNameParts[I].Previous^.PartKind = npFirst) and962 (Last = '') then begin963 NewNameParts[I].PartKind := npLast;964 end else965 if (NewNameParts[I].Previous^.PartKind = npLast) and966 (Middle = '') then begin967 NewNameParts[I].PartKind := npLast;968 NewNameParts[I].Previous^.PartKind := npMiddle;969 end else970 if (NewNameParts[I].Previous^.PartKind = npPrefix) then begin971 NewNameParts[I].PartKind := npFirst;972 end else973 NewNameParts[I].PartKind := NewNameParts[I].Previous^.PartKind;974 end;975 976 // Mark remaining unknown parts based on defined filling sequence977 NextKind := npFirst;978 for I := 0 to Length(Parts) - 1 do979 if NewNameParts[I].PartKind = npNone then begin980 if EndsWith(NewNameParts[I].Text, '.') and (NextKind = npFirst) then begin981 NewNameParts[I].PartKind := npPrefix;982 end else983 if (NextKind = npMiddle) and IsSuffix(NewNameParts[I].Text) then begin984 NewNameParts[I].PartKind := npSuffix;985 NextKind := npSuffix;986 end else987 if NextKind = npMiddle then begin988 NewNameParts[I].Previous^.PartKind := npMiddle;989 NewNameParts[I].PartKind := npLast;990 end else begin991 NewNameParts[I].PartKind := NextKind;992 if NextKind = npFirst then NextKind := npLast993 else if NextKind = npLast then NextKind := npMiddle;994 end;995 end;996 997 // Combine multiple parts to base parts998 Prefix := '';999 First := '';1000 Middle := '';1001 Last := '';1002 Suffix := '';1003 for I := 0 to Length(Parts) - 1 do1004 case NewNameParts[I].PartKind of1005 npPrefix: Prefix := Trim(Prefix + ' ' + Parts[I]);1006 npFirst: First := Trim(First + ' ' + Parts[I]);1007 npMiddle: Middle := Trim(Middle + ' ' + Parts[I]);1008 npLast: Last := Trim(Last + ' ' + Parts[I]);1009 npSuffix: Suffix := Trim(Suffix + ' ' + Parts[I]);1010 end;1011 1012 {1013 // Title Prefix1014 while (Length(Parts) > 0) and EndsWith(Parts[0], '.') do begin1015 Prefix := Trim(Prefix + ' ' + Parts[0]);1016 Delete(Parts, 0, 1);1017 end;1018 1019 // Title Suffix1020 if ProcessAfter then1021 for I := 0 to High(Parts) do1022 if (Pos('.', Parts[I]) > 0) or IsNumber(Parts[I]) or IsRomanNumber(Parts[I]) then begin1023 for J := I to High(Parts) do1024 Suffix := Trim(Suffix + ' ' + Parts[J]);1025 SetLength(Parts, I);1026 Break;1027 end;1028 1029 if Length(Parts) = 0 then begin1030 end else1031 if Length(Parts) = 1 then begin1032 First := Parts[0];1033 end else1034 if Length(Parts) = 2 then begin1035 First := Parts[0];1036 Last := Parts[1];1037 end else begin1038 First := Parts[0];1039 for I := 0 to Length(Parts) - 3 do1040 Middle := Trim(Middle + ' ' + Parts[I + 1]);1041 Last := Parts[High(Parts)];1042 end;}1043 end;1044 1045 function TNameDetails.GetCombined: string;1046 begin1047 Result := '';1048 if Prefix <> '' then Result := Result + ' ' + Prefix;1049 if First <> '' then Result := Result + ' ' + First;1050 if Middle <> '' then Result := Result + ' ' + Middle;1051 if Last <> '' then Result := Result + ' ' + Last;1052 if Suffix <> '' then Result := Result + ' ' + Suffix;1053 Result := Trim(Result);1054 699 end; 1055 700 -
trunk/Packages/VCard/VCardPackage.pas
r152 r173 9 9 10 10 uses 11 VCard, QuotedPrintable, ContactImage, VCardProcessor, LazarusPackageIntf; 11 VCard, QuotedPrintable, ContactImage, VCardProcessor, NameDetails, 12 LazarusPackageIntf; 12 13 13 14 implementation -
trunk/vCardStudio.lpi
r167 r173 123 123 </Item7> 124 124 </RequiredPackages> 125 <Units Count="2 6">125 <Units Count="27"> 126 126 <Unit0> 127 127 <Filename Value="vCardStudio.lpr"/> … … 288 288 <ResourceBaseClass Value="Form"/> 289 289 </Unit25> 290 <Unit26> 291 <Filename Value="Forms\FormMerge.pas"/> 292 <IsPartOfProject Value="True"/> 293 <ComponentName Value="FormMerge"/> 294 <HasResources Value="True"/> 295 <ResourceBaseClass Value="Form"/> 296 </Unit26> 290 297 </Units> 291 298 </ProjectOptions> -
trunk/vCardStudio.lpr
r167 r173 7 7 Interfaces, // this includes the LCL widgetset 8 8 Forms, FormMain, Core, Diff, SysUtils, FormCompareSideBySide, TestCases, 9 VCardFile, FormColumns, FormCompare, FormNormalize, FormExport, FormImport; 9 VCardFile, FormColumns, FormCompare, FormNormalize, FormExport, FormImport, 10 FormMerge; 10 11 11 12 {$R *.res}
Note:
See TracChangeset
for help on using the changeset viewer.