⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 gentypedlists1.pas

📁 Delphi, typed list generator code snippled, wonderfull delphi sample code
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{+------------------------------------------------------------
 | Unit GenTypedLists1
 |
 | Version: 1.0  Created: 03.06.99
 |               Last Modified: 03.06.99
 | Author : P. Below
 | Project: Typed lists generator
 | Description:
 |   The typed list generator creates a unit for a list class
 |   from a template and user-supplied information. The default
 |   template is embedded at design-time into the UnitTemplate
 |   container but it can be overridden by specifying a file
 |   on the command line. The default template is typelist_template.pas.
 |   The template contains a number of placeholder strings (called
 |   macros in the source) which have the form <!MACRONAME>. Note
 |   that the macro names are case-sensitive and that no whitespace
 |   is allowed between the macro name and the <! and > delimiters!
 |   To generate the target unit the code scans the template text
 |   for these macro strings and replaces them with other strings.
 |   A number of macros are build-in (see BuildMacroLists method),
 |   the others are listed in a grid for the user to supply values
 |   for.
 |   The generator can create typed lists for practically any type.
 |   The user has to specify a couple of things so the correct code
 |   in the template is activated. The template code uses conditional
 |   compilation for this, the generator replaces the <!DEFINES>
 |   macro with a list of $DEFINE compiler directives depending on
 |   the state of the three checkboxes on the form. The $DEFINEs
 |   are:
 |     GTL_OWNSOBJECTS: the list contains objects and owns them.
 |                      It will free the objects when the list
 |                      is cleared, freed, or individual items are
 |                      deleted or overwritten.
 |     GTL_USEPOINTERS: the list contains records or other data
 |                      types larger than 4 bytes. The list will
 |                      allocate memory for each item from the
 |                      heap and free this memory when the list
 |                      is cleared, freed, or individual items are
 |                      deleted or overwritten.
 |
 |   If none of these two directives is specified then the list
 |   is supposed to contain any 4 byte (or smaller) datatype, if
 |   this is a class type then the list does not own the objects
 |   and will do nothing to free objects in the situations listed
 |   above. It acts like TList in this configuration.
 |
 |     GTL_USECOMPAREPROC: Activates a template for a item
 |                         comparison function. This template
 |                         must be customized for the data type
 |                         the list is to store! A comparison
 |                         function is needed to Sort the list
 |                         and find items in it.
 | External dependencies:
 |   Custom components:
 |     The generator form uses two custom components: TExPanel
 |     (in expanel.pas) and TTextContainer (in textcontainer.pas).
 |     These two controls need to be installed into the component
 |     palette before the generator form can be opened in the IDE.
 |   Units:
   |   The generated unit depends on the abstracttypedlist.pas
 |     unit that contains the base class of all typed list classes.
 +------------------------------------------------------------}
unit GenTypedLists1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
    Dialogs,
  Grids, Expanel, StdCtrls, ExtCtrls, Textcontainer;

