Chip 2001 October/Chip_2001-10_cd1.bin/zkuste/delphi/kolekce/d456/DCSLIB25.ZIP/DCData.pas

Pascal/Delphi Source File | 2001-04-02 | 6KB | 208 lines

{
 BUSINESS CONSULTING
 s a i n t - p e t e r s b u r g

         Components Library for Borland Delphi 4.x, 5.x
         Copyright (c) 1998-2001 Alex'EM

}
unit DCData;

interface
uses
  Windows, SysUtils, DCConst, DCEditTools;

const
  RDATA_SUCCESS      = $0000;
  RDATA_RANGEERROR   = $F001;
  RDATA_INVALIDVALUE = $F002;

type
  TEditOptions = set of TEditOption;
  TRecordCode  = PChar;
  DResult      = DWORD;

  TRecordItemData = packed record
    Flags: WORD;
    case DataType: TPackedDataType of
      daInteger: (Value: integer);
      daFloat  : (Data : Double);
      daString : (Text : PChar);
  end;

  PRecordDataItems = ^TRecordDataItems;
  TRecordDataItems = packed array[0..0] of TRecordItemData;

  PRecordData_tag = ^TRecordData;
  TRecordData = packed record
    Code : TRecordCode;
    State: TRecordState;
    Count: WORD;
    Data : TRecordDataItems;
  end;

// ╠σ≥εΣ√ ≡αßε≥√ ± RecordData
function RDCreate(ACount: integer): PRecordData_tag;
function RDFree(AData: PRecordData_tag): DResult;
function RDSetValue(var AData: PRecordData_tag; AIndex: integer;
  ADataType: TPackedDataType; AValue: string): DResult;
function RDSetCode(var AData: PRecordData_tag; ACode: TRecordCode; ALength: integer): DResult;
function RDSetState(var AData: PRecordData_tag; AState: TRecordState): DResult;
function RDGetValue(AData: PRecordData_tag; AIndex: integer): string;
function RDGetCode(AData: PRecordData_tag): TRecordCode;
function RDGetState(AData: PRecordData_tag): TRecordState;

// ╠σ≥εΣ√ ≡αßε≥√ ± RecordItemData
function DISetValue(var AItemData: TRecordItemData; ADataType: TPackedDataType;
  AValue: string): DResult;
function DISetFlag(var AItemData: TRecordItemData; AFlag: integer; AClear: boolean = False): DResult;
function DIGetValue(AItemData: TRecordItemData): string;
function DIGetFlag(AItemData: TRecordItemData; AFlag: integer): integer;

implementation

function RDCreate(ACount: integer): PRecordData_tag;
 var
  ASize, i: integer;
begin
  ASize := SizeOf(TRecordData)+SizeOf(TRecordItemData)*ACount;

  GetMem(Result, ASize);
  FillChar(Result^, ASize, 0);

  Result.Count := ACount;
  GetMem(Result.Code, 1); StrCopy(Result.Code, '');

  for i := 0 to ACount - 1 do Result.Data[i].Text := nil;
end;

function RDFree(AData: PRecordData_tag): DResult;
 var
  i, ASize: integer;
  DataItem: TRecordItemData;
begin
  Result := RDATA_SUCCESS;

  if AData = nil then Exit;

  ASize  := SizeOf(TRecordData)+SizeOf(TRecordItemData)*AData.Count;

  for i := 0 to AData.Count - 1 do
  begin
    DataItem := AData.Data[i];
    if (DataItem.DataType = daString) and Assigned(DataItem.Text) then
      FreeMem(DataItem.Text, StrLen(DataItem.Text));
  end;

  ReallocMem(AData.Code, 0);
  FreeMem(AData, ASize);
end;

function RDSetValue(var AData: PRecordData_tag; AIndex: integer;
  ADataType: TPackedDataType; AValue: string): DResult;
begin
  if AIndex > AData.Count-1 then
  begin
    Result := RDATA_RANGEERROR;
    Exit;
  end;
  Result := DISetValue(AData.Data[AIndex], ADataType, AValue);
end;

function RDSetCode(var AData: PRecordData_tag; ACode: TRecordCode; ALength: integer): DResult;
begin
  Result := RDATA_SUCCESS;
  ReallocMem(AData.Code, SizeOf(Char)*(ALength+1));
  StrCopy(AData.Code, ACode);
end;

function RDSetState(var AData: PRecordData_tag; AState: TRecordState): DResult;
begin
  Result := RDATA_SUCCESS;
  AData.State := AState;
end;

function RDGetValue(AData: PRecordData_tag; AIndex: integer): string;
begin
  if AIndex > AData.Count-1 then
  begin
    Result := '';
    Exit;
  end;
  Result := DIGetValue(AData.Data[AIndex]);
end;

function RDGetCode(AData: PRecordData_tag): TRecordCode;
begin
  Result := AData.Code;
end;

function RDGetState(AData: PRecordData_tag): TRecordState;
begin
  Result := AData.State;
end;

function DISetValue(var AItemData: TRecordItemData; ADataType: TPackedDataType;
  AValue: string): DResult;
begin
  Result := RDATA_SUCCESS;
  if ADataType <> AItemData.DataType then
  begin
    if (AItemData.DataType = daString) and Assigned(AItemData.Text) then
    begin
      FreeMem(AItemData.Text, StrLen(AItemData.Text));
      AItemData.Text := nil;
    end;
  end;
  AItemData.DataType := ADataType;
  case ADataType of
    daInteger:
      if IsValidInteger(AValue) then
        AItemData.Value := StrToInt(AValue)
      else
        Result := RDATA_INVALIDVALUE;
    daFloat:
      if IsValidFloat(AValue) then
        AItemData.Data := StrToFloat(AValue)
      else
        Result := RDATA_INVALIDVALUE;
    daString:
      begin
        if Assigned(AItemData.Text) then
          ReallocMem(AItemData.Text, SizeOf(Char)*(Length(AValue)+1))
        else
          GetMem(AItemData.Text, SizeOf(Char)*(Length(AValue)+1));
        StrPCopy(AItemData.Text, AValue);
      end;
  end;
end;

function DISetFlag(var AItemData: TRecordItemData; AFlag: integer; AClear: boolean = False): DResult;
begin
  Result := RDATA_SUCCESS;
  if AClear then
    AItemData.Flags := AItemData.Flags and (AFlag xor $FFFF)
  else
    AItemData.Flags := AItemData.Flags or AFlag;
end;

function DIGetValue(AItemData: TRecordItemData): string;
begin
  case AItemData.DataType of
    daInteger:
      Result := IntToStr(AItemData.Value);
    daFloat:
      Result := FloatToStr(AItemData.Data);
    daString:
      Result := AItemData.Text;
  end;
end;

function DIGetFlag(AItemData: TRecordItemData; AFlag: integer): integer;
begin
  Result := AItemData.Flags and AFlag;
end;


end.