Traduire une dll delphi5 en vb6

hcadieu Messages postés 16 Date d'inscription mardi 28 septembre 2004 Statut Membre Dernière intervention 1 mai 2012 - 23 mai 2006 à 11:27
hcadieu Messages postés 16 Date d'inscription mardi 28 septembre 2004 Statut Membre Dernière intervention 1 mai 2012 - 17 juil. 2006 à 10:44
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;

3 réponses

Utilisateur anonyme
12 juil. 2006 à 17:02
Je te conseil d'être plus précis dans ce que tu veut traduire, je suis sure que tu peut en faire au moins la moitié;

Nous donner tout ca en bloc, ca fait beaucoup du coup!
Dis moi ce que tu connais pas,
0
Utilisateur anonyme
12 juil. 2006 à 17:16
Pour les classe, il faut déjà créer un module de classe, dans ajouter.
Pour l'interface, cest en haut de ce module que tu déclar tes vars.

Private Angle_rota As Double
Public compt_neg As Integer.
Const DIB_RGB_COLORS = 0

pour reservé, jsai pas.

Les types:

Type BITMAPINFOHEADER
        biSize As Long
        biWidth As Long
        biHeight As Long
        biPlanes As Integer
        biBitCount As Integer
        biCompression As Long
        biSizeImage As Long
        biXPelsPerMeter As Long
        biYPelsPerMeter As Long
        biClrUsed As Long
        biClrImportant As Long
End Type

Pour les méthodes, ta juste à les implémenté ds ce module:

Public Sub Trouver_Angle_rota()

     delta.x = Extr_haut.x
     delta.y = Extr_haut.y




rota.x = Pt_base.x - Extr_haut.x
rota.y = Pt_base.y - Extr_haut.y



If rota.x 0 Then rota.x 1




     Angle_rota = Atn(-(rota.y / rota.x))
End Sub
0
hcadieu Messages postés 16 Date d'inscription mardi 28 septembre 2004 Statut Membre Dernière intervention 1 mai 2012
17 juil. 2006 à 10:44
Merci beaucoup a toi, je suis pret a recompenser $$$ celui qui fera l'effort de traduire intégralement cette classe , es tu intéressé?
0
Rejoignez-nous