administrator/pascalabcnet
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Controls - добавления

Browse source
This commit is contained in:
miks1965 2018-03-29 22:21:23 +03:00
parent 5af9d25c78
commit 5eaebc003d
7 changed files with 198 additions and 176 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Configuration/GlobalAssemblyInfo.cs
View file

@ -15,7 +15,7 @@ internal static class RevisionClass
public const string Major = "3";
public const string Minor = "3";
public const string Build = "5";
public const string Revision = "1646";
public const string Revision = "1647";
public const string MainVersion = Major + "." + Minor;
public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;

4
Configuration/Version.defs
View file

@ -1,4 +1,4 @@
%MINOR%=3
%REVISION%=1646
%COREVERSION%=5
%REVISION%=1647
%MINOR%=3
%MAJOR%=3

2
ReleaseGenerators/PascalABCNET_version.nsh
View file

@ -1 +1 @@
!define VERSION '3.3.5.1646'
!define VERSION '3.3.5.1647'

273
TestSuite/CompilationSamples/graph3d.pas
View file

@ -2,15 +2,10 @@
// This code is distributed under the GNU LGPL (for details please see \doc\license.txt)
unit Graph3D;
{$reference 'PresentationFramework.dll'}
{$reference 'WindowsBase.dll'}
{$reference 'PresentationCore.dll'}
{$reference System.Xml.dll}
{$reference HelixToolkit.Wpf.dll}
{reference Petzold.Media3D.dll}
{$apptype windows}
uses GraphWPFBase;
uses System.Windows;
uses System.Windows.Controls;
@ -35,22 +30,13 @@ type
GMaterial = System.Windows.Media.Media3D.Material;
GCamera = System.Windows.Media.Media3D.ProjectionCamera;
GRect = System.Windows.Rect;
GWindow = System.Windows.Window;
CameraMode = HelixToolkit.Wpf.CameraMode;
TupleInt3 = (integer, integer, integer);
TupleReal3 = (real, real, real);
Point3D = Point3D;
Point = System.Windows.Point;
{MyWindow = class(GWindow)
public
procedure OnKeyDown(e: KeyEventArgs); override;
end;}
var
MainFormThread: Thread;
app: Application;
MainWindow: GWindow;
hvp: HelixViewport3D;
LightsGroup: Model3DGroup;
gvl: GridLinesVisual3D;
@ -65,16 +51,6 @@ var
/// Событие отжатия клавиши
OnKeyUp: procedure(k: Key);
{procedure MyWindow.OnKeyDown(e: KeyEventArgs);
begin
inherited OnKeyDown(e);
if Graph3D.OnKeyDown<>nil then
begin
Graph3D.OnKeyDown(e.Key);
e.Handled := True;
end;
end;}
function RGB(r, g, b: byte) := Color.Fromrgb(r, g, b);
function ARGB(a, r, g, b: byte) := Color.FromArgb(a, r, g, b);
function P3D(x, y, z: real) := new Point3D(x, y, z);
@ -190,56 +166,6 @@ type
function operator+(a,b: Material): Material; extensionmethod := Invoke&<Material>(GMHelper.Create(a,b).GroupMaterial);
/// --- SystemKeyEvents
procedure SystemOnKeyDown(sender: Object; e: System.Windows.Input.KeyEventArgs);
begin
if OnKeyDown <> nil then
OnKeyDown(e.Key);
end;
procedure SystemOnKeyUp(sender: Object; e: System.Windows.Input.KeyEventArgs) :=
begin
if OnKeyUp <> nil then
OnKeyUp(e.Key);
end;
/// --- SystemMouseEvents
procedure SystemOnMouseDown(sender: Object; e: System.Windows.Input.MouseButtonEventArgs);
begin
var mb := 0;
var p := e.GetPosition(hvp);
if e.LeftButton = MouseButtonState.Pressed then
mb := 1
else if e.RightButton = MouseButtonState.Pressed then
mb := 2;
if OnMouseDown <> nil then
OnMouseDown(p.x, p.y, mb);
end;
procedure SystemOnMouseUp(sender: Object; e: MouseButtonEventArgs);
begin
var mb := 0;
var p := e.GetPosition(hvp);
if e.LeftButton = MouseButtonState.Pressed then
mb := 1
else if e.RightButton = MouseButtonState.Pressed then
mb := 2;
if OnMouseUp <> nil then
OnMouseUp(p.x, p.y, mb);
end;
procedure SystemOnMouseMove(sender: Object; e: MouseEventArgs);
begin
var mb := 0;
var p := e.GetPosition(hvp);
if e.LeftButton = MouseButtonState.Pressed then
mb := 1
else if e.RightButton = MouseButtonState.Pressed then
mb := 2;
if OnMouseMove <> nil then
OnMouseMove(p.x, p.y, mb);
end;
type
///!#
View3DT = class
@ -2758,87 +2684,148 @@ function WindowType.Center := new Point(Width / 2, Height / 2);
function WindowType.ClientRect := Rect(0, 0, Window.Width, Window.Height);
var
mre := new ManualResetEvent(false);
type
Graph3DWindow = class(GMainWindow)
public
procedure InitMainGraphControl; override;
begin
var g := Content as DockPanel;
hvp := new HelixViewport3D();
g.Children.Add(hvp);
procedure InitWPF0;
hvp.ZoomExtentsWhenLoaded := True;
hvp.ShowCoordinateSystem := True;
hvp.Children.Add(new DefaultLights);
var mv := new ModelVisual3D;
LightsGroup := new Model3DGroup;
mv.Content := LightsGroup;
hvp.Children.Add(mv);
gvl := new GridLinesVisual3D();
gvl.Width := 12;
gvl.Length := 12;
gvl.Normal := OrtZ;
gvl.MinorDistance := 1;
gvl.MajorDistance := 1;
gvl.Thickness := 0.02;
hvp.Children.Add(gvl);
end;
procedure InitWindowProperties; override;
begin
(Width,Height) := (800,600);
Title := '3D графика';
WindowStartupLocation := System.Windows.WindowStartupLocation.CenterScreen;
end;
procedure InitGlobals; override;
begin
Window := new WindowType;
Camera := new CameraType;
Lights := new LightsType;
GridLines := new GridLinesType;
View3D := new View3DT;
NameScope.SetNameScope(Self, new NameScope());
end;
/// --- SystemKeyEvents
procedure SystemOnKeyDown(sender: Object; e: System.Windows.Input.KeyEventArgs);
begin
if Graph3D.OnKeyDown <> nil then
Graph3D.OnKeyDown(e.Key);
e.Handled := True;
end;
procedure SystemOnKeyUp(sender: Object; e: System.Windows.Input.KeyEventArgs) :=
begin
if Graph3D.OnKeyUp <> nil then
Graph3D.OnKeyUp(e.Key);
e.Handled := True;
end;
/// --- SystemMouseEvents
procedure SystemOnMouseDown(sender: Object; e: System.Windows.Input.MouseButtonEventArgs);
begin
var mb := 0;
var p := e.GetPosition(hvp);
if e.LeftButton = MouseButtonState.Pressed then
mb := 1
else if e.RightButton = MouseButtonState.Pressed then
mb := 2;
if Graph3D.OnMouseDown <> nil then
Graph3D.OnMouseDown(p.x, p.y, mb);
end;
procedure SystemOnMouseUp(sender: Object; e: MouseButtonEventArgs);
begin
var mb := 0;
var p := e.GetPosition(hvp);
if e.LeftButton = MouseButtonState.Pressed then
mb := 1
else if e.RightButton = MouseButtonState.Pressed then
mb := 2;
if Graph3D.OnMouseUp <> nil then
Graph3D.OnMouseUp(p.x, p.y, mb);
end;
procedure SystemOnMouseMove(sender: Object; e: MouseEventArgs);
begin
var mb := 0;
var p := e.GetPosition(hvp);
if e.LeftButton = MouseButtonState.Pressed then
mb := 1
else if e.RightButton = MouseButtonState.Pressed then
mb := 2;
if Graph3D.OnMouseMove <> nil then
Graph3D.OnMouseMove(p.x, p.y, mb);
end;
procedure InitHandlers; override;
begin
PreviewMouseDown += (o,e) -> SystemOnMouseDown(o,e);
PreviewMouseUp += (o,e) -> SystemOnMouseUp(o,e);
PreviewMouseMove += (o,e) -> SystemOnMouseMove(o,e);
PreviewKeyDown += (o,e)-> SystemOnKeyDown(o,e);
PreviewKeyUp += (o,e)-> SystemOnKeyUp(o,e);
Closed += procedure(sender, e) -> begin Halt; end;
end;
end;
var mre := new ManualResetEvent(false);
procedure InitApp;
begin
app := new Application;
app.Dispatcher.UnhandledException += (o, e) -> begin
Println(e.Exception.Message);
if e.Exception.InnerException<>nil then
Println(e.Exception.InnerException.Message);
halt;
end;
MainWindow := new GWindow;
Window := new WindowType;
Camera := new CameraType;
Lights := new LightsType;
GridLines := new GridLinesType;
var g := new Grid;
MainWindow.Content := g;
hvp := new HelixViewport3D();
g.Children.Add(hvp);
hvp.ZoomExtentsWhenLoaded := True;
hvp.ShowCoordinateSystem := True;
hvp.Children.Add(new DefaultLights);
//hvp.Children.Add(new ThreePointLights);
//var dl := new DirectionalLight(GrayColor(50), new Vector3D(-1.0, -1.0, -1.0));
var mv := new ModelVisual3D;
LightsGroup := new Model3DGroup;
//LightsGroup.Children.Add(dl);
mv.Content := LightsGroup;
hvp.Children.Add(mv);
gvl := new GridLinesVisual3D();
gvl.Width := 12;
gvl.Length := 12;
gvl.Normal := OrtZ;
gvl.MinorDistance := 1;
gvl.MajorDistance := 1;
gvl.Thickness := 0.02;
hvp.Children.Add(gvl);
NameScope.SetNameScope(MainWindow, new NameScope());
MainWindow.Title := '3D графика';
MainWindow.WindowStartupLocation := WindowStartupLocation.CenterScreen;
MainWindow.Width := 640;
MainWindow.Height := 480;
MainWindow.Closed += procedure(sender, e) -> begin Halt; end;
View3D := new View3DT;
MainWindow.PreviewKeyDown += (o,e)-> begin
if OnKeyDown<>nil then
begin
OnKeyDown(e.Key);
end;
e.Handled := True;
end;
MainWindow.PreviewKeyUp += (o,e)-> begin
if OnKeyUp<>nil then
begin
OnKeyUp(e.Key);
end;
e.Handled := True;
end;
MainWindow.PreviewMouseDown += (o,e) -> SystemOnMouseDown(o,e);
MainWindow.PreviewMouseUp += (o,e) -> SystemOnMouseUp(o,e);
MainWindow.PreviewMouseMove += (o,e) -> SystemOnMouseMove(o,e);
MainWindow := new Graph3DWindow;
//MainWindow.MainPanel;
mre.Set();
app.Run(MainWindow);
end;
procedure InitMainThread;
begin
var MainFormThread := new System.Threading.Thread(InitApp);
MainFormThread.SetApartmentState(ApartmentState.STA);
MainFormThread.Start;
mre.WaitOne; // Основная программа не начнется пока не будут инициализированы все компоненты приложения
end;
var
///--
__initialized := false;
@ -2849,11 +2836,7 @@ var
procedure __InitModule;
begin
MainFormThread := new System.Threading.Thread(InitWPF0);
MainFormThread.SetApartmentState(ApartmentState.STA);
MainFormThread.Start;
mre.WaitOne; // Основная программа не начнется пока не будут инициализированы все компоненты приложения
InitMainThread;
end;
///--

