When I call TTcpClient.SendStream(MyStream), it advances MyStream.Position to 8704, and I have to call SendStream() repeatedly to get it to completely send my stream. However, the data received is missing chunks of 512 bytes about every 8K.
Note: This question is rhetorical, because I suffered through trying and failing to find a solution on the web. I found the bug in Delphi 7 Sockets.pas, and want to publish the solution for the good of the community.
The problem is a coding bug in Delphi 7 Sockets.pas. The bug causes any stream larger than about 8K (exact size is OS-dependent) to lose 512-byte chunks of data. The SendStream implementation uses a repeat..until loop to pull 512-byte buffers from the caller's stream for sending with SendBuf(), and it continues as long as the stream has data and SendBuf() does not return equal to SOCKET_ERROR. The loss occurs when the Windows socket buffer fills, causing SendBuf() to return equal to SOCKET_ERROR, but at that point up to 512 bytes have already been read from the caller's stream and the stream Position has been advanced - but that Position is not restored on exit. Original Sockets.pas code:
function TBaseSocket.SendStream(AStream: TStream): Integer;
var
BufLen : Integer;
Buffer: array[0..511] of Byte;
begin
Result := 0;
if Assigned(AStream) then begin
repeat
BufLen := AStream.Read(Buffer, SizeOf(Buffer));
until (BufLen = 0) or (SendBuf(Buffer, BufLen) = SOCKET_ERROR);
end;
end;
And here's a fix:
function TBaseSocket.SendStream(AStream: TStream): Integer;
var
Quit : boolean;
BufLen,OldPosition : Integer;
Buffer: array[0..511] of Byte;
begin
Result := 0;
if Assigned(AStream) then begin
repeat
OldPosition := AStream.Position;
BufLen := AStream.Read(Buffer, SizeOf(Buffer));
if (BufLen > 0) then begin
Quit := (SendBuf(Buffer, BufLen) = SOCKET_ERROR);
if Quit then AStream.Position := OldPosition; //restore!
end else begin //BufLen = 0
Quit := true;
end;
until Quit;
end;
end;
Related
Is there any reasonably simple and robust way to smoothly animate the programmatic resize of a Delphi VCL form on Windows?
For instance, when the user clicks the "Show details" button the form's height is increased with a details panel shown in the new client area.
Resizing the form by setting its Height (or ClientHeight) property will resize it immediately. I want the form to grow smoothly in height from its original value to the new value over a half-second duration.
How to smoothly animate the resize of a Delphi VCL form?
Yes, this is actually pretty easy.
Probably the simplest way is to base the solution on a TTimer which fires some 30 times per second or so, each time updating the form's size.
We just have to settle for a mapping T from time to size (width or height), so that T(0) is the original size, T(1) is the final, target size, and T(t) is the intermediate size at time t, normalized to [0, 1].
Here the simplest approach would be to let the size grow or shrink linearly with time. However, this looks bad. Instead, we should use some sigmoid function to make the speed slow at the beginning and the end and maximal at t = 0.5. My favourite sigmoid function is the inverse tangent function, but we could equally well use the hyperbolic tangent function or the error function.
Now, if FFrames[i] is the size of the ith frame, then
var F := 1 / ArcTan(Gamma);
for var i := 0 to High(FFrames) do
begin
var t := i / High(FFrames); // [0, 1]
t := 2*t - 1; // [-1, 1]
t := F*ArcTan(Gamma*t); // sigmoid transformation
t := (t + 1) / 2; // [0, 1]
FFrames[i] := Round((1 - t) * AFrom + t * ATo);
end;
computes the trajectory according to this scheme. Notice that FFrames[i] is a convex combination of the initial and final sizes.
The following component uses this code to implement animated resizing:
unit WindowAnimator;
interface
uses
SysUtils, Windows, Types, Classes, Vcl.Forms, Vcl.ExtCtrls;
type
TWindowAnimator = class(TComponent)
strict private
type
TAxis = (axWidth, axHeight);
const
DEFAULT_GAMMA = 10;
DEFAULT_DURATION = 1000 {ms};
FrameCount = 256;
var
FTimer: TTimer;
FGamma: Integer;
FDuration: Integer {ms};
FFrames: array[0..FrameCount - 1] of Integer;
FAxis: TAxis;
FTarget: Integer;
FAnimStart,
FAnimEnd: TDateTime;
FForm: TCustomForm;
FBeforeProc, FAfterProc: TProc;
procedure TimerProc(Sender: TObject);
procedure Plot(AFrom, ATo: Integer);
procedure Stop;
procedure Animate(ABeforeProc: TProc = nil; AAfterProc: TProc = nil);
procedure DoBegin;
procedure DoFinish;
public
constructor Create(AOwner: TComponent); override;
procedure AnimateWidth(ANewWidth: Integer; ABeforeProc: TProc = nil; AAfterProc: TProc = nil);
procedure AnimateHeight(ANewHeight: Integer; ABeforeProc: TProc = nil; AAfterProc: TProc = nil);
published
property Gamma: Integer read FGamma write FGamma default DEFAULT_GAMMA;
property Duration {ms}: Integer read FDuration write FDuration default DEFAULT_DURATION;
end;
procedure Register;
implementation
uses
Math, DateUtils;
procedure Register;
begin
RegisterComponents('Rejbrand 2020', [TWindowAnimator]);
end;
{ TWindowAnimator }
procedure TWindowAnimator.Animate(ABeforeProc, AAfterProc: TProc);
begin
if FForm = nil then
Exit;
FBeforeProc := ABeforeProc;
FAfterProc := AAfterProc;
DoBegin;
FAnimStart := Now;
FAnimEnd := IncMilliSecond(FAnimStart, FDuration);
FTimer.Enabled := True;
end;
procedure TWindowAnimator.AnimateHeight(ANewHeight: Integer;
ABeforeProc, AAfterProc: TProc);
begin
if FForm = nil then
Exit;
Stop;
FAxis := axHeight;
Plot(FForm.Height, ANewHeight);
Animate(ABeforeProc, AAfterProc);
end;
procedure TWindowAnimator.AnimateWidth(ANewWidth: Integer;
ABeforeProc, AAfterProc: TProc);
begin
if FForm = nil then
Exit;
Stop;
FAxis := axWidth;
Plot(FForm.Width, ANewWidth);
Animate(ABeforeProc, AAfterProc);
end;
constructor TWindowAnimator.Create(AOwner: TComponent);
begin
inherited;
if AOwner is TCustomForm then
FForm := TCustomForm(AOwner);
FGamma := DEFAULT_GAMMA;
FDuration := DEFAULT_DURATION;
FTimer := TTimer.Create(Self);
FTimer.Interval := 30;
FTimer.OnTimer := TimerProc;
FTimer.Enabled := False;
end;
procedure TWindowAnimator.DoBegin;
begin
if Assigned(FBeforeProc) then
FBeforeProc();
end;
procedure TWindowAnimator.DoFinish;
begin
if Assigned(FAfterProc) then
FAfterProc();
end;
procedure TWindowAnimator.Plot(AFrom, ATo: Integer);
begin
FTarget := ATo;
var F := 1 / ArcTan(Gamma);
for var i := 0 to High(FFrames) do
begin
var t := i / High(FFrames); // [0, 1]
t := 2*t - 1; // [-1, 1]
t := F*ArcTan(Gamma*t); // sigmoid transformation
t := (t + 1) / 2; // [0, 1]
FFrames[i] := Round((1 - t) * AFrom + t * ATo);
end;
end;
procedure TWindowAnimator.Stop;
begin
FTimer.Enabled := False;
end;
procedure TWindowAnimator.TimerProc(Sender: TObject);
begin
var LNow := Now;
if (FForm = nil) or (FAnimEnd = 0.0) then
begin
FTimer.Enabled := False;
Exit;
end;
if LNow > FAnimEnd then // play it safe
begin
FTimer.Enabled := False;
case FAxis of
axWidth:
FForm.Width := FTarget;
axHeight:
FForm.Height := FTarget;
end;
DoFinish;
Exit;
end;
var t := MilliSecondsBetween(LNow, FAnimStart) / MilliSecondsBetween(FAnimStart, FAnimEnd);
var i := EnsureRange(Round(t * High(FFrames)), 0, High(FFrames));
case FAxis of
axWidth:
FForm.Width := FFrames[i];
axHeight:
FForm.Height := FFrames[i];
end;
end;
end.
To use this component, simply drop it on a form and use its public methods:
procedure AnimateWidth(ANewWidth: Integer; ABeforeProc: TProc = nil;
AAfterProc: TProc = nil);
procedure AnimateHeight(ANewHeight: Integer; ABeforeProc: TProc = nil;
AAfterProc: TProc = nil);
The optional TProc references let you run some code before and/or after the animation; typically, you want to populate any newly obtained client area after an increase in size and hide some content before a reduction in size.
Here's the component in action, showing and hiding a "Details" text:
Here's a more complicated example with a three-stage input procedure:
The total duration of the animation, as well as the sharpness of the sigmoid function, can be adjusted using the component's published properties.
procedure TForm1.SmoothResizeFormTo(const ToSize: integer);
var
CurrentHeight: integer;
Step: integer;
begin
while Height <> ToSize do
begin
CurrentHeight := Form1.Height;
// this is the trick which both accelerates initially then
// decelerates as the form reaches its target size
Step := (ToSize - CurrentHeight) div 3;
// this allows for both collapse and expand by using Absolute
// calculated value
if (Step = 0) and (Abs(ToSize - CurrentHeight) > 0) then
begin
Step := ToSize - CurrentHeight;
Sleep(50); // adjust for smoothness
end;
if Step <> 0 then
begin
Height := Height + Step;
sleep(50); // adjust for smoothness
end;
end;
end;
procedure TForm1.btnCollapseClick(Sender: TObject);
begin
SmoothResizeFormTo(100);
end;
procedure TForm1.btnExpandClick(Sender: TObject);
begin
SmoothResizeFormTo(800);
end;
Try this without any timers ;)
I'm using delphi (RAD Studio 10) to make a little app client and server. The server only send text.
The next functions returns correctly the number of bytes sent. For example I send 'hello' (client side):
procedure TTCPConnection.Write(S: String);
var buff : string;
begin
buff = S+EOL;
WriteBuffer(buff, Length(buff));
end;
Where: S = 'hello' and EOL = #13#10, so buff = 'hello'+EOL.
procedure TTCPConnection.WriteBuffer(var Buffer; const Len: Cardinal);
var
a : Int16;
begin
a := send(FSocket, Buffer, Len, 0);
if (a = SOCKET_ERROR) and FConnected then
begin
HandleError;
Disconnect;
end;
end;
in the previous function: send(FSocket, Buffer, Len, 0) return 7, number of bytes sent ('hello+EOL').
Server side:
function TTCPConnection.ReadLn(Delim: String = EOL): String;
const BUFFER_SIZE = 255;
var
Buff, Buf: string;
I, L: Cardinal;
begin
Result := '';
I := 1;
L := 1;
SetLength(Buff, BUFFER_SIZE);
Buf := AnsiString(Buff);
while Connected and (L <= Cardinal(Length(Delim))) do
begin
if recv(FSocket, Buffer, Len, 0) < 1 then exit;
Buf := Buff[I];
if Buff[I] = Delim[L] then
...
...
end;
(In the previous code I include Buf var for debugger purposes only). When I debug obtain this result:
Buff = {'h', #0, 'e', #0, 'l', #0, 'l'} (7 bytes) and the next time this line is executed recv(FSocket, Buffer, Len, 0) the program does nothing, I guess this is because recv function has nothing to receive (7 bytes were sent).
I need help to make all bytes are received correctly. I do not know why they are in that order (h-#0-e-#0-l-#0-l).
Starting with RAD Studio 2009, string consists of WideChar characters. Char is an alias for WideChar and is 16 bit. The Length() function returns number of characters, not bytes.
You may want to consider using TEncoding to convert your string to a TBytes (array of byte) for sending and vice versa for receiving. I don't know your TTCPConnection class, so it may be you need to tweek the code, but here for the sending part using TEncoding.UTF8:
procedure TTCPConnection.Write(S: String);
var buff : TBytes;
begin
buff := TEncoding.UTF8.GetBytes(S+EOL); // Convert to bytes using UTF8 encoding
WriteBuffer(buff, Length(buff));
end;
And here is my receiver code from a testproject in XE5 where I used the TTcpServer component
procedure TForm3.TcpServer1Accept(Sender: TObject;
ClientSocket: TCustomIpClient);
var
a: array[0..255] of byte;
b: TBytes;
i, n: integer;
s: string;
begin
n := ClientSocket.ReceiveBuf(a,255,0);
SetLength(b, n);
for i := Low(b) to High(b) do b[i] := a[i]; // copy from the receive buffer
s := TEncoding.UTF8.GetString(b); // convert UTF8 bytes to string
Memo1.Lines.Add(format('%4d %s',[n,s]));
end;
Finally a few useful links to the documentation:
TEncoding
UTF-8 Conversion Routines
I have a problem with the send function. My program worked correcly in Xe8 but with the upgrade to Xe10, I have a problem : encryption ?
I have create a simple project datasnap with juste the bugging function like that
procedure TServerMethods1.test3;
VAR
a : string;
begin
a := LoadFileToStr('C:\demo\Bitmaps\Mazak_Matrix.JPG');
GetInvocationMetadata.ResponseContentType := 'image/jpeg';
GetInvocationMetadata.ResponseCode := 200;
GetInvocationMetadata().ResponseContent := a;
GetInvocationMetaData.CloseSession := True;
end;
And the function LoadFileToStr
function LoadFileToStr(const FileName: string): AnsiString;
var
FileStream : TFileStream;
begin
FileStream:= TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
if FileStream.Size>0 then
begin
SetLength(Result, FileStream.Size);
FileStream.Read(Pointer(Result)^, FileStream.Size);
end;
finally
FileStream.Free;
end;
end;
Actually, the data was correct until
GetInvocationMetadata().ResponseContent := a;
The responseContent destroy the data, like you can see on the hex editor. An example. The entire file is not corrupt, just a few characters.
Original Picture
After sending by the server
Someone has encountered the same bug? If going directly a stream that works, but it doesn't interest me.
Thanks !
Had same problem. Try something like this.
procedure TAPI.GetFile(UID: string);
var
LFS: TFileStream;
I: Integer;
LByte: Byte;
begin
try
LFS := TFileStream.Create('e:\image.jpg', fmOpenRead);
for I := 0 to Pred(LFS.Size) do
begin
LFS.Read(LByte, 1);
GetInvocationmetaData.ResponseContent := GetInvocationmetaData.ResponseContent + Char(LByte);
end;
GetInvocationmetaData.ResponseContentType := 'image/jpeg';
finally
LFS.Free;
end;
end;
I have a problem which occurs only in a very small customer range and I would like to ask if you might give me a hint where the problem might be. The program works for 98% of the customers. Alas, it is not possible that I work with the customers to debug the issue, because their knowledge of Windows and computers is very basic. It is also not possible that I send multiple versions of the product to them, since they don't even know how to install software (the admins do all the stuff).
First of all, I translate all RT_STRING resources on-the-fly, so that the language-switching in the program also affects hardcoded stuff like "Yes", "No", "Cancel" etc., which would only be possible by compiling 2 EXE files.
The code (I have tried to left away as much unnecessary stuff as possible, but since I don't know where the problem is, I provided as much details for the bug as possible):
The ony-the-fly resource translation
procedure TranslateResources;
var
i: integer;
s: string;
{$IF NOT Declared(FILE_ATTRIBUTE_NOT_CONTENT_INDEXED)}
const
FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = $2000;
{$IFEND}
begin
// I copy all resources in a dummy DLL (without code), because
// 1) The resources are the only thing we need when changing the resource module
// 2) If the EXE code/debug sections are too long, BeginUpdateResource() will ruin the performance heavily
FTempFile := IncludeTrailingPathDelimiter(GetTempDirectory) + GetRandomString(8)+'.dll';
// Transfers all resources from ParamStr(0) into the dummy DLL at FTempFile
ReGenerateResourceFile(FTempFile);
// if necessary, remove readonly flag
SetFileAttributes(PChar(FTempFile), FILE_ATTRIBUTE_OFFLINE or
FILE_ATTRIBUTE_NOT_CONTENT_INDEXED or
FILE_ATTRIBUTE_TEMPORARY );
for i := 0 to Length(RTLResStringTranslationArray)-1 do
begin
s := Translate(RTLResStringTranslationArray[i].TranslationID);
if s <> '' then
begin
// Translate the string
UpdateResString(RTLResStringTranslationArray[i].ResStrDescriptor.Identifier, s);
end;
end;
LoadNewResourceModule(FTempFile):
end;
procedure ReGenerateResourceFile(OutputFile: string);
var
hUpd: Cardinal;
rs: TResourceStream;
fs: TFileStream;
begin
// As template we use a dummy DLL which contains no code.
// We will implement all resources from ParamStr(0) into it, before we translate the strings.
rs := TResourceStream.Create(HInstance, 'DUMMYDLL', 'DLL');
fs := TFileStream.Create(OutputFile, fmCreate or fmOpenWrite);
try
fs.CopyFrom(rs, rs.Size)
finally
rs.Free;
fs.Free;
end;
// Transfer resources from our EXE into the dummy DLL file
hUpd := BeginUpdateResource(PChar(OutputFile), true);
try
EnumResourceTypes(hInstance, #_enumResTypesProc, hUpd);
finally
EndUpdateResource(hUpd, false)
end;
end;
// This is based on reinit.pas from Borland's RichEdit example; slightly modified
function LoadNewResourceModule(PatchedFile: string): LongInt;
var
NewInst: Longint;
CurModule: PLibModule;
begin
Result := 0;
// Win95: "Initialization routine failed"
// NewInst := LoadLibrary(PChar(PatchedFile));
NewInst := LoadLibraryEx(PChar(PatchedFile), 0, LOAD_LIBRARY_AS_DATAFILE);
CurModule := LibModuleList;
Result := 0;
while CurModule <> nil do
begin
if CurModule.Instance = HInstance then
begin
if CurModule.ResInstance <> CurModule.Instance then
FreeLibrary(CurModule.ResInstance);
// Win95: ERangeError
CurModule^.ResInstance := NewInst;
Result := NewInst;
Exit;
end;
CurModule := CurModule.Next;
end;
end;
// Based on http://stackoverflow.com/questions/1498658/modifying-a-string-in-resource-of-an-exe
// Modified
procedure UpdateResString(const AStringIdent: Integer; const ANewString: WideString);
var
ResData, TempData: TWordArray;
iSection, iIndexInSection: Integer;
i, iLen, iSkip, iPos: Integer;
begin
// Calculate the resource string area and the string index in that area
iSection := AStringIdent div 16 + 1;
iIndexInSection := AStringIdent mod 16;
ResData := ReadSectionCached(iSection);
// Calculate the position of the string
iLen := Length(ANewString);
iPos := 0;
for i := 0 to iIndexInSection do
begin
if iPos > High(ResData) then
begin
SetLength(ResData, iPos + 1);
ResData[iPos] := 0;
end;
if i <> iIndexInSection then
begin
iSkip := ResData[iPos] + 1;
Inc(iPos, iSkip);
end;
end;
// Put data behind strings into TempData
iSkip := 1{size} + ResData[iPos];
SetLength(TempData, Length(ResData) - (iPos + iSkip));
if Length(TempData) > 0 then
begin
CopyMemory(#TempData[0], #ResData[iPos + iSkip], Length(TempData)*SizeOf(TempData[0]));
end;
SetLength(ResData, iPos + (iLen + 1{size}) + Length(TempData));
// Overwrite string
ResData[iPos] := iLen;
Inc(iPos);
if iLen > 0 then
begin
CopyMemory(#ResData[iPos], #ANewString[1], iLen*SizeOf(ANewString[1]));
Inc(iPos, iLen);
end;
// Append TempData after our new string
if Length(TempData) > 0 then
begin
CopyMemory(#ResData[iPos], #TempData[0], Length(TempData)*SizeOf(TempData[0]));
end;
CacheSet(iSection, ResData);
end;
type
TGlobalData = record
GlobalPtr: Pointer;
Length: integer;
end;
function LoadResourcePtr(hModule: HMODULE; restype, resname: PChar; wIDLanguage: WORD): TGlobalData;
var
hFind, hRes: THandle;
begin
result.GlobalPtr := nil;
result.Length := -1;
hFind := Windows.FindResourceEx(hModule, restype, resname, wIDLanguage);
if hFind = 0 then RaiseLastOSError;
hres := Windows.LoadResource(hModule, hFind);
if hres = 0 then RaiseLastOSError;
result.GlobalPtr := Windows.LockResource(hres);
result.Length := Windows.SizeofResource(hModule, hFind);
end;
function _enumResLangsProc(hmodule: HMODULE; restype, resname: PChar; wIDLanguage: WORD;
lParam: LongInt): BOOL; stdcall;
var
rs: TGlobalData;
begin
rs := LoadResourcePtr(hmodule, restype, resname, wIDLanguage);
UpdateResource(lParam, restype, resname, wIDLanguage, rs.GlobalPtr, rs.Length);
result := true;
end;
function _enumResNamesProc(hmodule: HMODULE; restype, resname: PChar;
lParam: LongInt): BOOL; stdcall;
begin
EnumResourceLanguages(hmodule, restype, resname, #_enumResLangsProc, lParam);
result := true;
end;
function _enumResTypesProc(hmodule: HMODULE; restype: PChar;
lParam: LongInt): BOOL; stdcall;
begin
EnumResourceNames(hmodule, restype, #_enumResNamesProc, lParam);
result := true;
end;
{$R '..\dummydll\dummydll.RES'}
Then I use a wait form:
unit Wait;
interface
uses
...
type
TWaitForm = class(TForm)
...
end;
var
WaitForm: TWaitForm;
implementation
{$R *.dfm}
...
end;
The wait form will be called by dynamically showing the form:
procedure ShowWaitForm;
begin
...
{ I use my own _CreateForm function because it solves many workarounds for
juicy stuff like half-modal windows (which can be hidden without user action),
miscellaneous deadlocks etc. and to allow the form to be shown in a shared PAS file
without the requirement to add it to every DPR file where the WaitForm API is used. }
WaitForm := _CreateForm(TWaitForm, {Application.MainForm}AParent) as TWaitForm;
WaitForm.Show;
...
end;
function _CreateForm(InstanceClass: TCustomFormClass; AParent: TCustomForm): TCustomForm;
var
LOwner: TComponent;
begin
if Assigned(AParent) then
begin
LOwner := AParent;
end
else if Assigned(Application) then
begin
LOwner := Application;
end
else
begin
LOwner := nil;
end;
result := InstanceClass.Create(LOwner);
end;
The error message at 2% of the customers:
Resource TWaitForm was not found
However, other forms are working.
There are 2 theories I can think of:
1) Did the resource translation corrupt the DLL file / part of the RCData section? (Maybe a bug in the WinAPI's UpdateResource ?)
2) Is there a problem with the dynamic showing of the wait form (since other "static" forms are shown?)
I use the following helper for preventing forms moving of screen and it is most of the time working OK. But if I open a wsNormal form in a MDI app then the form might show up of the area where it is supposed to be. I can then just move it a bit and then the unit here takes over and moves it in place.
My question is now: how can I either prevent this from happening or send a message to the form saying it is moving so the unit her can do its job.
unit U_FormsMove;
interface
uses
Messages, Windows, Forms;
{$M+}
type
TForm = class(Forms.TForm)
private
protected
procedure WMMoving(var message : TWMMoving); message WM_MOVING;
published
public
end;
implementation
function GetMovementArea: TRect;
var
MovementRect: TRect;
begin
if Application.MainForm.FormStyle = fsMDIForm then
Windows.GetWindowRect(Application.MainForm.ClientHandle, MovementRect)
else
SystemParametersInfo(SPI_GETWORKAREA, 0, #MovementRect, 0);
if MovementRect.Top < 150 then
MovementRect.Top := 150;
MovementRect.Top := MovementRect.Top + 5;
MovementRect.Left := MovementRect.Left + 5;
MovementRect.Right := MovementRect.Right - 5;
MovementRect.Bottom := MovementRect.Bottom - 5;
Result := MovementRect;
end;
{ TFormHelper }
procedure TForm.WMMoving(var Message: TWMMoving);
var
rec: ^TRect;
wrk: TRect;
begin
wrk := GetMovementArea;
rec := Pointer(Message.DragRect);
if rec^.Left < wrk.Left then
begin
rec^.Right := rec^.Right - (rec^.Left - wrk.Left);
rec^.Left := wrk.Left;
end
else if rec^.Right > wrk.Right then
begin
rec^.Left := rec^.Left - (rec^.Right - wrk.Right);
rec^.Right := wrk.Right;
end;
if rec^.Top < wrk.Top then
begin
rec^.Bottom := rec^.Bottom - (rec^.Top - wrk.Top);
rec^.Top := wrk.Top;
end
else if rec^.Bottom > wrk.Bottom then
begin
rec^.Top := rec^.Top - (rec^.Bottom - wrk.Bottom);
rec^.Bottom := wrk.Bottom;
end;
end;
end.