-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Nikolay Belykh
committed
Jul 21, 2024
0 parents
commit d30b389
Showing
9 changed files
with
301 additions
and
0 deletions.
There are no files selected for viewing
Binary file not shown.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,169 @@ | ||
<?xml version="1.0" encoding="UTF-8"?> | ||
<CONFIG> | ||
<ProjectOptions> | ||
<Version Value="12"/> | ||
<PathDelim Value="\"/> | ||
<General> | ||
<Flags> | ||
<CompatibilityMode Value="True"/> | ||
</Flags> | ||
<Title Value="Visio VBA Save As"/> | ||
<ResourceType Value="res"/> | ||
<UseXPManifest Value="True"/> | ||
<XPManifest> | ||
<TextName Value="Visio VBA Save As"/> | ||
<TextDesc Value="Visio VBA Save As"/> | ||
</XPManifest> | ||
</General> | ||
<i18n> | ||
<EnableI18N LFM="False"/> | ||
</i18n> | ||
<VersionInfo> | ||
<UseVersionInfo Value="True"/> | ||
<MajorVersionNr Value="1"/> | ||
<StringTable CompanyName="Paul Herber" FileDescription="Visio VBA Save As" InternalName="Visio VBA Save As" LegalCopyright="Copyright 2022 Paul Herber" OriginalFilename="Visio VBA Save As" ProductName="Visio VBA Save As" ProductVersion="1.0"/> | ||
</VersionInfo> | ||
<BuildModes Count="1" Active="Default"> | ||
<Item1 Name="Default" Default="True"/> | ||
</BuildModes> | ||
<PublishOptions> | ||
<Version Value="2"/> | ||
</PublishOptions> | ||
<RunParams> | ||
<FormatVersion Value="2"/> | ||
<Modes Count="1"> | ||
<Mode0 Name="default"/> | ||
</Modes> | ||
</RunParams> | ||
<RequiredPackages Count="1"> | ||
<Item1> | ||
<PackageName Value="LCL"/> | ||
</Item1> | ||
</RequiredPackages> | ||
<Units Count="2"> | ||
<Unit0> | ||
<Filename Value="outputdialog.lpr"/> | ||
<IsPartOfProject Value="True"/> | ||
<EditorIndex Value="1"/> | ||
<CursorPos X="15" Y="21"/> | ||
<UsageCount Value="69"/> | ||
<Loaded Value="True"/> | ||
</Unit0> | ||
<Unit1> | ||
<Filename Value="unit1.pas"/> | ||
<IsPartOfProject Value="True"/> | ||
<ComponentName Value="Form1"/> | ||
<HasResources Value="True"/> | ||
<ResourceBaseClass Value="Form"/> | ||
<UnitName Value="Unit1"/> | ||
<IsVisibleTab Value="True"/> | ||
<TopLine Value="59"/> | ||
<CursorPos X="66" Y="85"/> | ||
<UsageCount Value="69"/> | ||
<Loaded Value="True"/> | ||
<LoadedDesigner Value="True"/> | ||
</Unit1> | ||
</Units> | ||
<JumpHistory Count="16" HistoryIndex="15"> | ||
<Position1> | ||
<Filename Value="unit1.pas"/> | ||
</Position1> | ||
<Position2> | ||
<Filename Value="unit1.pas"/> | ||
<Caret Line="36" Column="9" TopLine="20"/> | ||
</Position2> | ||
<Position3> | ||
<Filename Value="outputdialog.lpr"/> | ||
</Position3> | ||
<Position4> | ||
<Filename Value="outputdialog.lpr"/> | ||
<Caret Line="19"/> | ||
</Position4> | ||
<Position5> | ||
<Filename Value="unit1.pas"/> | ||
<Caret Line="55" Column="40" TopLine="35"/> | ||
</Position5> | ||
<Position6> | ||
<Filename Value="unit1.pas"/> | ||
<Caret Line="52" Column="7" TopLine="39"/> | ||
</Position6> | ||
<Position7> | ||
<Filename Value="unit1.pas"/> | ||
<Caret Line="53" Column="25" TopLine="42"/> | ||
</Position7> | ||
<Position8> | ||
<Filename Value="outputdialog.lpr"/> | ||
<Caret Line="6" Column="39"/> | ||
</Position8> | ||
<Position9> | ||
<Filename Value="unit1.pas"/> | ||
<Caret Line="49" Column="28" TopLine="29"/> | ||
</Position9> | ||
<Position10> | ||
<Filename Value="unit1.pas"/> | ||
<Caret Line="52" Column="32" TopLine="29"/> | ||
</Position10> | ||
<Position11> | ||
<Filename Value="unit1.pas"/> | ||
<Caret Line="51" Column="16" TopLine="29"/> | ||
</Position11> | ||
<Position12> | ||
<Filename Value="unit1.pas"/> | ||
<Caret Line="52" Column="7" TopLine="22"/> | ||
</Position12> | ||
<Position13> | ||
<Filename Value="outputdialog.lpr"/> | ||
<Caret Line="21" Column="19"/> | ||
</Position13> | ||
<Position14> | ||
<Filename Value="unit1.pas"/> | ||
<Caret Line="34" Column="13" TopLine="21"/> | ||
</Position14> | ||
<Position15> | ||
<Filename Value="unit1.pas"/> | ||
<Caret Line="33" Column="13" TopLine="20"/> | ||
</Position15> | ||
<Position16> | ||
<Filename Value="unit1.pas"/> | ||
<Caret Line="32" Column="13" TopLine="19"/> | ||
</Position16> | ||
</JumpHistory> | ||
</ProjectOptions> | ||
<CompilerOptions> | ||
<Version Value="11"/> | ||
<PathDelim Value="\"/> | ||
<Target> | ||
<Filename Value="VisioVBASaveAs"/> | ||
</Target> | ||
<SearchPaths> | ||
<IncludeFiles Value="$(ProjOutDir)"/> | ||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> | ||
</SearchPaths> | ||
<Linking> | ||
<Debugging> | ||
<GenerateDebugInfo Value="False"/> | ||
<UseLineInfoUnit Value="False"/> | ||
<StripSymbols Value="True"/> | ||
<UseExternalDbgSyms Value="True"/> | ||
</Debugging> | ||
<Options> | ||
<Win32> | ||
<GraphicApplication Value="True"/> | ||
</Win32> | ||
</Options> | ||
</Linking> | ||
</CompilerOptions> | ||
<Debugging> | ||
<Exceptions Count="3"> | ||
<Item1> | ||
<Name Value="EAbort"/> | ||
</Item1> | ||
<Item2> | ||
<Name Value="ECodetoolError"/> | ||
</Item2> | ||
<Item3> | ||
<Name Value="EFOpenError"/> | ||
</Item3> | ||
</Exceptions> | ||
</Debugging> | ||
</CONFIG> |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,24 @@ | ||
program outputdialog; | ||
|
||
{$mode objfpc}{$H+} | ||
|
||
uses | ||
{$IFDEF UNIX}{$IFDEF UseCThreads} | ||
cthreads, | ||
{$ENDIF}{$ENDIF} | ||
Interfaces, // this includes the LCL widgetset | ||
Forms, Unit1; | ||
|
||
{$R *.res} | ||
|
||
|
||
begin | ||
RequireDerivedFormResource:=True; | ||
Application.Scaled:=True; | ||
Application.Title:='Visio VBA Save As'; | ||
Application.Initialize; | ||
Application.CreateForm(TForm1, Form1); | ||
Form1.Close; | ||
Application.Run; | ||
end. | ||
|
Binary file not shown.
Binary file not shown.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,14 @@ | ||
object Form1: TForm1 | ||
Left = 562 | ||
Height = 134 | ||
Top = 208 | ||
Width = 169 | ||
Caption = 'Visio VBA Save As' | ||
OnCreate = FormCreate | ||
LCLVersion = '2.2.0.4' | ||
Visible = True | ||
object SaveDialog1: TSaveDialog | ||
Left = 52 | ||
Top = 41 | ||
end | ||
end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,93 @@ | ||
unit Unit1; | ||
|
||
{$mode objfpc}{$H+} | ||
|
||
interface | ||
|
||
uses | ||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs; | ||
|
||
type | ||
|
||
{ TForm1 } | ||
|
||
TForm1 = class(TForm) | ||
SaveDialog1: TSaveDialog; | ||
procedure Button1Click(Sender: TObject); | ||
procedure FormCreate(Sender: TObject); | ||
private | ||
{ private declarations } | ||
public | ||
{ public declarations } | ||
end; | ||
|
||
var | ||
Form1: TForm1; | ||
|
||
implementation | ||
|
||
{$R *.lfm} | ||
|
||
{ TForm1 } | ||
|
||
uses ComObj; | ||
|
||
{$DEFINE ExitIfNoVisio} | ||
|
||
const | ||
ServerName = 'Visio.Application'; | ||
|
||
var | ||
i: integer; | ||
theText: string; | ||
Server, activeDoc: Variant; | ||
|
||
|
||
procedure TForm1.Button1Click(Sender: TObject); | ||
begin | ||
Close; | ||
end; | ||
|
||
procedure TForm1.FormCreate(Sender: TObject); | ||
var | ||
path, filename: string; | ||
begin | ||
RequireDerivedFormResource:=True; | ||
Application.Scaled:=True; | ||
theText := ''; | ||
if ParamCount > 4 then | ||
begin | ||
for i := 5 to ParamCount do | ||
begin | ||
theText := theText + ParamStr(i) + ' '; | ||
end; | ||
//ShowMessage(theText); | ||
end; | ||
try | ||
Server := GetActiveOleObject(ServerName); | ||
except | ||
ShowMessage('This addon can only be run from inside Visio VBA.'); | ||
{$IFDEF ExitIfNoVisio} | ||
Exit; | ||
{$ENDIF} | ||
end; | ||
try | ||
activeDoc := Server.ActiveDocument; | ||
path := ExtractFilePath(theText); | ||
fileName := ExtractFileName(theText); | ||
SaveDialog1.InitialDir := path; | ||
SaveDialog1.FileName := fileName; | ||
if SaveDialog1.Execute then | ||
begin | ||
activeDoc.SaveAs(SaveDialog1.FileName); | ||
end; | ||
except | ||
ShowMessage('This addon can only be run from inside Visio VBA.'); | ||
{$IFDEF ExitIfNoVisio} | ||
Exit; | ||
{$ENDIF} | ||
end; | ||
end; | ||
|
||
end. | ||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1 @@ | ||
1.0 |