type
  TTypedListgeneratorMainform = class(TForm)
    UnitTemplate: TTextContainer;
    Panel1: TPanel;
    GenerateButton: TButton;
    CloseButton: TButton;
    Panel2: TPanel;
    OwnsObjectCheckbox: TCheckBox;
    ExPanel1: TExPanel;
    MacroGrid: TStringGrid;
    UsePointersCheckbox: TCheckBox;
    makeCompareProcCheckbox: TCheckBox;
    HelpButton: TButton;
    procedure FormCreate(Sender: TObject);
    procedure CloseButtonClick(Sender: TObject);
    procedure GenerateButtonClick(Sender: TObject);
    procedure ExPanel1Resize(Sender: TObject);
    procedure MacroGridDrawCell(Sender: TObject; aCol, aRow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure UsePointersCheckboxClick(Sender: TObject);
    procedure OwnsObjectCheckboxClick(Sender: TObject);
    procedure HelpButtonClick(Sender: TObject);
  private
    { Private declarations }
    FKnownMacros: TStringlist;
    FUnknownMacros: TStringlist;

    procedure BuildMacroLists;
    procedure SizeGrid;
    procedure BuildUnit(const unitfilename: string);
    function Macro(const macroname: string): string;
    procedure EvaluateCommandline;
    procedure VerifyMacroInput;
  public
    { Public declarations }
  end;

var
  TypedListgeneratorMainform: TTypedListgeneratorMainform;

implementation

uses FileCtrl;
{$R *.DFM}

const
  cDefaultUnitDirectory = 'D:\Daten\Projects\D32';

resourcestring
  cOverwritePrompt =
    'File %s exists. OK to overwrite?';
  cOneEmptyMacro =
    'Macro %s is undefined. Proceed anyway?';
  cSeveralEmptyMacros =
    'Macros %s are undefined. Proceed anyway?';

  eUnterminatedMacro =
    'Macro delimiter ">" not found in line %s.';
  eUnknownMacro =
    'Unknown macro %s encountered!';
  eFileNotFound =
    'Specified template file %s not found, will use default template.';
  eUnitnameRequired =
    'The UNITNAME cannot be empty.';

type
  TMacroProc = function: string;
  EMacroError = class(Exception);

{+============================================================
 | Section 1: Auxillary functions
 +============================================================}

{+------------------------------------------------------------
 | Function IScan
 |
 | Parameters :
 |  ch: Character to scan for
 |  S : String to scan
 |  fromPos: first character to scan
 | Returns    :
 |  position of next occurence of character ch, or 0, if none
 |  found
 | Description:
 |  Search for next occurence of a character in a string.
 | Error Conditions: none
 | Created: 27.11.96 by P. Below
 +------------------------------------------------------------}
function IScan(ch: Char; const S: string; fromPos: Integer): Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := fromPos to Length(S) do begin
    if S[i] = ch then begin
      Result := i;
      Break;
    end; { If }
  end; { For }
end; { IScan }

{ Note: the build-in macros are implemented by value functions
  that return the macros value when called. This is the
  best way to do it since the value of these macros is
  not known at compile-time, with the exception of VERSION.
  The value functions must be of type TMacroProc.  The following
  three functions serve as value functions for the three build-in
  macros. }

{ Returns the string for the VERSION macro. }

function MacroVersion: string;
begin
  Result := '1.0';
end; { MacroVersion }

{ Returns the string for the DATE macro. }

function MacroDate: string;
begin
  Result := DateToStr(Date);
end; { MacroData }

{ Returns the string for the DEFINES macro. The $DEFINE directives
  are assembled according to the state of the three checkboxes on
  the main form.}

function MacroDefines: string;

  procedure Add(var R: string; const S: string);
  const
    CRLF = #13#10;
  begin
    if Length(R) > 0 then
      R := R + CRLF;
    R := R + S;
  end; { Add }

begin
  Result := EmptyStr;
  if TypedListgeneratorMainform.OwnsObjectCheckbox.Checked then
    Add(Result, '{$DEFINE GTL_OWNSOBJECTS}');

  if TypedListgeneratorMainform.UsePointersCheckbox.Checked then
    Add(Result, '{$DEFINE GTL_USEPOINTERS}');

  if TypedListgeneratorMainform.makeCompareProcCheckbox.Checked then
    Add(Result, '{$DEFINE GTL_USECOMPAREPROC}');
end; { MacroDefines }

{+============================================================
 | Section 2: Methods of TTypedListgeneratorMainform.
 |    Part 1. Form event handlers, Constructors and Destructors
 +============================================================}

{+------------------------------------------------------------
 | Procedure TTypedListgeneratorMainform.FormCreate
 |
 | Event      : OnCreate
 | Used by    : the form
 | Call method: static
 | Visibility : published
 | Description:
 |   Creates the two stringlist objects used to hold macro names,
 |   evaluates a command line, if present, fills the macro lists,
 |   and sizes the columns in the input grid. If we have a
 |   helpfile in the apps directory it is assigned to the
 |   Application.Helpfile property.
 | Error Conditions: none
 | Created: 03.06.99 by P. Below
 +------------------------------------------------------------}
procedure TTypedListgeneratorMainform.FormCreate(Sender: TObject);
var
  filename: string;
begin

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -