├── .github ├── FUNDING.yml ├── dependabot.yml └── workflows │ └── build.yml ├── .gitignore ├── .vscode └── settings.json ├── Makefile ├── README.md ├── README_install.adoc ├── README_pdf.adoc ├── README_russian.md ├── README_ukrainian.md ├── cge_www_header.adoc ├── code-samples ├── Makefile ├── anon_functions_assignment_test.dpr ├── anon_functions_list_map_foreach.dpr ├── anon_functions_list_map_foreach.dproj ├── anonymous_functions.dpr ├── anonymous_functions.dproj ├── anotherunit.pas ├── array_of_const.dpr ├── array_of_const.dproj ├── callbacks.dpr ├── callbacks_of_object.dpr ├── class_properties.dpr ├── delphi_and_fpc_differences │ └── compare_function_pointers.dpr ├── exception_finally.dpr ├── exception_in_constructor_test.dpr ├── experiments_that_dont_compile │ ├── callback_from_generic_function.dpr │ ├── callback_from_generic_function.dproj │ ├── callback_from_generic_method.dpr │ └── callback_from_generic_method.dproj ├── file_stream.dpr ├── file_stream.dproj ├── for_in_list.dpr ├── functions_primitives.dpr ├── gen_guid.dpr ├── generic_functions.dpr ├── generics.dpr ├── generics_dictionary.dpr ├── generics_lists.dpr ├── generics_lists.dproj ├── generics_object_dictionary.dpr ├── generics_sorting.dpr ├── generics_sorting.dproj ├── hello_world.dpr ├── hello_world.dproj ├── inheritance.dpr ├── inheritance.dproj ├── initialization_finalization.pas ├── interface_casting.dpr ├── interfaces_com_test.dpr ├── interfaces_com_test.dproj ├── interfaces_com_test_comments.txt ├── interfaces_com_with_ref_counting.dpr ├── interfaces_corba_test.dpr ├── is_as.dpr ├── lazarus │ ├── showcolor.dpr │ └── showcolor.lpi ├── loops.dpr ├── loops.dproj ├── method_calls_inheritance_1.dpr ├── method_calls_inherited.dpr ├── method_with_self_nil.dpr ├── myconfig.inc ├── myunit.pas ├── myunit_test.dpr ├── operator_overloading.dpr ├── operator_overloading_class_operator.dpr ├── operator_overloading_class_operator.dproj ├── operator_overloading_classes.dpr ├── operator_overloading_classes.dproj ├── operator_overloading_records.dpr ├── operator_overloading_records.dproj ├── operator_overloading_records_lists.dpr ├── persistent.dpr ├── records.dpr ├── records.dproj ├── static_class_method.dpr ├── static_class_method.dproj ├── test_myconfig.dpr ├── variant_in_record.dpr ├── variant_types.dpr ├── variant_types.dproj ├── with_virtual_methods.dpr ├── with_virtual_methods.dproj └── without_virtual_methods.dpr ├── code-samples_bg ├── Makefile ├── anotherunit.pas ├── exception_in_constructor_test.dpr ├── for_in_list.dpr ├── functions_primitives.dpr ├── generics_dictionary.dpr ├── hello_world.dpr ├── interface_casting.dpr ├── interfaces_com_with_ref_counting.dpr ├── is_as.dpr ├── loops.dpr ├── myconfig.inc ├── myunit.pas ├── myunit_test.dpr ├── persistent.dpr ├── test_myconfig.dpr ├── with_virtual_methods.dpr └── without_virtual_methods.dpr ├── code-samples_russian ├── .gitignore ├── Makefile ├── anotherunit.pas ├── exception_finally.dpr ├── exception_in_constructor_test.dpr ├── file_stream.dpr ├── for_in_list.dpr ├── functions_primitives.dpr ├── generic_functions.dpr ├── generics.dpr ├── hello_world.dpr ├── inheritance.dpr ├── interface_casting.dpr ├── interfaces_com_test.dpr ├── interfaces_com_test_comments.txt ├── interfaces_com_with_ref_counting.dpr ├── interfaces_corba_test.dpr ├── is_as.dpr ├── lazarus │ ├── showcolor.dpr │ └── showcolor.lpi ├── loops.dpr ├── myconfig.inc ├── myunit.pas ├── myunit_test.dpr ├── operator_overloading.dpr ├── persistent.dpr ├── records.dpr └── test_myconfig.dpr ├── code-samples_ukrainian ├── .gitignore ├── Makefile ├── anotherunit.pas ├── callbacks.dpr ├── callbacks_of_object.dpr ├── class_properties.dpr ├── exception_finally.dpr ├── exception_in_constructor_test.dpr ├── file_stream.dpr ├── for_in_list.dpr ├── functions_primitives.dpr ├── gen_guid.dpr ├── generic_functions.dpr ├── generics.dpr ├── generics_dictionary.dpr ├── generics_lists.dpr ├── generics_object_dictionary.dpr ├── generics_sorting.dpr ├── hello_world.dpr ├── inheritance.dpr ├── initialization_finalization.pas ├── interface_casting.dpr ├── interfaces_com_test.dpr ├── interfaces_com_test_comments.txt ├── interfaces_com_with_ref_counting.dpr ├── interfaces_corba_test.dpr ├── is_as.dpr ├── lazarus │ ├── showcolor.dpr │ └── showcolor.lpi ├── loops.dpr ├── method_calls_inheritance_1.dpr ├── method_calls_inherited.dpr ├── myconfig.inc ├── myunit.pas ├── myunit_test.dpr ├── operator_overloading.dpr ├── operator_overloading_classes.dpr ├── operator_overloading_records.dpr ├── operator_overloading_records_lists.dpr ├── persistent.dpr ├── records.dpr ├── static_class_method.dpr ├── test_myconfig.dpr ├── with_virtual_methods.dpr └── without_virtual_methods.dpr ├── docinfo-footer.html ├── locale ├── AUTHORS.txt ├── attributes-ar.adoc ├── attributes-bg.adoc ├── attributes-ca.adoc ├── attributes-cs.adoc ├── attributes-da.adoc ├── attributes-de.adoc ├── attributes-en.adoc ├── attributes-es.adoc ├── attributes-fa.adoc ├── attributes-fi.adoc ├── attributes-fr.adoc ├── attributes-hu.adoc ├── attributes-id.adoc ├── attributes-it.adoc ├── attributes-ja.adoc ├── attributes-kr.adoc ├── attributes-nb.adoc ├── attributes-nl.adoc ├── attributes-nn.adoc ├── attributes-pl.adoc ├── attributes-pt.adoc ├── attributes-pt_BR.adoc ├── attributes-ro.adoc ├── attributes-ru.adoc ├── attributes-sr.adoc ├── attributes-sr_Latn.adoc ├── attributes-sv.adoc ├── attributes-tr.adoc ├── attributes-uk.adoc ├── attributes-zh_CN.adoc ├── attributes-zh_TW.adoc └── attributes.adoc ├── modern_pascal_introduction.adoc ├── modern_pascal_introduction_bg.adoc ├── modern_pascal_introduction_chinese.pdf ├── modern_pascal_introduction_russian.adoc ├── modern_pascal_introduction_ukrainian.adoc ├── patreon-link-insert.dpr ├── patreon-link.css ├── patreon-link.html └── patreon-wordmark.png /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | github: [castle-engine, michaliskambi] # Replace with up to 4 GitHub Sponsors-enabled usernames e.g., [user1, user2] 4 | patreon: castleengine # Replace with a single Patreon username 5 | open_collective: castle-engine # Replace with a single Open Collective username 6 | # ko_fi: # Replace with a single Ko-fi username 7 | # tidelift: # Replace with a single Tidelift platform-name/package-name e.g., npm/babel 8 | # community_bridge: # Replace with a single Community Bridge project-name e.g., cloud-foundry 9 | # liberapay: # Replace with a single Liberapay username 10 | # issuehunt: # Replace with a single IssueHunt username 11 | # otechie: # Replace with a single Otechie username 12 | # custom: # Replace with up to 4 custom sponsorship URLs e.g., ['link1', 'link2'] 13 | -------------------------------------------------------------------------------- /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | # Check that GitHub Actions use latest versions of plugins. 2 | # See https://docs.github.com/en/code-security/dependabot/working-with-dependabot/keeping-your-actions-up-to-date-with-dependabot . 3 | 4 | version: 2 5 | updates: 6 | # Maintain dependencies for GitHub Actions 7 | - package-ecosystem: "github-actions" 8 | directory: "/" 9 | schedule: 10 | interval: "weekly" 11 | -------------------------------------------------------------------------------- /.github/workflows/build.yml: -------------------------------------------------------------------------------- 1 | # ---------------------------------------------------------------------------- 2 | # GitHub Actions workflow to test building all code samples. 3 | # 4 | # See docs: 5 | # - https://castle-engine.io/github_actions 6 | # - https://docs.github.com/en/actions 7 | # ---------------------------------------------------------------------------- 8 | 9 | name: Test Code Samples 10 | 11 | on: [push, pull_request] 12 | 13 | # Necessary to have && working in Windows jobs 14 | defaults: 15 | run: 16 | shell: bash 17 | 18 | jobs: 19 | build-using-docker: 20 | name: Test Code Samples with FPC 3.3.1 21 | runs-on: ubuntu-latest 22 | # Using FPC 3.3.1, as some examples (anonymous functions, some generics) 23 | # require it, FPC 3.2.0 is not enough. 24 | container: kambi/castle-engine-cloud-builds-tools:cge-none-fpc331 25 | steps: 26 | - uses: actions/checkout@v4 27 | - run: cd code-samples/ && make 28 | 29 | delphi_test: 30 | name: Delphi 31 | strategy: 32 | matrix: 33 | host-label: [ 34 | delphi_12 35 | ] 36 | runs-on: ${{ matrix.host-label }} 37 | steps: 38 | - uses: actions/checkout@v4 39 | - name: Delphi Build (Win32) 40 | run: cd code-samples/ && make all-delphi-win32 41 | - name: Delphi Build (Win64) 42 | run: cd code-samples/ && make all-delphi-win64 43 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | patreon-link-insert 3 | patreon-link-insert.exe 4 | patreon-link-insert.o 5 | modern_pascal_introduction.html 6 | modern_pascal_introduction.pdf 7 | modern_pascal_introduction.xml 8 | modern_pascal_introduction_russian.html 9 | modern_pascal_introduction_russian.pdf 10 | modern_pascal_introduction_russian.xml 11 | modern_pascal_introduction_bg.html 12 | modern_pascal_introduction_bg.pdf 13 | modern_pascal_introduction_bg.xml 14 | modern_pascal_introduction_ukrainian.html 15 | modern_pascal_introduction_ukrainian.pdf 16 | modern_pascal_introduction_ukrainian.xml 17 | 18 | # Ignore temp output inside code_samples. 19 | # Use code-samples* to match code samples in all languages. 20 | /code-samples*/*.ppu 21 | /code-samples*/*.dcu 22 | /code-samples*/*.o 23 | /code-samples*/*.exe 24 | /code-samples*/lazarus/*.bak 25 | /code-samples*/lazarus/*.lps 26 | /code-samples*/lazarus/lib/ 27 | /code-samples*/*.dproj.local 28 | /code-samples*/*.res 29 | /code-samples*/*.identcache 30 | /code-samples*/__recovery 31 | /code-samples*/delphi_and_fpc_differences/*.o 32 | /code-samples*/delphi_and_fpc_differences/*.exe 33 | 34 | # Ignore Unix binaries (no extension to detect them nicer) inside code_samples. 35 | /code-samples*/anonymous_functions 36 | /code-samples*/array_of_const 37 | /code-samples*/anon_functions_list_map_foreach 38 | /code-samples*/anon_functions_assignment_test 39 | /code-samples*/callbacks 40 | /code-samples*/callbacks_of_object 41 | /code-samples*/class_properties 42 | /code-samples*/exception_finally 43 | /code-samples*/exception_in_constructor_test 44 | /code-samples*/file_stream 45 | /code-samples*/for_in_list 46 | /code-samples*/functions_primitives 47 | /code-samples*/gen_guid 48 | /code-samples*/generic_functions 49 | /code-samples*/generics 50 | /code-samples*/generics_dictionary 51 | /code-samples*/generics_lists 52 | /code-samples*/generics_object_dictionary 53 | /code-samples*/generics_sorting 54 | /code-samples*/hello_world 55 | /code-samples*/inheritance 56 | /code-samples*/interface_casting 57 | /code-samples*/interfaces_com_test 58 | /code-samples*/interfaces_com_with_ref_counting 59 | /code-samples*/interfaces_corba_test 60 | /code-samples*/is_as 61 | /code-samples*/lazarus/showcolor 62 | /code-samples*/loops 63 | /code-samples*/method_calls_inheritance_1 64 | /code-samples*/method_calls_inherited 65 | /code-samples*/my_binary_file.data 66 | /code-samples*/myunit_test 67 | /code-samples*/operator_overloading 68 | /code-samples*/operator_overloading_classes 69 | /code-samples*/operator_overloading_records 70 | /code-samples*/operator_overloading_records_lists 71 | /code-samples*/persistent 72 | /code-samples*/records 73 | /code-samples*/static_class_method 74 | /code-samples*/variant_in_record 75 | /code-samples*/variant_types 76 | /code-samples*/with_virtual_methods 77 | /code-samples*/without_virtual_methods 78 | /code-samples*/method_with_self_nil 79 | /code-samples*/operator_overloading_class_operator 80 | /code-samples*/test_myconfig 81 | /code-samples*/delphi_and_fpc_differences/compare_function_pointers 82 | -------------------------------------------------------------------------------- /.vscode/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "asciidoc.antora.enableAntoraSupport": false, 3 | "cSpell.enabled": true, 4 | "cSpell.words": [ 5 | "adoc", 6 | "advancedrecords", 7 | "anonymousfunctions", 8 | "anotherunit", 9 | "apptype", 10 | "ASCIIDOCTOR", 11 | "cdecl", 12 | "coderay", 13 | "Contnrs", 14 | "corba", 15 | "deallocates", 16 | "deallocation", 17 | "docbook", 18 | "docinfo", 19 | "downto", 20 | "dylib", 21 | "execdir", 22 | "fopub", 23 | "FpJsonRtti", 24 | "functionreferences", 25 | "htdocs", 26 | "ifdef", 27 | "ifndef", 28 | "Kamburelis", 29 | "logcat", 30 | "Michalis", 31 | "modeswitch", 32 | "MSWINDOWS", 33 | "myconfig", 34 | "myprogram", 35 | "myunit", 36 | "nestedprocvars", 37 | "noimages", 38 | "objfpc", 39 | "objpas", 40 | "Readln", 41 | "RTTI", 42 | "scopedenums", 43 | "sectnums", 44 | "showcolor", 45 | "sprintf", 46 | "TFPG", 47 | "TMyInts", 48 | "toclevels", 49 | "typecasted", 50 | "Unported", 51 | "unversioned", 52 | "uuidgen", 53 | "wordmark", 54 | "Writeln", 55 | "XPCOM" 56 | ] 57 | } -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # Customize LANGUAGE_SUFFIX and ASCIIDOCTOR_LANGUAGE for non-English languages. 2 | # See the "copy-all" below for examples how to use them. 3 | # 4 | # Suffix added to input and output filenames. 5 | LANGUAGE_SUFFIX:= 6 | # Language parameters to AsciiDoctor, see https://asciidoctor.org/docs/user-manual/#language-support 7 | ASCIIDOCTOR_LANGUAGE:= 8 | 9 | NAME:=modern_pascal_introduction$(LANGUAGE_SUFFIX) 10 | ALL_OUTPUT:=$(NAME).html $(NAME).pdf $(NAME).xml 11 | #TEST_BROWSER:=firefox 12 | TEST_BROWSER:=x-www-browser 13 | 14 | all: $(ALL_OUTPUT) 15 | 16 | $(NAME).html: $(NAME).adoc 17 | asciidoctor $< -o $@ 18 | fpc -gl -gh patreon-link-insert.dpr 19 | ./patreon-link-insert $@ 20 | $(TEST_BROWSER) $@ & 21 | 22 | $(NAME).xml: $(NAME).adoc 23 | asciidoctor $(ASCIIDOCTOR_LANGUAGE) -b docbook5 $< -o $@ 24 | # yelp $@ 25 | 26 | $(NAME).pdf: $(NAME).xml 27 | fopub $(NAME).xml 28 | 29 | # $(NAME).pdf: $(NAME).adoc 30 | # asciidoctor-pdf $(NAME).adoc 31 | 32 | .PHONY: clean 33 | clean: 34 | rm -f $(ALL_OUTPUT) 35 | 36 | .PHONY: test 37 | test: 38 | $(MAKE) -C code-samples$(LANGUAGE_SUFFIX)/ clean all 39 | 40 | # Utilities to update on server ------------------------------------------------ 41 | # 42 | # Update cge-www contents assuming they are in $CASTLE_ENGINE_PATH/../cge-www/ . 43 | # 44 | # The full sequence to do update: 45 | # - make update-cge-www 46 | # - commit and push cge-www repo, 47 | # - www_synchronize_noimages.sh on sever. 48 | 49 | # Variables (adjust CGE_WWW_PATH if it's not in the default location). 50 | CGE_WWW_PATH:=$(CASTLE_ENGINE_PATH)/../cge-www/ 51 | CGE_ADOC_PATH:=$(CGE_WWW_PATH)/htdocs/doc/modern_pascal.adoc 52 | CGE_SAMPLES_PATH:=$(CGE_WWW_PATH)/htdocs/doc/modern_pascal_code_samples/ 53 | 54 | # Copy from here to cge-www one language version. 55 | .PHONY: copy-one-language 56 | copy-one-language: test clean all 57 | cp -f $(NAME).html $(NAME).pdf patreon-wordmark.png $(CGE_WWW_PATH)htdocs/ 58 | 59 | # Copy from here to cge-www all languages' versions. 60 | .PHONY: copy-all 61 | copy-all: 62 | $(MAKE) copy-one-language 63 | $(MAKE) copy-one-language LANGUAGE_SUFFIX=_russian ASCIIDOCTOR_LANGUAGE='-a lang=ru' 64 | $(MAKE) copy-one-language LANGUAGE_SUFFIX=_bg ASCIIDOCTOR_LANGUAGE='-a lang=bg' 65 | $(MAKE) copy-one-language LANGUAGE_SUFFIX=_ukrainian ASCIIDOCTOR_LANGUAGE='-a lang=ua' 66 | cp -f modern_pascal_introduction_chinese.pdf $(CGE_WWW_PATH)htdocs/ 67 | 68 | # Copy from here to cge-www everything: HTML and PDF generated by AsciiDoctor, 69 | # adoc (for rendering with CGE website styles), and code samples. 70 | .PHONY: update-cge-www 71 | update-cge-www: copy-all 72 | # Sanity check. 73 | if [ ! -f $(CGE_ADOC_PATH) ]; then \ 74 | echo "Missing $(CGE_ADOC_PATH), make sure CASTLE_ENGINE_PATH env variable is OK and cge-www is cloned alongside"; \ 75 | exit 1; \ 76 | fi 77 | 78 | # Copy and adjust adoc file. 79 | # 80 | # We version the $(CGE_ADOC_PATH).1,2,3... to 81 | # - allow easy debugging what script did (look at each file in succession) 82 | # - not worry that tail would have equal stdin and stdout. 83 | cp -f modern_pascal_introduction.adoc $(CGE_ADOC_PATH).1 84 | tail --lines=+9 $(CGE_ADOC_PATH).1 > $(CGE_ADOC_PATH).2 85 | cat cge_www_header.adoc $(CGE_ADOC_PATH).2 > $(CGE_ADOC_PATH).3 86 | sed -e 's|include::code-samples/|include::modern_pascal_code_samples/|' $(CGE_ADOC_PATH).3 > $(CGE_ADOC_PATH).4 87 | cp -f $(CGE_ADOC_PATH).4 $(CGE_ADOC_PATH) 88 | rm -f $(CGE_ADOC_PATH).? 89 | 90 | # Copy the code samples. 91 | # Avoid deleting/overwriting .gitignore there, which is maintained by hand in cge-www. 92 | find $(CGE_SAMPLES_PATH) \ 93 | '(' -type f -name .gitignore -prune ')' -or \ 94 | '(' -type f -execdir rm -f '{}' ';' ')' 95 | make -C code-samples/ clean 96 | cp -Rf code-samples/* $(CGE_SAMPLES_PATH) 97 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Modern Object Pascal Introduction for Programmers 2 | 3 | An introduction to modern Object Pascal. May be useful for programmers that already know the concepts (like "class"), but don't know how these concepts look in Object Pascal. 4 | 5 | Contains some introductory material at the beginning, and at the end quickly jumps over more advanced topics like class references. Enjoy, and share and redistribute freely! 6 | 7 | Source code is in AsciiDoc, processed by AsciiDoctor http://asciidoctor.org/ . 8 | 9 | The output is on: 10 | * https://castle-engine.io/modern_pascal_introduction.html 11 | * PDF: https://castle-engine.io/modern_pascal_introduction.pdf 12 | 13 | By Michalis Kamburelis (author of Castle Game Engine https://castle-engine.io/ ). 14 | -------------------------------------------------------------------------------- /README_install.adoc: -------------------------------------------------------------------------------- 1 | To generate the output, install: 2 | 3 | * asciidoctor, coderay (available as ready package in most Linux distros, just run `apt-get install ...`) 4 | * asciidoctor-fopub (from https://github.com/asciidoctor/asciidoctor-fopub) 5 | * follow the `README_pdf.adoc` to setup proper syntax highlighting for Pascal sources in asciidoctor-fopub. 6 | -------------------------------------------------------------------------------- /README_pdf.adoc: -------------------------------------------------------------------------------- 1 | # How to get Pascal syntax highlighting with AsciiDoc in PDF 2 | 3 | *Reasoning*: We use https://github.com/asciidoctor/asciidoctor-fopub . It generates a nice PDF out-of-the-box, but it doesn't highlight Pascal keywords. That's because it uses _xslthl_ for syntax highlighting, and it seems that this version of xslthl doesn't include Pascal highlighter. I'm not sure is it a limitation of the _old version of xslthl 2.1.0_, or was it "cut down" when adjusting xslthl 2.1.0 to asciidoctor-fopub (as `asciidoctor-fopub/build/fopub/docbook-xsl/xslthl-config.xml` says _"Several of the lesser used languages have been removed."_) 4 | 5 | The latest version of xslthl (see https://sourceforge.net/projects/xslthl/) does include a highlighter for Pascal (called "delphi"...). But simply upgrading xslthl version in `asciidoctor-fopub/build.gradle` doesn't work, it seems no version later than 2.1.0 works (it seems no new version was uploaded to "Maven Repository"?). 6 | 7 | So, we make a hack:) 8 | 9 | . Run `fopub` from `asciidoctor-fopub` at least once, to let it setup the `build` subdirectory. E.g. make once a PDF here, by `make clean all`. 10 | . Get `delphi-hl.xml` file from https://sourceforge.net/p/xslthl/code/HEAD/tree/trunk/xslthl/highlighters/delphi-hl.xml . Drop it inside `.../asciidoctor-fopub/build/fopub/docbook-xsl/xslthl/` directory. Like this: 11 | + 12 | -- 13 | cd ../asciidoctor-fopub/build/fopub/docbook-xsl/xslthl/ 14 | wget http://svn.code.sf.net/p/xslthl/code/trunk/xslthl/highlighters/delphi-hl.xml 15 | -- 16 | . Modify `.../asciidoctor-fopub/build/fopub/docbook-xsl/xslthl-config.xml` source code to add these lines: 17 | + 18 | -- 19 | 20 | 21 | -- 22 | + 23 | Add them near the end, aligned with the rest of ` . 10 | 11 | Оригінальний текст книги на английскій мові: 12 | 13 | * 14 | * PDF: 15 | 16 | Michalis Kamburelis (творець Castle Game Engine ). 17 | 18 | Переклад на українську мову: Вадим Вітомський () 19 | -------------------------------------------------------------------------------- /cge_www_header.adoc: -------------------------------------------------------------------------------- 1 | # Modern Object Pascal Introduction for Programmers 2 | include::common.adoc[] 3 | :description: Modern Object Pascal Introduction: units, classes, generics, memory management, exceptions and more. 4 | :cge-social-share-image: pascal_code_sample.png 5 | -------------------------------------------------------------------------------- /code-samples/Makefile: -------------------------------------------------------------------------------- 1 | UNIT_SOURCES:=$(wildcard *.pas) 2 | PROGRAM_SOURCES:=$(wildcard *.lpr) $(wildcard *.dpr) 3 | 4 | PROGRAM_UNIX_BINARIES:=$(PROGRAM_SOURCES:.lpr=) 5 | PROGRAM_UNIX_BINARIES:=$(PROGRAM_UNIX_BINARIES:.dpr=) 6 | 7 | PROGRAM_WINDOWS_BINARIES:=$(PROGRAM_SOURCES:.lpr=.exe) 8 | PROGRAM_WINDOWS_BINARIES:=$(PROGRAM_WINDOWS_BINARIES:.dpr=.exe) 9 | 10 | .PHONY: all 11 | all: 12 | $(foreach UNIT_NAME,$(UNIT_SOURCES),fpc $(UNIT_NAME) && ) true 13 | $(foreach PROGRAM_NAME,$(PROGRAM_SOURCES),fpc $(PROGRAM_NAME) && ) true 14 | 15 | # Delphi (dcc) command line options. 16 | # See https://github.com/castle-engine/castle-engine/blob/master/tools/build-tool/code/toolcompile.pas#L858 17 | # for how Castle Game Engine build tool invokes dcc for some hints. 18 | # -NS below follows the DPROJ settings generated by Delphi for new projects. 19 | DELPHI_OPTIONS_COMMON:='-NSSystem;Xml;Data;Datasnap;Web;Soap' 20 | DELPHI_WIN32_COMMAND:=dcc32 $(DELPHI_OPTIONS_COMMON) 21 | DELPHI_WIN64_COMMAND:=dcc64 $(DELPHI_OPTIONS_COMMON) 22 | 23 | .PHONY: all-delphi-win32 24 | all-delphi-win32: 25 | $(foreach UNIT_NAME,$(UNIT_SOURCES),$(DELPHI_WIN32_COMMAND) $(UNIT_NAME) && ) true 26 | $(foreach PROGRAM_NAME,$(PROGRAM_SOURCES),$(DELPHI_WIN32_COMMAND) $(PROGRAM_NAME) && ) true 27 | 28 | .PHONY: all-delphi-win64 29 | all-delphi-win64: 30 | $(foreach UNIT_NAME,$(UNIT_SOURCES),$(DELPHI_WIN64_COMMAND) $(UNIT_NAME) && ) true 31 | $(foreach PROGRAM_NAME,$(PROGRAM_SOURCES),$(DELPHI_WIN64_COMMAND) $(PROGRAM_NAME) && ) true 32 | 33 | .PHONY: clean 34 | clean: 35 | rm -Rf *.o *.ppu $(PROGRAM_UNIX_BINARIES) $(PROGRAM_WINDOWS_BINARIES) 36 | -------------------------------------------------------------------------------- /code-samples/anon_functions_assignment_test.dpr: -------------------------------------------------------------------------------- 1 | { Working example adjusted from 2 | https://forum.lazarus.freepascal.org/index.php?topic=59468.0 } 3 | 4 | {$ifdef FPC} 5 | {$mode objfpc}{$H+}{$J-} 6 | {$modeswitch functionreferences} 7 | {$modeswitch anonymousfunctions} 8 | {$endif} 9 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 10 | 11 | uses Classes; 12 | 13 | type 14 | {$ifdef FPC} 15 | TFunc = function: LongInt; 16 | {$else} 17 | TFunc = reference to function: LongInt; 18 | TProcedure = reference to procedure; 19 | TNotifyEvent = reference to procedure(aSender: TObject); 20 | {$endif} 21 | 22 | var 23 | p: TProcedure; 24 | f: TFunc; 25 | n: TNotifyEvent; 26 | begin 27 | {$ifdef FPC} // Delphi doesn't allow to invoke like this 28 | procedure(const aArg: String) 29 | begin 30 | Writeln(aArg); 31 | end('Hello World'); 32 | {$endif} 33 | 34 | p := procedure 35 | begin 36 | Writeln('Foobar'); 37 | end; 38 | p(); 39 | 40 | n := procedure(Sender: TObject) 41 | begin 42 | Writeln(Sender.ClassName); 43 | end; 44 | n(Nil); 45 | 46 | f := function: LongInt 47 | begin 48 | Result := 42; 49 | end; 50 | Writeln(f()); 51 | end. -------------------------------------------------------------------------------- /code-samples/anon_functions_list_map_foreach.dpr: -------------------------------------------------------------------------------- 1 | { Example of Map, ForEach methods and processing list with anonymous functions. } 2 | 3 | {$ifdef FPC} 4 | {$mode objfpc}{$H+}{$J-} 5 | {$modeswitch functionreferences} 6 | {$modeswitch anonymousfunctions} 7 | {$endif} 8 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 9 | 10 | uses SysUtils, Generics.Collections; 11 | 12 | type 13 | { Note about below TIntMapFunc and TIntMapProc definition, what to use? 14 | 15 | In short, use "reference to". You can assign to them anonymous functions 16 | reliably in both Delphi and FPC. 17 | 18 | With Delphi 12.1, only the "reference to" version will compile. 19 | 20 | With FPC 3.3.1, other variants will also compile. 21 | You can assign anonymous function to any of them. 22 | So if you only target FPC, you can decide which version to use 23 | based on what you want to assign to them *aside* 24 | from anonymous functions: 25 | 26 | - The 1st version (without "of object", without "reference to") 27 | allows to store a reference to a global function, 28 | 29 | - The 2nd (with "of object") 30 | allows to store a reference to a method of an object, 31 | 32 | - The 3rd (with "reference to") is the most universal, 33 | allows a lot of things -- 34 | see https://forum.lazarus.freepascal.org/index.php?topic=59468.0 . 35 | } 36 | 37 | TIntMapFunc = 38 | //function(const Index, Item: Integer): Integer; 39 | //function(const Index, Item: Integer): Integer of object; 40 | reference to function(const Index, Item: Integer): Integer; 41 | TIntMapProc = 42 | //procedure(const Index, Item: Integer); 43 | //procedure(const Index, Item: Integer) of object; 44 | reference to procedure(const Index, Item: Integer); 45 | 46 | TMyInts = class({$ifdef FPC}specialize{$endif} TList) 47 | { Change every item in the list using AFunc. } 48 | procedure Map(const AFunc: TIntMapFunc); 49 | { Call AProc for every item in the list. } 50 | procedure ForEach(const AProc: TIntMapProc); 51 | end; 52 | 53 | procedure TMyInts.Map(const AFunc: TIntMapFunc); 54 | var 55 | Index: Integer; 56 | begin 57 | for Index := 0 to Count - 1 do 58 | Items[Index] := AFunc(Index, Items[Index]); 59 | end; 60 | 61 | procedure TMyInts.ForEach(const AProc: TIntMapProc); 62 | var 63 | Index: Integer; 64 | begin 65 | for Index := 0 to Count - 1 do 66 | AProc(Index, Items[Index]); 67 | end; 68 | 69 | var 70 | MyList: TMyInts; 71 | I: Integer; 72 | F: TIntMapFunc; 73 | begin 74 | MyList := TMyInts.Create; 75 | try 76 | for I := 0 to 10 do 77 | MyList.Add(I); 78 | 79 | F := function(const Index, Item: Integer): Integer 80 | begin 81 | Result := Item + 1; 82 | end; 83 | // effectively this increases all numbers on the list by 3 84 | MyList.Map(F); 85 | MyList.Map(F); 86 | MyList.Map(F); 87 | 88 | // change all items to their squares 89 | MyList.Map(function(const Index, Item: Integer): Integer 90 | begin 91 | Result := Item * Item; 92 | end); 93 | 94 | // print all items 95 | MyList.ForEach(procedure(const Index, Item: Integer) 96 | begin 97 | WriteLn('Index: ', Index, ', Item: ', Item); 98 | WriteLn(' If we would process it by F: ', F(Index, Item)); 99 | end); 100 | finally FreeAndNil(MyList) end; 101 | end. 102 | -------------------------------------------------------------------------------- /code-samples/anonymous_functions.dpr: -------------------------------------------------------------------------------- 1 | { Anonymous functions test. } 2 | 3 | {$ifdef FPC} 4 | {$mode objfpc}{$H+}{$J-} 5 | {$modeswitch functionreferences} 6 | {$modeswitch anonymousfunctions} 7 | {$endif} 8 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 9 | 10 | type 11 | TMyFunction = reference to function (const A, B: Integer): Integer; 12 | 13 | function ProcessTheList(const F: TMyFunction): Integer; 14 | var 15 | I: Integer; 16 | begin 17 | Result := 1; 18 | for I := 2 to 10 do 19 | Result := F(Result, I); 20 | end; 21 | 22 | var 23 | SomeFunction: TMyFunction; 24 | begin 25 | // Assign anonymous function to a variable 26 | SomeFunction := 27 | function(const A, B: Integer): Integer 28 | begin 29 | Result := A + B; 30 | end; 31 | WriteLn('1 + 2 + 3 ... + 10 = ', ProcessTheList(SomeFunction)); 32 | 33 | // Or, simpler, just define the anonymous function inside the parameter 34 | WriteLn('1 + 2 + 3 ... + 10 = ', ProcessTheList( 35 | function(const A, B: Integer): Integer 36 | begin 37 | Result := A + B; 38 | end 39 | )); 40 | 41 | // Similar test, now with multiplication 42 | WriteLn('1 * 2 * 3 ... * 10 = ', ProcessTheList( 43 | function(const A, B: Integer): Integer 44 | begin 45 | Result := A * B; 46 | end 47 | )); 48 | end. 49 | -------------------------------------------------------------------------------- /code-samples/anotherunit.pas: -------------------------------------------------------------------------------- 1 | unit AnotherUnit; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | 5 | interface 6 | 7 | uses 8 | Classes; 9 | 10 | { The "TComponent" type (class) is defined in the Classes unit. 11 | That's why we had to use the Classes unit above. } 12 | procedure DoSomethingWithComponent(var C: TComponent); 13 | 14 | implementation 15 | 16 | uses SysUtils; 17 | 18 | procedure DoSomethingWithComponent(var C: TComponent); 19 | begin 20 | { The FreeAndNil procedure is defined in the SysUtils unit. 21 | Since we only refer to its name in the implementation, 22 | it was OK to use the SysUtils unit in the "implementation" section. } 23 | FreeAndNil(C); 24 | end; 25 | 26 | end. 27 | -------------------------------------------------------------------------------- /code-samples/array_of_const.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils; 5 | 6 | { Example function that concatenates all elements of an array of const 7 | into a String. } 8 | function GlueEverything(const MyArray: array of const): String; 9 | var 10 | I: Integer; 11 | begin 12 | Result := ''; 13 | 14 | for I := 0 to High(MyArray) do 15 | begin 16 | // treat MyArray[I] as TVarRec, check for type and do something 17 | case MyArray[I].VType of 18 | vtInteger: 19 | begin 20 | Writeln('Integer: ', MyArray[I].VInteger); 21 | Result := Result + IntToStr(MyArray[I].VInteger) + ' '; 22 | end; 23 | vtAnsiString: 24 | begin 25 | Writeln('Ansi String (8-bit chars): ', AnsiString(MyArray[I].VAnsiString)); 26 | Result := Result + AnsiString(MyArray[I].VAnsiString) + ' '; 27 | end; 28 | vtUnicodeString: 29 | begin 30 | Writeln('Unicode String (16-bit chars): ', UnicodeString(MyArray[I].VUnicodeString)); 31 | Result := Result + UnicodeString(MyArray[I].VUnicodeString) + ' '; 32 | end; 33 | else 34 | Writeln('Something else, ignoring'); 35 | end; 36 | end; 37 | end; 38 | 39 | var 40 | S: String; 41 | begin 42 | S := GlueEverything([123, 'Hello', 'World', 456]); 43 | Writeln(S); 44 | end. 45 | -------------------------------------------------------------------------------- /code-samples/callbacks.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | function Add(const A, B: Integer): Integer; 5 | begin 6 | Result := A + B; 7 | end; 8 | 9 | function Multiply(const A, B: Integer): Integer; 10 | begin 11 | Result := A * B; 12 | end; 13 | 14 | type 15 | TMyFunction = function (const A, B: Integer): Integer; 16 | 17 | function ProcessTheList(const F: TMyFunction): Integer; 18 | var 19 | I: Integer; 20 | begin 21 | Result := 1; 22 | for I := 2 to 10 do 23 | Result := F(Result, I); 24 | end; 25 | 26 | var 27 | SomeFunction: TMyFunction; 28 | begin 29 | SomeFunction := @Add; 30 | WriteLn('1 + 2 + 3 ... + 10 = ', ProcessTheList(SomeFunction)); 31 | 32 | SomeFunction := @Multiply; 33 | WriteLn('1 * 2 * 3 ... * 10 = ', ProcessTheList(SomeFunction)); 34 | end. -------------------------------------------------------------------------------- /code-samples/callbacks_of_object.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses 5 | SysUtils; 6 | 7 | type 8 | TMyMethod = procedure (const A: Integer) of object; 9 | 10 | TMyClass = class 11 | CurrentValue: Integer; 12 | procedure Add(const A: Integer); 13 | procedure Multiply(const A: Integer); 14 | procedure ProcessTheList(const M: TMyMethod); 15 | end; 16 | 17 | procedure TMyClass.Add(const A: Integer); 18 | begin 19 | CurrentValue := CurrentValue + A; 20 | end; 21 | 22 | procedure TMyClass.Multiply(const A: Integer); 23 | begin 24 | CurrentValue := CurrentValue * A; 25 | end; 26 | 27 | procedure TMyClass.ProcessTheList(const M: TMyMethod); 28 | var 29 | I: Integer; 30 | begin 31 | CurrentValue := 1; 32 | for I := 2 to 10 do 33 | M(I); 34 | end; 35 | 36 | var 37 | C: TMyClass; 38 | begin 39 | C := TMyClass.Create; 40 | try 41 | C.ProcessTheList({$ifdef FPC}@{$endif} C.Add); 42 | WriteLn('1 + 2 + 3 ... + 10 = ', C.CurrentValue); 43 | 44 | C.ProcessTheList({$ifdef FPC}@{$endif} C.Multiply); 45 | WriteLn('1 * 2 * 3 ... * 10 = ', C.CurrentValue); 46 | finally 47 | FreeAndNil(C); 48 | end; 49 | end. -------------------------------------------------------------------------------- /code-samples/class_properties.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | type 5 | TMyClass = class 6 | strict private 7 | // Alternative: 8 | // FMyProperty: Integer; static; 9 | class var 10 | FMyProperty: Integer; 11 | class procedure SetMyProperty(const Value: Integer); static; 12 | public 13 | class property MyProperty: Integer 14 | read FMyProperty write SetMyProperty; 15 | end; 16 | 17 | class procedure TMyClass.SetMyProperty(const Value: Integer); 18 | begin 19 | Writeln('MyProperty changes!'); 20 | FMyProperty := Value; 21 | end; 22 | 23 | begin 24 | TMyClass.MyProperty := 123; 25 | Writeln('TMyClass.MyProperty is now ', TMyClass.MyProperty); 26 | end. 27 | -------------------------------------------------------------------------------- /code-samples/delphi_and_fpc_differences/compare_function_pointers.dpr: -------------------------------------------------------------------------------- 1 | { Demonstrates how using @ in FPC ObjFpc makes some expressions 2 | unambiguous. See 3 | https://github.com/modern-pascal/modern-pascal-introduction/wiki/Some-differences-betwen-FPC-ObjFpc-mode-and-Delphi-(and-FPC-Delphi-mode) 4 | for information. } 5 | 6 | {$ifdef FPC} {$mode objfpc}{$H+} {$endif} 7 | {$ifdef MSWINDOWS} {$apptype console} {$endif} 8 | 9 | type 10 | TMyFunction = function: Integer; 11 | 12 | function MyFunction: Integer; 13 | begin 14 | Result := Random(1000 * 1000 * 1000); 15 | end; 16 | 17 | var 18 | X, Y: TMyFunction; 19 | begin 20 | Randomize; 21 | 22 | X := {$ifdef FPC}@{$endif} MyFunction; 23 | Y := {$ifdef FPC}@{$endif} MyFunction; 24 | 25 | { This is the weird point. 26 | 27 | - In FPC ObjFpc, it compares X and Y values, 28 | they are equal (both point to MyFunction). 29 | 30 | - In Delphi (or FPC Delphi mode), it will call X and Y. 31 | Most likely they'll return something different, 32 | since they return just random value. 33 | } 34 | if X = Y then 35 | Writeln('X = Y: Equal') 36 | else 37 | Writeln('X = Y: Not equal'); 38 | 39 | { This is again valid in both modes, but means something different. 40 | 41 | - In FPC ObjFpc, @ gets the address of the variable. 42 | So it compares the address of X and Y, which are different. 43 | 44 | - In Delphi (or FPC Delphi mode), it compares the values of X and Y. 45 | Since they are function pointers, they are equal. 46 | 47 | So in Delphi "if @X = @Y then" is equal to FPC ObjFpc "if X = Y then". 48 | } 49 | if @X = @Y then 50 | Writeln('@X = @Y: Equal') 51 | else 52 | Writeln('@X = @Y: Not equal'); 53 | 54 | {$ifndef FPC} 55 | { In Delphi, this allows to compare "the address of X" with "the address of Y". 56 | So "if @@X = @@Y then" in Delphi means the same thing 57 | as "if @X = @Y then" in FPC ObjFpc. 58 | 59 | In FPC ObjFpc, this is invalid, makes no sense -- @@X would mean we want 60 | an address of temporary value @X. } 61 | if @@X = @@Y then 62 | Writeln('@@X = @@Y: Equal') 63 | else 64 | Writeln('@@X = @@Y: Not equal'); 65 | {$endif} 66 | 67 | { Finally, this is valid in both modes and does the same: 68 | compares the values of X and Y. Using () forces the call of parameter-less 69 | function. } 70 | if X() = Y() then 71 | Writeln('X() or Y(): Equal') 72 | else 73 | Writeln('X() or Y(): Not equal'); 74 | end. 75 | -------------------------------------------------------------------------------- /code-samples/exception_finally.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | program MyProgram; 5 | 6 | uses 7 | SysUtils; 8 | 9 | type 10 | TMyClass = class 11 | procedure MyMethod; 12 | end; 13 | 14 | procedure TMyClass.MyMethod; 15 | begin 16 | if Random > 0.5 then 17 | raise Exception.Create('Raising an exception!'); 18 | end; 19 | 20 | var 21 | C: TMyClass; 22 | begin 23 | Randomize; 24 | C := TMyClass.Create; 25 | try 26 | C.MyMethod; 27 | finally 28 | FreeAndNil(C); 29 | end; 30 | end. 31 | -------------------------------------------------------------------------------- /code-samples/exception_in_constructor_test.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses 5 | SysUtils; 6 | 7 | type 8 | TGun = class 9 | end; 10 | 11 | TPlayer = class 12 | Gun1, Gun2: TGun; 13 | constructor Create; 14 | destructor Destroy; override; 15 | end; 16 | 17 | constructor TPlayer.Create; 18 | begin 19 | inherited; 20 | Gun1 := TGun.Create; 21 | raise Exception.Create('Raising an exception from constructor!'); 22 | Gun2 := TGun.Create; 23 | end; 24 | 25 | destructor TPlayer.Destroy; 26 | begin 27 | { in case since the constructor crashed, we can 28 | have Gun1 <> nil and Gun2 = nil now. Deal with it. 29 | ...Actually, in this case, FreeAndNil deals with it without 30 | any additional effort on our side, because FreeAndNil checks 31 | whether the instance is nil before calling its destructor. } 32 | FreeAndNil(Gun1); 33 | FreeAndNil(Gun2); 34 | inherited; 35 | end; 36 | 37 | begin 38 | try 39 | TPlayer.Create; 40 | except 41 | on E: Exception do 42 | WriteLn('Caught ' + E.ClassName + ': ' + E.Message); 43 | end; 44 | end. 45 | -------------------------------------------------------------------------------- /code-samples/experiments_that_dont_compile/callback_from_generic_function.dpr: -------------------------------------------------------------------------------- 1 | { Test getting pointers to generic functions. 2 | 3 | With FPC 3.2.2 this fails with clear message: 4 | callback_from_generic_function.dpr(40,74) Error: Pointers to generics functions not implemented 5 | callback_from_generic_function.dpr(41,74) Error: Pointers to generics functions not implemented 6 | 7 | With Delphi this fails as Delphi supports only generic methods, not global routines: 8 | [dcc32 Error] callback_from_generic_function.dpr(14): E2530 Type parameters not allowed on global procedure or function 9 | } 10 | 11 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 12 | {$apptype CONSOLE} 13 | 14 | uses 15 | SysUtils; 16 | 17 | {$ifdef FPC}generic{$endif} function Min(const A, B: T): T; 18 | begin 19 | if A < B then 20 | Result := A 21 | else 22 | Result := B; 23 | end; 24 | 25 | {$ifdef FPC}generic{$endif} function Max(const A, B: T): T; 26 | begin 27 | if A < B then 28 | Result := B 29 | else 30 | Result := A; 31 | end; 32 | 33 | type 34 | TMyIntegerFunction = function (const A, B: Integer): Integer; 35 | 36 | // Fold left ( https://en.wikipedia.org/wiki/Fold_(higher-order_function) ) 37 | // specifically for an array of Integers. 38 | function FoldLeftInts(const F: TMyIntegerFunction; const A: array of Integer): Integer; 39 | var 40 | I: Integer; 41 | begin 42 | Result := A[0]; 43 | for I := 1 to High(A) do 44 | Result := F(A[I], Result); 45 | end; 46 | 47 | var 48 | F: TMyIntegerFunction; 49 | begin 50 | Writeln('Min: ', FoldLeftInts([1, 2, 3, 4, 5], @{$ifdef FPC}specialize{$endif} Min)); 51 | Writeln('Max: ', FoldLeftInts([1, 2, 3, 4, 5], @{$ifdef FPC}specialize{$endif} Max)); 52 | end. 53 | -------------------------------------------------------------------------------- /code-samples/experiments_that_dont_compile/callback_from_generic_method.dpr: -------------------------------------------------------------------------------- 1 | { Test getting pointers to generic methods. 2 | 3 | With Delphi the core thing works (you can have generic function and 4 | take pointer to it), though in Delphi it isn't allowed to do "A < B" 5 | as Delphi doesn't have a constrain to express "A and B are comparable". 6 | 7 | It doesn't seem possible to get this to compile with FPC, 8 | adding generic / specialize (I removed them from this source code now, 9 | since they were making it quite noisy). 10 | It is unsure if it is possible anyway, as 11 | callback_from_generic_function.dpr shows that FPC 3.2.2 says 12 | "Pointers to generics functions not implemented". 13 | } 14 | 15 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 16 | {$apptype CONSOLE} 17 | 18 | uses 19 | SysUtils; 20 | 21 | type 22 | TMyClass = class 23 | class function Min(const A, B: T): T; static; 24 | class function Max(const A, B: T): T; static; 25 | end; 26 | 27 | class function TMyClass.Min(const A, B: T): T; 28 | begin 29 | // if A < B then 30 | // Result := A 31 | // else 32 | Result := B; 33 | end; 34 | 35 | class function TMyClass.Max(const A, B: T): T; 36 | begin 37 | // if A < B then 38 | // Result := B 39 | // else 40 | Result := A; 41 | end; 42 | 43 | type 44 | TMyIntegerFunction = function (const A, B: Integer): Integer; 45 | 46 | // Fold left ( https://en.wikipedia.org/wiki/Fold_(higher-order_function) ) 47 | // specifically for an array of Integers. 48 | function FoldLeftInts(const F: TMyIntegerFunction; const A: array of Integer): Integer; 49 | var 50 | I: Integer; 51 | begin 52 | Result := A[0]; 53 | for I := 1 to High(A) do 54 | Result := F(A[I], Result); 55 | end; 56 | 57 | begin 58 | Writeln('Min: ', FoldLeftInts(TMyClass.Min, [1, 2, 3, 4, 5])); 59 | Writeln('Max: ', FoldLeftInts(TMyClass.Max, [1, 2, 3, 4, 5])); 60 | 61 | Readln; 62 | end. 63 | -------------------------------------------------------------------------------- /code-samples/file_stream.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses 5 | SysUtils, Classes; 6 | 7 | var 8 | S: TStream; 9 | InputInt, OutputInt: Integer; 10 | begin 11 | InputInt := 666; 12 | 13 | S := TFileStream.Create('my_binary_file.data', fmCreate); 14 | try 15 | S.WriteBuffer(InputInt, SizeOf(InputInt)); 16 | finally 17 | FreeAndNil(S); 18 | end; 19 | 20 | S := TFileStream.Create('my_binary_file.data', fmOpenRead); 21 | try 22 | S.ReadBuffer(OutputInt, SizeOf(OutputInt)); 23 | finally 24 | FreeAndNil(S); 25 | end; 26 | 27 | WriteLn('Read from file got integer: ', OutputInt); 28 | end. -------------------------------------------------------------------------------- /code-samples/for_in_list.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses 5 | SysUtils, Generics.Collections; 6 | 7 | type 8 | TMyClass = class 9 | I, Square: Integer; 10 | end; 11 | TMyClassList = {$ifdef FPC}specialize{$endif} TObjectList; 12 | 13 | var 14 | List: TMyClassList; 15 | C: TMyClass; 16 | I: Integer; 17 | begin 18 | List := TMyClassList.Create(true); // true = owns children 19 | try 20 | for I := 0 to 9 do 21 | begin 22 | C := TMyClass.Create; 23 | C.I := I; 24 | C.Square := I * I; 25 | List.Add(C); 26 | end; 27 | 28 | for C in List do 29 | WriteLn('Square of ', C.I, ' is ', C.Square); 30 | finally 31 | FreeAndNil(List); 32 | end; 33 | end. -------------------------------------------------------------------------------- /code-samples/functions_primitives.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | program MyProgram; 5 | 6 | procedure MyProcedure(const A: Integer); 7 | begin 8 | WriteLn('A + 10 is: ', A + 10); 9 | end; 10 | 11 | function MyFunction(const S: string): string; 12 | begin 13 | Result := S + 'strings are automatically managed'; 14 | end; 15 | 16 | var 17 | X: Single; 18 | begin 19 | WriteLn(MyFunction('Note: ')); 20 | MyProcedure(5); 21 | 22 | // Division using "/" always makes float result, use "div" for integer division 23 | X := 15 / 5; 24 | WriteLn('X is now: ', X); // scientific notation 25 | WriteLn('X is now: ', X:1:2); // 2 decimal places 26 | end. 27 | -------------------------------------------------------------------------------- /code-samples/gen_guid.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses 5 | SysUtils; 6 | var 7 | MyGuid: TGUID; 8 | begin 9 | Randomize; 10 | CreateGUID(MyGuid); 11 | WriteLn('[''' + GUIDToString(MyGuid) + ''']'); 12 | end. 13 | -------------------------------------------------------------------------------- /code-samples/generic_functions.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | {$ifndef FPC} 5 | {$message warn 'Delphi does not support global generic functions'} 6 | begin end. 7 | {$endif} 8 | 9 | uses SysUtils; 10 | 11 | { Note: this example requires FPC 3.1.1 (will not compile with FPC 3.0.0 or older). } 12 | 13 | generic function Min(const A, B: T): T; 14 | begin 15 | if A < B then 16 | Result := A else 17 | Result := B; 18 | end; 19 | 20 | begin 21 | WriteLn('Min (1, 0): ', specialize Min(1, 0)); 22 | WriteLn('Min (3.14, 5): ', specialize Min(3.14, 5):1:2); 23 | WriteLn('Min (''a'', ''b''): ', specialize Min('a', 'b')); 24 | end. -------------------------------------------------------------------------------- /code-samples/generics.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | {$ifndef FPC} 5 | {$message warn 'Delphi does not allow addition on types that are generic parameters'} 6 | begin end. 7 | {$endif} 8 | 9 | uses SysUtils; 10 | 11 | type 12 | generic TMyCalculator = class 13 | Value: T; 14 | procedure Add(const A: T); 15 | end; 16 | 17 | procedure TMyCalculator.Add(const A: T); 18 | begin 19 | Value := Value + A; 20 | end; 21 | 22 | type 23 | TMyFloatCalculator = {$ifdef FPC}specialize{$endif} TMyCalculator; 24 | TMyStringCalculator = {$ifdef FPC}specialize{$endif} TMyCalculator; 25 | 26 | var 27 | FloatCalc: TMyFloatCalculator; 28 | StringCalc: TMyStringCalculator; 29 | begin 30 | FloatCalc := TMyFloatCalculator.Create; 31 | try 32 | FloatCalc.Add(3.14); 33 | FloatCalc.Add(1); 34 | WriteLn('FloatCalc: ', FloatCalc.Value:1:2); 35 | finally 36 | FreeAndNil(FloatCalc); 37 | end; 38 | 39 | StringCalc := TMyStringCalculator.Create; 40 | try 41 | StringCalc.Add('something'); 42 | StringCalc.Add(' more'); 43 | WriteLn('StringCalc: ', StringCalc.Value); 44 | finally 45 | FreeAndNil(StringCalc); 46 | end; 47 | end. -------------------------------------------------------------------------------- /code-samples/generics_dictionary.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils, Generics.Collections; 5 | 6 | type 7 | TApple = class 8 | Name: string; 9 | end; 10 | 11 | TAppleDictionary = {$ifdef FPC}specialize{$endif} TDictionary; 12 | 13 | var 14 | Apples: TAppleDictionary; 15 | A, FoundA: TApple; 16 | ApplePair: {$ifdef FPC} TAppleDictionary.TDictionaryPair {$else} TPair {$endif}; 17 | AppleKey: string; 18 | begin 19 | Apples := TAppleDictionary.Create; 20 | try 21 | A := TApple.Create; 22 | A.Name := 'my apple'; 23 | Apples.AddOrSetValue('apple key 1', A); 24 | 25 | if Apples.TryGetValue('apple key 1', FoundA) then 26 | Writeln('Found apple under key "apple key 1" with name: ' + 27 | FoundA.Name); 28 | 29 | for AppleKey in Apples.Keys do 30 | Writeln('Found apple key: ' + AppleKey); 31 | for A in Apples.Values do 32 | Writeln('Found apple value: ' + A.Name); 33 | for ApplePair in Apples do 34 | Writeln('Found apple key->value: ' + 35 | ApplePair.Key + '->' + ApplePair.Value.Name); 36 | 37 | { Line below works too, but it can only be used to set 38 | an *existing* dictionary key. 39 | Instead of this, usually use AddOrSetValue 40 | to set or add a new key, as necessary. } 41 | // Apples['apple key 1'] := ... ; 42 | 43 | Apples.Remove('apple key 1'); 44 | 45 | { Note that the TDictionary doesn't own the items, 46 | you need to free them yourself. 47 | We could use TObjectDictionary to have automatic ownership 48 | mechanism. } 49 | A.Free; 50 | finally FreeAndNil(Apples) end; 51 | end. 52 | -------------------------------------------------------------------------------- /code-samples/generics_lists.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils, Generics.Collections; 5 | 6 | type 7 | TApple = class 8 | Name: string; 9 | end; 10 | 11 | TAppleList = {$ifdef FPC}specialize{$endif} TObjectList; 12 | 13 | var 14 | A: TApple; 15 | Apples: TAppleList; 16 | begin 17 | Apples := TAppleList.Create(true); 18 | try 19 | A := TApple.Create; 20 | A.Name := 'my apple'; 21 | Apples.Add(A); 22 | 23 | A := TApple.Create; 24 | A.Name := 'another apple'; 25 | Apples.Add(A); 26 | 27 | Writeln('Count: ', Apples.Count); 28 | Writeln(Apples[0].Name); 29 | Writeln(Apples[1].Name); 30 | finally FreeAndNil(Apples) end; 31 | end. 32 | -------------------------------------------------------------------------------- /code-samples/generics_object_dictionary.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils, Generics.Collections; 5 | 6 | type 7 | TApple = class 8 | Name: string; 9 | end; 10 | 11 | TAppleDictionary = {$ifdef FPC}specialize{$endif} TObjectDictionary; 12 | 13 | var 14 | Apples: TAppleDictionary; 15 | A: TApple; 16 | ApplePair: {$ifdef FPC} TAppleDictionary.TDictionaryPair {$else} TPair {$endif}; 17 | begin 18 | Apples := TAppleDictionary.Create([doOwnsValues]); 19 | try 20 | A := TApple.Create; 21 | A.Name := 'my apple'; 22 | Apples.AddOrSetValue('apple key 1', A); 23 | 24 | for ApplePair in Apples do 25 | Writeln('Found apple key->value: ' + 26 | ApplePair.Key + '->' + ApplePair.Value.Name); 27 | 28 | Apples.Remove('apple key 1'); 29 | finally FreeAndNil(Apples) end; 30 | end. 31 | -------------------------------------------------------------------------------- /code-samples/generics_sorting.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | { If GENERICS_CONSTREF is defined, then various routines used with Generics.Collections 5 | (like callbacks we pass to TComparer, or OnNotify callback or Notify virtual method) 6 | should have "constref" parameter, not "const". 7 | This was the case of FPC<= 3.2.0, FPC changed it in 8 | https://gitlab.com/freepascal.org/fpc/source/-/commit/693491048bf2c6f9122a0d8b044ad0e55382354d . 9 | It is also applied to FPC fixes branch 3.2.3. } 10 | {$ifdef VER3_0} {$define GENERICS_CONSTREF} {$endif} 11 | {$ifdef VER3_2_0} {$define GENERICS_CONSTREF} {$endif} 12 | {$ifdef VER3_2_2} {$define GENERICS_CONSTREF} {$endif} 13 | 14 | uses SysUtils, Generics.Defaults, Generics.Collections; 15 | 16 | type 17 | TApple = class 18 | Name: string; 19 | end; 20 | 21 | TAppleList = {$ifdef FPC}specialize{$endif} TObjectList; 22 | 23 | function CompareApples( 24 | {$ifdef GENERICS_CONSTREF}constref{$else}const{$endif} 25 | Left, Right: TApple): Integer; 26 | begin 27 | Result := AnsiCompareStr(Left.Name, Right.Name); 28 | end; 29 | 30 | type 31 | TAppleComparer = {$ifdef FPC}specialize{$endif} TComparer; 32 | var 33 | A: TApple; 34 | L: TAppleList; 35 | begin 36 | L := TAppleList.Create(true); 37 | try 38 | A := TApple.Create; 39 | A.Name := '11'; 40 | L.Add(A); 41 | 42 | A := TApple.Create; 43 | A.Name := '33'; 44 | L.Add(A); 45 | 46 | A := TApple.Create; 47 | A.Name := '22'; 48 | L.Add(A); 49 | 50 | L.Sort(TAppleComparer.Construct({$ifdef FPC}@{$endif} CompareApples)); 51 | 52 | Writeln('Count: ', L.Count); 53 | Writeln(L[0].Name); 54 | Writeln(L[1].Name); 55 | Writeln(L[2].Name); 56 | finally FreeAndNil(L) end; 57 | end. 58 | -------------------------------------------------------------------------------- /code-samples/hello_world.dpr: -------------------------------------------------------------------------------- 1 | // Just use this line in all modern FPC sources. 2 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 3 | // Needed for console programs on Windows, 4 | // otherwise (with Delphi) the default is GUI program without console. 5 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 6 | 7 | program MyProgram; // Save this file as myprogram.dpr 8 | begin 9 | WriteLn('Hello world!'); 10 | end. 11 | -------------------------------------------------------------------------------- /code-samples/inheritance.dpr: -------------------------------------------------------------------------------- 1 | program MyProgram; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 5 | 6 | uses 7 | SysUtils; 8 | 9 | type 10 | TMyClass = class 11 | MyInt: Integer; 12 | procedure MyVirtualMethod; virtual; 13 | end; 14 | 15 | TMyClassDescendant = class(TMyClass) 16 | procedure MyVirtualMethod; override; 17 | end; 18 | 19 | procedure TMyClass.MyVirtualMethod; 20 | begin 21 | WriteLn('TMyClass shows MyInt + 10: ', MyInt + 10); 22 | end; 23 | 24 | procedure TMyClassDescendant.MyVirtualMethod; 25 | begin 26 | WriteLn('TMyClassDescendant shows MyInt + 20: ', MyInt + 20); 27 | end; 28 | 29 | var 30 | C: TMyClass; 31 | begin 32 | C := TMyClass.Create; 33 | try 34 | C.MyVirtualMethod; 35 | finally 36 | FreeAndNil(C); 37 | end; 38 | 39 | C := TMyClassDescendant.Create; 40 | try 41 | C.MyVirtualMethod; 42 | finally 43 | FreeAndNil(C); 44 | end; 45 | end. 46 | -------------------------------------------------------------------------------- /code-samples/initialization_finalization.pas: -------------------------------------------------------------------------------- 1 | unit initialization_finalization; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | 5 | interface 6 | 7 | implementation 8 | 9 | initialization 10 | WriteLn('Hello world!'); 11 | finalization 12 | WriteLn('Goodbye world!'); 13 | end. 14 | -------------------------------------------------------------------------------- /code-samples/interface_casting.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | // {$interfaces corba} // note that "as" typecasts will not compile with CORBA interfaces 5 | 6 | uses Classes; 7 | 8 | type 9 | IMyInterface = interface 10 | ['{7FC754BC-9CA7-4399-B947-D37DD30BA90A}'] 11 | procedure One; 12 | end; 13 | 14 | IMyInterface2 = interface(IMyInterface) 15 | ['{A72B7008-3F90-45C1-8F4C-E77C4302AA3E}'] 16 | procedure Two; 17 | end; 18 | 19 | IMyInterface3 = interface(IMyInterface2) 20 | ['{924BFB98-B049-4945-AF17-1DB08DB1C0C5}'] 21 | procedure Three; 22 | end; 23 | 24 | TMyClass = class(TComponent, IMyInterface) 25 | procedure One; 26 | end; 27 | 28 | TMyClass2 = class(TMyClass, IMyInterface, IMyInterface2) 29 | procedure One; 30 | procedure Two; 31 | end; 32 | 33 | procedure TMyClass.One; 34 | begin 35 | Writeln('TMyClass.One'); 36 | end; 37 | 38 | procedure TMyClass2.One; 39 | begin 40 | Writeln('TMyClass2.One'); 41 | end; 42 | 43 | procedure TMyClass2.Two; 44 | begin 45 | Writeln('TMyClass2.Two'); 46 | end; 47 | 48 | procedure UseInterface2(const I: IMyInterface2); 49 | begin 50 | I.One; 51 | I.Two; 52 | end; 53 | 54 | procedure UseInterface3(const I: IMyInterface3); 55 | begin 56 | I.One; 57 | I.Two; 58 | I.Three; 59 | end; 60 | 61 | var 62 | MyInterface: IMyInterface; 63 | MyClass: TMyClass; 64 | begin 65 | MyInterface := TMyClass2.Create(nil); 66 | MyClass := TMyClass2.Create(nil); 67 | 68 | // This doesn't compile, since at compile-time it's unknown if MyInterface is IMyInterface2. 69 | // UseInterface2(MyInterface); 70 | // UseInterface2(MyClass); 71 | 72 | // This compiles and works OK. 73 | UseInterface2(IMyInterface2(MyInterface)); 74 | // This does not compile. Casting InterfaceType(ClassType) is checked at compile-time. 75 | // UseInterface2(IMyInterface2(MyClass)); 76 | 77 | // This compiles and works OK. 78 | UseInterface2(MyInterface as IMyInterface2); 79 | // This compiles and works OK. 80 | UseInterface2(MyClass as IMyInterface2); 81 | 82 | // This compiles, but will fail at runtime, with ugly "Access violation". 83 | // UseInterface3(IMyInterface3(MyInterface)); 84 | // This does not compile. Casting InterfaceType(ClassType) is checked at compile-time. 85 | // UseInterface3(IMyInterface3(MyClass)); 86 | 87 | // This compiles, but will fail at runtime, with nice "EInvalidCast: Invalid type cast". 88 | // UseInterface3(MyInterface as IMyInterface3); 89 | // This compiles, but will fail at runtime, with nice "EInvalidCast: Invalid type cast". 90 | // UseInterface3(MyClass as IMyInterface3); 91 | 92 | Writeln('Finished'); 93 | end. 94 | -------------------------------------------------------------------------------- /code-samples/interfaces_com_test.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} 2 | {$mode objfpc}{$H+}{$J-} 3 | {$interfaces com} 4 | {$endif} 5 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 6 | 7 | uses 8 | SysUtils, Classes; 9 | 10 | type 11 | IMyInterface = interface 12 | ['{3075FFCD-8EFB-4E98-B157-261448B8D92E}'] 13 | procedure Shoot; 14 | end; 15 | 16 | TMyClass1 = class(TComponent, IMyInterface) 17 | procedure Shoot; 18 | end; 19 | 20 | TMyClass2 = class(TComponent, IMyInterface) 21 | procedure Shoot; 22 | end; 23 | 24 | TMyClass3 = class(TComponent) 25 | procedure Shoot; 26 | end; 27 | 28 | procedure TMyClass1.Shoot; 29 | begin 30 | WriteLn('TMyClass1.Shoot'); 31 | end; 32 | 33 | procedure TMyClass2.Shoot; 34 | begin 35 | WriteLn('TMyClass2.Shoot'); 36 | end; 37 | 38 | procedure TMyClass3.Shoot; 39 | begin 40 | WriteLn('TMyClass3.Shoot'); 41 | end; 42 | 43 | procedure UseThroughInterface(I: IMyInterface); 44 | begin 45 | Write('Shooting... '); 46 | I.Shoot; 47 | end; 48 | 49 | var 50 | C1: TMyClass1; 51 | C2: TMyClass2; 52 | C3: TMyClass3; 53 | 54 | procedure UseInterfaces; 55 | begin 56 | // In FPC, you could also check using "is", like: 57 | //if C1 is IMyInterface then ... 58 | 59 | if Supports(C1, IMyInterface) then 60 | UseThroughInterface(C1 as IMyInterface); 61 | if Supports(C2, IMyInterface) then 62 | UseThroughInterface(C2 as IMyInterface); 63 | if Supports(C3, IMyInterface) then 64 | UseThroughInterface(C3 as IMyInterface); 65 | end; 66 | 67 | begin 68 | C1 := TMyClass1.Create(nil); 69 | C2 := TMyClass2.Create(nil); 70 | C3 := TMyClass3.Create(nil); 71 | try 72 | UseInterfaces; 73 | finally 74 | FreeAndNil(C1); 75 | FreeAndNil(C2); 76 | FreeAndNil(C3); 77 | end; 78 | end. -------------------------------------------------------------------------------- /code-samples/interfaces_com_test_comments.txt: -------------------------------------------------------------------------------- 1 | if C1 is IMyInterface then 2 | //if Supports(C1, IMyInterface) then // equivalent to "is" check above 3 | //UseThroughInterface(C1 as IMyInterface); 4 | UseThroughInterface(C1); // these can also be just casted with no syntax, as it's compile-time provably correct 5 | //UseThroughInterface(IMyInterface(C1)); // equivalent to casting implicitly, it seems: checked at compile-time, this is OK 6 | 7 | if C2 is IMyInterface then 8 | //UseThroughInterface(C2 as IMyInterface); 9 | UseThroughInterface(C2); // these can also be just casted with no syntax, as it's compile-time provably correct 10 | 11 | if C3 is IMyInterface then 12 | UseThroughInterface(C3 as IMyInterface); // this is visibly wrong at compile-time, so only "as" cast compiles 13 | //UseThroughInterface(IMyInterface(C3)); // equivalent to casting implicitly, it seems: checked at compile-time, not possible here 14 | -------------------------------------------------------------------------------- /code-samples/interfaces_com_with_ref_counting.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} 2 | {$mode objfpc}{$H+}{$J-} 3 | {$interfaces com} 4 | {$endif} 5 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 6 | 7 | uses 8 | SysUtils, Classes; 9 | 10 | type 11 | IMyInterface = interface 12 | ['{3075FFCD-8EFB-4E98-B157-261448B8D92E}'] 13 | procedure Shoot; 14 | end; 15 | 16 | TMyClass1 = class(TInterfacedObject, IMyInterface) 17 | procedure Shoot; 18 | end; 19 | 20 | TMyClass2 = class(TInterfacedObject, IMyInterface) 21 | procedure Shoot; 22 | end; 23 | 24 | TMyClass3 = class(TInterfacedObject) 25 | procedure Shoot; 26 | end; 27 | 28 | procedure TMyClass1.Shoot; 29 | begin 30 | WriteLn('TMyClass1.Shoot'); 31 | end; 32 | 33 | procedure TMyClass2.Shoot; 34 | begin 35 | WriteLn('TMyClass2.Shoot'); 36 | end; 37 | 38 | procedure TMyClass3.Shoot; 39 | begin 40 | WriteLn('TMyClass3.Shoot'); 41 | end; 42 | 43 | procedure UseThroughInterface(I: IMyInterface); 44 | begin 45 | Write('Shooting... '); 46 | I.Shoot; 47 | end; 48 | 49 | var 50 | C1: IMyInterface; // COM takes care of destruction 51 | C2: IMyInterface; // COM takes care of destruction 52 | C3: TMyClass3; // YOU have to take care of destruction 53 | begin 54 | C1 := TMyClass1.Create as IMyInterface; 55 | C2 := TMyClass2.Create as IMyInterface; 56 | C3 := TMyClass3.Create; 57 | try 58 | UseThroughInterface(C1); // no need to use "as" operator 59 | UseThroughInterface(C2); 60 | if Supports(C3, IMyInterface) then 61 | UseThroughInterface(C3 as IMyInterface); // this will not execute 62 | finally 63 | { C1 and C2 variables go out of scope and will be auto-destroyed now. 64 | 65 | In contrast, C3 is a class instance, not managed by an interface, 66 | and it has to be destroyed manually. } 67 | FreeAndNil(C3); 68 | end; 69 | end. -------------------------------------------------------------------------------- /code-samples/interfaces_corba_test.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} 2 | {$mode objfpc}{$H+}{$J-} 3 | {$interfaces corba} // See below why we recommend CORBA interfaces 4 | {$else} 5 | {$message warn 'Delphi does not support CORBA interfaces, only COM, that change how memory is managed. This example is not valid in Delphi.'} 6 | begin end. 7 | {$endif} 8 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 9 | 10 | uses 11 | SysUtils, Classes; 12 | 13 | type 14 | IMyInterface = interface 15 | ['{79352612-668B-4E8C-910A-26975E103CAC}'] 16 | procedure Shoot; 17 | end; 18 | 19 | TMyClass1 = class(IMyInterface) 20 | procedure Shoot; 21 | end; 22 | 23 | TMyClass2 = class(IMyInterface) 24 | procedure Shoot; 25 | end; 26 | 27 | TMyClass3 = class 28 | procedure Shoot; 29 | end; 30 | 31 | procedure TMyClass1.Shoot; 32 | begin 33 | WriteLn('TMyClass1.Shoot'); 34 | end; 35 | 36 | procedure TMyClass2.Shoot; 37 | begin 38 | WriteLn('TMyClass2.Shoot'); 39 | end; 40 | 41 | procedure TMyClass3.Shoot; 42 | begin 43 | WriteLn('TMyClass3.Shoot'); 44 | end; 45 | 46 | procedure UseThroughInterface(I: IMyInterface); 47 | begin 48 | Write('Shooting... '); 49 | I.Shoot; 50 | end; 51 | 52 | var 53 | C1: TMyClass1; 54 | C2: TMyClass2; 55 | C3: TMyClass3; 56 | begin 57 | C1 := TMyClass1.Create; 58 | C2 := TMyClass2.Create; 59 | C3 := TMyClass3.Create; 60 | try 61 | if C1 is IMyInterface then 62 | UseThroughInterface(C1 as IMyInterface); 63 | if C2 is IMyInterface then 64 | UseThroughInterface(C2 as IMyInterface); 65 | // The "C3 is IMyInterface" below is false, 66 | // so "UseThroughInterface(C3 as IMyInterface)" will not execute. 67 | if C3 is IMyInterface then 68 | UseThroughInterface(C3 as IMyInterface); 69 | finally 70 | FreeAndNil(C1); 71 | FreeAndNil(C2); 72 | FreeAndNil(C3); 73 | end; 74 | end. 75 | 76 | -------------------------------------------------------------------------------- /code-samples/is_as.dpr: -------------------------------------------------------------------------------- 1 | program is_as; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 5 | 6 | uses 7 | SysUtils; 8 | 9 | type 10 | TMyClass = class 11 | procedure MyMethod; 12 | end; 13 | 14 | TMyClassDescendant = class(TMyClass) 15 | procedure MyMethodInDescendant; 16 | end; 17 | 18 | procedure TMyClass.MyMethod; 19 | begin 20 | WriteLn('MyMethod'); 21 | end; 22 | 23 | procedure TMyClassDescendant.MyMethodInDescendant; 24 | begin 25 | WriteLn('MyMethodInDescendant'); 26 | end; 27 | 28 | var 29 | Descendant: TMyClassDescendant; 30 | C: TMyClass; 31 | begin 32 | Descendant := TMyClassDescendant.Create; 33 | try 34 | Descendant.MyMethod; 35 | Descendant.MyMethodInDescendant; 36 | 37 | { Descendant has all functionality expected of 38 | the TMyClass, so this assignment is OK } 39 | C := Descendant; 40 | C.MyMethod; 41 | 42 | { this cannot work, since TMyClass doesn't define this method } 43 | //C.MyMethodInDescendant; 44 | if C is TMyClassDescendant then 45 | (C as TMyClassDescendant).MyMethodInDescendant; 46 | 47 | finally 48 | FreeAndNil(Descendant); 49 | end; 50 | end. 51 | -------------------------------------------------------------------------------- /code-samples/lazarus/showcolor.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | program showcolor; 5 | 6 | // Both Graphics and GoogleMapsEngine units define TColor type. 7 | uses 8 | Graphics, GoogleMapsEngine; 9 | 10 | var 11 | { This doesn't work like we want, as TColor ends up 12 | being defined by GoogleMapsEngine. } 13 | // Color: TColor; 14 | { This works Ok. } 15 | Color: Graphics.TColor; 16 | begin 17 | Color := clYellow; 18 | WriteLn(Red(Color), ' ', Green(Color), ' ', Blue(Color)); 19 | end. 20 | 21 | -------------------------------------------------------------------------------- /code-samples/lazarus/showcolor.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | <UseAppBundle Value="False"/> 14 | <ResourceType Value="res"/> 15 | </General> 16 | <i18n> 17 | <EnableI18N LFM="False"/> 18 | </i18n> 19 | <VersionInfo> 20 | <StringTable ProductVersion=""/> 21 | </VersionInfo> 22 | <BuildModes Count="1"> 23 | <Item1 Name="Default" Default="True"/> 24 | </BuildModes> 25 | <PublishOptions> 26 | <Version Value="2"/> 27 | </PublishOptions> 28 | <RunParams> 29 | <local> 30 | <FormatVersion Value="1"/> 31 | </local> 32 | </RunParams> 33 | <RequiredPackages Count="1"> 34 | <Item1> 35 | <PackageName Value="LCL"/> 36 | </Item1> 37 | </RequiredPackages> 38 | <Units Count="1"> 39 | <Unit0> 40 | <Filename Value="showcolor.dpr"/> 41 | <IsPartOfProject Value="True"/> 42 | </Unit0> 43 | </Units> 44 | </ProjectOptions> 45 | <CompilerOptions> 46 | <Version Value="11"/> 47 | <Target> 48 | <Filename Value="showcolor"/> 49 | </Target> 50 | <SearchPaths> 51 | <IncludeFiles Value="$(ProjOutDir)"/> 52 | <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 53 | </SearchPaths> 54 | </CompilerOptions> 55 | <Debugging> 56 | <Exceptions Count="3"> 57 | <Item1> 58 | <Name Value="EAbort"/> 59 | </Item1> 60 | <Item2> 61 | <Name Value="ECodetoolError"/> 62 | </Item2> 63 | <Item3> 64 | <Name Value="EFOpenError"/> 65 | </Item3> 66 | </Exceptions> 67 | </Debugging> 68 | </CONFIG> 69 | -------------------------------------------------------------------------------- /code-samples/loops.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | {$R+} // range checking on - nice for debugging 4 | 5 | var 6 | MyArray: array [0..9] of Integer; 7 | I: Integer; 8 | begin 9 | // initialize 10 | for I := 0 to 9 do 11 | MyArray[I] := I * I; 12 | 13 | // show 14 | for I := 0 to 9 do 15 | WriteLn('Square is ', MyArray[I]); 16 | 17 | // does the same as above 18 | for I := Low(MyArray) to High(MyArray) do 19 | WriteLn('Square is ', MyArray[I]); 20 | 21 | // does the same as above 22 | I := 0; 23 | while I < 10 do 24 | begin 25 | WriteLn('Square is ', MyArray[I]); 26 | I := I + 1; // or "I += 1", or "Inc(I)" 27 | end; 28 | 29 | // does the same as above 30 | I := 0; 31 | repeat 32 | WriteLn('Square is ', MyArray[I]); 33 | Inc(I); 34 | until I = 10; 35 | 36 | // does the same as above 37 | // note: here I enumerates MyArray values, not indexes 38 | for I in MyArray do 39 | WriteLn('Square is ', I); 40 | end. -------------------------------------------------------------------------------- /code-samples/method_calls_inheritance_1.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils; 5 | 6 | type 7 | TMyClass1 = class 8 | procedure MyMethod; 9 | end; 10 | 11 | TMyClass2 = class(TMyClass1) 12 | procedure MyMethod; 13 | procedure MyOtherMethod; 14 | end; 15 | 16 | procedure TMyClass1.MyMethod; 17 | begin 18 | Writeln('TMyClass1.MyMethod'); 19 | end; 20 | 21 | procedure TMyClass2.MyMethod; 22 | begin 23 | Writeln('TMyClass2.MyMethod'); 24 | end; 25 | 26 | procedure TMyClass2.MyOtherMethod; 27 | begin 28 | MyMethod; // this calls TMyClass2.MyMethod 29 | end; 30 | 31 | var 32 | C: TMyClass2; 33 | begin 34 | C := TMyClass2.Create; 35 | try 36 | C.MyOtherMethod; 37 | finally FreeAndNil(C) end; 38 | end. 39 | -------------------------------------------------------------------------------- /code-samples/method_calls_inherited.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils; 5 | 6 | type 7 | TMyClass1 = class 8 | constructor Create; 9 | procedure MyMethod(const A: Integer); 10 | end; 11 | 12 | TMyClass2 = class(TMyClass1) 13 | constructor Create; 14 | procedure MyMethod(const A: Integer); 15 | end; 16 | 17 | constructor TMyClass1.Create; 18 | begin 19 | inherited Create; // this calls TObject.Create 20 | Writeln('TMyClass1.Create'); 21 | end; 22 | 23 | procedure TMyClass1.MyMethod(const A: Integer); 24 | begin 25 | Writeln('TMyClass1.MyMethod ', A); 26 | end; 27 | 28 | constructor TMyClass2.Create; 29 | begin 30 | inherited Create; // this calls TMyClass1.Create 31 | Writeln('TMyClass2.Create'); 32 | end; 33 | 34 | procedure TMyClass2.MyMethod(const A: Integer); 35 | begin 36 | inherited MyMethod(A); // this calls TMyClass1.MyMethod 37 | Writeln('TMyClass2.MyMethod ', A); 38 | end; 39 | 40 | var 41 | C: TMyClass2; 42 | begin 43 | C := TMyClass2.Create; 44 | try 45 | C.MyMethod(123); 46 | finally FreeAndNil(C) end; 47 | end. 48 | -------------------------------------------------------------------------------- /code-samples/method_with_self_nil.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | { The expected output: 5 | 6 | $ fpc method_with_self_nil.dpr 7 | $ ./method_with_self_nil 8 | WriteSomethig: Self <> nil? FALSE 9 | Runtime error 216 at $000000000040119D 10 | $000000000040119D 11 | $0000000000422F7C 12 | } 13 | 14 | type 15 | TMyClass = class 16 | procedure WriteSomethig; 17 | procedure WriteSomethigVirtual; virtual; 18 | end; 19 | 20 | procedure TMyClass.WriteSomethig; 21 | begin 22 | Writeln('WriteSomethig: Self <> nil? ', Self <> nil); 23 | end; 24 | 25 | procedure TMyClass.WriteSomethigVirtual; 26 | begin 27 | Writeln('WriteSomethigVirtual: Self <> nil? ', Self <> nil); 28 | end; 29 | 30 | var 31 | C: TMyClass; 32 | begin 33 | { This test deliberately calls method with Self = nil. 34 | This is a dirty trick, should not be used (is definitely counter-intuitive as a programming pattern) 35 | but it works on non-virtual methods, 36 | and standard Free actually does it ("if Self <> nil then Destroy"). 37 | } 38 | 39 | // this works 40 | C.WriteSomethig; 41 | 42 | // this will crash 43 | C.WriteSomethigVirtual; 44 | end. 45 | -------------------------------------------------------------------------------- /code-samples/myconfig.inc: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} 2 | {$mode objfpc} 3 | {$H+} 4 | {$J-} 5 | {$modeswitch advancedrecords} 6 | {$ifdef VER2} 7 | {$message fatal 'This code can only be compiled using FPC version >= 3.0.'} 8 | {$endif} 9 | {$endif} 10 | -------------------------------------------------------------------------------- /code-samples/myunit.pas: -------------------------------------------------------------------------------- 1 | unit MyUnit; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | 5 | interface 6 | 7 | procedure MyProcedure(const A: Integer); 8 | function MyFunction(const S: string): string; 9 | 10 | implementation 11 | 12 | procedure MyProcedure(const A: Integer); 13 | begin 14 | WriteLn('A + 10 is: ', A + 10); 15 | end; 16 | 17 | function MyFunction(const S: string): string; 18 | begin 19 | Result := S + 'strings are automatically managed'; 20 | end; 21 | 22 | end. 23 | -------------------------------------------------------------------------------- /code-samples/myunit_test.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | program MyProgram; 5 | 6 | uses 7 | MyUnit; 8 | 9 | begin 10 | WriteLn(MyFunction('Note: ')); 11 | MyProcedure(5); 12 | end. 13 | -------------------------------------------------------------------------------- /code-samples/operator_overloading.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | {$ifndef FPC} 5 | {$message warn 'Delphi does not support global operator overloading'} 6 | begin end. 7 | {$endif} 8 | 9 | uses 10 | StrUtils; 11 | 12 | operator* (const S: string; const A: Integer): string; 13 | begin 14 | Result := DupeString(S, A); 15 | end; 16 | 17 | begin 18 | WriteLn('bla' * 10); 19 | end. -------------------------------------------------------------------------------- /code-samples/operator_overloading_class_operator.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} 2 | {$mode objfpc}{$H+}{$J-} 3 | {$modeswitch advancedrecords} 4 | {$endif} 5 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 6 | 7 | uses SysUtils; 8 | 9 | type 10 | TVector3 = record 11 | public 12 | X, Y, Z: Single; 13 | class operator {$ifdef FPC}+{$else}Add{$endif} 14 | (const A, B: TVector3): TVector3; 15 | class operator {$ifdef FPC}*{$else}Multiply{$endif} 16 | (const V: TVector3; const Scalar: Single): TVector3; 17 | function ToString: String; 18 | end; 19 | 20 | class operator TVector3.{$ifdef FPC}+{$else}Add{$endif} 21 | (const A, B: TVector3): TVector3; 22 | begin 23 | Result.X := A.X + B.X; 24 | Result.Y := A.Y + B.Y; 25 | Result.Z := A.Z + B.Z; 26 | end; 27 | 28 | class operator TVector3.{$ifdef FPC}*{$else}Multiply{$endif} 29 | (const V: TVector3; const Scalar: Single): TVector3; 30 | begin 31 | Result.X := V.X * Scalar; 32 | Result.Y := V.Y * Scalar; 33 | Result.Z := V.Z * Scalar; 34 | end; 35 | 36 | function TVector3.ToString: String; 37 | begin 38 | Result := Format('(%f, %f, %f)', [X, Y, Z]); 39 | end; 40 | 41 | var 42 | V1, V2: TVector3; 43 | begin 44 | V1.X := 1.0; V1.Y := 2.0; V1.Z := 3.0; 45 | V2.X := 4.0; V2.Y := 5.0; V2.Z := 6.0; 46 | WriteLn('V1: ', V1.ToString); 47 | WriteLn('V2: ', V2.ToString); 48 | WriteLn('V1 + V2: ', (V1 + V2).ToString); 49 | WriteLn('V1 * 10: ', (V1 * 10).ToString); 50 | end. 51 | -------------------------------------------------------------------------------- /code-samples/operator_overloading_classes.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | {$ifndef FPC} 5 | {$message warn 'Delphi does not support global operator overloading'} 6 | begin end. 7 | {$endif} 8 | 9 | uses 10 | SysUtils; 11 | 12 | type 13 | TMyClass = class 14 | MyInt: Integer; 15 | end; 16 | 17 | operator* (const C1, C2: TMyClass): TMyClass; 18 | begin 19 | Result := TMyClass.Create; 20 | Result.MyInt := C1.MyInt * C2.MyInt; 21 | end; 22 | 23 | var 24 | C1, C2: TMyClass; 25 | begin 26 | C1 := TMyClass.Create; 27 | try 28 | C1.MyInt := 12; 29 | C2 := C1 * C1; 30 | try 31 | WriteLn('12 * 12 = ', C2.MyInt); 32 | finally 33 | FreeAndNil(C2); 34 | end; 35 | finally 36 | FreeAndNil(C1); 37 | end; 38 | end. -------------------------------------------------------------------------------- /code-samples/operator_overloading_records.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | {$ifndef FPC} 5 | {$message warn 'Delphi does not support global operator overloading'} 6 | begin end. 7 | {$endif} 8 | 9 | uses SysUtils; 10 | 11 | type 12 | TMyRecord = record 13 | MyInt: Integer; 14 | end; 15 | 16 | operator* (const C1, C2: TMyRecord): TMyRecord; 17 | begin 18 | Result.MyInt := C1.MyInt * C2.MyInt; 19 | end; 20 | 21 | var 22 | R1, R2: TMyRecord; 23 | begin 24 | R1.MyInt := 12; 25 | R2 := R1 * R1; 26 | WriteLn('12 * 12 = ', R2.MyInt); 27 | end. -------------------------------------------------------------------------------- /code-samples/operator_overloading_records_lists.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} 2 | {$mode objfpc}{$H+}{$J-} 3 | {$modeswitch advancedrecords} 4 | {$endif} 5 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 6 | 7 | {$ifndef FPC} 8 | {$message warn 'Delphi does not have FGL unit'} 9 | begin end. 10 | {$endif} 11 | 12 | uses 13 | SysUtils, FGL; 14 | 15 | type 16 | TMyRecord = record 17 | MyInt: Integer; 18 | class operator+ (const C1, C2: TMyRecord): TMyRecord; 19 | class operator= (const C1, C2: TMyRecord): boolean; 20 | end; 21 | 22 | class operator TMyRecord.+ (const C1, C2: TMyRecord): TMyRecord; 23 | begin 24 | Result.MyInt := C1.MyInt + C2.MyInt; 25 | end; 26 | 27 | class operator TMyRecord.= (const C1, C2: TMyRecord): boolean; 28 | begin 29 | Result := C1.MyInt = C2.MyInt; 30 | end; 31 | 32 | type 33 | TMyRecordList = {$ifdef FPC}specialize{$endif} TFPGList<TMyRecord>; 34 | 35 | var 36 | R, ListItem: TMyRecord; 37 | L: TMyRecordList; 38 | begin 39 | L := TMyRecordList.Create; 40 | try 41 | R.MyInt := 1; L.Add(R); 42 | R.MyInt := 10; L.Add(R); 43 | R.MyInt := 100; L.Add(R); 44 | 45 | R.MyInt := 0; 46 | for ListItem in L do 47 | R := ListItem + R; 48 | 49 | WriteLn('1 + 10 + 100 = ', R.MyInt); 50 | finally 51 | FreeAndNil(L); 52 | end; 53 | end. -------------------------------------------------------------------------------- /code-samples/persistent.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses 5 | SysUtils, Classes; 6 | 7 | type 8 | TMyClass = class(TPersistent) 9 | public 10 | MyInt: Integer; 11 | procedure Assign(Source: TPersistent); override; 12 | end; 13 | 14 | TMyClassDescendant = class(TMyClass) 15 | public 16 | MyString: string; 17 | procedure Assign(Source: TPersistent); override; 18 | end; 19 | 20 | procedure TMyClass.Assign(Source: TPersistent); 21 | var 22 | SourceMyClass: TMyClass; 23 | begin 24 | if Source is TMyClass then 25 | begin 26 | SourceMyClass := TMyClass(Source); 27 | MyInt := SourceMyClass.MyInt; 28 | // Xxx := SourceMyClass.Xxx; // add new fields here 29 | end else 30 | { Since TMyClass is a direct TPersistent descendant, 31 | it calls inherited ONLY when it cannot handle Source class. 32 | See comments below. } 33 | inherited Assign(Source); 34 | end; 35 | 36 | procedure TMyClassDescendant.Assign(Source: TPersistent); 37 | var 38 | SourceMyClassDescendant: TMyClassDescendant; 39 | begin 40 | if Source is TMyClassDescendant then 41 | begin 42 | SourceMyClassDescendant := TMyClassDescendant(Source); 43 | MyString := SourceMyClassDescendant.MyString; 44 | // Xxx := SourceMyClassDescendant.Xxx; // add new fields here 45 | end; 46 | 47 | { Since TMyClassDescendant has an ancestor that already overrides 48 | Assign (in TMyClass.Assign), it calls inherited ALWAYS, 49 | to allow TMyClass.Assign to handle remaining fields. 50 | See comments below for a detailed reasoning. } 51 | inherited Assign(Source); 52 | end; 53 | 54 | var 55 | C1, C2: TMyClass; 56 | CD1, CD2: TMyClassDescendant; 57 | begin 58 | // test TMyClass.Assign 59 | C1 := TMyClass.Create; 60 | C2 := TMyClass.Create; 61 | try 62 | C1.MyInt := 666; 63 | C2.Assign(C1); 64 | WriteLn('C2 state: ', C2.MyInt); 65 | finally 66 | FreeAndNil(C1); 67 | FreeAndNil(C2); 68 | end; 69 | 70 | // test TMyClassDescendant.Assign 71 | CD1 := TMyClassDescendant.Create; 72 | CD2 := TMyClassDescendant.Create; 73 | try 74 | CD1.MyInt := 44; 75 | CD1.MyString := 'blah'; 76 | CD2.Assign(CD1); 77 | WriteLn('CD2 state: ', CD2.MyInt, ' ', CD2.MyString); 78 | finally 79 | FreeAndNil(CD1); 80 | FreeAndNil(CD2); 81 | end; 82 | end. -------------------------------------------------------------------------------- /code-samples/records.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} 2 | {$mode objfpc}{$H+}{$J-} 3 | {$modeswitch advancedrecords} 4 | {$endif} 5 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 6 | 7 | type 8 | TMyRecord = record 9 | public 10 | I, Square: Integer; 11 | procedure WriteLnDescription; 12 | end; 13 | 14 | procedure TMyRecord.WriteLnDescription; 15 | begin 16 | WriteLn('Square of ', I, ' is ', Square); 17 | end; 18 | 19 | var 20 | A: array [0..9] of TMyRecord; 21 | R: TMyRecord; 22 | I: Integer; 23 | begin 24 | for I := 0 to 9 do 25 | begin 26 | A[I].I := I; 27 | A[I].Square := I * I; 28 | end; 29 | 30 | for R in A do 31 | R.WriteLnDescription; 32 | end. 33 | -------------------------------------------------------------------------------- /code-samples/static_class_method.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | type 5 | TMyCallback = procedure (A: Integer); 6 | 7 | TMyClass = class 8 | class procedure Foo(A: Integer); static; 9 | end; 10 | 11 | class procedure TMyClass.Foo(A: Integer); 12 | begin 13 | end; 14 | 15 | var 16 | Callback: TMyCallback; 17 | begin 18 | Callback := @TMyClass.Foo; 19 | end. 20 | -------------------------------------------------------------------------------- /code-samples/test_myconfig.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 2 | 3 | { Compile this to test that myconfig.inc is valid. } 4 | {$I myconfig.inc} 5 | 6 | begin 7 | end. -------------------------------------------------------------------------------- /code-samples/variant_in_record.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | 3 | type 4 | TVector2 = packed record 5 | case Integer of 6 | 0: (X, Y: Single); 7 | 1: (Data: array [0..1] of Single); 8 | end; 9 | 10 | TVector3 = packed record 11 | case Integer of 12 | 0: (X, Y, Z: Single); 13 | 1: (Data: array [0..2] of Single); 14 | 2: (XY: TVector2); 15 | end; 16 | 17 | 18 | var 19 | V2: TVector2; 20 | V: TVector3; 21 | I: Integer; 22 | begin 23 | Writeln('Size of TVector2 is ', SizeOf(TVector2)); 24 | Writeln(' Should be equal to ', SizeOf(Single) * 2); 25 | 26 | Writeln('Size of TVector3 is ', SizeOf(TVector3)); 27 | Writeln(' Should be equal to ', SizeOf(Single) * 3); 28 | 29 | V.X := 1; 30 | V.Y := 2; 31 | V.Z := 3; 32 | 33 | for I := 0 to 2 do 34 | Writeln('V.Data[', I, '] is ', V.Data[I]:1:2); 35 | 36 | V2 := V.XY; 37 | 38 | for I := 0 to 1 do 39 | Writeln('V2.Data[', I, '] is ', V2.Data[I]:1:2); 40 | end. -------------------------------------------------------------------------------- /code-samples/variant_types.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | 3 | uses Variants; 4 | var 5 | V1, V2, V3: Variant; 6 | begin 7 | V1 := 'My String'; 8 | V1 := 123; // V1 no longer holds String, it has Integer now 9 | V2 := 456.789; 10 | V3 := V1 + V2; // result is float 11 | Writeln('V3 = ', V3); 12 | end. 13 | -------------------------------------------------------------------------------- /code-samples/with_virtual_methods.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils; 5 | 6 | type 7 | TFruit = class 8 | procedure Eat; virtual; 9 | end; 10 | 11 | TApple = class(TFruit) 12 | procedure Eat; override; 13 | end; 14 | 15 | procedure TFruit.Eat; 16 | begin 17 | Writeln('Eating a fruit'); 18 | end; 19 | 20 | procedure TApple.Eat; 21 | begin 22 | Writeln('Eating an apple'); 23 | end; 24 | 25 | procedure DoSomethingWithAFruit(const Fruit: TFruit); 26 | begin 27 | Writeln('We have a fruit with class ', Fruit.ClassName); 28 | Writeln('We eat it:'); 29 | Fruit.Eat; 30 | end; 31 | 32 | var 33 | Apple: TApple; // Note: you could also declare "Apple: TFruit" here 34 | begin 35 | Apple := TApple.Create; 36 | try 37 | DoSomethingWithAFruit(Apple); 38 | finally FreeAndNil(Apple) end; 39 | end. 40 | -------------------------------------------------------------------------------- /code-samples/without_virtual_methods.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils; 5 | 6 | type 7 | TFruit = class 8 | procedure Eat; 9 | end; 10 | 11 | TApple = class(TFruit) 12 | procedure Eat; 13 | end; 14 | 15 | procedure TFruit.Eat; 16 | begin 17 | Writeln('Eating a fruit'); 18 | end; 19 | 20 | procedure TApple.Eat; 21 | begin 22 | Writeln('Eating an apple'); 23 | end; 24 | 25 | procedure DoSomethingWithAFruit(const Fruit: TFruit); 26 | begin 27 | Writeln('We have a fruit with class ', Fruit.ClassName); 28 | Writeln('We eat it:'); 29 | Fruit.Eat; 30 | end; 31 | 32 | var 33 | Apple: TApple; // Note: you could also declare "Apple: TFruit" here 34 | begin 35 | Apple := TApple.Create; 36 | try 37 | DoSomethingWithAFruit(Apple); 38 | finally FreeAndNil(Apple) end; 39 | end. 40 | -------------------------------------------------------------------------------- /code-samples_bg/Makefile: -------------------------------------------------------------------------------- 1 | UNIT_SOURCES:=$(wildcard *.pas) 2 | PROGRAM_SOURCES:=$(wildcard *.lpr) 3 | PROGRAM_BINARIES:=$(PROGRAM_SOURCES:.lpr=) 4 | 5 | .PHONY: all 6 | all: 7 | $(foreach UNIT_NAME,$(UNIT_SOURCES),fpc $(UNIT_NAME) && ) true 8 | $(foreach PROGRAM_NAME,$(PROGRAM_SOURCES),fpc $(PROGRAM_NAME) && ) true 9 | 10 | .PHONY: clean 11 | clean: 12 | rm -Rf *.o *.ppu $(PROGRAM_BINARIES) 13 | -------------------------------------------------------------------------------- /code-samples_bg/anotherunit.pas: -------------------------------------------------------------------------------- 1 | unit AnotherUnit; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | 5 | interface 6 | 7 | uses Classes; 8 | 9 | { Типът (клас) "TComponent" е дефиниран в unit Classes. 10 | Поради тази причина трябва да използваме uses Classes; по-горе. } 11 | procedure DoSomethingWithComponent(var C: TComponent); 12 | 13 | implementation 14 | 15 | uses SysUtils; 16 | 17 | procedure DoSomethingWithComponent(var C: TComponent); 18 | begin 19 | { Процедурата FreeAndNil е дефинирана в unit SysUtils. 20 | Тъй като го използваме само в реализацията а не в интерфейсната част, 21 | достатъчно е да използваме uses SysUtils; в секция "implementation". } 22 | FreeAndNil(C); 23 | end; 24 | 25 | end. 26 | -------------------------------------------------------------------------------- /code-samples_bg/exception_in_constructor_test.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses 5 | SysUtils; 6 | 7 | type 8 | TGun = class 9 | end; 10 | 11 | TPlayer = class 12 | Gun1, Gun2: TGun; 13 | constructor Create; 14 | destructor Destroy; override; 15 | end; 16 | 17 | constructor TPlayer.Create; 18 | begin 19 | inherited; 20 | Gun1 := TGun.Create; 21 | raise Exception.Create('Предизвикано изключение от конструктор!'); 22 | Gun2 := TGun.Create; 23 | end; 24 | 25 | destructor TPlayer.Destroy; 26 | begin 27 | { в случай, че конструктора крашне, бихме могли 28 | да имаме ситуация с Gun1 <> nil и Gun2 = nil. Справете се с това. 29 | ... Всъщност в случая FreeAndNil ще се справи без 30 | допълнителни усилия от наша страна, защото FreeAndNil проверява 31 | дали инстанцията е nil преди да извика деструктора. } 32 | FreeAndNil(Gun1); 33 | FreeAndNil(Gun2); 34 | inherited; 35 | end; 36 | 37 | begin 38 | try 39 | TPlayer.Create; 40 | except 41 | on E: Exception do 42 | WriteLn('Уловено ' + E.ClassName + ': ' + E.Message); 43 | end; 44 | end. 45 | -------------------------------------------------------------------------------- /code-samples_bg/for_in_list.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses 5 | SysUtils, FGL; 6 | 7 | type 8 | TMyClass = class 9 | I, Square: Integer; 10 | end; 11 | TMyClassList = {$ifdef FPC}specialize{$endif} TFPGObjectList<TMyClass>; 12 | 13 | var 14 | List: TMyClassList; 15 | C: TMyClass; 16 | I: Integer; 17 | begin 18 | List := TMyClassList.Create(true); // true = притежава елементите си 19 | try 20 | for I := 0 to 9 do 21 | begin 22 | C := TMyClass.Create; 23 | C.I := I; 24 | C.Square := I * I; 25 | List.Add(C); 26 | end; 27 | 28 | for C in List do 29 | WriteLn('Квадрата на ', C.I, ' е ', C.Square); 30 | finally 31 | FreeAndNil(List); 32 | end; 33 | end. -------------------------------------------------------------------------------- /code-samples_bg/functions_primitives.dpr: -------------------------------------------------------------------------------- 1 | program MyProgram; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 5 | 6 | procedure MyProcedure(const A: Integer); 7 | begin 8 | WriteLn('A + 10 е: ', A + 10); 9 | end; 10 | 11 | function MyFunction(const S: string): string; 12 | begin 13 | Result := S + 'низовете се управляват автоматично'; 14 | end; 15 | 16 | var 17 | X: Single; 18 | begin 19 | WriteLn(MyFunction('Забележка: ')); 20 | MyProcedure(5); 21 | 22 | // Делението с "/" винаги дава резултат float, 23 | // използвайте "div" за целочислено делене 24 | X := 15 / 5; 25 | WriteLn('X сега е: ', X); // научна нотация 26 | WriteLn('X сега е: ', X:1:2); // 2 десетични знака 27 | end. 28 | -------------------------------------------------------------------------------- /code-samples_bg/generics_dictionary.dpr: -------------------------------------------------------------------------------- 1 | {$mode objfpc}{$H+}{$J-} 2 | uses SysUtils, Generics.Collections; 3 | 4 | type 5 | TApple = class 6 | Name: string; 7 | end; 8 | 9 | TAppleDictionary = {$ifdef FPC}specialize{$endif} TDictionary<String, TApple>; 10 | 11 | var 12 | Apples: TAppleDictionary; 13 | A, FoundA: TApple; 14 | ApplePair: {$ifdef FPC} TAppleDictionary.TDictionaryPair {$else} TPair<String, TApple> {$endif}; 15 | AppleKey: string; 16 | begin 17 | Apples := TAppleDictionary.Create; 18 | try 19 | A := TApple.Create; 20 | A.Name := 'моята ябълка'; 21 | Apples.AddOrSetValue('ключ за ябълка 1', A); 22 | 23 | if Apples.TryGetValue('ключ за ябълка 1', FoundA) then 24 | Writeln('Намерена ябълка с ключ "ключ за ябълка 1" с име: ' + 25 | FoundA.Name); 26 | 27 | for AppleKey in Apples.Keys do 28 | Writeln('Намерен ключ за ябълка: ' + AppleKey); 29 | for A in Apples.Values do 30 | Writeln('Намерена ябълка с име: ' + A.Name); 31 | for ApplePair in Apples do 32 | Writeln('Намерен ключ за ябълка->име на ябълка: ' + 33 | ApplePair.Key + '->' + ApplePair.Value.Name); 34 | 35 | { Долният ред също работи, но може да се използва само да 36 | зададе стойност на *съществуващ* ключ в речника. 37 | Вместо това обикновено се използва AddOrSetValue 38 | за да се зададе или добави нов ключ ако е необходимо. } 39 | // Apples['ключ за ябълка 1'] := ... ; 40 | 41 | Apples.Remove('ключ за ябълка 1'); 42 | 43 | { Забележете, че TDictionary не притежава елементите си 44 | и трябва да ги освобожавате ръчно. 45 | Може да използвате TObjectDictionary за да имате автоматичен 46 | режим за притежание. } 47 | A.Free; 48 | finally FreeAndNil(Apples) end; 49 | end. 50 | -------------------------------------------------------------------------------- /code-samples_bg/hello_world.dpr: -------------------------------------------------------------------------------- 1 | // Използвайте този ред във всички нови програми 2 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 3 | // Needed for console programs on Windows, 4 | // otherwise (with Delphi) the default is GUI program without console. 5 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 6 | 7 | program MyProgram; // Запишете файла като myprogram.dpr 8 | begin 9 | WriteLn('Hello world!'); 10 | end. 11 | -------------------------------------------------------------------------------- /code-samples_bg/interface_casting.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | // {$interfaces corba} // забележете, че "as" конверсии за CORBA няма да се компилират 5 | 6 | uses Classes; 7 | 8 | type 9 | IMyInterface = interface 10 | ['{7FC754BC-9CA7-4399-B947-D37DD30BA90A}'] 11 | procedure One; 12 | end; 13 | 14 | IMyInterface2 = interface(IMyInterface) 15 | ['{A72B7008-3F90-45C1-8F4C-E77C4302AA3E}'] 16 | procedure Two; 17 | end; 18 | 19 | IMyInterface3 = interface(IMyInterface2) 20 | ['{924BFB98-B049-4945-AF17-1DB08DB1C0C5}'] 21 | procedure Three; 22 | end; 23 | 24 | TMyClass = class(TComponent, IMyInterface) 25 | procedure One; 26 | end; 27 | 28 | TMyClass2 = class(TMyClass, IMyInterface, IMyInterface2) 29 | procedure One; 30 | procedure Two; 31 | end; 32 | 33 | procedure TMyClass.One; 34 | begin 35 | Writeln('TMyClass.One'); 36 | end; 37 | 38 | procedure TMyClass2.One; 39 | begin 40 | Writeln('TMyClass2.One'); 41 | end; 42 | 43 | procedure TMyClass2.Two; 44 | begin 45 | Writeln('TMyClass2.Two'); 46 | end; 47 | 48 | procedure UseInterface2(const I: IMyInterface2); 49 | begin 50 | I.One; 51 | I.Two; 52 | end; 53 | 54 | procedure UseInterface3(const I: IMyInterface3); 55 | begin 56 | I.One; 57 | I.Two; 58 | I.Three; 59 | end; 60 | 61 | var 62 | My: IMyInterface; 63 | MyClass: TMyClass; 64 | begin 65 | My := TMyClass2.Create(nil); 66 | MyClass := TMyClass2.Create(nil); 67 | 68 | // Това не може да с компилира, не е известно дали My е IMyInterface2. 69 | // UseInterface2(My); 70 | // UseInterface2(MyClass); 71 | 72 | // Това се компилира и работи. 73 | UseInterface2(IMyInterface2(My)); 74 | // Това не може да с компилира. Преобразуването InterfaceType(ClassType) се проверява при компилация. 75 | // UseInterface2(IMyInterface2(MyClass)); 76 | 77 | // Това се компилира и работи. 78 | UseInterface2(My as IMyInterface2); 79 | // Това се компилира и работи. 80 | UseInterface2(MyClass as IMyInterface2); 81 | 82 | // Това се компилира но не работи при изпълнение, с грозно "Access violation". 83 | // UseInterface3(IMyInterface3(My)); 84 | // Това не може да с компилира. Преобразуването InterfaceType(ClassType) се проверява при компилация. 85 | // UseInterface3(IMyInterface3(MyClass)); 86 | 87 | // Това се компилира но не работи при изпълнение, с хубаво "EInvalidCast: Invalid type cast". 88 | // UseInterface3(My as IMyInterface3); 89 | // Това се компилира но не работи при изпълнение, с хубаво "EInvalidCast: Invalid type cast". 90 | // UseInterface3(MyClass as IMyInterface3); 91 | 92 | Writeln('Край'); 93 | end. 94 | -------------------------------------------------------------------------------- /code-samples_bg/interfaces_com_with_ref_counting.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} 2 | {$mode objfpc}{$H+}{$J-} 3 | {$interfaces com} 4 | {$endif} 5 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 6 | 7 | uses 8 | SysUtils, Classes; 9 | 10 | type 11 | IMyInterface = interface 12 | ['{3075FFCD-8EFB-4E98-B157-261448B8D92E}'] 13 | procedure Shoot; 14 | end; 15 | 16 | TMyClass1 = class(TInterfacedObject, IMyInterface) 17 | procedure Shoot; 18 | end; 19 | 20 | TMyClass2 = class(TInterfacedObject, IMyInterface) 21 | procedure Shoot; 22 | end; 23 | 24 | TMyClass3 = class(TInterfacedObject) 25 | procedure Shoot; 26 | end; 27 | 28 | procedure TMyClass1.Shoot; 29 | begin 30 | WriteLn('TMyClass1.Shoot'); 31 | end; 32 | 33 | procedure TMyClass2.Shoot; 34 | begin 35 | WriteLn('TMyClass2.Shoot'); 36 | end; 37 | 38 | procedure TMyClass3.Shoot; 39 | begin 40 | WriteLn('TMyClass3.Shoot'); 41 | end; 42 | 43 | procedure UseThroughInterface(I: IMyInterface); 44 | begin 45 | Write('Shooting... '); 46 | I.Shoot; 47 | end; 48 | 49 | var 50 | C1: IMyInterface; // COM се грижи за унищожаването 51 | C2: IMyInterface; // COM се грижи за унищожаването 52 | C3: TMyClass3; // ВИЕ трябва да се погрижите за унищожаването 53 | begin 54 | C1 := TMyClass1.Create as IMyInterface; 55 | C2 := TMyClass2.Create as IMyInterface; 56 | C3 := TMyClass3.Create; 57 | try 58 | UseThroughInterface(C1); // няма нужда от оператор "as" 59 | UseThroughInterface(C2); 60 | if C3 is IMyInterface then 61 | UseThroughInterface(C3 as IMyInterface); // това няма да се изпълни 62 | finally 63 | { Променливи C1 и C2 излизат от обхват и тук би трябвало да се 64 | унищожат автоматично. 65 | 66 | За разлика от тях, C3 е инстанция, която не се управлява от интерфейс 67 | и трябва да се унищожи ръчно. } 68 | FreeAndNil(C3); 69 | end; 70 | end. -------------------------------------------------------------------------------- /code-samples_bg/is_as.dpr: -------------------------------------------------------------------------------- 1 | program is_as; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 5 | 6 | uses SysUtils; 7 | 8 | type 9 | TMyClass = class 10 | procedure MyMethod; 11 | end; 12 | 13 | TMyClassDescendant = class(TMyClass) 14 | procedure MyMethodInDescendant; 15 | end; 16 | 17 | procedure TMyClass.MyMethod; 18 | begin 19 | WriteLn('MyMethod'); 20 | end; 21 | 22 | procedure TMyClassDescendant.MyMethodInDescendant; 23 | begin 24 | WriteLn('MyMethodInDescendant'); 25 | end; 26 | 27 | var 28 | Descendant: TMyClassDescendant; 29 | C: TMyClass; 30 | begin 31 | Descendant := TMyClassDescendant.Create; 32 | try 33 | Descendant.MyMethod; 34 | Descendant.MyMethodInDescendant; 35 | 36 | { Descendant има цялата функционалност, която се очаква от 37 | TMyClass, така че това присвояване е OK } 38 | C := Descendant; 39 | C.MyMethod; 40 | 41 | { Това не може да сработи, тъй като TMyClass не дефинира този метод } 42 | //C.MyMethodInDescendant; 43 | if C is TMyClassDescendant then 44 | (C as TMyClassDescendant).MyMethodInDescendant; 45 | 46 | finally 47 | FreeAndNil(Descendant); 48 | end; 49 | end. 50 | -------------------------------------------------------------------------------- /code-samples_bg/loops.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | {$R+} // включена проверка на диапазона - подходящо за дебъг 4 | 5 | var 6 | MyArray: array [0..9] of Integer; 7 | I: Integer; 8 | begin 9 | // инизиализация 10 | for I := 0 to 9 do 11 | MyArray[I] := I * I; 12 | 13 | // показване 14 | for I := 0 to 9 do 15 | WriteLn('Квадрата е ', MyArray[I]); 16 | 17 | // прави същото като горното 18 | for I := Low(MyArray) to High(MyArray) do 19 | WriteLn('Квадрата е ', MyArray[I]); 20 | 21 | // прави същото като горното 22 | I := 0; 23 | while I < 10 do 24 | begin 25 | WriteLn('Квадрата е ', MyArray[I]); 26 | I := I + 1; // или "I += 1", или "Inc(I)" 27 | end; 28 | 29 | // прави същото като горното 30 | I := 0; 31 | repeat 32 | WriteLn('Квадрата е ', MyArray[I]); 33 | Inc(I); 34 | until I = 10; 35 | 36 | // прави същото като горното 37 | // забележка: тук се изброяват стойностите на MyArray, а не индексите 38 | for I in MyArray do 39 | WriteLn('Квадрата е ', I); 40 | end. -------------------------------------------------------------------------------- /code-samples_bg/myconfig.inc: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} 2 | {$mode objfpc} 3 | {$H+} 4 | {$J-} 5 | {$modeswitch advancedrecords} 6 | {$ifdef VER2} 7 | {$message fatal 'This code can only be compiled using FPC version >= 3.0.'} 8 | {$endif} 9 | {$endif} 10 | -------------------------------------------------------------------------------- /code-samples_bg/myunit.pas: -------------------------------------------------------------------------------- 1 | unit MyUnit; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | 5 | interface 6 | 7 | procedure MyProcedure(const A: Integer); 8 | function MyFunction(const S: string): string; 9 | 10 | implementation 11 | 12 | procedure MyProcedure(const A: Integer); 13 | begin 14 | WriteLn('A + 10 е равно на: ', A + 10); 15 | end; 16 | 17 | function MyFunction(const S: string): string; 18 | begin 19 | Result := S + 'низовете се управляват автоматично'; 20 | end; 21 | 22 | end. 23 | -------------------------------------------------------------------------------- /code-samples_bg/myunit_test.dpr: -------------------------------------------------------------------------------- 1 | program MyProgram; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 5 | 6 | uses MyUnit; 7 | 8 | begin 9 | WriteLn(MyFunction('Забележка: ')); 10 | MyProcedure(5); 11 | end. 12 | -------------------------------------------------------------------------------- /code-samples_bg/persistent.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses 5 | SysUtils, Classes; 6 | 7 | type 8 | TMyClass = class(TPersistent) 9 | public 10 | MyInt: Integer; 11 | procedure Assign(Source: TPersistent); override; 12 | end; 13 | 14 | TMyClassDescendant = class(TMyClass) 15 | public 16 | MyString: string; 17 | procedure Assign(Source: TPersistent); override; 18 | end; 19 | 20 | procedure TMyClass.Assign(Source: TPersistent); 21 | var 22 | SourceMyClass: TMyClass; 23 | begin 24 | if Source is TMyClass then 25 | begin 26 | SourceMyClass := TMyClass(Source); 27 | MyInt := SourceMyClass.MyInt; 28 | // Xxx := SourceMyClass.Xxx; // копирайте още полета ако е необходимо ... 29 | end else 30 | { Поради това, че TMyClass е директен наследник на TPersistent, 31 | той извиква inherited САМО когато не знае как да обработи Source. 32 | Виж кометарите по-долу. } 33 | inherited Assign(Source); 34 | end; 35 | 36 | procedure TMyClassDescendant.Assign(Source: TPersistent); 37 | var 38 | SourceMyClassDescendant: TMyClassDescendant; 39 | begin 40 | if Source is TMyClassDescendant then 41 | begin 42 | SourceMyClassDescendant := TMyClassDescendant(Source); 43 | MyString := SourceMyClassDescendant.MyString; 44 | // Xxx := SourceMyClassDescendant.Xxx; // копирайте още полета ако е необходимо ... 45 | end; 46 | 47 | { Поради това, че TMyClassDescendant има предшественик, който вече е 48 | заменил Assign (in TMyClass.Assign), той извиква inherited ВИНАГИ, 49 | за да позволи TMyClass.Assign да копира останалите полета. 50 | Виж кометарите по-долу за детайлно обяснение. } 51 | inherited Assign(Source); 52 | end; 53 | 54 | var 55 | C1, C2: TMyClass; 56 | CD1, CD2: TMyClassDescendant; 57 | begin 58 | // тест TMyClass.Assign 59 | C1 := TMyClass.Create; 60 | C2 := TMyClass.Create; 61 | try 62 | C1.MyInt := 666; 63 | C2.Assign(C1); 64 | WriteLn('C2 state: ', C2.MyInt); 65 | finally 66 | FreeAndNil(C1); 67 | FreeAndNil(C2); 68 | end; 69 | 70 | // тест TMyClassDescendant.Assign 71 | CD1 := TMyClassDescendant.Create; 72 | CD2 := TMyClassDescendant.Create; 73 | try 74 | CD1.MyInt := 44; 75 | CD1.MyString := 'blah'; 76 | CD2.Assign(CD1); 77 | WriteLn('CD2 state: ', CD2.MyInt, ' ', CD2.MyString); 78 | finally 79 | FreeAndNil(CD1); 80 | FreeAndNil(CD2); 81 | end; 82 | end. -------------------------------------------------------------------------------- /code-samples_bg/test_myconfig.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 2 | 3 | { Compile this to test that myconfig.inc is valid. } 4 | {$I myconfig.inc} 5 | 6 | begin 7 | end. -------------------------------------------------------------------------------- /code-samples_bg/with_virtual_methods.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils; 5 | 6 | type 7 | TFruit = class 8 | procedure Eat; virtual; 9 | end; 10 | 11 | TApple = class(TFruit) 12 | procedure Eat; override; 13 | end; 14 | 15 | procedure TFruit.Eat; 16 | begin 17 | Writeln('Изядохме плод'); 18 | end; 19 | 20 | procedure TApple.Eat; 21 | begin 22 | Writeln('Изядохме ябълка'); 23 | end; 24 | 25 | procedure DoSomethingWithAFruit(const Fruit: TFruit); 26 | begin 27 | Writeln('Имаме плод от клас ', Fruit.ClassName); 28 | Writeln('Ядем го:'); 29 | Fruit.Eat; 30 | end; 31 | 32 | var 33 | Apple: TApple; // Забележка: тук също така може да декларирате "Apple: TFruit" 34 | begin 35 | Apple := TApple.Create; 36 | try 37 | DoSomethingWithAFruit(Apple); 38 | finally FreeAndNil(Apple) end; 39 | end. 40 | -------------------------------------------------------------------------------- /code-samples_bg/without_virtual_methods.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils; 5 | 6 | type 7 | TFruit = class 8 | procedure Eat; 9 | end; 10 | 11 | TApple = class(TFruit) 12 | procedure Eat; 13 | end; 14 | 15 | procedure TFruit.Eat; 16 | begin 17 | Writeln('Изядохме плод'); 18 | end; 19 | 20 | procedure TApple.Eat; 21 | begin 22 | Writeln('Изядохме ябълка'); 23 | end; 24 | 25 | procedure DoSomethingWithAFruit(const Fruit: TFruit); 26 | begin 27 | Writeln('Имаме плод от клас ', Fruit.ClassName); 28 | Writeln('Ядем го:'); 29 | Fruit.Eat; 30 | end; 31 | 32 | var 33 | Apple: TApple; // Забележка: тук също така може да декларирате "Apple: TFruit" 34 | begin 35 | Apple := TApple.Create; 36 | try 37 | DoSomethingWithAFruit(Apple); 38 | finally FreeAndNil(Apple) end; 39 | end. 40 | -------------------------------------------------------------------------------- /code-samples_russian/.gitignore: -------------------------------------------------------------------------------- 1 | *.ppu 2 | *.o 3 | *.exe 4 | callbacks 5 | callbacks_of_object 6 | class_properties 7 | exception_finally 8 | exception_in_constructor_test 9 | file_stream 10 | for_in_list 11 | functions_primitives 12 | gen_guid 13 | generic_functions 14 | generics 15 | generics_dictionary 16 | generics_lists 17 | generics_object_dictionary 18 | generics_sorting 19 | hello_world 20 | inheritance 21 | interfaces_com_test 22 | interfaces_com_with_ref_counting 23 | interfaces_corba_test 24 | interface_casting 25 | is_as 26 | lazarus/showcolor 27 | loops 28 | method_calls_inheritance_1 29 | method_calls_inherited 30 | my_binary_file.data 31 | myunit_test 32 | operator_overloading 33 | operator_overloading_classes 34 | operator_overloading_records 35 | operator_overloading_records_lists 36 | persistent 37 | records 38 | static_class_method 39 | with_virtual_methods 40 | without_virtual_methods 41 | lazarus/*.bak 42 | lazarus/*.lps 43 | lazarus/lib/ 44 | -------------------------------------------------------------------------------- /code-samples_russian/Makefile: -------------------------------------------------------------------------------- 1 | UNIT_SOURCES:=$(wildcard *.pas) 2 | PROGRAM_SOURCES:=$(wildcard *.lpr) 3 | PROGRAM_BINARIES:=$(PROGRAM_SOURCES:.lpr=) 4 | 5 | .PHONY: all 6 | all: 7 | $(foreach UNIT_NAME,$(UNIT_SOURCES),fpc $(UNIT_NAME) && ) true 8 | $(foreach PROGRAM_NAME,$(PROGRAM_SOURCES),fpc $(PROGRAM_NAME) && ) true 9 | 10 | .PHONY: clean 11 | clean: 12 | rm -Rf *.o *.ppu $(PROGRAM_BINARIES) 13 | -------------------------------------------------------------------------------- /code-samples_russian/anotherunit.pas: -------------------------------------------------------------------------------- 1 | unit AnotherUnit; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | 5 | interface 6 | 7 | uses 8 | Classes; 9 | 10 | { Тип класса "TComponent" определён в unit-е Classes. 11 | По этому необходимо использовать uses Classes, как видно выше. } 12 | procedure DoSomethingWithComponent(var C: TComponent); 13 | 14 | implementation 15 | 16 | uses 17 | SysUtils; 18 | 19 | procedure DoSomethingWithComponent(var C: TComponent); 20 | begin 21 | { Процедура FreeAndNil определена в unit-е SysUtils. 22 | Поскольку мы лишь ссылаемся на её имя в разделе implementation, 23 | вполне допустимо использовать SysUtils в секции "implementation". } 24 | FreeAndNil(C); 25 | end; 26 | 27 | end. 28 | -------------------------------------------------------------------------------- /code-samples_russian/exception_finally.dpr: -------------------------------------------------------------------------------- 1 | program MyProgram; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 5 | 6 | uses 7 | SysUtils; 8 | 9 | type 10 | TMyClass = class 11 | procedure MyMethod; 12 | end; 13 | 14 | procedure TMyClass.MyMethod; 15 | begin 16 | if Random > 0.5 then 17 | raise Exception.Create('Вызываем exception!'); 18 | end; 19 | 20 | var 21 | C: TMyClass; 22 | begin 23 | Randomize; 24 | C := TMyClass.Create; 25 | try 26 | C.MyMethod; 27 | finally 28 | FreeAndNil(C) 29 | end; 30 | end. 31 | -------------------------------------------------------------------------------- /code-samples_russian/exception_in_constructor_test.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses 5 | SysUtils; 6 | 7 | type 8 | TGun = class 9 | end; 10 | 11 | TPlayer = class 12 | Gun1, Gun2: TGun; 13 | constructor Create; 14 | destructor Destroy; override; 15 | end; 16 | 17 | constructor TPlayer.Create; 18 | begin 19 | inherited; 20 | Gun1 := TGun.Create; 21 | raise Exception.Create('Вызваем exception из constructor-а!'); 22 | Gun2 := TGun.Create; 23 | end; 24 | 25 | destructor TPlayer.Destroy; 26 | begin 27 | { В данном случае в результате ошибки в constructor-е, у нас 28 | может оказаться Gun1 <> nil и Gun2 = nil. Смиритесь. 29 | В таком случае, FreeAndNil справится с задачей без каких-либо 30 | дополнительных действий с нашей стороны, поскольку FreeAndNil проверяет 31 | является ли экземпляр класса nil перед вызовом соответствующего destructor-а. } 32 | FreeAndNil(Gun1); 33 | FreeAndNil(Gun2); 34 | inherited; 35 | end; 36 | 37 | begin 38 | try 39 | TPlayer.Create; 40 | except 41 | on E: Exception do 42 | WriteLn('Ошибка ' + E.ClassName + ': ' + E.Message); 43 | end; 44 | end. -------------------------------------------------------------------------------- /code-samples_russian/file_stream.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils, Classes; 5 | 6 | var 7 | S: TStream; 8 | InputInt, OutputInt: Integer; 9 | begin 10 | InputInt := 666; 11 | 12 | S := TFileStream.Create('my_binary_file.data', fmCreate); 13 | try 14 | S.WriteBuffer(InputInt, SizeOf(InputInt)); 15 | finally 16 | FreeAndNil(S); 17 | end; 18 | 19 | S := TFileStream.Create('my_binary_file.data', fmOpenRead); 20 | try 21 | S.ReadBuffer(OutputInt, SizeOf(OutputInt)); 22 | finally 23 | FreeAndNil(S); 24 | end; 25 | 26 | WriteLn('Из файла прочитано целое число: ', OutputInt); 27 | end. -------------------------------------------------------------------------------- /code-samples_russian/for_in_list.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses 5 | SysUtils, FGL; 6 | 7 | type 8 | TMyClass = class 9 | I, Square: Integer; 10 | end; 11 | TMyClassList = {$ifdef FPC}specialize{$endif} TFPGObjectList<TMyClass>; 12 | 13 | var 14 | List: TMyClassList; 15 | C: TMyClass; 16 | I: Integer; 17 | begin 18 | List := TMyClassList.Create(true); // значение true означает, что List владеет всеми дочерними объектами 19 | try 20 | for I := 0 to 9 do 21 | begin 22 | C := TMyClass.Create; 23 | C.I := I; 24 | C.Square := I * I; 25 | List.Add(C); 26 | end; 27 | 28 | for C in List do 29 | WriteLn('Квадрат ', C.I, ' составляет ', C.Square); 30 | finally 31 | FreeAndNil(List); 32 | end; 33 | end. -------------------------------------------------------------------------------- /code-samples_russian/functions_primitives.dpr: -------------------------------------------------------------------------------- 1 | program MyProgram; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 5 | 6 | procedure MyProcedure(const A: Integer); 7 | begin 8 | WriteLn('A + 10 составляет: ', A + 10); 9 | end; 10 | 11 | function MyFunction(const S: string): string; 12 | begin 13 | Result := S + 'строки управляются автоматически'; 14 | end; 15 | 16 | var 17 | X: Single; 18 | begin 19 | WriteLn(MyFunction('примечание: ')); 20 | MyProcedure(5); 21 | 22 | // деление с помощью оператора "/" всегда даёт результат с плавающей запятой 23 | // для целочисленного деления необходимо использовать "div" 24 | X := 15 / 5; 25 | WriteLn('X составляет: ', X); // отобразить в научном формате вида 3.0000000E+000 26 | WriteLn('X составляет: ', X:1:2); // отобразить 2 знака после запятой 27 | end. 28 | -------------------------------------------------------------------------------- /code-samples_russian/generic_functions.dpr: -------------------------------------------------------------------------------- 1 | uses SysUtils; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 5 | 6 | { Примечание: этот пример требует FPC 3.1.1 и не скомпилируется в FPC 3.0.0 или более ранних версиях. } 7 | 8 | generic function Min<T>(const A, B: T): T; 9 | begin 10 | if A < B then 11 | Result := A 12 | else 13 | Result := B; 14 | end; 15 | 16 | begin 17 | WriteLn('Min (1, 0): ', specialize Min<Integer>(1, 0)); 18 | WriteLn('Min (3.14, 5): ', specialize Min<Single>(3.14, 5):1:2); 19 | WriteLn('Min (''a'', ''b''): ', specialize Min<string>('a', 'b')); 20 | end. -------------------------------------------------------------------------------- /code-samples_russian/generics.dpr: -------------------------------------------------------------------------------- 1 | uses SysUtils; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 5 | 6 | type 7 | generic TMyCalculator<T> = class 8 | Value: T; 9 | procedure Add(const A: T); 10 | end; 11 | 12 | procedure TMyCalculator.Add(const A: T); 13 | begin 14 | Value := Value + A; 15 | end; 16 | 17 | type 18 | TMyFloatCalculator = {$ifdef FPC}specialize{$endif} TMyCalculator<Single>; 19 | TMyStringCalculator = {$ifdef FPC}specialize{$endif} TMyCalculator<string>; 20 | 21 | var 22 | FloatCalc: TMyFloatCalculator; 23 | StringCalc: TMyStringCalculator; 24 | begin 25 | FloatCalc := TMyFloatCalculator.Create; 26 | try 27 | FloatCalc.Add(3.14); 28 | FloatCalc.Add(1); 29 | WriteLn('Сложение величин типа Float: ', FloatCalc.Value:1:2); 30 | finally 31 | FreeAndNil(FloatCalc); 32 | end; 33 | 34 | StringCalc := TMyStringCalculator.Create; 35 | try 36 | StringCalc.Add('что-нибудь'); 37 | StringCalc.Add(' ещё'); 38 | WriteLn('Сложение величин типа String: ', StringCalc.Value); 39 | finally 40 | FreeAndNil(StringCalc); 41 | end; 42 | end. -------------------------------------------------------------------------------- /code-samples_russian/hello_world.dpr: -------------------------------------------------------------------------------- 1 | // Эту строку необходимо использовать во всех современных программах 2 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 3 | // Needed for console programs on Windows, 4 | // otherwise (with Delphi) the default is GUI program without console. 5 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 6 | 7 | program MyProgram; // Сохраните этот файл под названием myprogram.dpr 8 | begin 9 | WriteLn('Hello world!'); 10 | end. 11 | -------------------------------------------------------------------------------- /code-samples_russian/inheritance.dpr: -------------------------------------------------------------------------------- 1 | program MyProgram; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 5 | 6 | uses 7 | SysUtils; 8 | 9 | type 10 | TMyClass = class 11 | MyInt: Integer; 12 | procedure MyVirtualMethod; virtual; 13 | end; 14 | 15 | TMyClassDescendant = class(TMyClass) 16 | procedure MyVirtualMethod; override; 17 | end; 18 | 19 | procedure TMyClass.MyVirtualMethod; 20 | begin 21 | WriteLn('TMyClass отображает MyInt + 10: ', MyInt + 10); 22 | end; 23 | 24 | procedure TMyClassDescendant.MyVirtualMethod; 25 | begin 26 | WriteLn('TMyClassDescendant отображает MyInt + 20: ', MyInt + 20); 27 | end; 28 | 29 | var 30 | C: TMyClass; 31 | begin 32 | C := TMyClass.Create; 33 | try 34 | C.MyVirtualMethod; 35 | finally 36 | FreeAndNil(C); 37 | end; 38 | 39 | C := TMyClassDescendant.Create; 40 | try 41 | C.MyVirtualMethod; 42 | finally 43 | FreeAndNil(C); 44 | end; 45 | end. 46 | -------------------------------------------------------------------------------- /code-samples_russian/interface_casting.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | // {$interfaces corba} // обратите внимание, что приведение типа с помощью "as" для интерфейсов типа CORBA не скомпилируется 4 | 5 | uses Classes; 6 | 7 | type 8 | IMyInterface = interface 9 | ['{7FC754BC-9CA7-4399-B947-D37DD30BA90A}'] 10 | procedure One; 11 | end; 12 | 13 | IMyInterface2 = interface(IMyInterface) 14 | ['{A72B7008-3F90-45C1-8F4C-E77C4302AA3E}'] 15 | procedure Two; 16 | end; 17 | 18 | IMyInterface3 = interface(IMyInterface2) 19 | ['{924BFB98-B049-4945-AF17-1DB08DB1C0C5}'] 20 | procedure Three; 21 | end; 22 | 23 | TMyClass = class(TComponent, IMyInterface) 24 | procedure One; 25 | end; 26 | 27 | TMyClass2 = class(TMyClass, IMyInterface, IMyInterface2) 28 | procedure One; 29 | procedure Two; 30 | end; 31 | 32 | procedure TMyClass.One; 33 | begin 34 | Writeln('TMyClass.One'); 35 | end; 36 | 37 | procedure TMyClass2.One; 38 | begin 39 | Writeln('TMyClass2.One'); 40 | end; 41 | 42 | procedure TMyClass2.Two; 43 | begin 44 | Writeln('TMyClass2.Two'); 45 | end; 46 | 47 | procedure UseInterface2(const I: IMyInterface2); 48 | begin 49 | I.One; 50 | I.Two; 51 | end; 52 | 53 | procedure UseInterface3(const I: IMyInterface3); 54 | begin 55 | I.One; 56 | I.Two; 57 | I.Three; 58 | end; 59 | 60 | var 61 | My: IMyInterface; 62 | MyClass: TMyClass; 63 | begin 64 | My := TMyClass2.Create(nil); 65 | MyClass := TMyClass2.Create(nil); 66 | 67 | // Следующий код не скомпилируется, так как в момент компиляции неизвестно является ли My интерфейсом IMyInterface2. 68 | // UseInterface2(My); 69 | // UseInterface2(MyClass); 70 | 71 | // Это скомпилируется и работает правильно. 72 | UseInterface2(IMyInterface2(My)); 73 | // А это не скомпилируется. Приведение типа InterfaceType(ClassType) проверяется в момент компиляции. 74 | // UseInterface2(IMyInterface2(MyClass)); 75 | 76 | // Это скомпилируется и работает правильно. 77 | UseInterface2(My as IMyInterface2); 78 | // Это скомпилируется и работает правильно. 79 | UseInterface2(MyClass as IMyInterface2); 80 | 81 | // Это скомпилируется, но приведёт к непонятной ошибке "Access violation" при выполнении программы. 82 | // UseInterface3(IMyInterface3(My)); 83 | // Это не скомпилируется. Приведение типа InterfaceType(ClassType) проверяется в момент компиляции. 84 | // UseInterface3(IMyInterface3(MyClass)); 85 | 86 | // Это скомпилируется, но приведёт к понятному сообщению об ошибке "EInvalidCast: Invalid type cast" и укажет на проблему. 87 | // UseInterface3(My as IMyInterface3); 88 | // Это скомпилируется, но приведёт к понятному сообщению об ошибке "EInvalidCast: Invalid type cast" и укажет на проблему. 89 | // UseInterface3(MyClass as IMyInterface3); 90 | 91 | Writeln('Готово'); 92 | end. 93 | -------------------------------------------------------------------------------- /code-samples_russian/interfaces_com_test.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} 2 | {$mode objfpc}{$H+}{$J-} 3 | {$interfaces com} 4 | {$endif} 5 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 6 | 7 | uses 8 | SysUtils, Classes; 9 | 10 | type 11 | IMyInterface = interface 12 | ['{3075FFCD-8EFB-4E98-B157-261448B8D92E}'] 13 | procedure Shoot; 14 | end; 15 | 16 | TMyClass1 = class(TComponent, IMyInterface) 17 | procedure Shoot; 18 | end; 19 | 20 | TMyClass2 = class(TComponent, IMyInterface) 21 | procedure Shoot; 22 | end; 23 | 24 | TMyClass3 = class(TComponent) 25 | procedure Shoot; 26 | end; 27 | 28 | procedure TMyClass1.Shoot; 29 | begin 30 | WriteLn('TMyClass1.Shoot'); 31 | end; 32 | 33 | procedure TMyClass2.Shoot; 34 | begin 35 | WriteLn('TMyClass2.Shoot'); 36 | end; 37 | 38 | procedure TMyClass3.Shoot; 39 | begin 40 | WriteLn('TMyClass3.Shoot'); 41 | end; 42 | 43 | procedure UseThroughInterface(I: IMyInterface); 44 | begin 45 | Write('Стреляем... '); 46 | I.Shoot; 47 | end; 48 | 49 | var 50 | C1: TMyClass1; 51 | C2: TMyClass2; 52 | C3: TMyClass3; 53 | 54 | procedure UseInterfaces; 55 | begin 56 | if C1 is IMyInterface then 57 | //if Supports(C1, IMyInterface) then // эта строчка идентична проверке "is" выше 58 | UseThroughInterface(C1 as IMyInterface); 59 | if C2 is IMyInterface then 60 | UseThroughInterface(C2 as IMyInterface); 61 | if C3 is IMyInterface then 62 | UseThroughInterface(C3 as IMyInterface); 63 | end; 64 | 65 | begin 66 | C1 := TMyClass1.Create(nil); 67 | C2 := TMyClass2.Create(nil); 68 | C3 := TMyClass3.Create(nil); 69 | try 70 | UseInterfaces; 71 | finally 72 | FreeAndNil(C1); 73 | FreeAndNil(C2); 74 | FreeAndNil(C3); 75 | end; 76 | end. -------------------------------------------------------------------------------- /code-samples_russian/interfaces_com_test_comments.txt: -------------------------------------------------------------------------------- 1 | if C1 is IMyInterface then 2 | //if Supports(C1, IMyInterface) then // Идентично проверке "is" выше 3 | //UseThroughInterface(C1 as IMyInterface); 4 | UseThroughInterface(C1); // Можно просто typecast без синтаксиса, поскольку верность этого выражения может быть доказана при компиляции 5 | //UseThroughInterface(IMyInterface(C1)); // Эквивалентно прямому typecast-у, также проверяется при компиляции 6 | 7 | if C2 is IMyInterface then 8 | //UseThroughInterface(C2 as IMyInterface); 9 | UseThroughInterface(C2); // И эти тоже можно typecast без синтасиса, поскольку проверка выполняется при компиляции 10 | 11 | if C3 is IMyInterface then 12 | UseThroughInterface(C3 as IMyInterface); // Это очевидно неправильно при компиляции, по этому скомпилируется лишь, если указать typecast через "as" 13 | //UseThroughInterface(IMyInterface(C3)); // Эквивалентно прямому typecast-у, однако такой вариант не проверяется при компиляции 14 | -------------------------------------------------------------------------------- /code-samples_russian/interfaces_com_with_ref_counting.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} 2 | {$mode objfpc}{$H+}{$J-} 3 | {$interfaces com} 4 | {$endif} 5 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 6 | 7 | uses 8 | SysUtils, Classes; 9 | 10 | type 11 | IMyInterface = interface 12 | ['{3075FFCD-8EFB-4E98-B157-261448B8D92E}'] 13 | procedure Shoot; 14 | end; 15 | 16 | TMyClass1 = class(TInterfacedObject, IMyInterface) 17 | procedure Shoot; 18 | end; 19 | 20 | TMyClass2 = class(TInterfacedObject, IMyInterface) 21 | procedure Shoot; 22 | end; 23 | 24 | TMyClass3 = class(TInterfacedObject) 25 | procedure Shoot; 26 | end; 27 | 28 | procedure TMyClass1.Shoot; 29 | begin 30 | WriteLn('TMyClass1.Shoot'); 31 | end; 32 | 33 | procedure TMyClass2.Shoot; 34 | begin 35 | WriteLn('TMyClass2.Shoot'); 36 | end; 37 | 38 | procedure TMyClass3.Shoot; 39 | begin 40 | WriteLn('TMyClass3.Shoot'); 41 | end; 42 | 43 | procedure UseThroughInterface(I: IMyInterface); 44 | begin 45 | Write('Стреляем... '); 46 | I.Shoot; 47 | end; 48 | 49 | var 50 | C1: IMyInterface; // COM управляет освобождением памяти 51 | C2: IMyInterface; // COM управляет освобождением памяти 52 | C3: TMyClass3; // Здесь управлять освобождением памяти придётся ВАМ 53 | begin 54 | C1 := TMyClass1.Create as IMyInterface; 55 | C2 := TMyClass2.Create as IMyInterface; 56 | C3 := TMyClass3.Create; 57 | try 58 | UseThroughInterface(C1); // Нет необходимости в операторе "as" 59 | UseThroughInterface(C2); 60 | if C3 is IMyInterface then 61 | UseThroughInterface(C3 as IMyInterface); // Так не сработает 62 | finally 63 | { Переменные C1 и C2 выходят из поля зрения 64 | и будут автоматически уничтожены сейчас. 65 | 66 | а переменная C3 является экземпляром класса 67 | и не управляется интерфейсом, 68 | по этому её необходимо совободить вручную. } 69 | FreeAndNil(C3); 70 | end; 71 | end. -------------------------------------------------------------------------------- /code-samples_russian/interfaces_corba_test.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} 2 | {$mode objfpc}{$H+}{$J-} 3 | {$interfaces corba} 4 | {$else} 5 | {$message warn 'Delphi does not support CORBA interfaces, only COM, that change how memory is managed. This example is not valid in Delphi.'} 6 | begin end. 7 | {$endif} 8 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 9 | 10 | uses 11 | SysUtils, Classes; 12 | 13 | type 14 | IMyInterface = interface 15 | ['{79352612-668B-4E8C-910A-26975E103CAC}'] 16 | procedure Shoot; 17 | end; 18 | 19 | TMyClass1 = class(IMyInterface) 20 | procedure Shoot; 21 | end; 22 | 23 | TMyClass2 = class(IMyInterface) 24 | procedure Shoot; 25 | end; 26 | 27 | TMyClass3 = class 28 | procedure Shoot; 29 | end; 30 | 31 | procedure TMyClass1.Shoot; 32 | begin 33 | WriteLn('TMyClass1.Shoot'); 34 | end; 35 | 36 | procedure TMyClass2.Shoot; 37 | begin 38 | WriteLn('TMyClass2.Shoot'); 39 | end; 40 | 41 | procedure TMyClass3.Shoot; 42 | begin 43 | WriteLn('TMyClass3.Shoot'); 44 | end; 45 | 46 | procedure UseThroughInterface(I: IMyInterface); 47 | begin 48 | Write('Стреляем... '); 49 | I.Shoot; 50 | end; 51 | 52 | var 53 | C1: TMyClass1; 54 | C2: TMyClass2; 55 | C3: TMyClass3; 56 | begin 57 | C1 := TMyClass1.Create; 58 | C2 := TMyClass2.Create; 59 | C3 := TMyClass3.Create; 60 | try 61 | if C1 is IMyInterface then 62 | UseThroughInterface(C1 as IMyInterface); 63 | if C2 is IMyInterface then 64 | UseThroughInterface(C2 as IMyInterface); 65 | if C3 is IMyInterface then 66 | UseThroughInterface(C3 as IMyInterface); 67 | finally 68 | FreeAndNil(C1); 69 | FreeAndNil(C2); 70 | FreeAndNil(C3); 71 | end; 72 | end. -------------------------------------------------------------------------------- /code-samples_russian/is_as.dpr: -------------------------------------------------------------------------------- 1 | program is_as; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 5 | 6 | uses 7 | SysUtils; 8 | 9 | type 10 | TMyClass = class 11 | procedure MyMethod; 12 | end; 13 | 14 | TMyClassDescendant = class(TMyClass) 15 | procedure MyMethodInDescendant; 16 | end; 17 | 18 | procedure TMyClass.MyMethod; 19 | begin 20 | WriteLn('Это MyMethod') 21 | end; 22 | 23 | procedure TMyClassDescendant.MyMethodInDescendant; 24 | begin 25 | WriteLn('Это MyMethodInDescendant') 26 | end; 27 | 28 | var 29 | Descendant: TMyClassDescendant; 30 | C: TMyClass; 31 | begin 32 | Descendant := TMyClassDescendant.Create; 33 | try 34 | Descendant.MyMethod; 35 | Descendant.MyMethodInDescendant; 36 | 37 | { производные классы сохраняют все функции родительского класса 38 | TMyClass, по этому можно таким образом создавать ссылку } 39 | C := Descendant; 40 | C.MyMethod; 41 | 42 | { так не сработает, поскольку в TMyClass не определён этот метод } 43 | //C.MyMethodInDescendant; 44 | { правильно записать следующим образом: } 45 | if C is TMyClassDescendant then 46 | (C as TMyClassDescendant).MyMethodInDescendant; 47 | 48 | finally 49 | FreeAndNil(Descendant); 50 | end; 51 | end. 52 | -------------------------------------------------------------------------------- /code-samples_russian/lazarus/showcolor.dpr: -------------------------------------------------------------------------------- 1 | program showcolor; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 5 | 6 | // и Graphics и GoogleMapsEngine определяют тип TColor. 7 | uses 8 | Graphics, GoogleMapsEngine; 9 | 10 | var 11 | { Это не сработает, как мы ожидаем, поскольку TColor последний раз 12 | был объявлен в unit-е GoogleMapsEngine. } 13 | // Color: TColor; 14 | { This works Ok. } 15 | Color: Graphics.TColor; 16 | begin 17 | Color := clYellow; 18 | WriteLn(Red(Color), ' ', Green(Color), ' ', Blue(Color)); 19 | end. 20 | 21 | -------------------------------------------------------------------------------- /code-samples_russian/lazarus/showcolor.lpi: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectOptions> 4 | <Version Value="9"/> 5 | <General> 6 | <Flags> 7 | <MainUnitHasCreateFormStatements Value="False"/> 8 | <MainUnitHasTitleStatement Value="False"/> 9 | </Flags> 10 | <SessionStorage Value="InProjectDir"/> 11 | <MainUnit Value="0"/> 12 | <Title Value="showcolor"/> 13 | <UseAppBundle Value="False"/> 14 | <ResourceType Value="res"/> 15 | </General> 16 | <i18n> 17 | <EnableI18N LFM="False"/> 18 | </i18n> 19 | <VersionInfo> 20 | <StringTable ProductVersion=""/> 21 | </VersionInfo> 22 | <BuildModes Count="1"> 23 | <Item1 Name="Default" Default="True"/> 24 | </BuildModes> 25 | <PublishOptions> 26 | <Version Value="2"/> 27 | </PublishOptions> 28 | <RunParams> 29 | <local> 30 | <FormatVersion Value="1"/> 31 | </local> 32 | </RunParams> 33 | <RequiredPackages Count="1"> 34 | <Item1> 35 | <PackageName Value="LCL"/> 36 | </Item1> 37 | </RequiredPackages> 38 | <Units Count="1"> 39 | <Unit0> 40 | <Filename Value="showcolor.dpr"/> 41 | <IsPartOfProject Value="True"/> 42 | </Unit0> 43 | </Units> 44 | </ProjectOptions> 45 | <CompilerOptions> 46 | <Version Value="11"/> 47 | <Target> 48 | <Filename Value="showcolor"/> 49 | </Target> 50 | <SearchPaths> 51 | <IncludeFiles Value="$(ProjOutDir)"/> 52 | <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 53 | </SearchPaths> 54 | </CompilerOptions> 55 | <Debugging> 56 | <Exceptions Count="3"> 57 | <Item1> 58 | <Name Value="EAbort"/> 59 | </Item1> 60 | <Item2> 61 | <Name Value="ECodetoolError"/> 62 | </Item2> 63 | <Item3> 64 | <Name Value="EFOpenError"/> 65 | </Item3> 66 | </Exceptions> 67 | </Debugging> 68 | </CONFIG> 69 | -------------------------------------------------------------------------------- /code-samples_russian/loops.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | {$R+} // включаем проверку на диапазон величин, очень полезно для отладки 4 | 5 | var 6 | MyArray: array [0..9] of Integer; 7 | I: Integer; 8 | begin 9 | // инициализация 10 | for I := 0 to 9 do 11 | MyArray[I] := I * I; 12 | 13 | // отображение 14 | for I := 0 to 9 do 15 | WriteLn('Квадрат составляет ', MyArray[I]); 16 | 17 | // делает то же самое, что и предыдущий вариант 18 | for I := Low(MyArray) to High(MyArray) do 19 | WriteLn('Квадрат составляет ', MyArray[I]); 20 | 21 | // делает то же самое 22 | I := 0; 23 | while I < 10 do 24 | begin 25 | WriteLn('Квадрат составляет ', MyArray[I]); 26 | I := I + 1; // это идентично "I += 1" или "Inc(I)" 27 | end; 28 | 29 | // делает то же самое 30 | I := 0; 31 | repeat 32 | WriteLn('Квадрат составляет ', MyArray[I]); 33 | Inc(I); 34 | until I = 10; 35 | 36 | // делает то же самое 37 | // обратите внимание, тут переменная I перечисляет значения элементов массива, а не его индексы 38 | for I in MyArray do 39 | WriteLn('Квадрат составляет ', I); 40 | end. -------------------------------------------------------------------------------- /code-samples_russian/myconfig.inc: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} 2 | {$mode objfpc} 3 | {$H+} 4 | {$J-} 5 | {$modeswitch advancedrecords} 6 | {$ifdef VER2} 7 | {$message fatal 'This code can only be compiled using FPC version >= 3.0.'} 8 | {$endif} 9 | {$endif} 10 | -------------------------------------------------------------------------------- /code-samples_russian/myunit.pas: -------------------------------------------------------------------------------- 1 | unit MyUnit; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | 5 | interface 6 | 7 | procedure MyProcedure(const A: Integer); 8 | function MyFunction(const S: string): string; 9 | 10 | implementation 11 | 12 | procedure MyProcedure(const A: Integer); 13 | begin 14 | WriteLn('A + 10 составляет: ', A + 10); 15 | end; 16 | 17 | function MyFunction(const S: string): string; 18 | begin 19 | Result := S + 'строки управляются автоматически'; 20 | end; 21 | 22 | end. 23 | -------------------------------------------------------------------------------- /code-samples_russian/myunit_test.dpr: -------------------------------------------------------------------------------- 1 | program MyProgram; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 5 | 6 | uses MyUnit; 7 | 8 | begin 9 | WriteLn(MyFunction('Примечание: ')); 10 | MyProcedure(5); 11 | end. 12 | -------------------------------------------------------------------------------- /code-samples_russian/operator_overloading.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses StrUtils; 5 | 6 | operator* (const S: string; const A: Integer): string; 7 | begin 8 | Result := DupeString(S, A); 9 | end; 10 | 11 | begin 12 | WriteLn('повтор' * 10); 13 | end. -------------------------------------------------------------------------------- /code-samples_russian/persistent.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses 5 | SysUtils, Classes; 6 | 7 | type 8 | TMyClass = class(TPersistent) 9 | public 10 | MyInt: Integer; 11 | procedure Assign(Source: TPersistent); override; 12 | end; 13 | 14 | TMyClassDescendant = class(TMyClass) 15 | public 16 | MyString: string; 17 | procedure Assign(Source: TPersistent); override; 18 | end; 19 | 20 | procedure TMyClass.Assign(Source: TPersistent); 21 | var 22 | SourceMyClass: TMyClass; 23 | begin 24 | if Source is TMyClass then 25 | begin 26 | SourceMyClass := TMyClass(Source); 27 | MyInt := SourceMyClass.MyInt; 28 | // Xxx := SourceMyClass.Xxx; // добавить необходимые поля здесь 29 | end else 30 | { Вызываем inherited ТОЛЬКО если не получается вручную обработать Source } 31 | inherited Assign(Source); 32 | end; 33 | 34 | procedure TMyClassDescendant.Assign(Source: TPersistent); 35 | var 36 | SourceMyClassDescendant: TMyClassDescendant; 37 | begin 38 | if Source is TMyClassDescendant then 39 | begin 40 | SourceMyClassDescendant := TMyClassDescendant(Source); 41 | MyString := SourceMyClassDescendant.MyString; 42 | // Xxx := SourceMyClassDescendant.Xxx; // добавить необходимые поля здесь 43 | end; 44 | 45 | { ВСЕГДА вызываем inherited, чтобы TMyClass.Assign сама обработала 46 | все остающиеся поля. } 47 | inherited Assign(Source); 48 | end; 49 | 50 | var 51 | C1, C2: TMyClass; 52 | CD1, CD2: TMyClassDescendant; 53 | begin 54 | // тестируем TMyClass.Assign 55 | C1 := TMyClass.Create; 56 | C2 := TMyClass.Create; 57 | try 58 | C1.MyInt := 666; 59 | C2.Assign(C1); 60 | WriteLn('C2 состояние: ', C2.MyInt); 61 | finally 62 | FreeAndNil(C1); 63 | FreeAndNil(C2); 64 | end; 65 | 66 | // тестируем TMyClassDescendant.Assign 67 | CD1 := TMyClassDescendant.Create; 68 | CD2 := TMyClassDescendant.Create; 69 | try 70 | CD1.MyInt := 44; 71 | CD1.MyString := 'что-нибудь'; 72 | CD2.Assign(CD1); 73 | WriteLn('CD2 состояние: ', CD2.MyInt, ' ', CD2.MyString); 74 | finally 75 | FreeAndNil(CD1); 76 | FreeAndNil(CD2); 77 | end; 78 | end. -------------------------------------------------------------------------------- /code-samples_russian/records.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} 2 | {$mode objfpc}{$H+}{$J-} 3 | {$modeswitch advancedrecords} 4 | {$endif} 5 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 6 | 7 | type 8 | TMyRecord = record 9 | public 10 | I, Square: Integer; 11 | procedure WriteLnDescription; 12 | end; 13 | 14 | procedure TMyRecord.WriteLnDescription; 15 | begin 16 | WriteLn('Квадрат числа ', I, ' равен ', Square); 17 | end; 18 | 19 | var 20 | A: array [0..9] of TMyRecord; 21 | R: TMyRecord; 22 | I: Integer; 23 | begin 24 | for I := 0 to 9 do 25 | begin 26 | A[I].I := I; 27 | A[I].Square := I * I; 28 | end; 29 | 30 | for R in A do 31 | R.WriteLnDescription; 32 | end. -------------------------------------------------------------------------------- /code-samples_russian/test_myconfig.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 2 | 3 | { Compile this to test that myconfig.inc is valid. } 4 | {$I myconfig.inc} 5 | 6 | begin 7 | end. -------------------------------------------------------------------------------- /code-samples_ukrainian/.gitignore: -------------------------------------------------------------------------------- 1 | *.ppu 2 | *.o 3 | *.exe 4 | callbacks 5 | callbacks_of_object 6 | class_properties 7 | exception_finally 8 | exception_in_constructor_test 9 | file_stream 10 | for_in_list 11 | functions_primitives 12 | gen_guid 13 | generic_functions 14 | generics 15 | generics_dictionary 16 | generics_lists 17 | generics_object_dictionary 18 | generics_sorting 19 | hello_world 20 | inheritance 21 | interface_casting 22 | interfaces_com_test 23 | interfaces_com_with_ref_counting 24 | interfaces_corba_test 25 | is_as 26 | lazarus/showcolor 27 | loops 28 | method_calls_inheritance_1 29 | method_calls_inherited 30 | my_binary_file.data 31 | myunit_test 32 | operator_overloading 33 | operator_overloading_classes 34 | operator_overloading_records 35 | operator_overloading_records_lists 36 | persistent 37 | records 38 | static_class_method 39 | with_virtual_methods 40 | without_virtual_methods 41 | lazarus/*.bak 42 | lazarus/*.lps 43 | lazarus/lib/ 44 | -------------------------------------------------------------------------------- /code-samples_ukrainian/Makefile: -------------------------------------------------------------------------------- 1 | UNIT_SOURCES:=$(wildcard *.pas) 2 | PROGRAM_SOURCES:=$(wildcard *.lpr) 3 | PROGRAM_BINARIES:=$(PROGRAM_SOURCES:.lpr=) 4 | 5 | .PHONY: all 6 | all: 7 | $(foreach UNIT_NAME,$(UNIT_SOURCES),fpc $(UNIT_NAME) && ) true 8 | $(foreach PROGRAM_NAME,$(PROGRAM_SOURCES),fpc $(PROGRAM_NAME) && ) true 9 | 10 | .PHONY: clean 11 | clean: 12 | rm -Rf *.o *.ppu $(PROGRAM_BINARIES) 13 | -------------------------------------------------------------------------------- /code-samples_ukrainian/anotherunit.pas: -------------------------------------------------------------------------------- 1 | unit AnotherUnit; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | 5 | interface 6 | 7 | uses 8 | Classes; 9 | 10 | { Тип (клас) "TComponent" визначається в модулі Classes. 11 | Ось чому нам довелося використати модуль Classes вище. } 12 | procedure DoSomethingWithComponent(var C: TComponent); 13 | 14 | implementation 15 | 16 | uses SysUtils; 17 | 18 | procedure DoSomethingWithComponent(var C: TComponent); 19 | begin 20 | { Процедура FreeAndNil визначена в модулі SysUtils. 21 | Оскільки ми посилаємося лише на його назву в реалізації, 22 | модуль SysUtils можна використовувати у розділі «implementation». } 23 | FreeAndNil(C); 24 | end; 25 | 26 | end. 27 | -------------------------------------------------------------------------------- /code-samples_ukrainian/callbacks.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | function Add(const A, B: Integer): Integer; 5 | begin 6 | Result := A + B; 7 | end; 8 | 9 | function Multiply(const A, B: Integer): Integer; 10 | begin 11 | Result := A * B; 12 | end; 13 | 14 | type 15 | TMyFunction = function (const A, B: Integer): Integer; 16 | 17 | function ProcessTheList(const F: TMyFunction): Integer; 18 | var 19 | I: Integer; 20 | begin 21 | Result := 1; 22 | for I := 2 to 10 do 23 | Result := F(Result, I); 24 | end; 25 | 26 | var 27 | SomeFunction: TMyFunction; 28 | begin 29 | SomeFunction := @Add; 30 | WriteLn('1 + 2 + 3 ... + 10 = ', ProcessTheList(SomeFunction)); 31 | 32 | SomeFunction := @Multiply; 33 | WriteLn('1 * 2 * 3 ... * 10 = ', ProcessTheList(SomeFunction)); 34 | end. -------------------------------------------------------------------------------- /code-samples_ukrainian/callbacks_of_object.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses 5 | SysUtils; 6 | 7 | type 8 | TMyMethod = procedure (const A: Integer) of object; 9 | 10 | TMyClass = class 11 | CurrentValue: Integer; 12 | procedure Add(const A: Integer); 13 | procedure Multiply(const A: Integer); 14 | procedure ProcessTheList(const M: TMyMethod); 15 | end; 16 | 17 | procedure TMyClass.Add(const A: Integer); 18 | begin 19 | CurrentValue := CurrentValue + A; 20 | end; 21 | 22 | procedure TMyClass.Multiply(const A: Integer); 23 | begin 24 | CurrentValue := CurrentValue * A; 25 | end; 26 | 27 | procedure TMyClass.ProcessTheList(const M: TMyMethod); 28 | var 29 | I: Integer; 30 | begin 31 | CurrentValue := 1; 32 | for I := 2 to 10 do 33 | M(I); 34 | end; 35 | 36 | var 37 | C: TMyClass; 38 | begin 39 | C := TMyClass.Create; 40 | try 41 | C.ProcessTheList(@C.Add); 42 | WriteLn('1 + 2 + 3 ... + 10 = ', C.CurrentValue); 43 | 44 | C.ProcessTheList(@C.Multiply); 45 | WriteLn('1 * 2 * 3 ... * 10 = ', C.CurrentValue); 46 | finally 47 | FreeAndNil(C); 48 | end; 49 | end. -------------------------------------------------------------------------------- /code-samples_ukrainian/class_properties.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | type 5 | TMyClass = class 6 | strict private 7 | // Альтернатива: 8 | // FMyProperty: Integer; static; 9 | class var 10 | FMyProperty: Integer; 11 | class procedure SetMyProperty(const Value: Integer); static; 12 | public 13 | class property MyProperty: Integer 14 | read FMyProperty write SetMyProperty; 15 | end; 16 | 17 | class procedure TMyClass.SetMyProperty(const Value: Integer); 18 | begin 19 | Writeln('MyProperty змінено!'); 20 | FMyProperty := Value; 21 | end; 22 | 23 | begin 24 | TMyClass.MyProperty := 123; 25 | Writeln('TMyClass.MyProperty тепер ', TMyClass.MyProperty); 26 | end. 27 | -------------------------------------------------------------------------------- /code-samples_ukrainian/exception_finally.dpr: -------------------------------------------------------------------------------- 1 | program MyProgram; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 5 | 6 | uses 7 | SysUtils; 8 | 9 | type 10 | TMyClass = class 11 | procedure MyMethod; 12 | end; 13 | 14 | procedure TMyClass.MyMethod; 15 | begin 16 | if Random > 0.5 then 17 | raise Exception.Create('Підняття винятку!'); 18 | end; 19 | 20 | var 21 | C: TMyClass; 22 | begin 23 | Randomize; 24 | C := TMyClass.Create; 25 | try 26 | C.MyMethod; 27 | finally 28 | FreeAndNil(C); 29 | end; 30 | end. 31 | -------------------------------------------------------------------------------- /code-samples_ukrainian/exception_in_constructor_test.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses 5 | SysUtils; 6 | 7 | type 8 | TGun = class 9 | end; 10 | 11 | TPlayer = class 12 | Gun1, Gun2: TGun; 13 | constructor Create; 14 | destructor Destroy; override; 15 | end; 16 | 17 | constructor TPlayer.Create; 18 | begin 19 | inherited; 20 | Gun1 := TGun.Create; 21 | raise Exception.Create('Підняття винятку з конструктора!'); 22 | Gun2 := TGun.Create; 23 | end; 24 | 25 | destructor TPlayer.Destroy; 26 | begin 27 | { у випадку, якщо в конструкторі стався збій, ми можемо 28 | мати Gun1 <> nil і Gun2 = nil зараз. Змиріться з цим. 29 | ...Насправді, у цьому випадку FreeAndNil справляється 30 | з цим без будь-яких додаткових зусиль з нашого боку, 31 | тому що FreeAndNil перевіряє, чи є екземпляр нульовим, 32 | перш ніж викликати його деструктор } 33 | FreeAndNil(Gun1); 34 | FreeAndNil(Gun2); 35 | inherited; 36 | end; 37 | 38 | begin 39 | try 40 | TPlayer.Create; 41 | except 42 | on E: Exception do 43 | WriteLn('Спіймано ' + E.ClassName + ': ' + E.Message); 44 | end; 45 | end. 46 | -------------------------------------------------------------------------------- /code-samples_ukrainian/file_stream.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils, Classes; 5 | 6 | var 7 | S: TStream; 8 | InputInt, OutputInt: Integer; 9 | begin 10 | InputInt := 666; 11 | 12 | S := TFileStream.Create('my_binary_file.data', fmCreate); 13 | try 14 | S.WriteBuffer(InputInt, SizeOf(InputInt)); 15 | finally 16 | FreeAndNil(S); 17 | end; 18 | 19 | S := TFileStream.Create('my_binary_file.data', fmOpenRead); 20 | try 21 | S.ReadBuffer(OutputInt, SizeOf(OutputInt)); 22 | finally 23 | FreeAndNil(S); 24 | end; 25 | 26 | WriteLn('Прочитано з файлу отримано ціле число: ', OutputInt); 27 | end. -------------------------------------------------------------------------------- /code-samples_ukrainian/for_in_list.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils, FGL; 5 | 6 | type 7 | TMyClass = class 8 | I, Square: Integer; 9 | end; 10 | TMyClassList = specialize TFPGObjectList<TMyClass>; 11 | 12 | var 13 | List: TMyClassList; 14 | C: TMyClass; 15 | I: Integer; 16 | begin 17 | List := TMyClassList.Create(true); // true = володіє дітьми 18 | try 19 | for I := 0 to 9 do 20 | begin 21 | C := TMyClass.Create; 22 | C.I := I; 23 | C.Square := I * I; 24 | List.Add(C); 25 | end; 26 | 27 | for C in List do 28 | WriteLn('Квадрат ', C.I, ' є ', C.Square); 29 | finally 30 | FreeAndNil(List); 31 | end; 32 | end. -------------------------------------------------------------------------------- /code-samples_ukrainian/functions_primitives.dpr: -------------------------------------------------------------------------------- 1 | program MyProgram; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 5 | 6 | procedure MyProcedure(const A: Integer); 7 | begin 8 | WriteLn('A + 10 is: ', A + 10); 9 | end; 10 | 11 | function MyFunction(const S: string): string; 12 | begin 13 | Result := S + 'рядки керуються автоматично'; 14 | end; 15 | 16 | var 17 | X: Single; 18 | begin 19 | WriteLn(MyFunction('Примітка: ')); 20 | MyProcedure(5); 21 | 22 | // Ділення за допомогою "/" завжди дає результат з плаваючою точкою, використовуйте "div" для цілочисельного ділення 23 | X := 15 / 5; 24 | WriteLn('X is now: ', X); // науковий запис 25 | WriteLn('X is now: ', X:1:2); // 2 десяткові позиції 26 | end. 27 | -------------------------------------------------------------------------------- /code-samples_ukrainian/gen_guid.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses 5 | SysUtils; 6 | var 7 | MyGuid: TGUID; 8 | begin 9 | Randomize; 10 | CreateGUID(MyGuid); 11 | WriteLn('[''' + GUIDToString(MyGuid) + ''']'); 12 | end. 13 | -------------------------------------------------------------------------------- /code-samples_ukrainian/generic_functions.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils; 5 | 6 | { Примітка: для цього прикладу потрібен FPC 3.1.1 (не компілюється з FPC 3.0.0 або старішим). } 7 | 8 | generic function Min<T>(const A, B: T): T; 9 | begin 10 | if A < B then 11 | Result := A else 12 | Result := B; 13 | end; 14 | 15 | begin 16 | WriteLn('Min (1, 0): ', specialize Min<Integer>(1, 0)); 17 | WriteLn('Min (3.14, 5): ', specialize Min<Single>(3.14, 5):1:2); 18 | WriteLn('Min (''a'', ''b''): ', specialize Min<string>('a', 'b')); 19 | end. -------------------------------------------------------------------------------- /code-samples_ukrainian/generics.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils; 5 | 6 | type 7 | generic TMyCalculator<T> = class 8 | Value: T; 9 | procedure Add(const A: T); 10 | end; 11 | 12 | procedure TMyCalculator.Add(const A: T); 13 | begin 14 | Value := Value + A; 15 | end; 16 | 17 | type 18 | TMyFloatCalculator = {$ifdef FPC}specialize{$endif} TMyCalculator<Single>; 19 | TMyStringCalculator = {$ifdef FPC}specialize{$endif} TMyCalculator<string>; 20 | 21 | var 22 | FloatCalc: TMyFloatCalculator; 23 | StringCalc: TMyStringCalculator; 24 | begin 25 | FloatCalc := TMyFloatCalculator.Create; 26 | try 27 | FloatCalc.Add(3.14); 28 | FloatCalc.Add(1); 29 | WriteLn('FloatCalc: ', FloatCalc.Value:1:2); 30 | finally 31 | FreeAndNil(FloatCalc); 32 | end; 33 | 34 | StringCalc := TMyStringCalculator.Create; 35 | try 36 | StringCalc.Add('щось'); 37 | StringCalc.Add(' більше'); 38 | WriteLn('StringCalc: ', StringCalc.Value); 39 | finally 40 | FreeAndNil(StringCalc); 41 | end; 42 | end. -------------------------------------------------------------------------------- /code-samples_ukrainian/generics_dictionary.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils, Generics.Collections; 5 | 6 | type 7 | TApple = class 8 | Name: string; 9 | end; 10 | 11 | TAppleDictionary = {$ifdef FPC}specialize{$endif} TDictionary<String, TApple>; 12 | 13 | var 14 | Apples: TAppleDictionary; 15 | A, FoundA: TApple; 16 | ApplePair: {$ifdef FPC} TAppleDictionary.TDictionaryPair {$else} TPair<String, TApple> {$endif}; 17 | AppleKey: string; 18 | begin 19 | Apples := TAppleDictionary.Create; 20 | try 21 | A := TApple.Create; 22 | A.Name := 'моє яблуко'; 23 | Apples.AddOrSetValue('яблучний ключ 1', A); 24 | 25 | if Apples.TryGetValue('яблучний ключ 1', FoundA) then 26 | Writeln('Знайдено яблуко під ключем "яблучний ключ 1" з назвою: ' + 27 | FoundA.Name); 28 | 29 | for AppleKey in Apples.Keys do 30 | Writeln('Знайдено яблучний ключ: ' + AppleKey); 31 | for A in Apples.Values do 32 | Writeln('Знайдено яблучне значення: ' + A.Name); 33 | for ApplePair in Apples do 34 | Writeln('Знайдено яблучні ключ->значення: ' + 35 | ApplePair.Key + '->' + ApplePair.Value.Name); 36 | 37 | { Рядок нижче також працює, але його можна використовувати 38 | лише для встановлення *існуючого* ключа словника. 39 | Замість цього зазвичай використовуйте AddOrSetValue, 40 | щоб установити або додати новий ключ, якщо це необхідно. } 41 | // Apples['яблучний ключ 1'] := ... ; 42 | 43 | Apples.Remove('яблучний ключ 1'); 44 | 45 | { Зверніть увагу, що TDictionary не володіє елементами, 46 | вам потрібно звільнити їх самостійно. 47 | Ми могли б використовувати TObjectDictionary, 48 | щоб мати автоматичний механізм власності. } 49 | A.Free; 50 | finally FreeAndNil(Apples) end; 51 | end. 52 | -------------------------------------------------------------------------------- /code-samples_ukrainian/generics_lists.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils, Generics.Collections; 5 | 6 | type 7 | TApple = class 8 | Name: string; 9 | end; 10 | 11 | TAppleList = {$ifdef FPC}specialize{$endif} TObjectList<TApple>; 12 | 13 | var 14 | A: TApple; 15 | Apples: TAppleList; 16 | begin 17 | Apples := TAppleList.Create(true); 18 | try 19 | A := TApple.Create; 20 | A.Name := 'моє яблуко'; 21 | Apples.Add(A); 22 | 23 | A := TApple.Create; 24 | A.Name := 'інше яблуко'; 25 | Apples.Add(A); 26 | 27 | Writeln('Кількість: ', Apples.Count); 28 | Writeln(Apples[0].Name); 29 | Writeln(Apples[1].Name); 30 | finally FreeAndNil(Apples) end; 31 | end. 32 | -------------------------------------------------------------------------------- /code-samples_ukrainian/generics_object_dictionary.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils, Generics.Collections; 5 | 6 | type 7 | TApple = class 8 | Name: string; 9 | end; 10 | 11 | TAppleDictionary = {$ifdef FPC}specialize{$endif} TObjectDictionary<String, TApple>; 12 | 13 | var 14 | Apples: TAppleDictionary; 15 | A: TApple; 16 | ApplePair: {$ifdef FPC} TAppleDictionary.TDictionaryPair {$else} TPair<String, TApple> {$endif}; 17 | begin 18 | Apples := TAppleDictionary.Create([doOwnsValues]); 19 | try 20 | A := TApple.Create; 21 | A.Name := 'моє яблуко'; 22 | Apples.AddOrSetValue('яблучний ключ 1', A); 23 | 24 | for ApplePair in Apples do 25 | Writeln('Знайдено яблучний ключ->значення: ' + 26 | ApplePair.Key + '->' + ApplePair.Value.Name); 27 | 28 | Apples.Remove('яблучний ключ 1'); 29 | finally FreeAndNil(Apples) end; 30 | end. 31 | -------------------------------------------------------------------------------- /code-samples_ukrainian/generics_sorting.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | { If GENERICS_CONSTREF is defined, then various routines used with Generics.Collections 5 | (like callbacks we pass to TComparer, or OnNotify callback or Notify virtual method) 6 | should have "constref" parameter, not "const". 7 | This was the case of FPC<= 3.2.0, FPC changed it in 8 | https://gitlab.com/freepascal.org/fpc/source/-/commit/693491048bf2c6f9122a0d8b044ad0e55382354d . 9 | It is also applied to FPC fixes branch 3.2.3. } 10 | {$ifdef VER3_0} {$define GENERICS_CONSTREF} {$endif} 11 | {$ifdef VER3_2_0} {$define GENERICS_CONSTREF} {$endif} 12 | {$ifdef VER3_2_2} {$define GENERICS_CONSTREF} {$endif} 13 | 14 | uses SysUtils, Generics.Defaults, Generics.Collections; 15 | 16 | type 17 | TApple = class 18 | Name: string; 19 | end; 20 | 21 | TAppleList = {$ifdef FPC}specialize{$endif} TObjectList<TApple>; 22 | 23 | function CompareApples( 24 | {$ifdef GENERICS_CONSTREF}constref{$else}const{$endif} 25 | Left, Right: TApple): Integer; 26 | begin 27 | Result := AnsiCompareStr(Left.Name, Right.Name); 28 | end; 29 | 30 | type 31 | TAppleComparer = {$ifdef FPC}specialize{$endif} TComparer<TApple>; 32 | var 33 | A: TApple; 34 | L: TAppleList; 35 | begin 36 | L := TAppleList.Create(true); 37 | try 38 | A := TApple.Create; 39 | A.Name := '11'; 40 | L.Add(A); 41 | 42 | A := TApple.Create; 43 | A.Name := '33'; 44 | L.Add(A); 45 | 46 | A := TApple.Create; 47 | A.Name := '22'; 48 | L.Add(A); 49 | 50 | L.Sort(TAppleComparer.Construct(@CompareApples)); 51 | 52 | Writeln('Кількість: ', L.Count); 53 | Writeln(L[0].Name); 54 | Writeln(L[1].Name); 55 | Writeln(L[2].Name); 56 | finally FreeAndNil(L) end; 57 | end. 58 | -------------------------------------------------------------------------------- /code-samples_ukrainian/hello_world.dpr: -------------------------------------------------------------------------------- 1 | // Просто використовуйте цей рядок у всіх сучасних сирцях 2 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 3 | // Needed for console programs on Windows, 4 | // otherwise (with Delphi) the default is GUI program without console. 5 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 6 | 7 | program MyProgram; // Збережіть цей файл як myprogram.dpr 8 | begin 9 | WriteLn('Привіт, світ!'); 10 | end. 11 | -------------------------------------------------------------------------------- /code-samples_ukrainian/inheritance.dpr: -------------------------------------------------------------------------------- 1 | program MyProgram; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 5 | 6 | uses SysUtils; 7 | 8 | type 9 | TMyClass = class 10 | MyInt: Integer; 11 | procedure MyVirtualMethod; virtual; 12 | end; 13 | 14 | TMyClassDescendant = class(TMyClass) 15 | procedure MyVirtualMethod; override; 16 | end; 17 | 18 | procedure TMyClass.MyVirtualMethod; 19 | begin 20 | WriteLn('TMyClass покаже MyInt + 10: ', MyInt + 10); 21 | end; 22 | 23 | procedure TMyClassDescendant.MyVirtualMethod; 24 | begin 25 | WriteLn('TMyClassDescendant покаже MyInt + 20: ', MyInt + 20); 26 | end; 27 | 28 | var 29 | C: TMyClass; 30 | begin 31 | C := TMyClass.Create; 32 | try 33 | C.MyVirtualMethod; 34 | finally 35 | FreeAndNil(C); 36 | end; 37 | 38 | C := TMyClassDescendant.Create; 39 | try 40 | C.MyVirtualMethod; 41 | finally 42 | FreeAndNil(C); 43 | end; 44 | end. 45 | -------------------------------------------------------------------------------- /code-samples_ukrainian/initialization_finalization.pas: -------------------------------------------------------------------------------- 1 | unit initialization_finalization; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | 5 | interface 6 | 7 | implementation 8 | 9 | initialization 10 | WriteLn('Привіт, світ!'); 11 | finalization 12 | WriteLn('Бувай, світ!'); 13 | end. 14 | -------------------------------------------------------------------------------- /code-samples_ukrainian/interface_casting.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | // {$interfaces corba} // зауважте, що приведення типу "as" для CORBA не компілюється 4 | 5 | uses Classes; 6 | 7 | type 8 | IMyInterface = interface 9 | ['{7FC754BC-9CA7-4399-B947-D37DD30BA90A}'] 10 | procedure One; 11 | end; 12 | 13 | IMyInterface2 = interface(IMyInterface) 14 | ['{A72B7008-3F90-45C1-8F4C-E77C4302AA3E}'] 15 | procedure Two; 16 | end; 17 | 18 | IMyInterface3 = interface(IMyInterface2) 19 | ['{924BFB98-B049-4945-AF17-1DB08DB1C0C5}'] 20 | procedure Three; 21 | end; 22 | 23 | TMyClass = class(TComponent, IMyInterface) 24 | procedure One; 25 | end; 26 | 27 | TMyClass2 = class(TMyClass, IMyInterface, IMyInterface2) 28 | procedure One; 29 | procedure Two; 30 | end; 31 | 32 | procedure TMyClass.One; 33 | begin 34 | Writeln('TMyClass.One'); 35 | end; 36 | 37 | procedure TMyClass2.One; 38 | begin 39 | Writeln('TMyClass2.One'); 40 | end; 41 | 42 | procedure TMyClass2.Two; 43 | begin 44 | Writeln('TMyClass2.Two'); 45 | end; 46 | 47 | procedure UseInterface2(const I: IMyInterface2); 48 | begin 49 | I.One; 50 | I.Two; 51 | end; 52 | 53 | procedure UseInterface3(const I: IMyInterface3); 54 | begin 55 | I.One; 56 | I.Two; 57 | I.Three; 58 | end; 59 | 60 | var 61 | My: IMyInterface; 62 | MyClass: TMyClass; 63 | begin 64 | My := TMyClass2.Create(nil); 65 | MyClass := TMyClass2.Create(nil); 66 | 67 | // Це не компілюється, оскільки під час компіляції невідомо, чи My є IMyInterface2. 68 | // UseInterface2(My); 69 | // UseInterface2(MyClass); 70 | 71 | // Це компілюється та працює нормально. 72 | UseInterface2(IMyInterface2(My)); 73 | // Це не компілюється. Приведення InterfaceType(ClassType) перевіряється під час компіляції. 74 | // UseInterface2(IMyInterface2(MyClass)); 75 | 76 | // Це компілюється та працює нормально. 77 | UseInterface2(My as IMyInterface2); 78 | // Це компілюється та працює нормально. 79 | UseInterface2(MyClass as IMyInterface2); 80 | 81 | // Це компілюється, але зазнає збою під час виконання, з потворним «Access Violation». 82 | // UseInterface3(IMyInterface3(My)); 83 | // Це не компілюється. Приведення InterfaceType(ClassType) перевіряється під час компіляції. 84 | // UseInterface3(IMyInterface3(MyClass)); 85 | 86 | // Це компілюється, але зазнає збою під час виконання, з гарним «EInvalidCast: неправильне приведення типу». 87 | // UseInterface3(My as IMyInterface3); 88 | // Це компілюється, але зазнає збою під час виконання, з гарним «EInvalidCast: неправильне приведення типу». 89 | // UseInterface3(MyClass as IMyInterface3); 90 | 91 | Writeln('Завершено'); 92 | end. 93 | -------------------------------------------------------------------------------- /code-samples_ukrainian/interfaces_com_test.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} 2 | {$mode objfpc}{$H+}{$J-} 3 | {$interfaces com} 4 | {$endif} 5 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 6 | 7 | uses 8 | SysUtils, Classes; 9 | 10 | type 11 | IMyInterface = interface 12 | ['{3075FFCD-8EFB-4E98-B157-261448B8D92E}'] 13 | procedure Shoot; 14 | end; 15 | 16 | TMyClass1 = class(TComponent, IMyInterface) 17 | procedure Shoot; 18 | end; 19 | 20 | TMyClass2 = class(TComponent, IMyInterface) 21 | procedure Shoot; 22 | end; 23 | 24 | TMyClass3 = class(TComponent) 25 | procedure Shoot; 26 | end; 27 | 28 | procedure TMyClass1.Shoot; 29 | begin 30 | WriteLn('TMyClass1.Shoot'); 31 | end; 32 | 33 | procedure TMyClass2.Shoot; 34 | begin 35 | WriteLn('TMyClass2.Shoot'); 36 | end; 37 | 38 | procedure TMyClass3.Shoot; 39 | begin 40 | WriteLn('TMyClass3.Shoot'); 41 | end; 42 | 43 | procedure UseThroughInterface(I: IMyInterface); 44 | begin 45 | Write('Shooting... '); 46 | I.Shoot; 47 | end; 48 | 49 | var 50 | C1: TMyClass1; 51 | C2: TMyClass2; 52 | C3: TMyClass3; 53 | 54 | procedure UseInterfaces; 55 | begin 56 | if C1 is IMyInterface then 57 | //if Supports(C1, IMyInterface) then // equivalent to "is" check above 58 | UseThroughInterface(C1 as IMyInterface); 59 | if C2 is IMyInterface then 60 | UseThroughInterface(C2 as IMyInterface); 61 | if C3 is IMyInterface then 62 | UseThroughInterface(C3 as IMyInterface); 63 | end; 64 | 65 | begin 66 | C1 := TMyClass1.Create(nil); 67 | C2 := TMyClass2.Create(nil); 68 | C3 := TMyClass3.Create(nil); 69 | try 70 | UseInterfaces; 71 | finally 72 | FreeAndNil(C1); 73 | FreeAndNil(C2); 74 | FreeAndNil(C3); 75 | end; 76 | end. -------------------------------------------------------------------------------- /code-samples_ukrainian/interfaces_com_test_comments.txt: -------------------------------------------------------------------------------- 1 | if C1 is IMyInterface then 2 | //if Supports(C1, IMyInterface) then // equivalent to "is" check above 3 | //UseThroughInterface(C1 as IMyInterface); 4 | UseThroughInterface(C1); // these can also be just casted with no syntax, as it's compile-time provably correct 5 | //UseThroughInterface(IMyInterface(C1)); // equivalent to casting implicitly, it seems: checked at compile-time, this is OK 6 | 7 | if C2 is IMyInterface then 8 | //UseThroughInterface(C2 as IMyInterface); 9 | UseThroughInterface(C2); // these can also be just casted with no syntax, as it's compile-time provably correct 10 | 11 | if C3 is IMyInterface then 12 | UseThroughInterface(C3 as IMyInterface); // this is visibly wrong at compile-time, so only "as" cast compiles 13 | //UseThroughInterface(IMyInterface(C3)); // equivalent to casting implicitly, it seems: checked at compile-time, not possible here 14 | -------------------------------------------------------------------------------- /code-samples_ukrainian/interfaces_com_with_ref_counting.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} 2 | {$mode objfpc}{$H+}{$J-} 3 | {$interfaces com} 4 | {$endif} 5 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 6 | 7 | uses 8 | SysUtils, Classes; 9 | 10 | type 11 | IMyInterface = interface 12 | ['{3075FFCD-8EFB-4E98-B157-261448B8D92E}'] 13 | procedure Shoot; 14 | end; 15 | 16 | TMyClass1 = class(TInterfacedObject, IMyInterface) 17 | procedure Shoot; 18 | end; 19 | 20 | TMyClass2 = class(TInterfacedObject, IMyInterface) 21 | procedure Shoot; 22 | end; 23 | 24 | TMyClass3 = class(TInterfacedObject) 25 | procedure Shoot; 26 | end; 27 | 28 | procedure TMyClass1.Shoot; 29 | begin 30 | WriteLn('TMyClass1.Shoot'); 31 | end; 32 | 33 | procedure TMyClass2.Shoot; 34 | begin 35 | WriteLn('TMyClass2.Shoot'); 36 | end; 37 | 38 | procedure TMyClass3.Shoot; 39 | begin 40 | WriteLn('TMyClass3.Shoot'); 41 | end; 42 | 43 | procedure UseThroughInterface(I: IMyInterface); 44 | begin 45 | Write('Shooting... '); 46 | I.Shoot; 47 | end; 48 | 49 | var 50 | C1: IMyInterface; // COM takes care of destruction 51 | C2: IMyInterface; // COM takes care of destruction 52 | C3: TMyClass3; // YOU have to take care of destruction 53 | begin 54 | C1 := TMyClass1.Create as IMyInterface; 55 | C2 := TMyClass2.Create as IMyInterface; 56 | C3 := TMyClass3.Create; 57 | try 58 | UseThroughInterface(C1); // no need to use "as" operator 59 | UseThroughInterface(C2); 60 | if C3 is IMyInterface then 61 | UseThroughInterface(C3 as IMyInterface); // this will not execute 62 | finally 63 | { C1 and C2 variables go out of scope and will be auto-destroyed now. 64 | 65 | In contrast, C3 is a class instance, not managed by an interface, 66 | and it has to be destroyed manually. } 67 | FreeAndNil(C3); 68 | end; 69 | end. -------------------------------------------------------------------------------- /code-samples_ukrainian/interfaces_corba_test.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} 2 | {$mode objfpc}{$H+}{$J-} 3 | {$interfaces corba} 4 | {$else} 5 | {$message warn 'Delphi does not support CORBA interfaces, only COM, that change how memory is managed. This example is not valid in Delphi.'} 6 | begin end. 7 | {$endif} 8 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 9 | 10 | uses 11 | SysUtils, Classes; 12 | 13 | type 14 | IMyInterface = interface 15 | ['{79352612-668B-4E8C-910A-26975E103CAC}'] 16 | procedure Shoot; 17 | end; 18 | 19 | TMyClass1 = class(IMyInterface) 20 | procedure Shoot; 21 | end; 22 | 23 | TMyClass2 = class(IMyInterface) 24 | procedure Shoot; 25 | end; 26 | 27 | TMyClass3 = class 28 | procedure Shoot; 29 | end; 30 | 31 | procedure TMyClass1.Shoot; 32 | begin 33 | WriteLn('TMyClass1.Shoot'); 34 | end; 35 | 36 | procedure TMyClass2.Shoot; 37 | begin 38 | WriteLn('TMyClass2.Shoot'); 39 | end; 40 | 41 | procedure TMyClass3.Shoot; 42 | begin 43 | WriteLn('TMyClass3.Shoot'); 44 | end; 45 | 46 | procedure UseThroughInterface(I: IMyInterface); 47 | begin 48 | Write('Shooting... '); 49 | I.Shoot; 50 | end; 51 | 52 | var 53 | C1: TMyClass1; 54 | C2: TMyClass2; 55 | C3: TMyClass3; 56 | begin 57 | C1 := TMyClass1.Create; 58 | C2 := TMyClass2.Create; 59 | C3 := TMyClass3.Create; 60 | try 61 | if C1 is IMyInterface then 62 | UseThroughInterface(C1 as IMyInterface); 63 | if C2 is IMyInterface then 64 | UseThroughInterface(C2 as IMyInterface); 65 | // The "C3 is IMyInterface" below is false, 66 | // so "UseThroughInterface(C3 as IMyInterface)" will not execute. 67 | if C3 is IMyInterface then 68 | UseThroughInterface(C3 as IMyInterface); 69 | finally 70 | FreeAndNil(C1); 71 | FreeAndNil(C2); 72 | FreeAndNil(C3); 73 | end; 74 | end. 75 | -------------------------------------------------------------------------------- /code-samples_ukrainian/is_as.dpr: -------------------------------------------------------------------------------- 1 | program is_as; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 5 | 6 | uses 7 | SysUtils; 8 | 9 | type 10 | TMyClass = class 11 | procedure MyMethod; 12 | end; 13 | 14 | TMyClassDescendant = class(TMyClass) 15 | procedure MyMethodInDescendant; 16 | end; 17 | 18 | procedure TMyClass.MyMethod; 19 | begin 20 | WriteLn('MyMethod'); 21 | end; 22 | 23 | procedure TMyClassDescendant.MyMethodInDescendant; 24 | begin 25 | WriteLn('MyMethodInDescendant'); 26 | end; 27 | 28 | var 29 | Descendant: TMyClassDescendant; 30 | C: TMyClass; 31 | begin 32 | Descendant := TMyClassDescendant.Create; 33 | try 34 | Descendant.MyMethod; 35 | Descendant.MyMethodInDescendant; 36 | 37 | { Descendant has all functionality expected of 38 | the TMyClass, so this assignment is OK } 39 | C := Descendant; 40 | C.MyMethod; 41 | 42 | { this cannot work, since TMyClass doesn't define this method } 43 | //C.MyMethodInDescendant; 44 | if C is TMyClassDescendant then 45 | (C as TMyClassDescendant).MyMethodInDescendant; 46 | 47 | finally 48 | FreeAndNil(Descendant); 49 | end; 50 | end. 51 | -------------------------------------------------------------------------------- /code-samples_ukrainian/lazarus/showcolor.dpr: -------------------------------------------------------------------------------- 1 | program showcolor; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 5 | 6 | // Обидва модулі - Graphics й GoogleMapsEngine визначають тип TColor. 7 | uses 8 | Graphics, GoogleMapsEngine; 9 | 10 | var 11 | { Не не спрацює так, як ми хочемо, оскільки TColor в підсумку 12 | визначений в модулі GoogleMapsEngine. } 13 | // Color: TColor; 14 | { Це працює. } 15 | Color: Graphics.TColor; 16 | begin 17 | Color := clYellow; 18 | WriteLn(Red(Color), ' ', Green(Color), ' ', Blue(Color)); 19 | end. 20 | 21 | -------------------------------------------------------------------------------- /code-samples_ukrainian/lazarus/showcolor.lpi: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectOptions> 4 | <Version Value="9"/> 5 | <General> 6 | <Flags> 7 | <MainUnitHasCreateFormStatements Value="False"/> 8 | <MainUnitHasTitleStatement Value="False"/> 9 | </Flags> 10 | <SessionStorage Value="InProjectDir"/> 11 | <MainUnit Value="0"/> 12 | <Title Value="showcolor"/> 13 | <UseAppBundle Value="False"/> 14 | <ResourceType Value="res"/> 15 | </General> 16 | <i18n> 17 | <EnableI18N LFM="False"/> 18 | </i18n> 19 | <VersionInfo> 20 | <StringTable ProductVersion=""/> 21 | </VersionInfo> 22 | <BuildModes Count="1"> 23 | <Item1 Name="Default" Default="True"/> 24 | </BuildModes> 25 | <PublishOptions> 26 | <Version Value="2"/> 27 | </PublishOptions> 28 | <RunParams> 29 | <local> 30 | <FormatVersion Value="1"/> 31 | </local> 32 | </RunParams> 33 | <RequiredPackages Count="1"> 34 | <Item1> 35 | <PackageName Value="LCL"/> 36 | </Item1> 37 | </RequiredPackages> 38 | <Units Count="1"> 39 | <Unit0> 40 | <Filename Value="showcolor.dpr"/> 41 | <IsPartOfProject Value="True"/> 42 | </Unit0> 43 | </Units> 44 | </ProjectOptions> 45 | <CompilerOptions> 46 | <Version Value="11"/> 47 | <Target> 48 | <Filename Value="showcolor"/> 49 | </Target> 50 | <SearchPaths> 51 | <IncludeFiles Value="$(ProjOutDir)"/> 52 | <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 53 | </SearchPaths> 54 | </CompilerOptions> 55 | <Debugging> 56 | <Exceptions Count="3"> 57 | <Item1> 58 | <Name Value="EAbort"/> 59 | </Item1> 60 | <Item2> 61 | <Name Value="ECodetoolError"/> 62 | </Item2> 63 | <Item3> 64 | <Name Value="EFOpenError"/> 65 | </Item3> 66 | </Exceptions> 67 | </Debugging> 68 | </CONFIG> 69 | -------------------------------------------------------------------------------- /code-samples_ukrainian/loops.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | {$R+} // перевірку діапазону ввімкнено – добре для налагодження 4 | 5 | var 6 | MyArray: array [0..9] of Integer; 7 | I: Integer; 8 | begin 9 | // ініціалізувати 10 | for I := 0 to 9 do 11 | MyArray[I] := I * I; 12 | 13 | // показати 14 | for I := 0 to 9 do 15 | WriteLn('Квадрати: ', MyArray[I]); 16 | 17 | // виконує те саме, що й вище 18 | for I := Low(MyArray) to High(MyArray) do 19 | WriteLn('Квадрати: ', MyArray[I]); 20 | 21 | // виконує те саме, що й вище 22 | I := 0; 23 | while I < 10 do 24 | begin 25 | WriteLn('Квадрати: ', MyArray[I]); 26 | I := I + 1; // or "I += 1", or "Inc(I)" 27 | end; 28 | 29 | // виконує те саме, що й вище 30 | I := 0; 31 | repeat 32 | WriteLn('Квадоати: ', MyArray[I]); 33 | Inc(I); 34 | until I = 10; 35 | 36 | // виконує те саме, що й вище 37 | // зауваження: тут я перераховую значення MyArray, а не індекси 38 | for I in MyArray do 39 | WriteLn('Квадрати: ', I); 40 | end. -------------------------------------------------------------------------------- /code-samples_ukrainian/method_calls_inheritance_1.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils; 5 | 6 | type 7 | TMyClass1 = class 8 | procedure MyMethod; 9 | end; 10 | 11 | TMyClass2 = class(TMyClass1) 12 | procedure MyMethod; 13 | procedure MyOtherMethod; 14 | end; 15 | 16 | procedure TMyClass1.MyMethod; 17 | begin 18 | Writeln('TMyClass1.MyMethod'); 19 | end; 20 | 21 | procedure TMyClass2.MyMethod; 22 | begin 23 | Writeln('TMyClass2.MyMethod'); 24 | end; 25 | 26 | procedure TMyClass2.MyOtherMethod; 27 | begin 28 | MyMethod; // this calls TMyClass2.MyMethod 29 | end; 30 | 31 | var 32 | C: TMyClass2; 33 | begin 34 | C := TMyClass2.Create; 35 | try 36 | C.MyOtherMethod; 37 | finally FreeAndNil(C) end; 38 | end. 39 | -------------------------------------------------------------------------------- /code-samples_ukrainian/method_calls_inherited.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils; 5 | 6 | type 7 | TMyClass1 = class 8 | constructor Create; 9 | procedure MyMethod(const A: Integer); 10 | end; 11 | 12 | TMyClass2 = class(TMyClass1) 13 | constructor Create; 14 | procedure MyMethod(const A: Integer); 15 | end; 16 | 17 | constructor TMyClass1.Create; 18 | begin 19 | inherited Create; // this calls TObject.Create 20 | Writeln('TMyClass1.Create'); 21 | end; 22 | 23 | procedure TMyClass1.MyMethod(const A: Integer); 24 | begin 25 | Writeln('TMyClass1.MyMethod ', A); 26 | end; 27 | 28 | constructor TMyClass2.Create; 29 | begin 30 | inherited Create; // this calls TMyClass1.Create 31 | Writeln('TMyClass2.Create'); 32 | end; 33 | 34 | procedure TMyClass2.MyMethod(const A: Integer); 35 | begin 36 | inherited MyMethod(A); // this calls TMyClass1.MyMethod 37 | Writeln('TMyClass2.MyMethod ', A); 38 | end; 39 | 40 | var 41 | C: TMyClass2; 42 | begin 43 | C := TMyClass2.Create; 44 | try 45 | C.MyMethod(123); 46 | finally FreeAndNil(C) end; 47 | end. 48 | -------------------------------------------------------------------------------- /code-samples_ukrainian/myconfig.inc: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} 2 | {$mode objfpc} 3 | {$H+} 4 | {$J-} 5 | {$modeswitch advancedrecords} 6 | {$ifdef VER2} 7 | {$message fatal 'This code can only be compiled using FPC version >= 3.0.'} 8 | {$endif} 9 | {$endif} 10 | -------------------------------------------------------------------------------- /code-samples_ukrainian/myunit.pas: -------------------------------------------------------------------------------- 1 | unit MyUnit; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | 5 | interface 6 | 7 | procedure MyProcedure(const A: Integer); 8 | function MyFunction(const S: string): string; 9 | 10 | implementation 11 | 12 | procedure MyProcedure(const A: Integer); 13 | begin 14 | WriteLn('A + 10 is: ', A + 10); 15 | end; 16 | 17 | function MyFunction(const S: string): string; 18 | begin 19 | Result := S + 'strings are automatically managed'; 20 | end; 21 | 22 | end. 23 | -------------------------------------------------------------------------------- /code-samples_ukrainian/myunit_test.dpr: -------------------------------------------------------------------------------- 1 | program MyProgram; 2 | 3 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 4 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 5 | 6 | uses MyUnit; 7 | 8 | begin 9 | WriteLn(MyFunction('Note: ')); 10 | MyProcedure(5); 11 | end. 12 | -------------------------------------------------------------------------------- /code-samples_ukrainian/operator_overloading.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses StrUtils; 5 | 6 | operator* (const S: string; const A: Integer): string; 7 | begin 8 | Result := DupeString(S, A); 9 | end; 10 | 11 | begin 12 | WriteLn('bla' * 10); 13 | end. -------------------------------------------------------------------------------- /code-samples_ukrainian/operator_overloading_classes.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils; 5 | 6 | type 7 | TMyClass = class 8 | MyInt: Integer; 9 | end; 10 | 11 | operator* (const C1, C2: TMyClass): TMyClass; 12 | begin 13 | Result := TMyClass.Create; 14 | Result.MyInt := C1.MyInt * C2.MyInt; 15 | end; 16 | 17 | var 18 | C1, C2: TMyClass; 19 | begin 20 | C1 := TMyClass.Create; 21 | try 22 | C1.MyInt := 12; 23 | C2 := C1 * C1; 24 | try 25 | WriteLn('12 * 12 = ', C2.MyInt); 26 | finally 27 | FreeAndNil(C2); 28 | end; 29 | finally 30 | FreeAndNil(C1); 31 | end; 32 | end. -------------------------------------------------------------------------------- /code-samples_ukrainian/operator_overloading_records.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils; 5 | 6 | type 7 | TMyRecord = record 8 | MyInt: Integer; 9 | end; 10 | 11 | operator* (const C1, C2: TMyRecord): TMyRecord; 12 | begin 13 | Result.MyInt := C1.MyInt * C2.MyInt; 14 | end; 15 | 16 | var 17 | R1, R2: TMyRecord; 18 | begin 19 | R1.MyInt := 12; 20 | R2 := R1 * R1; 21 | WriteLn('12 * 12 = ', R2.MyInt); 22 | end. -------------------------------------------------------------------------------- /code-samples_ukrainian/operator_overloading_records_lists.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} 2 | {$mode objfpc}{$H+}{$J-} 3 | {$modeswitch advancedrecords} 4 | {$endif} 5 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 6 | 7 | uses 8 | SysUtils, FGL; 9 | 10 | type 11 | TMyRecord = record 12 | MyInt: Integer; 13 | class operator+ (const C1, C2: TMyRecord): TMyRecord; 14 | class operator= (const C1, C2: TMyRecord): boolean; 15 | end; 16 | 17 | class operator TMyRecord.+ (const C1, C2: TMyRecord): TMyRecord; 18 | begin 19 | Result.MyInt := C1.MyInt + C2.MyInt; 20 | end; 21 | 22 | class operator TMyRecord.= (const C1, C2: TMyRecord): boolean; 23 | begin 24 | Result := C1.MyInt = C2.MyInt; 25 | end; 26 | 27 | type 28 | TMyRecordList = {$ifdef FPC}specialize{$endif} TFPGList<TMyRecord>; 29 | 30 | var 31 | R, ListItem: TMyRecord; 32 | L: TMyRecordList; 33 | begin 34 | L := TMyRecordList.Create; 35 | try 36 | R.MyInt := 1; L.Add(R); 37 | R.MyInt := 10; L.Add(R); 38 | R.MyInt := 100; L.Add(R); 39 | 40 | R.MyInt := 0; 41 | for ListItem in L do 42 | R := ListItem + R; 43 | 44 | WriteLn('1 + 10 + 100 = ', R.MyInt); 45 | finally 46 | FreeAndNil(L); 47 | end; 48 | end. -------------------------------------------------------------------------------- /code-samples_ukrainian/persistent.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils, Classes; 5 | 6 | type 7 | TMyClass = class(TPersistent) 8 | public 9 | MyInt: Integer; 10 | procedure Assign(Source: TPersistent); override; 11 | end; 12 | 13 | TMyClassDescendant = class(TMyClass) 14 | public 15 | MyString: string; 16 | procedure Assign(Source: TPersistent); override; 17 | end; 18 | 19 | procedure TMyClass.Assign(Source: TPersistent); 20 | var 21 | SourceMyClass: TMyClass; 22 | begin 23 | if Source is TMyClass then 24 | begin 25 | SourceMyClass := TMyClass(Source); 26 | MyInt := SourceMyClass.MyInt; 27 | // Xxx := SourceMyClass.Xxx; // add new fields here 28 | end else 29 | { Since TMyClass is a direct TPersistent descendant, 30 | it calls inherited ONLY when it cannot handle Source class. 31 | See comments below. } 32 | inherited Assign(Source); 33 | end; 34 | 35 | procedure TMyClassDescendant.Assign(Source: TPersistent); 36 | var 37 | SourceMyClassDescendant: TMyClassDescendant; 38 | begin 39 | if Source is TMyClassDescendant then 40 | begin 41 | SourceMyClassDescendant := TMyClassDescendant(Source); 42 | MyString := SourceMyClassDescendant.MyString; 43 | // Xxx := SourceMyClassDescendant.Xxx; // add new fields here 44 | end; 45 | 46 | { Since TMyClassDescendant has an ancestor that already overrides 47 | Assign (in TMyClass.Assign), it calls inherited ALWAYS, 48 | to allow TMyClass.Assign to handle remaining fields. 49 | See comments below for a detailed reasoning. } 50 | inherited Assign(Source); 51 | end; 52 | 53 | var 54 | C1, C2: TMyClass; 55 | CD1, CD2: TMyClassDescendant; 56 | begin 57 | // test TMyClass.Assign 58 | C1 := TMyClass.Create; 59 | C2 := TMyClass.Create; 60 | try 61 | C1.MyInt := 666; 62 | C2.Assign(C1); 63 | WriteLn('C2 state: ', C2.MyInt); 64 | finally 65 | FreeAndNil(C1); 66 | FreeAndNil(C2); 67 | end; 68 | 69 | // test TMyClassDescendant.Assign 70 | CD1 := TMyClassDescendant.Create; 71 | CD2 := TMyClassDescendant.Create; 72 | try 73 | CD1.MyInt := 44; 74 | CD1.MyString := 'blah'; 75 | CD2.Assign(CD1); 76 | WriteLn('CD2 state: ', CD2.MyInt, ' ', CD2.MyString); 77 | finally 78 | FreeAndNil(CD1); 79 | FreeAndNil(CD2); 80 | end; 81 | end. -------------------------------------------------------------------------------- /code-samples_ukrainian/records.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} 2 | {$mode objfpc}{$H+}{$J-} 3 | {$modeswitch advancedrecords} 4 | {$endif} 5 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 6 | 7 | type 8 | TMyRecord = record 9 | public 10 | I, Square: Integer; 11 | procedure WriteLnDescription; 12 | end; 13 | 14 | procedure TMyRecord.WriteLnDescription; 15 | begin 16 | WriteLn('Square of ', I, ' is ', Square); 17 | end; 18 | 19 | var 20 | A: array [0..9] of TMyRecord; 21 | R: TMyRecord; 22 | I: Integer; 23 | begin 24 | for I := 0 to 9 do 25 | begin 26 | A[I].I := I; 27 | A[I].Square := I * I; 28 | end; 29 | 30 | for R in A do 31 | R.WriteLnDescription; 32 | end. 33 | -------------------------------------------------------------------------------- /code-samples_ukrainian/static_class_method.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | type 5 | TMyCallback = procedure (A: Integer); 6 | 7 | TMyClass = class 8 | class procedure Foo(A: Integer); static; 9 | end; 10 | 11 | class procedure TMyClass.Foo(A: Integer); 12 | begin 13 | end; 14 | 15 | var 16 | Callback: TMyCallback; 17 | begin 18 | Callback := @TMyClass.Foo; 19 | end. 20 | -------------------------------------------------------------------------------- /code-samples_ukrainian/test_myconfig.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 2 | 3 | { Compile this to test that myconfig.inc is valid. } 4 | {$I myconfig.inc} 5 | 6 | begin 7 | end. -------------------------------------------------------------------------------- /code-samples_ukrainian/with_virtual_methods.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils; 5 | 6 | type 7 | TFruit = class 8 | procedure Eat; virtual; 9 | end; 10 | 11 | TApple = class(TFruit) 12 | procedure Eat; override; 13 | end; 14 | 15 | procedure TFruit.Eat; 16 | begin 17 | Writeln('Eating a fruit'); 18 | end; 19 | 20 | procedure TApple.Eat; 21 | begin 22 | Writeln('Eating an apple'); 23 | end; 24 | 25 | procedure DoSomethingWithAFruit(const Fruit: TFruit); 26 | begin 27 | Writeln('We have a fruit with class ', Fruit.ClassName); 28 | Writeln('We eat it:'); 29 | Fruit.Eat; 30 | end; 31 | 32 | var 33 | Apple: TApple; // Note: you could as well declare "Apple: TFruit" here 34 | begin 35 | Apple := TApple.Create; 36 | try 37 | DoSomethingWithAFruit(Apple); 38 | finally FreeAndNil(Apple) end; 39 | end. 40 | -------------------------------------------------------------------------------- /code-samples_ukrainian/without_virtual_methods.dpr: -------------------------------------------------------------------------------- 1 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 2 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 3 | 4 | uses SysUtils; 5 | 6 | type 7 | TFruit = class 8 | procedure Eat; 9 | end; 10 | 11 | TApple = class(TFruit) 12 | procedure Eat; 13 | end; 14 | 15 | procedure TFruit.Eat; 16 | begin 17 | Writeln('Eating a fruit'); 18 | end; 19 | 20 | procedure TApple.Eat; 21 | begin 22 | Writeln('Eating an apple'); 23 | end; 24 | 25 | procedure DoSomethingWithAFruit(const Fruit: TFruit); 26 | begin 27 | Writeln('We have a fruit with class ', Fruit.ClassName); 28 | Writeln('We eat it:'); 29 | Fruit.Eat; 30 | end; 31 | 32 | var 33 | Apple: TApple; // Note: you could as well declare "Apple: TFruit" here 34 | begin 35 | Apple := TApple.Create; 36 | try 37 | DoSomethingWithAFruit(Apple); 38 | finally FreeAndNil(Apple) end; 39 | end. 40 | -------------------------------------------------------------------------------- /docinfo-footer.html: -------------------------------------------------------------------------------- 1 | <!-- Google analytics --> 2 | <script type="text/javascript"> 3 | var gaJsHost = (("https:" == document.location.protocol) ? "https://ssl." : "http://www."); 4 | document.write(unescape("%3Cscript src='" + gaJsHost + "google-analytics.com/ga.js' type='text/javascript'%3E%3C/script%3E")); 5 | </script> 6 | <script type="text/javascript"> 7 | try { 8 | var pageTracker = _gat._getTracker("UA-6792759-1"); 9 | pageTracker._trackPageview(); 10 | } catch(err) {}</script> 11 | 12 | <!-- Piwik --> 13 | <a href="http://piwik.org" title="Web analytics" onclick="window.open(this.href);return(false);"> 14 | <script type="text/javascript"> 15 | var pkBaseURL = (("https:" == document.location.protocol) ? "https://michalis.xyz/piwik/" : "http://michalis.xyz/piwik/"); 16 | document.write(unescape("%3Cscript src='" + pkBaseURL + "piwik.js' type='text/javascript'%3E%3C/script%3E")); 17 | </script><script type="text/javascript"> 18 | piwik_action_name = ''; 19 | piwik_idsite = 1; 20 | piwik_url = pkBaseURL + "piwik.php"; 21 | piwik_log(piwik_action_name, piwik_idsite, piwik_url); 22 | </script> 23 | <object><noscript><p>Web analytics <img src="http://michalis.xyz/piwik/piwik.php?idsite=1" style="border:0" alt=""/></p></noscript></object></a> 24 | <!-- End Piwik Tag --> 25 | -------------------------------------------------------------------------------- /locale/AUTHORS.txt: -------------------------------------------------------------------------------- 1 | Localization for AsciiDoctor built-in labels, 2 | prepared by AsciiDoctor developers. 3 | See 4 | https://asciidoctor.org/docs/user-manual/#language-support 5 | https://github.com/asciidoctor/asciidoctor/tree/master/data/locale 6 | 7 | Get it by "svn co https://github.com/asciidoctor/asciidoctor/trunk/data/locale" 8 | (you can use SVN to easily download a subdirectory of repo from GitHub). 9 | -------------------------------------------------------------------------------- /locale/attributes-ar.adoc: -------------------------------------------------------------------------------- 1 | // Arabic translation, courtesy of Aboullaite Mohammed <aboullaite.mohammed@gmail.com> 2 | :appendix-caption: ملحق 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: تنبيه 5 | //:chapter-label: ??? 6 | //:chapter-refsig: {chapter-label} 7 | :example-caption: مثال 8 | :figure-caption: الشكل 9 | :important-caption: مهم 10 | :last-update-label: اخر تحديث 11 | ifdef::listing-caption[:listing-caption: قائمة] 12 | ifdef::manname-title[:manname-title: اسم] 13 | :note-caption: ملاحظة 14 | //:part-refsig: ??? 15 | ifdef::preface-title[:preface-title: تمهيد] 16 | //:section-refsig: ??? 17 | :table-caption: جدول 18 | :tip-caption: تلميح 19 | :toc-title: فهرس 20 | :untitled-label: بدون عنوان 21 | :version-label: نسخة 22 | :warning-caption: تحذير 23 | -------------------------------------------------------------------------------- /locale/attributes-bg.adoc: -------------------------------------------------------------------------------- 1 | // Bulgarian translation, courtesy of Ivan St. Ivanov <ivan.st.ivanov@gmail.com> 2 | :appendix-caption: Приложение 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Внимание 5 | //:chapter-label: ??? 6 | //:chapter-refsig: {chapter-label} 7 | :example-caption: Пример 8 | :figure-caption: Фигура 9 | :important-caption: Важно 10 | :last-update-label: Последно обновен 11 | ifdef::listing-caption[:listing-caption: Листинг] 12 | ifdef::manname-title[:manname-title: Име] 13 | :note-caption: Забележка 14 | //:part-refsig: ??? 15 | ifdef::preface-title[:preface-title: Предговор] 16 | //:section-refsig: ??? 17 | :table-caption: Таблица 18 | :tip-caption: Подсказка 19 | :toc-title: Съдържание 20 | :untitled-label: Без заглавие 21 | :version-label: Версия 22 | :warning-caption: Внимание 23 | -------------------------------------------------------------------------------- /locale/attributes-ca.adoc: -------------------------------------------------------------------------------- 1 | // Catalan translation, courtesy of Abel Salgado Romero <abelromero@gmail.com> and Alex Soto 2 | :appendix-caption: Apendix 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Atenció 5 | //:chapter-label: ??? 6 | //:chapter-refsig: {chapter-label} 7 | :example-caption: Exemple 8 | :figure-caption: Figura 9 | :important-caption: Important 10 | :last-update-label: Última actualització 11 | ifdef::listing-caption[:listing-caption: Llista] 12 | ifdef::manname-title[:manname-title: Nom] 13 | :note-caption: Nota 14 | //:part-refsig: ??? 15 | ifdef::preface-title[:preface-title: Prefaci] 16 | //:section-refsig: ??? 17 | :table-caption: Taula 18 | :tip-caption: Suggeriment 19 | :toc-title: Índex 20 | :untitled-label: Sense títol 21 | :version-label: Versió 22 | :warning-caption: Advertència 23 | -------------------------------------------------------------------------------- /locale/attributes-cs.adoc: -------------------------------------------------------------------------------- 1 | // czech translation, for reference only; matches the built-in behavior of core 2 | :appendix-caption: Příloha 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Upozornění 5 | :chapter-label: Kapitola 6 | :chapter-refsig: {chapter-label} 7 | :example-caption: Příklad 8 | :figure-caption: Obrázek 9 | :important-caption: Důležité 10 | :last-update-label: Změněno 11 | ifdef::listing-caption[:listing-caption: Seznam] 12 | ifdef::manname-title[:manname-title: Název] 13 | :note-caption: Poznámka 14 | :part-refsig: Část 15 | ifdef::preface-title[:preface-title: Úvod] 16 | :section-refsig: Oddíl 17 | :table-caption: Tabulka 18 | :tip-caption: Tip 19 | :toc-title: Obsah 20 | :untitled-label: Nepojmenovaný 21 | :version-label: Verze 22 | :warning-caption: Varování 23 | -------------------------------------------------------------------------------- /locale/attributes-da.adoc: -------------------------------------------------------------------------------- 1 | // Danish translation, courtesy of Max Rydahl Andersen <manderse@redhat.com> 2 | :appendix-caption: Appendix 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Forsigtig 5 | //:chapter-label: ??? 6 | //:chapter-refsig: {chapter-label} 7 | :example-caption: Eksempel 8 | :figure-caption: Figur 9 | :important-caption: Vigtig 10 | :last-update-label: Sidst opdateret 11 | ifdef::listing-caption[:listing-caption: List] 12 | ifdef::manname-title[:manname-title: Navn] 13 | :note-caption: Notat 14 | //:part-refsig: ??? 15 | ifdef::preface-title[:preface-title: Forord] 16 | //:section-refsig: ??? 17 | :table-caption: Tabel 18 | :tip-caption: Tips 19 | :toc-title: Indholdsfortegnelse 20 | :untitled-label: Unavngivet 21 | :version-label: Version 22 | :warning-caption: Advarsel 23 | -------------------------------------------------------------------------------- /locale/attributes-de.adoc: -------------------------------------------------------------------------------- 1 | // German translation, courtesy of Florian Wilhelm 2 | :appendix-caption: Anhang 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Achtung 5 | :chapter-label: Kapitel 6 | :chapter-refsig: {chapter-label} 7 | :example-caption: Beispiel 8 | :figure-caption: Abbildung 9 | :important-caption: Wichtig 10 | :last-update-label: Zuletzt aktualisiert 11 | ifdef::listing-caption[:listing-caption: Listing] 12 | ifdef::manname-title[:manname-title: Bezeichnung] 13 | :note-caption: Anmerkung 14 | :part-label: Teil 15 | :part-refsig: {part-label} 16 | ifdef::preface-title[:preface-title: Vorwort] 17 | :section-refsig: Abschnitt 18 | :table-caption: Tabelle 19 | :tip-caption: Hinweis 20 | :toc-title: Inhaltsverzeichnis 21 | :untitled-label: Ohne Titel 22 | :version-label: Version 23 | :warning-caption: Warnung 24 | -------------------------------------------------------------------------------- /locale/attributes-en.adoc: -------------------------------------------------------------------------------- 1 | // English translation, for reference only; matches the built-in behavior of core 2 | :appendix-caption: Appendix 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Caution 5 | :chapter-label: Chapter 6 | :chapter-refsig: {chapter-label} 7 | :example-caption: Example 8 | :figure-caption: Figure 9 | :important-caption: Important 10 | :last-update-label: Last updated 11 | ifdef::listing-caption[:listing-caption: Listing] 12 | ifdef::manname-title[:manname-title: Name] 13 | :note-caption: Note 14 | :part-label: Part 15 | :part-refsig: {part-label} 16 | ifdef::preface-title[:preface-title: Preface] 17 | :section-refsig: Section 18 | :table-caption: Table 19 | :tip-caption: Tip 20 | :toc-title: Table of Contents 21 | :untitled-label: Untitled 22 | :version-label: Version 23 | :warning-caption: Warning 24 | -------------------------------------------------------------------------------- /locale/attributes-es.adoc: -------------------------------------------------------------------------------- 1 | // Spanish translation, courtesy of Eddú Meléndez <eddu.melendez@gmail.com> 2 | :appendix-caption: Apéndice 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Precaución 5 | //:chapter-label: ??? 6 | //:chapter-refsig: {chapter-label} 7 | :example-caption: Ejemplo 8 | :figure-caption: Figura 9 | :important-caption: Importante 10 | :last-update-label: Ultima actualización 11 | ifdef::listing-caption[:listing-caption: Lista] 12 | ifdef::manname-title[:manname-title: Nombre] 13 | :note-caption: Nota 14 | //:part-refsig: ??? 15 | ifdef::preface-title[:preface-title: Prefacio] 16 | //:section-refsig: ??? 17 | :table-caption: Tabla 18 | :tip-caption: Sugerencia 19 | :toc-title: Tabla de Contenido 20 | :untitled-label: Sin título 21 | :version-label: Versión 22 | :warning-caption: Aviso 23 | -------------------------------------------------------------------------------- /locale/attributes-fa.adoc: -------------------------------------------------------------------------------- 1 | // Persian (Farsi) translation, courtesy of Shahryar Eivazzadeh <shahryareiv@gmail.com> 2 | :appendix-caption: پیوست 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: گوشزد 5 | //:chapter-label: ??? 6 | //:chapter-refsig: {chapter-label} 7 | :example-caption: نمونه 8 | :figure-caption: نمودار 9 | :important-caption: مهم 10 | :last-update-label: آخرین به روز رسانی 11 | ifdef::listing-caption[:listing-caption: فهرست] 12 | ifdef::manname-title[:manname-title: نام] 13 | :note-caption: یادداشت 14 | //:part-refsig: ??? 15 | ifdef::preface-title[:preface-title: پیشگفتار] 16 | //:section-refsig: ??? 17 | :table-caption: جدول 18 | :tip-caption: نکته 19 | :toc-title: فهرست مطالب 20 | :untitled-label: بی‌نام 21 | :version-label: نگارش 22 | :warning-caption: هشدار 23 | -------------------------------------------------------------------------------- /locale/attributes-fi.adoc: -------------------------------------------------------------------------------- 1 | // Finnish translation by Tero Hänninen 2 | :appendix-caption: Liitteet 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Huom 5 | //:chapter-label: ??? 6 | //:chapter-refsig: {chapter-label} 7 | :example-caption: Esimerkki 8 | :figure-caption: Kuvio 9 | :important-caption: Tärkeää 10 | :last-update-label: Viimeksi päivitetty 11 | ifdef::listing-caption[:listing-caption: Listaus] 12 | ifdef::manname-title[:manname-title: Nimi] 13 | :note-caption: Huomio 14 | //:part-refsig: ??? 15 | ifdef::preface-title[:preface-title: Esipuhe] 16 | //:section-refsig: ??? 17 | :table-caption: Taulukko 18 | :tip-caption: Vinkki 19 | :toc-title: Sisällysluettelo 20 | :untitled-label: Nimetön 21 | :version-label: Versio 22 | :warning-caption: Varoitus 23 | -------------------------------------------------------------------------------- /locale/attributes-fr.adoc: -------------------------------------------------------------------------------- 1 | // French translation, courtesy of Nicolas Comet <nicolas.comet@gmail.com> 2 | :appendix-caption: Annexe 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Avertissement 5 | //:chapter-label: Chapitre 6 | //:chapter-refsig: {chapter-label} 7 | :example-caption: Exemple 8 | :figure-caption: Figure 9 | :important-caption: Important 10 | :last-update-label: Dernière mise à jour 11 | ifdef::listing-caption[:listing-caption: Liste] 12 | ifdef::manname-title[:manname-title: Nom] 13 | :note-caption: Note 14 | //:part-refsig: ??? 15 | ifdef::preface-title[:preface-title: Préface] 16 | //:section-refsig: ??? 17 | :table-caption: Tableau 18 | :tip-caption: Astuce 19 | :toc-title: Table des matières 20 | :untitled-label: Sans titre 21 | :version-label: Version 22 | :warning-caption: Attention 23 | -------------------------------------------------------------------------------- /locale/attributes-hu.adoc: -------------------------------------------------------------------------------- 1 | // Hungarian translation, courtesy of István Pató <istvan.pato@gmail.com> 2 | :appendix-caption: függelék 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Figyelmeztetés 5 | //:chapter-label: ??? 6 | //:chapter-refsig: {chapter-label} 7 | :example-caption: Példa 8 | :figure-caption: Ábra 9 | :important-caption: Fontos 10 | :last-update-label: Utolsó frissítés 11 | ifdef::listing-caption[:listing-caption: Lista] 12 | ifdef::manname-title[:manname-title: Név] 13 | :note-caption: Megjegyzés 14 | //:part-refsig: ??? 15 | ifdef::preface-title[:preface-title: Előszó] 16 | //:section-refsig: ??? 17 | :table-caption: Táblázat 18 | :tip-caption: Tipp 19 | :toc-title: Tartalomjegyzék 20 | :untitled-label: Névtelen 21 | :version-label: Verzió 22 | :warning-caption: Figyelem 23 | -------------------------------------------------------------------------------- /locale/attributes-id.adoc: -------------------------------------------------------------------------------- 1 | // Bahasa Indonesia, courtesy of Triyan W. Nugroho <triyan.wn@gmail.com> 2 | :appendix-caption: Lampiran 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Perhatian 5 | :chapter-label: Bab 6 | :chapter-refsig: {chapter-label} 7 | :example-caption: Contoh 8 | :figure-caption: Gambar 9 | :important-caption: Penting 10 | :last-update-label: Pembaruan terakhir 11 | ifdef::listing-caption[:listing-caption: Daftar] 12 | ifdef::manname-title[:manname-title: Nama] 13 | :note-caption: Catatan 14 | //:part-refsig: ??? 15 | //ifdef::preface-title[:preface-title: ???] 16 | //:section-refsig: ??? 17 | :table-caption: Tabel 18 | :tip-caption: Tips 19 | :toc-title: Daftar Isi 20 | :untitled-label: Tak Berjudul 21 | :version-label: Versi 22 | :warning-caption: Peringatan 23 | -------------------------------------------------------------------------------- /locale/attributes-it.adoc: -------------------------------------------------------------------------------- 1 | // Italian translation, courtesy of Marco Ciampa <ciampix@libero.it> 2 | :appendix-caption: Appendice 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Attenzione 5 | :chapter-label: Capitolo 6 | :chapter-refsig: {chapter-label} 7 | :example-caption: Esempio 8 | :figure-caption: Figura 9 | :important-caption: Importante 10 | :last-update-label: Ultimo aggiornamento 11 | ifdef::listing-caption[:listing-caption: Elenco] 12 | ifdef::manname-title[:manname-title: Nome] 13 | :note-caption: Nota 14 | //:part-refsig: ??? 15 | ifdef::preface-title[:preface-title: Prefazione] 16 | //:section-refsig: ??? 17 | :table-caption: Tabella 18 | :tip-caption: Suggerimento 19 | :toc-title: Indice 20 | :untitled-label: Senza titolo 21 | :version-label: Versione 22 | :warning-caption: Attenzione 23 | -------------------------------------------------------------------------------- /locale/attributes-ja.adoc: -------------------------------------------------------------------------------- 1 | // Japanese translation, courtesy of Takayuki Konishi <seannos.takayuki@gmail.com> 2 | :appendix-caption: 付録 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: 注意 5 | //:chapter-label: ??? 6 | //:chapter-refsig: {chapter-label} 7 | :example-caption: 例 8 | :figure-caption: 図 9 | :important-caption: 重要 10 | :last-update-label: 最終更新 11 | ifdef::listing-caption[:listing-caption: リスト] 12 | ifdef::manname-title[:manname-title: 名前] 13 | :note-caption: 注記 14 | //:part-refsig: ??? 15 | ifdef::preface-title[:preface-title: まえがき] 16 | //:section-refsig: ??? 17 | :table-caption: 表 18 | :tip-caption: ヒント 19 | :toc-title: 目次 20 | :untitled-label: 無題 21 | :version-label: バージョン 22 | :warning-caption: 警告 23 | -------------------------------------------------------------------------------- /locale/attributes-kr.adoc: -------------------------------------------------------------------------------- 1 | // Korean translation, courtesy of Sungsik Nam <jmyl@me.com> 2 | :appendix-caption: 부록 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: 주의 5 | //:chapter-label: ??? 6 | //:chapter-refsig: {chapter-label} 7 | :example-caption: 예시 8 | :figure-caption: 그림 9 | :important-caption: 중요 10 | :last-update-label: 마지막 업데이트 11 | ifdef::listing-caption[:listing-caption: 목록] 12 | ifdef::manname-title[:manname-title: 이름] 13 | :note-caption: 노트 14 | //:part-refsig: ??? 15 | ifdef::preface-title[:preface-title: 머리말] 16 | //:section-refsig: ??? 17 | :table-caption: 표 18 | :tip-caption: 힌트 19 | :toc-title: 차례 20 | :untitled-label: 익명 21 | :version-label: 버전 22 | :warning-caption: 경고 23 | -------------------------------------------------------------------------------- /locale/attributes-nb.adoc: -------------------------------------------------------------------------------- 1 | // Norwegian Bokmål, courtesy of Aslak Knutsen <aslak@4fs.no>, with updates from Karl Ove Hufthammer <karl@huftis.org> 2 | :appendix-caption: Vedlegg 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: OBS 5 | :chapter-label: Kapittel 6 | :chapter-refsig: {chapter-label} 7 | :example-caption: Eksempel 8 | :figure-caption: Figur 9 | :important-caption: Viktig 10 | :last-update-label: Sist oppdatert 11 | ifdef::listing-caption[:listing-caption: Programkode] 12 | ifdef::manname-title[:manname-title: Navn] 13 | :note-caption: Merk 14 | //:part-refsig: ??? 15 | ifdef::preface-title[:preface-title: Forord] 16 | //:section-refsig: ??? 17 | :table-caption: Tabell 18 | :tip-caption: Tips 19 | :toc-title: Innhold 20 | :untitled-label: Navnløs 21 | :version-label: Versjon 22 | :warning-caption: Advarsel 23 | -------------------------------------------------------------------------------- /locale/attributes-nl.adoc: -------------------------------------------------------------------------------- 1 | // Dutch translation, courtesy of Roel Van Steenberghe <roel.vansteenberghe@gmail.com> 2 | :appendix-caption: Bijlage 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Opgelet 5 | //:chapter-label: Hoofdstuk 6 | //:chapter-refsig: {chapter-label} 7 | :example-caption: Voorbeeld 8 | :figure-caption: Figuur 9 | :important-caption: Belangrijk 10 | :last-update-label: Laatste aanpassing 11 | ifdef::listing-caption[:listing-caption: Lijst] 12 | ifdef::manname-title[:manname-title: Naam] 13 | :note-caption: Noot 14 | //:part-refsig: ??? 15 | ifdef::preface-title[:preface-title: Inleiding] 16 | //:section-refsig: ??? 17 | :table-caption: Tabel 18 | :tip-caption: Tip 19 | :toc-title: Ínhoudsopgave 20 | :untitled-label: Naamloos 21 | :version-label: Versie 22 | :warning-caption: Waarschuwing 23 | -------------------------------------------------------------------------------- /locale/attributes-nn.adoc: -------------------------------------------------------------------------------- 1 | // Norwegian Nynorsk, courtesy of Karl Ove Hufthammer <karl@huftis.org> 2 | :appendix-caption: Vedlegg 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: OBS 5 | :chapter-label: Kapittel 6 | :chapter-refsig: {chapter-label} 7 | :example-caption: Eksempel 8 | :figure-caption: Figur 9 | :important-caption: Viktig 10 | :last-update-label: Sist oppdatert 11 | ifdef::listing-caption[:listing-caption: Programkode] 12 | ifdef::manname-title[:manname-title: Namn] 13 | :note-caption: Merk 14 | //:part-refsig: ??? 15 | ifdef::preface-title[:preface-title: Forord] 16 | //:section-refsig: ??? 17 | :table-caption: Tabell 18 | :tip-caption: Tips 19 | :toc-title: Innhald 20 | :untitled-label: Namnlaus 21 | :version-label: Versjon 22 | :warning-caption: Åtvaring 23 | -------------------------------------------------------------------------------- /locale/attributes-pl.adoc: -------------------------------------------------------------------------------- 1 | // Polish translation, courtesy of Łukasz Dziedziul <l.dziedziul@gmail.com> 2 | :appendix-caption: Dodatek 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Uwaga 5 | :chapter-label: Rozdział 6 | :chapter-refsig: {chapter-label} 7 | :example-caption: Przykład 8 | :figure-caption: Rysunek 9 | :important-caption: Ważne 10 | :last-update-label: Ostatnio zmodyfikowany 11 | //ifdef::listing-caption[:listing-caption: ???] 12 | ifdef::manname-title[:manname-title: Nazwa] 13 | :note-caption: Notka 14 | //:part-refsig: ??? 15 | //ifdef::preface-title[:preface-title: ???] 16 | //:section-refsig: ??? 17 | :table-caption: Tabela 18 | :tip-caption: Sugestia 19 | :toc-title: Spis treści 20 | :untitled-label: Bez tytułu 21 | :version-label: Wersja 22 | :warning-caption: Ostrzeżenie 23 | -------------------------------------------------------------------------------- /locale/attributes-pt.adoc: -------------------------------------------------------------------------------- 1 | // Portuguese translation, courtesy of Roberto Cortez <radcortez@yahoo.com> 2 | :appendix-caption: Apêndice 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Atenção 5 | //:chapter-label: ??? 6 | //:chapter-refsig: {chapter-label} 7 | :example-caption: Exemplo 8 | :figure-caption: Figura 9 | :important-caption: Importante 10 | :last-update-label: Última actualização 11 | ifdef::listing-caption[:listing-caption: Listagem] 12 | ifdef::manname-title[:manname-title: Nome] 13 | :note-caption: Nota 14 | //:part-refsig: ??? 15 | ifdef::preface-title[:preface-title: Prefácio] 16 | //:section-refsig: ??? 17 | :table-caption: Tabela 18 | :tip-caption: Sugestão 19 | :toc-title: Índice 20 | :untitled-label: Sem título 21 | :version-label: Versão 22 | :warning-caption: Aviso 23 | -------------------------------------------------------------------------------- /locale/attributes-pt_BR.adoc: -------------------------------------------------------------------------------- 1 | // Brazilian Portuguese translation, courtesy of Rafael Pestano <rmpestano@gmail.com> 2 | :appendix-caption: Apêndice 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Cuidado 5 | //:chapter-label: ??? 6 | //:chapter-refsig: {chapter-label} 7 | :example-caption: Exemplo 8 | :figure-caption: Figura 9 | :important-caption: Importante 10 | :last-update-label: Última atualização 11 | ifdef::listing-caption[:listing-caption: Listagem] 12 | ifdef::manname-title[:manname-title: Nome] 13 | :note-caption: Nota 14 | //:part-refsig: ??? 15 | ifdef::preface-title[:preface-title: Prefácio] 16 | //:section-refsig: ??? 17 | :table-caption: Tabela 18 | :tip-caption: Dica 19 | :toc-title: Índice 20 | :untitled-label: Sem título 21 | :version-label: Versão 22 | :warning-caption: Aviso 23 | -------------------------------------------------------------------------------- /locale/attributes-ro.adoc: -------------------------------------------------------------------------------- 1 | // Romanian translation, courtesy of Vitalie Lazu <vitalie.lazu@gmail.com> 2 | :appendix-caption: Apendix 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Precauție 5 | //:chapter-label: ??? 6 | //:chapter-refsig: {chapter-label} 7 | :example-caption: Exemplu 8 | :figure-caption: Figură 9 | :important-caption: Important 10 | :last-update-label: Ultima actualizare 11 | ifdef::listing-caption[:listing-caption: Listare] 12 | ifdef::manname-title[:manname-title: Nume] 13 | :note-caption: Notă 14 | //:part-refsig: ??? 15 | ifdef::preface-title[:preface-title: Prefață] 16 | //:section-refsig: ??? 17 | :table-caption: Tabela 18 | :tip-caption: Sfat 19 | :toc-title: Cuprins 20 | :untitled-label: Fără denumire 21 | :version-label: Versiunea 22 | :warning-caption: Atenție 23 | -------------------------------------------------------------------------------- /locale/attributes-ru.adoc: -------------------------------------------------------------------------------- 1 | // Russian translation, courtesy of Alexander Zobkov <alexander.zobkov@gmail.com> 2 | :appendix-caption: Приложение 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Внимание 5 | :chapter-label: Глава 6 | :chapter-refsig: {chapter-label} 7 | :example-caption: Пример 8 | :figure-caption: Рисунок 9 | :important-caption: Важно 10 | :last-update-label: Последнее обновление 11 | ifdef::listing-caption[:listing-caption: Листинг] 12 | ifdef::manname-title[:manname-title: Название] 13 | :note-caption: Примечание 14 | :part-label: Часть 15 | :part-refsig: {part-label} 16 | ifdef::preface-title[:preface-title: Предисловие] 17 | :section-refsig: Раздел 18 | :table-caption: Таблица 19 | :tip-caption: Подсказка 20 | :toc-title: Содержание 21 | :untitled-label: Без названия 22 | :version-label: Версия 23 | :warning-caption: Предупреждение 24 | -------------------------------------------------------------------------------- /locale/attributes-sr.adoc: -------------------------------------------------------------------------------- 1 | // Serbian Cyrillic translation, courtesy of Bojan Stipic <bojan-7@live.com> 2 | :appendix-caption: Додатак 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Опрез 5 | :chapter-label: Поглавље 6 | :chapter-refsig: {chapter-label} 7 | :example-caption: Пример 8 | :figure-caption: Слика 9 | :important-caption: Важно 10 | :last-update-label: Последње ажурирано 11 | ifdef::listing-caption[:listing-caption: Листинг] 12 | ifdef::manname-title[:manname-title: Назив] 13 | :note-caption: Белешка 14 | :part-label: Део 15 | :part-refsig: {part-label} 16 | ifdef::preface-title[:preface-title: Предговор] 17 | :section-refsig: Секција 18 | :table-caption: Табела 19 | :tip-caption: Савет 20 | :toc-title: Садржај 21 | :untitled-label: Без назива 22 | :version-label: Верзија 23 | :warning-caption: Упозорење 24 | -------------------------------------------------------------------------------- /locale/attributes-sr_Latn.adoc: -------------------------------------------------------------------------------- 1 | // Serbian Latin translation, courtesy of Bojan Stipic <bojan-7@live.com> 2 | :appendix-caption: Dodatak 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Oprez 5 | :chapter-label: Poglavlje 6 | :chapter-refsig: {chapter-label} 7 | :example-caption: Primer 8 | :figure-caption: Slika 9 | :important-caption: Važno 10 | :last-update-label: Poslednje ažurirano 11 | ifdef::listing-caption[:listing-caption: Listing] 12 | ifdef::manname-title[:manname-title: Naziv] 13 | :note-caption: Beleška 14 | :part-label: Deo 15 | :part-refsig: {part-label} 16 | ifdef::preface-title[:preface-title: Predgovor] 17 | :section-refsig: Sekcija 18 | :table-caption: Tabela 19 | :tip-caption: Savet 20 | :toc-title: Sadržaj 21 | :untitled-label: Bez naziva 22 | :version-label: Verzija 23 | :warning-caption: Upozorenje 24 | -------------------------------------------------------------------------------- /locale/attributes-sv.adoc: -------------------------------------------------------------------------------- 1 | // Swedish translation, Jonas Björk <jonas.bjork@gmail.com> 2 | :appendix-caption: Bilaga 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Var uppmärksam 5 | :chapter-label: Kapitel 6 | :chapter-refsig: {chapter-label} 7 | :example-caption: Exempel 8 | :figure-caption: Figur 9 | :important-caption: Viktigt 10 | :last-update-label: Senast uppdaterad 11 | ifdef::listing-caption[:listing-caption: Lista] 12 | ifdef::manname-title[:manname-title: Namn] 13 | :note-caption: Notera 14 | :part-label: Del 15 | :part-refsig: {part-label} 16 | ifdef::preface-title[:preface-title: Förord] 17 | :section-refsig: Avsnitt 18 | :table-caption: Tabell 19 | :tip-caption: Tips 20 | :toc-title: Innehållsförteckning 21 | :untitled-label: Odöpt 22 | :version-label: Version 23 | :warning-caption: Varning 24 | -------------------------------------------------------------------------------- /locale/attributes-tr.adoc: -------------------------------------------------------------------------------- 1 | // Turkish translation, courtesy of Rahman Usta <rahman.usta.88@gmail.com> 2 | :appendix-caption: Ek bölüm 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Dikkat 5 | //:chapter-label: ??? 6 | //:chapter-refsig: {chapter-label} 7 | :example-caption: Örnek 8 | :figure-caption: Görsel 9 | :important-caption: Önemli 10 | :last-update-label: Son güncelleme 11 | ifdef::listing-caption[:listing-caption: Listeleme] 12 | ifdef::manname-title[:manname-title: İsim] 13 | :note-caption: Not 14 | //:part-refsig: ??? 15 | ifdef::preface-title[:preface-title: Ön söz] 16 | //:section-refsig: ??? 17 | :table-caption: Tablo 18 | :tip-caption: İpucu 19 | :toc-title: İçindekiler 20 | :untitled-label: İsimsiz 21 | :version-label: Versiyon 22 | :warning-caption: Uyarı 23 | -------------------------------------------------------------------------------- /locale/attributes-uk.adoc: -------------------------------------------------------------------------------- 1 | // Ukrainian translation, courtesy of Kyrylo Yatsenko <hedrok@gmail.com> 2 | :appendix-caption: Додаток 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: Обережно 5 | :chapter-label: Розділ 6 | :chapter-refsig: {chapter-label} 7 | :example-caption: Приклад 8 | :figure-caption: Рисунок 9 | :important-caption: Важливо 10 | :last-update-label: Востаннє оновлено 11 | ifdef::listing-caption[:listing-caption: Лістинг] 12 | ifdef::manname-title[:manname-title: Назва] 13 | :note-caption: Зауваження 14 | :part-label: Частина 15 | :part-refsig: {part-label} 16 | ifdef::preface-title[:preface-title: Передмова] 17 | :section-refsig: Підрозділ 18 | :table-caption: Таблиця 19 | :tip-caption: Підказка 20 | :toc-title: Зміст 21 | :untitled-label: Без назви 22 | :version-label: Версія 23 | :warning-caption: Попередження 24 | -------------------------------------------------------------------------------- /locale/attributes-zh_CN.adoc: -------------------------------------------------------------------------------- 1 | // Simplified Chinese translation, courtesy of John Dong <dongwqs@gmail.com> 2 | :appendix-caption: 附录 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: 注意 5 | //:chapter-label: ??? 6 | //:chapter-refsig: {chapter-label} 7 | :example-caption: 示例 8 | :figure-caption: 图表 9 | :important-caption: 重要 10 | :last-update-label: 最后更新 11 | ifdef::listing-caption[:listing-caption: 列表] 12 | ifdef::manname-title[:manname-title: 名称] 13 | :note-caption: 笔记 14 | //:part-refsig: ??? 15 | ifdef::preface-title[:preface-title: 序言] 16 | //:section-refsig: ??? 17 | :table-caption: 表格 18 | :tip-caption: 提示 19 | :toc-title: 目录 20 | :untitled-label: 暂无标题 21 | :version-label: 版本 22 | :warning-caption: 警告 23 | -------------------------------------------------------------------------------- /locale/attributes-zh_TW.adoc: -------------------------------------------------------------------------------- 1 | // Traditional Chinese translation, courtesy of John Dong <dongwqs@gmail.com> 2 | :appendix-caption: 附錄 3 | :appendix-refsig: {appendix-caption} 4 | :caution-caption: 注意 5 | //:chapter-label: ??? 6 | //:chapter-refsig: {chapter-label} 7 | :example-caption: 示例 8 | :figure-caption: 圖表 9 | :important-caption: 重要 10 | :last-update-label: 最後更新 11 | ifdef::listing-caption[:listing-caption: 列表] 12 | ifdef::manname-title[:manname-title: 名稱] 13 | :note-caption: 筆記 14 | //:part-refsig: ??? 15 | ifdef::preface-title[:preface-title: 序言] 16 | //:section-refsig: ??? 17 | :table-caption: 表格 18 | :tip-caption: 提示 19 | :toc-title: 目錄 20 | :untitled-label: 暫無標題 21 | :version-label: 版本 22 | :warning-caption: 警告 23 | -------------------------------------------------------------------------------- /locale/attributes.adoc: -------------------------------------------------------------------------------- 1 | // This directory provides translations for all built-in attributes in Asciidoctor that emit translatable strings. 2 | // See http://asciidoctor.org/docs/user-manual/#customizing-labels to learn how to apply this file. 3 | // 4 | // If you're introducing a new translation, create a file named attributes-<iana-subtag>.adoc, where <iana-subtag> is the IANA subtag for the language. 5 | // Next, assign a translation for each attribute, using attributes-en.adoc as a reference. 6 | // 7 | // IMPORTANT: Do not include any blank lines in the transation file. 8 | // 9 | // NOTE: Please wrap the listing-caption and preface-title entries in a preprocessor conditional directive. 10 | // These attributes should only be updated if set explicitly by the user. 11 | ifdef::lang[include::attributes-{lang}.adoc[]] 12 | -------------------------------------------------------------------------------- /modern_pascal_introduction_chinese.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/modern-pascal/modern-pascal-introduction/d49abd1a87a3c9354c1fb4271cdb9c0b864e2df1/modern_pascal_introduction_chinese.pdf -------------------------------------------------------------------------------- /patreon-link-insert.dpr: -------------------------------------------------------------------------------- 1 | { Simple program to insert a Patreon link into modern_pascal_introduction.html . 2 | Inserts a snippet of CSS and HTML code into the given document. 3 | 4 | Copyright Michalis Kamburelis 2018-2018. 5 | 6 | License: Permissive Apache 2.0 license. 7 | See https://www.apache.org/licenses/LICENSE-2.0 . 8 | Feel free to modify and reuse. 9 | } 10 | 11 | {$ifdef FPC} {$mode objfpc}{$H+}{$J-} {$endif} 12 | {$ifdef MSWINDOWS} {$apptype CONSOLE} {$endif} 13 | 14 | uses SysUtils, Classes; 15 | 16 | { Read file contents into a String. } 17 | function FileToString(const FileName: String): String; 18 | var 19 | F: TFileStream; 20 | begin 21 | F := TFileStream.Create(FileName, fmOpenRead); 22 | try 23 | // TFileStream on a simple file has always known Size 24 | SetLength(Result, F.Size); 25 | if F.Size <> 0 then 26 | F.ReadBuffer(Result[1], Length(Result)); 27 | finally FreeAndNil(F) end; 28 | end; 29 | 30 | { Set file contents from a String. Overrides previous file, if any. } 31 | procedure StringToFile(const FileName, Contents: string); 32 | var 33 | F: TStream; 34 | begin 35 | F := TFileStream.Create(FileName, fmCreate); 36 | try 37 | if Length(Contents) <> 0 then 38 | F.WriteBuffer(Contents[1], Length(Contents)); 39 | finally FreeAndNil(F) end; 40 | end; 41 | 42 | { Find the 1st occurrence of Search inside the Contents, 43 | and insert Insertion right before it. } 44 | function InsertBefore(const Contents, Search, Insertion: String): String; 45 | var 46 | P: Integer; 47 | begin 48 | P := Pos(Search, Contents); 49 | if P = 0 then 50 | raise Exception.CreateFmt('Substring "%s" not found in "%s"', [Search, Contents]); 51 | Result := Contents; 52 | Insert(Insertion, Result, P); 53 | end; 54 | 55 | var 56 | Contents: String; 57 | begin 58 | if ParamCount <> 1 then 59 | raise Exception.Create('Provide exactly 1 parameter, the HTML filename to process'); 60 | 61 | Contents := FileToString(ParamStr(1)); 62 | Contents := InsertBefore(Contents, '</head>', 63 | '<style>' + FileToString('patreon-link.css') + '</style>'); 64 | Contents := InsertBefore(Contents, '<div id="toc" class="toc2">', 65 | FileToString('patreon-link.html')); 66 | StringToFile(ParamStr(1), Contents); 67 | end. 68 | -------------------------------------------------------------------------------- /patreon-link.css: -------------------------------------------------------------------------------- 1 | .patreon-link { 2 | font-family: "Helvetica Neue",Helvetica,Arial,sans-serif; 3 | font-size: 14px; 4 | line-height: 35px; 5 | padding-bottom: 10px; 6 | padding-left: 15px; 7 | padding-right: 15px; 8 | padding-top: 10px; 9 | text-decoration: none; 10 | text-align: left; 11 | float: right; 12 | } 13 | /* 14 | a.patreon-link:hover, 15 | a.patreon-link:focus { 16 | color: black; 17 | background: #EEE; 18 | } 19 | */ 20 | -------------------------------------------------------------------------------- /patreon-link.html: -------------------------------------------------------------------------------- 1 | <a href="https://patreon.com/castleengine" class="navbar-link patreon-link" style="display: inline-block; background-color: #FF424D; border-radius: 0; text-align: center;"> 2 | <div style="color: #ffffff; padding-left: 1em; padding-right: 1em;"> 3 | <span style="vertical-align: middle;">Support us on</span> <img src="patreon-wordmark.png" alt="Patreon Wordmark" style="display: inline-block; vertical-align: middle;" width="80" height="16"> 4 | </div> 5 | </a> 6 | -------------------------------------------------------------------------------- /patreon-wordmark.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/modern-pascal/modern-pascal-introduction/d49abd1a87a3c9354c1fb4271cdb9c0b864e2df1/patreon-wordmark.png --------------------------------------------------------------------------------