On Wed, 16 Sep 1998 20:28:39 +0200, "Björn Röber" <b.roeber@cww.de>
wrote:
>Hallo Leute!
>
>Ich beschäftige mich seit ein paar Tagen mit WinSock-Programmierung.
Ich
>benutze die Komponente "DELPHI COSKCETS COMPONENT V3.0" von Gary
T
>Desrosiers. Meine Fragen:
>- Kann mir jemand sagen, wozu man die Methode OOB (sends the text
to the
>partner as urgent (out of band) data) braucht bzw. wie was man
damit
>anfangen kann und wie man sie benutzt?
>- Wozu ist Blocking / NonBlocking gut?
>
>Ich hoffe, es kennt sich jemand von Euch mit Socket-Programmierung
aus!
>Ich Danke Euch schon mal im voraus!
>
>Gruß, Björn!
>
>
Hi Björn !
Als "normaler" Anwender solltest du keinen OOB-Daten versenden,
da es
einige (Definitions?)Probleme gibt wie diese Daten aufgebaut sein
müssen und wie mit ihnen umgegangen werden soll....
zitiert aus der offiziellen
Winsock-Dokumentation:
2.2.3 Out-of-band data
Note: The following discussion of out-of-band data, also referred
to
as TCP Urgent data, follows the model used in the Berkeley
software
distribution. Users and implementors should be aware of the
fact that
there are at present two conflicting interpretations of RFC 793
(in
which the concept is introduced), and that the implementation of
out-of-band data in the Berkeley Software Distribution does not
conform to the Host Requirements laid down in RFC 1122. To
minimize
interoperability problems, applications writers are advised not
to use
out-of-band data unless this is required in order to interoperate
with
an existing service. Windows Sockets suppliers are urged
to document
the out-of-band semantics (BSD or RFC 1122) which their product
implements. It is beyond the scope of this specification
to mandate a
particular set of semantics for out-of-band data handling.....
Wie groß die Probleme mit OOB-Daten sind, zeigt der vor einiger
Zeit
um die Welt gegangene Windows-Bug, bei dem ein beliebiger Windows
Rechner (ob 3.11, Windows 95, oder NT spielt keine Rolle) über
TCP/IP
zum Absturz gebracht werden kann.
Dabei wurde mit dem Zielrechner einfach eine TCP-Verbindung an
den
Port 139 (NetBIOS) gelegt und irgendwelche Daten - jedoch mit dem
OOB-Flag versehen - an diesen geschickt. Daraufhin wußte
anscheinend
das geliebte Windows auf dem Zielrechner nicht, wie es denn mit
solchen Daten umgehen solle -> daher Bluescreen und meist
Totalabsturz.....
Das Winsock API bietet von vornherein 3 verschiedene Funktionstypen:
die blockierenden,
die nicht blockierenden und
die asynchronen.
Da es ja eine Zeit dauern kann, bis eine Funktion das gewünschte
Ergebnis zurückliefert, geben die meisten Funktionen die Kontrolle
nicht gleich wieder an das aufrufende Programm zurück -> sie
blockieren. Das stört natürlich gewaltig (außer
sie laufen in einem
eigenen Thread) daher geben die Funktionen, wenn in den
non-blocking-mode umgeschaltet wurde, die Kontrolle sofort wieder
an
den aufrufenden Prozeß zurück - meist ohne die gewünschten
Daten,
sondern mit der Fehlermeldung WSAEWOULDBLOCK. Mit einer schöööööönen
Schleife kann jedoch so lange die Funktion aufgerufen werden, bis
die
Daten bereitstehen. Als dritte Möglichkeit bietet das
Winsock-Interface die Windows typischen asynchronen Funktionen:
die
Funktion wird aufgerufen, die Kontrolle sofort wieder an das Programm
zurückgegeben und wenn die Daten bereitstehen wird eine entsprechende
Windowmessage verschickt und die Daten können in einer
Ereignisprozedur ausgelesen werden.
mfg. Martin Stemeseder
[ stemes@gmx.net ]
I'm no Delphi Guru, but I can tell you as a graphic designer what
I believe
is going on with Brightness/Contrast: Brightness IS indeed
a simultaneous
adjustment of each RGB value in equal increments (if they're unequal,
you're adjusting color HUE).
Contrast though, is the "movement" of middle values toward extremes,
ie., a
51% gray will become darker and a 49% gray will become lighter
if you set
your threshold in the middle.
HSB (Hue, Saturation, Brightness) Involves adjustment of an image
in
different ways...when Hue is adjusted, a single channel (the Red,
for
example, in an RGB image) is manipulated while the relative light/dark
values are maintained (a red apple can become green, but greyscale
images
of either would look similar). Adjustment to SATURATION involves
the
addition of a neutral value grey to the color. Brightness involves
the
addition of white, or, like I mentioned earlier, it is the linear,
equal
adjustment of all channels.
As to implementing the theory in Dephi...There's a site you should
know of;
the gentleman who runs the show there really seems to know his
stuff: EGC
Computer lab, at
http://www.infomaster.net/external/efg/index.htm
Hope this helps.
Kevn
On Thu, 08 Oct 1998 15:57:48 GMT, L.Filges@Im-Inter.net (Lars Filges)
wrote:
Hi Lars,
hier mal kurz ein Brachial-Beispiel für DLL's.
library Mathlib;
...
interface
procedure Beispielfunktion; export;
...
implementation
procedure Beispielfunktion;
var
MyForm : TMyForm;
// Dein Formular ;)
begin
MyForm := TMyForm.Create(...);
MyForm.ShowModal;
MyForm.Destroy;
end;
soviel zur DLL. In deinem Projekt sollte jetzt noch folgender Code
stehen:
unit MainProgramm;
...
interface
procedure Beispielfunktion; external '<der Name der DLL>';
...
begin
Beispielfunktion;
end;
So, das war's. Alle Klarheiten beseitigt?
Bye, Michael
SpeedItUp wrote in message <361F12E4.AA2683FE@iname.com>...
>use GetPerformaceCount (i dont know the exact name)
>resolution is at about 0.8 microseconds (depends on CPU)
use
>GetPerformaceResolution (or so) to get it out
>
>> I have really big trouble. I need a very precise timer under
Windows95
>> with a
>> resolution up to 10 microseconds. The "TTimer" is too bad or
this; its
>> to slow
>> and very unstable. How about programming an interrupt ? is that
>> pssible under
>> Win95? , and how could i do that ??
>
>
It's queryPerformanceCounter and queryPerformanceFrequency.
In Delphi4 you
can just use an int64 as a parameter, in Delphi 3 you must use
a
tLargeInteger.
Greg Smith
In article <danloy-1510981834490001@quadra.anma.ucl.ac.be>,
danloy@anma.ucl.ac.be (Bernard Danloy) wrote:
>
> : Bernard Danloy schrieb:
> : >
> :
> : > A student of mine did run a tentative program on his own
pc ( using,
> : > if i did understand correctly, some version of TurboPascal
) ; he
> : > found a unexpected decimal result for the machine epsilon,
something
> : > equivalent to .... 2^(-39) !!
> : >
>
> I am interested in more details ( in order to prepare new homeworks
) :
>
> How were the 6 bytes divided ? ( i presume 1 bit for the sign
)
> Exponent : 8 bits ?
> Mantissa : 40 bits ( the first one missing
due to normalization ) ?
The bits are allocated as follows:
1 sign bit
8 exponent bits (biased exponent with BIAS = 0x80)
39 mantissa bits (hidden MSB, normalization 0.5 <= m <
1)
Denormals, Infinities, NaNs and the like are not supported. The
largest
representable number is about 1.70e38, and the smallest representable
number is about 2.94e-39 (biased exponent of 1). Any number with
exponent
of zero is treated as zero. Epsilon is about 9.09e-13 = 0.5 ulp.
Best I recall, rounding was simply handled by truncation in early
versions.
The rounding was improved in later versions (Turbo Pascal 6 and
Borland
Pascal 7 for sure) to be simple round to nearest (i.e. always round
up
for the halfway case) producing mostly result with < 0.5 ulp
error for
add, subtract, multiply, and divide (but not SQRT). Since a sticky
bit
was not used in the routines for basic arithmetic, round-to-nearest-even
was not supported.
Due to the lack of a guard bit, addition of numbers with differing
signs
could lead to larger errors. I think TP never used more then a
simple
round bit in any version.
The run time library for Turbo Pascal used a calling convention
that passed
REAL arguments in registers DX:BX:AX and DI:DI:CX, with result
being returned
in DX:BX:AX. The bits were allocated to the register as follows:
47 46
8 7
+--+------------------------------+--------+
|S |
Mantissa |Exponent|
+--+------------------------------+--------+
47
31 15
7 0
+-------------+------------+------+--------+
| DX
| BX | AH |
AL |
+-------------+------------+------+--------+
47
31 15
7 0
+-------------+------------+------+--------+
| DI
| SI | CH |
CL |
+-------------+------------+------+--------+
value = 1^(-S) * Mantissa/2^40 * 2^(Exponent-129)
Variables in memory were stored in 6 bytes, little-endian, as one
would
expect on a little-endian platform. No intermediate higher working
precision
was used in the the run time libraries REAL routines.
The Turbo Pascal REAL format was an execellent trade-off between
execution
speed and accuracy for 16-bit x86 machines. Most of the operations
could
be implemented running almost exlusively from registers and a few
stack
variables.
I wrote two replacement libraries for Turbo Pascal 6.0 (TPL60N19.ZIP)
and
Borland Pascal 7.0 (BPL70N16.ZIP) that included improved REAL arithmetic.
I improved the rounding to round-to-nearest-even for add, subtract,
multiply,
divide, and square root, improved the accuracy of other functions
like the
transcendentals, and improved the speed. I think this resulted
in 2.5 KB of
object code for all REAL functions in the library. Full source
code for all
the REAL functions is included in the .ZIP files. If anybody is
interested,
they can still find these files on the Net.
-- Norbert
by Franz Glaser: This explanation is much
better than I could have sent.
For the .ZIP (284kB) look at the FTP search
engine
>AFAIK wird der Datenbereich der DLL für jede Instanz neu generiert
und
>"nur" der Code dupliziert - Korrekturen willkommen, wenn ich Müll
>geschrieben haben sollte.
Korrekt. Die DLL wird in den Adressraum des aufrufendenen Prozesses
eingeblendet und somit hat sie keinen Zugriff auf in einem anderen
Prozess gesetzte Werte. Win32 vorausgesetzt natürlich.
Es gibt einige Methoden trotzdem global und allen Nutzern zugängliche
Daten vorzuhalten. Hier eine, die ich aus einem System-Hook-Beispiel
abgeschrieben habe.
Diese DLL benutzt ein memory-mapped-file um einen Record
(TGlobalDLLData) zu speichern der ein paar Felder enthält
deren Wert
in jedem Speichercontext gleich sein soll.
Ciao, MM
------
library HakenLib;
uses Windows,Sysutils;
type THookEventKind=(hek_NoneYet,hek_KeyBoard,hek_Mouse,hek_SysMsg);
THookEvent=record
Kind:THookEventKind;
Time:TDateTime;
end;
PGlobalDLLData=^TGlobalDLLData;
TGlobalDLLData=record
KeyHook,
MouseHook,
SysMsgFilterHook:HHOOK;
LastEvent:THookEvent;
end;
procedure InstallHooks; stdcall export; forward;
procedure DeinstallHooks; stdcall export; forward;
function HooksInstalled:boolean; stdcall export; forward;
function GetLastEvent:THookEvent; stdcall export; forward;
function
KeyboardProc(nCode:integer;wParam:wParam;lParam:lParam):lResult
stdcall; forward;
function MouseProc(nCode:integer;wParam:wParam;lParam:lParam):lResult
stdcall; forward;
function SysMsgProc(nCode:integer;wParam:wParam;lParam:lParam):lResult
stdcall; forward;
const MMFileName='MMHakenLib2';
exports
InstallHooks,
DeInstallHooks,
GetLastEvent,
HooksInstalled,
KeyboardProc;
var MapHandle:THandle;
GlobalData:PGlobalDLLData;
procedure OpenSharedData;
var Size:integer;
CreateFileMappingError:integer;
begin
// Get the size of the data to be mapped
Size:=SizeOf(TGlobalDLLData);
// Now, get a memory-mapped file object. Note the first
parameter
passes
// the value $FFFFFFFF so that space is allocated from the
system's
// paging file. This requires that a name for the memory-mapped
object
// get passed as the last parameter.
MapHandle:=CreateFileMapping($FFFFFFFF,NIL,PAGE_READWRITE,0,Size,MMFileName);
if MapHandle=0 then RaiseLastWin32Error;
// Now map the data to the calling process' address space
and get a
pointer
// to the beginning of this address.
GlobalData:=MapViewOfFile(MapHandle,FILE_MAP_ALL_ACCESS,0,0,Size);
CreateFileMappingError:=GetLastError;
if GlobalData=NIL then
begin
CloseHandle(MapHandle);
RaiseLastWin32Error;
end;
// Initialize this data
if (MapHandle<>0) and (CreateFileMappingError<>ERROR_ALREADY_EXISTS)
then
begin
// this is the first time we have
created this file mapping...
// a good place to initialize our
data.
GlobalData^.KeyHook:=0;
GlobalData^.MouseHook:=0;
GlobalData^.SysMsgFilterHook:=0;
with GlobalData^.LastEvent do
begin
Time:=Now();
Kind:=hek_NoneYet;
end;
end;
end;
procedure CloseSharedData;
begin
UnmapViewOfFile(GlobalData);
CloseHandle(MapHandle);
end;
procedure InstallHooks;
begin
OpenSharedData;
with GlobalData^ do
begin
if KeyHook=0 then
begin
KeyHook:=SetWindowsHookEx(WH_KEYBOARD,KeyboardProc,hInstance,0);
if KeyHook=0
then RaiseLastWin32Error;
end;
if MouseHook=0 then
begin
MouseHook:=SetWindowsHookEx(WH_MOUSE,MouseProc,hInstance,0);
if MouseHook=0
then RaiseLastWin32Error;
end;
if SysMsgFilterHook=0 then
begin
SysMsgFilterHook:=SetWindowsHookEx(WH_SYSMSGFILTER,SysMsgProc,hInstance,0);
if SysMsgFilterHook=0
then RaiseLastWin32Error;
end;
end;
end;
procedure DeinstallHooks;
begin
OpenSharedData;
try
with GlobalData^ do
begin
if KeyHook<>0 then
begin
if not UnHookWindowsHookEx(KeyHook)
then {RaiseLastWin32Error;} { Why does it always fail? }
KeyHook:=0
end;
if MouseHook<>0 then
begin
if not UnHookWindowsHookEx(MouseHook)
then {RaiseLastWin32Error;} { Why does it always fail? }
MouseHook:=0
end;
if SysMsgFilterHook<>0
then
begin
if not UnHookWindowsHookEx(SysMsgFilterHook)
then {RaiseLastWin32Error;} { Why does it always fail? }
SysMsgFilterHook:=0
end;
end;
finally
CloseSharedData;
end;
end;
function GetLastEvent:THookEvent;
begin
Result:=GlobalData^.LastEvent;
end;
function HooksInstalled:boolean;
begin
// True if at least one of the hooks is in place.
Result:=((GlobalData^.KeyHook<>0) or
(GlobalData^.MouseHook<>0)
or
(GlobalData^.SysMsgFilterHook<>0));
end;
function
KeyboardProc(nCode:integer;wParam:wParam;lParam:lParam):lResult;
begin
OpenSharedData;
Result:=CallNextHookEx(GlobalData^.KeyHook,nCode,wParam,lParam);
if nCode=HC_ACTION then
with GlobalData^.LastEvent do
begin
Kind:=hek_Keyboard;
Time:=Now();
end;
end;
function MouseProc(nCode:integer;wParam:wParam;lParam:lParam):lResult;
begin
OpenSharedData;
Result:=CallNextHookEx(GlobalData^.MouseHook,nCode,wParam,lParam);
if nCode=HC_ACTION then
with GlobalData^.LastEvent do
begin
Kind:=hek_Mouse;
Time:=Now();
end;
end;
function
SysMsgProc(nCode:integer;wParam:wParam;lParam:lParam):lResult;
begin
OpenSharedData;
Result:=CallNextHookEx(GlobalData^.SysMsgFilterHook,nCode,wParam,lParam);
with GlobalData^.LastEvent do
begin
Kind:=hek_SysMsg;
Time:=Now();
end;
end;
begin
end.
--
Marian Maier, Gamma Soft http://www.gammasoft.de/maier
I would like to know if it's possible for me to assign values to
a variable
defined in a DLL. I will present an example of dll and a test program
wich
doesn't work :
{------------------here starts the DLL code-----------------}
library module;
uses app, drivers, views, dialogs, objects;
type POkButton = ^TOkButton;
TOkButton = object(TButton)
constructor Init(Bounds :
TRect);
end;
constructor TOkButton.Init(Bounds : TRect);
begin
inherited Init(Bounds, '~O~k', cmOk, bfDefault);
end;
function CreateObject : PView; export;
var p : POkButton;
R : TRect;
begin
R.Assign(2,2,5,5);
p := new(POkButton, Init(R));
CreateObject := PView(p);
end;
procedure DestroyObject(var control : PView); export;
begin
POkButton(control)^.Done;
end;
exports
CreateObject index 1,
DestroyObject index 2;
begin
end.
{------------------here ends the DLL code-----------------}
{------------------here starts the program code-----------------}
uses winapi, app, drivers, views, objects;
type CreateFunction = function : PView;
DestroyProcedure = procedure(var ctrl
: PView);
var MyLib : THANDLE;
MyApp :
TApplication;
CreateFunc : CreateFunction;
DestroyProc : DestroyProcedure;
ctrl
: PView;
begin
MyLib := loadlibrary('module.dll');
@CreateFunc := getprocaddress(MyLib, 'CreateObject');
@DestroyProc := getprocaddress(MyLib, 'DestroyObject');
if (@CreateFunc <> nil)
then ctrl := CreateFunc;
MyApp.Init;
Desktop^.Insert(ctrl); {err 216}
MyApp.Run;
if (@DestroyProc <> nil)
then DestroyProc(ctrl);
MyApp.Done;
freelibrary(MyLib);
end.
{------------------here ends the program code-----------------}
============= ANSWER:
Betreff: Re: DLL problems. Please help me !
Datum: Mon, 19 Oct 1998 17:34:03 GMT
Von: pandeng@telepath.com
(Steve Schafer (TeamB))
Firma:TeamB
Foren:borland.public.turbopascal
The problem is not one of trying to assign values to a variable
in a
DLL (which is easily done). The problem is that you are passing
_objects_ back and forth between DLL and EXE. This is related to
the
age-old problem in Windows generally referred to as SS!=DS (or
SS<>DS
when converted to Pascal). In a 16-bit Windows EXE, the stack segment
register and the data segment register contain the same value.
But in
a DLL, those values are different. Much of the run-time library
code
assumes that SS=DS, which is what leads to the problem. Declaring
a
procedure with the "export" directive adds fix-up code that eliminates
the problem, but the difficulty is that object methods are generally
declared without the "export" directive. (If you were to declare
and
use only your own object classes, whose methods were _all_ declared
with the "export" directive, you wouldn't have any of these problems.)
In short, you can't safely call a method of an object from the EXE
if
the object was instantiated in the DLL, and vice versa. If the
method
call makes no reference to any of the fields of the object, you
can
usually get away with it, but you'll get a GPF as soon as you try
to
access a field.
-Steve
Here's some code you can examine/modify for these tasks
(plus a couple
of example calls):
function Parse_AN: string; { Parse A/N string - strip
"s on ends }
var I,J : Word;
S : string;
C1 : char;
begin
S := ''; C1 := S1[1]; Delete (S1,1,1);
{ strip comma? }
if C1 <> ',' then
begin
I := Pos('"',S1); S := ''; J :=
Pos(',',S1);
if I > 1 then
begin
S := Copy(S1,1,I-1);
Delete (S1,1,I+1)
end
else Delete (S1,1,2)
end;
Parse_AN := S
end; { Parse_AN }
function Parse_N: Word;
{ Parse/Convert Numeric string }
var S : string;
W,I : Word;
R : Real;
begin
I := Pos(',',S1); S := Copy(S1,1,I-1); Delete (S1,1,I);
if Pos('.',S) = 0 then
begin
Val (S,W,N);
if X then W := W*60
{ integer time - scale hours }
end
else
begin
Val(S,R,N); W := Trunc(R)*60+(Round(Frac(R)*60))
end;
Parse_N := W
end; { Parse_N }
W_P := Parse_AN;
{ Work Product }
SDate := Parse_AN;
{ Meeting Date }
BTW, I would expect the data in a conventional .CSV
file to have
alphanumeric fields enclosed in ".." pairs, which the Parse_AN
function
handles...
> Can anyone please show me a fragment of TP7.0
> code that will read in the text from a CSV file - all I have
> managed to do so far is read & write from files where
> the information is stored one variable to one line -
> Instead of the text file being organised like this
:
>
> Smith
> Joe
> 4589
> 12
> 78
>
> I would like to organise it like this :
>
> Smith, Joe, 4589,12,78....
> How can I calculate position of pixel from x,y,z ? I want to make starfield.
There are several solutions.
First of all, you have to make sure that the 3D X
and Y positions of your
stars are between
-a1 and +b1
(I suppose A1 and B1 are half of the screen Y dimension)
That means declare their variables as INTEGERS and
NOT as Words.
and the 3D z position if greater than 0.
Then you can do the following:
X2D := X3D * ZA div (Z3D + ZA)
Y2D := Y3D * ZA div (Z3D + ZA)
ZA is a constant that's value represents how far your
eye is away from the
screen.
Play around with it to find a good value for ZA.
Note that X2D and Y2D are between -a1 and +b1, too.
So you should add the value of a1 to X2D and Y2D,
before you display them.
Alternately you can do the following:
X2Df := R * X3D / SQRT(X3D*X3D+Y3D*Y3D+Z3D*Z3D);
Y2Df := R * Y3D / SQRT(X3D*X3D+Y3D*Y3D+Z3D*Z3D);
BTW: Play around with R. this so caled Frog's eye
will display the Pixels as
if they are watched through a cut if half glas ball.
It looks better but it is much slower than the first
version.
As above, X2D and Y2D have to be between -a1 and
+b1, and you'll have to add
a1 to the results before you can display them.
If you have problems interpreting these 2 calculations,
e-mail me and I'll
send you my Starfields.
On Sat, 24 Oct 1998 11:49:48 +0200, "Tobias" <tobih@mayn.de> wrote:
Hallo Tobias,
> Im Protected Mode geht da nix...
in protected
mode not possible
Natürlich geht es. Funktion GetIntVect im Protected
Mode gibt
Nicht Pointer auf eine Interrupt Service Routine
(ISR) zurück,
wie im Real Mode, sonder zeigt auf eine Tabelle.
Dort findet
man richtige Pointer mit noch ein Par wichtige Informationen.
Hier ist das was du brauchst:
Indeed it is possible. The
GetIntVect function in protected mode
does not deliver a pointer
to the interrupt service routine (ISR)
like in Real Mode, but points
to a table. There the actual pointer
is found with some additional
important informations.
Here is what you need:
(english by F.Glaser)
+++ BEGIN CUT+++
uses dos;
procedure GetRMIntVec(IntNo: byte; var Vector: pointer);
assembler;
asm
mov AX,$0200
mov BL,IntNo
int $31
les DI,Vector
mov word
ptr ES:[DI],DX
mov word
ptr ES:[DI+2],CX
end;
const
cPattern : string[4] = 'N5NX';
function Found(ISR: byte): boolean; {function
to detect if the TSR is already installed}
var
P: pointer;
R: record O,S: word end absolute P;
I: byte;
begin
{$IFDEF DPMI}
GetRMIntVec(ISR,P);
R.S:=SegToSel(R.S);
{$ELSE}
getintvec(ISR,P);
{$ENDIF}
Found:=true;
for I:=1 to length(cPattern) do
if cPattern[I]<>char(mem[R.S:R.O+I-1)
then Found:=false;
end;
+++ END CUT +++
Viel Spaß. Und übrigens, das ist nicht
richtige weg um zu
prüfen ob ein TSR installiert ist oder nicht!
Tefik Becirovic - Fiko
Greet to all PASCAL Profys Staff Wizard.
In article <3639D9D8.2BA479D7@rz-online.de>,
Frederic <frederic@rz-online.de> wrote:
>How can I resize an array (accessed via a pointer) without losing
the
>already existing data?
>Example:
>
>type
> TestArray = Array[1..64000] of byte;
>var
> Table : ^TestArray;
>
>Now suppose that using GetMem(Table, 64000), I allocate 64,000
bytes for
>Table. Later in the program, I find out that I actually only need
16,000
>bytes. How can I release the 48,000 bytes I do not need?
I think this should work:
Type Words=Record
lo,hi:Word;
End;
Procedure ShrinkMem(Var P:pointer; OrigSize,NewSize:word);
var P2:pointer;
Begin
if origsize>65535-8 then runerror(203);
Origsize:=((OrigSize-1) or 7) +1;
Newsize:=((NewSize-1) or 7) +1;
if Newsize>=OrigSize Then Exit;
p2:=ptr(words(p).Hi+NewSize shr 4,NewSize and 8+Words(p).Lo);
if Words(p2).Lo>15 then p2:=ptr(Words(p2).Hi+1,Words(p2).Lo-16);
FreeMem(p2,OrigSize-NewSize)
End;
The above is for versions 6.0-7.0.
---snip
Osmo
> Martin Laabs wrote:
> >
> > Das klingt jetzt wie eine Anfängerfrage. Ist sie aber
nicht.
> > Jeder kennt ja das problem, das man mit der Graf o. einer anderen
Und zwar geht das indem man einen sogenannten proprietären
Textgerätetreiber in Pascal schreibt. Um eine "Ausgabedatei"
zu erstellen
muss man folgende Proceduren zur Verfügung stellen:
OPEN
WRITE
FLUSH
CLOSE
Übleicherweise wird beim Flush das selbe ausgeführt wie
beim Write. Konkret
kann das in etwa so aussehen (modifizerte Version aus einer meiner
Grafik-Units kopiert):
uses
DOS; {Definiert den
TextRec-Typ}
function TextWrite(var Txt: TextRec): Integer; far;
var
S: string;
begin
with Txt do begin
S[0]:=Char(BufPos);
Move(BufPtr^,S[1],Length(S));
BufPos:=0;
WriteString(S); {Wobei Du das WriteString schreibst}
end;
TextWrite:=0;
end;
function TextReturn(var Txt: TextRec): Integer; far;
begin
TextReturn:=0;
end;
function TextOpen(var Txt: TextRec): Integer; far;
begin
with Txt do
if Mode<>fmOutput then
TextOpen:=5 {"File access denied", da nur
Schreibtauglich}
else begin
InOutFunc:=@TextWrite;
FlushFunc:=@TextWrite;
CloseFunc:=@TextReturn;
TextOpen:=0;
end;
end;
Und im Hauptprogramm bzw. dort von wo an der Text "umgeleitet" werden soll:
Close(Input);
with TextRec(Input)
do begin
Mode:=fmClosed;
BufSize:=SizeOf(Buffer);
BufPtr:=@Buffer;
OpenFunc:=@TextOpen;
Name[0]:=#0;
Canvas:=@self;
end;
Rewrite(Input);
Hoffentlich erfüllt das Deine Wünsche...
--
Arsène von Wyss - avonwyss@gmx.net
+-------------------------------------------------------------+
| Pascal, Delphi & Personal stuff: http://bsn.ch/avonwyss
|
| Programming Contest Problems Archive: http://bsn.ch/contest |
¦ Webmaster von Roger's Equine Pages: http://bsn.ch/pferde
|
+-------------------------------------------------------------+
| "Is that your C program listing or is it line noise?"
|
+---------------------------------------------------------+
Get your own FREE
HOMEPAGE