├── .gitignore ├── Advanced text search ├── FindInFiles.dpr ├── FindInFiles.dproj ├── FindInFiles.res ├── cFindInFile.pas ├── simple │ ├── Tester.dpr │ ├── Tester.dproj │ ├── TesterForm.dfm │ └── TesterForm.pas ├── uMainForm.dfm └── uMainForm.pas ├── Array demo ├── Project_Arrays.dpr ├── Project_Arrays.dproj ├── Project_Arrays.res ├── UnitArrays.dfm └── UnitArrays.pas ├── Classes - Methods and polymorphism ├── FormHide.dfm ├── FormHide.pas ├── FormOverload.dfm ├── FormOverload.pas ├── Project_Polymorphism.dpr ├── Project_Polymorphism.dproj ├── Project_Polymorphism.res └── __history │ └── FormOverload.pas ├── Classes - Typecast demo Delphi ├── Indenter.ico ├── MainForm.dfm ├── MainForm.pas ├── ProjectTypecast.res ├── Project_Typecast.dpr ├── Project_Typecast.dproj ├── Project_Typecast.res └── uMachines.pas ├── Classes - Typecast demo Lazarus ├── Indenter.ico ├── Indenter.lpi ├── Indenter.lpr ├── Indenter.lps ├── mainform.lfm ├── mainform.pas └── umachines.pas ├── Clean.cmd ├── Close Form ├── MainForm.dfm ├── MainForm.pas ├── TestCloseForm.dpr ├── TestCloseForm.dproj ├── TestCloseForm.res ├── formSecond.dfm └── formSecond.pas ├── Custom components 2 ├── DrawingControl.dpk ├── DrawingControl.dproj ├── DrawingControl.res ├── ProjectGroup.groupproj ├── Tester │ ├── Tester.dpr │ ├── Tester.dproj │ ├── Tester.res │ ├── Tester.tproj │ ├── Unit7.dfm │ └── Unit7.pas └── uDrawingControl.pas ├── DataTypes - SizeOf ├── DateTypeSize.res ├── Project_DateTypeSize.dpr ├── Project_DateTypeSize.dproj ├── Unit1.dfm └── Unit1.pas ├── Debug - Memory leaks ├── CreateMemLeak.dpr ├── CreateMemLeak.dproj ├── CreateMemLeak.res ├── FastMM_FullDebugMode.dll ├── TesterForm.dfm └── TesterForm.pas ├── Debugger test ├── MainForm.dfm ├── MainForm.pas ├── Project_Arrays.res ├── Project_DebuggerTest.dpr ├── Project_DebuggerTest.dproj ├── Project_DebuggerTest.res └── Project_DebuggerTest.tproj ├── DemoProjects.groupproj ├── Errors - Premature return from function ├── Premature.dpr ├── Premature.dproj ├── Premature.res ├── StarterProject.res ├── TesterForm.dfm ├── TesterForm.pas └── TesterForm.vlb ├── Errors ├── Project_TryExcept.dpr ├── Project_TryExcept.dproj ├── Project_TryExcept.res ├── Unit1.dfm └── Unit1.pas ├── FastMM4Options.inc ├── Forms-Proper initialization ├── Project_ProperInitialization.dpr ├── Project_ProperInitialization.dproj ├── Unit1.dfm ├── Unit1.pas ├── Unit2.dfm └── Unit2.pas ├── Forms-Two forms ├── Project_TwoForms.dpr ├── Project_TwoForms.dproj ├── Project_TwoForms.res ├── Unit1.dfm ├── Unit1.pas ├── Unit2.dfm └── Unit2.pas ├── Global variables in DLLs ├── DLL1.dpr ├── DLL1.dproj ├── DLL2.dpr ├── DLL2.dproj ├── DLL2.res ├── MainForm.dfm ├── MainForm.pas ├── ProjectGroup1.groupproj ├── TestDLL.dpr ├── TestDLL.dproj ├── TestDLL.res └── Win32 │ └── Debug │ └── DLL2.dll ├── HelloWorld ├── MainForm.dfm ├── MainForm.pas ├── Project_HelloWorld.dpr └── Project_HelloWorld.dproj ├── Initialization in IDE packages (simple) ├── Pkg1_R.dpk ├── Pkg1_R.dproj ├── Pkg1_R.res ├── Pkg2_D.dpk ├── Pkg2_D.dproj ├── Pkg2_D.res ├── Pkg2_R.dpk ├── Pkg2_R.dproj ├── Pkg2_R.res ├── TestApp.dpr ├── TestApp.dproj ├── TestApp.res ├── TestGroup.groupproj ├── uMainForm.dfm ├── uMainForm.pas ├── uTest1.pas ├── uTest2_D.pas └── uTest2_R.pas ├── Initialization in IDE packages 2 (advanced) ├── Pkg1_R.dpk ├── Pkg1_R.dproj ├── Pkg1_R.res ├── Pkg2_D.dpk ├── Pkg2_D.dproj ├── Pkg2_D.res ├── Pkg2_R.dpk ├── Pkg2_R.dproj ├── Pkg2_R.res ├── TestApp.dpr ├── TestApp.dproj ├── TestApp.res ├── TestGroup.groupproj ├── uMainForm.dfm ├── uMainForm.pas ├── uTest1.pas ├── uTest2_D.pas └── uTest2_R.pas ├── Out Parameters ├── FormDemo.dfm ├── FormDemo.pas ├── OutParameters.res ├── Project_CopyRecords.res ├── Project_OutParameters.dpr ├── Project_OutParameters.dproj └── Project_OutParameters.res ├── Packages - Initialization test ├── TestRegPackage.dpk ├── TestRegPackage.dproj └── TestRegister.pas ├── README.md ├── Record field alignment ├── FormDemo.dfm ├── FormDemo.pas ├── Project_FieldAlignment.dpr └── Project_FieldAlignment.dproj ├── Records - Deep copy records ├── FormDemo.dfm ├── FormDemo.pas ├── Project_CopyRecords.dpr ├── Project_CopyRecords.dproj └── Project_CopyRecords.res ├── Required package ├── Package1.dpk ├── Package1.dproj ├── Package1.res ├── Package2.dpk ├── Package2.dproj ├── Package2.res ├── ProjectGroup.groupproj ├── Unit1.pas └── Unit2.pas ├── Show VCL inheritance tree ├── Project_InheritanceTree.dpr ├── Project_InheritanceTree.dproj ├── TesterForm.dfm ├── TesterForm.pas └── cVclUtils.lnk ├── Speed comparison ├── Julia massively outperforms Delphi. Obsolete asm code by Delphi compiler - Stack Overflow.URL ├── Julia_vs_Delphi.jl ├── SpeedTest.dpr ├── SpeedTest.dproj ├── SpeedTest.res ├── TesterForm.dfm └── TesterForm.pas ├── Strings - GetBothNames ├── ProjectBothNames.otares ├── Project_BothNames.dpr ├── Project_BothNames.dproj ├── Unit1.dfm └── Unit1.pas ├── Strings - GetFirstName as function ├── Project_FirstName2.dpr ├── Project_FirstName2.dproj ├── Unit1.dfm └── Unit1.pas ├── Strings - GetFirstName ├── Project_FirstName.dpr ├── Project_FirstName.dproj ├── Unit1.dfm └── Unit1.pas ├── Strings - Null terminator ├── MainForm.dfm ├── MainForm.pas ├── Test.dpr ├── Test.dproj └── Test.res ├── Test rounding numbers ├── FormRounding.dfm ├── FormRounding.pas ├── Project_Rounding.dpr └── Project_Rounding.dproj ├── Virtual keyboard ├── FormKeyboard.dfm ├── FormKeyboard.pas ├── Project_VirtualKeyb.dpr └── Project_VirtualKeyb.dproj └── _Scrips & tools ├── CleanDisabledPkg.cmd ├── Install_LightSaber_package.cmd ├── UpdateEnvironment.cmd ├── Update_NDK.cmd ├── Update_SDK.cmd └── WhereIsDelphi.cmd /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | *.~dsk 3 | *.dsk 4 | *.lnk 5 | -------------------------------------------------------------------------------- /Advanced text search/FindInFiles.dpr: -------------------------------------------------------------------------------- 1 | program FindInFiles; 2 | 3 | uses 4 | FastMM4, 5 | Vcl.Forms, 6 | uMainForm in 'uMainForm.pas' {frmMain}, 7 | cFindInFile in 'cFindInFile.pas', 8 | cbAppData in '..\..\Packages\LightSaber\cbAppData.pas', 9 | FormLog in '..\..\Packages\LightSaber\FormLog.pas'; 10 | 11 | {$R *.res} 12 | 13 | begin 14 | Application.Initialize; 15 | AppData:= TAppDataEx.Create('MyCollApp'); 16 | Application.MainFormOnTaskbar := True; 17 | Application.CreateForm(TfrmMain, frmMain); 18 | Application.Run; 19 | end. 20 | -------------------------------------------------------------------------------- /Advanced text search/FindInFiles.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Advanced text search/FindInFiles.res -------------------------------------------------------------------------------- /Advanced text search/cFindInFile.pas: -------------------------------------------------------------------------------- 1 | unit cFindInFile; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, System.SysUtils, System.Classes, 7 | Vcl.Forms; 8 | 9 | type 10 | TFoundPositions = array of Integer; 11 | 12 | TSearchResult= class(TObject) 13 | FileName: string; 14 | Positions: TFoundPositions; 15 | procedure AddNewPos(Pos: Integer); 16 | function Found: Boolean; 17 | function PositionsAsString: string; 18 | end; 19 | 20 | 21 | function FindStringInFile(FileName: string): TSearchResult; 22 | 23 | 24 | 25 | 26 | implementation 27 | Uses ccCore, csSystem, cbDialogs, ccINIFile, ccIO, cmIO, cmIO.Win; 28 | 29 | 30 | 31 | 32 | 33 | { Find a text using very specific rules. Change the rules and recompile. } 34 | function FindStringsInLine(TextLine: string): Boolean; 35 | var 36 | iFunction, iEnum: Integer; 37 | begin 38 | iFunction:= PosInsensitive('function', TextLine); 39 | iEnum:= PosInsensitive('.enum', TextLine); 40 | Result:= (iFunction = 1) AND (iEnum > 9) AND (iEnum < 50); 41 | end; 42 | 43 | 44 | function FindStringInLine(TextLine, Needle: string): Boolean; 45 | begin 46 | var iPos:= PosInsensitive(Needle, TextLine); 47 | Result:= (iPos > 0); 48 | end; 49 | 50 | { Returns the line(s) where the text was found } 51 | function FindStringInFile(FileName: string): TSearchResult; 52 | var 53 | TextBody: TStringList; 54 | sLine: string; 55 | i: Integer; 56 | begin 57 | Result:= TSearchResult.Create; 58 | Result.FileName:= FileName; 59 | 60 | TextBody:= StringFromFileTSL(FileName); 61 | try 62 | for i:= 0 to TextBody.Count-1 do 63 | begin 64 | sLine:= TextBody[i]; 65 | if FindStringInLine(sLine, '{$') // Find lines that has compiler directives 66 | and not FindStringInLine(sLine, '{$R *') // Ignore lines that are DFM resource files 67 | and not FindStringInLine(sLine, '{$EXTERNALSYM') // API 68 | and not FindStringInLine(sLine, '{$IFDEF') // Ignore lines that are DEF 69 | and not FindStringInLine(sLine, '{$IFNDEF') // Ignore lines that are DEF 70 | and not FindStringInLine(sLine, '{$DEF') // Ignore lines that are DEF 71 | and not FindStringInLine(sLine, '{$ENDIF') // Ignore lines that are DEF 72 | then 73 | begin 74 | { Returns the line(s) where the text was found } 75 | Result.AddNewPos(i); 76 | end; 77 | end; 78 | finally 79 | FreeAndNil(TextBody); 80 | end; 81 | end; 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | { TSearchResult } 90 | procedure TSearchResult.AddNewPos(Pos: Integer); 91 | begin 92 | SetLength(Positions, Length(Positions)+1); 93 | Positions[High(Positions)]:= Pos; 94 | end; 95 | 96 | 97 | function TSearchResult.Found: Boolean; 98 | begin 99 | Result:= Length(Positions) > 0; 100 | end; 101 | 102 | 103 | function TSearchResult.PositionsAsString: string; 104 | begin 105 | Result:= ''; 106 | for var i in Positions 107 | do Result:= Result+ IntToStr(i)+ ','; 108 | Result:= RemoveLastChar(Result); 109 | end; 110 | 111 | 112 | end. 113 | -------------------------------------------------------------------------------- /Advanced text search/simple/Tester.dpr: -------------------------------------------------------------------------------- 1 | program Tester; 2 | 3 | uses 4 | fastmm4, 5 | Forms, 6 | TesterForm in 'TesterForm.pas' {frmTester}, 7 | cbAppData in '..\..\..\..\..\Packages\LightSaber\cbAppData.pas', 8 | FormLog in '..\..\..\..\..\Packages\LightSaber\FormLog.pas'; 9 | 10 | {$R *.res} 11 | 12 | begin 13 | Application.Initialize; 14 | AppData:= TAppDataEx.Create('Cubic Advanced Text Search'); 15 | Application.MainFormOnTaskbar := True; { If true, a taskbar button represents the application's main form and displays its caption. All child forms will stay on top of the MainForm (bad)! If False, a taskbar button represents the application's (hidden) main window and bears the application's Title. Must be True to use Windows (Vista) Aero effects (ive taskbar thumbnails, Dynamic Windows, Windows Flip, Windows Flip 3D). https://stackoverflow.com/questions/66720721/ } 16 | Application.CreateForm(TfrmTester, frmTester); 17 | frmTester.Show; 18 | Application.Run; 19 | end. 20 | -------------------------------------------------------------------------------- /Advanced text search/simple/TesterForm.dfm: -------------------------------------------------------------------------------- 1 | object frmTester: TfrmTester 2 | Left = 373 3 | Top = 170 4 | Anchors = [] 5 | Caption = 'Search for text in files' 6 | ClientHeight = 571 7 | ClientWidth = 777 8 | Color = clBtnFace 9 | Constraints.MinHeight = 500 10 | Constraints.MinWidth = 690 11 | DoubleBuffered = True 12 | Font.Charset = DEFAULT_CHARSET 13 | Font.Color = clWindowText 14 | Font.Height = -11 15 | Font.Name = 'Tahoma' 16 | Font.Style = [] 17 | OldCreateOrder = False 18 | Position = poDesigned 19 | ScreenSnap = True 20 | ShowHint = True 21 | SnapBuffer = 4 22 | OnCreate = FormCreate 23 | OnDestroy = FormDestroy 24 | PixelsPerInch = 96 25 | TextHeight = 13 26 | object lblInfo: TLabel 27 | AlignWithMargins = True 28 | Left = 3 29 | Top = 3 30 | Width = 771 31 | Height = 13 32 | Align = alTop 33 | Caption = 'Find the specified text in all files in folder.' 34 | end 35 | object Log: TRichLog 36 | Left = 0 37 | Top = 132 38 | Width = 777 39 | Height = 439 40 | Align = alClient 41 | Font.Charset = ANSI_CHARSET 42 | Font.Color = clWindowText 43 | Font.Height = -11 44 | Font.Name = 'Tahoma' 45 | Font.Style = [] 46 | HideSelection = False 47 | Lines.Strings = ( 48 | 'Log') 49 | MaxLength = 2147483632 50 | ParentFont = False 51 | ParentShowHint = False 52 | ScrollBars = ssVertical 53 | ShowHint = True 54 | TabOrder = 0 55 | WordWrap = False 56 | Zoom = 100 57 | end 58 | object Panel1: TPanel 59 | Left = 0 60 | Top = 19 61 | Width = 777 62 | Height = 113 63 | Align = alTop 64 | TabOrder = 1 65 | DesignSize = ( 66 | 777 67 | 113) 68 | object edtSearchWord: TCubicLabelEdit 69 | Left = 26 70 | Top = 38 71 | Width = 189 72 | Height = 21 73 | EditLabel.Width = 54 74 | EditLabel.Height = 13 75 | EditLabel.Caption = 'Search for:' 76 | TabOrder = 0 77 | Text = ' 8.1 Text: ' 78 | end 79 | object chkNonEmpty: TCubicCheckBox 80 | Left = 26 81 | Top = 72 82 | Width = 168 83 | Height = 17 84 | Hint = 85 | 'Do not log the file if the text was found but there was no addit' + 86 | 'ional text after it' 87 | Caption = 'Ignore if the line is incomplete' 88 | Checked = True 89 | State = cbChecked 90 | TabOrder = 1 91 | AutoSize = True 92 | end 93 | object Path: TCubicPathEdit 94 | Left = 332 95 | Top = 22 96 | Width = 427 97 | Height = 41 98 | Hint = 'You can drag and drop folders here' 99 | Caption = 'Folder' 100 | TabOrder = 2 101 | end 102 | object edtFileType: TCubicLabelEdit 103 | Left = 230 104 | Top = 38 105 | Width = 73 106 | Height = 21 107 | Hint = 'Only search these files' 108 | EditLabel.Width = 41 109 | EditLabel.Height = 13 110 | EditLabel.Caption = 'File type' 111 | TabOrder = 3 112 | Text = '*.*' 113 | end 114 | object btnStart: TButton 115 | Left = 624 116 | Top = 76 117 | Width = 150 118 | Height = 35 119 | Anchors = [akRight, akBottom] 120 | Caption = 'START Search' 121 | TabOrder = 4 122 | OnClick = btnStartClick 123 | end 124 | end 125 | end 126 | -------------------------------------------------------------------------------- /Advanced text search/simple/TesterForm.pas: -------------------------------------------------------------------------------- 1 | UNIT TesterForm; 2 | 3 | INTERFACE 4 | 5 | USES 6 | WinApi.Windows, WinApi.Messages, System.SysUtils, System.Classes, Vcl.StdCtrls, VCL.Forms, Vcl.Controls, Vcl.Samples.Spin, 7 | cvRichEdit, FormLog, Vcl.ComCtrls, ccCore, csSystem, cbDialogs, ccINIFile, Vcl.ExtCtrls, cvLabelEdit, cvPathEdit, cvCheckBox, 8 | llRichLog, cbAppData; 9 | 10 | TYPE 11 | TfrmTester = class(TForm) 12 | lblInfo: TLabel; 13 | Log: TRichLog; 14 | Panel1: TPanel; 15 | edtSearchWord: TCubicLabelEdit; 16 | chkNonEmpty: TCubicCheckBox; 17 | Path: TCubicPathEdit; 18 | edtFileType: TCubicLabelEdit; 19 | btnStart: TButton; 20 | procedure btnStartClick(Sender: TObject); 21 | procedure FormCreate(Sender: TObject); 22 | procedure FormDestroy(Sender: TObject); 23 | protected 24 | private 25 | procedure LateInitialize(VAR Msg: TMessage); message MSG_LateFormInit; // Called after the main form was fully created 26 | procedure SearchInFile(FileName: string); 27 | public 28 | end; 29 | 30 | VAR 31 | frmTester: TfrmTester; 32 | 33 | IMPLEMENTATION {$R *.dfm} 34 | 35 | USES shellApi, cbIniFile, cvIniFile, ccIO, cmIO, cmIO.Win, system.IniFiles; 36 | 37 | 38 | 39 | 40 | 41 | {-------------------------------------------------------------------------------------------------- 42 | APP START/CLOSE 43 | --------------------------------------------------------------------------------------------------} 44 | procedure TfrmTester.FormCreate(Sender: TObject); 45 | begin 46 | DragAcceptFiles(Handle, True); { Accept the dropped files from Windows Explorer } 47 | PostMessage(Self.Handle, MSG_LateAppInit_, 0, 0); Not needed anymore. Moved to cbAppData { This will call LateInitialize } 48 | end; 49 | 50 | 51 | procedure TfrmTester.LateInitialize; 52 | begin 53 | LoadForm(Self); 54 | AppData.Initializing:= FALSE; moved to cbAppData 55 | edtSearchWord.Text:= ' My Text: '; 56 | end; 57 | 58 | 59 | procedure TfrmTester.FormDestroy(Sender: TObject); 60 | begin 61 | SaveForm(Self); 62 | //FreeAndNil(AppData-); 63 | end; 64 | 65 | 66 | 67 | 68 | 69 | procedure TfrmTester.SearchInFile(FileName: string); 70 | VAR 71 | iLine: Integer; 72 | Body: TStringList; 73 | 74 | procedure ListFile; 75 | begin 76 | Log.AddImpo(FileName); 77 | Log.AddMsg(IntToStr(iLine)+ ' -> '+ Body[iLine]); 78 | Log.AddEmptyRow; 79 | end; 80 | 81 | begin 82 | Body:= ccIO.StringFromFileTSL(FileName); 83 | TRY 84 | 85 | for iLine:= 0 to Body.Count-1 DO 86 | 87 | if Pos(edtSearchWord.Text, Body[iLine]) > 0 then 88 | begin 89 | if chkNonEmpty.Checked 90 | then 91 | begin 92 | if Body[iLine].Length > Length(edtSearchWord.Text) 93 | then ListFile 94 | end 95 | else ListFile; 96 | 97 | //if FindOnce then Break; 98 | end; 99 | 100 | FINALLY 101 | FreeAndNil(Body); 102 | END; 103 | end; 104 | 105 | 106 | 107 | procedure TfrmTester.btnStartClick(Sender: TObject); 108 | VAR 109 | i: Integer; 110 | FileList: TStringList; 111 | begin 112 | log.Clear; 113 | Caption:= 'Building list of files...'; 114 | FileList:= ccIO.ListFilesOf(Path.Path, edtFileType.Text, TRUE, TRUE); 115 | TRY 116 | 117 | for i:= 0 to FileList.Count-1 DO 118 | begin 119 | Caption:= 'File ' + IntToStr(i+1) + ' of ' + IntToStr(FileList.Count); 120 | SearchInFile(FileList[i]); 121 | end; 122 | 123 | Caption:= 'Ready'; 124 | FINALLY 125 | FreeAndNil(FileList); 126 | END; 127 | end; 128 | 129 | 130 | 131 | end. 132 | -------------------------------------------------------------------------------- /Array demo/Project_Arrays.dpr: -------------------------------------------------------------------------------- 1 | program Project_Arrays; 2 | 3 | uses 4 | FastMM4, 5 | Vcl.Forms, 6 | UnitArrays in 'UnitArrays.pas' {Form21}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.MainFormOnTaskbar := True; 13 | Application.CreateForm(TForm21, Form21); 14 | Application.Run; 15 | end. 16 | -------------------------------------------------------------------------------- /Array demo/Project_Arrays.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Array demo/Project_Arrays.res -------------------------------------------------------------------------------- /Array demo/UnitArrays.dfm: -------------------------------------------------------------------------------- 1 | object Form21: TForm21 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form21' 5 | ClientHeight = 337 6 | ClientWidth = 635 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | end 18 | -------------------------------------------------------------------------------- /Array demo/UnitArrays.pas: -------------------------------------------------------------------------------- 1 | unit UnitArrays; 2 | 3 | {------------------------------------------------------------------------------------------------------------- 4 | This program demonstrates how to declare, initializa and copy arrays } 5 | 6 | interface 7 | 8 | uses 9 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 10 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs; 11 | 12 | type 13 | TForm21 = class(TForm) 14 | procedure FormCreate(Sender: TObject); 15 | private 16 | public 17 | end; 18 | 19 | var 20 | Form21: TForm21; 21 | 22 | implementation {$R *.dfm} 23 | 24 | 25 | procedure TestCopyArray; 26 | VAR 27 | i : Integer; 28 | Source, Target : array of Integer; 29 | begin 30 | SetLength(Source, 8); 31 | 32 | for i := 1 to 8 do // Build the dynamic source array 33 | Source[i-1] := i; // Remember that arrays start at index 0 34 | 35 | Target := Copy(Source, 3, 4); 36 | 37 | for i := 0 to Length(Target) -1 do // Display the created array 38 | ShowMessage('Target['+IntToStr(i)+'] : '+IntToStr(Target[i])); 39 | end; 40 | 41 | 42 | 43 | procedure TForm21.FormCreate(Sender: TObject); 44 | CONST 45 | A: Array[1..2,1..2] of Real = ((1,2),(3,4)); 46 | TwoDee: array[1..2, 1..5] of Integer = ( (2,4,6,8,10), (101,102,103,104,105) ); 47 | 48 | Days: array[1..7] of string = ('Mon','Tue','Wed','Thu','Fri','Sat','Sun'); 49 | Numbers: array[0..9] of integer = (0,1,2,3,4,5,6,7,8,9); 50 | 51 | VAR 52 | Source, Target: array of Integer; 53 | begin 54 | Target:= Source; 55 | Target:= Copy(Source, 0, High(Source)); 56 | end; 57 | 58 | 59 | end. 60 | -------------------------------------------------------------------------------- /Classes - Methods and polymorphism/FormHide.dfm: -------------------------------------------------------------------------------- 1 | object frmReinstroduce: TfrmReinstroduce 2 | Left = 277 3 | Top = 549 4 | Caption = 'Polymorphism demo - Hiding a method' 5 | ClientHeight = 222 6 | ClientWidth = 479 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | Position = poDesigned 15 | DesignSize = ( 16 | 479 17 | 222) 18 | PixelsPerInch = 96 19 | TextHeight = 13 20 | object Button1: TButton 21 | Left = 264 22 | Top = 74 23 | Width = 156 24 | Height = 33 25 | Anchors = [] 26 | Caption = 'Declared as THide1' 27 | TabOrder = 0 28 | OnClick = Button1Click 29 | end 30 | object Button2: TButton 31 | Left = 264 32 | Top = 114 33 | Width = 156 34 | Height = 33 35 | Anchors = [] 36 | Caption = 'Declared as THide2' 37 | TabOrder = 1 38 | OnClick = Button2Click 39 | end 40 | object Button3: TButton 41 | Left = 59 42 | Top = 114 43 | Width = 156 44 | Height = 33 45 | Anchors = [] 46 | Caption = 'Declared as TOvr2' 47 | TabOrder = 2 48 | OnClick = Button3Click 49 | end 50 | object Button4: TButton 51 | Left = 59 52 | Top = 74 53 | Width = 156 54 | Height = 33 55 | Anchors = [] 56 | Caption = 'Declared as TOvr1' 57 | TabOrder = 3 58 | OnClick = Button4Click 59 | end 60 | end 61 | -------------------------------------------------------------------------------- /Classes - Methods and polymorphism/FormHide.pas: -------------------------------------------------------------------------------- 1 | UNIT FormHide; 2 | 3 | INTERFACE 4 | 5 | USES 6 | System.SysUtils, System.Classes, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; 7 | 8 | TYPE 9 | TfrmReinstroduce = class(TForm) 10 | Button1: TButton; 11 | Button2: TButton; 12 | Button3: TButton; 13 | Button4: TButton; 14 | procedure Button1Click(Sender: TObject); 15 | procedure Button2Click(Sender: TObject); 16 | procedure Button3Click(Sender: TObject); 17 | procedure Button4Click(Sender: TObject); 18 | end; 19 | 20 | VAR 21 | frmReinstroduce: TfrmReinstroduce; 22 | 23 | IMPLEMENTATION {$R *.dfm} 24 | 25 | 26 | 27 | 28 | 29 | {------------------------------------------------------------------------------------------------------------- 30 | OVERRIDING A METHOD 31 | Polymorphism works properly 32 | -------------------------------------------------------------------------------------------------------------} 33 | 34 | TYPE 35 | TOvr1 = class(TObject) 36 | function Print: string; virtual; 37 | end; 38 | 39 | TOvr2 = class(TOvr1) 40 | function Print: string; override; // Print is redeclared and overridden. It doesn't hide parent's Print method. 41 | end; 42 | 43 | 44 | function TOvr1.Print: string; 45 | begin 46 | Result:= 'Class TOvr1 (parent)'; 47 | end; 48 | 49 | 50 | function TOvr2.Print: string; 51 | begin 52 | Result:= 'Class TOvr2'; 53 | end; 54 | 55 | 56 | 57 | 58 | {------------------- 59 | Using the class 60 | --------------------} 61 | 62 | procedure TfrmReinstroduce.Button3Click(Sender: TObject); 63 | var 64 | SomeObject: TOvr1; // Declared as TOvr1 but constructed as TOvr2 65 | begin 66 | SomeObject := TOvr2.Create; 67 | Caption:= SomeObject.Print; // Calls TOvr2.Print because of the polymorphism 68 | end; 69 | 70 | 71 | procedure TfrmReinstroduce.Button4Click(Sender: TObject); 72 | var 73 | SomeObject: TOvr2; // Declared as TOvr2, constructed as TOvr2 74 | begin 75 | SomeObject := TOvr2.Create; 76 | Caption:= SomeObject.Print; // Calls T2.Print 77 | end; 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | {------------------------------------------------------------------------------------------------------------- 96 | HIDING A METHOD 97 | This will break the polymorphism chain! 98 | -------------------------------------------------------------------------------------------------------------} 99 | 100 | TYPE 101 | THide1 = class(TObject) 102 | function Print: string; virtual; 103 | end; 104 | 105 | THide2 = class(THide1) 106 | // Print is redeclared, but not overridden, therefore it hides parent's Print method. 107 | // We need to use reintroduce to make the warning "Method Print hides virtual method of base type T1" go away. 108 | function Print: string; reintroduce; 109 | end; 110 | 111 | function THide1.Print: string; 112 | begin 113 | Result:= 'Class THide1 (parent)'; 114 | end; 115 | 116 | 117 | function THide2.Print: string; 118 | begin 119 | Result:= 'Class THide2'; 120 | end; 121 | 122 | 123 | {------------------- 124 | Using the class 125 | --------------------} 126 | 127 | procedure TfrmReinstroduce.Button1Click(Sender: TObject); 128 | var 129 | SomeObject: THide1; // Declared as THide1 but constructed as THide2 130 | begin 131 | SomeObject := THide2.Create; 132 | Caption:= SomeObject.Print; // Calls THide1.Print instead of THide2.Print because THide2.Prin was hidden. We can say that the behavior in this case is pretty much the same as in the case of a 'static' method. 133 | end; 134 | 135 | 136 | procedure TfrmReinstroduce.Button2Click(Sender: TObject); 137 | var 138 | SomeObject: THide2; // Declared as THide2, constructed as THide2 139 | begin 140 | SomeObject := THide2.Create; 141 | Caption:= SomeObject.Print; // Calls T2.Print 142 | end; 143 | 144 | 145 | end. 146 | -------------------------------------------------------------------------------- /Classes - Methods and polymorphism/FormOverload.dfm: -------------------------------------------------------------------------------- 1 | object frmOverride: TfrmOverride 2 | Left = 823 3 | Top = 525 4 | Caption = 'Polymorphism demo - Overriding a method' 5 | ClientHeight = 222 6 | ClientWidth = 367 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | Position = poDesigned 15 | DesignSize = ( 16 | 367 17 | 222) 18 | PixelsPerInch = 96 19 | TextHeight = 13 20 | object btnT3: TButton 21 | Left = 117 22 | Top = 41 23 | Width = 132 24 | Height = 33 25 | Anchors = [] 26 | Caption = 'Class T3' 27 | TabOrder = 0 28 | OnClick = btnT3Click 29 | end 30 | object btnT6: TButton 31 | Left = 117 32 | Top = 167 33 | Width = 132 34 | Height = 33 35 | Anchors = [] 36 | Caption = 'Abstract method' 37 | TabOrder = 1 38 | WordWrap = True 39 | OnClick = btnT6Click 40 | end 41 | end 42 | -------------------------------------------------------------------------------- /Classes - Methods and polymorphism/FormOverload.pas: -------------------------------------------------------------------------------- 1 | UNIT FormOverload; 2 | 3 | {------------------------------------------------------------------------------------------------------------- 4 | OVERRIDING A METHOD 5 | Polymorphism works properly 6 | -------------------------------------------------------------------------------------------------------------} 7 | 8 | INTERFACE 9 | 10 | USES 11 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, 12 | Vcl.Controls, Vcl.Forms, Vcl.StdCtrls; 13 | 14 | TYPE 15 | TfrmOverride = class(TForm) 16 | btnT3: TButton; 17 | btnT6: TButton; 18 | procedure btnT3Click(Sender: TObject); 19 | procedure btnT6Click(Sender: TObject); 20 | private 21 | public 22 | end; 23 | 24 | VAR 25 | frmOverride: TfrmOverride; 26 | 27 | IMPLEMENTATION {$R *.dfm} 28 | 29 | 30 | 31 | 32 | {------------------------------------------------------------------------------------------------------------- 33 | OVERLOADING METHODS WITH DIFFERENT PARAMETERS 34 | -------------------------------------------------------------------------------------------------------------} 35 | 36 | TYPE 37 | T3 = class(TObject) 38 | function Print(S: string): string; virtual; 39 | end; 40 | 41 | T4 = class(T3) 42 | // Same method name but different parameter 43 | // We cannot use override here. Override can be used only if this method signature (name/parameters) is identical with parent's method signature 44 | function Print(I: Integer): string; reintroduce; overload; 45 | end; 46 | 47 | 48 | 49 | function T3.Print(S: string): string; 50 | begin 51 | Result:= S; 52 | end; 53 | 54 | 55 | function T4.Print(I: Integer): string; 56 | begin 57 | Result:= IntToStr(i)+ ' (child)'; 58 | end; 59 | 60 | 61 | 62 | 63 | 64 | 65 | procedure TfrmOverride.btnT3Click(Sender: TObject); 66 | VAR SomeObject: T4; 67 | begin 68 | SomeObject:= T4.Create; 69 | Caption:= SomeObject.Print('The answer to life is ') // calls T3.Print(s) 70 | + SomeObject.Print(42); // calls T4.Print(i) 71 | end; 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | {------------------------------------------------------------------------------------------------------------- 83 | ABSTRACT METHODS 84 | -------------------------------------------------------------------------------------------------------------} 85 | 86 | TYPE 87 | T5 = class(TObject) 88 | //This method is abstract (not implemented in T5). All abstract methods must be virtual 89 | function Print: string; virtual; abstract; 90 | 91 | //This will generate an warning because it is abstract and we don't implement it in the 92 | // inherited class (T6): Constructing instance of 'T6' containing abstract method 'T5.PrintMe'. 93 | //We have 3 choises: 94 | // 1) hide the warning (if you know what you are doing). 95 | // 2) implement the method in T5 (as an empty method). 96 | // 3) implement the method in T6 (as an empty method) 97 | function PrintMe: string; virtual; abstract; 98 | end; 99 | 100 | T6 = class(T5) 101 | // This implements the missing/abstract method of T5 102 | function Print: string; override; 103 | end; 104 | 105 | 106 | 107 | 108 | function T6.Print: string; 109 | begin 110 | Result:= 'Class T6 (child)'; 111 | end; 112 | 113 | 114 | procedure TfrmOverride.btnT6Click(Sender: TObject); 115 | var 116 | SomeObject: T6; 117 | begin 118 | SomeObject := T6.Create; 119 | Caption:= SomeObject.Print; // calls T6.Print 120 | end; 121 | 122 | 123 | 124 | end. 125 | -------------------------------------------------------------------------------- /Classes - Methods and polymorphism/Project_Polymorphism.dpr: -------------------------------------------------------------------------------- 1 | program Project_Polymorphism; 2 | 3 | uses 4 | Vcl.Forms, 5 | FormHide in 'FormHide.pas' {frmReinstroduce}, 6 | FormOverload in 'FormOverload.pas' {frmOverride}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.MainFormOnTaskbar := True; 13 | Application.CreateForm(TfrmReinstroduce, frmReinstroduce); 14 | Application.CreateForm(TfrmOverride, frmOverride); 15 | frmOverride.Show; 16 | Application.Run; 17 | end. 18 | -------------------------------------------------------------------------------- /Classes - Methods and polymorphism/Project_Polymorphism.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Classes - Methods and polymorphism/Project_Polymorphism.res -------------------------------------------------------------------------------- /Classes - Methods and polymorphism/__history/FormOverload.pas: -------------------------------------------------------------------------------- 1 | UNIT FormOverload; 2 | 3 | {------------------------------------------------------------------------------------------------------------- 4 | OVERRIDING A METHOD 5 | Polymorphism works properly 6 | -------------------------------------------------------------------------------------------------------------} 7 | 8 | INTERFACE 9 | 10 | USES 11 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, 12 | Vcl.Controls, Vcl.Forms, Vcl.StdCtrls; 13 | 14 | TYPE 15 | TfrmOverride = class(TForm) 16 | btnT3: TButton; 17 | btnT4: TButton; 18 | btnT6: TButton; 19 | procedure btnT3Click(Sender: TObject); 20 | procedure btnT4Click(Sender: TObject); 21 | procedure btnT6Click(Sender: TObject); 22 | private 23 | public 24 | end; 25 | 26 | VAR 27 | frmOverride: TfrmOverride; 28 | 29 | IMPLEMENTATION {$R *.dfm} 30 | 31 | 32 | 33 | 34 | {------------------------------------------------------------------------------------------------------------- 35 | OVERLOADING METHODS WITH DIFFERENT PARAMETERS 36 | -------------------------------------------------------------------------------------------------------------} 37 | 38 | TYPE 39 | T0 = class(TObject) 40 | end; 41 | 42 | T3 = class(T0) 43 | function Print(S: string): string; virtual; 44 | end; 45 | 46 | T4 = class(T0) 47 | // Same method name but different parameter 48 | // We cannot use override here. Override can be used only if this method signature (name/parameters) is identical with parent's method signature 49 | function Print(I: Integer): string; //reintroduce; overload; {override;} 50 | end; 51 | 52 | 53 | function T3.Print(S: string): string; 54 | begin 55 | Result:= S; 56 | end; 57 | 58 | 59 | function T4.Print(I: Integer): string; 60 | begin 61 | Result:= IntToStr(i)+ ' (child)'; 62 | end; 63 | 64 | 65 | 66 | 67 | 68 | 69 | procedure TfrmOverride.btnT3Click(Sender: TObject); 70 | VAR SomeObject: T0; 71 | begin 72 | SomeObject:= T4.Create; 73 | Caption:= (SomeObject as T3).Print('The answer to life is ') // calls T3.Print(s) 74 | + (SomeObject as T4).Print(42); // calls T4.Print(i) 75 | end; 76 | 77 | 78 | procedure TfrmOverride.btnT4Click(Sender: TObject); 79 | VAR SomeObject: T4; 80 | begin 81 | SomeObject:= T4.Create; 82 | Caption:= SomeObject.Print('The answer to life is ') // calls T3.Print(s) 83 | + SomeObject.Print(42); // calls T4.Print(i) 84 | end; 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | {------------------------------------------------------------------------------------------------------------- 96 | ABSTRACT METHODS 97 | -------------------------------------------------------------------------------------------------------------} 98 | 99 | TYPE 100 | T5 = class(TObject) 101 | //This method is abstract (not implemented in T5). All abstract methods must be virtual 102 | function Print: string; virtual; abstract; 103 | 104 | //This will generate an warning because it is abstract and we don't implement it in the 105 | // inherited class (T6): Constructing instance of 'T6' containing abstract method 'T5.PrintMe'. 106 | //We have 3 choises: 107 | // 1) hide the warning (if you know what you are doing). 108 | // 2) implement the method in T5 (as an empty method). 109 | // 3) implement the method in T6 (as an empty method) 110 | function PrintMe: string; virtual; abstract; 111 | end; 112 | 113 | T6 = class(T5) 114 | // This implements the missing/abstract method of T5 115 | function Print: string; override; 116 | end; 117 | 118 | 119 | 120 | 121 | function T6.Print: string; 122 | begin 123 | Result:= 'Class T6 (child)'; 124 | end; 125 | 126 | 127 | procedure TfrmOverride.btnT6Click(Sender: TObject); 128 | var 129 | SomeObject: T5; 130 | begin 131 | SomeObject := T6.Create; 132 | Caption:= SomeObject.Print; // calls T6.Print 133 | end; 134 | 135 | 136 | 137 | end. 138 | -------------------------------------------------------------------------------- /Classes - Typecast demo Delphi/Indenter.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Classes - Typecast demo Delphi/Indenter.ico -------------------------------------------------------------------------------- /Classes - Typecast demo Delphi/MainForm.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'Typecasting demo' 5 | ClientHeight = 337 6 | ClientWidth = 558 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object Memo: TMemo 18 | Left = 0 19 | Top = 0 20 | Width = 426 21 | Height = 337 22 | Align = alClient 23 | TabOrder = 0 24 | end 25 | object Panel: TPanel 26 | Left = 426 27 | Top = 0 28 | Width = 132 29 | Height = 337 30 | Align = alRight 31 | TabOrder = 1 32 | object btnAsCast: TButton 33 | AlignWithMargins = True 34 | Left = 4 35 | Top = 4 36 | Width = 124 37 | Height = 44 38 | Align = alTop 39 | Caption = '"As" typecast' 40 | TabOrder = 0 41 | OnClick = btnAsCastClick 42 | end 43 | object btnIs: TButton 44 | AlignWithMargins = True 45 | Left = 4 46 | Top = 54 47 | Width = 124 48 | Height = 44 49 | Align = alTop 50 | Caption = 'Is' 51 | TabOrder = 1 52 | OnClick = btnIsClick 53 | end 54 | object btnHardTypecast: TButton 55 | AlignWithMargins = True 56 | Left = 4 57 | Top = 104 58 | Width = 124 59 | Height = 44 60 | Align = alTop 61 | Caption = 'Hard typecast' 62 | TabOrder = 2 63 | OnClick = btnHardTypecastClick 64 | end 65 | object btnBadTypecast: TButton 66 | AlignWithMargins = True 67 | Left = 4 68 | Top = 154 69 | Width = 124 70 | Height = 44 71 | Align = alTop 72 | Caption = 'Bad typecast 1' 73 | TabOrder = 3 74 | OnClick = btnBadTypecastClick 75 | end 76 | object btnBadTypecast2: TButton 77 | AlignWithMargins = True 78 | Left = 4 79 | Top = 204 80 | Width = 124 81 | Height = 44 82 | Align = alTop 83 | Caption = 'Bad typecast 2' 84 | TabOrder = 4 85 | OnClick = btnBadTypecast2Click 86 | end 87 | object btnBadTypecast3: TButton 88 | AlignWithMargins = True 89 | Left = 4 90 | Top = 254 91 | Width = 124 92 | Height = 44 93 | Align = alTop 94 | Caption = 'Bad typecast 3' 95 | TabOrder = 5 96 | OnClick = btnBadTypecast3Click 97 | end 98 | end 99 | end 100 | -------------------------------------------------------------------------------- /Classes - Typecast demo Delphi/ProjectTypecast.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Classes - Typecast demo Delphi/ProjectTypecast.res -------------------------------------------------------------------------------- /Classes - Typecast demo Delphi/Project_Typecast.dpr: -------------------------------------------------------------------------------- 1 | program Project_Typecast; 2 | 3 | uses 4 | Vcl.Forms, 5 | MainForm in 'MainForm.pas' {frmMain}, 6 | uMachines in 'uMachines.pas'; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.MainFormOnTaskbar := True; 13 | Application.CreateForm(TfrmMain, frmMain); 14 | Application.Run; 15 | end. 16 | -------------------------------------------------------------------------------- /Classes - Typecast demo Delphi/Project_Typecast.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Classes - Typecast demo Delphi/Project_Typecast.res -------------------------------------------------------------------------------- /Classes - Typecast demo Delphi/uMachines.pas: -------------------------------------------------------------------------------- 1 | unit uMachines; 2 | 3 | INTERFACE 4 | 5 | USES 6 | Classes, SysUtils; 7 | 8 | 9 | TYPE 10 | TMachinery = class(TObject) 11 | public 12 | Name: string; 13 | constructor Create; overload; 14 | function WhatAreYou: string; 15 | end; 16 | 17 | TCar = class(TMachinery) 18 | private 19 | s: string; 20 | public 21 | constructor Create; overload; 22 | function WhatAreYou: string; 23 | end; 24 | 25 | TAirplane = class(TMachinery) 26 | public 27 | constructor Create; overload; 28 | function WhatAreYou: string; 29 | end; 30 | 31 | 32 | implementation 33 | 34 | 35 | constructor TMachinery.Create; 36 | begin 37 | inherited Create; 38 | Name:= 'TMachinery'; 39 | end; 40 | 41 | function TMachinery.WhatAreYou: string; 42 | begin 43 | Result:= 'Machinery'; 44 | end; 45 | 46 | 47 | 48 | 49 | constructor TCar.Create; 50 | begin 51 | inherited Create; // This will construct the TMachinery and set the Name to 'some kind of machine'... 52 | Name:= 'TCar'; // ...however, here we override the name with our own string (a car) 53 | end; 54 | 55 | 56 | function TCar.WhatAreYou: string; 57 | begin 58 | Result:= 'Car'; 59 | end; 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | constructor TAirplane.Create; 68 | begin 69 | inherited Create; // This will set the name to 'some kind of machine' then to 'a car'... 70 | Name:= 'TAirplane'; // ... and now we again overwrite those name with our own (an airplane) 71 | end; 72 | 73 | function TAirplane.WhatAreYou: string; 74 | begin 75 | Result:= 'Airplane'; 76 | end; 77 | 78 | 79 | end. 80 | 81 | -------------------------------------------------------------------------------- /Classes - Typecast demo Lazarus/Indenter.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Classes - Typecast demo Lazarus/Indenter.ico -------------------------------------------------------------------------------- /Classes - Typecast demo Lazarus/Indenter.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | <Scaled Value="True"/> 11 | <ResourceType Value="res"/> 12 | <UseXPManifest Value="True"/> 13 | <XPManifest> 14 | <DpiAware Value="True"/> 15 | </XPManifest> 16 | <Icon Value="0"/> 17 | </General> 18 | <BuildModes Count="1"> 19 | <Item1 Name="Default" Default="True"/> 20 | </BuildModes> 21 | <PublishOptions> 22 | <Version Value="2"/> 23 | <UseFileFilters Value="True"/> 24 | </PublishOptions> 25 | <RunParams> 26 | <FormatVersion Value="2"/> 27 | <Modes Count="0"/> 28 | </RunParams> 29 | <RequiredPackages Count="1"> 30 | <Item1> 31 | <PackageName Value="LCL"/> 32 | </Item1> 33 | </RequiredPackages> 34 | <Units Count="3"> 35 | <Unit0> 36 | <Filename Value="Indenter.lpr"/> 37 | <IsPartOfProject Value="True"/> 38 | </Unit0> 39 | <Unit1> 40 | <Filename Value="..\typecasts\mainform.pas"/> 41 | <IsPartOfProject Value="True"/> 42 | <ComponentName Value="Form1"/> 43 | <HasResources Value="True"/> 44 | <ResourceBaseClass Value="Form"/> 45 | <UnitName Value="MainForm"/> 46 | </Unit1> 47 | <Unit2> 48 | <Filename Value="umachines.pas"/> 49 | <IsPartOfProject Value="True"/> 50 | <UnitName Value="uMachines"/> 51 | </Unit2> 52 | </Units> 53 | </ProjectOptions> 54 | <CompilerOptions> 55 | <Version Value="11"/> 56 | <PathDelim Value="\"/> 57 | <Target> 58 | <Filename Value="Indenter"/> 59 | </Target> 60 | <SearchPaths> 61 | <IncludeFiles Value="$(ProjOutDir)"/> 62 | <OtherUnitFiles Value="D:\Backup\bec\typecasts\"/> 63 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 64 | </SearchPaths> 65 | <Parsing> 66 | <SyntaxOptions> 67 | <IncludeAssertionCode Value="True"/> 68 | </SyntaxOptions> 69 | </Parsing> 70 | <CodeGeneration> 71 | <Checks> 72 | <IOChecks Value="True"/> 73 | <RangeChecks Value="True"/> 74 | <OverflowChecks Value="True"/> 75 | <StackChecks Value="True"/> 76 | </Checks> 77 | </CodeGeneration> 78 | <Linking> 79 | <Options> 80 | <Win32> 81 | <GraphicApplication Value="True"/> 82 | </Win32> 83 | </Options> 84 | </Linking> 85 | </CompilerOptions> 86 | <Debugging> 87 | <Exceptions Count="3"> 88 | <Item1> 89 | <Name Value="EAbort"/> 90 | </Item1> 91 | <Item2> 92 | <Name Value="ECodetoolError"/> 93 | </Item2> 94 | <Item3> 95 | <Name Value="EFOpenError"/> 96 | </Item3> 97 | </Exceptions> 98 | </Debugging> 99 | </CONFIG> 100 | -------------------------------------------------------------------------------- /Classes - Typecast demo Lazarus/Indenter.lpr: -------------------------------------------------------------------------------- 1 | program Indenter; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | {$IFDEF UNIX}{$IFDEF UseCThreads} 7 | cthreads, 8 | {$ENDIF}{$ENDIF} 9 | Interfaces, // this includes the LCL widgetset 10 | Forms, MainForm, uMachines 11 | { you can add units after this }; 12 | 13 | {$R *.res} 14 | 15 | begin 16 | RequireDerivedFormResource:=True; 17 | Application.Scaled:=True; 18 | Application.Initialize; 19 | Application.CreateForm(TForm1, Form1); 20 | Application.Run; 21 | end. 22 | 23 | -------------------------------------------------------------------------------- /Classes - Typecast demo Lazarus/Indenter.lps: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectSession> 4 | <PathDelim Value="\"/> 5 | <Version Value="11"/> 6 | <BuildModes Active="Default"/> 7 | <Units Count="4"> 8 | <Unit0> 9 | <Filename Value="Indenter.lpr"/> 10 | <IsPartOfProject Value="True"/> 11 | <EditorIndex Value="-1"/> 12 | <WindowIndex Value="-1"/> 13 | <TopLine Value="-1"/> 14 | <CursorPos X="-1" Y="-1"/> 15 | <UsageCount Value="22"/> 16 | </Unit0> 17 | <Unit1> 18 | <Filename Value="..\typecasts\mainform.pas"/> 19 | <IsPartOfProject Value="True"/> 20 | <ComponentName Value="Form1"/> 21 | <HasResources Value="True"/> 22 | <ResourceBaseClass Value="Form"/> 23 | <UnitName Value="MainForm"/> 24 | <UsageCount Value="20"/> 25 | </Unit1> 26 | <Unit2> 27 | <Filename Value="umachines.pas"/> 28 | <IsPartOfProject Value="True"/> 29 | <UnitName Value="uMachines"/> 30 | <EditorIndex Value="1"/> 31 | <TopLine Value="33"/> 32 | <CursorPos X="14" Y="68"/> 33 | <UsageCount Value="20"/> 34 | <Loaded Value="True"/> 35 | </Unit2> 36 | <Unit3> 37 | <Filename Value="mainform.pas"/> 38 | <ComponentName Value="Form1"/> 39 | <HasResources Value="True"/> 40 | <ResourceBaseClass Value="Form"/> 41 | <UnitName Value="MainForm"/> 42 | <IsVisibleTab Value="True"/> 43 | <TopLine Value="123"/> 44 | <CursorPos X="16" Y="138"/> 45 | <UsageCount Value="22"/> 46 | <Loaded Value="True"/> 47 | <LoadedDesigner Value="True"/> 48 | </Unit3> 49 | </Units> 50 | <JumpHistory Count="6" HistoryIndex="5"> 51 | <Position1> 52 | <Filename Value="mainform.pas"/> 53 | <Caret Line="266" Column="6" TopLine="134"/> 54 | </Position1> 55 | <Position2> 56 | <Filename Value="mainform.pas"/> 57 | <Caret Line="56" TopLine="21"/> 58 | </Position2> 59 | <Position3> 60 | <Filename Value="mainform.pas"/> 61 | <Caret Line="123" Column="18" TopLine="109"/> 62 | </Position3> 63 | <Position4> 64 | <Filename Value="mainform.pas"/> 65 | <Caret Line="124" Column="18" TopLine="110"/> 66 | </Position4> 67 | <Position5> 68 | <Filename Value="mainform.pas"/> 69 | <Caret Line="159" TopLine="127"/> 70 | </Position5> 71 | <Position6> 72 | <Filename Value="mainform.pas"/> 73 | <Caret Line="10"/> 74 | </Position6> 75 | </JumpHistory> 76 | <RunParams> 77 | <FormatVersion Value="2"/> 78 | <Modes Count="0" ActiveMode=""/> 79 | </RunParams> 80 | </ProjectSession> 81 | <Debugging> 82 | <Watches Count="2"> 83 | <Item1> 84 | <Expression Value="iPos"/> 85 | </Item1> 86 | <Item2> 87 | <Expression Value="s"/> 88 | </Item2> 89 | </Watches> 90 | </Debugging> 91 | </CONFIG> 92 | -------------------------------------------------------------------------------- /Classes - Typecast demo Lazarus/mainform.lfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 675 3 | Height = 430 4 | Top = 349 5 | Width = 599 6 | Caption = 'Typecasts' 7 | ClientHeight = 430 8 | ClientWidth = 599 9 | OnCreate = FormCreate 10 | OnDestroy = FormDestroy 11 | LCLVersion = '2.0.2.0' 12 | object Memo: TMemo 13 | Left = 0 14 | Height = 430 15 | Top = 0 16 | Width = 451 17 | Align = alLeft 18 | Anchors = [akTop, akLeft, akRight, akBottom] 19 | ParentShowHint = False 20 | ScrollBars = ssAutoBoth 21 | ShowHint = True 22 | TabOrder = 0 23 | WordWrap = False 24 | end 25 | object btnTypeCast: TButton 26 | Left = 469 27 | Height = 38 28 | Top = 19 29 | Width = 107 30 | Anchors = [akTop, akRight] 31 | Caption = 'Do typecast' 32 | OnClick = btnTypeCastClick 33 | TabOrder = 1 34 | end 35 | object btnPolymorphims: TButton 36 | Left = 469 37 | Height = 38 38 | Top = 65 39 | Width = 107 40 | Anchors = [akTop, akRight] 41 | Caption = 'Polymorphims' 42 | OnClick = btnPolymorphimsClick 43 | TabOrder = 2 44 | end 45 | end 46 | -------------------------------------------------------------------------------- /Classes - Typecast demo Lazarus/mainform.pas: -------------------------------------------------------------------------------- 1 | unit MainForm; 2 | {$mode objfpc}{$H+} 3 | 4 | interface 5 | 6 | uses 7 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, uMachines; 8 | 9 | type 10 | TForm1 = class(TForm) 11 | btnPolymorphims: TButton; 12 | Memo: TMemo; 13 | btnTypeCast: TButton; 14 | procedure btnPolymorphimsClick(Sender: TObject); 15 | procedure FormCreate(Sender: TObject); 16 | procedure FormDestroy(Sender: TObject); 17 | procedure btnTypeCastClick(Sender: TObject); 18 | private 19 | public 20 | end; 21 | 22 | var 23 | Form1: TForm1; 24 | Car: TCar; 25 | Airplane: TAirplane; 26 | Machinery: TMachinery; 27 | 28 | implementation {$R *.lfm} 29 | 30 | 31 | 32 | 33 | 34 | 35 | procedure TForm1.FormCreate(Sender: TObject); 36 | begin 37 | Machinery:= TMachinery.Create; 38 | Car:= TCar.Create; 39 | Airplane:= TAirplane.Create; 40 | 41 | //typecastClick(Sender); //del 42 | end; 43 | 44 | 45 | procedure TForm1.FormDestroy(Sender: TObject); 46 | begin 47 | FreeAndNil(Airplane); 48 | FreeAndNil(Car); 49 | FreeAndNil(Machinery); 50 | end; 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | procedure TForm1.btnTypeCastClick(Sender: TObject); 61 | begin 62 | Memo.Lines.Add(''); 63 | Memo.Lines.Add('[Valid typecasts]'); 64 | 65 | // Pointless btnTypeCast. This will show 'some kind of machine' 66 | Memo.Lines.Add((Machinery as TMachinery).Name); 67 | 68 | // This will show 'a car' 69 | Memo.Lines.Add((Car as TMachinery).Name); 70 | 71 | // This will show 'an airplane' 72 | Memo.Lines.Add((Airplane as TMachinery).Name); 73 | 74 | // Impossible btnTypeCast. This line won't compile 75 | //Memo.Lines.Add((TMachinery as Airplane).Name); 76 | 77 | Memo.Lines.Add(''); 78 | Memo.Lines.Add('[Testing object type]'); 79 | 80 | if Car is TMachinery 81 | then Memo.Lines.Add(' The car is a machine') 82 | else Memo.Lines.Add(' Nope. The car is not a machine. Maybe it is a bird?'); 83 | 84 | // Impossible btnTypeCast. This line won't compile 85 | // The compiler already knows that this cannot be so it won't even try to compile this code. Compiler error message: Class or Object types "TCar" and "TAirplane" are not related 86 | {if Car is TAirplane 87 | then Memo.Lines.Add('The car is an airplane') 88 | else Memo.Lines.Add('Nope. The car is not an airplane');} 89 | 90 | 91 | 92 | Memo.Lines.Add(''); 93 | Memo.Lines.Add('[Valid but unsafe typecasts. Use ''as'' instead.]'); 94 | 95 | // This will show 'a car' 96 | Memo.Lines.Add(TMachinery(Car).Name); 97 | 98 | // This will show 'some kind of machine' 99 | Memo.Lines.Add(TCar(Machinery).Name); 100 | 101 | // This will show 'an airplane' 102 | Memo.Lines.Add(TMachinery(Airplane).Name); 103 | 104 | // This will show 'some kind of machine' 105 | Memo.Lines.Add(TAirplane(Machinery).Name); 106 | 107 | // Invalid btnTypeCast 108 | // With this btnTypeCast you can force compiler's had to compile it even if it is unsafe. 109 | // But the compiler will warn you anyway: Warning: Class types "TCar" and "TAirplane" are not related 110 | ////// Memo.Lines.Add('Invalid typecast: '+ TAirplane(Car).Name); // This will show 'a car' 111 | 112 | // Impossible btnTypeCast. This line won't compile 113 | // The compiler will refuse to compile this buggy code 114 | // and will show an error: Class or Object types "TAirplane" and "TCar" are not related 115 | //Memo.Lines.Add((anAirplane as TCar).Name); 116 | end; 117 | 118 | 119 | 120 | procedure TForm1.btnPolymorphimsClick(Sender: TObject); 121 | begin 122 | Memo.Lines.Add(''); 123 | Memo.Lines.Add('[Polymorphism: Hardcast]'); 124 | 125 | // This will show 'I'm a bird' 126 | Memo.Lines.Add(TAirplane(Machinery).WhatAreYou); 127 | 128 | // This will show 'I'm a car' 129 | Memo.Lines.Add(TCar(Machinery).WhatAreYou); 130 | 131 | // This will show 'I'm a machine' however it is a lie because the typecast is invalid! 132 | Memo.Lines.Add(TMachinery(Airplane).WhatAreYou); 133 | 134 | // This will show 'I'm a machine' however it is a lie! 135 | Memo.Lines.Add(TMachinery(Car).WhatAreYou); 136 | 137 | 138 | 139 | Memo.Lines.Add(''); 140 | Memo.Lines.Add('[Polymorphism (Safecast)]'); 141 | 142 | // This will show 'I'm a machine' 143 | Memo.Lines.Add((Airplane as TMachinery).WhatAreYou); 144 | 145 | // This will show 'I'm a machine' 146 | Memo.Lines.Add((Car as TMachinery).WhatAreYou); 147 | 148 | // This will raise an EInvalidCast error at run time 149 | //Memo.Lines.Add((Machinery as TAirplane).WhatAreYou); 150 | 151 | // This will raise an EInvalidCast error at run time 152 | //Memo.Lines.Add((Machinery as TCar).WhatAreYou); 153 | end; 154 | 155 | 156 | 157 | end. 158 | 159 | -------------------------------------------------------------------------------- /Classes - Typecast demo Lazarus/umachines.pas: -------------------------------------------------------------------------------- 1 | unit uMachines; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils; 9 | 10 | 11 | 12 | type 13 | TMachinery = class(TObject) 14 | public 15 | Name: string; 16 | constructor Create; overload; 17 | function WhatAreYou: string; 18 | end; 19 | 20 | TCar = class(TMachinery) 21 | public 22 | constructor Create; overload; 23 | function WhatAreYou: string; 24 | end; 25 | 26 | TAirplane = class(TMachinery) 27 | public 28 | constructor Create; overload; 29 | function WhatAreYou: string; 30 | end; 31 | 32 | 33 | implementation 34 | 35 | 36 | constructor TMachinery.Create; 37 | begin 38 | inherited Create; 39 | Name:= ' some kind of machine'; 40 | end; 41 | 42 | function TMachinery.WhatAreYou: string; 43 | begin 44 | Result:= ' I''m a machine'; 45 | end; 46 | 47 | 48 | constructor TCar.Create; 49 | begin 50 | inherited Create; // This will construct the TMachinery and set the Name to 'some kind of machine'... 51 | Name:= ' a car'; // ...however, here we override the name with our own string (a car) 52 | end; 53 | 54 | function TCar.WhatAreYou: string; 55 | begin 56 | Result:= ' I''m a car'; 57 | end; 58 | 59 | 60 | constructor TAirplane.Create; 61 | begin 62 | inherited Create; // This will set the name to 'some kind of machine' then to 'a car'... 63 | Name:= ' an airplane'; // ... and now we again overwrite those name with our onw (an airplane) 64 | end; 65 | 66 | function TAirplane.WhatAreYou: string; 67 | begin 68 | Result:= ' I''m a bird'; 69 | end; 70 | 71 | 72 | end. 73 | 74 | -------------------------------------------------------------------------------- /Clean.cmd: -------------------------------------------------------------------------------- 1 | echo off 2 | prompt $ 3 | cls 4 | 5 | 6 | del /s *.map 7 | del /s *.dsm 8 | del /s *.ddp 9 | del /s *.bak 10 | del /s *.dsk 11 | del /s *.drc 12 | del /s *.local 13 | del /s *.identcache 14 | del /s *.stat 15 | del /s *.elf 16 | del /s *.cbk 17 | del /s *.dcu 18 | del /s *.exe 19 | del /s *.~* 20 | del /s *.rsm 21 | del /s *.tvsconfig 22 | delay 1000 s 23 | 24 | delay 1000 s -------------------------------------------------------------------------------- /Close Form/MainForm.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'frmMain' 5 | ClientHeight = 438 6 | ClientWidth = 307 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -12 11 | Font.Name = 'Segoe UI' 12 | Font.Style = [] 13 | TextHeight = 15 14 | object Memo: TMemo 15 | AlignWithMargins = True 16 | Left = 3 17 | Top = 3 18 | Width = 173 19 | Height = 432 20 | Align = alClient 21 | TabOrder = 0 22 | end 23 | object Panel1: TPanel 24 | Left = 179 25 | Top = 0 26 | Width = 128 27 | Height = 438 28 | Align = alRight 29 | TabOrder = 1 30 | object btnNormalFree: TButton 31 | AlignWithMargins = True 32 | Left = 4 33 | Top = 143 34 | Width = 120 35 | Height = 37 36 | Align = alTop 37 | Caption = 'NormalFree' 38 | TabOrder = 0 39 | OnClick = btnNormalFreeClick 40 | end 41 | object btnNormalClose: TButton 42 | AlignWithMargins = True 43 | Left = 4 44 | Top = 186 45 | Width = 120 46 | Height = 37 47 | Align = alTop 48 | Caption = 'NormalClose' 49 | TabOrder = 1 50 | OnClick = btnNormalCloseClick 51 | end 52 | object btnNormalRelease: TButton 53 | AlignWithMargins = True 54 | Left = 4 55 | Top = 229 56 | Width = 120 57 | Height = 37 58 | Align = alTop 59 | Caption = 'NormalRelease' 60 | TabOrder = 2 61 | OnClick = btnNormalReleaseClick 62 | end 63 | object btnModalRelease: TButton 64 | AlignWithMargins = True 65 | Left = 4 66 | Top = 90 67 | Width = 120 68 | Height = 37 69 | Align = alTop 70 | Caption = 'ModalRelease' 71 | TabOrder = 3 72 | OnClick = btnModalReleaseClick 73 | end 74 | object btnModalClose: TButton 75 | AlignWithMargins = True 76 | Left = 4 77 | Top = 47 78 | Width = 120 79 | Height = 37 80 | Align = alTop 81 | Caption = 'ModalClose' 82 | TabOrder = 4 83 | OnClick = btnModalCloseClick 84 | end 85 | object btnModalFree: TButton 86 | AlignWithMargins = True 87 | Left = 4 88 | Top = 4 89 | Width = 120 90 | Height = 37 91 | Align = alTop 92 | Caption = 'Modal Free' 93 | TabOrder = 5 94 | OnClick = btnModalFreeClick 95 | end 96 | object Panel2: TPanel 97 | Left = 1 98 | Top = 130 99 | Width = 126 100 | Height = 10 101 | Align = alTop 102 | TabOrder = 6 103 | end 104 | object tgl: TToggleSwitch 105 | AlignWithMargins = True 106 | Left = 4 107 | Top = 414 108 | Width = 120 109 | Height = 20 110 | Hint = 'Action' 111 | Align = alBottom 112 | StateCaptions.CaptionOn = 'caFree' 113 | StateCaptions.CaptionOff = 'caHide' 114 | TabOrder = 7 115 | OnClick = tglClick 116 | end 117 | end 118 | end 119 | -------------------------------------------------------------------------------- /Close Form/MainForm.pas: -------------------------------------------------------------------------------- 1 | unit MainForm; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.WinXCtrls; 8 | 9 | type 10 | TfrmMain = class(TForm) 11 | Memo: TMemo; 12 | Panel1: TPanel; 13 | btnNormalFree: TButton; 14 | btnNormalClose: TButton; 15 | btnNormalRelease: TButton; 16 | btnModalRelease: TButton; 17 | btnModalClose: TButton; 18 | btnModalFree: TButton; 19 | Panel2: TPanel; 20 | tgl: TToggleSwitch; 21 | procedure btnModalFreeClick(Sender: TObject); 22 | procedure btnModalCloseClick(Sender: TObject); 23 | procedure btnModalReleaseClick(Sender: TObject); 24 | procedure btnNormalFreeClick(Sender: TObject); 25 | procedure btnNormalCloseClick(Sender: TObject); 26 | procedure btnNormalReleaseClick(Sender: TObject); 27 | procedure tglClick(Sender: TObject); 28 | private 29 | public 30 | end; 31 | 32 | var 33 | frmMain: TfrmMain; 34 | 35 | implementation {$R *.dfm} 36 | uses FormSecond; 37 | 38 | 39 | procedure TfrmMain.btnModalFreeClick(Sender: TObject); 40 | var 41 | frmSecond: TfrmSecond; 42 | begin 43 | frmMain.Memo.Lines.Add(''); 44 | frmMain.Memo.Lines.Add(' ** Modal form ** '); 45 | frmSecond:= TfrmSecond.Create(Nil); 46 | frmSecond.ShowModal; 47 | frmMain.Memo.Lines.Add('.Free'); 48 | frmSecond.Free; 49 | frmMain.Memo.Lines.Add('.'); 50 | end; 51 | 52 | 53 | procedure TfrmMain.btnModalCloseClick(Sender: TObject); 54 | var 55 | frmSecond: TfrmSecond; 56 | begin 57 | frmMain.Memo.Lines.Add(''); 58 | frmMain.Memo.Lines.Add(' ** Modal form ** '); 59 | frmSecond:= TfrmSecond.Create(Nil); 60 | frmSecond.ShowModal; 61 | frmMain.Memo.Lines.Add('.Close'); 62 | frmSecond.Close; 63 | frmMain.Memo.Lines.Add('.'); 64 | end; 65 | 66 | 67 | procedure TfrmMain.btnModalReleaseClick(Sender: TObject); 68 | var 69 | frmSecond: TfrmSecond; 70 | begin 71 | frmMain.Memo.Lines.Add(''); 72 | frmMain.Memo.Lines.Add(' ** Modal form ** '); 73 | frmSecond:= TfrmSecond.Create(Nil); 74 | frmSecond.ShowModal; 75 | frmMain.Memo.Lines.Add('.Release'); 76 | frmSecond.Close; 77 | frmMain.Memo.Lines.Add('.'); 78 | end; 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | procedure TfrmMain.btnNormalFreeClick(Sender: TObject); 90 | var 91 | frmSecond: TfrmSecond; 92 | begin 93 | frmMain.Memo.Lines.Add(''); 94 | frmMain.Memo.Lines.Add(' ** Normal form ** '); 95 | frmSecond:= TfrmSecond.Create(Nil); 96 | frmSecond.Show; 97 | frmMain.Memo.Lines.Add('.Free'); 98 | frmSecond.Free; 99 | frmMain.Memo.Lines.Add('.'); 100 | end; 101 | 102 | 103 | procedure TfrmMain.btnNormalCloseClick(Sender: TObject); 104 | var 105 | frmSecond: TfrmSecond; 106 | begin 107 | frmMain.Memo.Lines.Add(''); 108 | frmMain.Memo.Lines.Add(' ** Normal form ** '); 109 | frmSecond:= TfrmSecond.Create(Nil); 110 | frmSecond.Show; 111 | frmMain.Memo.Lines.Add('.Close'); 112 | frmSecond.Close; 113 | frmMain.Memo.Lines.Add('.'); 114 | end; 115 | 116 | 117 | procedure TfrmMain.btnNormalReleaseClick(Sender: TObject); 118 | var 119 | frmSecond: TfrmSecond; 120 | begin 121 | frmMain.Memo.Lines.Add(''); 122 | frmMain.Memo.Lines.Add(' ** Normal form ** '); 123 | frmSecond:= TfrmSecond.Create(Nil); 124 | frmSecond.Show; 125 | frmMain.Memo.Lines.Add('.Release'); 126 | frmSecond.Release; 127 | frmMain.Memo.Lines.Add('.'); 128 | end; 129 | 130 | 131 | procedure TfrmMain.tglClick(Sender: TObject); 132 | begin 133 | if tgl.State = tssOff 134 | then Caption:= 'caHide' 135 | else Caption:= 'caFree'; 136 | end; 137 | 138 | end. 139 | -------------------------------------------------------------------------------- /Close Form/TestCloseForm.dpr: -------------------------------------------------------------------------------- 1 | program TestCloseForm; 2 | 3 | uses 4 | Vcl.Forms, 5 | MainForm in 'MainForm.pas' {frmMain}, 6 | formSecond in 'formSecond.pas' {frmSecond}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.MainFormOnTaskbar := True; 13 | Application.CreateForm(TfrmMain, frmMain); 14 | Application.Run; 15 | end. 16 | -------------------------------------------------------------------------------- /Close Form/TestCloseForm.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Close Form/TestCloseForm.res -------------------------------------------------------------------------------- /Close Form/formSecond.dfm: -------------------------------------------------------------------------------- 1 | object frmSecond: TfrmSecond 2 | Left = 0 3 | Top = 0 4 | Caption = 'frmSecond' 5 | ClientHeight = 160 6 | ClientWidth = 313 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -12 11 | Font.Name = 'Segoe UI' 12 | Font.Style = [] 13 | OnClose = FormClose 14 | OnCloseQuery = FormCloseQuery 15 | OnDestroy = FormDestroy 16 | TextHeight = 15 17 | end 18 | -------------------------------------------------------------------------------- /Close Form/formSecond.pas: -------------------------------------------------------------------------------- 1 | unit formSecond; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.WinXCtrls; 8 | 9 | type 10 | TfrmSecond = class(TForm) 11 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 12 | procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); 13 | procedure FormDestroy(Sender: TObject); 14 | private 15 | public 16 | end; 17 | 18 | var 19 | frmSecond: TfrmSecond; 20 | 21 | implementation {$R *.dfm} 22 | 23 | uses MainForm; 24 | 25 | 26 | procedure TfrmSecond.FormClose(Sender: TObject; var Action: TCloseAction); 27 | begin 28 | if frmMain.tgl.State = tssOff 29 | then Action:= caHide 30 | else Action:= caFree; 31 | 32 | if Action = caFree 33 | then frmMain.Memo.Lines.Add('FormClose (caFree)') 34 | else frmMain.Memo.Lines.Add('FormClose (caHide)'); 35 | end; 36 | 37 | procedure TfrmSecond.FormCloseQuery(Sender: TObject; var CanClose: Boolean); 38 | begin 39 | frmMain.Memo.Lines.Add('FormCloseQuery'); 40 | end; 41 | 42 | procedure TfrmSecond.FormDestroy(Sender: TObject); 43 | begin 44 | frmMain.Memo.Lines.Add('FormDestroy'); 45 | end; 46 | 47 | end. 48 | -------------------------------------------------------------------------------- /Custom components 2/DrawingControl.dpk: -------------------------------------------------------------------------------- 1 | package DrawingControl; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 1} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS ON} 17 | {$RANGECHECKS ON} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$LIBSUFFIX AUTO} 29 | {$IMPLICITBUILD ON} 30 | 31 | requires 32 | rtl, 33 | vcl; 34 | 35 | contains 36 | uDrawingControl in 'uDrawingControl.pas'; 37 | 38 | end. 39 | -------------------------------------------------------------------------------- /Custom components 2/DrawingControl.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Custom components 2/DrawingControl.res -------------------------------------------------------------------------------- /Custom components 2/ProjectGroup.groupproj: -------------------------------------------------------------------------------- 1 | <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> 2 | <PropertyGroup> 3 | <ProjectGuid>{551983E8-843C-4FED-BFB5-FC7F241A5EFB}</ProjectGuid> 4 | </PropertyGroup> 5 | <ItemGroup> 6 | <Projects Include="Tester\Tester.dproj"> 7 | <Dependencies/> 8 | </Projects> 9 | <Projects Include="DrawingControl.dproj"> 10 | <Dependencies/> 11 | </Projects> 12 | </ItemGroup> 13 | <ProjectExtensions> 14 | <Borland.Personality>Default.Personality.12</Borland.Personality> 15 | <Borland.ProjectType/> 16 | <BorlandProject> 17 | <Default.Personality/> 18 | </BorlandProject> 19 | </ProjectExtensions> 20 | <Target Name="Tester"> 21 | <MSBuild Projects="Tester\Tester.dproj"/> 22 | </Target> 23 | <Target Name="Tester:Clean"> 24 | <MSBuild Projects="Tester\Tester.dproj" Targets="Clean"/> 25 | </Target> 26 | <Target Name="Tester:Make"> 27 | <MSBuild Projects="Tester\Tester.dproj" Targets="Make"/> 28 | </Target> 29 | <Target Name="DrawingControl"> 30 | <MSBuild Projects="DrawingControl.dproj"/> 31 | </Target> 32 | <Target Name="DrawingControl:Clean"> 33 | <MSBuild Projects="DrawingControl.dproj" Targets="Clean"/> 34 | </Target> 35 | <Target Name="DrawingControl:Make"> 36 | <MSBuild Projects="DrawingControl.dproj" Targets="Make"/> 37 | </Target> 38 | <Target Name="Build"> 39 | <CallTarget Targets="Tester;DrawingControl"/> 40 | </Target> 41 | <Target Name="Clean"> 42 | <CallTarget Targets="Tester:Clean;DrawingControl:Clean"/> 43 | </Target> 44 | <Target Name="Make"> 45 | <CallTarget Targets="Tester:Make;DrawingControl:Make"/> 46 | </Target> 47 | <Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/> 48 | </Project> 49 | -------------------------------------------------------------------------------- /Custom components 2/Tester/Tester.dpr: -------------------------------------------------------------------------------- 1 | program Tester; 2 | 3 | uses 4 | Vcl.Forms, 5 | Unit7 in 'Unit7.pas' {frmTester}, 6 | uDrawingControl in '..\uDrawingControl.pas'; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.MainFormOnTaskbar := True; 13 | Application.CreateForm(TfrmTester, frmTester); 14 | Application.Run; 15 | end. 16 | -------------------------------------------------------------------------------- /Custom components 2/Tester/Tester.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Custom components 2/Tester/Tester.res -------------------------------------------------------------------------------- /Custom components 2/Tester/Tester.tproj: -------------------------------------------------------------------------------- 1 | [Project] 2 | XTDFile=<ohne> 3 | -------------------------------------------------------------------------------- /Custom components 2/Tester/Unit7.dfm: -------------------------------------------------------------------------------- 1 | object frmTester: TfrmTester 2 | Left = 0 3 | Top = 0 4 | Caption = 'Tester' 5 | ClientHeight = 310 6 | ClientWidth = 387 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -12 11 | Font.Name = 'Segoe UI' 12 | Font.Style = [] 13 | TextHeight = 15 14 | object DrawingControl: TDrawingControl 15 | Left = 5 16 | Top = 5 17 | Width = 376 18 | Height = 266 19 | end 20 | object radCirc: TRadioButton 21 | Left = 0 22 | Top = 276 23 | Width = 387 24 | Height = 17 25 | Align = alBottom 26 | Caption = 'Circle' 27 | Checked = True 28 | TabOrder = 1 29 | TabStop = True 30 | OnClick = radCircClick 31 | ExplicitTop = 275 32 | ExplicitWidth = 383 33 | end 34 | object radRect: TRadioButton 35 | Left = 0 36 | Top = 293 37 | Width = 387 38 | Height = 17 39 | Align = alBottom 40 | Caption = 'Rectangle' 41 | TabOrder = 2 42 | OnClick = radRectClick 43 | ExplicitTop = 292 44 | ExplicitWidth = 383 45 | end 46 | end 47 | -------------------------------------------------------------------------------- /Custom components 2/Tester/Unit7.pas: -------------------------------------------------------------------------------- 1 | unit Unit7; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, uDrawingControl, Vcl.StdCtrls; 8 | 9 | type 10 | TfrmTester = class(TForm) 11 | DrawingControl: TDrawingControl; 12 | radCirc: TRadioButton; 13 | radRect: TRadioButton; 14 | procedure radCircClick(Sender: TObject); 15 | procedure radRectClick(Sender: TObject); 16 | private 17 | public 18 | end; 19 | 20 | var 21 | frmTester: TfrmTester; 22 | 23 | implementation 24 | {$R *.dfm} 25 | 26 | procedure TfrmTester.radCircClick(Sender: TObject); 27 | begin 28 | DrawingControl.ShapeType:= stCircle; 29 | end; 30 | 31 | procedure TfrmTester.radRectClick(Sender: TObject); 32 | begin 33 | DrawingControl.ShapeType:= stRectangle; 34 | end; 35 | 36 | end. 37 | -------------------------------------------------------------------------------- /Custom components 2/uDrawingControl.pas: -------------------------------------------------------------------------------- 1 | unit uDrawingControl; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Classes, Vcl.Controls, Vcl.Graphics, Winapi.Messages, Math, System.Types, 7 | Winapi.Windows, Vcl.Dialogs; 8 | 9 | type 10 | TShapeType = (stCircle, stRectangle); 11 | 12 | // Enhanced TDrawingControl with mouse interaction for drawing shapes 13 | TDrawingControl = class(TCustomControl) 14 | private 15 | FColor: TColor; 16 | FShapeType: TShapeType; 17 | FStartPoint: TPoint; 18 | FEndPoint: TPoint; 19 | FMouseDown: Boolean; 20 | procedure DrawShape; 21 | protected 22 | procedure Paint; override; 23 | procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 24 | procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; 25 | procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; 26 | public 27 | constructor Create(AOwner: TComponent); override; 28 | published 29 | // Published properties accessible in the Object Inspector 30 | property Color: TColor read FColor write FColor default clRed; 31 | property ShapeType: TShapeType read FShapeType write FShapeType default stCircle; 32 | end; 33 | 34 | procedure Register; 35 | 36 | implementation 37 | 38 | 39 | constructor TDrawingControl.Create(AOwner: TComponent); 40 | begin 41 | inherited; 42 | FColor := clRed; 43 | FShapeType := stCircle; 44 | end; 45 | 46 | 47 | // This is called when the control has to repaint itself. For example when the form containing the control is resized. 48 | procedure TDrawingControl.Paint; 49 | begin 50 | inherited; 51 | DrawShape; 52 | end; 53 | 54 | 55 | procedure TDrawingControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 56 | begin 57 | inherited; 58 | FMouseDown := False; 59 | DrawShape; // Draw the final shape when mouse button is released 60 | end; 61 | 62 | 63 | procedure TDrawingControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 64 | begin 65 | inherited; 66 | FStartPoint := Point(X, Y); 67 | FMouseDown := True; 68 | end; 69 | 70 | 71 | procedure TDrawingControl.MouseMove(Shift: TShiftState; X, Y: Integer); 72 | begin 73 | inherited; 74 | if FMouseDown then 75 | begin 76 | FEndPoint := Point(X, Y); 77 | Invalidate; // Trigger repaint to show shape preview while dragging. In the end, it calls DrawShape 78 | end; 79 | end; 80 | 81 | 82 | procedure TDrawingControl.DrawShape; 83 | var R: TRect; 84 | begin 85 | Canvas.Pen.Color := FColor; 86 | Canvas.Brush.Style:= bsClear; // Change to bsSolid to fill the shape with color 87 | 88 | // Determine shape based on ShapeType property 89 | case FShapeType of 90 | stCircle: 91 | begin 92 | R.Left := Min(FStartPoint.X, FEndPoint.X); 93 | R.Top := Min(FStartPoint.Y, FEndPoint.Y); 94 | R.Right := Max(FStartPoint.X, FEndPoint.X); 95 | R.Bottom := Max(FStartPoint.Y, FEndPoint.Y); 96 | Canvas.Ellipse(R); 97 | end; 98 | stRectangle: 99 | begin 100 | R := Rect(FStartPoint.X, FStartPoint.Y, FEndPoint.X, FEndPoint.Y); 101 | Canvas.Rectangle(R); 102 | end; 103 | end; 104 | end; 105 | 106 | 107 | procedure Register; 108 | begin 109 | RegisterComponents('Glorious Controls', [TDrawingControl]); 110 | end; 111 | 112 | end. 113 | -------------------------------------------------------------------------------- /DataTypes - SizeOf/DateTypeSize.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/DataTypes - SizeOf/DateTypeSize.res -------------------------------------------------------------------------------- /DataTypes - SizeOf/Project_DateTypeSize.dpr: -------------------------------------------------------------------------------- 1 | program Project_DateTypeSize; 2 | 3 | uses 4 | Vcl.Forms, 5 | Unit1 in 'Unit1.pas' {Form20}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TForm20, Form20); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /DataTypes - SizeOf/Unit1.dfm: -------------------------------------------------------------------------------- 1 | object Form20: TForm20 2 | Left = 549 3 | Top = 225 4 | Caption = 'Data types Test' 5 | ClientHeight = 561 6 | ClientWidth = 478 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = True 14 | Position = poDesigned 15 | OnCreate = FormCreate 16 | OnDestroy = FormDestroy 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object Memo: TMemo 20 | Left = 0 21 | Top = 0 22 | Width = 360 23 | Height = 561 24 | Align = alClient 25 | Font.Charset = ANSI_CHARSET 26 | Font.Color = clWindowText 27 | Font.Height = -13 28 | Font.Name = 'Consolas' 29 | Font.Style = [] 30 | ParentFont = False 31 | TabOrder = 0 32 | end 33 | object Panel1: TPanel 34 | Left = 360 35 | Top = 0 36 | Width = 118 37 | Height = 561 38 | Align = alRight 39 | TabOrder = 1 40 | object btnMemAddress: TButton 41 | AlignWithMargins = True 42 | Left = 4 43 | Top = 88 44 | Width = 110 45 | Height = 36 46 | Align = alTop 47 | Caption = 'Show address' 48 | TabOrder = 0 49 | OnClick = btnMemAddressClick 50 | end 51 | object btnLength: TButton 52 | AlignWithMargins = True 53 | Left = 4 54 | Top = 46 55 | Width = 110 56 | Height = 36 57 | Align = alTop 58 | Caption = 'Length' 59 | TabOrder = 1 60 | OnClick = btnLengthClick 61 | end 62 | object btnSizeOf: TButton 63 | AlignWithMargins = True 64 | Left = 4 65 | Top = 4 66 | Width = 110 67 | Height = 36 68 | Align = alTop 69 | Caption = 'SizeOf' 70 | TabOrder = 2 71 | OnClick = btnSizeOfClick 72 | end 73 | object Button3: TButton 74 | AlignWithMargins = True 75 | Left = 4 76 | Top = 519 77 | Width = 110 78 | Height = 38 79 | Align = alBottom 80 | Caption = 'Clear' 81 | TabOrder = 3 82 | OnClick = Button3Click 83 | end 84 | end 85 | end 86 | -------------------------------------------------------------------------------- /DataTypes - SizeOf/Unit1.pas: -------------------------------------------------------------------------------- 1 | UNIT Unit1; 2 | 3 | INTERFACE 4 | 5 | USES 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.StdCtrls, 7 | Vcl.ExtCtrls; 8 | 9 | TYPE 10 | TForm20 = class(TForm) 11 | Memo: TMemo; 12 | Panel1: TPanel; 13 | btnMemAddress: TButton; 14 | btnLength: TButton; 15 | btnSizeOf: TButton; 16 | Button3: TButton; 17 | procedure btnSizeOfClick(Sender: TObject); 18 | procedure btnLengthClick(Sender: TObject); 19 | procedure FormCreate(Sender: TObject); 20 | procedure btnMemAddressClick(Sender: TObject); 21 | procedure FormDestroy(Sender: TObject); 22 | procedure Button3Click(Sender: TObject); 23 | private 24 | public 25 | end; 26 | 27 | VAR 28 | Form20: TForm20; 29 | 30 | IMPLEMENTATION {$R *.dfm} 31 | 32 | 33 | VAR 34 | i: Integer; 35 | r: Real; 36 | s: string; 37 | Rec: packed record 38 | i: Integer; 39 | s: string; 40 | r: Real; 41 | end; 42 | Obj: TButton; // Object 43 | Set3: TTextLayout; // Set 44 | ArrayDy: array of Byte; // Dynamic array 45 | ArraySt: array[1..100] of Byte; // Static array (100 elements) 46 | 47 | 48 | 49 | procedure TForm20.FormCreate(Sender: TObject); 50 | begin 51 | SetLength(ArrayDy, 100); // Set this dynamic array to 100 elements 52 | SetLength(s, 100); // Make this string 100 chars long 53 | Obj:= TButton.Create(Self); 54 | 55 | btnSizeOfClick(Sender); 56 | btnLengthClick(Sender); 57 | btnMemAddressClick(Sender); 58 | end; 59 | 60 | 61 | procedure TForm20.FormDestroy(Sender: TObject); 62 | begin 63 | FreeAndNil(Obj); 64 | end; 65 | 66 | 67 | procedure TForm20.Button3Click(Sender: TObject); 68 | begin 69 | Memo.Lines.Clear; 70 | end; 71 | 72 | 73 | 74 | 75 | 76 | 77 | procedure TForm20.btnSizeOfClick(Sender: TObject); 78 | begin 79 | Memo.Lines.Add(''); 80 | Memo.Lines.Add('SIZEOF'); 81 | Memo.Lines.Add(''); 82 | Memo.Lines.Add(' True values: '); 83 | Memo.Lines.Add(#9+ 'Integer: ' +#9+ IntToStr(SizeOf(i)) + ' bytes'); 84 | Memo.Lines.Add(#9+ 'Record: ' +#9+ IntToStr(SizeOf(rec)) + ' bytes'); 85 | Memo.Lines.Add(#9+ 'Real: ' +#9+ IntToStr(SizeOf(r)) + ' bytes'); 86 | Memo.Lines.Add(#9+ 'Set: ' +#9+ IntToStr(SizeOf(Set3)) + ' bytes'); 87 | Memo.Lines.Add(#9+ 'ArraySt: ' +#9+ IntToStr(SizeOf(ArraySt)) + ' bytes'); 88 | 89 | Memo.Lines.Add(''); 90 | Memo.Lines.Add(#9+ 'ArrayDy: ' +#9+ IntToStr(SizeOf(ArrayDy)) + ' bytes (pointer)'); 91 | Memo.Lines.Add(#9+ 'Object: ' +#9+ IntToStr(SizeOf(Obj)) + ' bytes (pointer)'); 92 | Memo.Lines.Add(#9+ 'String: ' +#9+ IntToStr(SizeOf(s)) + ' bytes (pointer)'); 93 | end; 94 | 95 | 96 | procedure TForm20.btnLengthClick(Sender: TObject); 97 | begin 98 | Memo.Lines.Add(''); 99 | Memo.Lines.Add('LENGTH:'); 100 | Memo.Lines.Add(#9+ 'ArraySt: ' +#9+ IntToStr(Length(ArraySt)) + ' bytes'); 101 | Memo.Lines.Add(#9+ 'ArrayDy: ' +#9+ IntToStr(Length(ArrayDy)) + ' bytes'); 102 | Memo.Lines.Add(#9+ 'String: ' +#9+ IntToStr(Length(s)) + ' bytes'); 103 | end; 104 | 105 | 106 | procedure TForm20.btnMemAddressClick(Sender: TObject); 107 | begin 108 | Memo.Lines.Add(''); 109 | Memo.Lines.Add('ADDRESS:'); 110 | Memo.Lines.Add(#9+ '@i: ' +#9+ IntToStr(Integer(@i))); 111 | Memo.Lines.Add(#9+ '@r: ' +#9+ IntToStr(Integer(@r))); 112 | Memo.Lines.Add(#9+ '@String: ' +#9+ IntToStr(Integer(@s))); 113 | Memo.Lines.Add(''); 114 | 115 | Memo.Lines.Add(#9+ '@Record: ' +#9+ IntToStr(Integer(@Rec))); 116 | Memo.Lines.Add(#9+ ' @Rec.i: ' +#9+ IntToStr(Integer(@Rec.i))); 117 | Memo.Lines.Add(#9+ ' @Rec.s: ' +#9+ IntToStr(Integer(@Rec.s))); 118 | Memo.Lines.Add(#9+ ' @Rec.r: ' +#9+ IntToStr(Integer(@Rec.r))); 119 | Memo.Lines.Add(''); 120 | 121 | Memo.Lines.Add(#9+ '@Object: ' +#9+ IntToStr(Integer(@Obj))); 122 | Memo.Lines.Add(#9+ '@Set: ' +#9+#9+ IntToStr(Integer(@Set3))); 123 | Memo.Lines.Add(#9+ '@ArrayDy: ' +#9+ IntToStr(Integer(@ArrayDy))); 124 | Memo.Lines.Add(''); 125 | 126 | Memo.Lines.Add(#9+ '@ArrayDy[0]: ' +#9+ IntToStr(Integer(@ArrayDy[0]))); 127 | Memo.Lines.Add(#9+ '@String[1]: ' +#9+ IntToStr(Integer(@s[1]))); 128 | end; 129 | 130 | 131 | 132 | 133 | end. 134 | 135 | 136 | -------------------------------------------------------------------------------- /Debug - Memory leaks/CreateMemLeak.dpr: -------------------------------------------------------------------------------- 1 | program CreateMemLeak; 2 | 3 | uses 4 | {$IFDEF DEBUG} 5 | FastMM4, 6 | {$ENDIF } 7 | Forms, 8 | TesterForm in 'TesterForm.pas' {frmTester}; 9 | 10 | {$R *.res} 11 | 12 | begin 13 | Application.Initialize; 14 | 15 | { MainFormOnTaskbar 16 | See: stackoverflow.com/questions/66720721 17 | 18 | If true: 19 | The taskbar button represents the application's Main Form and displays its caption. 20 | 21 | Bad: All child forms will stay on top of the MainForm! 22 | But they are not modal! The MainForm can still be clicked! 23 | If we don't really want this, we should stick with MainFormOnTaskbar = false. 24 | When we do want a child form to stay on top, then can use fsStayOnTop. 25 | 26 | If False: 27 | The taskbar button represents the application's (hidden) main window and bears the application's Title. 28 | Must be True to use Windows (Vista) Aero effects (live taskbar thumbnails, Dynamic Windows, Windows Flip, Windows Flip 3D). 29 | 30 | Bad: All child forms will disapear under the MainForm! } 31 | 32 | Application.MainFormOnTaskbar := True; 33 | Application.Title := 'CubicTester'; // Set by AppData 34 | Application.CreateForm(TfrmTester, frmTester); 35 | frmTester.Show; 36 | Application.Run; 37 | end. 38 | -------------------------------------------------------------------------------- /Debug - Memory leaks/CreateMemLeak.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Debug - Memory leaks/CreateMemLeak.res -------------------------------------------------------------------------------- /Debug - Memory leaks/FastMM_FullDebugMode.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Debug - Memory leaks/FastMM_FullDebugMode.dll -------------------------------------------------------------------------------- /Debug - Memory leaks/TesterForm.dfm: -------------------------------------------------------------------------------- 1 | object frmTester: TfrmTester 2 | Left = 450 3 | Top = 311 4 | Anchors = [] 5 | Caption = 'Tester' 6 | ClientHeight = 364 7 | ClientWidth = 474 8 | Color = clBtnFace 9 | Constraints.MinHeight = 300 10 | Constraints.MinWidth = 490 11 | DoubleBuffered = True 12 | Font.Charset = ANSI_CHARSET 13 | Font.Color = clWindowText 14 | Font.Height = -13 15 | Font.Name = 'Segoe UI' 16 | Font.Style = [] 17 | OldCreateOrder = False 18 | Position = poDesigned 19 | ScreenSnap = True 20 | ShowHint = True 21 | SnapBuffer = 4 22 | PixelsPerInch = 96 23 | TextHeight = 17 24 | object Label1: TLabel 25 | Left = 0 26 | Top = 166 27 | Width = 474 28 | Height = 17 29 | Align = alTop 30 | Caption = 'Total beeps:' 31 | end 32 | object btnSmall: TButton 33 | AlignWithMargins = True 34 | Left = 3 35 | Top = 3 36 | Width = 468 37 | Height = 48 38 | Align = alTop 39 | Caption = 'START - Small leak' 40 | TabOrder = 0 41 | OnClick = btnSmallClick 42 | end 43 | object btnMultiple: TButton 44 | AlignWithMargins = True 45 | Left = 3 46 | Top = 57 47 | Width = 468 48 | Height = 48 49 | Align = alTop 50 | Caption = 'START - Multiple leaks' 51 | TabOrder = 1 52 | OnClick = btnMultipleClick 53 | end 54 | object btnDang: TButton 55 | AlignWithMargins = True 56 | Left = 3 57 | Top = 111 58 | Width = 468 59 | Height = 48 60 | Align = alTop 61 | Caption = 'Dangling pointer' 62 | TabOrder = 2 63 | OnClick = btnDangClick 64 | end 65 | object btnBeeper: TButton 66 | AlignWithMargins = True 67 | Left = 3 68 | Top = 186 69 | Width = 468 70 | Height = 48 71 | Align = alTop 72 | Caption = 'Beeper create' 73 | TabOrder = 3 74 | OnClick = btnBeeperClick 75 | end 76 | object btnBeepFree: TButton 77 | AlignWithMargins = True 78 | Left = 3 79 | Top = 240 80 | Width = 468 81 | Height = 48 82 | Align = alTop 83 | Caption = 'Beeper destroy' 84 | TabOrder = 4 85 | OnClick = btnBeepFreeClick 86 | end 87 | object Panel1: TPanel 88 | Left = 0 89 | Top = 162 90 | Width = 474 91 | Height = 4 92 | Align = alTop 93 | TabOrder = 5 94 | end 95 | object btnManualBeep: TButton 96 | AlignWithMargins = True 97 | Left = 3 98 | Top = 294 99 | Width = 468 100 | Height = 48 101 | Align = alTop 102 | Caption = 'Manual beep (after free)' 103 | TabOrder = 6 104 | OnClick = btnManualBeepClick 105 | end 106 | end 107 | -------------------------------------------------------------------------------- /Debug - Memory leaks/TesterForm.pas: -------------------------------------------------------------------------------- 1 | UNIT TesterForm; 2 | 3 | INTERFACE 4 | 5 | USES 6 | WinApi.Windows, Winapi.ShellAPI, WinApi.Messages, System.SysUtils, System.Classes, Vcl.StdCtrls, VCL.Forms, Vcl.Controls, Vcl.Samples.Spin, Vcl.ComCtrls, Vcl.ExtCtrls; 7 | 8 | TYPE 9 | TfrmTester = class(TForm) 10 | btnSmall: TButton; 11 | btnMultiple: TButton; 12 | btnDang: TButton; 13 | btnBeeper: TButton; 14 | btnBeepFree: TButton; 15 | Panel1: TPanel; 16 | Label1: TLabel; 17 | btnManualBeep: TButton; 18 | procedure btnSmallClick(Sender: TObject); 19 | procedure btnMultipleClick(Sender: TObject); 20 | procedure btnDangClick(Sender: TObject); 21 | procedure btnBeeperClick(Sender: TObject); 22 | procedure btnBeepFreeClick(Sender: TObject); 23 | procedure btnManualBeepClick(Sender: TObject); 24 | protected 25 | private 26 | function Test: TStringList; 27 | public 28 | end; 29 | 30 | VAR 31 | frmTester: TfrmTester; 32 | 33 | IMPLEMENTATION {$R *.dfm} 34 | 35 | 36 | 37 | 38 | 39 | {-------------------------------------------------------------------------------------------------- 40 | APP START/CLOSE 41 | --------------------------------------------------------------------------------------------------} 42 | 43 | function TfrmTester.Test: TStringList; 44 | begin 45 | Result:= TStringList.Create; 46 | end; 47 | 48 | 49 | procedure TfrmTester.btnSmallClick(Sender: TObject); 50 | VAR TSL: TStringList; 51 | begin 52 | TSL:= Test; 53 | TRY 54 | TSL.Text:= 'Some text'; 55 | FINALLY 56 | //FreeAndNil(TSL); 57 | END; 58 | end; 59 | 60 | 61 | procedure TfrmTester.btnMultipleClick(Sender: TObject); 62 | VAR TSL: TStringList; 63 | begin 64 | for VAR i:= 1 to 10 DO 65 | TSL:= Test; 66 | end; 67 | 68 | 69 | procedure TfrmTester.btnDangClick(Sender: TObject); 70 | VAR Variable1, Variable2: TObject; 71 | begin 72 | Variable1:= TObject.Create; 73 | 74 | Variable2:= Variable1; 75 | 76 | FreeAndNil(Variable1); 77 | 78 | Variable2.GetHashCode; 79 | end; 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | {--------------------------- 90 | Class TBeeper 91 | ---------------------------} 92 | 93 | TYPE 94 | 95 | TBeeper= class(TObject) 96 | Timer: TTimer; 97 | TotalBeeps: Integer; 98 | ALabel: TLabel; 99 | constructor Create; 100 | destructor Destroy; override; 101 | procedure TimerTimer(Sender: TObject); 102 | procedure DoBeep; 103 | end; 104 | 105 | 106 | constructor TBeeper.Create; 107 | begin 108 | Timer:= TTimer.Create(NIL); 109 | Timer.OnTimer:= TimerTimer; 110 | end; 111 | 112 | destructor TBeeper.Destroy; 113 | begin 114 | ALabel.Caption:= 'The Beeper was desptroyed'; 115 | inherited; 116 | end; 117 | 118 | procedure TBeeper.DoBeep; 119 | begin 120 | Beep; 121 | Inc(TotalBeeps); 122 | //ALabel.Caption:= 'Total beeps: '+ IntToStr(TotalBeeps); 123 | end; 124 | 125 | procedure TBeeper.TimerTimer(Sender: TObject); 126 | begin 127 | DoBeep; 128 | end; 129 | 130 | 131 | 132 | {--------------------------- 133 | Start Beeper 134 | ---------------------------} 135 | 136 | VAR Beeper: TBeeper; 137 | 138 | procedure TfrmTester.btnBeeperClick(Sender: TObject); 139 | begin 140 | Beeper:= TBeeper.Create; 141 | Beeper.ALabel:= Label1; 142 | end; 143 | 144 | 145 | procedure TfrmTester.btnBeepFreeClick(Sender: TObject); 146 | begin 147 | Beeper.Free; // The computer will beep even after we free the Beeper. 148 | end; 149 | 150 | 151 | procedure TfrmTester.btnManualBeepClick(Sender: TObject); 152 | begin 153 | Beeper.DoBeep; 154 | end; 155 | 156 | 157 | {procedure TfrmTester.FormClick(Sender: TObject); 158 | begin 159 | VAR p: PIntegerArray; 160 | p:= Pointer(Integer(Beeper.Timer)); 161 | Caption:= IntToStr(Integer(p)); 162 | for VAR i:= 0 to 100 DO 163 | p^[i]:= MaxInt; 164 | end; } 165 | 166 | 167 | end. 168 | -------------------------------------------------------------------------------- /Debugger test/MainForm.dfm: -------------------------------------------------------------------------------- 1 | object Form21: TForm21 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form21' 5 | ClientHeight = 337 6 | ClientWidth = 635 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OnCreate = FormCreate 14 | TextHeight = 13 15 | end 16 | -------------------------------------------------------------------------------- /Debugger test/MainForm.pas: -------------------------------------------------------------------------------- 1 | unit MainForm; 2 | 3 | {------------------------------------------------------------------------------------------------------------- 4 | This program demonstrates how to declare, initializa and copy arrays } 5 | 6 | interface 7 | 8 | uses 9 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 10 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs; 11 | 12 | type 13 | TForm21 = class(TForm) 14 | procedure FormCreate(Sender: TObject); 15 | private 16 | RandomValue: Integer; 17 | procedure Test1; 18 | procedure Test2; 19 | procedure FaultyProcedure(i: Integer); 20 | procedure Test3; 21 | public 22 | end; 23 | 24 | var 25 | Form21: TForm21; 26 | 27 | implementation {$R *.dfm} 28 | 29 | 30 | procedure CallMeAtDebugTime; 31 | begin 32 | System.SysUtils.beep; 33 | end; 34 | 35 | 36 | procedure TForm21.FormCreate(Sender: TObject); 37 | begin 38 | Randomize; 39 | Application.ProcessMessages; 40 | RandomValue:= Random(999)+1; 41 | Test2; 42 | //CallMeAtDebugTime; 43 | end; 44 | 45 | 46 | 47 | procedure TForm21.Test1; 48 | begin 49 | for VAR i:= 100 downto 0 DO 50 | Caption:= IntToStr(10 DIV i); 51 | end; 52 | 53 | 54 | procedure TForm21.FaultyProcedure(i: Integer); 55 | begin 56 | if i = RandomValue 57 | then RAISE Exception.Create('Ups!') 58 | end; 59 | 60 | 61 | procedure TForm21.Test2; 62 | VAR i: integer; 63 | begin 64 | for i:= 1 to 999 DO 65 | begin 66 | FaultyProcedure(i); 67 | Caption:= IntToStr(i); 68 | end; 69 | end; 70 | 71 | 72 | procedure TForm21.Test3; 73 | begin 74 | for VAR i:= 1 to 999 DO 75 | begin 76 | TRY 77 | FaultyProcedure(i); 78 | Caption:= IntToStr(i); 79 | EXCEPT 80 | Caption:= 'Ups!'; // Put break point here! 81 | END; 82 | end; 83 | end; 84 | 85 | 86 | 87 | end. 88 | -------------------------------------------------------------------------------- /Debugger test/Project_Arrays.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Debugger test/Project_Arrays.res -------------------------------------------------------------------------------- /Debugger test/Project_DebuggerTest.dpr: -------------------------------------------------------------------------------- 1 | program Project_DebuggerTest; 2 | 3 | uses 4 | FastMM4, 5 | Vcl.Forms, 6 | MainForm in 'MainForm.pas' {Form21}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.MainFormOnTaskbar := True; 13 | Application.CreateForm(TForm21, Form21); 14 | Application.Run; 15 | end. 16 | -------------------------------------------------------------------------------- /Debugger test/Project_DebuggerTest.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Debugger test/Project_DebuggerTest.res -------------------------------------------------------------------------------- /Debugger test/Project_DebuggerTest.tproj: -------------------------------------------------------------------------------- 1 | [Project] 2 | XTDFile=<ohne> 3 | -------------------------------------------------------------------------------- /Errors - Premature return from function/Premature.dpr: -------------------------------------------------------------------------------- 1 | program Premature; 2 | 3 | uses 4 | {$IFDEF DEBUG} 5 | FastMM4, 6 | {$ENDIF } 7 | Forms, 8 | TesterForm in 'TesterForm.pas' {frmTester}; 9 | 10 | {$R *.res} 11 | 12 | begin 13 | Application.Initialize; 14 | 15 | { If true, a taskbar button represents the application's main form and displays its caption. 16 | All child forms will stay on top of the MainForm (bad)! 17 | Since I don't really want "modal" forms all over in my app, 18 | I should stick with MainFormOnTaskbar = false. 19 | When I do want a child form to stay on top, then I make it modal or use fsStayOnTop. 20 | 21 | If False, a taskbar button represents the application's (hidden) main window and 22 | bears the application's Title. 23 | Must be True to use Windows (Vista) Aero effects (ive taskbar thumbnails, 24 | Dynamic Windows, Windows Flip, Windows Flip 3D). stackoverflow.com/questions/66720721 } 25 | Application.MainFormOnTaskbar := True; 26 | Application.Title := 'CubicTester'; // Set by AppData 27 | Application.CreateForm(TfrmTester, frmTester); 28 | frmTester.Show; 29 | Application.Run; 30 | end. 31 | -------------------------------------------------------------------------------- /Errors - Premature return from function/Premature.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Errors - Premature return from function/Premature.res -------------------------------------------------------------------------------- /Errors - Premature return from function/StarterProject.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Errors - Premature return from function/StarterProject.res -------------------------------------------------------------------------------- /Errors - Premature return from function/TesterForm.dfm: -------------------------------------------------------------------------------- 1 | object frmTester: TfrmTester 2 | Left = 450 3 | Top = 311 4 | Anchors = [] 5 | Caption = 'Tester' 6 | ClientHeight = 261 7 | ClientWidth = 474 8 | Color = clBtnFace 9 | Constraints.MinHeight = 300 10 | Constraints.MinWidth = 490 11 | DoubleBuffered = True 12 | Font.Charset = ANSI_CHARSET 13 | Font.Color = clWindowText 14 | Font.Height = -13 15 | Font.Name = 'Segoe UI' 16 | Font.Style = [] 17 | OldCreateOrder = False 18 | Position = poDesigned 19 | ScreenSnap = True 20 | ShowHint = True 21 | SnapBuffer = 4 22 | OnCreate = FormCreate 23 | PixelsPerInch = 96 24 | TextHeight = 17 25 | object mmo: TMemo 26 | AlignWithMargins = True 27 | Left = 3 28 | Top = 3 29 | Width = 468 30 | Height = 201 31 | Align = alClient 32 | TabOrder = 0 33 | end 34 | object btnStart: TButton 35 | AlignWithMargins = True 36 | Left = 3 37 | Top = 210 38 | Width = 468 39 | Height = 48 40 | Align = alBottom 41 | Caption = 'START' 42 | TabOrder = 1 43 | OnClick = btnStartClick 44 | end 45 | end 46 | -------------------------------------------------------------------------------- /Errors - Premature return from function/TesterForm.pas: -------------------------------------------------------------------------------- 1 | UNIT TesterForm; 2 | 3 | INTERFACE 4 | 5 | USES 6 | WinApi.Windows, Winapi.ShellAPI, WinApi.Messages, System.SysUtils, System.Classes, Vcl.StdCtrls, VCL.Forms, Vcl.Controls, Vcl.Samples.Spin, 7 | cvRichEdit, Vcl.ComCtrls, ccCore, csSystem, cbDialogs, ccINIFile, FormLog, cvPathEdit, Vcl.ExtCtrls, llRichLog; 8 | 9 | TYPE 10 | TfrmTester = class(TForm) 11 | mmo: TMemo; 12 | btnStart: TButton; 13 | procedure btnStartClick(Sender: TObject); 14 | procedure FormCreate(Sender: TObject); 15 | protected 16 | private 17 | procedure LateInitialize(VAR Msg: TMessage); message MSG_LateFormInit; // Called after the main form was fully created 18 | public 19 | end; 20 | 21 | VAR 22 | frmTester: TfrmTester; 23 | 24 | IMPLEMENTATION {$R *.dfm} 25 | 26 | USES cbAppData, cbINIFile, cbWinVersion, cvIniFile, ccIO, cmIO, cmIO.Win, cmDebugger; 27 | 28 | 29 | 30 | 31 | {-------------------------------------------------------------------------------------------------- 32 | APP START/CLOSE 33 | --------------------------------------------------------------------------------------------------} 34 | 35 | 36 | procedure TfrmTester.FormCreate(Sender: TObject); 37 | begin 38 | PostMessage(Self.Handle, MSG_LateAppInit_, 0, 0); Not needed anymore. Moved to cbAppData { This will call LateInitialize } 39 | end; 40 | 41 | 42 | procedure TfrmTester.LateInitialize; 43 | begin 44 | end; 45 | 46 | 47 | procedure SomeCodeToWriteToDataBase; 48 | Begin 49 | raise Exception.Create('Some DB error!'); 50 | End; 51 | 52 | 53 | Function WriteCustomer(sCustomerData: string): Boolean; 54 | Begin 55 | Result:= False; 56 | SomeCodeToWriteToDataBase; 57 | Result:= True; 58 | End; 59 | 60 | 61 | procedure TfrmTester.btnStartClick(Sender: TObject); 62 | begin 63 | Caption:= 'Starting...'; 64 | if WriteCustomer('Roger Waters') 65 | then Caption:= 'Done' 66 | else Caption:= 'Failed!' 67 | end; 68 | 69 | 70 | end. 71 | -------------------------------------------------------------------------------- /Errors - Premature return from function/TesterForm.vlb: -------------------------------------------------------------------------------- 1 | [mmo] 2 | Coordinates=173,10,53,51 3 | 4 | [] 5 | Coordinates=10,10,47,51 6 | 7 | -------------------------------------------------------------------------------- /Errors/Project_TryExcept.dpr: -------------------------------------------------------------------------------- 1 | program Project_TryExcept; 2 | 3 | uses 4 | Vcl.Forms, 5 | Unit1 in 'Unit1.pas' {Form1}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TForm1, Form1); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Errors/Project_TryExcept.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Errors/Project_TryExcept.res -------------------------------------------------------------------------------- /Errors/Unit1.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form1' 5 | ClientHeight = 337 6 | ClientWidth = 635 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object btnError1: TButton 18 | Left = 234 19 | Top = 76 20 | Width = 131 21 | Height = 63 22 | Caption = 'Generate error' 23 | TabOrder = 0 24 | OnClick = btnError1Click 25 | end 26 | object btnError2: TButton 27 | Left = 234 28 | Top = 147 29 | Width = 131 30 | Height = 63 31 | Caption = 'Generate error 2' 32 | TabOrder = 1 33 | OnClick = btnError2Click 34 | end 35 | object btnError3: TButton 36 | Left = 234 37 | Top = 218 38 | Width = 131 39 | Height = 63 40 | Caption = 'Generate error (fixed)' 41 | TabOrder = 2 42 | OnClick = btnError3Click 43 | end 44 | end 45 | -------------------------------------------------------------------------------- /Errors/Unit1.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Errors/Unit1.pas -------------------------------------------------------------------------------- /Forms-Proper initialization/Project_ProperInitialization.dpr: -------------------------------------------------------------------------------- 1 | program Project_ProperInitialization; 2 | 3 | uses 4 | Vcl.Forms, 5 | Unit1 in 'Unit1.pas' {Form1}, 6 | Unit2 in 'Unit2.pas' {Form2}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.MainFormOnTaskbar := True; 13 | Application.CreateForm(TForm1, Form1); 14 | Application.Run; 15 | end. 16 | -------------------------------------------------------------------------------- /Forms-Proper initialization/Unit1.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form1' 5 | ClientHeight = 172 6 | ClientWidth = 277 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object Button1: TButton 18 | Left = 82 19 | Top = 62 20 | Width = 103 21 | Height = 35 22 | Caption = 'Create Form2' 23 | TabOrder = 0 24 | OnClick = Button1Click 25 | end 26 | end 27 | -------------------------------------------------------------------------------- /Forms-Proper initialization/Unit1.pas: -------------------------------------------------------------------------------- 1 | UNIT Unit1; 2 | 3 | INTERFACE 4 | 5 | USES 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; 8 | 9 | CONST 10 | MSG_LateFormInit= WM_APP + 4711; 11 | 12 | TYPE 13 | TForm1 = class(TForm) 14 | Button1: TButton; 15 | procedure Button1Click(Sender: TObject); 16 | procedure FormCreate(Sender: TObject); 17 | private 18 | protected 19 | procedure LateInitialize(VAR Msg: TMessage); message MSG_LateFormInit; // Called after the main form was fully created 20 | end; 21 | 22 | var 23 | Form1: TForm1; 24 | 25 | IMPLEMENTATION {$R *.dfm} 26 | 27 | USES Unit2; 28 | 29 | 30 | 31 | 32 | procedure TForm1.FormCreate (Sender: TObject); 33 | begin 34 | PostMessage(Self.Handle, MSG_LateAppInit_, 0, 0); 35 | Show; 36 | Sleep(1000); // Form 1 is very bussy here. 37 | end; 38 | 39 | 40 | procedure TForm1.LateInitialize; 41 | begin 42 | //Move as much as possible of your initialization code from FromCreate, here 43 | Button1Click(Self); // The second form will only be created AFTER the first form was fully created 44 | end; 45 | 46 | 47 | 48 | procedure TForm1.Button1Click(Sender: TObject); 49 | begin 50 | Form2:= TForm2.Create(Self); 51 | Form2.Show; 52 | //Form2.WindowState:= wsMaximized; //Try me 53 | end; 54 | 55 | end. 56 | -------------------------------------------------------------------------------- /Forms-Proper initialization/Unit2.dfm: -------------------------------------------------------------------------------- 1 | object Form2: TForm2 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form2' 5 | ClientHeight = 142 6 | ClientWidth = 247 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnClose = FormClose 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | end 18 | -------------------------------------------------------------------------------- /Forms-Proper initialization/Unit2.pas: -------------------------------------------------------------------------------- 1 | UNIT Unit2; 2 | 3 | INTERFACE 4 | 5 | USES 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs; 8 | 9 | TYPE 10 | TForm2 = class(TForm) 11 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 12 | end; 13 | 14 | VAR 15 | Form2: TForm2; 16 | 17 | IMPLEMENTATION {$R *.dfm} 18 | 19 | procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction); 20 | begin 21 | Action:= caFree; 22 | end; 23 | 24 | end. 25 | -------------------------------------------------------------------------------- /Forms-Two forms/Project_TwoForms.dpr: -------------------------------------------------------------------------------- 1 | program Project_TwoForms; 2 | 3 | uses 4 | Vcl.Forms, 5 | Unit1 in 'Unit1.pas' {Form1}, 6 | Unit2 in 'Unit2.pas' {Form2}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | 13 | { MainFormOnTaskbar 14 | See: stackoverflow.com/questions/66720721 15 | 16 | If true: 17 | The taskbar button represents the application's Main Form and displays its caption. 18 | 19 | Bad: All child forms will stay on top of the MainForm! 20 | But they are not modal! The MainForm can still be clicked! 21 | If we don't really want this, we should stick with MainFormOnTaskbar = false. 22 | When we do want a child form to stay on top, then can use fsStayOnTop. 23 | 24 | If False: 25 | The taskbar button represents the application's (hidden) main window and bears the application's Title. 26 | Must be True to use Windows (Vista) Aero effects (live taskbar thumbnails, Dynamic Windows, Windows Flip, Windows Flip 3D). 27 | 28 | Bad: All child forms will disapear under the MainForm! } 29 | 30 | Application.MainFormOnTaskbar := FALSE; 31 | Application.CreateForm(TForm1, Form1); 32 | Application.Run; 33 | end. 34 | -------------------------------------------------------------------------------- /Forms-Two forms/Project_TwoForms.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Forms-Two forms/Project_TwoForms.res -------------------------------------------------------------------------------- /Forms-Two forms/Unit1.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 754 3 | Top = 525 4 | Caption = 'Form1' 5 | ClientHeight = 272 6 | ClientWidth = 277 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | Position = poDesigned 15 | DesignSize = ( 16 | 277 17 | 272) 18 | PixelsPerInch = 96 19 | TextHeight = 13 20 | object Button1: TButton 21 | Left = 52 22 | Top = 36 23 | Width = 173 24 | Height = 57 25 | Anchors = [] 26 | Caption = 'Create Form2' 27 | TabOrder = 0 28 | OnClick = Button1Click 29 | end 30 | object btnCreateNoVar: TButton 31 | Left = 52 32 | Top = 101 33 | Width = 173 34 | Height = 57 35 | Anchors = [] 36 | Caption = 'Create Form2 (no global variable)' 37 | TabOrder = 1 38 | WordWrap = True 39 | OnClick = btnCreateNoVarClick 40 | end 41 | object chkShowModal: TCheckBox 42 | Left = 92 43 | Top = 247 44 | Width = 97 45 | Height = 17 46 | Caption = 'Show modal' 47 | TabOrder = 2 48 | end 49 | object Button2: TButton 50 | Left = 52 51 | Top = 164 52 | Width = 173 53 | Height = 57 54 | Anchors = [] 55 | Caption = 'Create Form2 (fsStayOnTop)' 56 | TabOrder = 3 57 | WordWrap = True 58 | OnClick = Button2Click 59 | end 60 | end 61 | -------------------------------------------------------------------------------- /Forms-Two forms/Unit1.pas: -------------------------------------------------------------------------------- 1 | UNIT Unit1; 2 | 3 | INTERFACE 4 | 5 | USES 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; 8 | 9 | TYPE 10 | TForm1 = class(TForm) 11 | Button1: TButton; 12 | btnCreateNoVar: TButton; 13 | chkShowModal: TCheckBox; 14 | Button2: TButton; 15 | procedure Button1Click(Sender: TObject); 16 | procedure btnCreateNoVarClick(Sender: TObject); 17 | procedure Button2Click(Sender: TObject); 18 | private 19 | protected 20 | end; 21 | 22 | VAR 23 | Form1: TForm1; // Global variable. Not good! 24 | 25 | IMPLEMENTATION {$R *.dfm} 26 | 27 | USES Unit2; 28 | 29 | 30 | 31 | { Note: Open the DPR file (main menu, Project -> View Source) and play with Application.MainFormOnTaskbar } 32 | 33 | 34 | procedure TForm1.Button1Click(Sender: TObject); 35 | begin 36 | Form2:= TForm2.Create(Self); 37 | 38 | if chkShowModal.Checked 39 | then 40 | begin 41 | Form2.ShowModal; 42 | Form2.Close; 43 | end 44 | else 45 | Form2.Show; 46 | 47 | //Form2.WindowState:= wsMaximized; //Try me 48 | end; 49 | 50 | 51 | procedure TForm1.btnCreateNoVarClick(Sender: TObject); 52 | begin 53 | VAR LocalForm:= TForm2.Create(Self); 54 | if chkShowModal.Checked 55 | then 56 | begin 57 | LocalForm.ShowModal; 58 | LocalForm.Close; 59 | end 60 | else 61 | LocalForm.Show; 62 | end; 63 | 64 | 65 | procedure TForm1.Button2Click(Sender: TObject); 66 | begin 67 | VAR LocalForm:= TForm2.Create(Self); 68 | LocalForm.FormStyle:= fsStayOnTop; 69 | 70 | if chkShowModal.Checked 71 | then 72 | begin 73 | LocalForm.ShowModal; 74 | LocalForm.Close; 75 | end 76 | else 77 | LocalForm.Show; 78 | end; 79 | 80 | 81 | end. 82 | -------------------------------------------------------------------------------- /Forms-Two forms/Unit2.dfm: -------------------------------------------------------------------------------- 1 | object Form2: TForm2 2 | Left = 891 3 | Top = 675 4 | Caption = 'Form2' 5 | ClientHeight = 142 6 | ClientWidth = 247 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | Position = poDesigned 15 | OnClose = FormClose 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | object Button1: TButton 19 | Left = 60 20 | Top = 28 21 | Width = 114 22 | Height = 33 23 | Caption = 'Show MainForm (a)' 24 | TabOrder = 0 25 | OnClick = Button1Click 26 | end 27 | object Button2: TButton 28 | Left = 60 29 | Top = 71 30 | Width = 114 31 | Height = 33 32 | Caption = 'Show MainForm (b)' 33 | TabOrder = 1 34 | OnClick = Button2Click 35 | end 36 | end 37 | -------------------------------------------------------------------------------- /Forms-Two forms/Unit2.pas: -------------------------------------------------------------------------------- 1 | UNIT Unit2; 2 | 3 | INTERFACE 4 | 5 | USES 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; 8 | 9 | TYPE 10 | TForm2 = class(TForm) 11 | Button1: TButton; 12 | Button2: TButton; 13 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 14 | procedure Button1Click(Sender: TObject); 15 | procedure Button2Click(Sender: TObject); 16 | end; 17 | 18 | VAR 19 | Form2: TForm2; // Global variable. Not good! 20 | 21 | IMPLEMENTATION {$R *.dfm} 22 | 23 | uses Unit1; 24 | 25 | 26 | 27 | 28 | procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction); 29 | begin 30 | Action:= caFree; 31 | end; 32 | 33 | 34 | procedure TForm2.Button1Click(Sender: TObject); 35 | begin 36 | Form1.Caption:= 'Here I am!'; 37 | Form1.Show; // We can do this only because we have Form1 in a global variable. But what if we don't have it in a global var? 38 | end; 39 | 40 | 41 | procedure TForm2.Button2Click(Sender: TObject); 42 | begin 43 | Application.MainForm.Caption:= 'Here I am!!'; 44 | Application.MainForm.Show; // We don't actually to access Form1 via a global var. We can access it via Application.MainForm. 45 | end; 46 | 47 | 48 | end. 49 | -------------------------------------------------------------------------------- /Global variables in DLLs/DLL1.dpr: -------------------------------------------------------------------------------- 1 | library DLL1; 2 | 3 | uses 4 | System.SysUtils, 5 | vcl.Dialogs, 6 | uTest1 in 'c:\Projects\Carte\Demo projects\Initialization in IDE packages\uTest1.pas'; 7 | 8 | procedure TestSingleton; stdcall; 9 | begin 10 | TSingleton.Instance.SetValue(7); 11 | TSingleton.Instance.PrintValue('uTest1 - DLL'); 12 | end; 13 | 14 | exports 15 | TestSingleton; 16 | 17 | begin 18 | end. 19 | 20 | -------------------------------------------------------------------------------- /Global variables in DLLs/DLL2.dpr: -------------------------------------------------------------------------------- 1 | library DLL2; 2 | 3 | uses 4 | System.SysUtils, 5 | vcl.Dialogs, 6 | uTest1 in 'c:\Projects\Carte\Demo projects\Initialization in IDE packages\uTest1.pas'; 7 | 8 | procedure TestSingleton; stdcall; 9 | begin 10 | TSingleton.Instance.PrintValue('uTest2 - DLL'); 11 | end; 12 | 13 | exports 14 | TestSingleton; 15 | 16 | begin 17 | end. 18 | 19 | -------------------------------------------------------------------------------- /Global variables in DLLs/DLL2.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Global variables in DLLs/DLL2.res -------------------------------------------------------------------------------- /Global variables in DLLs/MainForm.dfm: -------------------------------------------------------------------------------- 1 | object Form10: TForm10 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form10' 5 | ClientHeight = 442 6 | ClientWidth = 628 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -12 11 | Font.Name = 'Segoe UI' 12 | Font.Style = [] 13 | OnCreate = FormCreate 14 | TextHeight = 15 15 | end 16 | -------------------------------------------------------------------------------- /Global variables in DLLs/MainForm.pas: -------------------------------------------------------------------------------- 1 | unit MainForm; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs; 8 | 9 | type 10 | TForm10 = class(TForm) 11 | procedure FormCreate(Sender: TObject); 12 | private 13 | public 14 | end; 15 | 16 | var 17 | Form10: TForm10; 18 | 19 | implementation 20 | {$R *.dfm} 21 | 22 | 23 | procedure CallDLL(const DLLName: string; const FuncName: string); 24 | type 25 | TTestSingleton = procedure; stdcall; 26 | var 27 | DLLHandle: THandle; 28 | Proc: TTestSingleton; 29 | begin 30 | DLLHandle := LoadLibrary(PChar(DLLName)); 31 | try 32 | if DLLHandle <> 0 then 33 | begin 34 | @Proc := GetProcAddress(DLLHandle, PChar(FuncName)); 35 | if Assigned(Proc) then 36 | Proc; 37 | end; 38 | finally 39 | FreeLibrary(DLLHandle); 40 | end; 41 | end; 42 | 43 | procedure TForm10.FormCreate(Sender: TObject); 44 | begin 45 | CallDLL('DLL1.dll', 'TestSingleton'); // Initializes singleton in uTest1 DLL 46 | CallDLL('DLL2.dll', 'TestSingleton'); // Should initialize a new instance of the singleton in uTest2 DLL 47 | end; 48 | 49 | 50 | 51 | 52 | end. 53 | -------------------------------------------------------------------------------- /Global variables in DLLs/ProjectGroup1.groupproj: -------------------------------------------------------------------------------- 1 | <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> 2 | <PropertyGroup> 3 | <ProjectGuid>{8869B391-49E3-4CCC-861A-C7FB33B49A76}</ProjectGuid> 4 | </PropertyGroup> 5 | <ItemGroup> 6 | <Projects Include="TestDLL.dproj"> 7 | <Dependencies/> 8 | </Projects> 9 | <Projects Include="DLL1.dproj"> 10 | <Dependencies/> 11 | </Projects> 12 | <Projects Include="DLL2.dproj"> 13 | <Dependencies/> 14 | </Projects> 15 | </ItemGroup> 16 | <ProjectExtensions> 17 | <Borland.Personality>Default.Personality.12</Borland.Personality> 18 | <Borland.ProjectType/> 19 | <BorlandProject> 20 | <Default.Personality/> 21 | </BorlandProject> 22 | </ProjectExtensions> 23 | <Target Name="TestDLL"> 24 | <MSBuild Projects="TestDLL.dproj"/> 25 | </Target> 26 | <Target Name="TestDLL:Clean"> 27 | <MSBuild Projects="TestDLL.dproj" Targets="Clean"/> 28 | </Target> 29 | <Target Name="TestDLL:Make"> 30 | <MSBuild Projects="TestDLL.dproj" Targets="Make"/> 31 | </Target> 32 | <Target Name="DLL1"> 33 | <MSBuild Projects="DLL1.dproj"/> 34 | </Target> 35 | <Target Name="DLL1:Clean"> 36 | <MSBuild Projects="DLL1.dproj" Targets="Clean"/> 37 | </Target> 38 | <Target Name="DLL1:Make"> 39 | <MSBuild Projects="DLL1.dproj" Targets="Make"/> 40 | </Target> 41 | <Target Name="DLL2"> 42 | <MSBuild Projects="DLL2.dproj"/> 43 | </Target> 44 | <Target Name="DLL2:Clean"> 45 | <MSBuild Projects="DLL2.dproj" Targets="Clean"/> 46 | </Target> 47 | <Target Name="DLL2:Make"> 48 | <MSBuild Projects="DLL2.dproj" Targets="Make"/> 49 | </Target> 50 | <Target Name="Build"> 51 | <CallTarget Targets="TestDLL;DLL1;DLL2"/> 52 | </Target> 53 | <Target Name="Clean"> 54 | <CallTarget Targets="TestDLL:Clean;DLL1:Clean;DLL2:Clean"/> 55 | </Target> 56 | <Target Name="Make"> 57 | <CallTarget Targets="TestDLL:Make;DLL1:Make;DLL2:Make"/> 58 | </Target> 59 | <Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/> 60 | </Project> 61 | -------------------------------------------------------------------------------- /Global variables in DLLs/TestDLL.dpr: -------------------------------------------------------------------------------- 1 | program TestDLL; 2 | 3 | uses 4 | Vcl.Forms, 5 | MainForm in 'MainForm.pas' {Form10}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TForm10, Form10); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Global variables in DLLs/TestDLL.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Global variables in DLLs/TestDLL.res -------------------------------------------------------------------------------- /Global variables in DLLs/Win32/Debug/DLL2.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Global variables in DLLs/Win32/Debug/DLL2.dll -------------------------------------------------------------------------------- /HelloWorld/MainForm.dfm: -------------------------------------------------------------------------------- 1 | object MainFrom: TMainFrom 2 | Left = 728 3 | Top = 359 4 | Caption = 'Hi' 5 | ClientHeight = 231 6 | ClientWidth = 375 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | DesignSize = ( 15 | 375 16 | 231) 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object btnHello: TButton 20 | Left = 102 21 | Top = 86 22 | Width = 150 23 | Height = 57 24 | Anchors = [] 25 | Caption = 'Say hello' 26 | TabOrder = 0 27 | OnClick = btnHelloClick 28 | end 29 | end 30 | -------------------------------------------------------------------------------- /HelloWorld/MainForm.pas: -------------------------------------------------------------------------------- 1 | UNIT MainForm; 2 | 3 | INTERFACE 4 | 5 | USES 6 | System.SysUtils, System.Classes, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; 7 | 8 | TYPE 9 | TMainFrom = class(TForm) 10 | btnHello: TButton; 11 | procedure btnHelloClick(Sender: TObject); 12 | end; 13 | 14 | VAR 15 | MainFrom: TMainFrom; 16 | 17 | IMPLEMENTATION {$R *.dfm} 18 | 19 | 20 | 21 | procedure TMainFrom.btnHelloClick(Sender: TObject); 22 | begin 23 | ShowMessage('Hello world!'); 24 | end; 25 | 26 | end. 27 | -------------------------------------------------------------------------------- /HelloWorld/Project_HelloWorld.dpr: -------------------------------------------------------------------------------- 1 | program Project_HelloWorld; 2 | 3 | uses 4 | EMemLeaks, 5 | EResLeaks, 6 | ESendMailMAPI, 7 | ESendMailSMAPI, 8 | ESendMailSMTP, 9 | EDialogWinAPIEurekaLogDetailed, 10 | EDialogWinAPIStepsToReproduce, 11 | EFixSafeCallException, 12 | EMapWin32, 13 | EAppVCL, 14 | ExceptionLog7, 15 | Vcl.Forms, 16 | MainForm in 'MainForm.pas' {MainFrom}; 17 | 18 | {$R *.res} 19 | 20 | begin 21 | Application.Initialize; 22 | 23 | { MainFormOnTaskbar 24 | See: stackoverflow.com/questions/66720721 25 | 26 | If true: 27 | The taskbar button represents the application's Main Form and displays its caption. 28 | 29 | Bad: All child forms will stay on top of the MainForm! 30 | But they are not modal! The MainForm can still be clicked! 31 | If we don't really want this, we should stick with MainFormOnTaskbar = false. 32 | When we do want a child form to stay on top, then can use fsStayOnTop. 33 | 34 | If False: 35 | The taskbar button represents the application's (hidden) main window and bears the application's Title. 36 | Must be True to use Windows (Vista) Aero effects (live taskbar thumbnails, Dynamic Windows, Windows Flip, Windows Flip 3D). 37 | 38 | Bad: All child forms will disapear under the MainForm! } 39 | 40 | Application.MainFormOnTaskbar := True; 41 | Application.CreateForm(TMainFrom, MainFrom); 42 | Application.Run; 43 | end. 44 | -------------------------------------------------------------------------------- /Initialization in IDE packages (simple)/Pkg1_R.dpk: -------------------------------------------------------------------------------- 1 | package Pkg1_R; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS ON} 17 | {$RANGECHECKS ON} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$RUNONLY} 29 | {$IMPLICITBUILD ON} 30 | 31 | requires 32 | rtl, 33 | vcl; 34 | 35 | contains 36 | uTest1 in 'uTest1.pas'; 37 | 38 | end. 39 | -------------------------------------------------------------------------------- /Initialization in IDE packages (simple)/Pkg1_R.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Initialization in IDE packages (simple)/Pkg1_R.res -------------------------------------------------------------------------------- /Initialization in IDE packages (simple)/Pkg2_D.dpk: -------------------------------------------------------------------------------- 1 | package Pkg2_D; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS ON} 17 | {$RANGECHECKS ON} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$DESIGNONLY} 29 | {$IMPLICITBUILD ON} 30 | 31 | requires 32 | rtl, 33 | vcl, 34 | Pkg1_R, 35 | Pkg2_R; 36 | 37 | contains 38 | uTest2_D in 'uTest2_D.pas'; 39 | 40 | end. 41 | -------------------------------------------------------------------------------- /Initialization in IDE packages (simple)/Pkg2_D.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Initialization in IDE packages (simple)/Pkg2_D.res -------------------------------------------------------------------------------- /Initialization in IDE packages (simple)/Pkg2_R.dpk: -------------------------------------------------------------------------------- 1 | package Pkg2_R; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS ON} 17 | {$RANGECHECKS ON} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$RUNONLY} 29 | {$IMPLICITBUILD ON} 30 | 31 | requires 32 | rtl, 33 | vcl, 34 | Pkg1_R; 35 | 36 | contains 37 | uTest2_R in 'uTest2_R.pas'; 38 | 39 | end. 40 | -------------------------------------------------------------------------------- /Initialization in IDE packages (simple)/Pkg2_R.dproj: -------------------------------------------------------------------------------- 1 | <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> 2 | <PropertyGroup> 3 | <Base>True</Base> 4 | <AppType>Package</AppType> 5 | <Config Condition="'$(Config)'==''">Debug</Config> 6 | <FrameworkType>VCL</FrameworkType> 7 | <MainSource>Pkg2_R.dpk</MainSource> 8 | <Platform Condition="'$(Platform)'==''">Win32</Platform> 9 | <ProjectGuid>{11835C10-3C86-4D7D-85E2-0EF9B8B88D4B}</ProjectGuid> 10 | <ProjectVersion>19.5</ProjectVersion> 11 | <TargetedPlatforms>1</TargetedPlatforms> 12 | </PropertyGroup> 13 | <PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''"> 14 | <Base>true</Base> 15 | </PropertyGroup> 16 | <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''"> 17 | <Base_Win32>true</Base_Win32> 18 | <CfgParent>Base</CfgParent> 19 | <Base>true</Base> 20 | </PropertyGroup> 21 | <PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''"> 22 | <Cfg_1>true</Cfg_1> 23 | <CfgParent>Base</CfgParent> 24 | <Base>true</Base> 25 | </PropertyGroup> 26 | <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''"> 27 | <Cfg_1_Win32>true</Cfg_1_Win32> 28 | <CfgParent>Cfg_1</CfgParent> 29 | <Cfg_1>true</Cfg_1> 30 | <Base>true</Base> 31 | </PropertyGroup> 32 | <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''"> 33 | <Cfg_2>true</Cfg_2> 34 | <CfgParent>Base</CfgParent> 35 | <Base>true</Base> 36 | </PropertyGroup> 37 | <PropertyGroup Condition="'$(Base)'!=''"> 38 | <SanitizedProjectName>Pkg2_R</SanitizedProjectName> 39 | <DCC_CBuilderOutput>All</DCC_CBuilderOutput> 40 | <DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput> 41 | <DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput> 42 | <DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace> 43 | <GenDll>true</GenDll> 44 | <GenPackage>true</GenPackage> 45 | <RuntimeOnlyPackage>true</RuntimeOnlyPackage> 46 | <VerInfo_Locale>1031</VerInfo_Locale> 47 | </PropertyGroup> 48 | <PropertyGroup Condition="'$(Base_Win32)'!=''"> 49 | <BT_BuildType>Debug</BT_BuildType> 50 | <DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace> 51 | <DCC_UsePackage>vcl;rtl;Pkg1_R;$(DCC_UsePackage)</DCC_UsePackage> 52 | </PropertyGroup> 53 | <PropertyGroup Condition="'$(Cfg_1)'!=''"> 54 | <DCC_DebugDCUs>true</DCC_DebugDCUs> 55 | <DCC_DebugInfoInExe>true</DCC_DebugInfoInExe> 56 | <DCC_Define>DEBUG;$(DCC_Define)</DCC_Define> 57 | <DCC_GenerateStackFrames>true</DCC_GenerateStackFrames> 58 | <DCC_IntegerOverflowCheck>true</DCC_IntegerOverflowCheck> 59 | <DCC_Optimize>false</DCC_Optimize> 60 | <DCC_RangeChecking>true</DCC_RangeChecking> 61 | <DCC_RemoteDebug>true</DCC_RemoteDebug> 62 | </PropertyGroup> 63 | <PropertyGroup Condition="'$(Cfg_1_Win32)'!=''"> 64 | <DCC_RemoteDebug>false</DCC_RemoteDebug> 65 | </PropertyGroup> 66 | <PropertyGroup Condition="'$(Cfg_2)'!=''"> 67 | <DCC_DebugInformation>0</DCC_DebugInformation> 68 | <DCC_Define>RELEASE;$(DCC_Define)</DCC_Define> 69 | <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols> 70 | <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo> 71 | </PropertyGroup> 72 | <ItemGroup> 73 | <DelphiCompile Include="$(MainSource)"> 74 | <MainSource>MainSource</MainSource> 75 | </DelphiCompile> 76 | <DCCReference Include="rtl.dcp"/> 77 | <DCCReference Include="vcl.dcp"/> 78 | <DCCReference Include="Pkg1_R.dcp"/> 79 | <DCCReference Include="uTest2_R.pas"/> 80 | <BuildConfiguration Include="Base"> 81 | <Key>Base</Key> 82 | </BuildConfiguration> 83 | <BuildConfiguration Include="Debug"> 84 | <Key>Cfg_1</Key> 85 | <CfgParent>Base</CfgParent> 86 | </BuildConfiguration> 87 | <BuildConfiguration Include="Release"> 88 | <Key>Cfg_2</Key> 89 | <CfgParent>Base</CfgParent> 90 | </BuildConfiguration> 91 | </ItemGroup> 92 | <ProjectExtensions> 93 | <Borland.Personality>Delphi.Personality.12</Borland.Personality> 94 | <Borland.ProjectType>Package</Borland.ProjectType> 95 | <BorlandProject> 96 | <Delphi.Personality> 97 | <Source> 98 | <Source Name="MainSource">Pkg2_R.dpk</Source> 99 | </Source> 100 | <Excluded_Packages/> 101 | </Delphi.Personality> 102 | <Platforms> 103 | <Platform value="Win32">True</Platform> 104 | <Platform value="Win64">False</Platform> 105 | </Platforms> 106 | </BorlandProject> 107 | <ProjectFileVersion>12</ProjectFileVersion> 108 | </ProjectExtensions> 109 | <Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/> 110 | <Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/> 111 | <Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/> 112 | </Project> 113 | -------------------------------------------------------------------------------- /Initialization in IDE packages (simple)/Pkg2_R.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Initialization in IDE packages (simple)/Pkg2_R.res -------------------------------------------------------------------------------- /Initialization in IDE packages (simple)/TestApp.dpr: -------------------------------------------------------------------------------- 1 | program TestApp; 2 | 3 | uses 4 | Vcl.Forms, 5 | uMainForm in 'uMainForm.pas' {frmMain}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TfrmMain, frmMain); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Initialization in IDE packages (simple)/TestApp.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Initialization in IDE packages (simple)/TestApp.res -------------------------------------------------------------------------------- /Initialization in IDE packages (simple)/TestGroup.groupproj: -------------------------------------------------------------------------------- 1 | <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> 2 | <PropertyGroup> 3 | <ProjectGuid>{3D577D97-8CF1-4DCD-90DC-52919FE71C44}</ProjectGuid> 4 | </PropertyGroup> 5 | <ItemGroup> 6 | <Projects Include="Pkg1_R.dproj"> 7 | <Dependencies/> 8 | </Projects> 9 | <Projects Include="Pkg2_R.dproj"> 10 | <Dependencies/> 11 | </Projects> 12 | <Projects Include="Pkg2_D.dproj"> 13 | <Dependencies/> 14 | </Projects> 15 | <Projects Include="TestApp.dproj"> 16 | <Dependencies/> 17 | </Projects> 18 | </ItemGroup> 19 | <ProjectExtensions> 20 | <Borland.Personality>Default.Personality.12</Borland.Personality> 21 | <Borland.ProjectType/> 22 | <BorlandProject> 23 | <Default.Personality/> 24 | </BorlandProject> 25 | </ProjectExtensions> 26 | <Target Name="Pkg1_R"> 27 | <MSBuild Projects="Pkg1_R.dproj"/> 28 | </Target> 29 | <Target Name="Pkg1_R:Clean"> 30 | <MSBuild Projects="Pkg1_R.dproj" Targets="Clean"/> 31 | </Target> 32 | <Target Name="Pkg1_R:Make"> 33 | <MSBuild Projects="Pkg1_R.dproj" Targets="Make"/> 34 | </Target> 35 | <Target Name="Pkg2_R"> 36 | <MSBuild Projects="Pkg2_R.dproj"/> 37 | </Target> 38 | <Target Name="Pkg2_R:Clean"> 39 | <MSBuild Projects="Pkg2_R.dproj" Targets="Clean"/> 40 | </Target> 41 | <Target Name="Pkg2_R:Make"> 42 | <MSBuild Projects="Pkg2_R.dproj" Targets="Make"/> 43 | </Target> 44 | <Target Name="Pkg2_D"> 45 | <MSBuild Projects="Pkg2_D.dproj"/> 46 | </Target> 47 | <Target Name="Pkg2_D:Clean"> 48 | <MSBuild Projects="Pkg2_D.dproj" Targets="Clean"/> 49 | </Target> 50 | <Target Name="Pkg2_D:Make"> 51 | <MSBuild Projects="Pkg2_D.dproj" Targets="Make"/> 52 | </Target> 53 | <Target Name="TestApp"> 54 | <MSBuild Projects="TestApp.dproj"/> 55 | </Target> 56 | <Target Name="TestApp:Clean"> 57 | <MSBuild Projects="TestApp.dproj" Targets="Clean"/> 58 | </Target> 59 | <Target Name="TestApp:Make"> 60 | <MSBuild Projects="TestApp.dproj" Targets="Make"/> 61 | </Target> 62 | <Target Name="Build"> 63 | <CallTarget Targets="Pkg1_R;Pkg2_R;Pkg2_D;TestApp"/> 64 | </Target> 65 | <Target Name="Clean"> 66 | <CallTarget Targets="Pkg1_R:Clean;Pkg2_R:Clean;Pkg2_D:Clean;TestApp:Clean"/> 67 | </Target> 68 | <Target Name="Make"> 69 | <CallTarget Targets="Pkg1_R:Make;Pkg2_R:Make;Pkg2_D:Make;TestApp:Make"/> 70 | </Target> 71 | <Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/> 72 | </Project> 73 | -------------------------------------------------------------------------------- /Initialization in IDE packages (simple)/uMainForm.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'Main' 5 | ClientHeight = 440 6 | ClientWidth = 620 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -12 11 | Font.Name = 'Segoe UI' 12 | Font.Style = [] 13 | OnCreate = FormCreate 14 | TextHeight = 15 15 | object mmo: TMemo 16 | AlignWithMargins = True 17 | Left = 3 18 | Top = 3 19 | Width = 291 20 | Height = 434 21 | Align = alLeft 22 | Lines.Strings = ( 23 | 'mmo') 24 | TabOrder = 0 25 | end 26 | object MyPanel1: TMyPanel 27 | Left = 350 28 | Top = 190 29 | Width = 185 30 | Height = 41 31 | Caption = 'MyPanel1' 32 | TabOrder = 1 33 | OnClick = MyPanel1Click 34 | end 35 | end 36 | -------------------------------------------------------------------------------- /Initialization in IDE packages (simple)/uMainForm.pas: -------------------------------------------------------------------------------- 1 | unit uMainForm; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, uTest2_R; 8 | 9 | type 10 | TfrmMain = class(TForm) 11 | mmo: TMemo; 12 | MyPanel1: TMyPanel; 13 | procedure FormCreate(Sender: TObject); 14 | procedure MyPanel1Click(Sender: TObject); 15 | end; 16 | 17 | var 18 | frmMain: TfrmMain; 19 | 20 | implementation {$R *.dfm} 21 | 22 | uses uTest1; 23 | 24 | procedure TfrmMain.FormCreate(Sender: TObject); 25 | begin 26 | mmo.Lines.Add('Global: '+ IntToStr(Global)); 27 | end; 28 | 29 | procedure TfrmMain.MyPanel1Click(Sender: TObject); 30 | begin 31 | TMyPanel.Print('App running - OnClick'); 32 | end; 33 | 34 | end. 35 | -------------------------------------------------------------------------------- /Initialization in IDE packages (simple)/uTest1.pas: -------------------------------------------------------------------------------- 1 | unit uTest1; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, vcl.Dialogs; 7 | 8 | var Global: Integer; 9 | 10 | 11 | implementation 12 | 13 | 14 | initialization 15 | begin 16 | Global:= 111; 17 | ShowMessage('Initialization Pkg1. '+ #13+ IntToStr(Global)); 18 | end; 19 | 20 | finalization 21 | begin 22 | end; 23 | 24 | end. 25 | -------------------------------------------------------------------------------- /Initialization in IDE packages (simple)/uTest2_D.pas: -------------------------------------------------------------------------------- 1 | unit uTest2_D; 2 | 3 | interface 4 | 5 | USES 6 | System.SysUtils, System.Classes, 7 | Vcl.Forms, vcl.Dialogs, Vcl.Controls, 8 | uTest1, uTest2_R; 9 | 10 | 11 | procedure Register; 12 | 13 | implementation 14 | 15 | 16 | procedure Register; 17 | begin 18 | RegisterComponents('LightSaber', [TMyPanel]); 19 | TMyPanel.Print('Register in Pkg2_D'); 20 | end; 21 | 22 | 23 | initialization 24 | begin 25 | Global:= 555; 26 | ShowMessage('Initialization Pkg2_D. '+ #13+ IntToStr(Global)); 27 | end; 28 | 29 | finalization 30 | begin 31 | end; 32 | 33 | end. 34 | 35 | 36 | -------------------------------------------------------------------------------- /Initialization in IDE packages (simple)/uTest2_R.pas: -------------------------------------------------------------------------------- 1 | unit uTest2_R; 2 | 3 | interface 4 | 5 | USES 6 | System.SysUtils, System.Classes, System.TypInfo, 7 | Vcl.Forms, vcl.Dialogs, Vcl.Controls, Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.StdCtrls, 8 | uTest1; 9 | 10 | TYPE 11 | TMyPanel = class(TPanel) 12 | class procedure Print(const Msg: string); 13 | constructor Create(aOwner: TComponent); override; 14 | end; 15 | 16 | 17 | implementation 18 | 19 | 20 | constructor TMyPanel.Create(aOwner: TComponent); 21 | begin 22 | inherited Create(aOwner); 23 | Print('TMyPanel.Create'); 24 | end; 25 | 26 | 27 | class procedure TMyPanel.Print(const Msg: string); 28 | begin 29 | ShowMessage( 30 | #10+ Msg 31 | + #10 32 | + #10+ 'TMyPanel: ' 33 | + #10+ ' Module ID: ' + IntToHex(UIntPtr(HInstance), 8) // Retrieve the module handle and convert to hex 34 | + #10+ ' @TMyPanel: ' + IntToHex(IntPtr(TMyPanel), 8) 35 | + #10+ ' @Self : ' + IntToHex(NativeInt(Pointer(Self)), 8) 36 | + #10+ ' Global : ' + IntToStr(Global) 37 | ); 38 | end; 39 | 40 | 41 | initialization 42 | begin 43 | Global:= 333; 44 | ShowMessage('Initialization Pkg2_R. '+ #13+ IntToStr(Global)); 45 | end; 46 | 47 | finalization 48 | begin 49 | end; 50 | 51 | end. 52 | 53 | 54 | -------------------------------------------------------------------------------- /Initialization in IDE packages 2 (advanced)/Pkg1_R.dpk: -------------------------------------------------------------------------------- 1 | package Pkg1_R; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS ON} 17 | {$RANGECHECKS ON} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$RUNONLY} 29 | {$IMPLICITBUILD ON} 30 | 31 | requires 32 | rtl, 33 | vcl; 34 | 35 | contains 36 | uTest1 in 'uTest1.pas'; 37 | 38 | end. 39 | -------------------------------------------------------------------------------- /Initialization in IDE packages 2 (advanced)/Pkg1_R.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Initialization in IDE packages 2 (advanced)/Pkg1_R.res -------------------------------------------------------------------------------- /Initialization in IDE packages 2 (advanced)/Pkg2_D.dpk: -------------------------------------------------------------------------------- 1 | package Pkg2_D; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS ON} 17 | {$RANGECHECKS ON} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$DESIGNONLY} 29 | {$IMPLICITBUILD ON} 30 | 31 | requires 32 | rtl, 33 | vcl, 34 | Pkg1_R, 35 | Pkg2_R; 36 | 37 | contains 38 | uTest2_D in 'uTest2_D.pas'; 39 | 40 | end. 41 | -------------------------------------------------------------------------------- /Initialization in IDE packages 2 (advanced)/Pkg2_D.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Initialization in IDE packages 2 (advanced)/Pkg2_D.res -------------------------------------------------------------------------------- /Initialization in IDE packages 2 (advanced)/Pkg2_R.dpk: -------------------------------------------------------------------------------- 1 | package Pkg2_R; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS ON} 17 | {$RANGECHECKS ON} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$RUNONLY} 29 | {$IMPLICITBUILD ON} 30 | 31 | requires 32 | rtl, 33 | vcl, 34 | Pkg1_R; 35 | 36 | contains 37 | uTest2_R in 'uTest2_R.pas'; 38 | 39 | end. 40 | -------------------------------------------------------------------------------- /Initialization in IDE packages 2 (advanced)/Pkg2_R.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Initialization in IDE packages 2 (advanced)/Pkg2_R.res -------------------------------------------------------------------------------- /Initialization in IDE packages 2 (advanced)/TestApp.dpr: -------------------------------------------------------------------------------- 1 | program TestApp; 2 | 3 | uses 4 | Vcl.Forms, 5 | uMainForm in 'uMainForm.pas' {frmMain}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TfrmMain, frmMain); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Initialization in IDE packages 2 (advanced)/TestApp.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Initialization in IDE packages 2 (advanced)/TestApp.res -------------------------------------------------------------------------------- /Initialization in IDE packages 2 (advanced)/TestGroup.groupproj: -------------------------------------------------------------------------------- 1 | <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> 2 | <PropertyGroup> 3 | <ProjectGuid>{3D577D97-8CF1-4DCD-90DC-52919FE71C44}</ProjectGuid> 4 | </PropertyGroup> 5 | <ItemGroup> 6 | <Projects Include="Pkg1_R.dproj"> 7 | <Dependencies/> 8 | </Projects> 9 | <Projects Include="Pkg2_R.dproj"> 10 | <Dependencies/> 11 | </Projects> 12 | <Projects Include="Pkg2_D.dproj"> 13 | <Dependencies/> 14 | </Projects> 15 | <Projects Include="TestApp.dproj"> 16 | <Dependencies/> 17 | </Projects> 18 | </ItemGroup> 19 | <ProjectExtensions> 20 | <Borland.Personality>Default.Personality.12</Borland.Personality> 21 | <Borland.ProjectType/> 22 | <BorlandProject> 23 | <Default.Personality/> 24 | </BorlandProject> 25 | </ProjectExtensions> 26 | <Target Name="Pkg1_R"> 27 | <MSBuild Projects="Pkg1_R.dproj"/> 28 | </Target> 29 | <Target Name="Pkg1_R:Clean"> 30 | <MSBuild Projects="Pkg1_R.dproj" Targets="Clean"/> 31 | </Target> 32 | <Target Name="Pkg1_R:Make"> 33 | <MSBuild Projects="Pkg1_R.dproj" Targets="Make"/> 34 | </Target> 35 | <Target Name="Pkg2_R"> 36 | <MSBuild Projects="Pkg2_R.dproj"/> 37 | </Target> 38 | <Target Name="Pkg2_R:Clean"> 39 | <MSBuild Projects="Pkg2_R.dproj" Targets="Clean"/> 40 | </Target> 41 | <Target Name="Pkg2_R:Make"> 42 | <MSBuild Projects="Pkg2_R.dproj" Targets="Make"/> 43 | </Target> 44 | <Target Name="Pkg2_D"> 45 | <MSBuild Projects="Pkg2_D.dproj"/> 46 | </Target> 47 | <Target Name="Pkg2_D:Clean"> 48 | <MSBuild Projects="Pkg2_D.dproj" Targets="Clean"/> 49 | </Target> 50 | <Target Name="Pkg2_D:Make"> 51 | <MSBuild Projects="Pkg2_D.dproj" Targets="Make"/> 52 | </Target> 53 | <Target Name="TestApp"> 54 | <MSBuild Projects="TestApp.dproj"/> 55 | </Target> 56 | <Target Name="TestApp:Clean"> 57 | <MSBuild Projects="TestApp.dproj" Targets="Clean"/> 58 | </Target> 59 | <Target Name="TestApp:Make"> 60 | <MSBuild Projects="TestApp.dproj" Targets="Make"/> 61 | </Target> 62 | <Target Name="Build"> 63 | <CallTarget Targets="Pkg1_R;Pkg2_R;Pkg2_D;TestApp"/> 64 | </Target> 65 | <Target Name="Clean"> 66 | <CallTarget Targets="Pkg1_R:Clean;Pkg2_R:Clean;Pkg2_D:Clean;TestApp:Clean"/> 67 | </Target> 68 | <Target Name="Make"> 69 | <CallTarget Targets="Pkg1_R:Make;Pkg2_R:Make;Pkg2_D:Make;TestApp:Make"/> 70 | </Target> 71 | <Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/> 72 | </Project> 73 | -------------------------------------------------------------------------------- /Initialization in IDE packages 2 (advanced)/uMainForm.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'Main' 5 | ClientHeight = 440 6 | ClientWidth = 620 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -12 11 | Font.Name = 'Segoe UI' 12 | Font.Style = [] 13 | OnCreate = FormCreate 14 | TextHeight = 15 15 | object mmo: TMemo 16 | AlignWithMargins = True 17 | Left = 3 18 | Top = 3 19 | Width = 291 20 | Height = 434 21 | Align = alLeft 22 | Lines.Strings = ( 23 | 'mmo') 24 | TabOrder = 0 25 | end 26 | end 27 | -------------------------------------------------------------------------------- /Initialization in IDE packages 2 (advanced)/uMainForm.pas: -------------------------------------------------------------------------------- 1 | unit uMainForm; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, uTest2_R; 8 | 9 | type 10 | TfrmMain = class(TForm) 11 | mmo: TMemo; 12 | procedure FormCreate(Sender: TObject); 13 | private 14 | public 15 | end; 16 | 17 | var 18 | frmMain: TfrmMain; 19 | 20 | implementation 21 | {$R *.dfm} 22 | uses uTest1; 23 | 24 | procedure TfrmMain.FormCreate(Sender: TObject); 25 | begin 26 | //PrintMsg_Pkg2; 27 | mmo.Lines.Add('Global: '+ IntToStr(Global)); 28 | mmo.Lines.Add('Singleton: '+ IntToStr(TSingleton.Instance.GetInstanceVar)); 29 | end; 30 | 31 | end. 32 | -------------------------------------------------------------------------------- /Initialization in IDE packages 2 (advanced)/uTest1.pas: -------------------------------------------------------------------------------- 1 | unit uTest1; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, vcl.Dialogs; 7 | 8 | type 9 | ISingleton = interface 10 | ['{E1459FC2-E55A-40DB-889D-8FE18A7762C5}'] 11 | procedure Print(const s: string); 12 | procedure SetInstanceVar(Value: Integer); 13 | function GetInstanceVar: Integer; 14 | end; 15 | 16 | TSingleton = class(TInterfacedObject, ISingleton) 17 | private 18 | class var FInstance: ISingleton; 19 | class var Lock: TObject; 20 | class function GetInstance: ISingleton; static; 21 | public 22 | var InstVar: Integer; //"Private" field 23 | class var ClassVar: Integer; 24 | class property Instance: ISingleton read GetInstance; 25 | procedure Print(const Msg: string); 26 | procedure SetInstanceVar(Value: Integer); 27 | function GetInstanceVar: Integer; 28 | 29 | class constructor ClassCreate; // static; 30 | class destructor ClassDestroy; // static; 31 | end; 32 | 33 | var Global: Integer; 34 | 35 | procedure PrintMsg_Pkg1; 36 | 37 | 38 | implementation 39 | 40 | procedure PrintMsg_Pkg1; 41 | begin 42 | ShowMessage('Hello! This is package 1.'); 43 | end; 44 | 45 | 46 | 47 | // Call automatically when the unit is loaded! 48 | // Delphi restricts a single class constructor and a single class destructor per class 49 | class constructor TSingleton.ClassCreate; 50 | begin 51 | Lock := TObject.Create; // This is a class variable 52 | ShowMessage('TSingleton.ClassCreate'); 53 | end; 54 | 55 | 56 | class destructor TSingleton.ClassDestroy; 57 | begin 58 | FreeAndNil(Lock); 59 | end; 60 | 61 | 62 | {------------------------------------------------------------------------ 63 | SINGLETON 64 | ------------------------------------------------------------------------} 65 | class function TSingleton.GetInstance: ISingleton; 66 | begin 67 | if FInstance = nil then 68 | begin 69 | FInstance := TSingleton.Create; // Create the singleton only once 70 | var sModule := IntToHex(UIntPtr(HInstance), 8); // Retrieve the module handle and convert to hex 71 | //ShowMessage('Singleton created in uTest1'+ #13+ 'Module: ' + sModule); 72 | end; 73 | Result := FInstance; 74 | end; 75 | 76 | 77 | function TSingleton.GetInstanceVar: Integer; 78 | begin 79 | if Lock = nil 80 | then ShowMessage('Panic! Lock is nil!'); 81 | 82 | Result:= InstVar; 83 | end; 84 | 85 | 86 | procedure TSingleton.SetInstanceVar(Value: Integer); 87 | begin 88 | InstVar:= Value; 89 | end; 90 | 91 | 92 | 93 | procedure TSingleton.Print(const Msg: string); 94 | begin 95 | ShowMessage( 96 | #10+ Msg 97 | + #10 98 | + #10+ 'TSingleton: ' 99 | + #10+ ' Module ID: ' + IntToHex(UIntPtr(HInstance), 8) // Retrieve the module handle and convert to hex 100 | + #10+ ' @Class address: ' + IntToHex(IntPtr(TSingleton), 8) // the class TSingleton itself. converts the class type to an integer pointer to get its address. 101 | + #10+ ' @Self: ' + IntToHex(NativeInt(Pointer(Self)), 8) // The address of the current instance (i.e., Self), which is retrieved by 102 | + #10+ ' @TSingleton.Instance: ' + IntToHex(NativeInt(Pointer(TSingleton.Instance)), 8) 103 | + #10+ ' @TSingleton.ClassVar : ' + IntToHex(IntPtr(@ClassVar), 8) // Address of var 104 | + #10+ ' ClassVar : ' + IntToStr(ClassVar) 105 | + #10+ ' @TSingleton.InstVar : ' + IntToHex(IntPtr(@InstVar), 8) // Address of var 106 | + #10+ ' TSingleton.InstVar : ' + IntToHex(IntPtr(InstVar), 8) // Address of object 107 | 108 | + #10+ ' Instance.GetInstanceVar : ' + IntToStr(TSingleton.Instance.GetInstanceVar) 109 | + #10 110 | + #10+ 'Global : ' + IntToStr(Global) 111 | ); 112 | end; 113 | 114 | 115 | 116 | 117 | 118 | initialization 119 | begin 120 | Global:= 1; 121 | //TSingleton.ClassVar:= 2; // Class var 122 | //TSingleton.Instance.SetInstanceVar(3); // Instance var 123 | //TSingleton.Instance.Print('uTest1.Initialization. Singleton usage.'); 124 | end; 125 | 126 | finalization 127 | begin 128 | end; 129 | 130 | end. 131 | -------------------------------------------------------------------------------- /Initialization in IDE packages 2 (advanced)/uTest2_D.pas: -------------------------------------------------------------------------------- 1 | unit uTest2_D; 2 | 3 | interface 4 | 5 | USES 6 | System.SysUtils, System.Classes, 7 | Vcl.Forms, vcl.Dialogs, Vcl.Controls, Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.StdCtrls, 8 | uTest1, uTest2_R; 9 | 10 | 11 | procedure Register; 12 | 13 | implementation 14 | 15 | 16 | procedure Register; 17 | begin 18 | RegisterComponents('LightSaber', [TMyPanel]); 19 | end; 20 | 21 | 22 | 23 | 24 | {-----------------------------------------------------------------------} 25 | initialization 26 | begin 27 | //TSingleton.Instance.Print('uTest2_D.Initialization. '); // This should print 7, but it may create a new instance and print nothing (0) 28 | end; 29 | 30 | finalization 31 | begin 32 | end; 33 | {-----------------------------------------------------------------------} 34 | 35 | end. 36 | 37 | 38 | -------------------------------------------------------------------------------- /Initialization in IDE packages 2 (advanced)/uTest2_R.pas: -------------------------------------------------------------------------------- 1 | unit uTest2_R; 2 | 3 | interface 4 | 5 | USES 6 | System.SysUtils, System.Classes, System.TypInfo, 7 | Vcl.Forms, vcl.Dialogs, Vcl.Controls, Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.StdCtrls, 8 | uTest1; 9 | 10 | TYPE 11 | TMyPanel = class(TPanel) 12 | procedure Print(const Msg: string); 13 | constructor Create(aOwner: TComponent); override; 14 | end; 15 | 16 | procedure PrintMsg_Pkg2R(const Msg: string); 17 | 18 | 19 | 20 | implementation 21 | 22 | 23 | constructor TMyPanel.Create(aOwner: TComponent); 24 | begin 25 | inherited Create(aOwner); 26 | Print('TMyPanel.Create'); 27 | //TSingleton.Instance.Print('TMyPanel.Create. '); 28 | end; 29 | 30 | 31 | procedure TMyPanel.Print(const Msg: string); 32 | begin 33 | ShowMessage( 34 | #10+ Msg 35 | + #10 36 | + #10+ 'TMyPanel: ' 37 | + #10+ ' Module ID: ' + IntToHex(UIntPtr(HInstance), 8) // Retrieve the module handle and convert to hex 38 | + #10+ ' @TMyPanel: ' + IntToHex(IntPtr(TMyPanel), 8) 39 | + #10+ ' @Self : ' + IntToHex(NativeInt(Pointer(Self)), 8) 40 | + #10 41 | + #10+ 'TSingleton : ' 42 | + #10+ ' @TSingleton.Instance: ' + IntToHex(NativeInt(Pointer(TSingleton.Instance)), 8) 43 | + #10+ ' @Singleton.ClassVar : ' + IntToHex(IntPtr(@TSingleton.ClassVar), 8) 44 | + #10+ ' Instance.GetInstanceVar : ' + IntToStr(TSingleton.Instance.GetInstanceVar) 45 | + #10+ ' Global : ' + IntToStr(Global) 46 | ); 47 | 48 | PrintMsg_Pkg2R('PrintMsg_Pkg2R'); 49 | end; 50 | 51 | 52 | 53 | procedure PrintMsg_Pkg2R(const Msg: string); 54 | begin 55 | ShowMessage( 56 | #10+ Msg 57 | + #10 58 | + #10+ 'PrintMsg_Pkg2R: ' 59 | + #10+ ' Module: ' + IntToHex(UIntPtr(HInstance), 8) // Retrieve the module handle and convert to hex 60 | + #10 61 | + #10+ 'TSingleton : ' 62 | + #10+ ' @TSingleton.Instance: ' + IntToHex(NativeInt(Pointer(TSingleton.Instance)), 8) 63 | + #10+ ' @Singleton.ClassVar : ' + IntToHex(IntPtr(@TSingleton.ClassVar), 8) 64 | + #10+ ' Instance.GetInstanceVar : ' + IntToHex(IntPtr(TSingleton.Instance.GetInstanceVar), 8) 65 | + #10+ ' Global : ' + IntToStr(Global) 66 | ); 67 | end; 68 | 69 | 70 | 71 | 72 | 73 | {-----------------------------------------------------------------------} 74 | initialization 75 | begin 76 | //TSingleton.Instance.Print('uTest2_R.Initialization. '); // This should print 7, but it may create a new instance and print nothing (0) 77 | end; 78 | 79 | finalization 80 | begin 81 | end; 82 | {-----------------------------------------------------------------------} 83 | 84 | end. 85 | 86 | 87 | -------------------------------------------------------------------------------- /Out Parameters/FormDemo.dfm: -------------------------------------------------------------------------------- 1 | object frmTest: TfrmTest 2 | AlignWithMargins = True 3 | Left = 0 4 | Top = 0 5 | Caption = 'Test OUT parameter' 6 | ClientHeight = 301 7 | ClientWidth = 381 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'Tahoma' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object Panel1: TPanel 18 | Left = 0 19 | Top = 260 20 | Width = 381 21 | Height = 41 22 | Align = alBottom 23 | BevelOuter = bvNone 24 | TabOrder = 0 25 | object btnTestRec: TButton 26 | AlignWithMargins = True 27 | Left = 274 28 | Top = 3 29 | Width = 104 30 | Height = 35 31 | Align = alRight 32 | Caption = 'Test record' 33 | TabOrder = 0 34 | OnClick = btnTestRecClick 35 | end 36 | object btnTestStr: TButton 37 | AlignWithMargins = True 38 | Left = 164 39 | Top = 3 40 | Width = 104 41 | Height = 35 42 | Align = alRight 43 | Caption = 'Test string' 44 | TabOrder = 1 45 | OnClick = btnTestStrClick 46 | end 47 | object btnTestInt: TButton 48 | AlignWithMargins = True 49 | Left = 54 50 | Top = 3 51 | Width = 104 52 | Height = 35 53 | Align = alRight 54 | Caption = 'Test integer' 55 | TabOrder = 2 56 | OnClick = btnTestIntClick 57 | end 58 | end 59 | object Memo: TMemo 60 | Left = 0 61 | Top = 0 62 | Width = 381 63 | Height = 260 64 | Align = alClient 65 | Lines.Strings = ( 66 | 'Memo') 67 | TabOrder = 1 68 | end 69 | end 70 | -------------------------------------------------------------------------------- /Out Parameters/FormDemo.pas: -------------------------------------------------------------------------------- 1 | unit FormDemo; 2 | 3 | {------------------------------------------------------------------------------------------------------------- 4 | This program demonstrates: 5 | How to deep copy a record that has managed fields (for example dynamic arrays) 6 | -------------------------------------------------------------------------------------------------------------} 7 | 8 | INTERFACE 9 | 10 | USES 11 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 12 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls; 13 | 14 | TYPE 15 | TfrmTest = class(TForm) 16 | Panel1: TPanel; 17 | btnTestRec: TButton; 18 | btnTestStr: TButton; 19 | btnTestInt: TButton; 20 | Memo: TMemo; 21 | procedure btnTestRecClick (Sender: TObject); 22 | procedure btnTestStrClick(Sender: TObject); 23 | procedure btnTestIntClick(Sender: TObject); 24 | private 25 | public 26 | end; 27 | 28 | VAR 29 | frmTest: TfrmTest; 30 | 31 | implementation {$R *.dfm} 32 | 33 | 34 | 35 | {------------------------------------------------------------------------------------------------------------- 36 | 37 | -------------------------------------------------------------------------------------------------------------} 38 | 39 | 40 | TYPE TMyRec = record 41 | i: Integer; 42 | end; 43 | 44 | 45 | Procedure TestInteger(OUT i: Integer); 46 | Begin 47 | End; 48 | 49 | 50 | Procedure TestRec(OUT R: TMyRec); 51 | Begin 52 | End; 53 | 54 | 55 | Procedure TestStr(OUT S: string); 56 | Begin 57 | End; 58 | 59 | 60 | 61 | procedure TfrmTest.btnTestRecClick(Sender: TObject); 62 | begin 63 | VAR MyRecord: TMyRec; 64 | MyRecord.i:= 7; 65 | TestRec(MyRecord); 66 | Memo.Lines.Add('Test rec: '+ IntToStr(MyRecord.i)); 67 | end; 68 | 69 | 70 | procedure TfrmTest.btnTestStrClick(Sender: TObject); 71 | begin 72 | VAR s: string:= 'x'; 73 | TestStr(s); 74 | Memo.Lines.Add('Test str: '+ s); 75 | end; 76 | 77 | 78 | procedure TfrmTest.btnTestIntClick(Sender: TObject); 79 | begin 80 | VAR i: Integer:= 7; 81 | TestInteger(i); 82 | Memo.Lines.Add('Test int: '+ IntToStr(i)); 83 | end; 84 | 85 | 86 | end. 87 | 88 | 89 | { 90 | Procedure TestList(OUT tsl: TStringList); 91 | Begin 92 | tsl.Add('x'); 93 | End; 94 | 95 | 96 | procedure TfrmTest.btnTestClick(Sender: TObject); 97 | begin 98 | VAR tsl:= TStringList.Create; 99 | TestList(tsl); 100 | Caption:= tsl.Text; 101 | 102 | VAR i: Integer; 103 | TestInteger(i); 104 | end; 105 | } 106 | 107 | 108 | -------------------------------------------------------------------------------- /Out Parameters/OutParameters.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Out Parameters/OutParameters.res -------------------------------------------------------------------------------- /Out Parameters/Project_CopyRecords.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Out Parameters/Project_CopyRecords.res -------------------------------------------------------------------------------- /Out Parameters/Project_OutParameters.dpr: -------------------------------------------------------------------------------- 1 | program Project_OutParameters; 2 | 3 | uses 4 | Vcl.Forms, 5 | FormDemo in 'FormDemo.pas' {frmTest}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TfrmTest, frmTest); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Out Parameters/Project_OutParameters.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Out Parameters/Project_OutParameters.res -------------------------------------------------------------------------------- /Packages - Initialization test/TestRegPackage.dpk: -------------------------------------------------------------------------------- 1 | package TestRegPackage; 2 | 3 | 4 | 5 | {$R *.res} 6 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 7 | {$ALIGN 8} 8 | {$ASSERTIONS ON} 9 | {$BOOLEVAL OFF} 10 | {$DEBUGINFO OFF} 11 | {$EXTENDEDSYNTAX ON} 12 | {$IMPORTEDDATA ON} 13 | {$IOCHECKS ON} 14 | {$LOCALSYMBOLS ON} 15 | {$LONGSTRINGS ON} 16 | {$OPENSTRINGS ON} 17 | {$OPTIMIZATION OFF} 18 | {$OVERFLOWCHECKS ON} 19 | {$RANGECHECKS ON} 20 | {$REFERENCEINFO ON} 21 | {$SAFEDIVIDE OFF} 22 | {$STACKFRAMES ON} 23 | {$TYPEDADDRESS OFF} 24 | {$VARSTRINGCHECKS ON} 25 | {$WRITEABLECONST OFF} 26 | {$MINENUMSIZE 1} 27 | {$IMAGEBASE $400000} 28 | {$DEFINE DEBUG} 29 | {$ENDIF IMPLICITBUILDING} 30 | {$IMPLICITBUILD ON} 31 | 32 | requires 33 | vcl, 34 | rtl; 35 | 36 | contains 37 | TestRegister in 'TestRegister.pas'; 38 | 39 | end. 40 | -------------------------------------------------------------------------------- /Packages - Initialization test/TestRegister.pas: -------------------------------------------------------------------------------- 1 | unit TestRegister; 2 | 3 | interface 4 | 5 | procedure Register; 6 | 7 | implementation 8 | 9 | uses 10 | System.SysUtils, System.Classes, System.IOUtils, Vcl.Controls, Vcl.Forms; 11 | 12 | procedure LogMessage(const Msg: string); 13 | var 14 | LogFile: TextFile; 15 | TempPath: string; 16 | LogFileName: string; 17 | begin 18 | TempPath := TPath.GetTempPath; 19 | LogFileName := TempPath + 'RegisterLog.txt'; 20 | 21 | AssignFile(LogFile, LogFileName); 22 | if FileExists(LogFileName) then 23 | Append(LogFile) 24 | else 25 | Rewrite(LogFile); 26 | try 27 | Writeln(LogFile, Msg); 28 | finally 29 | CloseFile(LogFile); 30 | end; 31 | end; 32 | 33 | procedure Register; 34 | begin 35 | LogMessage('Register procedure called.'); 36 | end; 37 | 38 | initialization 39 | LogMessage('Initialization section called.'); 40 | 41 | end. 42 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Code examples 2 | for the "[Delphi, in all its glory](https://GabrielMoraru.com/publications-citations/)" book (2023). 3 | Get the book in printed or electronic format. 4 | -------------------------------------------------------------------------------- /Record field alignment/FormDemo.dfm: -------------------------------------------------------------------------------- 1 | object frmFieldAlign: TfrmFieldAlign 2 | AlignWithMargins = True 3 | Left = 0 4 | Top = 0 5 | Caption = 'Test records' 6 | ClientHeight = 211 7 | ClientWidth = 621 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'Tahoma' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | OnCreate = FormCreate 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | object mmoRec1: TMemo 19 | AlignWithMargins = True 20 | Left = 3 21 | Top = 3 22 | Width = 615 23 | Height = 164 24 | Align = alClient 25 | TabOrder = 0 26 | end 27 | object Panel1: TPanel 28 | Left = 0 29 | Top = 170 30 | Width = 621 31 | Height = 41 32 | Align = alBottom 33 | BevelOuter = bvNone 34 | TabOrder = 1 35 | object btnSizeOf: TButton 36 | AlignWithMargins = True 37 | Left = 512 38 | Top = 3 39 | Width = 106 40 | Height = 35 41 | Align = alRight 42 | Caption = 'Test record size' 43 | TabOrder = 0 44 | WordWrap = True 45 | OnClick = btnSizeOfClick 46 | end 47 | end 48 | end 49 | -------------------------------------------------------------------------------- /Record field alignment/FormDemo.pas: -------------------------------------------------------------------------------- 1 | unit FormDemo; 2 | 3 | {------------------------------------------------------------------------------------------------------------- 4 | This program demonstrates: 5 | Record field alignment 6 | -------------------------------------------------------------------------------------------------------------} 7 | 8 | INTERFACE 9 | 10 | USES 11 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 12 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls; 13 | 14 | TYPE 15 | TDynArray = array of byte; // Size at compile time: undeterminate 16 | TStatArray = array [0..0] of Byte; // Size: 1 byte 17 | 18 | TYPE 19 | TfrmFieldAlign = class(TForm) 20 | mmoRec1 : TMemo; 21 | Panel1 : TPanel; 22 | btnSizeOf : TButton; 23 | procedure FormCreate (Sender: TObject); 24 | procedure btnSizeOfClick (Sender: TObject); 25 | public 26 | end; 27 | 28 | VAR 29 | frmFieldAlign: TfrmFieldAlign; 30 | 31 | implementation {$R *.dfm} 32 | 33 | 34 | 35 | 36 | {------------------------------------------------------------------------------------------------------------- 37 | Test Record field alignment 38 | -------------------------------------------------------------------------------------------------------------} 39 | procedure TfrmFieldAlign.FormCreate(Sender: TObject); 40 | begin 41 | btnSizeOfClick(Sender); 42 | end; 43 | 44 | 45 | procedure TfrmFieldAlign.btnSizeOfClick(Sender: TObject); 46 | TYPE 47 | // It is recommended to put all your 4-byte fields at the top of the record and the other fields at the bottom. 48 | TUnpackedRec= record // 20 bytes 49 | i: Integer; 50 | s: string; 51 | StatArray: TStatArray; 52 | DynArray: TDynArray; 53 | B: Boolean; // The compiler will automatically add three empty bytes to make this boolean 4-byte long (alignment to 32 bit boundary). 54 | end; 55 | 56 | // Different data layout will result in different boundry alignment 57 | TRevertedRec= record // 16 bytes 58 | i: Integer; 59 | s: string; 60 | DynArray: TDynArray; 61 | StatArray: TStatArray; 62 | B: Boolean; 63 | end; 64 | 65 | // This will reflect the real size. Always use packed when saving records to disk or sharing data between applications. 66 | TPackedRec= packed record //14 bytes 67 | i: Integer; // 4 bytes (real size) 68 | s: string; // 4 bytes (real size) 69 | StatArray: TStatArray; // 1 bytes (real size) 70 | DynArray: TDynArray; // 4 bytes (real size) 71 | B: Boolean; // 1 byte (real size) 72 | end; 73 | 74 | VAR 75 | UnpRec: TUnpackedRec; 76 | RevRec: TRevertedRec; 77 | PckRec: TPackedRec; 78 | begin 79 | mmoRec1.Lines.Add(''); 80 | mmoRec1.Lines.Add('Size of UnpRec is: '+ IntToStr(SizeOf(UnpRec))); 81 | mmoRec1.Lines.Add('Size of RevRec is: '+ IntToStr(SizeOf(RevRec))); 82 | mmoRec1.Lines.Add('Size of PckRec is: '+ IntToStr(SizeOf(PckRec))); 83 | end; 84 | 85 | 86 | end. 87 | 88 | -------------------------------------------------------------------------------- /Record field alignment/Project_FieldAlignment.dpr: -------------------------------------------------------------------------------- 1 | program Project_FieldAlignment; 2 | 3 | uses 4 | Vcl.Forms, 5 | FormDemo in 'FormDemo.pas' {frmFieldAlign}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TfrmFieldAlign, frmFieldAlign); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Records - Deep copy records/FormDemo.dfm: -------------------------------------------------------------------------------- 1 | object frmCopyRecords: TfrmCopyRecords 2 | AlignWithMargins = True 3 | Left = 0 4 | Top = 0 5 | Caption = 'Test records' 6 | ClientHeight = 211 7 | ClientWidth = 621 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'Tahoma' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | OnCreate = FormCreate 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | object Label1: TLabel 19 | Left = 0 20 | Top = 0 21 | Width = 621 22 | Height = 13 23 | Align = alTop 24 | Alignment = taCenter 25 | Caption = 26 | 'This is Record1 (initialized with small no) ' + 27 | ' This is Record2 (initialized with big no)' 28 | end 29 | object mmoRec1: TMemo 30 | AlignWithMargins = True 31 | Left = 3 32 | Top = 16 33 | Width = 305 34 | Height = 151 35 | Align = alLeft 36 | TabOrder = 0 37 | end 38 | object mmoRec2: TMemo 39 | AlignWithMargins = True 40 | Left = 314 41 | Top = 16 42 | Width = 305 43 | Height = 151 44 | Align = alLeft 45 | TabOrder = 1 46 | end 47 | object Panel1: TPanel 48 | Left = 0 49 | Top = 170 50 | Width = 621 51 | Height = 41 52 | Align = alBottom 53 | BevelOuter = bvNone 54 | TabOrder = 2 55 | object btnChange: TButton 56 | AlignWithMargins = True 57 | Left = 165 58 | Top = 3 59 | Width = 75 60 | Height = 35 61 | Align = alLeft 62 | Caption = 'Change R2' 63 | Enabled = False 64 | TabOrder = 0 65 | OnClick = btnChangeClick 66 | end 67 | object btnCopy: TButton 68 | AlignWithMargins = True 69 | Left = 84 70 | Top = 3 71 | Width = 75 72 | Height = 35 73 | Align = alLeft 74 | Caption = 'R2:= R1' 75 | TabOrder = 1 76 | OnClick = btnCopyClick 77 | end 78 | object chkDeepCopy: TCheckBox 79 | AlignWithMargins = True 80 | Left = 246 81 | Top = 3 82 | Width = 126 83 | Height = 35 84 | Hint = 'Make all fields of R2 unique' 85 | Align = alLeft 86 | Caption = 'Make unique fields' 87 | Enabled = False 88 | TabOrder = 2 89 | OnClick = chkDeepCopyClick 90 | end 91 | object btnInitR1: TButton 92 | AlignWithMargins = True 93 | Left = 3 94 | Top = 3 95 | Width = 75 96 | Height = 35 97 | Align = alLeft 98 | Caption = 'Init R1' 99 | TabOrder = 3 100 | OnClick = btnInitR1Click 101 | end 102 | object btnPointers: TButton 103 | AlignWithMargins = True 104 | Left = 543 105 | Top = 3 106 | Width = 75 107 | Height = 35 108 | Align = alRight 109 | Caption = 'Pointers' 110 | TabOrder = 4 111 | OnClick = btnPointersClick 112 | end 113 | end 114 | end 115 | -------------------------------------------------------------------------------- /Records - Deep copy records/Project_CopyRecords.dpr: -------------------------------------------------------------------------------- 1 | program Project_CopyRecords; 2 | 3 | uses 4 | Vcl.Forms, 5 | FormDemo in 'FormDemo.pas' {frmCopyRecords}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TfrmCopyRecords, frmCopyRecords); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Records - Deep copy records/Project_CopyRecords.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Records - Deep copy records/Project_CopyRecords.res -------------------------------------------------------------------------------- /Required package/Package1.dpk: -------------------------------------------------------------------------------- 1 | package Package1; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS ON} 17 | {$RANGECHECKS ON} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$IMPLICITBUILD ON} 29 | 30 | requires 31 | rtl, 32 | vcl; 33 | 34 | contains 35 | Unit1 in 'Unit1.pas'; 36 | 37 | end. 38 | -------------------------------------------------------------------------------- /Required package/Package1.dproj: -------------------------------------------------------------------------------- 1 | <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> 2 | <PropertyGroup> 3 | <Base>True</Base> 4 | <AppType>Package</AppType> 5 | <Config Condition="'$(Config)'==''">Debug</Config> 6 | <FrameworkType>None</FrameworkType> 7 | <MainSource>Package1.dpk</MainSource> 8 | <Platform Condition="'$(Platform)'==''">Win32</Platform> 9 | <ProjectGuid>{8204C261-0A18-46D4-A331-9AAED30720AC}</ProjectGuid> 10 | <ProjectVersion>19.5</ProjectVersion> 11 | <TargetedPlatforms>1</TargetedPlatforms> 12 | </PropertyGroup> 13 | <PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''"> 14 | <Base>true</Base> 15 | </PropertyGroup> 16 | <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''"> 17 | <Base_Win32>true</Base_Win32> 18 | <CfgParent>Base</CfgParent> 19 | <Base>true</Base> 20 | </PropertyGroup> 21 | <PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''"> 22 | <Cfg_1>true</Cfg_1> 23 | <CfgParent>Base</CfgParent> 24 | <Base>true</Base> 25 | </PropertyGroup> 26 | <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''"> 27 | <Cfg_1_Win32>true</Cfg_1_Win32> 28 | <CfgParent>Cfg_1</CfgParent> 29 | <Cfg_1>true</Cfg_1> 30 | <Base>true</Base> 31 | </PropertyGroup> 32 | <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''"> 33 | <Cfg_2>true</Cfg_2> 34 | <CfgParent>Base</CfgParent> 35 | <Base>true</Base> 36 | </PropertyGroup> 37 | <PropertyGroup Condition="'$(Base)'!=''"> 38 | <SanitizedProjectName>Package1</SanitizedProjectName> 39 | <DCC_CBuilderOutput>All</DCC_CBuilderOutput> 40 | <DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput> 41 | <DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput> 42 | <DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace> 43 | <GenDll>true</GenDll> 44 | <GenPackage>true</GenPackage> 45 | </PropertyGroup> 46 | <PropertyGroup Condition="'$(Base_Win32)'!=''"> 47 | <BT_BuildType>Debug</BT_BuildType> 48 | <DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace> 49 | <DCC_UsePackage>vcl;rtl;$(DCC_UsePackage)</DCC_UsePackage> 50 | </PropertyGroup> 51 | <PropertyGroup Condition="'$(Cfg_1)'!=''"> 52 | <DCC_DebugDCUs>true</DCC_DebugDCUs> 53 | <DCC_DebugInfoInExe>true</DCC_DebugInfoInExe> 54 | <DCC_Define>DEBUG;$(DCC_Define)</DCC_Define> 55 | <DCC_GenerateStackFrames>true</DCC_GenerateStackFrames> 56 | <DCC_IntegerOverflowCheck>true</DCC_IntegerOverflowCheck> 57 | <DCC_Optimize>false</DCC_Optimize> 58 | <DCC_RangeChecking>true</DCC_RangeChecking> 59 | <DCC_RemoteDebug>true</DCC_RemoteDebug> 60 | </PropertyGroup> 61 | <PropertyGroup Condition="'$(Cfg_1_Win32)'!=''"> 62 | <DCC_RemoteDebug>false</DCC_RemoteDebug> 63 | </PropertyGroup> 64 | <PropertyGroup Condition="'$(Cfg_2)'!=''"> 65 | <DCC_DebugInformation>0</DCC_DebugInformation> 66 | <DCC_Define>RELEASE;$(DCC_Define)</DCC_Define> 67 | <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols> 68 | <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo> 69 | </PropertyGroup> 70 | <ItemGroup> 71 | <DelphiCompile Include="$(MainSource)"> 72 | <MainSource>MainSource</MainSource> 73 | </DelphiCompile> 74 | <DCCReference Include="rtl.dcp"/> 75 | <DCCReference Include="vcl.dcp"/> 76 | <DCCReference Include="Unit1.pas"/> 77 | <BuildConfiguration Include="Base"> 78 | <Key>Base</Key> 79 | </BuildConfiguration> 80 | <BuildConfiguration Include="Debug"> 81 | <Key>Cfg_1</Key> 82 | <CfgParent>Base</CfgParent> 83 | </BuildConfiguration> 84 | <BuildConfiguration Include="Release"> 85 | <Key>Cfg_2</Key> 86 | <CfgParent>Base</CfgParent> 87 | </BuildConfiguration> 88 | </ItemGroup> 89 | <ProjectExtensions> 90 | <Borland.Personality>Delphi.Personality.12</Borland.Personality> 91 | <Borland.ProjectType>Package</Borland.ProjectType> 92 | <BorlandProject> 93 | <Delphi.Personality> 94 | <Source> 95 | <Source Name="MainSource">Package1.dpk</Source> 96 | </Source> 97 | </Delphi.Personality> 98 | <Platforms> 99 | <Platform value="Win32">True</Platform> 100 | <Platform value="Win64">False</Platform> 101 | </Platforms> 102 | </BorlandProject> 103 | <ProjectFileVersion>12</ProjectFileVersion> 104 | </ProjectExtensions> 105 | <Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/> 106 | <Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/> 107 | <Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/> 108 | </Project> 109 | -------------------------------------------------------------------------------- /Required package/Package1.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Required package/Package1.res -------------------------------------------------------------------------------- /Required package/Package2.dpk: -------------------------------------------------------------------------------- 1 | package Package2; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS ON} 17 | {$RANGECHECKS ON} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$IMPLICITBUILD ON} 29 | 30 | requires 31 | rtl, 32 | vcl, 33 | Package1; 34 | 35 | contains 36 | Unit2 in 'Unit2.pas'; 37 | 38 | end. 39 | -------------------------------------------------------------------------------- /Required package/Package2.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Required package/Package2.res -------------------------------------------------------------------------------- /Required package/ProjectGroup.groupproj: -------------------------------------------------------------------------------- 1 | <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> 2 | <PropertyGroup> 3 | <ProjectGuid>{4FBB3478-B718-4254-97CF-539277CAC313}</ProjectGuid> 4 | </PropertyGroup> 5 | <ItemGroup> 6 | <Projects Include="Package1.dproj"> 7 | <Dependencies/> 8 | </Projects> 9 | <Projects Include="Package2.dproj"> 10 | <Dependencies/> 11 | </Projects> 12 | </ItemGroup> 13 | <ProjectExtensions> 14 | <Borland.Personality>Default.Personality.12</Borland.Personality> 15 | <Borland.ProjectType/> 16 | <BorlandProject> 17 | <Default.Personality/> 18 | </BorlandProject> 19 | </ProjectExtensions> 20 | <Target Name="Package1"> 21 | <MSBuild Projects="Package1.dproj"/> 22 | </Target> 23 | <Target Name="Package1:Clean"> 24 | <MSBuild Projects="Package1.dproj" Targets="Clean"/> 25 | </Target> 26 | <Target Name="Package1:Make"> 27 | <MSBuild Projects="Package1.dproj" Targets="Make"/> 28 | </Target> 29 | <Target Name="Package2"> 30 | <MSBuild Projects="Package2.dproj"/> 31 | </Target> 32 | <Target Name="Package2:Clean"> 33 | <MSBuild Projects="Package2.dproj" Targets="Clean"/> 34 | </Target> 35 | <Target Name="Package2:Make"> 36 | <MSBuild Projects="Package2.dproj" Targets="Make"/> 37 | </Target> 38 | <Target Name="Build"> 39 | <CallTarget Targets="Package1;Package2"/> 40 | </Target> 41 | <Target Name="Clean"> 42 | <CallTarget Targets="Package1:Clean;Package2:Clean"/> 43 | </Target> 44 | <Target Name="Make"> 45 | <CallTarget Targets="Package1:Make;Package2:Make"/> 46 | </Target> 47 | <Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/> 48 | </Project> 49 | -------------------------------------------------------------------------------- /Required package/Unit1.pas: -------------------------------------------------------------------------------- 1 | unit Unit1; 2 | 3 | interface 4 | uses Vcl.Forms; 5 | 6 | implementation 7 | 8 | procedure MyProcedure(); 9 | begin 10 | var Form:= TForm.Create(nil); 11 | Form.Free; 12 | end; 13 | 14 | end. 15 | -------------------------------------------------------------------------------- /Required package/Unit2.pas: -------------------------------------------------------------------------------- 1 | unit Unit2; 2 | 3 | interface 4 | uses Unit1; 5 | 6 | implementation 7 | 8 | end. 9 | -------------------------------------------------------------------------------- /Show VCL inheritance tree/Project_InheritanceTree.dpr: -------------------------------------------------------------------------------- 1 | program Project_InheritanceTree; 2 | 3 | uses 4 | fastmm4, 5 | madExcept, 6 | madLinkDisAsm, 7 | madListHardware, 8 | madListProcesses, 9 | madListModules, 10 | Forms, 11 | TesterForm in 'TesterForm.pas' {frmTester}, 12 | cShortcutConflictLister in '..\..\Packages\LightSaber\cShortcutConflictLister.pas', 13 | cVclUtils in '..\..\Packages\LightSaber\cVclUtils.pas'; 14 | 15 | {$R *.res} 16 | 17 | begin 18 | Application.Initialize; 19 | Application.MainFormOnTaskbar := True; { If true, a taskbar button represents the application's main form and displays its caption. All child forms will stay on top of the MainForm (bad)! If False, a taskbar button represents the application's (hidden) main window and bears the application's Title. Must be True to use Windows (Vista) Aero effects (ive taskbar thumbnails, Dynamic Windows, Windows Flip, Windows Flip 3D). https://stackoverflow.com/questions/66720721/ } 20 | Application.CreateForm(TfrmTester, frmTester); 21 | frmTester.Show; 22 | Application.Run; 23 | end. 24 | -------------------------------------------------------------------------------- /Show VCL inheritance tree/TesterForm.pas: -------------------------------------------------------------------------------- 1 | UNIT TesterForm; 2 | 3 | INTERFACE 4 | 5 | USES 6 | WinApi.Windows, WinApi.Messages, System.SysUtils, System.Classes, Vcl.StdCtrls, VCL.Forms, vcl.Menus, VCL.Controls, Vcl.Samples.Spin, Vcl.ActnList, 7 | cvRichEdit, Vcl.ComCtrls, Vcl.StdActns, System.Actions, Vcl.ExtCtrls, Vcl.Imaging.jpeg; 8 | 9 | CONST 10 | MSG_LateFormInit= WM_APP + 4711; 11 | 12 | TYPE 13 | TfrmTester = class(TForm) 14 | btnStart: TButton; 15 | MainMenu: TMainMenu; 16 | mnuFile: TMenuItem; 17 | mnuCopy: TMenuItem; 18 | mnuCut: TMenuItem; 19 | mnuDelete: TMenuItem; 20 | mnuPaste: TMenuItem; 21 | mnuSelectAll: TMenuItem; 22 | mnuUndo: TMenuItem; 23 | lboxMain: TListBox; 24 | Timer: TTimer; 25 | CheckBox1: TCheckBox; 26 | DemoImage: TImage; 27 | procedure FormCreate(Sender: TObject); 28 | procedure TimerTimer(Sender: TObject); 29 | protected 30 | private 31 | procedure LateInitialize(VAR Msg: TMessage); message MSG_LateFormInit; // Called after the main form was fully created 32 | public 33 | end; 34 | 35 | VAR 36 | frmTester: TfrmTester; 37 | 38 | IMPLEMENTATION {$R *.dfm} 39 | 40 | USES cmVclUtils; 41 | 42 | 43 | 44 | 45 | 46 | 47 | {-------------------------------------------------------------------------------------------------- 48 | APP START/CLOSE 49 | --------------------------------------------------------------------------------------------------} 50 | procedure TfrmTester.FormCreate(Sender: TObject); 51 | begin 52 | 53 | end; 54 | 55 | 56 | procedure TfrmTester.LateInitialize; 57 | begin 58 | end; 59 | 60 | 61 | procedure TfrmTester.TimerTimer(Sender: TObject); 62 | VAR 63 | Control: TControl; 64 | begin 65 | //GetCursorPos(P); 66 | Control:= cmVclUtils.FindControlAtPos(Mouse.CursorPos); // Note FindVCLWindow could be used also, but it doesn't search disabled controls (Enabled=False). 67 | if Control <> NIL then 68 | begin 69 | Caption:= IntToStr(Mouse.CursorPos.X)+ ' '+ IntToStr(Mouse.CursorPos.Y)+ ' '+ Control.Name; 70 | lboxMain.Items.Text:= 'Name: '+ Control.Name+ #13#10+ ShowInheritanceTree(Control); 71 | end; 72 | end; 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | end. 92 | -------------------------------------------------------------------------------- /Show VCL inheritance tree/cVclUtils.lnk: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Show VCL inheritance tree/cVclUtils.lnk -------------------------------------------------------------------------------- /Speed comparison/Julia massively outperforms Delphi. Obsolete asm code by Delphi compiler - Stack Overflow.URL: -------------------------------------------------------------------------------- 1 | [InternetShortcut] 2 | URL=https://stackoverflow.com/questions/75201947/julia-massively-outperforms-delphi-obsolete-asm-code-by-delphi-compiler 3 | IDList= 4 | HotKey=0 5 | IconFile=C:\Users\GabrielMoraru\AppData\Local\Mozilla\Firefox\Profiles\daecy5hr.default-release\shortcutCache\tNs4VLSIiRHFBsU076XS3A==.ico 6 | IconIndex=0 7 | -------------------------------------------------------------------------------- /Speed comparison/Julia_vs_Delphi.jl: -------------------------------------------------------------------------------- 1 | using BenchmarkTools 2 | println("----------- Test for loops") 3 | # test for loops 4 | function for_fun(a) 5 | total = 0 6 | big = 0 7 | small = 0 8 | for i in 1:a 9 | total += 1 10 | if i > 500000 11 | big += 1 12 | else 13 | small += 1 14 | end 15 | end 16 | 17 | return (total, small, big) 18 | end 19 | 20 | res_for = for_fun(1000000000) 21 | println(res_for) 22 | @btime for_fun(1000000000) 23 | 24 | 25 | elem_vect = 10000 26 | # test memory allocation undefined vector 27 | println("---------- Test memory undef") 28 | function mem_undef_fun(nr_elem::Int) 29 | big_vect = Vector{Vector}(undef, nr_elem) 30 | 31 | for i in 1:nr_elem 32 | big_vect[i] = Vector{Int32}(undef, nr_elem) 33 | 34 | #println("Interm vector size for loop $i is $(sizeof(big_vect))") 35 | end 36 | #println(sizeof(big_vect)) 37 | return big_vect 38 | end 39 | res_mem_undef = mem_undef_fun(elem_vect) 40 | 41 | @btime mem_undef_fun(elem_vect) 42 | println("Allocated mem by mem_undef_fun is $((@allocated mem_undef_fun(elem_vect))/1048576) Megabytes.") 43 | #println("Sizeof res_undef is $(sizeof(res_mem_undef))") 44 | #println("Length of res_undef is $(length(res_mem_undef))") 45 | 46 | # test memory allocation zeros vector 47 | println("Test memory zeros") 48 | 49 | function mem_zero_fun(nr_elem::Int) 50 | big_vect = Vector{Vector}(undef, nr_elem) 51 | 52 | for i in 1:nr_elem 53 | big_vect[i] = zeros(Int32, nr_elem) 54 | end 55 | 56 | return big_vect 57 | end 58 | res_mem_zero = mem_zero_fun(elem_vect) 59 | 60 | @btime mem_zero_fun(elem_vect) 61 | println("Allocated mem by mem_zero_fun is $((@allocated mem_zero_fun(elem_vect))/1048576) Megabytes.") 62 | #println("Sizeof res_zero is $(sizeof(res_mem_zero))") 63 | #println("Length of res_zero is $(length(res_mem_zero))") 64 | 65 | 66 | #measure fill mem 67 | #fill string with chars 68 | println("--------- Test fill string with strings") 69 | nr_char = 100000000 70 | @btime repeat('A', nr_char) 71 | println("Allocated mem is $((@allocated repeat('A', nr_char))/1048576) Megabytes.") 72 | 73 | 74 | #find shortest and longest string 75 | println("--------- Find shortest and longest string") 76 | nr_strings = 1000000 77 | 78 | #preparatory function 79 | function make_string_vect_fun(nr_strings) 80 | string_size_float = rand(nr_strings) .* (500-1) .+ 1 81 | string_size_int = Vector{Int}(undef, nr_strings) 82 | for i in 1:nr_strings 83 | string_size_int[i] = round(Int, string_size_float[i]) 84 | end 85 | 86 | string_vect = Vector{String}(undef, nr_strings) 87 | for j in 1:nr_strings 88 | string_vect[j] = repeat('A', string_size_int[j]) 89 | end 90 | 91 | return string_vect 92 | end 93 | 94 | string_vect = make_string_vect_fun(nr_strings) 95 | 96 | #find min max function 97 | function find_min_max_fun(string_vect) 98 | min_s = 1000 99 | max_s = 0 100 | for x in 1:length(string_vect) 101 | len = length(string_vect[x]) 102 | if len < min_s 103 | min_s = len 104 | elseif len > max_s 105 | max_s = len 106 | end 107 | end 108 | 109 | return (min_s, max_s) 110 | end 111 | 112 | 113 | @btime find_min_max_fun(string_vect) 114 | println(find_min_max_fun(string_vect)) -------------------------------------------------------------------------------- /Speed comparison/SpeedTest.dpr: -------------------------------------------------------------------------------- 1 | program SpeedTest; 2 | 3 | uses 4 | {$IFDEF DEBUG} 5 | FastMM4, 6 | {$ENDIF } 7 | Forms, 8 | TesterForm in 'TesterForm.pas' {frmTester}, 9 | cbAppData in '..\..\..\..\..\Packages\LightSaber\cbAppData.pas', 10 | cmDebugger in '..\..\..\..\..\Packages\LightSaber\cmDebugger.pas', 11 | FormLog in '..\..\..\..\..\Packages\LightSaber\FormLog.pas', 12 | chHardID in '..\..\..\..\..\Packages\LightSaber\chHardID.pas'; 13 | 14 | {$R *.res} 15 | 16 | begin 17 | Application.Initialize; 18 | 19 | { MainFormOnTaskbar 20 | See: stackoverflow.com/questions/66720721 21 | 22 | If true: 23 | The taskbar button represents the application's Main Form and displays its caption. 24 | 25 | Bad: All child forms will stay on top of the MainForm! 26 | But they are not modal! The MainForm can still be clicked! 27 | If we don't really want this, we should stick with MainFormOnTaskbar = false. 28 | When we do want a child form to stay on top, then can use fsStayOnTop. 29 | 30 | If False: 31 | The taskbar button represents the application's (hidden) main window and bears the application's Title. 32 | Must be True to use Windows (Vista) Aero effects (live taskbar thumbnails, Dynamic Windows, Windows Flip, Windows Flip 3D). 33 | 34 | Bad: All child forms will disapear under the MainForm! } 35 | 36 | Application.MainFormOnTaskbar := True; 37 | Application.Title := 'CubicTester'; // Set by AppData 38 | AppData:= TAppDataEx.Create('Cubic Tester Dummy'); { Absolutelly critical if you use the SaveForm/LoadForm functionality. This string will be used as the name of the INI file. } 39 | Application.CreateForm(TfrmTester, frmTester); 40 | frmTester.Show; 41 | Application.Run; 42 | end. 43 | -------------------------------------------------------------------------------- /Speed comparison/SpeedTest.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Speed comparison/SpeedTest.res -------------------------------------------------------------------------------- /Speed comparison/TesterForm.dfm: -------------------------------------------------------------------------------- 1 | object frmTester: TfrmTester 2 | Left = 450 3 | Top = 311 4 | ActiveControl = btnFindShortStr 5 | Anchors = [] 6 | Caption = 'Delphi speed test' 7 | ClientHeight = 462 8 | ClientWidth = 622 9 | Color = clBtnFace 10 | Constraints.MinHeight = 300 11 | Constraints.MinWidth = 490 12 | DoubleBuffered = True 13 | Font.Charset = ANSI_CHARSET 14 | Font.Color = clWindowText 15 | Font.Height = -13 16 | Font.Name = 'Segoe UI' 17 | Font.Style = [] 18 | OldCreateOrder = False 19 | Position = poDesigned 20 | ScreenSnap = True 21 | ShowHint = True 22 | SnapBuffer = 4 23 | OnCreate = FormCreate 24 | OnDestroy = FormDestroy 25 | PixelsPerInch = 96 26 | TextHeight = 17 27 | object pnlRight: TPanel 28 | Left = 452 29 | Top = 0 30 | Width = 170 31 | Height = 462 32 | Align = alRight 33 | BevelOuter = bvNone 34 | TabOrder = 0 35 | object btnForLoop: TButton 36 | AlignWithMargins = True 37 | Left = 3 38 | Top = 195 39 | Width = 164 40 | Height = 48 41 | Align = alBottom 42 | Caption = 'Do For Loop' 43 | TabOrder = 0 44 | OnClick = btnForLoopClick 45 | end 46 | object bntMemAlloc: TButton 47 | AlignWithMargins = True 48 | Left = 3 49 | Top = 249 50 | Width = 164 51 | Height = 48 52 | Align = alBottom 53 | Caption = 'Memory allocation' 54 | TabOrder = 1 55 | OnClick = bntMemAllocClick 56 | end 57 | object btnFillString: TButton 58 | AlignWithMargins = True 59 | Left = 3 60 | Top = 303 61 | Width = 164 62 | Height = 48 63 | Align = alBottom 64 | Caption = 'Fill each char' 65 | TabOrder = 2 66 | OnClick = btnFillStringClick 67 | end 68 | object btnFindShortStr: TButton 69 | AlignWithMargins = True 70 | Left = 3 71 | Top = 411 72 | Width = 164 73 | Height = 48 74 | Align = alBottom 75 | Caption = 'Find shortest string' 76 | Default = True 77 | TabOrder = 3 78 | OnClick = btnFindShortStrClick 79 | end 80 | object btnFillMem: TButton 81 | AlignWithMargins = True 82 | Left = 3 83 | Top = 357 84 | Width = 164 85 | Height = 48 86 | Align = alBottom 87 | Caption = 'Fill memory' 88 | TabOrder = 4 89 | OnClick = btnFillMemClick 90 | end 91 | end 92 | object mmo: TMemo 93 | AlignWithMargins = True 94 | Left = 3 95 | Top = 3 96 | Width = 446 97 | Height = 456 98 | Align = alClient 99 | TabOrder = 1 100 | end 101 | end 102 | -------------------------------------------------------------------------------- /Strings - GetBothNames/ProjectBothNames.otares: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Strings - GetBothNames/ProjectBothNames.otares -------------------------------------------------------------------------------- /Strings - GetBothNames/Project_BothNames.dpr: -------------------------------------------------------------------------------- 1 | program Project_BothNames; 2 | 3 | uses 4 | Vcl.Forms, 5 | Unit1 in 'Unit1.pas' {Form3}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TForm3, Form3); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Strings - GetBothNames/Unit1.dfm: -------------------------------------------------------------------------------- 1 | object Form3: TForm3 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form3' 5 | ClientHeight = 188 6 | ClientWidth = 375 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object Button1: TButton 17 | Left = 140 18 | Top = 80 19 | Width = 109 20 | Height = 37 21 | Caption = 'Button1' 22 | TabOrder = 0 23 | OnClick = Button1Click 24 | end 25 | end 26 | -------------------------------------------------------------------------------- /Strings - GetBothNames/Unit1.pas: -------------------------------------------------------------------------------- 1 | unit Unit1; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; 8 | 9 | type 10 | TForm3 = class(TForm) 11 | Button1: TButton; 12 | procedure Button1Click(Sender: TObject); 13 | private 14 | public 15 | end; 16 | 17 | var 18 | Form3: TForm3; 19 | 20 | implementation {$R *.dfm} 21 | 22 | procedure SplitName(FullName: string; out FirstName, FamilyName: string); 23 | var FoundAt: Integer; 24 | begin 25 | FoundAt:= Pos(' ', FullName, 1); 26 | if FoundAt > 0 27 | then 28 | begin 29 | FirstName := Copy(FullName, 1, FoundAt-1); 30 | FamilyName:= Copy(FullName, FoundAt, Length(FullName)); 31 | end 32 | else ShowMessage('Invalid name!'); 33 | end; 34 | 35 | procedure TForm3.Button1Click(Sender: TObject); 36 | var 37 | MyName: string; 38 | Name1, Name2: string; 39 | begin 40 | MyName:= 'John Lennon'; 41 | SplitName(MyName, Name1, Name2); 42 | Caption:= 'First name is: '+ Name1+ '. Last name is: '+ Name2; 43 | end; 44 | 45 | end. 46 | -------------------------------------------------------------------------------- /Strings - GetFirstName as function/Project_FirstName2.dpr: -------------------------------------------------------------------------------- 1 | program Project_FirstName2; 2 | 3 | uses 4 | Vcl.Forms, 5 | Unit1 in 'Unit1.pas' {Form3}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TForm3, Form3); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Strings - GetFirstName as function/Unit1.dfm: -------------------------------------------------------------------------------- 1 | object Form3: TForm3 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form3' 5 | ClientHeight = 188 6 | ClientWidth = 375 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object Button1: TButton 17 | Left = 130 18 | Top = 80 19 | Width = 75 20 | Height = 25 21 | Caption = 'Button1' 22 | TabOrder = 0 23 | OnClick = Button1Click 24 | end 25 | end 26 | -------------------------------------------------------------------------------- /Strings - GetFirstName as function/Unit1.pas: -------------------------------------------------------------------------------- 1 | unit Unit1; 2 | 3 | INTERFACE 4 | 5 | USES 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; 8 | 9 | TYPE 10 | TForm3 = class(TForm) 11 | Button1: TButton; 12 | procedure Button1Click(Sender: TObject); 13 | private 14 | public 15 | end; 16 | 17 | var 18 | Form3: TForm3; 19 | 20 | implementation {$R *.dfm} 21 | 22 | 23 | function GetFirstName(FullName: string): string; 24 | var FoundAt: Integer; 25 | begin 26 | FoundAt:= Pos(' ', FullName, 1); 27 | if FoundAt > 0 28 | then Result:= Copy(FullName, 1, FoundAt-1) 29 | else ShowMessage('Invalid name!'); 30 | end; 31 | 32 | 33 | procedure TForm3.Button1Click(Sender: TObject); 34 | var 35 | MyName: string; 36 | begin 37 | MyName:= 'John Lennon'; 38 | Caption:= 'First name is: '+ GetFirstName(MyName); 39 | end; 40 | 41 | end. 42 | -------------------------------------------------------------------------------- /Strings - GetFirstName/Project_FirstName.dpr: -------------------------------------------------------------------------------- 1 | program Project_FirstName; 2 | 3 | uses 4 | Vcl.Forms, 5 | Unit1 in 'Unit1.pas'; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TForm3, Form3); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Strings - GetFirstName/Unit1.dfm: -------------------------------------------------------------------------------- 1 | object Form3: TForm3 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form3' 5 | ClientHeight = 188 6 | ClientWidth = 375 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object Button1: TButton 17 | Left = 130 18 | Top = 80 19 | Width = 75 20 | Height = 25 21 | Caption = 'Button1' 22 | TabOrder = 0 23 | OnClick = Button1Click 24 | end 25 | end 26 | -------------------------------------------------------------------------------- /Strings - GetFirstName/Unit1.pas: -------------------------------------------------------------------------------- 1 | unit Unit1; 2 | 3 | {------------------------------------------------------------------------------------------------------------- 4 | This program demonstrates: 5 | Passing string as var (by reference) 6 | -------------------------------------------------------------------------------------------------------------} 7 | 8 | 9 | INTERFACE 10 | 11 | USES 12 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 13 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; 14 | 15 | TYPE 16 | TForm3 = class(TForm) 17 | Button1: TButton; 18 | procedure Button1Click(Sender: TObject); 19 | private 20 | public 21 | end; 22 | 23 | var 24 | Form3: TForm3; 25 | 26 | implementation {$R *.dfm} 27 | 28 | 29 | procedure GetFirstName(var FullName: string); 30 | var 31 | FoundAt: Integer; 32 | begin 33 | FoundAt:= Pos(' ', FullName, 1); 34 | if FoundAt > 0 35 | then FullName:= Copy(FullName, 1, FoundAt-1) 36 | else ShowMessage('Invalid name!'); 37 | end; 38 | 39 | 40 | procedure TForm3.Button1Click(Sender: TObject); 41 | var 42 | MyName: string; 43 | begin 44 | MyName:= 'John Lennon'; 45 | GetFirstName(MyName); 46 | Caption:= 'First name is: '+ MyName; 47 | end; 48 | 49 | end. 50 | -------------------------------------------------------------------------------- /Strings - Null terminator/MainForm.dfm: -------------------------------------------------------------------------------- 1 | object Form10: TForm10 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form10' 5 | ClientHeight = 442 6 | ClientWidth = 628 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -12 11 | Font.Name = 'Segoe UI' 12 | Font.Style = [] 13 | OnCreate = FormCreate 14 | TextHeight = 15 15 | end 16 | -------------------------------------------------------------------------------- /Strings - Null terminator/MainForm.pas: -------------------------------------------------------------------------------- 1 | unit MainForm; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs; 8 | 9 | type 10 | TForm10 = class(TForm) 11 | procedure FormCreate(Sender: TObject); 12 | private 13 | public 14 | end; 15 | 16 | var 17 | Form10: TForm10; 18 | 19 | implementation 20 | 21 | {$R *.dfm} 22 | 23 | {$R-} 24 | procedure TForm10.FormCreate(Sender: TObject); 25 | var s: String; 26 | p: PByte; 27 | begin 28 | { 1. Testing for #0 at the end of the string } 29 | 30 | // Make sure the memory was not occupied accidentally by zeroes 31 | s:= 'ABBBBBBB'; 32 | s:= 'A'; // Its ASCII code is 65 33 | Caption:= IntToStr(Ord(s[1])); // 65 34 | Caption:= IntToStr(Ord(s[2])); // #0 35 | Caption:= IntToStr(Ord(s[3])); // Random data 36 | 37 | 38 | { 2. Testing for length counter at the begining of the string } 39 | s:= 'XYZ'; 40 | p := PByte(s); // Get the pointer to the string buffer 41 | 42 | // This is the first character ('X') 43 | Caption := IntToStr(p[0]); 44 | 45 | // Accessing the length counter 46 | Caption := IntToStr(p[-1]); // 0 47 | Caption := IntToStr(p[-2]); // 0 48 | Caption := IntToStr(p[-3]); // 0 49 | Caption := IntToStr(p[-4]); // 3 50 | Assert(p[-4] = Length(s)); // It is the same 51 | end; 52 | 53 | end. 54 | -------------------------------------------------------------------------------- /Strings - Null terminator/Test.dpr: -------------------------------------------------------------------------------- 1 | program Test; 2 | 3 | uses 4 | Vcl.Forms, 5 | MainForm in 'MainForm.pas' {Form10}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TForm10, Form10); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Strings - Null terminator/Test.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GabrielOnDelphi/Delphi-in-all-its-glory-Demo-Code/bc8707b20a340f084168df06be43fb07e31dc236/Strings - Null terminator/Test.res -------------------------------------------------------------------------------- /Test rounding numbers/FormRounding.dfm: -------------------------------------------------------------------------------- 1 | object frmMine2: TfrmMine2 2 | Left = 0 3 | Top = 0 4 | Caption = 'frmMine2' 5 | ClientHeight = 383 6 | ClientWidth = 752 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object Button1: TButton 17 | Left = 271 18 | Top = 82 19 | Width = 180 20 | Height = 71 21 | Caption = 'Start' 22 | TabOrder = 0 23 | OnClick = Button1Click 24 | end 25 | end 26 | -------------------------------------------------------------------------------- /Test rounding numbers/FormRounding.pas: -------------------------------------------------------------------------------- 1 | unit FormRounding; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Menus, Vcl.ComCtrls; 8 | 9 | type 10 | TfrmMine2 = class(TForm) 11 | Button1: TButton; 12 | procedure Button1Click(Sender: TObject); 13 | private 14 | public 15 | end; 16 | 17 | var 18 | frmMine2: TfrmMine2; 19 | 20 | implementation {$R *.dfm} 21 | 22 | 23 | 24 | 25 | 26 | 27 | procedure TfrmMine2.Button1Click(Sender: TObject); 28 | var 29 | S, T: string; 30 | begin 31 | Str(1.4:2:1, T); 32 | S := T + ' rounds to ' + IntToStr(Round(1.4)) + #13#10; 33 | Str(1.5:2:1, T); 34 | S := S + T + ' rounds to ' + IntToStr(Round(1.5)) + #13#10; 35 | Str(-1.4:2:1, T); 36 | S := S + #13#10; 37 | 38 | S := S + T + ' rounds to ' + IntToStr(Round(-1.4)) + #13#10; 39 | Str(-1.5:2:1, T); 40 | S := S + T + ' rounds to ' + IntToStr(Round(-1.5))+ #13#10; 41 | 42 | S := S + #13#10; 43 | 44 | Str(2.5:2:1, T); 45 | S := S + T + ' rounds to ' + IntToStr(Round(2.5)) + #13#10; 46 | 47 | Str(3.5:2:1, T); 48 | S := S + T + ' rounds to ' + IntToStr(Round(3.5)) + #13#10; 49 | 50 | MessageDlg(S, mtInformation, [mbOk], 0, mbOk); 51 | end; 52 | 53 | 54 | end. 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | -------------------------------------------------------------------------------- /Test rounding numbers/Project_Rounding.dpr: -------------------------------------------------------------------------------- 1 | program Project_Rounding; 2 | 3 | uses 4 | Vcl.Forms, 5 | FormRounding in 'FormRounding.pas' {frmMine2}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TfrmMine2, frmMine2); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Virtual keyboard/FormKeyboard.dfm: -------------------------------------------------------------------------------- 1 | object FormKeyb: TFormKeyb 2 | Left = 0 3 | Top = 0 4 | Caption = 'Virtual keyboard' 5 | ClientHeight = 203 6 | ClientWidth = 308 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object FlowPanel: TFlowPanel 17 | AlignWithMargins = True 18 | Left = 3 19 | Top = 3 20 | Width = 302 21 | Height = 174 22 | Align = alClient 23 | TabOrder = 0 24 | object Button1: TButton 25 | Left = 1 26 | Top = 1 27 | Width = 96 28 | Height = 42 29 | Caption = '1' 30 | TabOrder = 0 31 | OnClick = ClickedButton 32 | end 33 | object Button2: TButton 34 | Left = 97 35 | Top = 1 36 | Width = 96 37 | Height = 42 38 | Caption = '2' 39 | TabOrder = 1 40 | OnClick = ClickedButton 41 | end 42 | object Button3: TButton 43 | Left = 193 44 | Top = 1 45 | Width = 96 46 | Height = 42 47 | Caption = '3' 48 | TabOrder = 2 49 | OnClick = ClickedButton 50 | end 51 | object Button4: TButton 52 | Left = 1 53 | Top = 43 54 | Width = 96 55 | Height = 42 56 | Caption = '4' 57 | TabOrder = 3 58 | OnClick = ClickedButton 59 | end 60 | object Button5: TButton 61 | Left = 97 62 | Top = 43 63 | Width = 96 64 | Height = 42 65 | Caption = '5' 66 | TabOrder = 4 67 | OnClick = ClickedButton 68 | end 69 | object Button6: TButton 70 | Left = 193 71 | Top = 43 72 | Width = 96 73 | Height = 42 74 | Caption = '6' 75 | TabOrder = 5 76 | OnClick = ClickedButton 77 | end 78 | object Button7: TButton 79 | Left = 1 80 | Top = 85 81 | Width = 96 82 | Height = 42 83 | Caption = '7' 84 | TabOrder = 6 85 | OnClick = ClickedButton 86 | end 87 | object Button8: TButton 88 | Left = 97 89 | Top = 85 90 | Width = 96 91 | Height = 42 92 | Caption = '8' 93 | TabOrder = 7 94 | OnClick = ClickedButton 95 | end 96 | object Button9: TButton 97 | Left = 193 98 | Top = 85 99 | Width = 96 100 | Height = 42 101 | Caption = '9' 102 | TabOrder = 8 103 | OnClick = ClickedButton 104 | end 105 | object Button0: TButton 106 | Left = 1 107 | Top = 127 108 | Width = 96 109 | Height = 42 110 | Caption = '0' 111 | TabOrder = 9 112 | OnClick = ClickedButton 113 | end 114 | end 115 | object CheckBox1: TCheckBox 116 | AlignWithMargins = True 117 | Left = 3 118 | Top = 183 119 | Width = 302 120 | Height = 17 121 | Align = alBottom 122 | Caption = 'Check box' 123 | TabOrder = 1 124 | OnClick = ClickedButton 125 | end 126 | end 127 | -------------------------------------------------------------------------------- /Virtual keyboard/FormKeyboard.pas: -------------------------------------------------------------------------------- 1 | unit FormKeyboard; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Menus, Vcl.ComCtrls, Vcl.ExtCtrls; 8 | 9 | type 10 | TFormKeyb = class(TForm) 11 | FlowPanel: TFlowPanel; 12 | Button1: TButton; 13 | Button2: TButton; 14 | Button3: TButton; 15 | Button4: TButton; 16 | Button5: TButton; 17 | Button6: TButton; 18 | Button7: TButton; 19 | Button8: TButton; 20 | Button9: TButton; 21 | Button0: TButton; 22 | CheckBox1: TCheckBox; 23 | procedure ClickedButton(Sender: TObject); 24 | private 25 | public 26 | end; 27 | 28 | TYPE 29 | TCristina = class(TObject) 30 | Suparata: Boolean; 31 | end; 32 | 33 | var 34 | FormKeyb: TFormKeyb; 35 | 36 | implementation {$R *.dfm} 37 | 38 | 39 | 40 | 41 | 42 | 43 | procedure TFormKeyb.ClickedButton(Sender: TObject); 44 | begin 45 | if Sender is TButton // Does the click originates from a button? 46 | then Caption:= 'You pressed button '+ (Sender as TButton).Caption 47 | else 48 | // Bonus code 49 | if Sender is TCheckBox // Does the click originates from a checkbox? 50 | then Caption:= 'You click the checkbox.'; 51 | end; 52 | 53 | 54 | 55 | 56 | 57 | end. 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | -------------------------------------------------------------------------------- /Virtual keyboard/Project_VirtualKeyb.dpr: -------------------------------------------------------------------------------- 1 | program Project_VirtualKeyb; 2 | 3 | uses 4 | Vcl.Forms, 5 | FormKeyboard in 'FormKeyboard.pas' {FormKeyb}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | 12 | { MainFormOnTaskbar 13 | See: stackoverflow.com/questions/66720721 14 | 15 | If true: 16 | The taskbar button represents the application's Main Form and displays its caption. 17 | 18 | Bad: All child forms will stay on top of the MainForm! 19 | But they are not modal! The MainForm can still be clicked! 20 | If we don't really want this, we should stick with MainFormOnTaskbar = false. 21 | When we do want a child form to stay on top, then can use fsStayOnTop. 22 | 23 | If False: 24 | The taskbar button represents the application's (hidden) main window and bears the application's Title. 25 | Must be True to use Windows (Vista) Aero effects (live taskbar thumbnails, Dynamic Windows, Windows Flip, Windows Flip 3D). 26 | 27 | Bad: All child forms will disapear under the MainForm! } 28 | 29 | Application.MainFormOnTaskbar := True; 30 | Application.CreateForm(TFormKeyb, FormKeyb); 31 | Application.Run; 32 | end. 33 | -------------------------------------------------------------------------------- /_Scrips & tools/CleanDisabledPkg.cmd: -------------------------------------------------------------------------------- 1 | 2 | Echo Take the packages out from "Disabled" 3 | SET REG_IDE_VERSION=22.0 4 | SET DisabledKey=HKEY_CURRENT_USER\Software\Embarcadero\BDS\%REG_IDE_VERSION%\Disabled Packages 5 | 6 | Rem Which package? 7 | SET BPLPATH=c:\MyProjects\MyLibraries\LightSaber.bpl 8 | 9 | Rem Delete 10 | REG delete "%DisabledKey%" /v "%BplPath%" /f 11 | -------------------------------------------------------------------------------- /_Scrips & tools/Install_LightSaber_package.cmd: -------------------------------------------------------------------------------- 1 | @prompt $ 2 | @echo off 3 | echo --------------------------------------- 4 | echo Installing BPLs into the IDE 5 | echo --------------------------------------- 6 | echo. 7 | 8 | SET REG_IDE_VERSION=22.0 9 | echo Detect Delphi installation folder 10 | CALL whereIsDelphi.cmd Alex 11 | CALL "%DelphiPath%\bin\rsvars.bat" 12 | echo. 13 | 14 | call CleanDisabledPkg.cmd 15 | 16 | rem Set the key where we should install the packages 17 | SET BPLREG=HKEY_CURRENT_USER\Software\Embarcadero\BDS\%REG_IDE_VERSION%\Known Packages 18 | 19 | rem Which package? 20 | SET BPLPATH=c:\MyProjects\MyLibraries 21 | SET PackageBplName=LightSaber.bpl 22 | 23 | ECHO Package to be installed to %BPLREG% 24 | ECHO Package file is: %BPLPATH%\%PackageBplName% 25 | 26 | rem Delete that package first, to prevent duplication 27 | rem The delete operation will fail if the package is not already installed. This is normal. We don't show this to the user, therefore we output the messages to the nul console 28 | REG delete "%BPLREG%" /v "%BPLPATH%\%PackageBplName%" /f >nul 2>&1 29 | REG add "%BPLREG%" /v "%BPLPATH%\%PackageBplName%" /t REG_SZ /d "TeeChart Standard 2018 Designtime" 30 | echo. 31 | 32 | call UpdateEnvironment.cmd -------------------------------------------------------------------------------- /_Scrips & tools/UpdateEnvironment.cmd: -------------------------------------------------------------------------------- 1 | echo --------------------------------------------- 2 | echo Updating the environment 3 | echo This forces Delphi to see the changes we have done to the registry 4 | echo --------------------------------------------- 5 | 6 | rem Force update enviroment 7 | ECHO Updating the IDE for Delphi %REG_IDE_VERSION% 8 | SET GlobalsREG=HKEY_CURRENT_USER\Software\Embarcadero\BDS\%REG_IDE_VERSION%\Globals 9 | 10 | REG delete "%GlobalsREG%" /v "ForceEnvOptionsUpdate" /f >nul 2>&1 11 | REG add "%GlobalsREG%" /v "ForceEnvOptionsUpdate" /t REG_SZ /d "1" 12 | echo. 13 | -------------------------------------------------------------------------------- /_Scrips & tools/Update_NDK.cmd: -------------------------------------------------------------------------------- 1 | rem cd "c:\Delphi\Delphi 11\CatalogRepository\AndroidSDK-2525-22.0.48361.3236\cmdline-tools\latest\bin\" 2 | prompt $g 3 | echo off 4 | cls 5 | echo. 6 | echo. 7 | echo This tool: 8 | echo * Checks the Java version and Java_Home env var. 9 | echo * Updates the SDK 10 | echo www.GabrielMoraru.com 11 | echo More details in my new book "Delphi in all its gloty [Part 4]" 12 | echo. 13 | echo. 14 | 15 | echo _____________________________ 16 | echo JAVA_HOME VAR IS SET TO: 17 | echo %JAVA_HOME% 18 | echo _____________________________ 19 | echo. 20 | echo. 21 | 22 | 23 | java -version 24 | echo. 25 | echo. 26 | echo. 27 | 28 | call sdkmanager.bat --list --verbose > List.txt 29 | echo Open List.txt and choose the NDK you want to install. Replace its version in the command below. 30 | pause 31 | 32 | echo INSTALL NDK 33 | echo This has 3-4GB so it will take a while... 34 | call sdkmanager.bat --verbose --install "ndk;22.0.7026061" 35 | 36 | echo. 37 | echo. 38 | echo. 39 | pause 40 | 41 | -------------------------------------------------------------------------------- /_Scrips & tools/Update_SDK.cmd: -------------------------------------------------------------------------------- 1 | prompt $g 2 | echo off 3 | cls 4 | echo. 5 | echo. 6 | echo This tool: 7 | echo * Checks the Java version and Java_Home env var. 8 | echo * Updates the SDK 9 | echo www.GabrielMoraru.com 10 | echo More details in my new book "Delphi in all its gloty [Part 4]" 11 | echo. 12 | echo. 13 | 14 | echo _____________________________ 15 | echo JAVA_HOME VAR IS SET TO: 16 | echo %JAVA_HOME% 17 | echo _____________________________ 18 | echo. 19 | echo. 20 | 21 | 22 | java -version 23 | echo. 24 | echo. 25 | echo. 26 | 27 | 28 | echo LIST 29 | call sdkmanager.bat --list --verbose 30 | echo. 31 | echo. 32 | echo. 33 | pause 34 | 35 | echo UPDATE 36 | call sdkmanager.bat --update --verbose 37 | echo. 38 | echo. 39 | echo. 40 | pause 41 | 42 | echo INSTALL PLATFORMS 1 43 | call sdkmanager.bat --verbose --install "platforms;android-32" 44 | 45 | echo INSTALL PLATFORMS 2 (in case the first one fails) 46 | call sdkmanager.bat "platform-tools" "platforms;android-32" 47 | echo. 48 | echo. 49 | echo. 50 | pause 51 | 52 | 53 | echo INSTALL BILDS 54 | call sdkmanager.bat --verbose --install "build-tools;32.0.0" 55 | echo. 56 | echo. 57 | echo. 58 | echo DONE 59 | pause 60 | 61 | -------------------------------------------------------------------------------- /_Scrips & tools/WhereIsDelphi.cmd: -------------------------------------------------------------------------------- 1 | @prompt $ 2 | @echo off 3 | @REM Sets the DelphiPath variable to the correct disk path based on the Delphi "name" passed as parameter 4 | @REM Call it like this: CALL WhereIsDelphi.cmd Alex 5 | 6 | setlocal 7 | 8 | rem DelphiVersion is provided via command line 9 | set DelphiVersion=%1 10 | 11 | rem Support for Windows 64 Bit 12 | set ProgFiles=%ProgramFiles(x86)% 13 | if not "%ProgFiles%"=="" goto Win64Bit 14 | set ProgFiles=%ProgramFiles% 15 | :Win64Bit 16 | 17 | set DelphiPath= 18 | 19 | rem This is equivalent to a case/switch statement 20 | rem Call :Delphi%DelphiVersion% resolves into call :Delphi6 etc. 21 | call :Delphi%DelphiVersion% 22 | goto EndDelphiDetection 23 | 24 | :Delphi6 25 | call :ReadReg Borland\Delphi\6.0 26 | goto :eof 27 | 28 | :Delphi7 29 | call :ReadReg Borland\Delphi\7.0 30 | goto :eof 31 | 32 | :Delphi2005 33 | call :ReadReg Borland\BDS\3.0 34 | goto :eof 35 | 36 | :Delphi2006 37 | call :ReadReg Borland\BDS\4.0 38 | goto :eof 39 | 40 | :Delphi2007 41 | call :ReadReg Borland\BDS\5.0 42 | goto :eof 43 | 44 | :Delphi2009 45 | call :ReadReg CodeGear\BDS\6.0 46 | goto :eof 47 | 48 | :Delphi2010 49 | call :ReadReg CodeGear\BDS\7.0 50 | goto :eof 51 | 52 | :DelphiXE 53 | call :ReadReg Embarcadero\BDS\8.0 54 | goto :eof 55 | 56 | :DelphiXE2 57 | call :ReadReg Embarcadero\BDS\9.0 58 | goto :eof 59 | 60 | :DelphiXE3 61 | call :ReadReg Embarcadero\BDS\10.0 62 | goto :eof 63 | 64 | :DelphiXE4 65 | call :ReadReg Embarcadero\BDS\11.0 66 | goto :eof 67 | 68 | :DelphiXE5 69 | call :ReadReg Embarcadero\BDS\12.0 70 | goto :eof 71 | 72 | :DelphiXE6 73 | call :ReadReg Embarcadero\BDS\14.0 74 | goto :eof 75 | 76 | :DelphiXE7 77 | call :ReadReg Embarcadero\BDS\15.0 78 | goto :eof 79 | 80 | :DelphiSydney 81 | call :ReadReg Embarcadero\BDS\21.0 82 | goto :eof 83 | 84 | :DelphiAlex 85 | call :ReadReg Embarcadero\BDS\22.0 86 | goto :eof 87 | 88 | :Delphi12 89 | call :ReadReg Embarcadero\BDS\23.0 90 | goto :eof 91 | 92 | :Delphi13 93 | call :ReadReg Embarcadero\BDS\24.0 94 | goto :eof 95 | 96 | :EndDelphiDetection 97 | 98 | 99 | 100 | if exist "%DelphiPath%" goto StatusOK 101 | echo *** Error: Directory "%DelphiPath%" does not exist!*** 102 | pause 103 | goto :eof 104 | 105 | :StatusOK 106 | endlocal & set DelphiPath=%DelphiPath% 107 | echo DelphiPath: "%DelphiPath%" 108 | goto :eof 109 | 110 | :ReadReg 111 | rem Read the registry entry 112 | set DelphiPath= 113 | FOR /F "usebackq skip=2 tokens=3,*" %%A IN (`REG QUERY HKCU\Software\%1 /v RootDir 2^>nul`) DO ( 114 | set DelphiPath=%%A %%B 115 | ) 116 | rem Remove one trailing space which might have been added because %%B was empty 117 | rem Remove any quotes 118 | set DelphiPath=%DelphiPath:"=% 119 | 120 | rem Add quotes 121 | set DelphiPath="%DelphiPath%" 122 | 123 | rem Remove space before the closing quote 124 | set DelphiPath=%DelphiPath: "="% 125 | 126 | rem Remove any quotes 127 | set DelphiPath=%DelphiPath:"=% 128 | 129 | goto :eof --------------------------------------------------------------------------------