Форум программистов [Powered by Invision Power Board]

Код


unit DTM_Structure;

interface
   uses
    System.Classes,System.SysUtils,Types,Vcl.Graphics;

 const
  TDTMPointSize = 5*SizeOf(integer)+Sizeof(boolean);
 type
  TDTMPoint = class
   private
    Fx: Integer;
    FY: Integer;
    FColor: Integer;
    FTolerance: integer;
    FAreaSize: integer;
    FBp: boolean;
    public
     procedure Reset;
     constructor Create;
     procedure DrawToCanvas(Render: TCanvas;aColor,Width,Height: integer);
     property x: Integer read Fx write Fx;
     property y: Integer read FY write FY;
     property Color: Integer read FColor write FColor;
     property Tolerance: Integer read FTolerance write FTolerance;
     property AreaSize: integer read FAreaSize write FAreaSize;
     property Bp: boolean read FBp write FBp;
  end;

  TDTMPointList = class
  private
    FDTMPoints: TList;
    function GetCount: Integer;
    function GetDTMPoint(Index: Integer): TDTMPoint;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure Assign(Src: TDTMPointList);
    procedure Add(aDTMPoint: TDTMPoint); overload;
    procedure Add(aDTMPoints: TDTMPointList); overload;
    procedure Delete(Index: Integer); overload;
    procedure Delete(aDTMPoint: TDTMPoint); overload;
    function IndexOf(aDTMPoint: TDTMPoint): Integer;

    property Count: Integer read GetCount;
    property DTMPoint[Index: Integer]: TDTMPoint read GetDTMPoint; default;
  end;

****
  { TDTMPoint }

constructor TDTMPoint.Create;
begin
 inherited;
 Reset;
end;

procedure TDTMPoint.DrawToCanvas(Render: TCanvas;AColor,Width,Height: integer);
var
  rx, ry, z, w, h: Integer;
begin
 z := Max(AreaSize shr 1, 1);
 w := Width;
 h := Height;
  for rx := -z to z do
    for ry := -z to z do
      if (x + rx >= 0) and (x + rx < w) and (y + ry >= 0) and (y + ry < h) then
          Render.Pixels[x + rx , y + ry ] := AColor;
     // render.Picture.Assign(bmpBuffer);
end;

procedure TDTMPoint.Reset;
begin
 x:=0;
 y:=0;
 Color:=0;
 Tolerance:=0;
 AreaSize:=0;
 BP:=false;
end;

constructor TDTMPointList.Create;
begin
  FDTMPoints := TList.Create;
end;

destructor TDTMPointList.Destroy;
begin
  Clear;
  FDTMPoints.Free;
  inherited;
end;

procedure TDTMPointList.Delete(Index: Integer);
begin
  if (Index < 0) or (Index >= Count) then
    raise Exception.Create(ErrItemNotFound);

  DTMPoint[Index].Free;
  FDTMPoints.Delete(Index);
end;

procedure TDTMPointList.Delete(aDTMPoint: TDTMPoint);
begin
  Delete(IndexOf(aDTMPoint));
end;

procedure TDTMPointList.Add(aDTMPoints: TDTMPointList);
var
  I: Integer;
begin
  for I := 0 to aDTMPoints.Count - 1 do
    Add(aDTMPoints[I]);
end;

procedure TDTMPointList.Add(aDTMPoint: TDTMPoint);
begin
  FDTMPoints.Add(aDTMPoint);
end;

procedure TDTMPointList.Assign(Src: TDTMPointList);
begin
  Clear;
  Add(Src);
end;

procedure TDTMPointList.Clear;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    DTMPoint[I].Free;
  FDTMPoints.Clear;
end;


function TDTMPointList.GetCount: Integer;
begin
  Result := FDTMPoints.Count;
end;

function TDTMPointList.GetDTMPoint(Index: Integer): TDTMPoint;
begin
  if (Index >= 0) and (Index < Count) then
    Result := TDTMPoint(FDTMPoints[Index])
  else
    Result := nil;
end;

function TDTMPointList.IndexOf(aDTMPoint: TDTMPoint): Integer;
begin
  Result := FDTMPoints.IndexOf(aDTMPoint);
end;

Код


TAbstractFile = class
   private
      FName: string;
      FSize: integer;
      FOffset: Integer;

    public
      Constructor Create;
      procedure Reset;virtual;abstract;
      property Name: string read Fname write FName;
      property Size: Integer read FSize write FSize;
      property Offset: integer read FOffset write FOffset;
  end;
****
TAbstractFileList = class
  private
    FAbstractFiles: TList;
    function GetCount: Integer;
    function GetAbstractFile(Index: Integer): TAbstractFile;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure Assign(Src: TAbstractFileList);
    procedure Add(aAbstractFile: TAbstractFile); overload;
    procedure Add(aAbstractFiles: TAbstractFileList); overload;
    procedure Delete(Index: Integer); overload;
    procedure Delete(aAbstractFile: TAbstractFile); overload;
    function IndexOf(aAbstractFile: TAbstractFile): Integer;

    property Count: Integer read GetCount;
    property AbstractFile[Index: Integer]: TAbstractFile read GetAbstractFile; default;
  end;