mainform.pas

學習資料網上下載

(*----------------------------------------------------------------------*
 | TfmMain.actEditUndoExecute                                           |
 |                                                                      |
 | Handler for Edit/Undo.  Tell the form to undo changes.               |
 *----------------------------------------------------------------------*)
procedure TfmMain.actEditUndoExecute(Sender: TObject);
var
  res : TResourceDetails;
  resForm : TfmResource;
  st : string;
begin
  resForm := ResourceForm;
  if Assigned (resForm) then
  begin
    resForm.Undo;
    fmResourceObject.Obj := resForm.ResourceDetails
  end;

  res := SelectedResourceDetails;
  if Assigned (res) then
  begin
    if res.ResourceLanguage = 0 then
      st := rstLanguageNeutral
    else
      st := Languages.NameFromLocaleID [res.ResourceLanguage];
    tvResources.Selected.Text := st;

    if res is TStringResourceDetails then
      st := ResIdToStringsId (res.ResourceName)
    else
      st := res.ResourceName;
    tvResources.Selected.Parent.Text := st
  end
end;

(*----------------------------------------------------------------------*
 | TfmMain.actEditRedoExecute                                           |
 |                                                                      |
 | Handler for Edit/Redo.  Tell the form to redo changes.               |
 *----------------------------------------------------------------------*)
procedure TfmMain.actEditRedoExecute(Sender: TObject);
var
  resForm : TfmResource;
begin
  resForm := ResourceForm;
  if Assigned (resForm) then
  begin
    resForm.Redo;
    fmResourceObject.Obj := resForm.ResourceDetails
  end
end;

(*----------------------------------------------------------------------*
 | TfmMain.mnuEditClick                                                 |
 |                                                                      |
 | Before displaying the 'Edit' menu, set the undo and redo             |
 | descriptions                                                         |
 *----------------------------------------------------------------------*)
procedure TfmMain.mnuEditClick(Sender: TObject);
var
  s : string;
  resForm : TfmResource;
begin
  resForm := ResourceForm;
  if Assigned (resForm) then
  begin
    s := resForm.UndoDescription;

    if s = '' then
      mnuEditUndo.Caption := fUndo
    else
      mnuEditUndo.Caption := Format (rstUndo, [s]);

    s := resForm.RedoDescription;

    if s = '' then
      mnuEditRedo.Caption := fRedo
    else
      mnuEditRedo.Caption := Format (rstRedo, [s])
  end
end;

(*----------------------------------------------------------------------*
 | TfmMain.actHelpAboutExecute                                          |
 |                                                                      |
 | Display/execute the about box.                                       |
 *----------------------------------------------------------------------*)
procedure TfmMain.actHelpAboutExecute(Sender: TObject);
begin
  NTAboutBox1.Execute
end;

(*----------------------------------------------------------------------*
 | TfmMain.actResourceExportResourceExecute                             |
 |                                                                      |
 | Display/execute the 'export resource' dialog.  This is either a      |
 | 'save' dialog, or a 'save picture' dialog, depending on the          |
 | resource to be exported.                                             |
 *----------------------------------------------------------------------*)
procedure TfmMain.actResourceExportResourceExecute(Sender: TObject);
var
  pict : TPicture;
  reg : TRegistry;
  cls, cls1 : TGraphicClass;
  ext : string;
  newGraphic : TGraphic;
const
  pfNames : array [TPixelFormat] of string = ('Same as monitor', '2 Colour', '16 Colour', '256 Colour', '', '65536 Colour', 'High Colour', 'True Colour', '');
