textresourceform.pas

學習資料網上下載

(*======================================================================*
 | unit TextResourceForm                                                |
 |                                                                      |
 | Display / edit text (string and message) resources                   |
 |                                                                      |
 | Beware - string table ids must be numeric, consecutive, etc.         |
 |                                                                      |
 | ** Gold code - 24/4/2001 **                                          |
 |                                                                      |
 | Version  Date        By    Description                               |
 | -------  ----------  ----  ------------------------------------------|
 | 1.0      31/01/2001  CPWW  Original                                  |
 *======================================================================*)

unit TextResourceForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ResourceForm, ComCtrls, unitResourceMessages, ActnList, Menus, StdCtrls, ConTnrs;

type
  TfmTextResource = class(TfmResource)
    lvStrings: TListView;
    mnuStringsMenu: TMainMenu;
    mnuStrings: TMenuItem;
    ActionList1: TActionList;
    actStringsAdd: TAction;
    actStringsModify: TAction;
    actStringsDelete: TAction;
    AddString1: TMenuItem;
    ModifyString1: TMenuItem;
    DeleteString1: TMenuItem;
    pomStrings: TPopupMenu;
    AddString2: TMenuItem;
    ModifyString2: TMenuItem;
    DeleteString2: TMenuItem;
    mmoMessage: TMemo;
    actStringsChangeID: TAction;
    ChangeID1: TMenuItem;
    ChangeID2: TMenuItem;
    procedure lvStringsDblClick(Sender: TObject);
    procedure lvStringsKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure actStringsModifyExecute(Sender: TObject);
    procedure mmoMessageExit(Sender: TObject);
    procedure actStringsDeleteExecute(Sender: TObject);
    procedure actStringsAddExecute(Sender: TObject);
    procedure lvStringsEdited(Sender: TObject; Item: TListItem;
      var S: String);
    procedure lvStringsEditing(Sender: TObject; Item: TListItem;
      var AllowEdit: Boolean);
    procedure actStringsChangeIDExecute(Sender: TObject);
  protected
    procedure SetObject(const Value: TObject); override;
    function GetMenuItem : TMenuItem; override;
    procedure UpdateActions; override;
  private
    fDetails : TTextResourceDetails;
    fAdding : Boolean;
    fAllowEdit : Boolean;
    fHexMode : Boolean;
    fIsStrings : Boolean;
    procedure SaveResource (const undoDetails : string);
  end;

var
  fmTextResource: TfmTextResource;

implementation

{$R *.DFM}

resourcestring
  rstChangeString  = 'change string';
  rstDeleteString  = 'delete string';
  rstChangeMessage = 'change message';
  rstDeleteMessage = 'delete message';
  rstAddString     = 'add string';
  rstAddMessage    = 'add message';
  rstChangeID      = 'change message ID';
  rstDuplicateMessageID = 'Duplicate Message ID';

{ TfmTextResource }

(*----------------------------------------------------------------------*
 | TfmTextResource.actStringsAddExecute                                 |
 |                                                                      |
 | Add a new string.  Just create a new item in the list view, then     |
 | modify it.                                                           |
 *----------------------------------------------------------------------*)
procedure TfmTextResource.actStringsAddExecute(Sender: TObject);
var
  item : TListItem;
  newID : Integer;
begin
  if (lvStrings.Items.Count < 16) or not fIsStrings then
  begin
    item := lvStrings.Items.Add;

                                        // Work out string / message ID
    if item.Index = 0 then
      if fIsStrings then
        item.Caption := ResIdToStringsId (fDetails.ResourceName)
      else
        item.Caption := '00000001'
    else
      if fHexMode then
      begin
        newId :=StrToInt ('$' + lvStrings.Items [lvStrings.Items.Count - 2].Caption);
        item.Caption := IntToHex (newId + 1, 8)
      end
      else
      begin
        newId :=StrToInt (lvStrings.Items [lvStrings.Items.Count - 2].Caption);
        item.Caption := IntToStr (newId + 1)
      end;

    item.SubItems.Add ('');
    item.Selected := True;

    fAdding := True;                    // Clear in mmoMessageExit

    actStringsModifyExecute (Sender)
  end