73
bin/Lib/Controls.pas
View file

@ -10,10 +10,10 @@ uses System.Windows;
uses System.Windows.Media;
uses System.Windows.Controls;
procedure AddRightPanel(Width: real := 200; c: Color := Colors.LightGray);
procedure AddLeftPanel(Width: real := 200; c: Color := Colors.LightGray);
procedure AddTopPanel(Height: real := 70; c: Color := Colors.LightGray);
procedure AddBottomPanel(Height: real := 70; c: Color := Colors.LightGray);
procedure AddRightPanel(Width: real := 200; c: Color := Colors.LightGray; Margin: real := 10);
procedure AddLeftPanel(Width: real := 200; c: Color := Colors.LightGray; Margin: real := 10);
procedure AddTopPanel(Height: real := 70; c: Color := Colors.LightGray; Margin: real := 10);
procedure AddBottomPanel(Height: real := 70; c: Color := Colors.LightGray; Margin: real := 10);
procedure AddStatusBar(Height: real := 24);
var
@ -72,8 +72,9 @@ type
end;
property Text: string read GetText write SetText;
end;
///!#
TextBlockT = class(CommonControl)
TextLabelT = class(CommonControl)
protected
function b: GTextBlock := element as GTextBlock;
function GetText: string := InvokeString(()->b.Text);
@ -94,6 +95,7 @@ type
end;
property Text: string read GetText write SetText;
end;
///!#
TextBoxT = class(CommonControl)
protected
@ -200,11 +202,51 @@ type
end;
property Text: string read GetText write SetText;
end;
SliderT = class(CommonControl)
private
function sl: Slider := element as Slider;
function GetMinimum: real := InvokeReal(()->sl.Minimum);
procedure SetMinimumP(r: real) := sl.Minimum := r;
procedure SetMinimum(r: real) := Invoke(SetMinimumP,r);
function GetMaximum: real := InvokeReal(()->sl.Maximum);
procedure SetMaximumP(r: real) := sl.Maximum := r;
procedure SetMaximum(r: real) := Invoke(SetMaximumP,r);
function GetValue: real := InvokeReal(()->sl.Value);
procedure SetValueP(r: real) := sl.Value := r;
procedure SetValue(r: real) := Invoke(SetValueP,r);
function GetFrequency: real := InvokeReal(()->sl.TickFrequency);
procedure SetFrequencyP(r: real) := sl.TickFrequency := r;
procedure SetFrequency(r: real) := Invoke(SetFrequencyP,r);
protected
procedure CreateP(min,max,val: real);
begin
element := new Slider;
sl.ValueChanged += procedure(o,e) -> ValueChangedP;
sl.Minimum := min;
sl.Maximum := max;
sl.Value := val;
ActivePanel.Children.Add(sl);
end;
procedure ValueChangedP := if ValueChanged<>nil then ValueChanged;
public
event ValueChanged: procedure;
constructor Create(min,max,val: real);
begin
Invoke(CreateP,min,max,val);
end;
property Minimum: real read GetMinimum write SetMinimum;
property Maximum: real read GetMaximum write SetMaximum;
property Value: real read GetValue write SetValue;
property Frequency: real read GetFrequency write SetFrequency;
end;
function Button(Txt: string): ButtonT;
function TextBlock(Txt: string): TextBlockT;
function TextLabel(Txt: string): TextLabelT;
function TextBox(Txt: string := ''; w: real := 0): TextBoxT;
function IntegerBox(w: real := 0): IntegerBoxT;
function Slider(min: real := 0; max: real := 10; val: real := 0): SliderT;
procedure EmptyBlock(sz: integer := 16);
@ -219,7 +261,7 @@ var
StatusBarPanel: StatusBar;
LeftPanel,RightPanel,TopPanel,BottomPanel: Panel;
procedure AddPanel(var pp: StackPanel; wh: real; d: Dock; c: Color);
procedure AddPanel(var pp: StackPanel; wh: real; d: Dock; c: Color; Margin: real := 10);
begin
if pp<>nil then
exit;
@ -228,7 +270,7 @@ begin
var p := new StackPanel;
bb.Child := p;
//bb.Children.Add(p);
p.Margin := new System.Windows.Thickness(20);
p.Margin := new System.Windows.Thickness(Margin);
if (d = Dock.Left) or (d = Dock.Right) then
begin
p.Orientation := Orientation.Vertical;
@ -240,17 +282,17 @@ begin
bb.Height := wh;
end;
p.Background := new SolidColorBrush(c);
DockPanel.SetDock(p,d);
DockPanel.SetDock(bb,d);
// Всегда добавлять предпоследним
MainDockPanel.children.Insert(MainDockPanel.children.Count-1,bb);
pp := p;
ActivePanel := p;
end;
procedure AddRightPanel(Width: real; c: Color) := Invoke(AddPanel,RightPanel,Width,Dock.Right,c);
procedure AddLeftPanel(Width: real; c: Color) := Invoke(AddPanel,LeftPanel,Width,Dock.Left,c);
procedure AddTopPanel(Height: real; c: Color) := Invoke(AddPanel,TopPanel,Height,Dock.Top,c);
procedure AddBottomPanel(Height: real; c: Color) := Invoke(AddPanel,BottomPanel,Height,Dock.Bottom,c);
procedure AddRightPanel(Width: real; c: Color; Margin: real) := Invoke(AddPanel,RightPanel,Width,Dock.Right,c,Margin);
procedure AddLeftPanel(Width: real; c: Color; Margin: real) := Invoke(AddPanel,LeftPanel,Width,Dock.Left,c,Margin);
procedure AddTopPanel(Height: real; c: Color; Margin: real) := Invoke(AddPanel,TopPanel,Height,Dock.Top,c,Margin);
procedure AddBottomPanel(Height: real; c: Color; Margin: real) := Invoke(AddPanel,BottomPanel,Height,Dock.Bottom,c,Margin);
procedure AddStatusBarP(Height: real);
begin
@ -272,13 +314,14 @@ end;
procedure AddStatusBar(Height: real) := Invoke(AddStatusBarP,Height);
function Button(Txt: string): ButtonT := ButtonT.Create(Txt);
function TextBlock(Txt: string): TextBlockT := TextBlockT.Create(Txt);
function TextLabel(Txt: string): TextLabelT := TextLabelT.Create(Txt);
function TextBox(Txt: string; w: real): TextBoxT := TextBoxT.Create(Txt,w);
function IntegerBox(w: real): IntegerBoxT := IntegerBoxT.Create(w);
function Slider(min,max,val: real): SliderT := SliderT.Create(min,max,val);
procedure EmptyBlock(sz: integer);
begin
var e := TextBlock('');
var e := TextLabel('');
e.Height:= sz;
e.Width:= sz;
end;

