PureBoard

Code: Alles auswählen

; http://www.purebasic.fr/english/viewtopic.php?f=5&t=28544
;

EnableExplicit

ProcedureDLL.l IsPowerOf2(x.l)
  Protected t.l=0 
  If (x&(x-1))=0 
     t=1 
  EndIf                      
  ProcedureReturn t 
EndProcedure 

ProcedureDLL.l IsPowerOf(power.l, base.l) 
  Protected basePow.l 
  Protected count.l 

  If base < 0 Or power < 0 
    ProcedureReturn -1 
  EndIf 
  If base = 0 
    If power = 1 
      ProcedureReturn 0 
    Else 
      ProcedureReturn 1 
    EndIf 
  EndIf 
  If base = 1 
    If power = 1 
      ProcedureReturn 1 
    Else 
      ProcedureReturn -1 
    EndIf 
  EndIf 
  If power = 1 
    ProcedureReturn 0 
  EndIf 

  basePow = base 
  While $7FFFFFFF / basePow > 1 
    count+1 
    If basePow = power 
      ProcedureReturn count 
    EndIf 
    basePow * base 
  Wend 
  ProcedureReturn -1 
EndProcedure 

Global ReturnString.s = ""
ProcedureDLL.s Round2n(n.f,places.l) 
    If places < 0 : places = 0 : EndIf 
    Protected r.f = 0.5 * Pow(10,-1*places) : Protected T.f = Pow(10,places) 
        
    ReturnString = StrF(Int((n+r)*T)/T,places)
    ProcedureReturn ReturnString
EndProcedure

Debug IsPowerOf2(33)
Debug IsPowerOf(49,7)
Debug Round2n(3.1415927,4)

Code: Alles auswählen

EnableExplicit
; Import-File created by Lib2PBImport
; Libname: PBdll.lib
; created: 2009/12/16  12:25

Import "PBdll.lib"
  IsPowerOf2.l(a.l)     As "_IsPowerOf2@4"
  IsPowerOf.l(a.l,b.l)  As "_IsPowerOf@8"
  Round2n(a.l,b.l)      As "_Round2n@8"
EndImport


Define a.s =""
Define ReturnString1.s =""
Define ReturnString2.s =""

Debug "IsPowerOf2(33) = "         + Str(IsPowerOf2(33))
Debug "IsPowerOf(49,7) = "        + Str(IsPowerOf(49,7))
Debug "Round2n(3.1415927, 4) = "  + Str(Round2n(3.1415927,4))

a.s = PeekS(Round2n(3.1415927, 4))
Debug a

; Versuch mit CallFunction
If OpenLibrary(0, "PBdll.dll")
ReturnString1.s = PeekS(CallFunction(0,"Round2n",3.1415927, 4))

EndIf

Debug "ReturnString1 = " + ReturnString1

Debug "Islibrary = " + Str(IsLibrary(0))

CloseLibrary(0)

; Versuch mit Prototype
Prototype.s protoRound2n(n.f, places.l)

If OpenLibrary(0, "PBdll.dll")

Define rstring.protoRound2n = GetFunction(0, "Round2n")

ReturnString2.s = rstring(3.1415927, 4)

EndIf

Debug "ReturnString1 = " + ReturnString1
Debug "ReturnString2 = " + ReturnString2


Debug "Islibrary = " + Str(IsLibrary(0))

CloseLibrary(0)

Code: Alles auswählen

// pbdlltest.cpp : Defines the entry point for the console application.
//

#include "stdafx.h"

#pragma comment(lib, "PBdll.lib")

extern "C" __declspec(dllimport) int __stdcall IsPowerOf2(int n);
extern "C" __declspec(dllimport) int __stdcall IsPowerOf(int power, int base);
extern "C" __declspec(dllimport) char* __stdcall Round2n(float n,int places);



int _tmain(int argc, _TCHAR* argv[])
{
	char ch;
	int n,m;
	n = IsPowerOf2(33);
	m = IsPowerOf(49, 7);
	printf("%d\n", n);
	printf("%d\n", m);
	printf("%s\n", Round2n((float) 3.1415927,4));
	printf("%s\n","press return to end");
	ch = getchar();

	return 0;
}

Code: Alles auswählen

Round2n(a.f, b.l)      As "_Round2n@8"

Code: Alles auswählen

; This procedure is called once, when the program loads the library
; for the first time. All init stuffs can be done here (but not DirectX init)
;

Global mutex

ProcedureDLL AttachProcess(Instance)
  mutex = CreateMutex()
EndProcedure


; Called when the program release (free) the DLL
;
ProcedureDLL DetachProcess(Instance)
  FreeMutex(mutex)
EndProcedure


; Both are called when a thread in a program call or release (free) the DLL
;
ProcedureDLL AttachThread(Instance)
EndProcedure

ProcedureDLL DetachThread(Instance)
EndProcedure

; Compilermode ansi

;-T_BSTR
Procedure helpSysAllocString(*Value)
  ProcedureReturn SysAllocString_(*Value)
EndProcedure
Prototype.l ProtoSysAllocString(Value.p-unicode)

Global T_BSTR.ProtoSysAllocString = @helpSysAllocString()

ProcedureDLL GetString(*var.variant)

  Protected temp.s, hr
  
  LockMutex(mutex)
  hr = VariantClear_(*var)
  If hr = #S_OK
    temp = "Hello World"
    *var\vt = #VT_BSTR
    *var\bstrVal = T_BSTR(temp)
  EndIf
  UnlockMutex(mutex)
  ProcedureReturn hr
  
EndProcedure

ProcedureDLL GetFloat(*var.variant)

  Protected hr
  
  LockMutex(mutex)
  hr = VariantClear_(*var)
  If hr = #S_OK
    *var\vt = #VT_R4
    *var\fltVal = 99.8
  EndIf
  UnlockMutex(mutex)
  ProcedureReturn hr
  
EndProcedure

ProcedureDLL GetDirectString()

  Protected result, temp.s
  
  LockMutex(mutex)
  temp = "Hello World"
  result = SysAllocStringLen_(temp, Len(temp))
  UnlockMutex(mutex)
  ProcedureReturn result

EndProcedure

Code: Alles auswählen

Module test

    Declare Function GetString Lib "vbDLL.dll" (ByRef var As Object) As Int32
    Declare Function GetFloat Lib "vbDLL.dll" (ByRef var As Object) As Int32

    Declare Ansi Function GetDirectString Lib "vbDLL.dll" () As String

End Module

Code: Alles auswählen

    Private Sub ToolStripMenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripMenuItem2.Click

        Dim result As Object

        'result = "Testing"
        test.GetString(result)
        Me.ListBox1.Items.Add(result)
        test.GetFloat(result)
        Me.ListBox1.Items.Add(result)

        Me.ListBox1.Items.Add(test.GetDirectString())

    End Sub