PJStringPE.pas

{
 * This Source Code Form is subject to the terms of the Mozilla Public License,
 * v. 2.0. If a copy of the MPL was not distributed with this file, You can
 * obtain one at http://mozilla.org/MPL/2.0/
 *
 * Copyright (C) 2004-2014, Peter Johnson (www.delphidabbler.com).
 *
 * Enhanced string property editor for the Delphi IDE that enables multi-line
 * strings to be edited and assigned to any components' string & TCaption
 * properties at design time.
}


unit PJStringPE;


interface


// Requires Delphi 6 or later

{$IF CompilerVersion >= 24.0} // Delphi XE3 and later
  {$LEGACYIFEND ON}  // NOTE: this must come before all $IFEND directives
  {$DEFINE TScrollStyleMoved}
{$IFEND}
{$IF CompilerVersion >= 23.0} // Delphi XE2 and later
  {$DEFINE RTLNameSpaces}
{$IFEND}
{$IF CompilerVersion >= 15.0} // Delphi 7 and later
  {$WARN UNSAFE_CODE OFF}
{$IFEND}


uses
  // Delphi
  {$IFDEF RTLNameSpaces}
  Vcl.StdCtrls, Vcl.Controls, Vcl.ExtCtrls, System.Classes, Vcl.Dialogs,
  Vcl.Forms, Vcl.ImgList, Vcl.ComCtrls, Vcl.ToolWin, Vcl.ActnList,
  {$ELSE}
  StdCtrls, Controls, ExtCtrls, Classes, Dialogs, Forms, ImgList, ComCtrls,
  ToolWin, ActnList,
  {$ENDIF}
  DesignIntf, DesignEditors;


