Changeset 108 for trunk


Ignore:
Timestamp:
Feb 11, 2022, 11:31:42 AM (3 years ago)
Author:
chronos
Message:
  • Fixed: Do not update interface in contact properties if the listview doesn't have handle yet.
  • Added: Synced update of full name and name parts in contact form.
  • Modified: Improved image loading code by image format.
Location:
trunk
Files:
10 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormContact.lfm

    r103 r108  
    4343        Top = 75
    4444        Width = 161
     45        OnChange = NamePartChange
    4546        ParentFont = False
    4647        TabOrder = 1
    … …  
    9596      end
    9697      object EditLastName: TEdit
    97         Left = 699
     98        Left = 700
    9899        Height = 43
    99100        Top = 75
    100101        Width = 161
     102        OnChange = NamePartChange
    101103        ParentFont = False
    102104        TabOrder = 2
    … …  
    167169        Top = 125
    168170        Width = 161
     171        OnChange = NamePartChange
    169172        ParentFont = False
    170173        TabOrder = 4
    … …  
    179182      end
    180183      object EditTitleBefore: TEdit
    181         Left = 375
     184        Left = 376
    182185        Height = 43
    183186        Top = 175
    184187        Width = 161
     188        OnChange = NamePartChange
    185189        ParentFont = False
    186190        TabOrder = 5
    … …  
    199203        Top = 175
    200204        Width = 161
     205        OnChange = NamePartChange
    201206        ParentFont = False
    202207        TabOrder = 6
    … …  
    699704        Width = 920
    700705        Caption = 'Address'
    701         ClientHeight = 255
     706        ClientHeight = 281
    702707        ClientWidth = 918
    703708        TabOrder = 9

  • trunk/Forms/UFormContact.pas

    r104 r108  
    205205    procedure ButtonWorkAddressShowClick(Sender: TObject);
    206206    procedure EditFullNameChange(Sender: TObject);
     207    procedure NamePartChange(Sender: TObject);
    207208    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    208209    procedure FormCreate(Sender: TObject);
    … …  
    315316  {$ENDIF}
    316317  Core.PersistentForm1.Load(Self);
    317 
    318   FormProperties.ManualDock(TabSheetAll, nil, alClient);
    319   FormProperties.Align := alClient;
    320   FormProperties.Show;
    321 
    322318  PhotoChange(nil);
    323319
    324   PageControlContact.TabIndex := Core.LastContactTabIndex;
    325   UpdateInterface;
     320  FormProperties.BeginUpdate;
     321  try
     322
     323    FormProperties.ManualDock(TabSheetAll, nil, alClient);
     324    FormProperties.Align := alClient;
     325    FormProperties.Show;
     326
     327    PageControlContact.TabIndex := Core.LastContactTabIndex;
     328    UpdateInterface;
     329  finally
     330    FormProperties.EndUpdate;
     331  end;
    326332end;
    327333
    … …  
    385391procedure TFormContact.TabSheetAllShow(Sender: TObject);
    386392begin
    387   FormProperties.Properties := Contact.Properties;
    388   FormProperties.ReloadList;
    389   FormProperties.UpdateInterface;
     393  FormProperties.BeginUpdate;
     394  try
     395    FormProperties.Properties := Contact.Properties;
     396    FormProperties.ReloadList;
     397    FormProperties.UpdateInterface;
     398    FormProperties.Show;
     399  finally
     400    FormProperties.EndUpdate;
     401  end;
    390402end;
    391403
    … …  
    709721end;
    710722
     723procedure UpdateEditNoOnChange(Edit: TEdit; Text: string);
     724var
     725  LastHandler: TNotifyEvent;
     726begin
     727  LastHandler := Edit.OnChange;
     728  Edit.OnChange := nil;
     729  try
     730    Edit.Text := Text;
     731  finally
     732    Edit.OnChange := LastHandler;
     733  end;
     734end;
     735
    711736procedure TFormContact.EditFullNameChange(Sender: TObject);
    712 begin
     737var
     738
     739  Before, First, Middle, Last, After: string;
     740begin
     741  Contact.FullNameToNameParts(EditFullName.Text, Before, First, Middle, Last, After);
     742  UpdateEditNoOnChange(EditTitleBefore, Before);
     743  UpdateEditNoOnChange(EditFirstName, First);
     744  UpdateEditNoOnChange(EditMiddleName, Middle);
     745  UpdateEditNoOnChange(EditLastName, Last);
     746  UpdateEditNoOnChange(EditTitleAfter, After);
    713747  UpdateInterface;
     748end;
     749
     750procedure TFormContact.NamePartChange(Sender: TObject);
     751begin
     752  UpdateEditNoOnChange(EditFullName, Contact.NamePartsToFullName(EditTitleBefore.Text,
     753    EditFirstName.Text, EditMiddleName.Text, EditLastName.Text, EditTitleAfter.Text));
    714754end;
    715755
    … …  
    732772
    733773procedure TFormContact.UpdateInterface;
    734 begin
    735   Caption := EditFullName.Text + ' - ' + SContact;
     774var
     775  Title: string;
     776begin
     777  Title := SContact;
     778  if EditFullName.Text <> '' then Title := EditFullName.Text + ' - ' + Title
     779  else
     780  if EditOrganization.Text <> '' then Title := EditOrganization.Text + ' - ' + Title;
     781  Caption := Title;
    736782  APhotoSave.Enabled := FPhoto.Used;
    737783  APhotoClear.Enabled := FPhoto.Used;

  • trunk/Forms/UFormContacts.pas

    r104 r108  
    260260  Selected: Boolean;
    261261begin
     262  if not ListView1.HandleAllocated then Exit;
     263
    262264  Selected := Assigned(ListView1.Selected);
    263265  AAdd.Enabled := Assigned(Contacts);

  • trunk/Forms/UFormMain.lfm

    r90 r108  
    11object FormMain: TFormMain
    2   Left = 601
     2  Left = 553
    33  Height = 829
    4   Top = 447
     4  Top = 401
    55  Width = 1227
    66  Caption = 'vCard Studio'

  • trunk/Forms/UFormProperties.pas

    r104 r108  
    6565  private
    6666    FProperties: TContactProperties;
     67    FUpdateCount: Integer;
    6768    procedure FilterList(List: TFPGObjectList<TObject>);
    6869    procedure SetProperties(AValue: TContactProperties);
     70    procedure DoUpdateInterface;
    6971  public
    7072    property Properties: TContactProperties read FProperties write SetProperties;
    7173    procedure ReloadList;
     74    procedure BeginUpdate;
     75    procedure EndUpdate;
    7276    procedure UpdateInterface;
    7377  end;
    … …  
    9397  STextFiles = 'Text files';
    9498  SValue = 'Value';
     99  SEndUpdateTooLow = 'Update counter error';
    95100
    96101const
    … …  
    365370end;
    366371
    367 procedure TFormProperties.UpdateInterface;
     372procedure TFormProperties.BeginUpdate;
     373begin
     374  Inc(FUpdateCount);
     375end;
     376
     377procedure TFormProperties.EndUpdate;
     378begin
     379  if FUpdateCount <= 0 then raise Exception(SEndUpdateTooLow);
     380  Dec(FUpdateCount);
     381  if FUpdateCount = 0 then DoUpdateInterface;
     382end;
     383
     384procedure TFormProperties.DoUpdateInterface;
    368385var
    369386  Text: string;
    … …  
    371388  Selected: Boolean;
    372389begin
     390  if not ListView1.HandleAllocated then Exit;
     391
    373392  Selected := Assigned(ListView1.Selected);
    374393  AAdd.Enabled := Assigned(Properties);
    … …  
    392411end;
    393412
     413procedure TFormProperties.UpdateInterface;
     414begin
     415  if FUpdateCount = 0 then DoUpdateInterface;
     416end;
     417
    394418end.
    395419

  • trunk/Languages/vCardStudio.cs.po

    r104 r108  
    13791379
    13801380#: uformcontacts.sendupdatetoolow
     1381msgctxt "uformcontacts.sendupdatetoolow"
    13811382msgid "Update counter error"
    13821383msgstr "Chyba čítače aktualizací"
    … …  
    14181419msgstr "Všechny soubory"
    14191420
     1421#: uformproperties.sendupdatetoolow
     1422msgctxt "uformproperties.sendupdatetoolow"
     1423msgid "Update counter error"
     1424msgstr "Chyba čítače aktualizací"
     1425
    14201426#: uformproperties.sfiltered
    14211427msgctxt "uformproperties.sfiltered"

  • trunk/Languages/vCardStudio.pot

    r104 r108  
    13511351
    13521352#: uformcontacts.sendupdatetoolow
     1353msgctxt "uformcontacts.sendupdatetoolow"
    13531354msgid "Update counter error"
    13541355msgstr ""
    … …  
    13901391msgstr ""
    13911392
     1393#: uformproperties.sendupdatetoolow
     1394msgctxt "uformproperties.sendupdatetoolow"
     1395msgid "Update counter error"
     1396msgstr ""
     1397
    13921398#: uformproperties.sfiltered
    13931399msgctxt "uformproperties.sfiltered"

  • trunk/Packages/Common/UCommon.pas

    r98 r108  
    1313type
    1414  TArrayOfByte = array of Byte;
    15   TArrayOfString = array of string;
    1615  TExceptionEvent = procedure(Sender: TObject; E: Exception) of object;
    1716
    … …  
    5150function ComputerName: string;
    5251procedure DeleteFiles(APath, AFileSpec: string);
     52function Explode(Separator: Char; Data: string): TStringArray;
    5353procedure ExecuteProgram(Executable: string; Parameters: array of string);
    5454procedure FileDialogUpdateFilterFileType(FileDialog: TOpenDialog);
    … …  
    6565function LoadFileToStr(const FileName: TFileName): AnsiString;
    6666function LoggedOnUserNameEx(Format: TUserNameFormat): string;
    67 function MergeArray(A, B: array of string): TArrayOfString;
     67function MergeArray(A, B: array of string): TStringArray;
    6868function OccurenceOfChar(What: Char; Where: string): Integer;
    6969procedure OpenWebPage(URL: string);
    … …  
    291291end;
    292292
    293 function Explode(Separator: char; Data: string): TArrayOfString;
    294 begin
    295   Result := nil;
    296   SetLength(Result, 0);
    297   while Pos(Separator, Data) > 0 do begin
    298     SetLength(Result, Length(Result) + 1);
    299     Result[High(Result)] := Copy(Data, 1, Pos(Separator, Data) - 1);
    300     Delete(Data, 1, Pos(Separator, Data));
    301   end;
     293function Explode(Separator: Char; Data: string): TStringArray;
     294var
     295  Index: Integer;
     296begin
     297  Result := Default(TStringArray);
     298  repeat
     299    Index := Pos(Separator, Data);
     300    if Index > 0 then begin
     301      SetLength(Result, Length(Result) + 1);
     302      Result[High(Result)] := Copy(Data, 1, Index - 1);
     303      Delete(Data, 1, Index);
     304    end else Break;
     305  until False;
    302306  SetLength(Result, Length(Result) + 1);
    303307  Result[High(Result)] := Data;
    … …  
    509513end;
    510514
    511 function MergeArray(A, B: array of string): TArrayOfString;
    512 var
    513   I: Integer;
    514 begin
    515   Result := Default(TArrayOfString);
     515function MergeArray(A, B: array of string): TStringArray;
     516var
     517  I: Integer;
     518begin
     519  Result := Default(TStringArray);
    516520  SetLength(Result, Length(A) + Length(B));
    517521  for I := 0 to Length(A) - 1 do

  • trunk/UContact.pas

    r104 r108  
    141141    function GetProperty(Field: TContactField): TContactProperty; overload;
    142142    function GetProperty(FieldIndex: TContactFieldIndex): TContactProperty; overload;
     143    procedure FullNameToNameParts(FullName: string; out Before, First, Middle,
     144      Last, After: string);
     145    function NamePartsToFullName(Before, First, Middle, Last, After: string): string;
    143146    procedure Assign(Source: TContact);
    144147    function UpdateFrom(Source: TContact): Boolean;
    … …  
    11161119end;
    11171120
     1121function IsNumber(Text: string): Boolean;
     1122var
     1123  Value: Integer;
     1124begin
     1125  Result := TryStrToInt(Text, Value);
     1126end;
     1127
     1128function IsRomanNumber(Text: string): Boolean;
     1129var
     1130  I: Integer;
     1131begin
     1132  Result := True;
     1133  for I := 1 to Length(Text) do
     1134    if not (Text[I] in ['I', 'V', 'X', 'L', 'C', 'D', 'M']) then begin
     1135      Result := False;
     1136      Break;
     1137    end;
     1138end;
     1139
     1140procedure TContact.FullNameToNameParts(FullName: string; out Before, First,
     1141  Middle, Last, After: string);
     1142var
     1143  Parts: TStringArray;
     1144  I, J: Integer;
     1145begin
     1146  Before := '';
     1147  First := '';
     1148  Middle := '';
     1149  Last := '';
     1150  After := '';
     1151  while Pos('  ', FullName) > 0 do
     1152    FullName := StringReplace(FullName, '  ', ' ', [rfReplaceAll]);
     1153  Parts := Explode(' ', Trim(FullName));
     1154
     1155  // Title before
     1156  while (Length(Parts) > 0) and EndsWith(Parts[0], '.') do begin
     1157    Before := Trim(Before + ' ' + Parts[0]);
     1158    Delete(Parts, 0, 1);
     1159  end;
     1160
     1161  // Title after
     1162  for I := 0 to High(Parts) do
     1163    if (Pos('.', Parts[I]) > 0) or IsNumber(Parts[I]) or IsRomanNumber(Parts[I]) then begin
     1164      for J := I to High(Parts) do
     1165        After := Trim(After + ' ' + Parts[J]);
     1166      SetLength(Parts, I);
     1167      Break;
     1168    end;
     1169
     1170  if Length(Parts) = 0 then begin
     1171  end else
     1172  if Length(Parts) = 1 then begin
     1173    First := Parts[0];
     1174  end else
     1175  if Length(Parts) = 2 then begin
     1176    First := Parts[0];
     1177    Last := Parts[1];
     1178  end else begin
     1179    First := Parts[0];
     1180    for I := 0 to Length(Parts) - 3 do
     1181      Middle := Trim(Middle + ' ' + Parts[I + 1]);
     1182    Last := Parts[High(Parts)];
     1183  end;
     1184end;
     1185
     1186function TContact.NamePartsToFullName(Before, First, Middle, Last, After: string
     1187  ): string;
     1188begin
     1189  Result := '';
     1190  if Before <> '' then Result := Result + ' ' + Before;
     1191  if First <> '' then Result := Result + ' ' + First;
     1192  if Middle <> '' then Result := Result + ' ' + Middle;
     1193  if Last <> '' then Result := Result + ' ' + Last;
     1194  if After <> '' then Result := Result + ' ' + After;
     1195  Result := Trim(Result);
     1196end;
     1197
    11181198procedure TContact.Assign(Source: TContact);
    11191199begin

  • trunk/UContactImage.pas

    r103 r108  
    99
    1010type
    11   TContactImageFormat = (ifBmp, ifJpeg, ifPng, ifGif);
     11  TContactImageFormat = (ifNone, ifBmp, ifJpeg, ifPng, ifGif);
    1212
    1313  { TContactImage }
    … …  
    6464    (ContactProperty.Attributes.IndexOf('png') <> -1) then Result := ifPng
    6565  else
    66     Result := ifBmp;
     66    if (ContactProperty.Attributes.IndexOf('BMP') <> -1) or
     67      (ContactProperty.Attributes.IndexOf('bmp') <> -1) then Result := ifBmp
     68  else
     69    Result := ifNone;
    6770end;
    6871
    … …  
    134137      GifImage.Free;
    135138    end;
     139  end else
     140  if ImageFormat = ifBmp then begin
     141    try
     142      Bitmap.SaveToStream(Stream);
     143    except
     144    end;
    136145  end else begin
    137     // Bmp
    138     try
    139       Bitmap.SaveToStream(Stream);
    140     except
    141     end;
     146    // Use default type
     147    SaveImageToStream(ifJpeg, Stream);
    142148  end;
    143149end;
    … …  
    149155  PngImage: TPortableNetworkGraphic;
    150156  GifImage: TGIFImage;
     157  BmpImage: TBitmap;
    151158begin
    152159  if ImageFormat = ifJpeg then begin
    153     JpegImage := TJPEGImage.Create;
    154     try
     160    try
     161      JpegImage := TJPEGImage.Create;
    155162      try
    156163        JpegImage.LoadFromStream(Stream);
    … …  
    160167          Canvas.Draw(0, 0, JpegImage);
    161168        end;
    162         Used := True;
    163       except
    164         Used := False;
    165       end;
    166     finally
    167       JpegImage.Free;
     169      finally
     170        JpegImage.Free;
     171      end;
     172      Used := True;
     173    except
     174      Used := False;
    168175    end;
    169176  end else
    170177  if ImageFormat = ifPng then begin
    171     PngImage := TPortableNetworkGraphic.Create;
    172     try
     178    try
     179      PngImage := TPortableNetworkGraphic.Create;
    173180      try
    174181        PngImage.LoadFromStream(Stream);
    … …  
    178185          Canvas.Draw(0, 0, PngImage);
    179186        end;
    180         Used := True;
    181       except
    182         Used := False;
    183       end;
    184     finally
    185       PngImage.Free;
     187      finally
     188        PngImage.Free;
     189      end;
     190      Used := True;
     191    except
     192      Used := False;
    186193    end;
    187194  end else
    188195  if ImageFormat = ifGif then begin
    189     GifImage := TGIFImage.Create;
    190     try
     196    try
     197      GifImage := TGIFImage.Create;
    191198      try
    192199        GifImage.LoadFromStream(Stream);
    … …  
    196203          Canvas.Draw(0, 0, GifImage);
    197204        end;
    198         Used := True;
    199       except
    200         Used := False;
    201       end;
    202     finally
    203       GifImage.Free;
     205      finally
     206        GifImage.Free;
     207      end;
     208      Used := True;
     209    except
     210      Used := False;
     211    end;
     212  end else
     213  if ImageFormat = ifBmp then begin
     214    try
     215      BmpImage := TBitmap.Create;
     216      try
     217        BmpImage.LoadFromStream(Stream);
     218        with Bitmap do begin
     219          PixelFormat := pf24bit;
     220          SetSize(BmpImage.Width, BmpImage.Height);
     221          Canvas.Draw(0, 0, BmpImage);
     222        end;
     223      finally
     224        BmpImage.Free;
     225      end;
     226      Used := True;
     227    except
     228      Used := False;
    204229    end;
    205230  end else begin
    206     // Bmp
    207     with TImage.Create(nil) do
    208     try
     231    // Unknown image type, let TPicture guess what it is
     232    try
     233      with TImage.Create(nil) do
    209234      try
    210235        Picture.LoadFromStream(Stream);
    211         Canvas.Draw(0, 0, Picture.Bitmap);
    212         Used := True;
    213       except
    214         Used := False;
    215       end;
    216     finally
    217       Free;
     236        with Bitmap do begin
     237          PixelFormat := pf24bit;
     238          SetSize(Picture.Bitmap.Width, Picture.Bitmap.Height);
     239          Canvas.Draw(0, 0, Picture.Bitmap);
     240        end;
     241      finally
     242        Free;
     243      end;
     244      Used := True;
     245    except
     246      Used := False;
    218247    end;
    219248  end;
Note: See TracChangeset for help on using the changeset viewer.