end;

(*----------------------------------------------------------------------*
 | TfmTextResource.actStringsDeleteExecute                              |
 |                                                                      |
 | Delete the selected string                                           |
 *----------------------------------------------------------------------*)
procedure TfmTextResource.actStringsDeleteExecute(Sender: TObject);
var
  idx : Integer;
begin
  if Assigned (lvStrings.Selected) then
  begin
    idx := lvStrings.Selected.Index;
    lvStrings.Selected.Free;

                                // Select next string
    if idx < lvStrings.Items.Count then
      lvStrings.Selected := lvStrings.Items [idx]
    else
    begin
      Dec (idx);
      if idx >= 0 then
        lvStrings.Selected := lvStrings.Items [idx]
    end;

    if fDetails is TMessageResourceDetails then
      SaveResource (rstDeleteMessage)
    else
      SaveResource (rstDeleteString)
  end
end;

(*----------------------------------------------------------------------*
 | TfmTextResource.actStringsModifyExecute                              |
 |                                                                      |
 | Allow the user to edit a string by unhiding and repositioning the    |
 | hidden memo                                                          |
 *----------------------------------------------------------------------*)
procedure TfmTextResource.actStringsModifyExecute(Sender: TObject);
begin
  if Assigned (lvStrings.Selected) then
  begin
    mmoMessage.Width := lvStrings.Width - 2;
    mmoMessage.Top := lvStrings.Selected.DisplayRect (drLabel).Bottom;
    mmoMessage.Text := lvStrings.Selected.SubItems [0];
    if mmoMessage.Top + mmoMessage.Height > lvStrings.Top + lvStrings.Height then
      mmoMessage.Top := lvStrings.Selected.DisplayRect (drLabel).Top - mmoMessage.Height;
    mmoMessage.Visible := True;
    mmoMessage.SetFocus
  end
  else
    actStringsAdd.Execute;
end;

(*----------------------------------------------------------------------*
 | TfmTextResource.GetMenuItem                                          |
 |                                                                      |
 | Override GetMenuItem to return our menu to the resource editor       |
 | framework                                                            |
 *----------------------------------------------------------------------*)
function TfmTextResource.GetMenuItem: TMenuItem;
begin
  result := mnuStrings
end;

(*----------------------------------------------------------------------*
 | TfmTextResource.lvStringsDblClick                                    |
 |                                                                      |
 | Respond to double click.  Modify (or add) a string                   |
 *----------------------------------------------------------------------*)
procedure TfmTextResource.lvStringsDblClick(Sender: TObject);
begin
  if Assigned (lvStrings.Selected) then
    actStringsModify.Execute
  else
    actStringsAdd.Execute
end;

(*----------------------------------------------------------------------*
 | TfmTextResource.lvStringsEdited                                      |
 |                                                                      |
 | Message resource ID changed.  Check for duplicates.                  |
 *----------------------------------------------------------------------*)
procedure TfmTextResource.lvStringsEdited(Sender: TObject; Item: TListItem;
  var S: String);
var
  i, newID : Integer;
begin
  fAllowEdit := False;
  actStringsDelete.ShortCut := actStringsDelete.Tag;    // Restore 'Delete' shortcut
  if s <> item.Caption then
  try
    if fHexMode then
      newId := StrToInt ('$' + s)
    else
      newID := StrToInt (s);

    for i := 0 to fDetails.Count - 1 do
      if fDetails.Ids [i] = newID then
        raise Exception.Create (rstDuplicateMessageID);

    item.Caption := s;          // need to do this so 'SaveResource' picks it up...
    SaveResource (rstChangeID);
  except
    s := item.Caption;
    raise
  end
end;

(*----------------------------------------------------------------------*
 | TfmTextResource.lvStringsEditing                                     |
 |                                                                      |
 | Disallow editing string resource IDs                                 |
 *----------------------------------------------------------------------*)
procedure TfmTextResource.lvStringsEditing(Sender: TObject;
  Item: TListItem; var AllowEdit: Boolean);
begin
  AllowEdit := fAllowEdit;
  actStringsDelete.Tag := actStringsDelete.ShortCut;    // Suspend 'Delete' shortcut.
  actStringsDelete.ShortCut := 0;