type

  ///  <summary>
  ///  Dialogue box used to edit multi-line string properties.
  ///  </summary>
  ///  <remarks>
  ///  Instantiated by TPJStringPE.
  ///  </remarks>
  TPJStringPEDlg = class(TForm)
    toolBar: TToolBar;
    tbSelectAll: TToolButton;
    tbClearText: TToolButton;
    tbSeparator1: TToolButton;
    tbPasteOver: TToolButton;
    tbCopyAll: TToolButton;
    tbSeparator2: TToolButton;
    tbUndo: TToolButton;
    tbSeparator3: TToolButton;
    tbLoad: TToolButton;
    tbSave: TToolButton;
    edText: TMemo;
    dlgOpen: TOpenDialog;
    dlgSave: TSaveDialog;
    actionList: TActionList;
    actLoad: TAction;
    actSave: TAction;
    actClear: TAction;
    actSelectAll: TAction;
    actPasteOver: TAction;
    actCopyAll: TAction;
    actUndo: TAction;
    imageList: TImageList;
    pnlButton: TPanel;
    btnOK: TButton;
    btnCancel: TButton;
    cbWordWrap: TCheckBox;
    actHelp: TAction;
    tbSeparator4: TToolButton;
    tbHelp: TToolButton;
    ///  <summary>Copies all text in editor to clipboard.</summary>
    procedure actCopyAllExecute(Sender: TObject);
    ///  <summary>Disables Copy All action if no text in editor.</summary>
    procedure actCopyAllUpdate(Sender: TObject);
    ///  <summary>Clears all text from editor.</summary>
    procedure actClearExecute(Sender: TObject);
    ///  <summary>Displays property editor's online documentation wiki.
    ///  </summary>
    procedure actHelpExecute(Sender: TObject);
    ///  <summary>Replaces text in editor with text on clipboard.</summary>
    procedure actPasteOverExecute(Sender: TObject);
    ///  <summary>Disables Paste Over action if there is no text on clipboard.
    ///  </summary>
    procedure actPasteOverUpdate(Sender: TObject);
    ///  <summary>Loads text from a file specified by user into editor.
    ///  </summary>
    procedure actLoadExecute(Sender: TObject);
    ///  <summary>Saves text from editor to file specified by user.</summary>
    procedure actSaveExecute(Sender: TObject);
    ///  <summary>Selects all text in editor.</summary>
    procedure actSelectAllExecute(Sender: TObject);
    ///  <summary>Disables Select All action if there is no text in editor.
    ///  </summary>
    procedure actSelectAllUpdate(Sender: TObject);
    ///  <summary>Undoes last change in editor.</summary>
    procedure actUndoExecute(Sender: TObject);
    ///  <summary>Disables Undo action if editor can't undo last edit.</summary>
    procedure actUndoUpdate(Sender: TObject);
    ///  <summary>Toggles word wrapping in editor on and off depending on state
    ///  of check box.</summary>
    procedure cbWordWrapClick(Sender: TObject);
    ///  <summary>Initialises form.</summary>
    ///  <remarks>Sets default font.</remarks>
    procedure FormCreate(Sender: TObject);
    ///  <summary>Saves persistent settings when form is destroyed.</summary>
    ///  <remarks>Word wrap setting and window location are persisted.</remarks>
    procedure FormDestroy(Sender: TObject);
    ///  <summary>Cause unmodified ESC key and Ctrl+RETURN key presses to have
    ///  same effect as clicking Cancel and OK buttons respectively.</summary>
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    ///  <summary>Reads and acts on persistent settings from registry.</summary>
    ///  <remarks>Updates word-wrap setting and locates window.</remarks>
    procedure FormShow(Sender: TObject);
  private
    ///  <summary>Adjusts given registry access flags to include or exclude
    ///  64 bit registry access flag depending on operating system.</summary>
    function AdjustRegAccessFlags(const Flags: LongWord): LongWord;
    ///  <summary>Saves a setting as binary data in registry.</summary>
    ///  <param name="ID">string [in] Name of registry value.</param>
    ///  <param name="Value">Untyped [in] Value to be stored.</param>
    ///  <param name="Size">Integer [in] Size of Value in bytes.</param>
    ///  <returns>Boolean. True if setting is written successfully or False on
    ///  failure.</returns>
    function SaveSetting(const ID: string; var Value;
      const Size: Integer): Boolean;
    ///  <summary>Reads binary data for a given setting.</summary>
    ///  <param name="ID">string [in] Name of registry value.</param>
    ///  <param name="Value">Untyped [in/out] Untyped value that receives
    ///  setting data. Any existing value is overwritten.</param>
    ///  <param name="Size">Integer [in] Size of Value in bytes.</param>
    ///  <returns>Boolean. True if setting is read successfully or False on
    ///  failure.</returns>
    function ReadSetting(const ID: string; var Value;
      const Size: Integer): Boolean;
    ///  <summary>Updates editor's word wrap setting and state of check box.
    ///  </summary>
    procedure UpdateWordWrap(Flag: Boolean);
  end;


  ///  <summary>
  ///  Extended string property editor.
  ///  </summary>
  TPJStringPE = class(TStringProperty)
  public
    ///  <summary>Called by IDE to get attributes of property editor.</summary>
    ///  <remarks>Informs IDE that property editor displays a dialogue box in
    ///  addition to standard string property editor.</remarks>
    function GetAttributes: TPropertyAttributes; override;
    ///  <summary>Called by IDE when property editor dialogue box is to be
    ///  displayed.</summary>
    procedure Edit; override;
  end;


///  <summary>Registers property editor for all string and TCaption properties
///  of all components.</summary>
procedure Register;


implementation


uses
  // Delphi
  {$IFDEF RTLNameSpaces}
  System.SysUtils, Winapi.Windows, System.Win.Registry, Vcl.ClipBrd,
  Winapi.Messages, Winapi.ShellAPI
  {$ELSE}
  SysUtils, Windows, Registry, ClipBrd, Messages, ShellAPI
  {$ENDIF}
  {$IFDEF TScrollStyleMoved}
  , System.UITypes
  {$ENDIF}
  ;


{$R *.DFM}


procedure Register;
begin
  // Register property editor for any string or TCaption property of any
  // component.
  RegisterPropertyEditor(TypeInfo(string), nil, '', TPJStringPE);
  RegisterPropertyEditor(TypeInfo(TCaption), nil, '', TPJStringPE);
end;

{ TPJStringPE }

procedure TPJStringPE.Edit;
begin
  with TPJStringPEDlg.Create(Application) do
    try
      edText.Text := GetStrValue;
      if ShowModal = mrOK then
        SetStrValue(edText.Text);
    finally
      Free;
    end;