begin
  pict := nil;
  reg := nil;

  if fmResourceObject.Obj is TIconCursorGroupResourceDetails then
  begin
    pict := TPicture.Create;
    TIconCursorGroupResourceDetails (fmResourceObject.Obj).GetImage (pict)
  end
  else
    if fmResourceObject.Obj is TGraphicsResourceDetails then
    begin
      pict := TPicture.Create;
      TGraphicsResourceDetails (fmResourceObject.Obj).GetImage (pict)
    end;

  if Assigned (pict) then
  try
    if Assigned (pict.Graphic) then
    begin
      reg := TRegistry.Create;

      if reg.OpenKey ('\' + PersistentPosition1.ApplicationKey + '\Directories', False) and
        reg.ValueExists ('Export') then
          SavePictureDialog1.InitialDir := reg.ReadString ('Export');

      cls := TGraphicClass (pict.Graphic.ClassType);
      SavePictureDialog1.DefaultExt := GraphicExtension (cls);

      if SavePictureDialog1.Execute then
      begin
        ext := ExtractFileExt (SavePictureDialog1.FileName);
        cls1 := GetGraphicsClass (ext);

        if cls <> cls1 then
        begin
          newGraphic := CreateCompatibleGraphic (pict.Graphic, cls1);
          try
            newGraphic.SaveToFile(SavePictureDialog1.FileName);
          finally
            newGraphic.Free
          end
        end
        else
          pict.SaveToFile (SavePictureDialog1.FileName);

        if reg.OpenKey ('\' + PersistentPosition1.ApplicationKey + '\Directories', True) then
          reg.WriteString ('Export', ExtractFilePath (SavePictureDialog1.FileName))
      end
    end
  finally
    reg.Free;
    pict.Free
  end
  else if fmResourceObject.Obj is TResourceDetails then
  begin
    SaveDialog.Filter := rstAnyFileFilter;
    SaveDialog.InitialDir := ExtractFilePath (SaveDialog.FileName);
    SaveDialog.FileName := TResourceDetails (fmResourceObject.Obj).ResourceName;
    if SaveDialog.Execute then
      TResourceDetails (fmResourceObject.Obj).Data.SaveToFile(SaveDialog.FileName)
  end
end;

(*----------------------------------------------------------------------*
 | TfmMain.SetCaption                                                   |
 |                                                                      |
 | Set the caption to display the loaded file.                          |
 *----------------------------------------------------------------------*)
procedure TfmMain.SetCaption;
begin
  if FileName = '' then
    Caption := Application.Title
  else
    Caption := ExtractFileName (FileName + ' - ' + Application.Title)
end;

(*----------------------------------------------------------------------*
 | TfmMain.SetFileName                                                  |
 |                                                                      |
 | Set the file name.                                                   |
 *----------------------------------------------------------------------*)
procedure TfmMain.SetFileName(const Value: string);
begin
  if FileName <> Value then
  begin
    fFileName := Value;
    SetCaption
  end
end;

(*----------------------------------------------------------------------*
 | TfmMain.actResourceAddResourceExecute                                |
 |                                                                      |
 | Display/execute the Add Resource dialog.                             |
 *----------------------------------------------------------------------*)
procedure TfmMain.actResourceAddResourceExecute(Sender: TObject);
var
  dlg : TdlgAddResource;
  res : TResourceDetails;
begin
  dlg := TdlgAddResource.Create (nil);
  try
    if dlg.ShowModal = mrOk then
    begin
      res := dlg.ResourceDetailsClass.CreateNew (fResourceModule, 0, fResourceModule.GetUniqueResourceName (dlg.ResourceDetailsClass.GetBaseType));
      res.Dirty := True;
      fResourceModule.SortResources;
      UpdateDisplay
    end
  finally
    dlg.Free
  end
end;

(*----------------------------------------------------------------------*
 | TfmMain.tvResourcesExpanded                                          |
 |                                                                      |
 | Adjust the icon for closed/open folder when a node is expanded       |
 *----------------------------------------------------------------------*)
procedure TfmMain.tvResourcesExpanded(Sender: TObject; Node: TTreeNode);
begin
  Node.ImageIndex := imgOpenFolder;
  Node.SelectedIndex := imgOpenFolder;
end;

(*----------------------------------------------------------------------*
 | TfmMain.tvResourcesCollapsed                                         |
 |                                                                      |
 | Adjust the icon for closed/open folder when a node is expanded       |
 *----------------------------------------------------------------------*)
procedure TfmMain.tvResourcesCollapsed(Sender: TObject; Node: TTreeNode);
begin
  Node.ImageIndex := imgClosedFolder;
  Node.SelectedIndex := imgClosedFolder;
end;

(*----------------------------------------------------------------------*
 | TfmMain.actResourceDeleteResourceExecute                             |
 |                                                                      |
 | Delete the selected resource, and delete the node(s) that refer to   |
 | it.                                                                  |
 *----------------------------------------------------------------------*)
procedure TfmMain.actResourceDeleteResourceExecute(Sender: TObject);
var
  obj, o1 : TObject;
  p, p1 : TTreeNode;
  forceDeleteParent : Boolean;
begin
  if Assigned (tvResources.Selected) then
  begin
    obj := TObject (tvResources.Selected.Data);
    if (Integer (obj) > 32) and (obj is TResourceDetails) then
    begin
      fmResourceObject.Close;           // Close the editor form for the object.
      Application.ProcessMessages;

      p := tvResources.Selected;
      forceDeleteParent := False;
      if obj is TIconCursorResourceDetails then
      begin
        o1 := TObject (p.Parent.Data);
        if (o1 is TIconCursorGroupResourceDetails) and (TIconCursorGroupResourceDetails (o1).ResourceCount = 1) then
          forceDeleteParent := True;

        // Need to establish if DeleteResource is going to nuke the resource details parent if
        // it's the last icon or cursor resource in an icon/cursor group.
        // If so we want to delete the parent node from the tree - otherwise we AV trying to
        // display the (deleted) parent group resource.
      end;

      fResourceModule.DeleteResource (fResourceModule.IndexOfResource (TResourceDetails (obj)));
      repeat            // We've deleted the resource - now delete the tree node
                        // - and the node for the resource name and resource type
                        // if they're empty.

        if forceDeleteParent then
        begin
          p := p.Parent;
          forceDeleteParent := False
        end;

        p1 := p.Parent;
        tvResources.Items.Delete (p);
        p := p1;

        if (p = Nil) or ((p.Data <> Nil) and (TObject (p.Data) is TImageSection)) then
          break
      until p.Count > 0
    end
  end
end;

function TfmMain.IsDirty: Boolean;
begin
  if Assigned (fResourceModule) then
    Result := fResourceModule.Dirty
  else
    Result := False
end;

function TfmMain.SaveChanges: Boolean;
var
  s : string;
begin
  if FileName = '' then
    s := rstUntitled
  else
    s := ExtractFileName (FileName);
  if ISDirty then
    case MessageBox (Handle, PChar (Format (rstChanges, [s])), PChar (Application.Title), MB_YESNOCANCEL or MB_ICONQUESTION) of
      ID_YES : Result := SaveFile;
      ID_CANCEL : Result := False;
      else
        Result := True
    end
  else
    Result := True
end;

function TfmMain.SaveFile: boolean;
begin
  if fFileName = '' then
    Result := SaveFileAs
  else
  begin
    Application.ProcessMessages;
    fResourceModule.SaveToFile (fFileName);
    Result := True
  end
end;

function TfmMain.SaveFileAs: Boolean;
var
  s : string;
  newModule : TResModule;
begin
  Result := False;
  Application.ProcessMessages;  // Ensures that toolbar button doesn't temporarily disappear
  if Assigned (fResourceModule) then
  begin
    SaveDialog.FileName := FileName;

    s := '';
    if FileName <> '' then
    begin
      s := ExtractFileExt (FileName);
      if Length (s) > 0 then
        s := Copy (s, 2, MaxInt)
    end
    else
      if fResourceModule is TResModule then
        s := 'RES';

    SaveDialog.DefaultExt := s;
    if fResourceModule is TResModule then
      SaveDialog.Filter := rstRESFilter
    else