13
bin/Lib/Graph3D.pas
View file

@ -59,6 +59,8 @@ function Sz3D(x, y, z: real) := new Size3D(x, y, z);
function Pnt(x, y: real) := new Point(x, y);
function Rect(x, y, w, h: real) := new System.Windows.Rect(x, y, w, h);
function operator*(p: Point3D; r: real); extensionmethod := P3D(p.x*r,p.y*r,p.z*r);
const
OrtX = V3D(1, 0, 0);
OrtY = V3D(0, 1, 0);
@ -91,17 +93,6 @@ function GrayColor(b: byte) := RGB(b, b, b);
function RandomSolidBrush := new SolidColorBrush(RandomColor);
procedure Invoke(d: System.Delegate; params args: array of object) := app.Dispatcher.Invoke(d, args);
procedure Invoke(d: ()->()) := app.Dispatcher.Invoke(d);
function Invoke<T>(d: Func0<T>): T := app.Dispatcher.Invoke&<T>(d);
function InvokeString(d: Func0<string>): string := Invoke&<String>(d);
function InvokeReal(d: Func0<real>): real := Invoke&<Real>(d);
function InvokeBoolean(d: Func0<boolean>): boolean := Invoke&<boolean>(d);
function InvokeInteger(d: Func0<integer>): integer := Invoke&<integer>(d);
function Inv<T>(p: ()->T): T := Invoke&<T>(p); // Теперь это работает!
function wplus := SystemParameters.WindowResizeBorderThickness.Left + SystemParameters.WindowResizeBorderThickness.Right;
function hplus := SystemParameters.WindowCaptionHeight + SystemParameters.WindowResizeBorderThickness.Top + SystemParameters.WindowResizeBorderThickness.Bottom;

7
bin/Lib/GraphWPFBase.pas
View file

@ -52,11 +52,16 @@ var
app: Application;
MainWindow: GMainWindow;
procedure Invoke(d: System.Delegate; params args: array of object) := app.Dispatcher.Invoke(d,args);
procedure Invoke(d: System.Delegate; params args: array of object) := app.Dispatcher.Invoke(d, args);
procedure Invoke(d: ()->()) := app.Dispatcher.Invoke(d);
function Invoke<T>(d: Func0<T>): T := app.Dispatcher.Invoke&<T>(d);
function InvokeReal(f: ()->real): real := Invoke&<Real>(f);
function InvokeString(f: ()->string): string := Invoke&<string>(f);
function InvokeBoolean(d: Func0<boolean>): boolean := Invoke&<boolean>(d);
function InvokeInteger(d: Func0<integer>): integer := Invoke&<integer>(d);
function Inv<T>(p: ()->T): T := Invoke&<T>(p); // Теперь это работает!
function MainDockPanel: DockPanel := MainWindow.MainPanel;