end;

function TPJStringPE.GetAttributes: TPropertyAttributes;
begin
  Result := inherited GetAttributes + [paDialog];
end;

{ TPJStringPEDlg }

const
  // Registry key where property editor's settings are stored
  cRegKey = '\Software\DelphiDabbler\Experts\StringPE';
  // Names of registry values used for settings
  cWordWrapSetting = 'WordWrap';               // whether word wrap is enabled
  cWindowPlacementSetting = 'WindowPlacement'; // size and location of window

procedure TPJStringPEDlg.actClearExecute(Sender: TObject);
begin
  edText.Clear;
  edText.SetFocus;
end;

procedure TPJStringPEDlg.actCopyAllExecute(Sender: TObject);
begin
  Clipboard.AsText := edText.Text;
end;

procedure TPJStringPEDlg.actCopyAllUpdate(Sender: TObject);
begin
  actCopyAll.Enabled := edText.Text <> '';
end;

procedure TPJStringPEDlg.actHelpExecute(Sender: TObject);
begin
  ShellExecute(
    Handle,
    'open',
    'http://www.delphidabbler.com/url/stringpe-wiki',
    nil,
    nil,
    SW_SHOWNORMAL
  );
end;

procedure TPJStringPEDlg.actLoadExecute(Sender: TObject);
begin
  if dlgOpen.Execute then
  begin
    edText.Lines.LoadFromFile(dlgOpen.FileName);
    edText.SetFocus;
    edText.SelStart := 0;
    edText.SelLength := 0;
  end;
end;

procedure TPJStringPEDlg.actPasteOverExecute(Sender: TObject);
begin
  edText.Text := Clipboard.AsText;
  edText.SetFocus;
  edText.SelStart := 0;
  edText.SelLength := 0;
end;

procedure TPJStringPEDlg.actPasteOverUpdate(Sender: TObject);
begin
  {$IFDEF UNICODE}
  actPasteOver.Enabled := ClipBoard.HasFormat(CF_TEXT)
    or Clipboard.HasFormat(CF_UNICODETEXT);
  {$ELSE}
  actPasteOver.Enabled := ClipBoard.HasFormat(CF_TEXT);
  {$ENDIF}
end;

procedure TPJStringPEDlg.actSaveExecute(Sender: TObject);
begin
  if dlgSave.Execute then
    edText.Lines.SaveToFile(dlgSave.FileName);
end;

procedure TPJStringPEDlg.actSelectAllExecute(Sender: TObject);
begin
  edText.SetFocus;
  edText.SelectAll;
end;

procedure TPJStringPEDlg.actSelectAllUpdate(Sender: TObject);
begin
  actSelectAll.Enabled := edText.Text <> '';
end;

procedure TPJStringPEDlg.actUndoExecute(Sender: TObject);
begin
  edText.Perform(EM_UNDO, 0, 0);
end;

procedure TPJStringPEDlg.actUndoUpdate(Sender: TObject);
begin
  actUndo.Enabled := edText.Perform(EM_CANUNDO, 0, 0) <> 0;
end;

function TPJStringPEDlg.AdjustRegAccessFlags(const Flags: LongWord): LongWord;
const
  // 64 bit view registry access flag: not defined by all supported Delphis
  KEY_WOW64_64KEY = $0100;
begin
  if (Win32MajorVersion > 5) or
    ((Win32MajorVersion = 5) and (Win32MinorVersion >= 1)) then
    // Windows XP or later: include 64 bit flag
    Result := Flags or KEY_WOW64_64KEY
  else
    // Windows 2000 or earlier, including Win9x: exclude 64 bit flag
    Result := Flags and not KEY_WOW64_64KEY;
end;

procedure TPJStringPEDlg.cbWordWrapClick(Sender: TObject);
begin
  UpdateWordWrap(cbWordWrap.Checked);
end;

procedure TPJStringPEDlg.FormCreate(Sender: TObject);
const
  VistaFontName = 'Segoe UI';
  XPFontName = 'Tahoma';
begin
  if Screen.Fonts.IndexOf(VistaFontName) >= 0 then
  begin
    Font.Name := VistaFontName;
    Font.Size := 9;
  end
  else if Screen.Fonts.IndexOf(XPFontName) >= 0 then
    Font.Name := XPFontName;
