// Copyright (c) Ivan Bondarev, Stanislav Mihalkovich (for details please see \doc\copyright.txt) // This code is distributed under the GNU LGPL (for details please see \doc\license.txt) ///-- unit GraphWPFBase; {$reference 'PresentationFramework.dll'} {$reference 'WindowsBase.dll'} {$reference 'PresentationCore.dll'} {$apptype windows} uses System.Windows; uses System.Windows.Controls; type /// Тип цвета GColor = System.Windows.Media.Color; /// Тип прямоугольника GRect = System.Windows.Rect; GWindow = System.Windows.Window; GMainWindow = class(GWindow) public function CreateContent: DockPanel; virtual; begin var g := new DockPanel; g.LastChildFill := True; Result := g; end; procedure InitMainGraphControl; virtual; begin end; procedure InitWindowProperties; virtual; begin end; procedure InitGlobals; virtual; begin end; procedure InitHandlers; virtual; begin end; constructor Create; begin Content := CreateContent; InitMainGraphControl; InitGlobals; InitWindowProperties; InitHandlers; end; function MainPanel: DockPanel := Content as DockPanel; end; var app: Application; MainWindow: GMainWindow; procedure Invoke(d: System.Delegate; params args: array of object) := app.Dispatcher.Invoke(d, args); procedure InvokeP(p: procedure(r: real); r: real) := Invoke(p,r); procedure Invoke(d: ()->()) := app.Dispatcher.Invoke(d); function Invoke(d: Func0): T := T(app.Dispatcher.Invoke(d)); function InvokeReal(f: ()->real): real := Invoke&(f); function InvokeString(f: ()->string): string := Invoke&(f); function InvokeBoolean(d: Func0): boolean := Invoke&(d); function InvokeInteger(d: Func0): integer := Invoke&(d); function Inv(p: ()->T): T := Invoke&(p); // Теперь это работает! function MainDockPanel: DockPanel := MainWindow.MainPanel; //{{{doc: Начало секции 1 }}} type // ----------------------------------------------------- //>> Класс WindowType # WindowType class // ----------------------------------------------------- ///!# /// Тип главного окна приложения WindowType = class private procedure SetLeft(l: real); function GetLeft: real; procedure SetTop(t: real); function GetTop: real; procedure SetWidth(w: real); function GetWidth: real; procedure SetHeight(h: real); function GetHeight: real; procedure SetCaption(c: string); function GetCaption: string; public /// Отступ главного окна от левого края экрана property Left: real read GetLeft write SetLeft; /// Отступ главного окна от верхнего края экрана property Top: real read GetTop write SetTop; /// Ширина клиентской части главного окна property Width: real read GetWidth write SetWidth; /// Высота клиентской части главного окна property Height: real read GetHeight write SetHeight; /// Заголовок окна property Caption: string read GetCaption write SetCaption; /// Заголовок окна property Title: string read GetCaption write SetCaption; /// Очищает графическое окно белым цветом procedure Clear; virtual; /// Очищает графическое окно цветом c procedure Clear(c: GColor); virtual; /// Устанавливает размеры клиентской части главного окна procedure SetSize(w, h: real); /// Устанавливает отступ главного окна от левого верхнего края экрана procedure SetPos(l, t: real); /// Закрывает главное окно и завершает приложение procedure Close; /// Сворачивает главное окно procedure Minimize; /// Максимизирует главное окно procedure Maximize; /// Возвращает главное окно к нормальному размеру procedure Normalize; /// Центрирует главное окно по центру экрана procedure CenterOnScreen; /// Возвращает центр главного окна function Center: Point; /// Возвращает прямоугольник клиентской области окна function ClientRect: GRect; private procedure CenterOnScreenP; end; //{{{--doc: Конец секции 1 }}} function wplus := SystemParameters.WindowResizeBorderThickness.Left + SystemParameters.WindowResizeBorderThickness.Right; function hplus := SystemParameters.WindowCaptionHeight + SystemParameters.WindowResizeBorderThickness.Top + SystemParameters.WindowResizeBorderThickness.Bottom; ///---- Window ----- procedure WindowTypeSetLeftP(l: real) := MainWindow.Left := l; procedure WindowType.SetLeft(l: real) := Invoke(WindowTypeSetLeftP,l); function WindowTypeGetLeftP := MainWindow.Left; function WindowType.GetLeft := InvokeReal(WindowTypeGetLeftP); procedure WindowTypeSetTopP(t: real) := MainWindow.Top := t; procedure WindowType.SetTop(t: real) := Invoke(WindowTypeSetTopP,t); function WindowTypeGetTopP := MainWindow.Top; function WindowType.GetTop := InvokeReal(WindowTypeGetTopP); procedure WindowTypeSetWidthP(w: real) := MainWindow.Width := w + wplus; procedure WindowType.SetWidth(w: real) := Invoke(WindowTypeSetWidthP,w); function WindowTypeGetWidthP := MainWindow.ActualWidth - wplus; function WindowType.GetWidth := InvokeReal(WindowTypeGetWidthP); procedure WindowTypeSetHeightP(h: real) := MainWindow.Height := h + hplus; procedure WindowType.SetHeight(h: real) := Invoke(WindowTypeSetHeightP,h); function WindowTypeGetHeightP := MainWindow.ActualHeight - hplus; function WindowType.GetHeight := InvokeReal(WindowTypeGetHeightP); procedure WindowTypeSetCaptionP(c: string) := MainWindow.Title := c; procedure WindowType.SetCaption(c: string) := Invoke(WindowTypeSetCaptionP,c); function WindowTypeGetCaptionP := MainWindow.Title; function WindowType.GetCaption := Invoke&(WindowTypeGetCaptionP); procedure WindowTypeClearP := begin {Host.children.Clear; CountVisuals := 0;} end; procedure WindowType.Clear := Invoke(WindowTypeClearP); procedure WindowType.Clear(c: GColor); begin raise new System.NotImplementedException('WindowType.Clear(c) пока не реализовано. Честное слово - в будущем!') end; procedure WindowTypeSetSizeP(w, h: real); begin WindowTypeSetWidthP(w); WindowTypeSetHeightP(h); end; procedure WindowType.SetSize(w, h: real) := Invoke(WindowTypeSetSizeP,w,h); procedure WindowTypeSetPosP(l, t: real); begin WindowTypeSetLeftP(l); WindowTypeSetTopP(t); end; procedure WindowType.SetPos(l, t: real) := Invoke(WindowTypeSetPosP,l,t); procedure WindowType.Close := Invoke(MainWindow.Close); procedure WindowTypeMinimizeP := MainWindow.WindowState := WindowState.Minimized; procedure WindowType.Minimize := Invoke(WindowTypeMinimizeP); procedure WindowTypeMaximizeP := MainWindow.WindowState := WindowState.Maximized; procedure WindowType.Maximize := Invoke(WindowTypeMaximizeP); procedure WindowTypeNormalizeP := MainWindow.WindowState := WindowState.Normal; procedure WindowType.Normalize := Invoke(WindowTypeNormalizeP); procedure WindowType.CenterOnScreenP; begin var w := SystemParameters.PrimaryScreenWidth - MainWindow.Width; var h := SystemParameters.PrimaryScreenHeight - Mainwindow.Height; SetPos(w/2,h/2); end; procedure WindowType.CenterOnScreen := Invoke(CenterOnScreenP); 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 WindowType.Center := Pnt(Width/2,Height/2); function WindowType.ClientRect := Rect(0,0,Width,Height); function operator implicit(Self: (integer, integer)): Point; extensionmethod := new Point(Self[0], Self[1]); function operator implicit(Self: (integer, real)): Point; extensionmethod := new Point(Self[0], Self[1]); function operator implicit(Self: (real, integer)): Point; extensionmethod := new Point(Self[0], Self[1]); function operator implicit(Self: (real, real)): Point; extensionmethod := new Point(Self[0], Self[1]); function operator implicit(Self: (integer, integer)): Size; extensionmethod := new Size(Self[0], Self[1]); function operator implicit(Self: (integer, real)): Size; extensionmethod := new Size(Self[0], Self[1]); function operator implicit(Self: (real, integer)): Size; extensionmethod := new Size(Self[0], Self[1]); function operator implicit(Self: (real, real)): Size; extensionmethod := new Size(Self[0], Self[1]); function operator implicit(Self: array of (real, real)): array of Point; extensionmethod := Self.Select(t->new Point(t[0],t[1])).ToArray; function operator implicit(Self: array of (integer, integer)): array of Point; extensionmethod := Self.Select(t->new Point(t[0],t[1])).ToArray; procedure SetLeft(Self: UIElement; l: integer); extensionmethod := Canvas.SetLeft(Self,l); procedure SetTop(Self: UIElement; t: integer); extensionmethod := Canvas.SetTop(Self,t); var __initialized: boolean; procedure __InitModule; begin end; procedure __InitModule__; begin if not __initialized then begin __initialized := true; __InitModule; end; end; begin __InitModule; end.