end;

(*----------------------------------------------------------------------*
 | TfmTextResource.lvStringsKeyDown                                     |
 |                                                                      |
 | Respond to the 'Return' key - Modify the string if it's pressed.     |
 *----------------------------------------------------------------------*)
procedure TfmTextResource.lvStringsKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then
    actStringsModify.Execute
end;

(*----------------------------------------------------------------------*
 | TfmTextResource.mmoMessageExit                                       |
 |                                                                      |
 | Finished editing the string.  Hide the memo, and update the resource |
 *----------------------------------------------------------------------*)
procedure TfmTextResource.mmoMessageExit(Sender: TObject);
var
  st : string;
  adding : Boolean;
begin
  adding := fAdding;
  fAdding := False;
  mmoMessage.Visible := False;
  with lvStrings do if Assigned (Selected) then
  begin
    if mmoMessage.CanUndo or fAdding then  // ie.  If it's changed
    begin
      selected.SubItems [0] := mmoMessage.Text;

      if adding then
        if fDetails is TMessageResourceDetails then
          st := rstAddmessage
        else
          st := rstAddString
      else
        if fDetails is TMessageResourceDetails then
          st := rstChangeMessage
        else
          st := rstChangeString;

      SaveResource (st);
      mmoMessage.ClearUndo;
    end
  end
end;

(*----------------------------------------------------------------------*
 | TfmTextResource.SaveResource                                         |
 |                                                                      |
 | Update the resource from the list box strings.                      |
 *----------------------------------------------------------------------*)
procedure TfmTextResource.SaveResource(const undoDetails: string);
var
  i : Integer;
begin
  AddUndoEntry (undoDetails);
  fDetails.BeginUpdate;
  try
    for i := 0 to lvStrings.Items.Count - 1 do
      with lvStrings.Items [i] do
      begin
        fDetails.Strings [i] := SubItems [0];

        if fHexMode then
          fDetails.Ids [i] := StrToInt ('$' + Caption)
        else
          fDetails.Ids [i] := StrToInt (Caption);
      end;

    i := lvStrings.Items.Count;
    while i < fDetails.Count do
      fDetails.Delete(i);
  finally
    fDetails.EndUpdate
  end
end;

(*----------------------------------------------------------------------*
 | TfmTextResource.SetObject                                            |
 |                                                                      |
 | Initialize the form with data from the object                        |
 *----------------------------------------------------------------------*)
procedure TfmTextResource.SetObject(const Value: TObject);
var
  i : Integer;
begin
  inherited;            // *Must* call inherited

  fDetails := ResourceDetails as TTextResourceDetails;

  fIsStrings := not (fDetails is TMessageResourceDetails);
  fHexMode := not fIsStrings;

  lvStrings.Items.BeginUpdate;
  try
    lvStrings.Items.Clear;
    for i := 0 to fDetails.Count - 1 do
    begin
      with lvStrings.Items.Add do
      begin
        if fHexMode then
          Caption := IntToHex (fDetails.Ids [i], 8)
        else
          caption := IntToStr (fDetails.Ids [i]);
        SubItems.Add (fDetails.Strings [i])
      end
    end
  finally
    lvStrings.Items.EndUpdate
  end
end;

(*----------------------------------------------------------------------*
 | TfmTextResource.UpdateActions                                        |
 |                                                                      |
 | Disallow modifying/deleting if nothing's selected                    |
 *----------------------------------------------------------------------*)
procedure TfmTextResource.UpdateActions;
var
  sel : Boolean;
begin
  sel := Assigned (lvStrings.Selected);

  actStringsAdd.Enabled := fDetails is TMessageResourceDetails;
  actStringsModify.Enabled := sel;
  actStringsDelete.Enabled := sel;
  actStringsChangeID.Enabled := sel
end;

procedure TfmTextResource.actStringsChangeIDExecute(Sender: TObject);
begin
  if Assigned (lvStrings.Selected) then
  begin
    fAllowEdit := fDetails is TMessageResourceDetails;
    lvStrings.Selected.EditCaption
  end
end;

end.