mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-18 03:19:17 +02:00
examples: added demo package for generating Pascal from a design form
git-svn-id: trunk@57771 -
This commit is contained in:
parent
3c52bd5001
commit
ac208d729d
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -6452,6 +6452,9 @@ examples/openurltest/openurltest.ico -text
|
|||||||
examples/openurltest/openurltest.lpi svneol=native#text/plain
|
examples/openurltest/openurltest.lpi svneol=native#text/plain
|
||||||
examples/openurltest/openurltest.lpr svneol=native#text/plain
|
examples/openurltest/openurltest.lpr svneol=native#text/plain
|
||||||
examples/openurltest/openurltest.res -text
|
examples/openurltest/openurltest.res -text
|
||||||
|
examples/pascalstream/CopyAsPasPkg/copyaspasdemounit1.pas svneol=native#text/plain
|
||||||
|
examples/pascalstream/CopyAsPasPkg/copyformaspascaldemopkg.lpk svneol=native#text/plain
|
||||||
|
examples/pascalstream/CopyAsPasPkg/copyformaspascaldemopkg.pas svneol=native#text/plain
|
||||||
examples/pascalstream/PascalStream1.lpi svneol=native#text/plain
|
examples/pascalstream/PascalStream1.lpi svneol=native#text/plain
|
||||||
examples/pascalstream/PascalStream1.lpr svneol=native#text/plain
|
examples/pascalstream/PascalStream1.lpr svneol=native#text/plain
|
||||||
examples/pascalstream/unit1.pas svneol=native#text/plain
|
examples/pascalstream/unit1.pas svneol=native#text/plain
|
||||||
|
92
examples/pascalstream/CopyAsPasPkg/copyaspasdemounit1.pas
Normal file
92
examples/pascalstream/CopyAsPasPkg/copyaspasdemounit1.pas
Normal file
@ -0,0 +1,92 @@
|
|||||||
|
{
|
||||||
|
Author: Mattias Gaertner
|
||||||
|
}
|
||||||
|
unit CopyAsPasDemoUnit1;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, FormEditingIntf, IDECommands, MenuIntf, IDEDialogs,
|
||||||
|
LazLoggerBase, CompWriterPas, Forms, Dialogs, Clipbrd;
|
||||||
|
|
||||||
|
resourcestring
|
||||||
|
rsCopyFormAsPascal = 'Copy form as Pascal';
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure CopyFormAsPascal(Sender: TObject);
|
||||||
|
var
|
||||||
|
aDesigner: TIDesigner;
|
||||||
|
MemStream: TMemoryStream;
|
||||||
|
Writer: TCompWriterPas;
|
||||||
|
s: string;
|
||||||
|
begin
|
||||||
|
debugln(['CopyFormAsPascal ',DbgSName(Sender)]);
|
||||||
|
|
||||||
|
// get currently active designer form
|
||||||
|
aDesigner:=FormEditingHook.GetCurrentDesigner;
|
||||||
|
if aDesigner=nil then
|
||||||
|
begin
|
||||||
|
IDEMessageDialog('Missing Designer','Copy form as Pascal needs a designer form.',
|
||||||
|
mtError,[mbOK]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// create a TMemoryStream as storage
|
||||||
|
MemStream:=TMemoryStream.Create;
|
||||||
|
|
||||||
|
// create TCompWriterPas and set its options
|
||||||
|
Writer:=TCompWriterPas.Create(MemStream);
|
||||||
|
try
|
||||||
|
// Writer has various options to make the Pascal suitable for various contexts:
|
||||||
|
// Writer.CurIndent:=2;
|
||||||
|
// Writer.Options:=[...]
|
||||||
|
// Writer.MaxColumn:=80;
|
||||||
|
|
||||||
|
// generate the Pascal
|
||||||
|
FormEditingHook.SaveComponentAsPascal(aDesigner,Writer);
|
||||||
|
|
||||||
|
// copy the MemStream to a string
|
||||||
|
SetLength(s,MemStream.Size);
|
||||||
|
if s<>'' then
|
||||||
|
system.Move(MemStream.Memory^,s[1],length(s));
|
||||||
|
debugln(['CopyFormAsPascal :START=============================================']);
|
||||||
|
debugln(s);
|
||||||
|
debugln(['CopyFormAsPascal :END===============================================']);
|
||||||
|
|
||||||
|
// copy the Pascal to the Clipboard
|
||||||
|
Clipboard.AsText:=s;
|
||||||
|
|
||||||
|
// Hint:
|
||||||
|
// Writer.NeededUnits now contains all units that the generated Pascal needs
|
||||||
|
finally
|
||||||
|
Writer.Free;
|
||||||
|
MemStream.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
var
|
||||||
|
CmdCatDesignerMenu: TIDECommandCategory;
|
||||||
|
CopyFormAsPascalCommand: TIDECommand;
|
||||||
|
begin
|
||||||
|
// get the designer popup menu
|
||||||
|
CmdCatDesignerMenu:=IDECommandList.FindCategoryByName('Designer');
|
||||||
|
if CmdCatDesignerMenu=nil then
|
||||||
|
raise Exception.Create('CopyAsPasDemoUnit1: command category Designer not found');
|
||||||
|
|
||||||
|
// add an IDE command, so the user can set a keyboard shortcut
|
||||||
|
CopyFormAsPascalCommand:=RegisterIDECommand(CmdCatDesignerMenu, 'CopyFormAsPascal',
|
||||||
|
rsCopyFormAsPascal,
|
||||||
|
CleanIDEShortCut,CleanIDEShortCut,nil,@CopyFormAsPascal);
|
||||||
|
|
||||||
|
// add an IDE menu item in the designer's popup menu
|
||||||
|
RegisterIDEMenuCommand(DesignerMenuSectionClipboard,'CopyFormAsPascal',rsCopyFormAsPascal,
|
||||||
|
nil,nil,CopyFormAsPascalCommand);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,31 @@
|
|||||||
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<CONFIG>
|
||||||
|
<Package Version="4">
|
||||||
|
<Name Value="CopyFormAsPascalDemoPkg"/>
|
||||||
|
<Type Value="RunAndDesignTime"/>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<SearchPaths>
|
||||||
|
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)/"/>
|
||||||
|
</SearchPaths>
|
||||||
|
</CompilerOptions>
|
||||||
|
<Files Count="1">
|
||||||
|
<Item1>
|
||||||
|
<Filename Value="copyaspasdemounit1.pas"/>
|
||||||
|
<HasRegisterProc Value="True"/>
|
||||||
|
<UnitName Value="copyaspasdemounit1"/>
|
||||||
|
</Item1>
|
||||||
|
</Files>
|
||||||
|
<RequiredPkgs Count="1">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="IDEIntf"/>
|
||||||
|
</Item1>
|
||||||
|
</RequiredPkgs>
|
||||||
|
<UsageOptions>
|
||||||
|
<UnitPath Value="$(PkgOutDir)"/>
|
||||||
|
</UsageOptions>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
</PublishOptions>
|
||||||
|
</Package>
|
||||||
|
</CONFIG>
|
@ -0,0 +1,22 @@
|
|||||||
|
{ This file was automatically created by Lazarus. Do not edit!
|
||||||
|
This source is only used to compile and install the package.
|
||||||
|
}
|
||||||
|
|
||||||
|
unit CopyFormAsPascalDemoPkg;
|
||||||
|
|
||||||
|
{$warn 5023 off : no warning about unused units}
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
CopyAsPasDemoUnit1, LazarusPackageIntf;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure Register;
|
||||||
|
begin
|
||||||
|
RegisterUnit('CopyAsPasDemoUnit1', @CopyAsPasDemoUnit1.Register);
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
RegisterPackage('CopyFormAsPascalDemoPkg', @Register);
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user