mainform.pas

學習資料網上下載

      SaveDialog.Filter := rstModuleFilter + '|' + rstRESFilter;

    if SaveDialog.Execute then
    begin
      s := UpperCase (ExtractFileExt (SaveDialog.FileName));

      if (fResourceModule is TPEModule) and ((s = '.DCR') or (s = '.RES')) then
      begin
        newModule := TResModule.Create;
        newModule.Assign (fResourceModule);
        FreeAndNil (fResourceModule);
        ClearUndoDetails;
        fResourceModule := newModule;
        UpdateDisplay;
      end;
      fResourceModule.SaveToFile (SaveDialog.FileName);
      FileName := SaveDialog.FileName;
      MRUList1.AddFile (fileName);
      Result := True;
    end
  end
end;

procedure TfmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := SaveChanges
end;

procedure TfmMain.actResourceImportResourceExecute(Sender: TObject);
var
  ResourceDetailsClass : TResourcedetailsClass;
  ext : string;
  res : TResourceDetails;
  img : TPicture;
  reg : TRegistry;
begin
  reg := TRegistry.Create (KEY_READ or KEY_WRITE);
  try
    if reg.OpenKey ('\' + PersistentPosition1.ApplicationKey + '\Directories', False) and
      reg.ValueExists ('Import') then
        OpenPictureDialog1.InitialDir := reg.ReadString ('Import');
  finally
    reg.Free
  end;

  if OpenPictureDialog1.Execute then
  begin
    ext := UpperCase (ExtractFileExt (OpenPictureDialog1.FileName));

    if ext = '.ICO' then
      ResourceDetailsClass := TIconGroupResourceDetails
    else
      if (ext = '.CUR') or (ext = '.ANI') then
        ResourceDetailsClass := TCursorGroupResourceDetails
      else
        if (ext = '.GIF') then
          ResourceDetailsClass := TGIFResourceDetails
        else
          if (ext = '.JPG') or (ext = '.JPEG') then
            ResourceDetailsClass := TJPEGResourceDetails
          else
            ResourceDetailsClass := TBitmapResourceDetails;

    res := ResourceDetailsClass.CreateNew (fResourceModule, 0, fResourceModule.GetUniqueResourceName (ResourceDetailsClass.GetBaseType));
    res.Dirty := True;

    if res is TIconCursorGroupResourceDetails then
      TIconCursorGroupResourceDetails (res).LoadImage (OpenPictureDialog1.FileName)
    else
    begin
      img := TPicture.Create;
      try
        img.LoadFromFile (OpenPictureDialog1.FileName);
        TGraphicsResourceDetails (res).SetImage (img);
      finally
        img.Free
      end
    end;

    reg := TRegistry.Create (KEY_READ or KEY_WRITE);
    try
      if reg.OpenKey ('\' + PersistentPosition1.ApplicationKey + '\Directories', True) then
        reg.WriteString ('Import', ExtractFilePath (OpenPictureDialog1.FileName))
    finally
      reg.Free
    end;

    fResourceModule.SortResources;
    UpdateDisplay
  end

end;

procedure TfmMain.actResourcePropertiesExecute(Sender: TObject);
var
  dlg : TdlgResourceProperties;
  fm : TfmResource;
  newLanguage : LCID;
  newName : string;
  res, r : TResourceDetails;
begin
  fm := ResourceForm;
  res := SelectedResourceDetails;

  if Assigned (res) and Assigned (fm) and not (res is TIconCursorResourceDetails) then
  begin
    dlg := TdlgResourceProperties.Create (nil);
    try
      dlg.ResourceDetails := res;

      if dlg.ShowModal = mrOK then
      begin
        newLanguage := dlg.Language;
        newName := dlg.edName.Text;

        if res is TStringResourceDetails then
          newName := StringsIDToResID (newName);

        if (newLanguage <> res.ResourceLanguage) or (newName <> res.ResourceName) then
        begin
          r := fResourceModule.FindResource (res.ResourceType, newName, newLanguage);
          if Assigned (r) and (r <> res) and (r.ResourceLanguage = newLanguage) then
            raise Exception.Create (rstDuplicateResourceName);

          fm.AddUndoEntry (rstChangeResourceProperties);

          if newLanguage <> res.ResourceLanguage then
          begin
            res.ResourceLanguage := newLanguage;

            if newLanguage = 0 then
              tvResources.Selected.Text := rstLanguageNeutral
            else
              tvResources.Selected.Text := Languages.NameFromLocaleID [newLanguage]
          end;

          if newName <> res.ResourceName then
          begin
            res.ResourceName := newName;
            if res is TStringResourceDetails then
              newName := ResIdToStringsId (newName);
            tvResources.Selected.Parent.Text := newName;

            if res is TStringResourceDetails then
              SwitchView (res)
          end;

        end
      end
    finally
      dlg.Free
    end
  end
end;

function TfmMain.SelectedResourceDetails: TResourceDetails;
begin
  if Assigned (tvResources.Selected) and (TObject (tvResources.Selected.Data) is TResourceDetails) then
    Result := TResourceDetails (tvResources.Selected.Data)
  else
    Result := Nil
end;

procedure TfmMain.actEditSelectAllExecute(Sender: TObject);
begin
  if ResourceForm <> Nil then
    ResourceForm.SelectAll
end;

function TfmMain.ResourceForm: TfmResource;
begin
  if Assigned (fmResourceObject) and (fmResourceObject is TfmResource) then
    Result := TfmResource (fmResourceObject)
  else
    Result := Nil
end;

procedure TfmMain.actEditCopyExecute(Sender: TObject);
begin
  if ResourceForm <> nil then
    ResourceForm.Copy
end;

procedure TfmMain.actEditPasteExecute(Sender: TObject);
begin
  if ResourceForm <> nil then
    ResourceForm.Paste
end;

procedure TfmMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Assigned (fmResourceObject) then
  begin
    fmResourceObject.PreviewKey (key, Shift);
    fIgnoreChar := key = 0;
  end
end;

procedure TfmMain.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if fIgnoreChar then
    key := #0
end;

procedure TfmMain.WmStatusBar(var Msg: TMessage);
begin
  if Msg.lParam <> 0 then
    sbMain.Panels [1].Text := PChar (Msg.lParam) + '     ';

  if Msg.wParam <> 0 then
    sbMain.Panels [0].Text := PChar (Msg.wParam);
end;

procedure TfmMain.actHelpContentsExecute(Sender: TObject);
begin
//  HTMLHelp1.DisplayTopic ('');
end;

function TfmMain.ApplicationEvents1Help(Command: Word; Data: Integer;
  var CallHelp: Boolean): Boolean;
var
  topic : string;
begin
  topic := HelpLink (Data);
//  HTMLHelp1.DisplayTopic (topic);
  CallHelp := False;
  result := True
end;

procedure TfmMain.actResourceImportRCDataResourceExecute(Sender: TObject);
var
  res : TResourceDetails;
  reg : TRegistry;
  f : TMemoryStream;
begin
  reg := TRegistry.Create (KEY_READ or KEY_WRITE);
  try
    if reg.OpenKey ('\' + PersistentPosition1.ApplicationKey + '\Directories', False) and
      reg.ValueExists ('Import') then
        OpenDialog1.InitialDir := reg.ReadString ('Import');
  finally
    reg.Free
  end;

  if OpenDialog1.Execute then
  begin
    f := TMemoryStream.Create;
    f.LoadFromFile (OpenDialog1.FileName);

    res := TResourceDetails.CreateResourceDetails (
      fResourceModule, 0,
      fResourceModule.GetUniqueResourceName (IntToStr (Integer (RT_RCDATA))),
      IntToStr (Integer (RT_RCDATA)),
      f.Size, f.Memory);

    fResourceModule.AddResource (res);

    res.Dirty := True;

    reg := TRegistry.Create (KEY_READ or KEY_WRITE);
    try
      if reg.OpenKey ('\' + PersistentPosition1.ApplicationKey + '\Directories', True) then
        reg.WriteString ('Import', ExtractFilePath (OpenDialog1.FileName))
    finally
      reg.Free
    end;

    fResourceModule.SortResources;
    UpdateDisplay
  end
end;

procedure TfmMain.FormShow(Sender: TObject);
begin
  psMenu.Font := Screen.MenuFont
end;

procedure TfmMain.WmAddImageResource(var msg: TMessage);
var
  o : TResourceDetails;
  grp : TIconCursorGroupResourceDetails;
  res : TIconCursorResourceDetails;
  p : TTreeNode;

begin
  p := tvResources.Selected;

  if Assigned (p) then
    p := p.Parent;

  if Assigned (p) then
  begin
    o := TResourceDetails (p.data);

    if o is TIconCursorGroupResourceDetails then
    begin
      grp := TIconCursorGroupResourceDetails (o);
      if grp is TIconGroupResourceDetails then
        res := TIconResourceDetails.CreateNew (fResourceModule, 0, fResourceModule.GetUniqueResourceName (TIconResourceDetails.GetBaseType))
      else
        res := TCursorResourceDetails.CreateNew (fResourceModule, 0, fResourceModule.GetUniqueResourceName (TCursorResourceDetails.GetBaseType));

      res.Dirty := True;
      grp.AddToGroup (res);
    end
  end;
  fResourceModule.SortResources;
  UpdateDisplay
end;

procedure TfmMain.actResourceImportOtherResourceExecute(Sender: TObject);
var
  res : TResourceDetails;
  reg : TRegistry;
  f : TMemoryStream;
  resType : string;
  resName : string;
begin
  reg := TRegistry.Create (KEY_READ or KEY_WRITE);
  try
    if reg.OpenKey ('\' + PersistentPosition1.ApplicationKey + '\Directories', False) and
      reg.ValueExists ('Import') then
        OpenDialog1.InitialDir := reg.ReadString ('Import');
  finally
    reg.Free
  end;

  if OpenDialog1.Execute then
  begin
    f := TMemoryStream.Create;
    f.LoadFromFile (OpenDialog1.FileName);
    resType := UpperCase (ExtractFileName (OpenDialog1.FileName));
    resName := SplitString ('.', resType);
    if resType = '' then
    begin
      resType := resName;
      resName := fResourceModule.GetUniqueResourceName (resType)
    end;

    res := TResourceDetails.CreateResourceDetails (
      fResourceModule, 0,
      resName,
      resType,
      f.Size, f.Memory);

    fResourceModule.AddResource (res);

    res.Dirty := True;

    reg := TRegistry.Create (KEY_READ or KEY_WRITE);
    try
      if reg.OpenKey ('\' + PersistentPosition1.ApplicationKey + '\Directories', True) then
        reg.WriteString ('Import', ExtractFilePath (OpenDialog1.FileName))
    finally
      reg.Free
    end;

    fResourceModule.SortResources;
    UpdateDisplay
  end
end;

end.