diff --git a/Example/TDelphiManager/pExample.identcache b/Example/TDelphiManager/pExample.identcache index 81d0b01..90632ba 100644 Binary files a/Example/TDelphiManager/pExample.identcache and b/Example/TDelphiManager/pExample.identcache differ diff --git a/Package/Delphi_XE5/LINA_D_XE5.identcache b/Package/Delphi_XE5/LINA_D_XE5.identcache index 3e56f58..4404730 100644 Binary files a/Package/Delphi_XE5/LINA_D_XE5.identcache and b/Package/Delphi_XE5/LINA_D_XE5.identcache differ diff --git a/Resource/Compiled/uFrmCtrls.dcr b/Resource/Compiled/uFrmCtrls.dcr index 1ca872b..01cf3d9 100644 Binary files a/Resource/Compiled/uFrmCtrls.dcr and b/Resource/Compiled/uFrmCtrls.dcr differ diff --git a/Resource/LINA.rc b/Resource/LINA.rc index 2160db1..96118e8 100644 --- a/Resource/LINA.rc +++ b/Resource/LINA.rc @@ -23,6 +23,9 @@ TCURSORFIX32 BITMAP "Bitmap\Large\TCursorFix.bmp" TDELPHIMANAGER BITMAP "Bitmap\TDelphiManager.bmp" TDELPHIMANAGER16 BITMAP "Bitmap\Small\TDelphiManager.bmp" TDELPHIMANAGER32 BITMAP "Bitmap\Large\TDelphiManager.bmp" +TDIAGRAM BITMAP "Bitmap\TDiagram.bmp" +TDIAGRAM16 BITMAP "Bitmap\Small\TDiagram.bmp" +TDIAGRAM32 BITMAP "Bitmap\Large\TDiagram.bmp" TDOWNLOAD BITMAP "Bitmap\TDownload.bmp" TDOWNLOAD16 BITMAP "Bitmap\Small\TDownload.bmp" TDOWNLOAD32 BITMAP "Bitmap\Large\TDownload.bmp" diff --git a/Source/Compiled/uAdvCtrls.dcu b/Source/Compiled/uAdvCtrls.dcu index 7974a79..c63d665 100644 Binary files a/Source/Compiled/uAdvCtrls.dcu and b/Source/Compiled/uAdvCtrls.dcu differ diff --git a/Source/Compiled/uBase.dcu b/Source/Compiled/uBase.dcu index a453840..c7d588b 100644 Binary files a/Source/Compiled/uBase.dcu and b/Source/Compiled/uBase.dcu differ diff --git a/Source/Compiled/uCalc.dcu b/Source/Compiled/uCalc.dcu index ad3987f..056efca 100644 Binary files a/Source/Compiled/uCalc.dcu and b/Source/Compiled/uCalc.dcu differ diff --git a/Source/Compiled/uFileCtrls.dcu b/Source/Compiled/uFileCtrls.dcu index 9f1b745..e0f0aca 100644 Binary files a/Source/Compiled/uFileCtrls.dcu and b/Source/Compiled/uFileCtrls.dcu differ diff --git a/Source/Compiled/uFileTools.dcu b/Source/Compiled/uFileTools.dcu index 0aaff7b..51927b6 100644 Binary files a/Source/Compiled/uFileTools.dcu and b/Source/Compiled/uFileTools.dcu differ diff --git a/Source/Compiled/uFrmCtrls.dcu b/Source/Compiled/uFrmCtrls.dcu index 589b2e6..fb41b5c 100644 Binary files a/Source/Compiled/uFrmCtrls.dcu and b/Source/Compiled/uFrmCtrls.dcu differ diff --git a/Source/Compiled/uInit.dcu b/Source/Compiled/uInit.dcu index 189cdfc..bb7aa53 100644 Binary files a/Source/Compiled/uInit.dcu and b/Source/Compiled/uInit.dcu differ diff --git a/Source/Compiled/uLocalMgr.dcu b/Source/Compiled/uLocalMgr.dcu index 9decf56..182fc64 100644 Binary files a/Source/Compiled/uLocalMgr.dcu and b/Source/Compiled/uLocalMgr.dcu differ diff --git a/Source/Compiled/uScriptMgr.dcu b/Source/Compiled/uScriptMgr.dcu index 6d60494..399044c 100644 Binary files a/Source/Compiled/uScriptMgr.dcu and b/Source/Compiled/uScriptMgr.dcu differ diff --git a/Source/Compiled/uSysCtrls.dcu b/Source/Compiled/uSysCtrls.dcu index 1d5efeb..b3f70d6 100644 Binary files a/Source/Compiled/uSysCtrls.dcu and b/Source/Compiled/uSysCtrls.dcu differ diff --git a/Source/Compiled/uSysTools.dcu b/Source/Compiled/uSysTools.dcu index d52731f..21cd013 100644 Binary files a/Source/Compiled/uSysTools.dcu and b/Source/Compiled/uSysTools.dcu differ diff --git a/Source/Compiled/uVirtObj.dcu b/Source/Compiled/uVirtObj.dcu index d32a043..71c9120 100644 Binary files a/Source/Compiled/uVirtObj.dcu and b/Source/Compiled/uVirtObj.dcu differ diff --git a/Source/Compiled/uWebCtrls.dcu b/Source/Compiled/uWebCtrls.dcu index 2287a2a..90fdd9f 100644 Binary files a/Source/Compiled/uWebCtrls.dcu and b/Source/Compiled/uWebCtrls.dcu differ diff --git a/Source/uAdvCtrls.pas b/Source/uAdvCtrls.pas index 3eb2b7e..0c304e7 100644 --- a/Source/uAdvCtrls.pas +++ b/Source/uAdvCtrls.pas @@ -3,7 +3,7 @@ unit uAdvCtrls; ////////////////////////////////////// /// Lina Advanced Controls Unit /// /// **************************** /// -/// (c) 2015 Dennis Göhlert a.o. /// +/// (c) 2016 Dennis Göhlert a.o. /// ////////////////////////////////////// {$I 'Config.inc'} @@ -29,6 +29,8 @@ type type { Ereignisse } TPaintMemoPaintEvent = procedure(Sender: TObject) of object; + TShortcutLabelOpenTargetEvent = procedure(Sender: TObject) of object; + TShortcutLabelOpenTargetQueryEvent = procedure(Sender: TObject; var CanOpen: Boolean) of object; type { Hauptklassen } @@ -184,11 +186,15 @@ type private { Private-Deklarationen } FAbout: TComponentAbout; + FAutoOpenTarget: Boolean; FTarget: String; FState: TShortcutLabelState; FFont: TShortcutLabelFont; FHighlightVisited: Boolean; FStoreVisited: Boolean; + { Ereignisse } + FOpenTargetEvent: TShortcutLabelOpenTargetEvent; + FOpenTargetQueryEvent: TShortcutLabelOpenTargetQueryEvent; { Methoden } procedure SetFont(Value: TShortcutLabelFont); procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; @@ -202,9 +208,13 @@ type procedure Click; override; property State: TShortcutLabelState read FState default slsDefault; published + { Ereignisse } + property OnOpenTarget: TShortcutLabelOpenTargetEvent read FOpenTargetEvent write FOpenTargetEvent; + property OnOpenTargetQuery: TShortcutLabelOpenTargetQueryEvent read FOpenTargetQueryEvent write FOpenTargetQueryEvent; { Published-Deklarationen } property Cursor default crHandPoint; property About: TComponentAbout read FAbout; + property AutoOpenTarget: Boolean read FAutoOpenTarget write FAutoOpenTarget default True; property Target: String read FTarget write FTarget; property Font: TShortcutLabelFont read FFont write SetFont; property HighlightVisited: Boolean read FHighlightVisited write FHighlightVisited default True; @@ -752,6 +762,7 @@ constructor TShortcutLabel.Create(AOwner: TComponent); begin inherited; FAbout := TComponentAbout.Create(TShortcutLabel); + FAutoOpenTarget := True; FState := slsDefault; FFont := TShortcutLabelFont.Create(Self); FHighlightVisited := True; @@ -771,17 +782,30 @@ end; procedure TShortcutLabel.Click; var Index: Integer; + CanOpen: Boolean; begin inherited; - if Length(Target) <> 0 then + if (AutoOpenTarget = True) and (Length(Target) <> 0) then begin - ExecuteFile(Target); - if StoreVisited = True then + CanOpen := True; + if Assigned(OnOpenTargetQuery) = True then begin - VisitedTargets.Add(Target); - for Index := 0 to ShortcutLabels.Count - 1 do + OnOpenTargetQuery(Self,CanOpen); + end; + if CanOpen = True then + begin + ExecuteFile(Target); + if StoreVisited = True then begin - (ShortcutLabels.Items[Index] as TShortcutLabel).Font.Update; + VisitedTargets.Add(Target); + for Index := 0 to ShortcutLabels.Count - 1 do + begin + (ShortcutLabels.Items[Index] as TShortcutLabel).Font.Update; + end; + end; + if Assigned(OnOpenTarget) = True then + begin + OnOpenTarget(Self); end; end; end; diff --git a/Source/uBase.pas b/Source/uBase.pas index e223248..8f4ddfd 100644 --- a/Source/uBase.pas +++ b/Source/uBase.pas @@ -3,7 +3,7 @@ unit uBase; ////////////////////////////////////// /// Lina Base Unit /// /// **************************** /// -/// (c) 2015 Dennis Göhlert a.o. /// +/// (c) 2016 Dennis Göhlert a.o. /// ////////////////////////////////////// {$I 'Config.inc'} diff --git a/Source/uCalc.pas b/Source/uCalc.pas index 02210ac..b68888e 100644 --- a/Source/uCalc.pas +++ b/Source/uCalc.pas @@ -3,7 +3,7 @@ unit uCalc; ////////////////////////////////////// /// Lina Calculator Unit /// /// **************************** /// -/// (c) 2015 Dennis Göhlert a.o. /// +/// (c) 2016 Dennis Göhlert a.o. /// ////////////////////////////////////// {$I 'Config.inc'} diff --git a/Source/uFileCtrls.pas b/Source/uFileCtrls.pas index e7a2862..62c109d 100644 --- a/Source/uFileCtrls.pas +++ b/Source/uFileCtrls.pas @@ -3,7 +3,7 @@ unit uFileCtrls; ////////////////////////////////////// /// Lina File Controls Unit /// /// **************************** /// -/// (c) 2015 Dennis Göhlert a.o. /// +/// (c) 2016 Dennis Göhlert a.o. /// ////////////////////////////////////// {$I 'Config.inc'} diff --git a/Source/uFileTools.pas b/Source/uFileTools.pas index 4468045..ede7263 100644 --- a/Source/uFileTools.pas +++ b/Source/uFileTools.pas @@ -3,7 +3,7 @@ unit uFileTools; ////////////////////////////////////// /// Lina File Tools Unit /// /// **************************** /// -/// (c) 2015 Dennis Göhlert a.o. /// +/// (c) 2016 Dennis Göhlert a.o. /// ////////////////////////////////////// {$I 'Config.inc'} @@ -27,10 +27,12 @@ type EMissingExts = class(Exception); EInvalidStyle = class(Exception); ENoGetFileOwner = class(Exception); + EDllFileNoExist = class(Exception); + EDllMethodNoExist = class(Exception); type { Hilfsklassen } - TFileExecuteMode = (feOpen,feEdit,feExplore,feFind,fePrint); + TFileExecuteMode = (feOpen,feEdit,feExplore,feFind,fePrint,feProperties,feRunAs,feRunAsUser); TFileNameStyles = set of (fnDirectory,fnExtension); TFileAttributes = set of (faReadOnly,faHidden,faSystem,faArchive,faTemporary); TInvalidFileName = String[4]; @@ -38,6 +40,34 @@ type type { Hauptklassen } + TDllFile = record + FileName: String; + Handle: THandle; + end; + + TDllManager = class + private + { Private-Deklarationen } + FFileName: String; + FFiles: array of TDllFile; + function GetFiles(Index: Integer): TDllFile; + function GetFileCount: Integer; + public + { Public-Deklarationen } + constructor Create; + destructor Destroy; override; + property Files[Index: Integer]: TDllFile read GetFiles; + property FileCount: Integer read GetFileCount; + procedure Load(const FileName: String); + procedure Close(DLL: TDllFile); overload; + procedure Close(FileName: String); overload; + procedure Close(Handle: THandle); overload; + function GetMethod(Name: String): Pointer; + function GetProcedure(Name: String): TProcedure; + function MethodExists(Name: String): Boolean; + function LibraryExists(FileName: String): Boolean; + end; + TWinFileInfo = class private { Private-Deklarationen } @@ -341,6 +371,9 @@ begin feExplore: Result := 'explore'; feFind: Result := 'find'; fePrint: Result := 'print'; + feProperties: Result := 'properties'; + feRunAs: Result := 'runas'; + feRunAsUser: Result := 'runasuser'; else Result := nil; end; end; @@ -644,6 +677,160 @@ begin end; end; +{ ---------------------------------------------------------------------------- + TDllManager + ---------------------------------------------------------------------------- } + +constructor TDllManager.Create; +begin + inherited; + SetLength(FFiles,0); +end; + +destructor TDllManager.Destroy; +var + Index: Integer; +begin + for Index := 0 to FileCount - 1 do + begin + Close(Files[Index]); + end; + inherited; +end; + +function TDllManager.GetFiles(Index: Integer): TDllFile; +begin + Result := FFiles[Index]; +end; + +function TDllManager.GetFileCount: Integer; +begin + Result := Length(FFiles); +end; + +procedure TDllManager.Load(const FileName: String); +var + Handle: THandle; + DLL: TDllFile; +begin + SetLength(FFiles,Length(FFiles) + 1); + Handle := LoadLibrary(PChar(FileName)); + if Handle = 0 then + begin + raise EDllFileNoExist.Create('Library "' + FileName + '" not found'); + end else + begin + Dll.FileName := FileName; + Dll.Handle := Handle; + FFiles[High(FFiles)] := DLL; + end; +end; + +procedure TDllManager.Close(DLL: TDllFile); +var + Index: Integer; +begin + for Index := 0 to FileCount - 1 do + begin + if (Files[Index].FileName = DLL.FileName) and (Files[Index].Handle = DLL.Handle) then + begin + Break; + end; + end; + while Index < FileCount - 1 do + begin + FFiles[Index] := Files[Index + 1]; + Inc(Index); + end; + if Index = FileCount then + begin + raise EDllFileNoExist.Create('Library [' + IntToStr(DLL.Handle) + '] "' + DLL.FileName + '" not loaded'); + end else + begin + SetLength(FFiles,Length(FFiles) - 1); + end; +end; + +procedure TDllManager.Close(FileName: String); +var + Index: Integer; +begin + for Index := 0 to FileCount - 1 do + begin + if Files[Index].FileName = FileName then + begin + Break; + end; + end; + while Index < FileCount - 1 do + begin + FFiles[Index] := Files[Index + 1]; + Inc(Index); + end; + if Index = FileCount then + begin + raise EDllFileNoExist.Create('Library "' + FileName + '" not loaded'); + end else + begin + SetLength(FFiles,Length(FFiles) - 1); + end; +end; + +procedure TDllManager.Close(Handle: THandle); +var + Index: Integer; +begin + for Index := 0 to FileCount - 1 do + begin + if Files[Index].Handle = Handle then + begin + Break; + end; + end; + while Index < FileCount - 1 do + begin + FFiles[Index] := Files[Index + 1]; + Inc(Index); + end; + if Index = FileCount then + begin + raise EDllFileNoExist.Create('Library [' + IntToStr(Handle) + '] not loaded'); + end else + begin + SetLength(FFiles,Length(FFiles) - 1); + end; +end; + +function TDllManager.GetMethod(Name: String): Pointer; +begin + +end; + +function TDllManager.GetProcedure(Name: String): TProcedure; +begin + Result := TProcedure(GetMethod(Name)); +end; + +function TDllManager.MethodExists(Name: String): Boolean; +begin + // Load +end; + +function TDllManager.LibraryExists(FileName: String): Boolean; +var + Handle: THandle; +begin + Handle := LoadLibrary(PChar(FileName)); + if Handle = 0 then + begin + Result := False; + end else + begin + Result := True; + FreeLibrary(Handle); + end; +end; + { ---------------------------------------------------------------------------- TWinFileInfo ---------------------------------------------------------------------------- } diff --git a/Source/uFrmCtrls.pas b/Source/uFrmCtrls.pas index 38547dd..2b81833 100644 --- a/Source/uFrmCtrls.pas +++ b/Source/uFrmCtrls.pas @@ -3,7 +3,7 @@ unit uFrmCtrls; ////////////////////////////////////// /// Lina Form Controls Unit /// /// **************************** /// -/// (c) 2015 Dennis Göhlert a.o. /// +/// (c) 2016 Dennis Göhlert a.o. /// ////////////////////////////////////// {$I 'Config.inc'} @@ -23,6 +23,7 @@ type EParamNotFound = class(Exception); EInvalidParamIdentifier = class(Exception); EInvalidParamFormat = class(Exception); + EInvalidDiagramGap = class(Exception); type { Hilfsklassen } @@ -30,6 +31,8 @@ type TSplashScreenAnimation = (ssaNone,ssaShallow); TProgressBarManagerMode = (pmmNone,pmmBattery,pmmDownload); TListBoxManagerMode = (lmmNone,lmmEdit,lmmComboBox); + TDiagramLayout = (dloColumns,dloPoints,dloLines,dloCustom); + TDiagramGridLines = (dglHorizontal,dglVertical,dglBoth); type { Ereignisse } @@ -41,6 +44,8 @@ type TSplashScreenTimerEvent = procedure(Sender: TObject) of object; TComponentManagerUpdateEvent = procedure(Sender: TObject) of object; TParamDefinerUpdateEvent = procedure(Sender: TObject) of object; + TDiagramDrawValueEvent = procedure(Sender: TObject; Index: Integer) of object; + TDiagramCustomDrawValueEvent = procedure(Sender: TObject; Index: Integer) of object; type { Hauptklassen } @@ -448,6 +453,300 @@ type property References: TParamReferences read FReferences write SetReferences; end; + TDiagram = class; + + TDiagramPadding = class + private + { Private-Deklarationen } + FDiagram: TDiagram; + FTop: Integer; + FBottom: Integer; + FLeft: Integer; + FRight: Integer; + FAxis: Integer; + { Methoden } + procedure SetTop(Value: Integer); + procedure SetBottom(Value: Integer); + procedure SetLeft(Value: Integer); + procedure SetRight(Value: Integer); + procedure SetAxis(Value: Integer); + public + { Public-Deklarationen } + constructor Create(ADiagram: TDiagram); + destructor Destroy; override; + published + { Published-Deklarationen } + property Top: Integer read FTop write SetTop default 0; + property Bottom: Integer read FBottom write SetBottom default 0; + property Left: Integer read FLeft write SetLeft default 5; + property Right: Integer read FRight write SetRight default 5; + property Axis: Integer read FAxis write SetAxis default 0; + end; + + TDiagramValue = class(TCollectionItem) + private + { Private-Deklarationen } + FName: String; + FColor: TColor; + FValue: Integer; + FVIsible: Boolean; + FArtLine: Boolean; + FBorderStyle: TBorderStyle; + FBorderWidth: Integer; + FBorderColor: TColor; + { Methoden } + procedure SetName(Value: String); + procedure SetColor(Value: TColor); + procedure SetValue(Value: Integer); + procedure SetVisible(Value: Boolean); + procedure SetArtLine(Value: Boolean); + procedure SetBorderStyle(Value: TBorderStyle); + procedure SetBorderWidth(Value: Integer); + procedure SetBorderColor(Value: TColor); + function GetDisplayName: String; override; + public + { Public-Deklarationen } + constructor Create(Collection: TCollection); override; + destructor Destroy; override; + published + { Published-Deklarationen } + property Name: String read FName write SetName; + property Color: TColor read FColor write SetColor default clNone; + property Value: Integer read FValue write SetValue default 0; + property Visible: Boolean read FVIsible write SetVisible default True; + property ArtLine: Boolean read FArtLine write SetArtLine default False; + property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle; + property BorderWith: Integer read FBorderWidth write SetBorderWidth default 1; + property BorderColor: TColor read FBorderColor write SetBorderColor default clNone; + end; + + TDiagramValues = class(TCollection) + private + { Private-Deklarationen } + FDiagram: TDiagram; + public + { Public-Deklarationen } + constructor Create(ADiagram: TDiagram); + destructor Destroy; override; + function MinValue: Integer; + function MaxValue: Integer; + function MidValue: Integer; + function AvgValue: Integer; + function First: Integer; + function Last: Integer; + end; + + TDiagramScaleBar = class(TPersistent) + private + { Private-Deklarationen } + FDiagram: TDiagram; + FVisible: Boolean; + FColor: TColor; + FWidth: Integer; + FRulerWidth: Word; + FRulerGap: Word; + FRulerNumbers: Boolean; + { Methoden } + procedure SetVisible(Value: Boolean); + procedure SetColor(Value: TColor); + procedure SetWidth(Value: Integer); + procedure SetRulerWidth(Value: Word); + procedure SetRulerGap(Value: Word); + procedure SetRulerNumbers(Value: Boolean); + public + { Public-Deklarationen } + constructor Create(ADiagram: TDiagram); + destructor Destroy; override; + published + { Published-Deklarationen } + property Visible: Boolean read FVisible write SetVisible default True; + property Color: TColor read FColor write SetColor default clBlack; + property Width: Integer read FWidth write SetWidth default 2; + property RulerWidth: Word read FRulerWidth write SetRulerWidth default 0; + property RulerGap: Word read FRulerGap write SetRulerGap default 10; + property RulerNumbers: Boolean read FRulerNumbers write SetRulerNumbers default False; + end; + + TDiagramScaleGrid = class(TPersistent) + private + { Private-Deklarationen } + FDiagram: TDiagram; + FVisible: Boolean; + FDotted: Boolean; + FLines: TDiagramGridLines; + FColor: TColor; + FWidth: Integer; + FGap: Word; + { Methoden } + procedure SetVisible(Value: Boolean); + procedure SetDotted(Value: Boolean); + procedure SetLines(Value: TDiagramGridLines); + procedure SetColor(Value: TColor); + procedure SetWidth(Value: Integer); + procedure SetGap(Value: Word); + public + { Public-Deklarationen } + constructor Create(ADiagram: TDiagram); + destructor Destroy; override; + published + { Published-Deklarationen } + property Visible: Boolean read FVisible write SetVisible default False; + property Dotted: Boolean read FDotted write SetDotted default False; + property Lines: TDiagramGridLines read FLines write SetLines default dglBoth; + property Color: TColor read FColor write SetColor default clGray; + property Width: Integer read FWidth write SetWidth default 1; + property Gap: Word read FGap write SetGap default 10; + end; + + TDiagramScaleValues = class(TPersistent) + private + { Private-Deklarationen } + FDiagram: TDiagram; + FVisible: Boolean; + FFont: TFont; + FAutoColor: Boolean; + { Methoden } + procedure SetVisible(Value: Boolean); + procedure SetFont(Value: TFont); + procedure SetAutoColor(Value: Boolean); + public + { Public-Deklarationen } + constructor Create(ADiagram: TDiagram); + destructor Destroy; override; + published + { Published-Deklarationen } + property Visible: Boolean read FVisible write SetVisible default False; + property Font: TFont read FFont write SetFont; + property AutoColor: Boolean read FAutoColor write SetAutoColor default False; + end; + + TDiagramScale = class(TPersistent) + private + { Private-Deklarationen } + FDiagram: TDiagram; + FBar: TDiagramScaleBar; + FGrid: TDiagramScaleGrid; + FValues: TDiagramScaleValues; + public + { Public-Deklarationen } + constructor Create(ADiagram: TDiagram); + destructor Destroy; override; + published + { Published-Deklarationen } + property Bar: TDiagramScaleBar read FBar write FBar; + property Grid: TDiagramScaleGrid read FGrid write FGrid; + property Values: TDiagramScaleValues read FValues write FValues; + end; + + TDiagramCaption = class(TPersistent) + private + { Private-Deklarationen } + FDiagram: TDiagram; + FText: TCaption; + FFont: TFont; + FAlignment: TAlignment; + FVerticalAlignment: TVerticalAlignment; + { Methoden } + procedure SetText(Value: TCaption); + procedure SetFont(Value: TFont); + procedure SetAlignment(Value: TAlignment); + procedure SetVerticalAlignment(Value: TVerticalAlignment); + public + { Public-Deklarationen } + constructor Create(ADiagram: TDiagram); + destructor Destroy; override; + published + { Published-Deklarationen } + property Text: TCaption read FText write SetText; + property Font: TFont read FFont write SetFont; + property Alignment: TAlignment read FAlignment write SetAlignment default taCenter; + property VerticalAlignment: TVerticalAlignment read FVerticalAlignment write SetVerticalAlignment default taAlignTop; + end; + + {$IFNDEF NO_MULTIPLATFORM} + [ComponentPlatformsAttribute(pidWin32 or pidWin64)] + {$ENDIF} + TDiagram = class(TGraphicControl) + private + { Private-Deklarationen } + FAbout: TComponentAbout; + FCaption: TDiagramCaption; + FLayout: TDiagramLayout; + FValues: TDiagramValues; + FPadding: TDiagramPadding; + FScale: TDiagramScale; + FAutoColor: Boolean; + FAlignment: TAlignment; + { Ereignisse } + FDrawValueEvent: TDiagramDrawValueEvent; + FCustomDrawValueEvent: TDiagramCustomDrawValueEvent; + { Methoden } + procedure SetCaption(Value: TDiagramCaption); + procedure SetLayout(Value: TDiagramLayout); + procedure SetValues(Value: TDiagramValues); + procedure SetPadding(Value: TDiagramPadding); + procedure SetScale(Value: TDiagramScale); + procedure SetAutoColor(Value: Boolean); + procedure PropertyChange(Sender: TObject); + protected + { Protected-Deklarationen } + procedure Paint; override; + procedure DrawBackground; + procedure DrawCaption; + procedure DrawBar; + procedure DrawGrid; + procedure DrawValue(Index: Integer); + procedure DrawColumn(Index: Integer); + procedure DrawPoint(Index: Integer); + procedure DrawLine(Index: Integer); + function ZeroWidth: Integer; + function ZeroHeight: Integer; + function ValueHeight(Value: Integer): Integer; + function HeightValue(Height: Integer): Integer; + public + { Public-Deklarationen } + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + { Published-Deklarationen } + { Ereignisse } + property OnCanResize; + property OnClick; + property OnConstrainedResize; + property OnContextPopup; + property OnDblClick; + property OnDragDrop; + property OnDragOver; + property OnEndDock; + property OnEndDrag; + property OnMouseActivate; + property OnMouseDown; + property OnMouseEnter; + property OnMouseLeave; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseWheelDown; + property OnMouseWheelUp; + property OnResize; + property OnStartDock; + property OnStartDrag; + property OnDrawValue: TDiagramDrawValueEvent read FDrawValueEvent write FDrawValueEvent; + property OnCustomDrawValue: TDiagramCustomDrawValueEvent read FCustomDrawValueEvent write FCustomDrawValueEvent; + { Eigenschaften } + property Align; + property Width default 200; + property Height default 50; + property Color; + property Caption: TDiagramCaption read FCaption write SetCaption; + property About: TComponentAbout read FAbout; + property Layout: TDiagramLayout read FLayout write SetLayout default dloColumns; + property Values: TDiagramValues read FValues write SetValues; + property Padding: TDiagramPadding read FPadding write SetPadding; + property Scale: TDiagramScale read FScale write SetScale; + property AutoColor: Boolean read FAutoColor write SetAutoColor default False; + end; + { ShowMessage-Varianten } procedure ShowMessageVal(const Msg: Integer); overload; procedure ShowMessageVal(const Msg: Extended); overload; @@ -468,7 +767,7 @@ implementation {$IFDEF ADD_COMPONENTREG} procedure Register; begin - RegisterComponents(ComponentsPage,[TSplashScreen,TProgressBarManager,TListBoxManager,TParamDefiner]); + RegisterComponents(ComponentsPage,[TSplashScreen,TProgressBarManager,TListBoxManager,TParamDefiner,TDiagram]); end; {$ENDIF} @@ -1834,4 +2133,860 @@ begin end; end; +{ ---------------------------------------------------------------------------- + TDiagramPadding + ---------------------------------------------------------------------------- } + +constructor TDiagramPadding.Create(ADiagram: TDiagram); +begin + inherited Create; + FDiagram := ADiagram; + FLeft := 5; + FRight := 5; + FTop := 0; + FBottom := 0; + FAxis := 0; +end; + +destructor TDiagramPadding.Destroy; +begin + FDiagram := nil; + inherited; +end; + +procedure TDiagramPadding.SetTop(Value: Integer); +begin + FTop := Value; + FDiagram.Repaint; +end; + +procedure TDiagramPadding.SetBottom(Value: Integer); +begin + FBottom := Value; + FDiagram.Repaint; +end; + +procedure TDiagramPadding.SetLeft(Value: Integer); +begin + FLeft := Value; + FDiagram.Repaint; +end; + +procedure TDiagramPadding.SetRight(Value: Integer); +begin + FRight := Value; + FDiagram.Repaint; +end; + +procedure TDiagramPadding.SetAxis(Value: Integer); +begin + FAxis := Value; + FDiagram.Repaint; +end; + +{ ---------------------------------------------------------------------------- + TDiagramValue + ---------------------------------------------------------------------------- } + +constructor TDiagramValue.Create(Collection: TCollection); +begin + inherited; + FName := 'Value' + IntToStr(ID); + FColor := clNone; + FValue := 0; + FVisible := True; + FArtLine := False; + FBorderStyle := bsSingle; + FBorderWidth := 1; + FBorderColor := clNone; +end; + +destructor TDiagramValue.Destroy; +begin + //... + inherited; +end; + +procedure TDiagramValue.SetName(Value: String); +begin + FName := Value; + (Collection as TDiagramValues).FDiagram.Repaint; +end; + +procedure TDiagramValue.SetColor(Value: TColor); +begin + FColor := Value; + (Collection as TDiagramValues).FDiagram.Repaint; +end; + +procedure TDiagramValue.SetValue(Value: Integer); +begin + FValue := Value; + (Collection as TDiagramValues).FDiagram.Repaint; +end; + +procedure TDiagramValue.SetVisible(Value: Boolean); +begin + FVisible := Value; + (Collection as TDiagramValues).FDiagram.Repaint; +end; + +procedure TDiagramValue.SetArtLine(Value: Boolean); +begin + FArtLine := Value; + (Collection as TDiagramValues).FDiagram.Repaint; +end; + +procedure TDiagramValue.SetBorderStyle(Value: TBorderStyle); +begin + FBorderStyle := Value; + (Collection as TDiagramValues).FDiagram.Repaint; +end; + +procedure TDiagramValue.SetBorderWidth(Value: Integer); +begin + FBorderWidth := Value; + (Collection as TDiagramValues).FDiagram.Repaint; +end; + +procedure TDiagramValue.SetBorderColor(Value: TColor); +begin + FBorderColor := Value; + (Collection as TDiagramValues).FDiagram.Repaint; +end; + +function TDiagramValue.GetDisplayName: String; +begin + inherited; + Result:= FName; +end; + +{ ---------------------------------------------------------------------------- + TDiagramValues + ---------------------------------------------------------------------------- } + +constructor TDiagramValues.Create(ADiagram: TDiagram); +begin + inherited Create(TDiagramValue); + FDiagram := ADiagram; +end; + +destructor TDiagramValues.Destroy; +begin + FDiagram := nil; + inherited; +end; + +function TDiagramValues.MinValue: Integer; +var + Index: Integer; +begin + if Count = 0 then + begin + Result := 0; + end else + begin + Result := (Items[First] as TDiagramValue).Value; + for Index := 1 to Count - 1 do + begin + if (Items[Index] as TDiagramValue).Visible and ((Items[Index] as TDiagramValue).Value < Result) then + begin + Result := (Items[Index] as TDiagramValue).Value; + end; + end; + end; +end; + +function TDiagramValues.MaxValue: Integer; +var + Index: Integer; +begin + if Count = 0 then + begin + Result := 0; + end else + begin + Result := (Items[First] as TDiagramValue).Value; + for Index := 1 to Count - 1 do + begin + if (Items[Index] as TDiagramValue).Visible and ((Items[Index] as TDiagramValue).Value > Result) then + begin + Result := (Items[Index] as TDiagramValue).Value; + end; + end; + end; +end; + +function TDiagramValues.MidValue: Integer; +begin + Result := MaxValue - MinValue div 2; +end; + +function TDiagramValues.AvgValue: Integer; +var + Index: Integer; +begin + Result := 0; + for Index := 0 to Count - 1 do + begin + if (Items[Index] as TDiagramValue).Visible then + begin + Result := Result + (Items[Index] as TDiagramValue).Value; + end; + end; + Result := Result div Index; +end; + +function TDiagramValues.First: Integer; +begin + for Result := 0 to Count - 1 do + begin + if (Items[Result] as TDiagramValue).Visible then + begin + Exit; + end; + end; + Result := -1; +end; + +function TDiagramValues.Last: Integer; +begin + for Result := Count - 1 downto 0 do + begin + if (Items[Result] as TDiagramValue).Visible then + begin + Exit; + end; + end; + Result := -1; +end; + +{ ---------------------------------------------------------------------------- + TDiagramScaleBar + ---------------------------------------------------------------------------- } + +constructor TDiagramScaleBar.Create(ADiagram: TDiagram); +begin + inherited Create; + FDiagram := ADiagram; + FVisible := True; + FColor := clBlack; + FWidth := 2; + FRulerWidth := 0; + FRulerGap := 10; + FRulerNumbers := False; +end; + +destructor TDiagramScaleBar.Destroy; +begin + FDiagram := nil; + inherited; +end; + +procedure TDiagramScaleBar.SetVisible(Value: Boolean); +begin + FVisible := Value; + FDiagram.Repaint; +end; + +procedure TDiagramScaleBar.SetColor(Value: TColor); +begin + FColor := Value; + FDiagram.Repaint; +end; + +procedure TDiagramScaleBar.SetWidth(Value: Integer); +begin + FWidth := Value; + FDiagram.Repaint; +end; + +procedure TDiagramScaleBar.SetRulerWidth(Value: Word); +begin + FRulerWidth := Value; + FDiagram.Repaint; +end; + +procedure TDiagramScaleBar.SetRulerGap(Value: Word); +begin + if Value = 0 then + begin + raise EInvalidDiagramGap.Create('Invalid diagram ruler gap value for property "Bar"'); + end; + FRulerGap := Value; + FDiagram.Repaint; +end; + +procedure TDiagramScaleBar.SetRulerNumbers(Value: Boolean); +begin + FRulerNumbers := Value; + FDiagram.Repaint; +end; + +{ ---------------------------------------------------------------------------- + TDiagramScaleGrid + ---------------------------------------------------------------------------- } + +constructor TDiagramScaleGrid.Create(ADiagram: TDiagram); +begin + inherited Create; + FDiagram := ADiagram; + FVisible := False; + FDotted := False; + FLines := dglBoth; + FColor := clGray; + FWidth := 1; + FGap := 10; +end; + +destructor TDiagramScaleGrid.Destroy; +begin + FDiagram := nil; + inherited; +end; + +procedure TDiagramScaleGrid.SetVisible(Value: Boolean); +begin + FVisible := Value; + FDiagram.Repaint; +end; + +procedure TDiagramScaleGrid.SetDotted(Value: Boolean); +begin + FDotted := Value; + FDiagram.Repaint; +end; + +procedure TDiagramScaleGrid.SetLines(Value: TDiagramGridLines); +begin + FLines := Value; + FDiagram.Repaint; +end; + +procedure TDiagramScaleGrid.SetColor(Value: TColor); +begin + FColor := Value; + FDiagram.Repaint; +end; + +procedure TDiagramScaleGrid.SetWidth(Value: Integer); +begin + FWidth := Value; + FDiagram.Repaint; +end; + +procedure TDiagramScaleGrid.SetGap(Value: Word); +begin + if Value = 0 then + begin + raise EInvalidDiagramGap.Create('Invalid diagram gap value for property "Grid"'); + end; + FGap := Value; + FDiagram.Repaint; +end; + +{ ---------------------------------------------------------------------------- + TDiagramScaleValues + ---------------------------------------------------------------------------- } + +constructor TDiagramScaleValues.Create(ADiagram: TDiagram); +begin + inherited Create; + FDiagram := ADiagram; + FVisible := False; + FFont := TFont.Create; + FFont.Color := clNone; + FAutoColor := False; +end; + +destructor TDiagramScaleValues.Destroy; +begin + FDiagram := nil; + FFont.Free; + inherited; +end; + +procedure TDiagramScaleValues.SetVisible(Value: Boolean); +begin + FVisible := Value; + FDiagram.Repaint; +end; + +procedure TDiagramScaleValues.SetFont(Value: TFont); +begin + FFont := Value; + FDiagram.Repaint; +end; + +procedure TDiagramScaleValues.SetAutoColor(Value: Boolean); +begin + FAutoColor := Value; + FDiagram.Repaint; +end; + +{ ---------------------------------------------------------------------------- + TDiagramScale + ---------------------------------------------------------------------------- } + +constructor TDiagramScale.Create(ADiagram: TDiagram); +begin + inherited Create; + FDiagram := ADiagram; + FBar := TDiagramScaleBar.Create(ADiaGram); + FGrid := TDiagramScaleGrid.Create(ADiagram); + FValues := TDiagramScaleValues.Create(ADiagram); +end; + +destructor TDiagramScale.Destroy; +begin + FBar.Free; + FGrid.Free; + FValues.Free; + inherited; +end; + +{ ---------------------------------------------------------------------------- + TDiagramCaption + ---------------------------------------------------------------------------- } + +constructor TDiagramCaption.Create(ADiagram: TDiagram); +begin + inherited Create; + FDiagram := ADiagram; + FFont := TFont.Create; + FFont.Size := 12; + FFont.Color := clSilver; + FAlignment := taCenter; + FVerticalAlignment := taAlignTop; +end; + +destructor TDiagramCaption.Destroy; +begin + FDiagram := nil; + FFont.Free; + inherited; +end; + +procedure TDiagramCaption.SetText(Value: TCaption); +begin + FText := Value; + FDiagram.Repaint; +end; + +procedure TDiagramCaption.SetFont(Value: TFont); +begin + FFont := Value; + FDiagram.Repaint; +end; + +procedure TDiagramCaption.SetAlignment(Value: TAlignment); +begin + FAlignment := Value; + FDiagram.Repaint; +end; + +procedure TDiagramCaption.SetVerticalAlignment(Value: TVerticalAlignment); +begin + FVerticalAlignment := Value; + FDiagram.Repaint; +end; + +{ ---------------------------------------------------------------------------- + TDiagram + ---------------------------------------------------------------------------- } + +constructor TDiagram.Create(AOwner: TComponent); +begin + inherited; + FAbout := TComponentAbout.Create(TDiagram); + FCaption := TDiagramCaption.Create(Self); + FLayout := dloColumns; + FValues := TDiagramValues.Create(Self); + Width := 200; + Height := 50; + FPadding := TDiagramPadding.Create(Self); + FScale := TDiagramScale.Create(Self); + FAutoColor := False; + //OnChange-Ereignisse + FCaption.Font.OnChange := PropertyChange; + FScale.Values.Font.OnChange := PropertyChange; +end; + +destructor TDiagram.Destroy; +begin + FAbout.Free; + FCaption.Free; + FValues.Free; + FPadding.Free; + FScale.Free; + inherited; +end; + +procedure TDiagram.SetCaption(Value: TDiagramCaption); +begin + FCaption := Value; + Repaint; +end; + +procedure TDiagram.SetLayout(Value: TDiagramLayout); +begin + FLayout := Value; + Repaint; +end; + +procedure TDiagram.SetValues(Value: TDiagramValues); +begin + FValues := Value; + Repaint; +end; + +procedure TDiagram.SetPadding(Value: TDiagramPadding); +begin + FPadding := Value; + Repaint; +end; + +procedure TDiagram.SetScale(Value: TDiagramScale); +begin + FScale := Value; + Repaint; +end; + +procedure TDiagram.SetAutoColor(Value: Boolean); +begin + FAutoColor := Value; + Repaint; +end; + +procedure TDiagram.PropertyChange(Sender: TObject); +begin + Repaint; +end; + +procedure TDiagram.Paint; +var + Index: Integer; +begin + inherited; + DrawBackground; + DrawCaption; + with Canvas do + begin + if Scale.Bar.RulerNumbers then + begin + Font.Color := Scale.Bar.Color; + Font.Height := Scale.Bar.RulerGap; + end; + end; + if Scale.FGrid.Visible then + begin + DrawGrid; + end; + if Scale.Bar.Visible then + begin + DrawBar; + end; + case Layout of + dloColumns: for Index := 0 to Values.Count - 1 do + begin + DrawColumn(Index); + if Assigned(OnDrawValue) then + begin + OnDrawValue(Self,Index); + end; + end; + dloPoints: for Index := 0 to Values.Count - 1 do + begin + DrawPoint(Index); + if Assigned(OnDrawValue) then + begin + OnDrawValue(Self,Index); + end; + end; + dloLines: for Index := 0 to Values.Count - 1 do + begin + DrawLine(Index); + if Assigned(OnDrawValue) then + begin + OnDrawValue(Self,Index); + end; + end; + dloCustom: for Index := 0 to Values.Count - 1 do + begin + if Assigned(OnDrawValue) then + begin + OnDrawValue(Self,Index); + end; + if Assigned(OnCustomDrawValue) then + begin + OnCustomDrawValue(Self,Index); + end; + end; + end; + if Scale.Values.Visible then + begin + for Index := 0 to Values.Count - 1 do + begin + DrawValue(Index); + end; + end; +end; + +procedure TDiagram.DrawBackground; +begin + with Canvas do + begin + Brush.Color := Color; + FillRect(Rect(0,0,Width,Height)) + end; +end; + +procedure TDiagram.DrawCaption; +var + Top: Integer; +begin + if Length(Caption.Text) <> 0 then + begin + with Canvas do + begin + Font.Assign(Caption.Font); + case Caption.VerticalAlignment of + taAlignTop: Top := 0; + taAlignBottom: Top := Height - TextHeight(Caption.Text); + taVerticalCenter: Top := (Height - TextHeight(Caption.Text)) div 2; + end; + case Caption.Alignment of + taLeftJustify: TextOut(0,Top,Caption.Text); + taCenter: TextOut((Width - TextWidth(Caption.Text)) div 2,Top,Caption.Text); + taRightJustify: TextOut(Width - TextWidth(Caption.Text),Top,Caption.Text); + end; + end; + end; +end; + +procedure TDiagram.DrawBar; +var + Index: Integer; +begin + with Canvas do + begin + Pen.Color := Scale.Bar.Color; + Pen.Width := Scale.Bar.Width; + MoveTo(ZeroWidth,0); + LineTo(ZeroWidth,Height); + MoveTo(ZeroWidth,ZeroHeight); + LineTo(Width,ZeroHeight); + Index := ZeroHeight - Scale.Bar.RulerGap; + while Index >= 0 do + begin + MoveTo(ZeroWidth - Scale.Bar.RulerWidth - Scale.Bar.Width div 2 - 1,Index); + LineTo(ZeroWidth,Index); + Dec(Index,Scale.Bar.RulerGap); + end; + Index := ZeroHeight + Scale.Bar.RulerGap; + while Index < Height do + begin + MoveTo(ZeroWidth - Scale.Bar.RulerWidth - Scale.Bar.Width div 2 - 1,Index); + LineTo(ZeroWidth,Index); + Inc(Index,Scale.Bar.RulerGap); + end; + if Scale.Bar.RulerWidth <> 0 then + begin + Brush.Color := Color; + FillRect(Rect(0,0,ZeroWidth - Scale.Bar.RulerWidth - Scale.Bar.Width div 2,Height)); + end; + MoveTo(-1,ZeroHeight); + LineTo(Width,ZeroHeight); + if Scale.Bar.RulerNumbers then + begin + Index := ZeroHeight + Scale.Bar.RulerGap; + while Index < Height do + begin + TextOut(ZeroWidth - Scale.Bar.RulerWidth - TextWidth(IntToStr(HeightValue(Index))),Index - Font.Height div 2,IntToStr(HeightValue(Index))); + Inc(Index,Scale.Bar.RulerGap); + end; + Index := ZeroHeight - Scale.Bar.RulerGap; + while Index >= 0 do + begin + TextOut(ZeroWidth - Scale.Bar.RulerWidth - TextWidth(IntToStr(HeightValue(Index))),Index - Font.Height div 2,IntToStr(HeightValue(Index))); + Dec(Index,Scale.Bar.RulerGap); + end; + end; + end; +end; + +procedure TDiagram.DrawGrid; +var + Index: Integer; +begin + with Canvas do + begin + Pen.Color := Scale.Grid.Color; + Pen.Width := Scale.Grid.Width; + if Scale.Grid.Dotted then + begin + Pen.Style := psDot; + end else + begin + Pen.Style := psSolid; + end; + if Scale.Grid.Lines in [dglBoth,dglHorizontal] then + begin + if Scale.Bar.Visible then + begin + Index := ZeroHeight - Scale.Grid.Gap; + end else + begin + Index := ZeroHeight; + end; + while Index >= 0 do + begin + MoveTo(ZeroWidth,Index); + LineTo(Width,Index); + Dec(Index,Scale.Grid.Gap); + end; + if Scale.Bar.Visible then + begin + Index := ZeroHeight + Scale.Grid.Gap; + end else + begin + Index := ZeroHeight; + end; + while Index < Height do + begin + MoveTo(ZeroWidth,Index); + LineTo(Width,Index); + Inc(Index,Scale.Grid.Gap); + end; + end; + if Scale.Grid.Lines in [dglBoth,dglVertical] then + begin + if Scale.Bar.Visible then + begin + Index := ZeroWidth + Scale.Grid.Gap; + end else + begin + Index := ZeroWidth; + end; + while Index < Width do + begin + MoveTo(Index,0); + LineTo(Index,Height); + Inc(Index,Scale.Grid.Gap); + end; + end; + end; +end; + +procedure TDiagram.DrawValue(Index: Integer); +begin + +end; + +procedure TDiagram.DrawColumn(Index: Integer); +begin + +end; + +procedure TDiagram.DrawPoint(Index: Integer); +begin + +end; + +procedure TDiagram.DrawLine(Index: Integer); +begin + +end; + +function TDiagram.ZeroWidth: Integer; +var + Index: Integer; + MaxWidth: Integer; +begin + if Scale.Bar.Visible then + begin + if Scale.Bar.RulerNumbers then + begin + MaxWidth := Canvas.TextWidth('1'); + for Index := Values.MinValue to Values.MaxValue do + begin + if Canvas.TextWidth(IntToStr(Index)) > MaxWidth then + begin + MaxWidth := Canvas.TextWidth(IntToStr(Index)); + end; + end; + Result := MaxWidth + Scale.Bar.RulerWidth + Scale.Bar.Width div 2; + end else + begin + Result := Scale.Bar.RulerWidth + Scale.Bar.Width div 2; + end; + end else + begin + Result := 0; + end; +end; + +function TDiagram.ZeroHeight: Integer; +begin + if Values.MinValue >= 0 then + begin + Result := Height - Scale.Bar.Width div 2; + end else + begin + if Values.MaxValue <= 0 then + begin + Result := Scale.Bar.Width div 2; + end else + begin + Result := Round(Height / (Values.MaxValue - Values.MinValue) * Values.MaxValue); + end; + end; +end; + +function TDiagram.ValueHeight(Value: Integer): Integer; +begin + if Value = 0 then + begin + Result := ZeroHeight; + end else + begin + if (Values.MinValue >= 0) or (Values.MaxValue > 0) then + begin + Result := ZeroHeight - Round(ZeroHeight / Values.MaxValue * Value); + end else + begin + Result := ZeroHeight + Round((Height - ZeroHeight) / Values.MinValue * Value); + end; + end; +end; + +function TDiagram.HeightValue(Height: Integer): Integer; +begin + if Height = ZeroHeight then + begin + Result := 0; + end else + begin + if Values.MinValue >= 0 then + begin + Result := Trunc((1 - Height / ZeroHeight) * Values.MaxValue) + 1; + end else + begin + if Values.MaxValue <= 0 then + begin + Result := Trunc(Height / (Self.Height - ZeroHeight) * Values.MinValue) - 1; + end else + begin + if Height > ZeroHeight then + begin + Result := Values.MinValue + Trunc((1 - Height / Self.Height) * (Values.MaxValue - Values.MinValue)); + end else + begin + Result := Values.MinValue + Trunc((1 - Height / Self.Height) * (Values.MaxValue - Values.MinValue)) + 1; + end; + end; + end; + end; +end; + end. diff --git a/Source/uInit.pas b/Source/uInit.pas index e89f94f..d02c760 100644 --- a/Source/uInit.pas +++ b/Source/uInit.pas @@ -3,7 +3,7 @@ unit uInit; ////////////////////////////////////// /// Lina Initialization Unit /// /// **************************** /// -/// (c) 2015 Dennis Göhlert a.o. /// +/// (c) 2016 Dennis Göhlert a.o. /// ////////////////////////////////////// {$I 'Config.inc'} diff --git a/Source/uLocalMgr.pas b/Source/uLocalMgr.pas index 87d105f..c2d0b2f 100644 --- a/Source/uLocalMgr.pas +++ b/Source/uLocalMgr.pas @@ -3,7 +3,7 @@ unit uLocalMgr; ////////////////////////////////////// /// Lina Localize Manager Unit /// /// **************************** /// -/// (c) 2015 Dennis Göhlert a.o. /// +/// (c) 2016 Dennis Göhlert a.o. /// ////////////////////////////////////// {$I 'Config.inc'} @@ -147,7 +147,7 @@ type FManager: TLocalizationManager; public { Public-Deklarationen } - constructor Create(ItemClass: TCollectionItemClass; AManager: TLocalizationManager); + constructor Create(AManager: TLocalizationManager); destructor Destroy; override; function IndexOfTag(const Tag: TLanguageTag): Integer; procedure LoadFromFile(const FileName: String); @@ -212,7 +212,7 @@ type FManager: TLocalizationManager; public { Public-Deklarationen } - constructor Create(ItemClass: TCollectionItemClass; AManager: TLocalizationManager); + constructor Create(AManager: TLocalizationManager); destructor Destroy; override; procedure Apply; end; @@ -1026,9 +1026,9 @@ end; TLocalizations ---------------------------------------------------------------------------- } -constructor TLocalizations.Create(ItemClass: TCollectionItemClass; AManager: TLocalizationManager); +constructor TLocalizations.Create(AManager: TLocalizationManager); begin - inherited Create(ItemClass); + inherited Create(TLocalization); FManager := AManager; end; @@ -1333,9 +1333,9 @@ end; TLocalizationReferences ---------------------------------------------------------------------------- } -constructor TLocalizationReferences.Create(ItemClass: TCollectionItemClass; AManager: TLocalizationManager); +constructor TLocalizationReferences.Create(AManager: TLocalizationManager); begin - inherited Create(ItemClass); + inherited Create(TLocalizationReference); FManager := AManager; end; @@ -1541,9 +1541,9 @@ constructor TLocalizationManager.Create(AOwnder: TComponent); begin inherited; FAbout := TComponentAbout.Create(TLocalizationManager); - FLocalizations := TLocalizations.Create(TLocalization,Self); + FLocalizations := TLocalizations.Create(Self); FData := TLocalizationData.Create(Self); - FReferences := TLocalizationReferences.Create(TLocalizationReference,Self); + FReferences := TLocalizationReferences.Create(Self); FApplier := TLocalizationApplier.Create(Self); FCurrent := -1; FIgnoreCase := True; diff --git a/Source/uScriptMgr.pas b/Source/uScriptMgr.pas index 61f4749..aa8b0c9 100644 --- a/Source/uScriptMgr.pas +++ b/Source/uScriptMgr.pas @@ -3,7 +3,7 @@ unit uScriptMgr; ////////////////////////////////////// /// Lina Script Manager Unit /// /// **************************** /// -/// (c) 2015 Dennis Göhlert a.o. /// +/// (c) 2016 Dennis Göhlert a.o. /// ////////////////////////////////////// {$I 'Config.inc'} diff --git a/Source/uSysCtrls.pas b/Source/uSysCtrls.pas index a48b2d8..a8541e2 100644 --- a/Source/uSysCtrls.pas +++ b/Source/uSysCtrls.pas @@ -3,7 +3,7 @@ unit uSysCtrls; ////////////////////////////////////// /// Lina System Controls Unit /// /// **************************** /// -/// (c) 2015 Dennis Göhlert a.o. /// +/// (c) 2016 Dennis Göhlert a.o. /// ////////////////////////////////////// {$I 'Config.inc'} diff --git a/Source/uSysTools.pas b/Source/uSysTools.pas index 0ef2122..b6f3867 100644 --- a/Source/uSysTools.pas +++ b/Source/uSysTools.pas @@ -3,10 +3,11 @@ unit uSysTools; ////////////////////////////////////// /// Lina System Tools Unit /// /// **************************** /// -/// (c) 2015 Dennis Göhlert a.o. /// +/// (c) 2016 Dennis Göhlert a.o. /// ////////////////////////////////////// {$I 'Config.inc'} + {$POINTERMATH ON} interface @@ -30,6 +31,9 @@ type TStringFilterMode = type TLinePosition; TStringFilterOptions = set of (sfoCaseSensitive,sfoForceTrim,sfoDefaultVisible); TCharEncoding = (ceANSI,ceASCII,ceBigEndianUnicode,ceUnicode,ceUTF7,ceUTF8); + {$IF !Declared(TVerticalAlignment} + TVerticalAlignment = (taAlignTop, taAlignBottom, taVerticalCenter); + {$ENDIF} type {$IFNDEF NO_GENERIC} @@ -48,20 +52,34 @@ type TStringArray = array of String; TShortStringArray = array of ShortString; - TAnsiStringArray = array of AnsiString; + {$IFDEF NO_UNICODE} + TAnsiStringArray = TStringArray; + {$ELSE} + TAnsiStringArray = array of AnsiString; + TUnicodeStringArray = TStringArray; + {$ENDIF} TByteArray = array of Byte; + TUInt8Array = TByteArray; TWordArray = array of Word; + TUInt16Array = TWordArray; TCardinalArray = array of Cardinal; + TUInt32Array = TCardinalArray; + TUInt64Array = array of UInt64; - TIntegerArray = array of Integer; TShortIntArray = array of ShortInt; + TInt8Array = TShortIntArray; TSmallIntArray = array of SmallInt; - TLongIntArray = TIntegerArray; + TInt16Array = TSmallIntArray; + TIntegerArray = array of Integer; TInt32Array = TIntegerArray; + TLongIntArray = TIntegerArray; TInt64Array = array of Int64; TBooleanArray = array of Boolean; + TByteBoolArray = array of ByteBool; + TWordBoolArray = array of WordBool; + TLongBoolArray = array of LongBool; TFloatArray = array of Extended; TSingleArray = array of Single; @@ -232,6 +250,7 @@ type { Array-Position } function ArrayPos(const AValue; const AArray: array of const): Integer; overload; function ArrayPos(const AValue: Variant; const AArray: array of Variant): Integer; overload; + function ArrayPos(const AValue: Pointer; const AArray: array of Pointer): Integer; overload; function ArrayPos(const AValue: Char; const AArray: array of Char): Integer; overload; function ArrayPos(const AValue: ShortString; const AArray: array of ShortString): Integer; overload; function ArrayPos(const AValue: String; const AArray: array of String): Integer; overload; @@ -242,6 +261,7 @@ type function ArrayPos(const AValue: Byte; const AArray: array of Byte): Integer; overload; function ArrayPos(const AValue: Word; const AArray: array of Word): Integer; overload; function ArrayPos(const AValue: Cardinal; const AArray: array of Cardinal): Integer; overload; + function ArrayPos(const AValue: UInt64; const AArray: array of UInt64): Integer; overload; function ArrayPos(const AValue: Single; const AArray: array of Single): Integer; overload; function ArrayPos(const AValue: Double; const AArray: array of Double): Integer; overload; function ArrayPos(const AValue: Real; const AArray: array of Real): Integer; overload; @@ -256,12 +276,29 @@ type function ArrayPosRef(const AValue: Extended; const AArray: array of TFloatRefDataArrayReferenceData): Integer; overload; function ArrayPosType(AValue: TClass; AArray: array of TClass): Integer; overload; function ArrayPosType(AValue: TClass; AArray: array of TObject): Integer; overload; + { Array-Element Löschen } + procedure ArrayDelete(var AArray: TVariantArray; Index: Integer; Count: Integer); overload; + procedure ArrayDelete(var AArray: TCharArray; Index: Integer; Count: Integer); overload; + procedure ArrayDelete(var AArray: TShortStringArray; Index: Integer; Count: Integer); overload; + procedure ArrayDelete(var AArray: TStringArray; Index: Integer; Count: Integer); overload; + procedure ArrayDelete(var AArray: TShortIntArray; Index: Integer; Count: Integer); overload; + procedure ArrayDelete(var AArray: TSmallIntArray; Index: Integer; Count: Integer); overload; + procedure ArrayDelete(var AArray: TIntegerArray; Index: Integer; Count: Integer); overload; + procedure ArrayDelete(var AArray: TInt64Array; Index: Integer; Count: Integer); overload; + procedure ArrayDelete(var AArray: TByteArray; Index: Integer; Count: Integer); overload; + procedure ArrayDelete(var AArray: TWordArray; Index: Integer; Count: Integer); overload; + procedure ArrayDelete(var AArray: TCardinalArray; Index: Integer; Count: Integer); overload; + procedure ArrayDelete(var AArray: TUInt64Array; Index: Integer; Count: Integer); overload; + procedure ArrayDelete(var AArray: TSingleArray; Index: Integer; Count: Integer); overload; + procedure ArrayDelete(var AArray: TDoubleArray; Index: Integer; Count: Integer); overload; + procedure ArrayDelete(var AArray: TExtendedArray; Index: Integer; Count: Integer); overload; { TComponent Laden/Speichern } procedure ComponentSaveToFile(const FileName: String; Component: TComponent); procedure ComponentLoadFromFile(const FileName: String; Component: TComponent); procedure ComponentSaveToStream(var Stream: TStream; Component: TComponent); procedure ComponentLoadFromStream(Stream: TStream; Component: TComponent); { Char-Case-Umwandelungen } + function LowCase(Ch: Char): Char; function CharLowerCase(Character: Char): Char; function CharUpperCase(Character: Char): Char; { Null-/Plus-Minus-Unendlich- Annäherung } @@ -280,6 +317,11 @@ type function FloatMod(X,Y: Single): Single; overload; function FloatMod(X,Y: Double): Double; overload; function FloatMod(X,Y: Extended): Extended; overload; + { Ganzzahliges Exponenzieren } + function IntPow(Base: ShortInt; Exponent: Byte): Int64; overload; + function IntPow(Base: SmallInt; Exponent: Byte): Int64; overload; + function IntPow(Base: Integer; Exponent: Byte): Int64; overload; + function IntPow(Base: Int64; Exponent: Byte): Int64; overload; { GGT ("GCD") / KGV ("LCM") } function GCD(A,B: Byte): Byte; overload; function GCD(A,B: Word): Word; overload; @@ -367,8 +409,9 @@ type function Factional(X: Byte): Cardinal; function ExtractClassName(FullClassName: String; CaseSensitive: Boolean = True): String; function CountLines(S: String): Integer; - function Wrappable(S: String; Font: TFont; MaxWidth: Integer): Boolean; overload; - function Wrappable(S: String; Canvas: TCanvas; MaxWidth: Integer): Boolean; overload; + function CountLine(S: String; Line: Integer): Integer; + function Wrappable(S: String; Canvas: TCanvas; MaxWidth: Integer): Boolean; + function WrappedTextHeight(S: String; Canvas: TCanvas; MaxWidth: Integer): Integer; function CharEncoding(EncodingClass: TEncoding): TCharEncoding; function EncodingClass(CharEncoding: TCharEncoding): TEncoding; function SecToTime(const Sec: Cardinal): TTime; @@ -519,6 +562,11 @@ begin Stream.ReadComponentRes(Component); end; +function LowCase(Ch: Char): Char; +begin + Result := CharLowerCase(Ch); +end; + function CharLowerCase(Character: Char): Char; { Basierend auf der Technik von SysUtils.LowerCase, nur simpler/schneller } begin @@ -659,7 +707,7 @@ begin end; end; -function PQFormula(P,Q: Single): TSingleArray; +function PQFormula(P,Q: Single): TSingleArray; overload; var Root: Single; begin @@ -681,7 +729,7 @@ begin end; end; -function PQFormula(P,Q: Double): TDoubleArray; +function PQFormula(P,Q: Double): TDoubleArray; overload; var Root: Double; begin @@ -703,7 +751,7 @@ begin end; end; -function PQFormula(P,Q: Extended): TExtendedArray; +function PQFormula(P,Q: Extended): TExtendedArray; overload; var Root: Extended; begin @@ -725,21 +773,61 @@ begin end; end; -function FloatMod(X,Y: Single): Single; +function FloatMod(X,Y: Single): Single; overload; begin Result := X - Y * Trunc(X / Y); end; -function FloatMod(X,Y: Double): Double; +function FloatMod(X,Y: Double): Double; overload; begin Result := X - Y * Trunc(X / Y); end; -function FloatMod(X,Y: Extended): Extended; +function FloatMod(X,Y: Extended): Extended; overload; begin Result := X - Y * Trunc(X / Y); end; +function IntPow(Base: ShortInt; Exponent: Byte): Int64; overload; +begin + Result := 1; + while Exponent > 0 do + begin + Result := Result * Base; + Dec(Exponent); + end; +end; + +function IntPow(Base: SmallInt; Exponent: Byte): Int64; overload; +begin + Result := 1; + while Exponent > 0 do + begin + Result := Result * Base; + Dec(Exponent); + end; +end; + +function IntPow(Base: Integer; Exponent: Byte): Int64; overload; +begin + Result := 1; + while Exponent > 0 do + begin + Result := Result * Base; + Dec(Exponent); + end; +end; + +function IntPow(Base: Int64; Exponent: Byte): Int64; overload; +begin + Result := 1; + while Exponent > 0 do + begin + Result := Result * Base; + Dec(Exponent); + end; +end; + function GCD(A,B: Byte): Byte; overload; begin if B <> 0 then @@ -1838,7 +1926,7 @@ end; function ExtractClassName(FullClassName: String; CaseSensitive: Boolean = True): String; begin - if ((FullClassName[1] = 'T') or ((CaseSensitive = False) and (FullClassName[1] = 't'))) and ((FullClassName[2] in UppercaseLetters) or (CaseSensitive = False)) then + if (Length(FullClassName) <> 0) and ((FullClassName[1] = 'T') or ((CaseSensitive = False) and (FullClassName[1] = 't'))) and ((FullClassName[2] in UppercaseLetters) or (CaseSensitive = False)) then begin Result := Copy(FullClassName,2,Length(FullClassName) - 1); end else @@ -1872,22 +1960,78 @@ begin end; end; +function CountLine(S: String; Line: Integer): Integer; +var + Current: PChar; +begin + if Line < 0 then + begin + Result := -1; + Exit; + end; + Result := 0; + Current := PChar(S); + while Current^ <> #0 do + begin + if Current^ = #13 then + begin + if (Current + 1)^ = #10 then + begin + if Line = 0 then + begin + Exit; + end; + Dec(Line); + Inc(Current); + Continue; + end; + end; + if Line = 0 then + begin + Inc(Result); + end; + Inc(Current); + end; + if Line <> 0 then + begin + Result := -1; + end; +end; + function Wrappable(S: String; Canvas: TCanvas; MaxWidth: Integer): Boolean; overload; begin Result := (Canvas.TextWidth(S) <= MaxWidth); end; -function Wrappable(S: String; Font: TFont; MaxWidth: Integer): Boolean; overload; +function WrappedTextHeight(S: String; Canvas: TCanvas; MaxWidth: Integer): Integer; var - Canvas: TCanvas; + Current: PChar; + Line: String; begin - Canvas := TCanvas.Create; - try - Canvas.Font.Assign(Font); - Result := Wrappable(S,Canvas,MaxWidth); - finally - Canvas.Free; + Result := 0; + if (Length(S) = 0) or (MaxWidth = 0) then + begin + Exit; end; + Line := ''; + Current := PChar(S); + while Current^ <> #0 do + begin + if ((Current^ = #13) and ((Current + 1)^ = #10)) or (Canvas.TextWidth(Line + Current^) > MaxWidth) then + begin + Inc(Result,Canvas.TextHeight(Line)); + Line := Current^; + if (Current + 1)^ = #10 then + begin + Inc(Current); + end; + end else + begin + Line := Line + Current^; + end; + Inc(Current); + end; + Inc(Result,Canvas.TextHeight(Line)); end; function CharEncoding(EncodingClass: TEncoding): TCharEncoding; @@ -2114,6 +2258,21 @@ begin end; end; +function ArrayPos(const AValue: Pointer; const AArray: array of Pointer): Integer; +var + Index: Integer; +begin + Result := Low(AArray) - 1; + for Index := Low(AArray) to High(AArray) do + begin + if AArray[Index] = AValue then + begin + Result := Index; + Exit; + end; + end; +end; + function ArrayPos(const AValue: Char; const AArray: array of Char): Integer; overload; var Index: Integer; @@ -2264,6 +2423,21 @@ begin end; end; +function ArrayPos(const AValue: UInt64; const AArray: array of UInt64): Integer; overload; +var + Index: Integer; +begin + Result := Low(AArray) - 1; + for Index := Low(AArray) to High(AArray) do + begin + if AArray[Index] = AValue then + begin + Result := Index; + Exit; + end; + end; +end; + function ArrayPos(const AValue: Single; const AArray: array of Single): Integer; overload; var Index: Integer; @@ -2474,6 +2648,141 @@ begin end; end; +procedure ArrayDelete(var AArray: TVariantArray; Index: Integer; Count: Integer); +begin + if Count <> 0 then + begin + Move(AArray[Index + Count],AArray[Index],SizeOf(AArray[0]) * (Length(AArray) - Index - Count)); + SetLength(AArray,Length(AArray) - Count); + end; +end; + +procedure ArrayDelete(var AArray: TCharArray; Index: Integer; Count: Integer); +begin + if Count <> 0 then + begin + Move(AArray[Index + Count],AArray[Index],SizeOf(AArray[0]) * (Length(AArray) - Index - Count)); + SetLength(AArray,Length(AArray) - Count); + end; +end; + +procedure ArrayDelete(var AArray: TShortStringArray; Index: Integer; Count: Integer); +begin + if Count <> 0 then + begin + Move(AArray[Index + Count],AArray[Index],SizeOf(AArray[0]) * (Length(AArray) - Index - Count)); + SetLength(AArray,Length(AArray) - Count); + end; +end; + +procedure ArrayDelete(var AArray: TStringArray; Index: Integer; Count: Integer); +begin + if Count <> 0 then + begin + Move(AArray[Index + Count],AArray[Index],SizeOf(AArray[0]) * (Length(AArray) - Index - Count)); + SetLength(AArray,Length(AArray) - Count); + end; +end; + +procedure ArrayDelete(var AArray: TShortIntArray; Index: Integer; Count: Integer); +begin + if Count <> 0 then + begin + Move(AArray[Index + Count],AArray[Index],SizeOf(AArray[0]) * (Length(AArray) - Index - Count)); + SetLength(AArray,Length(AArray) - Count); + end; +end; + +procedure ArrayDelete(var AArray: TSmallIntArray; Index: Integer; Count: Integer); +begin + if Count <> 0 then + begin + Move(AArray[Index + Count],AArray[Index],SizeOf(AArray[0]) * (Length(AArray) - Index - Count)); + SetLength(AArray,Length(AArray) - Count); + end; +end; + +procedure ArrayDelete(var AArray: TIntegerArray; Index: Integer; Count: Integer); +begin + if Count <> 0 then + begin + Move(AArray[Index + Count],AArray[Index],SizeOf(AArray[0]) * (Length(AArray) - Index - Count)); + SetLength(AArray,Length(AArray) - Count); + end; +end; + +procedure ArrayDelete(var AArray: TInt64Array; Index: Integer; Count: Integer); +begin + if Count <> 0 then + begin + Move(AArray[Index + Count],AArray[Index],SizeOf(AArray[0]) * (Length(AArray) - Index - Count)); + SetLength(AArray,Length(AArray) - Count); + end; +end; + +procedure ArrayDelete(var AArray: TByteArray; Index: Integer; Count: Integer); +begin + if Count <> 0 then + begin + Move(AArray[Index + Count],AArray[Index],SizeOf(AArray[0]) * (Length(AArray) - Index - Count)); + SetLength(AArray,Length(AArray) - Count); + end; +end; + +procedure ArrayDelete(var AArray: TWordArray; Index: Integer; Count: Integer); +begin + if Count <> 0 then + begin + Move(AArray[Index + Count],AArray[Index],SizeOf(AArray[0]) * (Length(AArray) - Index - Count)); + SetLength(AArray,Length(AArray) - Count); + end; +end; + +procedure ArrayDelete(var AArray: TCardinalArray; Index: Integer; Count: Integer); +begin + if Count <> 0 then + begin + Move(AArray[Index + Count],AArray[Index],SizeOf(AArray[0]) * (Length(AArray) - Index - Count)); + SetLength(AArray,Length(AArray) - Count); + end; +end; + +procedure ArrayDelete(var AArray: TUInt64Array; Index: Integer; Count: Integer); +begin + if Count <> 0 then + begin + Move(AArray[Index + Count],AArray[Index],SizeOf(AArray[0]) * (Length(AArray) - Index - Count)); + SetLength(AArray,Length(AArray) - Count); + end; +end; + +procedure ArrayDelete(var AArray: TSingleArray; Index: Integer; Count: Integer); +begin + if Count <> 0 then + begin + Move(AArray[Index + Count],AArray[Index],SizeOf(AArray[0]) * (Length(AArray) - Index - Count)); + SetLength(AArray,Length(AArray) - Count); + end; +end; + +procedure ArrayDelete(var AArray: TDoubleArray; Index: Integer; Count: Integer); +begin + if Count <> 0 then + begin + Move(AArray[Index + Count],AArray[Index],SizeOf(AArray[0]) * (Length(AArray) - Index - Count)); + SetLength(AArray,Length(AArray) - Count); + end; +end; + +procedure ArrayDelete(var AArray: TExtendedArray; Index: Integer; Count: Integer); +begin + if Count <> 0 then + begin + Move(AArray[Index + Count],AArray[Index],SizeOf(AArray[0]) * (Length(AArray) - Index - Count)); + SetLength(AArray,Length(AArray) - Count); + end; +end; + function ExtractUserName(const Owner: String): String; var Index: Integer; diff --git a/Source/uVirtObj.pas b/Source/uVirtObj.pas index 807e90c..5ba6903 100644 --- a/Source/uVirtObj.pas +++ b/Source/uVirtObj.pas @@ -3,7 +3,7 @@ unit uVirtObj; ////////////////////////////////////// /// Lina Virtual Object Unit /// /// **************************** /// -/// (c) 2015 Dennis Göhlert a.o. /// +/// (c) 2016 Dennis Göhlert a.o. /// ////////////////////////////////////// {$I 'Config.inc'} diff --git a/Source/uWebCtrls.pas b/Source/uWebCtrls.pas index 1c8128d..6838113 100644 --- a/Source/uWebCtrls.pas +++ b/Source/uWebCtrls.pas @@ -3,7 +3,7 @@ unit uWebCtrls; ////////////////////////////////////// /// Lina Web Controls Unit /// /// **************************** /// -/// (c) 2015 Dennis Göhlert a.o. /// +/// (c) 2016 Dennis Göhlert a.o. /// ////////////////////////////////////// {$I 'Config.inc'}