end;

procedure TPJStringPEDlg.FormDestroy(Sender: TObject);
var
  WordWrap: Boolean;    // whether editor word wraps
  Pl: TWindowPlacement; // placement of editor window
begin
  // Save word wrap value
  WordWrap := cbWordWrap.Checked;
  SaveSetting(cWordWrapSetting, WordWrap, SizeOf(WordWrap));
  // Save window placement
  FillChar(Pl, 0, SizeOf(Pl));
  Pl.Length := SizeOf(TWindowPlacement);
  GetWindowPlacement(Self.Handle, @Pl);
  SaveSetting(
    cWindowPlacementSetting, Pl.rcNormalPosition, SizeOf(Pl.rcNormalPosition)
  );
end;

procedure TPJStringPEDlg.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
const
  cShiftKeys = [ssCtrl, ssAlt, ssShift];  // set of modifier keys
begin
  case Key of
    VK_ESCAPE:
      if Shift * cShiftKeys = [] then
        // unmodified ESC key - cancel dialogue
        ModalResult := mrCancel;
    VK_RETURN:
    begin
      if Shift * cShiftKeys = [ssCtrl] then
        // CTRL+RETURN - OK the dialogue
        ModalResult := mrOK;
    end;
  end;
end;

procedure TPJStringPEDlg.FormShow(Sender: TObject);
var
  WordWrap: Boolean;    // whether editor word wraps
  Pl: TWindowPlacement; // placement of editor window
  WorkArea: TRect;      // desktop work area
begin
  // Get word wrapping setting and update accordingly
  if not ReadSetting(cWordWrapSetting, WordWrap, SizeOf(WordWrap)) then
    WordWrap := False;
  UpdateWordWrap(WordWrap);
  // Get window placement setting and place window accordingly
  FillChar(Pl, SizeOf(Pl), #0);
  if ReadSetting(
    cWindowPlacementSetting, Pl.rcNormalPosition, SizeOf(Pl.rcNormalPosition)
  ) then
  begin
    // we have read settings: position and size window accordingly
    Pl.Length := SizeOf(TWindowPlacement);
    Pl.showCmd := SW_SHOW;      // needed when restore called late in start-up
    SetWindowPlacement(Self.Handle, @Pl);
  end
  else
  begin
    // we have no settings: centre window on Windows work area
    if SystemParametersInfo(SPI_GETWORKAREA, 0, @WorkArea, 0) then
    begin
      Left := WorkArea.Left + (WorkArea.Right - WorkArea.Left - Width) div 2;
      Top := WorkArea.Top + (WorkArea.Bottom - WorkArea.Top - Height) div 2;
      if Left < WorkArea.Left then
        Left := WorkArea.Left;
      if Top < WorkArea.Top then
        Top := WorkArea.Top;
    end;
  end;
end;

function TPJStringPEDlg.ReadSetting(const ID: string; var Value;
  const Size: Integer): Boolean;
begin
  with TRegistry.Create(AdjustRegAccessFlags(KEY_READ)) do
    try
      try
        Result := OpenKey(cRegKey, False) and ValueExists(ID);
        if Result then
          Result := ReadBinaryData(ID, Value, Size) = Size;
      except
        Result := False;
      end;
    finally
      Free;
    end;
end;

function TPJStringPEDlg.SaveSetting(const ID: string; var Value;
  const Size: Integer): Boolean;
begin
  with TRegistry.Create(AdjustRegAccessFlags(KEY_ALL_ACCESS)) do
    try
      try
        Result := OpenKey(cRegKey, True);
        if Result then
          WriteBinaryData(ID, Value, Size);
      except
        Result := False;
      end;
    finally
      Free;
    end;
end;

procedure TPJStringPEDlg.UpdateWordWrap(Flag: Boolean);
const
  // map of word wrap flag to TMemo.Scrollbars property value
  cScrollBars: array[Boolean] of TScrollStyle = (ssBoth, ssVertical);
begin
  // update check box
  cbWordWrap.Checked := Flag;
  // update editor memo control
  edText.WordWrap := Flag;
  edText.ScrollBars := cScrollBars[Flag];
end;

end.