Ver Mensaje Individual
  #2  
Antiguo 30-01-2009
Avatar de sitrico
[sitrico] sitrico is offline
Miembro Premium
 
Registrado: may 2003
Ubicación: Caracas, Venezuela
Posts: 295
Reputación: 21
sitrico Va por buen camino
Listo ya esta solucionado

Código Delphi [-]
library ToolsProfit;

uses
  SysUtils,
  Classes,
  Forms;

{$R *.res}

{function MessageBoxStr(const Text, Caption: String; Flags: Longint = 0): Integer;
Var
bText,bCaption : PChar;
Begin
getMem(bText,Length(text)+1);
StrCopy(bText, PChar(text));
getMem(bCaption,Length(Caption)+1);
StrCopy(bCaption, PChar(Caption));
Result := Application.MessageBox(bText,bcaption,Flags);
FreeMem(bText);
FreeMem(bCaption);
End;
}

Procedure Informa(x : PChar); StdCall;
begin
With tForm.Create(nil) do
   Begin
   Try
      Caption := x;
      ShowModal;
   Finally
      free;
      End;
   End;
End;

// Utilitarios

function ExtraerSTRDelimitada(var s : String; Delimitador : String):String;

Begin
result := s;
If s = '' Then exit;
If Pos(Delimitador,s) <> 0 Then
   Result := copy(s,1,Pos(Delimitador,s)-1);
Delete(s,1,Pos(Delimitador,s));
End;

Function StrReplace(s:String;ChrAct,ChrNew:Char):String;
Var
p : Integer;
Begin
If ChrNew <> #0 then
   Begin
   Repeat
      p := Pos(ChrAct,s);
      If p <> 0 Then
         Begin
         Delete(s,p,1);
         Insert(ChrNew,s,p);
         End;
   Until p = 0;
   End
Else
   Begin
   While Pos(ChrAct,s) <> 0 do
      Delete(s,Pos(ChrAct,s),1);
   End;
Result := s;
End;

Function StrExpandR(s:String;lon:Integer):String;

Begin
s := Trim(s);
s := Copy(s,1,lon);
While Length(s) < lon do
   s := ' ' + s;
Result := s;
End;


Function fs(Num: Double;e,d:Integer;al:Boolean=False):String; Overload;
Var
s : String;
Begin
s := FloatToStrF(Num,ffNumber,E,d);
While (Length(s) > e) And (Pos('.',s) <> 0) do
   Delete(s,Pos('.',s),1);
If not al then
   s := StrExpandR(s,e);
Result := s;
End;

Function fs(Num: Double;al:Boolean=True):String; Overload;
Begin
Result := fs(Num,20,2);
End;


Function StrMontoGringo(c:Currency):Pchar;
Var
m : String;
begin
m := Trim(fs(c,15,4));
m := StrReplace(m,'.',#0);
Result := Pchar(Trim(StrReplace(m,',','.')));
end;

Procedure DecodeAux02(Aux02:Pchar; Var Piezas,Largo,Alto: Double; Var Ubicacion:Pchar); StdCall;
Var
s : ShortString;
Aux : String;
begin
//Informa(Aux02);
Aux := aux02;
Aux  := StrReplace(aux,'.',',');
Piezas := 0;
Largo := 0;
Alto := 0;
Ubicacion := '';
s := ExtraerSTRDelimitada(Aux,';');
If s <> '' Then
   Piezas := StrToFloat(s);
s := ExtraerSTRDelimitada(Aux,';');
If s <> '' Then
   Largo := StrToFloat(s);
s := ExtraerSTRDelimitada(Aux,';');
If s <> '' Then
   Alto := StrToFloat(s);
Ubicacion := AnsiStrUpper(Pchar(Aux));
end;

Function Redondeo(vouble): Double;
Const
Factor = 10000;
begin
Result := Trunc(v*Factor)/Factor;
End;

// Funciones ------------------

Function DecodePiezas(Aux02:Pchar): Double; StdCall;
 Var Piezas,Largo,Alto: Double;
 Var Ubicacion:Pchar;
Begin
DecodeAux02(Aux02,Piezas, Largo, Alto, Ubicacion);
Result := Piezas;
End;

Function DecodeLargo(Aux02:Pchar): Double; StdCall;
 Var Piezas,Largo,Altoouble;
 Var Ubicacion:Pchar;
Begin
DecodeAux02(Aux02,Piezas, Largo, Alto, Ubicacion);
Result := Largo;
End;

Function DecodeAlto(Aux02:Pchar): Double; StdCall;
 Var Piezas,Largo,Altoouble;
 Var Ubicacion:Pchar;
Begin
DecodeAux02(Aux02,Piezas, Largo, Alto, Ubicacion);
Result := Alto;
End;

Function DecodeUbicacion(Aux02:Pchar): PChar; StdCall;
 Var Piezas,Largo,Altoouble;
 Var Ubicacion:Pchar;
Begin
DecodeAux02(Aux02,Piezas, Largo, Alto, Ubicacion);
Result := Ubicacion;
End;

Function  EncodeAux02(var Piezas,Largo,Altoouble; Ubicacion:Pchar):Pchar;  StdCall;
Begin
Result := PChar(Trim(StrMontoGringo(Piezas)+';'+
                     StrMontoGringo(Largo)+';'+
                     StrMontoGringo(Alto)+';'+
                     AnsiStrUpper(Ubicacion)));
End;

Function StockEnFactores(Var Piezas,Largo,Altoouble)ouble;  StdCall;
begin
Result := Redondeo(Piezas*Largo*Alto);
End;

Function StockEnAux02(Aux02:PChar)ouble;  StdCall;
Var
Piezas,Largo,Altoouble;
Ubicacion:PChar;
begin
DecodeAux02(Aux02,Piezas,Largo,Alto,Ubicacion);
Result := StockEnFactores(Piezas,Largo,Alto);
End;



Exports
  DecodeAux02,
  DecodePiezas,
  DecodeLargo,
  DecodeAlto,
  DecodeUbicacion,
  EncodeAux02,
  StockEnFactores,
  StockEnAux02,
  Informa;

begin
end.
__________________
Sitrico
Responder Con Cita