Bonjour,
j'ai développé un algorithme en delphi 5 et j'ai besoin de le traduire en VB6, quelqu'un ici bas maitrise t-il ces deux languages pour m'aider ?
unit MBRawData;
//note: the way HasHeader works slows the system down by about 50%.
//should just be temporary though - once data is converted, HasHeader
//can be removed.
(*
class: TMBRawData
hervé Cadieu
Job Description
---------------
- To hold the entire raw data for a single sample.
- To give random access to each point in the sample
by means of an array-like structure.
- To allow the entire sample to be read and written in
a single operation
*)
interface
uses Common,
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TmbRawData = class(TMemoryStream)
private //none
protected
function GetCount:integer;
function GetHasHeader:boolean;
function GetHeader:TMBRawDataHeader;
function GetPoint(Index:Integer): TMBBasePoint;
function GetVersion:byte;
function GetDuration:integer;
procedure SetDuration(value:integer);
function GetPenID:longint;
procedure SetPenID(value:longint);
function GetPenType:longint;
procedure SetPenType(value:longint);
procedure SetHeader(header:TMBRawDataHeader);
public
procedure AddPoint(BasePoint:TMBBasePoint);
procedure Truncate(LastPoint:integer);
property Points[Index:integer]:TMBBasePoint read GetPoint; default;
property Count:integer read GetCount;
property HasHeader:boolean read GetHasHeader;
property PenID:longint read GetPenID write SetPenID;
property PenType:longint read GetPenType write SetPenType;
property Version:byte read GetVersion;
property Duration:integer read GetDuration write SetDuration;
end;
implementation
//AddPoint - adds a new BasePoint to the end of the RawData
procedure TMBRawData.AddPoint(BasePoint:TMBBasePoint);
procedure AddHeaderBlock;
var header:TMBRawDataHeader;
begin;
fillchar(header,SizeOf(header),0); //init to all zeros
header.HeaderID := RawDataHeaderID;
header.Version := LatestRawDataVersion;
SetHeader(header);
end;
begin;
if size=0 then AddHeaderBlock; //first point, so add header block
seek(0,soFromEnd); //make sure we are at the end of the stream
write(BasePoint,SizeOf(BasePoint)); //write new point to end
end;
function TMBRawData.GetCount:integer;
//GetCount - calcs the number of BasePoints for the Count property
var HeaderSize : integer;
begin;
//cope with samples that do or do not have header blocks
if HasHeader
then HeaderSize := SizeOf(TMBRawDataHeader)
else HeaderSize := 0;
result := (size-HeaderSize) div SizeOf(TMBBasePoint);
end;
function TMBRawData.GetDuration:integer;
//returns sample's duration
var header:TMBRawDataHeader;
begin;
header := GetHeader;
result := header.Duration;
end;
function TMBRawData.GetPenID:longint;
//returns pen ID for sample
var header:TMBRawDataHeader;
begin;
header := GetHeader;
result := header.PenID;
end;
procedure TMBRawData.SetPenID(value:longint);
//sets the sample's penID
var header:TMBRawDataHeader;
begin;
if not HasHeader then exit;
header := GetHeader;
header.PenID := value;
SetHeader(header);
end;
function TMBRawData.GetPenType:longint;
//returns pen type for sample
var header:TMBRawDataHeader;
begin;
header := GetHeader;
result := header.PenType;
end;
procedure TMBRawData.SetPenType(value:longint);
//sets the sample's pen type
var header:TMBRawDataHeader;
begin;
if not HasHeader then exit;
header := GetHeader;
header.PenType := value;
SetHeader(header);
end;
function TMBRawData.GetHasHeader:boolean;
//GetHasHeader - returns wether the sample contains header info.
//early versions did not contain header info:
// old version new version has header
// 1.0 1 no
// 1.1 2 no
// - 3 onwards yes
var Header:TMBRawDataHeader;
begin;
result := false;
if size<SizeOf(header) then exit;
position := 0;
read(header,sizeOf(header));
result := header.HeaderID = RawDataHeaderID;
end;
function TMBRawData.GetHeader:TMBRawDataHeader;
//returns the sample's header info
begin;
if not HasHeader then
begin;
FillChar(result,SizeOf(result),0); //blank header
exit;
end;
//there is a header
position := 0;
read(result,sizeOf(result));
end;
//GetPoint - gets a BasePoint from the RawData
function TMBRawData.GetPoint(Index: Integer): TMBBasePoint;
var p : ^byte;
HeaderSize : integer;
begin;