Design/TntWideStringProperty_Design.pas

   1
   2 {*****************************************************************************}
   3 {                                                                             }
   4 {    Tnt Delphi Unicode Controls                                              }
   5 {      http://www.tntware.com/delphicontrols/unicode/                         }
   6 {        Version: 2.3.0                                                       }
   7 {                                                                             }
   8 {    Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com)       }
   9 {                                                                             }
  10 {*****************************************************************************}
  11
  12 unit TntWideStringProperty_Design;
  13
  14 {$INCLUDE ..\Source\TntCompilers.inc}
  15
  16 interface
  17
  18 {*****************************************************}
  19 {  TWideCharProperty-editor implemented by Maël Hörz  }
  20 {*****************************************************}
  21
  22 {$IFDEF COMPILER_9_UP}
  23   {$MESSAGE FATAL 'The Object Inspector in Delphi 9 is already Unicode enabled.'}
  24 {$ENDIF}
  25
  26 uses
  27   Classes, Messages, Windows, Graphics, TypInfo, TntDesignEditors_Design,
  28   DesignIntf, DesignEditors, VCLEditors;
  29
  30 type
  31   TWideStringProperty = class(TPropertyEditor, ICustomPropertyDrawing)
  32   private
  33     FActivateWithoutGetValue: Boolean;
  34     FPropList: PInstPropList;
  35   protected
  36     procedure SetPropEntry(Index: Integer; AInstance: TPersistent; APropInfo: PPropInfo); override;
  37     function GetWideStrValueAt(Index: Integer): WideString; dynamic;
  38     function GetWideStrValue: WideString;
  39     procedure SetWideStrValue(const Value: WideString); dynamic;
  40     function GetWideVisualValue: WideString;
  41   public
  42     constructor Create(const ADesigner: ITntDesigner; APropCount: Integer); override;
  43     destructor Destroy; override;
  44     procedure Activate; override;
  45     procedure PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
  46     procedure PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
  47     function AllEqual: Boolean; override;
  48     function GetEditLimit: Integer; override;
  49     function GetValue: AnsiString; override;
  50     procedure SetValue(const Value: AnsiString); override;
  51     {$IFDEF MULTI_LINE_STRING_EDITOR}
  52     function GetAttributes: TPropertyAttributes; override;
  53     procedure Edit; override;
  54     {$ENDIF}
  55   end;
  56
  57   TWideCaptionProperty = class(TWideStringProperty)
  58   public
  59     function GetAttributes: TPropertyAttributes; override;
  60   end;
  61
  62   TWideCharProperty = class(TWideStringProperty)
  63   protected
  64     {$IFDEF COMPILER_7_UP}
  65     function GetIsDefault: Boolean; override;
  66     {$ENDIF}
  67     function GetWideStrValueAt(Index: Integer): WideString; override;
  68     procedure SetWideStrValue(const Value: WideString); override;
  69   public
  70     function GetAttributes: TPropertyAttributes; override;
  71     function GetEditLimit: Integer; override;
  72   end;
  73
  74 procedure Register;
  75
  76 implementation
  77
  78 uses
  79   Controls, Forms, SysUtils, StdCtrls, TntGraphics, TntControls,
  80   TntSysUtils, TntSystem, Consts,
  81   RTLConsts;
  82
  83 procedure Register;
  84 begin
  85   RegisterPropertyEditor(TypeInfo(WideString), nil, '', TWideStringProperty);
  86   RegisterPropertyEditor(TypeInfo(TWideCaption), nil, '', TWideCaptionProperty);
  87   RegisterPropertyEditor(TypeInfo(WideChar), nil, '', TWideCharProperty);
  88 end;
  89
  90 function GetOIInspListBox: TWinControl;
  91 var
  92   ObjectInspectorForm: TCustomForm;
  93   Comp: TComponent;
  94 begin
  95   Result := nil;
  96   ObjectInspectorForm := GetObjectInspectorForm;
  97   if ObjectInspectorForm <> nil then begin
  98     Comp := ObjectInspectorForm.FindComponent('PropList');
  99     if Comp is TWinControl then
 100       Result := TWinControl(Comp);
 101   end;
 102 end;
 103
 104 function GetOIPropInspEdit: TCustomEdit{TNT-ALLOW TCustomEdit};
 105 var
 106   OIInspListBox: TWinControl;
 107   Comp: TComponent;
 108 begin
 109   Result := nil;
 110   OIInspListBox := GetOIInspListBox;
 111   if OIInspListBox <> nil then begin
 112     Comp := OIInspListBox.FindComponent('EditControl');
 113     if Comp is TCustomEdit{TNT-ALLOW TCustomEdit} then
 114       Result := TCustomEdit{TNT-ALLOW TCustomEdit}(Comp);
 115   end;
 116 end;
 117 //------------------------------
 118
 119 type TAccessWinControl = class(TWinControl);
 120
 121 { TWideStringProperty }
 122
 123 var
 124   WideStringPropertyCount: Integer = 0;
 125
 126 constructor TWideStringProperty.Create(const ADesigner: ITntDesigner; APropCount: Integer);
 127 begin
 128   inherited;
 129   Inc(WideStringPropertyCount);
 130   GetMem(FPropList, APropCount * SizeOf(TInstProp));
 131 end;
 132
 133 procedure ConvertObjectInspectorBackToANSI;
 134 var
 135   Edit: TCustomEdit{TNT-ALLOW TCustomEdit};
 136 begin
 137   if (Win32PlatformIsUnicode) then begin
 138     Edit := GetOIPropInspEdit;
 139     if Assigned(Edit)
 140     and IsWindowUnicode(Edit.Handle) then
 141       TAccessWinControl(Edit).RecreateWnd;
 142   end;
 143 end;
 144
 145 destructor TWideStringProperty.Destroy;
 146 begin
 147   Dec(WideStringPropertyCount);
 148   if (WideStringPropertyCount = 0) then
 149     ConvertObjectInspectorBackToANSI;
 150   if FPropList <> nil then
 151     FreeMem(FPropList, PropCount * SizeOf(TInstProp));
 152   inherited;
 153 end;
 154
 155 {$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
 156 type
 157   THackPropertyEditor = class
 158     FDesigner: IDesigner;
 159     FPropList: PInstPropList;
 160   end;
 161 {$ENDIF}
 162
 163 procedure TWideStringProperty.Activate;
 164 var
 165   Edit: TCustomEdit{TNT-ALLOW TCustomEdit};
 166 begin
 167   FActivateWithoutGetValue := True;
 168   if (Win32PlatformIsUnicode) then begin
 169     Edit := GetOIPropInspEdit;
 170     if Assigned(Edit)
 171     and (not IsWindowUnicode(Edit.Handle)) then
 172       ReCreateUnicodeWnd(Edit, 'EDIT', True);
 173   end;
 174 end;
 175
 176 procedure TWideStringProperty.SetPropEntry(Index: Integer;
 177   AInstance: TPersistent; APropInfo: PPropInfo);
 178 begin
 179   inherited;
 180   with FPropList^[Index] do
 181   begin
 182     Instance := AInstance;
 183     PropInfo := APropInfo;
 184   end;
 185 end;
 186
 187 function TWideStringProperty.GetWideStrValueAt(Index: Integer): WideString;
 188 begin
 189   with FPropList^[Index] do Result := GetWideStrProp(Instance, PropInfo);
 190 end;
 191
 192 function TWideStringProperty.GetWideStrValue: WideString;
 193 begin
 194   Result := GetWideStrValueAt(0);
 195 end;
 196
 197 procedure TWideStringProperty.SetWideStrValue(const Value: WideString);
 198 var
 199   I: Integer;
 200 begin
 201   for I := 0 to PropCount - 1 do
 202     with FPropList^[I] do SetWideStrProp(Instance, PropInfo, Value);
 203   Modified;
 204 end;
 205
 206 function TWideStringProperty.GetWideVisualValue: WideString;
 207 begin
 208   if AllEqual then
 209     Result := GetWideStrValue
 210   else
 211     Result := '';
 212 end;
 213
 214 procedure TWideStringProperty.PropDrawName(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
 215 begin
 216   DefaultPropertyDrawName(Self, ACanvas, ARect);
 217 end;
 218
 219 procedure TWideStringProperty.PropDrawValue(ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
 220 begin
 221   WideCanvasTextRect(ACanvas, ARect, ARect.Left + 1, ARect.Top + 1, GetWideVisualValue);
 222 end;
 223
 224 function TWideStringProperty.AllEqual: Boolean;
 225 var
 226   I: Integer;
 227   V: WideString;
 228 begin
 229   Result := False;
 230   if PropCount > 1 then
 231   begin
 232     V := GetWideStrValue;
 233     for I := 1 to PropCount - 1 do
 234       if GetWideStrValueAt(I) <> V then Exit;
 235   end;
 236   Result := True;
 237 end;
 238
 239 function TWideStringProperty.GetEditLimit: Integer;
 240 var
 241   Edit: TCustomEdit{TNT-ALLOW TCustomEdit};
 242 begin
 243   Result := MaxInt;
 244   // GetEditLimit is called right before the inplace editor text has been set
 245   if Win32PlatformIsUnicode then begin
 246     Edit := GetOIPropInspEdit;
 247     if Assigned(Edit) then begin
 248       TntControl_SetText(Edit, GetWideStrValue);
 249       TntControl_SetHint(Edit, GetWideStrValue);
 250     end;
 251   end;
 252 end;
 253
 254 function TWideStringProperty.GetValue: AnsiString;
 255 begin
 256   FActivateWithoutGetValue := False;
 257   Result := WideStringToStringEx(GetWideStrValue, CP_ACP{TNT-ALLOW CP_ACP}); // use the same code page as the inplace editor
 258 end;
 259
 260 procedure TWideStringProperty.SetValue(const Value: AnsiString);
 261 var
 262   Edit: TCustomEdit{TNT-ALLOW TCustomEdit};
 263 begin
 264   if (not FActivateWithoutGetValue) then begin
 265     Edit := GetOIPropInspEdit;
 266     if Assigned(Edit) and Win32PlatformIsUnicode then
 267       SetWideStrValue(TntControl_GetText(Edit))
 268     else
 269       SetWideStrValue(StringToWideStringEx(Value, CP_ACP{TNT-ALLOW CP_ACP})); // use the same code page as the inplace editor
 270   end;
 271 end;
 272
 273 {$IFDEF MULTI_LINE_STRING_EDITOR}
 274 function TWideStringProperty.GetAttributes: TPropertyAttributes;
 275 begin
 276   Result := inherited GetAttributes + [paDialog];
 277 end;
 278
 279 procedure TWideStringProperty.Edit;
 280 var
 281   Temp: WideString;
 282 begin
 283   with TTntStrEditDlg.Create(Application) do
 284   try
 285     PrepareForWideStringEdit;
 286     Memo.Text := GetWideStrValue;
 287     UpdateStatus(nil);
 288     if ShowModal = mrOk then begin
 289       Temp := Memo.Text;
 290       while (Length(Temp) > 0) and (Temp[Length(Temp)] < ' ') do
 291         System.Delete(Temp, Length(Temp), 1); { trim control characters from end }
 292       SetWideStrValue(Temp);
 293     end;
 294   finally
 295     Free;
 296   end;
 297 end;
 298 {$ENDIF}
 299
 300 { TWideCaptionProperty }
 301
 302 function TWideCaptionProperty.GetAttributes: TPropertyAttributes;
 303 begin
 304   Result := inherited GetAttributes + [paAutoUpdate];
 305 end;
 306
 307 { TWideCharProperty }
 308
 309 function TWideCharProperty.GetAttributes: TPropertyAttributes;
 310 begin
 311   Result := [paMultiSelect, paRevertable];
 312 end;
 313
 314 function TWideCharProperty.GetEditLimit: Integer;
 315 begin
 316   inherited GetEditLimit;
 317   Result := 63;
 318 end;
 319
 320 {$IFDEF COMPILER_7_UP}
 321 function TWideCharProperty.GetIsDefault: Boolean;
 322 var
 323   i: Integer;
 324   OldPropList: PInstPropList;
 325 begin
 326   Result := True;
 327   if PropCount > 0 then
 328   begin
 329     OldPropList := THackPropertyEditor(Self).FPropList;
 330     // The memory FPropList points to is write-protected.
 331     // In the constructor we dynamically allocated our own PropList,
 332     // which can be written, so point there instead.
 333     THackPropertyEditor(Self).FPropList := FPropList;
 334
 335     // Delphi can't handle WideChar-type, but does well with Word-type,
 336     // which has exactly the same size as WideChar (i.e. 2 Bytes)
 337     for i := 0 to PropCount - 1 do
 338       FPropList^[i].PropInfo^.PropType^ := TypeInfo(Word);
 339
 340     Result := inherited GetIsDefault;
 341
 342     for i := 0 to PropCount - 1 do
 343       FPropList^[i].PropInfo^.PropType^ := TypeInfo(WideChar);
 344
 345     THackPropertyEditor(Self).FPropList := OldPropList;
 346   end;
 347 end;
 348 {$ENDIF}
 349
 350 function IsCharGraphic(C: WideChar): Boolean;
 351 begin
 352   if Win32PlatformIsUnicode then
 353     Result := not IsWideCharCntrl(C) and not IsWideCharSpace(C)
 354   else // representation as charcode avoids corruption on ANSI-systems
 355     Result := (C >= #33) and (C <= #127);
 356 end;
 357
 358 function TWideCharProperty.GetWideStrValueAt(Index: Integer): WideString;
 359 var
 360   C: WideChar;
 361 begin
 362   with FPropList^[Index] do
 363     C := WideChar(GetOrdProp(Instance, PropInfo));
 364
 365   if IsCharGraphic(C) then
 366     Result := C
 367   else
 368     Result := WideFormat('#%d', [Ord(C)]);
 369 end;
 370
 371 procedure TWideCharProperty.SetWideStrValue(const Value: WideString);
 372 var
 373   C: Longint;
 374   I: Integer;
 375 begin
 376   if Length(Value) = 0 then
 377     C := 0
 378   else if Length(Value) = 1 then
 379     C := Ord(Value[1])
 380   else if Value[1] = '#' then
 381     C := StrToInt(Copy(Value, 2, Maxint))
 382   else
 383     raise EPropertyError.Create(SInvalidPropertyValue);
 384
 385   with GetTypeData(GetPropType)^ do
 386     if (C < MinValue) or (C > MaxValue) then
 387       raise EPropertyError.CreateFmt(SOutOfRange, [MinValue, MaxValue]);
 388
 389   for I := 0 to PropCount - 1 do
 390     with FPropList^[I] do SetOrdProp(Instance, PropInfo, C);
 391
 392   Modified;
 393 end;
 394
 395 initialization
 396
 397 finalization
 398   ConvertObjectInspectorBackToANSI;
 399
 400 end.