paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 16:19:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

added ipro html components, compilable but not yet working

Browse Source 
git-svn-id: trunk@3975 -
This commit is contained in:
mattias 2003-03-27 18:25:35 +00:00
parent a486bdea2a
commit 2d20c163ab
8 changed files with 27999 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
.gitattributes vendored
View File

@ -103,7 +103,14 @@ components/synedit/synmacrorecorder.pas svneol=native#text/pascal
components/synedit/synmemo.pas svneol=native#text/pascal
components/synedit/synregexpr.pas svneol=native#text/pascal
components/synedit/syntextdrawer.pp svneol=native#text/pascal
components/turbopower_ipro/ipanim.pas svneol=native#text/pascal
components/turbopower_ipro/ipconst.pas svneol=native#text/pascal
components/turbopower_ipro/ipdefine.inc svneol=native#text/pascal
components/turbopower_ipro/iphtml.pas svneol=native#text/pascal
components/turbopower_ipro/iphtmlpv.pas svneol=native#text/pascal
components/turbopower_ipro/ipmsg.pas svneol=native#text/pascal
components/turbopower_ipro/ipstrms.pas svneol=native#text/pascal
components/turbopower_ipro/iputils.pas svneol=native#text/pascal
debugger/breakpointsdlg.lfm svneol=native#text/plain
debugger/breakpointsdlg.lrs svneol=native#text/pascal
debugger/breakpointsdlg.pp svneol=native#text/pascal

937
components/turbopower_ipro/ipanim.pas Normal file
View File

@ -0,0 +1,937 @@
{******************************************************************}
{* IPANIM.PAS - Provides basic animation support. You should not *}
{* need to create an instance of this class, instead you should *}
{* inherit your animated graphics class from this class. *}
{******************************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower Internet Professional
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 2000-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{ Global defines potentially affecting this unit }
{$I IPDEFINE.INC}
unit IpAnim;
interface
uses
{$IFDEF IP_LAZARUS}
LCLType,
GraphType,
LCLLinux,
{$ELSE}
Windows,
Messages,
{$ENDIF}
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, IpConst;
const
// Constants for the default settings of some properties
DefaultAggressiveDrawing : Boolean = False;
DefaultFrameChangeNotify : Boolean = False;
type
// Various disposal methods
TDisposalMethod = (NODISPOSALMETHOD, DONOTDISPOSE, OVERWRITEWITHBKGCOLOR,
OVERWRITEWITHPREVIOUS);
TIpAnimationFrameList = class;
// Event Types
TOnBeforeFrameChange = procedure ( Sender : TObject;
CurrentFrame : Integer;
var NewFrame : Integer;
Frames : TIpAnimationFrameList;
var CanChange : boolean) of object;
TOnAfterFrameChange = procedure (Sender : TObject;
CurrentFrame : Integer;
Frames : TIpAnimationFrameList)
of object;
// Exception Classes
EAnimationError = class(Exception); // GIF Decoding errors
EFrameListError = class (Exception); // GIF Frame List errors
// TIpAnimationFrame
{
TIpAnimationFrame holds one frame of an animation. It also keeps track
of the x and y offsets for the frame and the size of this frame.
}
TIpAnimationFrame = class(TObject)
private
FBitmap : TBitmap; // bitmap for this frame
FXOffset : Integer; // X Offset for this frame
FYOffset : Integer; // Y Offset for this frame
FDelayTime : Integer; // Time in 1/100 second til next frame
FDisposalMethod : TDisposalMethod; // Disposal Method
FTransparent : Boolean;
FTransparentColor : TColor;
protected
procedure SetBitmap (v : TBitmap);
procedure SetDelayTime (v : Integer);
procedure SetXOffset (v : Integer);
procedure SetYOffset (v : Integer);
public
constructor Create;
destructor Destroy; override;
published
property Bitmap : TBitmap read FBitmap write SetBitmap;
property DelayTime : Integer read FDelayTime write SetDelayTime;
property DisposalMethod : TDisposalMethod
read FDisposalMethod write FDisposalMethod default DONOTDISPOSE;
property Transparent : Boolean
read FTransparent write FTransparent;
property TransparentColor : TColor
read FTransparentColor write FTransparentColor;
property XOffset : Integer read FXOffset write SetXOffset default 0;
property YOffset : Integer read FYOffset write SetYOffset default 0;
end;
{
TIpAnimationFrameList holds a list of Frames.
}
TIpAnimationFrameList = class(TObject)
private
FReferenceCounter : Integer; // Internal reference counter
FList : TList;
protected
function GetCount : Integer;
procedure SetCount (v : Integer);
function GetItem(Index : Integer): TIpAnimationFrame;
procedure SetItem(Index : Integer; AFrame : TIpAnimationFrame);
procedure RegisterFrames; virtual;
procedure ReleaseFrames; virtual;
public
constructor Create;
destructor Destroy; override;
// public methods
function Add(AFrame : TIpAnimationFrame): Integer;
procedure Assign (Source : TIpAnimationFrameList); virtual;
procedure Clear;
function IndexOf(AFrame : TIpAnimationFrame): Integer;
procedure Insert(Index : Integer; AFrame : TIpAnimationFrame);
function Remove(AFrame : TIpAnimationFrame): Integer;
// properties
property Count : Integer read GetCount write SetCount;
property Items[Index: Integer]: TIpAnimationFrame
read GetItem write SetItem; default;
property List : TList read FList write FList;
end;
{
TFreeGIFImage holds a decopressed GIF image.
}
TIpAnimatedGraphic = class(TGraphic)
private
FNumFrames : Integer; // Number of frames in an animation
FAnimate : boolean; // Animated image or not indicator
FRealWidth : Integer; // Real width of the image
FRealHeight : Integer; // Real height of the image
FBitmap : TBitmap; // bitmap of the current frame
FDelayTime : Integer; // Delay in 100ths of a second
FCurrentFrame : Integer; // Index of the current frame
FDisposalMethod : TDisposalMethod; // Disposal method for the cur frm
FAggressiveDrawing : Boolean; // steal a canvas and write to it?
FFrameChangeNotify : Boolean; // trigger OnChange events?
FTransparent : Boolean;
FTransparentColor : TColor;
FBackgroundColor : TColor;
FTimer : TTimer; // Animation Timer
FImages : TIpAnimationFrameList;
FOnBeforeFrameChange : TOnBeforeFrameChange;
FOnAfterFrameChange : TOnAfterFrameChange;
FDrawingCanvas : TCanvas; // Canvas that will be "stolen" for
// animation purposes.
FDrawingRect : TRect;
FDestinationCanvas : TCanvas; // User specified canvas to write to.
FDestinationRect : TRect; // User specified rectangle to write to.
protected
// Property Access
procedure ChangeFrame (NewFrame : Integer); virtual;
procedure ClearFrame ( CurrentFrame : TBitmap;
NewFrame : TIpAnimationFrame;
DisposalMethod : TDisposalMethod;
var DefaultDrawing : Boolean); virtual;
procedure Draw( ACanvas : TCanvas;
const Rect : TRect); override;
procedure FreeAnimationFrames; virtual;
function GetAnimate : boolean;
function GetEmpty : Boolean; override;
function GetHeight : Integer; override;
function GetWidth : Integer; override;
procedure Initialize; virtual;
procedure SetAggressiveDrawing (v : Boolean);
procedure SetAnimate (v : boolean);
procedure SetBitmap (v : TBitmap);
procedure SetDelayTime (v : Integer);
procedure SetDestinationCanvas (v : TCanvas);
procedure SetDestinationRect (v : TRect);
procedure SetDisposalMethod (v : TDisposalMethod);
procedure SetDrawingCanvas (v : TCanvas);
procedure SetDrawingRect (v : TRect);
procedure SetFrameChangeNotify (v : Boolean);
procedure SetHeight (v : Integer); override;
procedure SetImages (v : TIpAnimationFrameList);
procedure SetNumFrames (v : Integer);
procedure SetWidth (v : Integer); override;
procedure TimerTimeoutHandler (Sender : TObject); virtual;
public
constructor Create; {$IFNDEF IP_LAZARUS}override;{$ENDIF}
destructor Destroy; override;
procedure Assign(Source : TPersistent); override;
procedure AssignTo (Dest : TPersistent); override;
procedure LoadFromStream (Stream: TStream); override;
function StartAnimation : boolean; virtual;
procedure StopAnimation; virtual;
// Properties
property AggressiveDrawing : Boolean
read FAggressiveDrawing write SetAggressiveDrawing;
property Animate : boolean read GetAnimate write SetAnimate;
property BackgroundColor : TColor
read FBackgroundColor write FBackgroundColor;
property Bitmap : TBitmap read FBitmap write SetBitmap;
property CurrentFrameIndex : Integer read FCurrentFrame write ChangeFrame;
property DelayTime : Integer read FDelayTime write SetDelayTime;
property DestinationCanvas : TCanvas
read FDestinationCanvas write SetDestinationCanvas;
property DestinationRect : TRect
read FDestinationRect write SetDestinationRect;
property DrawingCanvas : TCanvas
read FDrawingCanvas write SetDrawingCanvas;
property DrawingRect : TRect
read FDrawingRect write SetDrawingRect;
property DisposalMethod : TDisposalMethod
read FDisposalMethod write SetDisposalMethod;
property FrameChangeNotify : Boolean
read FFrameChangeNotify write SetFrameChangeNotify;
property Height : Integer read getHeight write setHeight;
property Images : TIpAnimationFrameList read FImages write SetImages;
property NumFrames : Integer read FNumFrames write SetNumFrames;
property Transparent : boolean read FTransparent write FTransparent;
property TransparentColor : TColor
read FTransparentColor write FTransparentColor;
property Width : Integer read getWidth write setWidth;
// Events
property OnAfterFrameChange : TOnAfterFrameChange
read FOnAfterFrameChange
write FOnAfterFrameChange;
property OnBeforeFrameChange : TOnBeforeFrameChange
read FOnBeforeFrameChange
write FOnBeforeFrameChange;
published
end;
implementation
// TFreeGIFFrame
constructor TIpAnimationFrame.Create;
begin
inherited Create;
FBitmap := TBitmap.create;
XOffset := 0;
YOffset := 0;
DisposalMethod := NODISPOSALMETHOD;
end;
destructor TIpAnimationFrame.Destroy;
begin
FBitmap.Free;
FBitmap := nil;
inherited Destroy;
end;
procedure TIpAnimationFrame.SetBitmap (v : TBitmap);
begin
FBitmap.Assign (v);
end;
procedure TIpAnimationFrame.SetDelayTime (v : Integer);
begin
if v <> FDelayTime then
FDelayTime := v;
end;
procedure TIpAnimationFrame.SetXOffset (v : Integer);
begin
if v <> FXOffset then
FXOffset := v;
end;
procedure TIpAnimationFrame.SetYOffset (v : Integer);
begin
if v <> FYOffset then
FYOffset := v;
end;
// TIpAnimationFrameList
constructor TIpAnimationFrameList.Create;
begin
inherited Create;
FList := TList.Create;
FReferenceCounter := 0;
end;
destructor TIpAnimationFrameList.Destroy;
begin
FList.Free;
inherited Destroy;
end;
function TIpAnimationFrameList.Add(AFrame : TIpAnimationFrame) : Integer;
begin
Result := FList.Add (AFrame)
end;
procedure TIpAnimationFrameList.Assign (Source : TIpAnimationFrameList);
var
i : Integer;
begin
Clear;
FList.Capacity := Source.List.Capacity;
FList.Count := Source.List.Count;
for i := 0 to Source.List.Count - 1 do
FList.Items[i] := Source.List.Items[i];
RegisterFrames;
end;
procedure TIpAnimationFrameList.Clear;
begin
FList.Clear;
end;
function TIpAnimationFrameList.GetCount : Integer;
begin
result := FList.Count;
end;
function TIpAnimationFrameList.GetItem(Index : Integer) :
TIpAnimationFrame;
begin
if (Index >= FList.Count) or (Index < 0) then begin
Result := nil;
Exit;
end;
if (FList.Items[Index]=nil) then begin
Result := nil;
Exit;
end;
if TObject (FList.Items[Index]) is TIpAnimationFrame then
Result := TObject (FList.Items[Index]) as TIpAnimationFrame
else
raise EFrameListError.CreateFmt(sBadFrameListObject,
[TObject(FList.Items[Index]).ClassName]);
end;
function TIpAnimationFrameList.IndexOf(AFrame : TIpAnimationFrame) : Integer;
begin
Result := FList.IndexOf (AFrame);
end;
procedure TIpAnimationFrameList.Insert(Index : Integer;
AFrame : TIpAnimationFrame);
begin
FList.Insert (Index, AFrame);
end;
procedure TIpAnimationFrameList.RegisterFrames;
begin
inc(FReferenceCounter);
end;
procedure TIpAnimationFrameList.ReleaseFrames;
var
i : Integer;
begin
dec (FReferenceCounter);
if FReferenceCounter >= 0 then
exit;
for i := 0 to FList.Count - 1 do begin
if (FList.Items[i]<>nil) then
if TObject(FList.Items[i]) is TIpAnimationFrame then
TIpAnimationFrame (FList.Items[i]).Free;
FList.Items[i] := nil;
end;
Clear;
FList.Count := 0;
end;
function TIpAnimationFrameList.Remove(AFrame : TIpAnimationFrame) : Integer;
begin
Result := FList.Remove (AFrame);
end;
procedure TIpAnimationFrameList.SetCount (v : Integer);
begin
if v <> FList.Count then
FList.Count := v;
end;
procedure TIpAnimationFrameList.SetItem(Index : Integer;
AFrame : TIpAnimationFrame);
begin
FList.Items[Index] := AFrame;
end;
// TIpAnimatedGraphic
constructor TIpAnimatedGraphic.Create;
begin
inherited Create;
FBitmap := TBitmap.create;
FImages := TIpAnimationFrameList.create;
FTimer := TTimer.create(nil);
FTimer.Enabled := False;
FTImer.OnTimer := TimerTimeoutHandler;
FDrawingCanvas := nil;
FDestinationCanvas := nil;
FAggressiveDrawing := DefaultAggressiveDrawing;
FFrameChangeNotify := DefaultFrameChangeNotify;
end;
destructor TIpAnimatedGraphic.Destroy;
begin
FTimer.Free;
FTimer := nil;
FBitmap.Free;
FBitmap := nil;
FreeAnimationFrames;
FImages.Free;
FImages := nil;
inherited Destroy;
end;
procedure TIpAnimatedGraphic.Assign (Source : TPersistent);
begin
if Source is TIpAnimatedGraphic then
with Source as TIpAnimatedGraphic do begin
Self.Bitmap.assign(Bitmap);
Self.Images.Assign(Images);
Self.NumFrames := NumFrames;
Self.Animate := Animate;
Self.Width := Width;
Self.Height := Height;
Self.CurrentFrameIndex := 0;
Self.DelayTime := DelayTime;
Self.DisposalMethod := DisposalMethod;
Self.AggressiveDrawing := AggressiveDrawing;
Self.FrameChangeNotify := FrameChangeNotify;
Self.DrawingCanvas := DrawingCanvas;
end
else
inherited Assign (Source);
end;
procedure TIpAnimatedGraphic.AssignTo (Dest : TPersistent);
begin
if (Dest is TBitmap) then
Dest.Assign(Bitmap)
else
inherited AssignTo(Dest);
end;
procedure TIpAnimatedGraphic.ChangeFrame (NewFrame : Integer);
var
DefaultDrawing : Boolean;
begin
if (NewFrame < 0) or (NewFrame >= NumFrames) then
exit;
FCurrentFrame := NewFrame;
FBitmap.Width := FRealWidth;
FBitmap.Height := FRealHeight;
DisposalMethod := Images[NewFrame].DisposalMethod;
DefaultDrawing := True;
ClearFrame (FBitmap, Images[NewFrame],
Images[NewFrame].DisposalMethod, DefaultDrawing);
if DefaultDrawing then
FBitmap.Canvas.CopyRect (Rect (Images[NewFrame].XOffset,
Images[NewFrame].YOffset,
Images[NewFrame].XOffset + Images[NewFrame].Bitmap.Width,
Images[NewFrame].YOffset + Images[NewFrame].Bitmap.Height),
Images[NewFrame].Bitmap.Canvas,
Rect (0,
0,
Images[NewFrame].Bitmap.Width,
Images[NewFrame].Bitmap.Height));
if AggressiveDrawing then begin
if assigned(FDrawingCanvas) then begin
// Do a quick and dirty verification that the handle that we stole
// from the .Draw method is still good. We do this by calling
// GetDeviceCaps with the handle and verifying that there is something
// there. If this is ok, we can then update the bitmap with the next
// frame.
if GetDeviceCaps (FDrawingCanvas.Handle, HORZSIZE) <> 0 then begin {!!.dg}
if Animate and Transparent then {!!.dg}
FDrawingCanvas.CopyRect (FDrawingRect, FBitmap.Canvas, {!!.dg}
Rect (0, 0, {!!.dg}
FBitmap.Width, {!!.dg}
FBitmap.Height)) {!!.dg}
else {!!.dg}
Draw (FDrawingCanvas, FDrawingRect); {!!.dg}
end; {!!.dg}
end;
end;
if assigned(FDestinationCanvas) then begin {!!.dg}
if Animate and Transparent then {!!.dg}
FDestinationCanvas.CopyRect (FDestinationRect, FBitmap.Canvas, {!!.dg}
Rect (0, 0, {!!.dg}
FBitmap.Width, {!!.dg}
FBitmap.Height)) {!!.dg}
else {!!.dg}
Draw (FDestinationCanvas, DestinationRect); {!!.dg}
end; {!!.dg}
// An alternate way to cause the animation to occur is to use the OnChange
// event to notify the parent application that the image has changed. The
// problem with this is that the resulting flicker is... severe....
if (assigned (OnChange)) and FrameChangeNotify then
OnChange (self);
if (assigned (FOnAfterFrameChange)) then
FOnAfterFrameChange (Self, NewFrame, Images);
end;
procedure TIpAnimatedGraphic.ClearFrame ( CurrentFrame : TBitmap;
NewFrame : TIpAnimationFrame;
DisposalMethod : TDisposalMethod;
var DefaultDrawing : Boolean);
var
i : Integer;
x, y : Integer;
UseTransparentCopy : Boolean;
begin
{$IFDEF IP_LAZARUS}
if (CurrentFrame=nil) then ;
{$ENDIF}
// Basic clear frame. This should work for just about anything.
DefaultDrawing := False;
UseTransparentCopy := False;
case DisposalMethod of
NODISPOSALMETHOD :
// do nothing in this case - leave the old image
begin
UseTransparentCopy := NewFrame.Transparent;
end;
DONOTDISPOSE :
// do nothing in this case - leave the old image
begin
UseTransparentCopy := NewFrame.Transparent;
end;
OVERWRITEWITHBKGCOLOR :
begin
// Fill with the background color
Bitmap.Canvas.Brush.Color := BackgroundColor;
Bitmap.Canvas.FillRect (Rect(NewFrame.XOffset,
NewFrame.YOffset,
NewFrame.XOffset + NewFrame.Bitmap.Width,
NewFrame.YOffset + NewFrame.Bitmap.Height));
end;
OVERWRITEWITHPREVIOUS :
// Try to find the last do not dispose frame and fill the canvas with
// that.
begin
i := CurrentFrameIndex;
while (i >= 0) and (FNumFrames > 1) and
(Images[i].DisposalMethod <> DONOTDISPOSE) do
dec (i);
if (i >= 0) and (i < FNumFrames) and (FNumFrames > 1) then begin
if Images[i].DisposalMethod = DONOTDISPOSE then
Bitmap.Canvas.CopyRect (Rect (Images[i].XOffset,
Images[i].YOffset,
Images[i].XOffset + Images[i].Bitmap.Width,
Images[i].YOffset + Images[i].Bitmap.Height),
Images[i].Bitmap.Canvas,
Rect (0,
0,
Images[i].Bitmap.Width,
Images[i].Bitmap.Height));
UseTransparentCopy := NewFrame.Transparent;
end
else
UseTransparentCopy := NewFrame.Transparent;
end;
end;
// This is not a generally recommended way of handling transparency.
// However, it gets the timing more accurate.
if UseTransparentCopy then begin
if Images[FCurrentFrame].Bitmap <> nil then {!!.12}
for x := 0 to Images[FCurrentFrame].Bitmap.Width - 1 do
for y := 0 to Images[FCurrentFrame].Bitmap.Height - 1 do
if Images[FCurrentFrame].Bitmap.Canvas.Pixels[x, y] <>
Images[FCurrentFrame].TransparentColor then begin
if (x + Images[FCurrentFrame].XOffset < Bitmap.Width) and
(y + Images[FCurrentFrame].YOffset < Bitmap.Height) then
Bitmap.Canvas.Pixels[x + Images[FCurrentFrame].XOffset,
y + Images[FCurrentFrame].YOffset] :=
Images[FCurrentFrame].Bitmap.Canvas.Pixels[x, y];
end;
end else
Bitmap.Canvas.CopyRect (Rect (NewFrame.XOffset,
NewFrame.YOffset,
NewFrame.XOffset + NewFrame.Bitmap.Width,
NewFrame.YOffset + NewFrame.Bitmap.Height),
NewFrame.Bitmap.Canvas,
Rect (0,
0,
NewFrame.Bitmap.Width,
NewFrame.Bitmap.Height));
end;
procedure TIpAnimatedGraphic.Draw( ACanvas : TCanvas;
const Rect : TRect);
begin
// Since a TGraphic has no visible portion (for trapping paints) and no
// knowledge of what component owns it, the animation can be tricky. This
// is resolved by "stealing" the canvas from wherever this graphic is going
// to be drawn and then using that canvas for the animation updates.
if AggressiveDrawing then begin
DrawingCanvas := ACanvas;
DrawingRect := Rect;
end;
end;
procedure TIpAnimatedGraphic.FreeAnimationFrames;
begin
Images.ReleaseFrames;
end;
function TIpAnimatedGraphic.GetAnimate : boolean;
begin
result := FAnimate;
end;
function TIpAnimatedGraphic.GetEmpty : Boolean;
begin
result := (Height = 0) or (Width = 0);
end;
function TIpAnimatedGraphic.GetHeight : Integer;
begin
Result := FRealHeight;
end;
function TIpAnimatedGraphic.GetWidth : Integer;
begin
result := FRealWidth;
end;
procedure TIpAnimatedGraphic.Initialize;
begin
// Reset the frame count
NumFrames := 0;
FCurrentFrame := 0;
Animate := False;
// Free up any stray bitmaps
FreeAnimationFrames;
end;
procedure TIpAnimatedGraphic.LoadFromStream (Stream: TStream);
{
LoadFromStream should never be called at this level. The classes that
inherit from this class should implement their own load code.
Should LoadFromStream get called, TIpAnimatedGraphic will create a default
image.
}
begin
{$IFDEF IP_LAZARUS}
if (Stream=nil) then ;
{$ENDIF}
Width := 50;
Height := 50;
Bitmap.Canvas.Brush.Color := clWhite;
Bitmap.Canvas.FillRect (Rect (0, 0, 49, 49));
Bitmap.Canvas.Pen.Color := clRed;
Bitmap.Canvas.TextOut (0, 0, 'X');
end;
procedure TIpAnimatedGraphic.SetAggressiveDrawing (v : Boolean);
begin
if v <> FAggressiveDrawing then
FAggressiveDrawing := v;
end;
procedure TIpAnimatedGraphic.SetAnimate (v : boolean);
begin
if v <> FAnimate then begin
if v then
FAnimate := StartAnimation
else begin
FAnimate := False;
StopAnimation;
end;
end;
end;
procedure TIpAnimatedGraphic.SetBitmap (v : TBitmap);
begin
FBitmap.Assign (v);
end;
procedure TIpAnimatedGraphic.SetDelayTime (v : Integer);
begin
if v <> FDelayTime then
FDelayTime := v;
end;
procedure TIpAnimatedGraphic.SetDestinationCanvas (v : TCanvas);
begin
// Destination Canvas is a weird property. It IS the canvas to which the
// drawing will take place. We use := to assign it.
if v <> FDestinationCanvas then
FDestinationCanvas := v;
end;
procedure TIpAnimatedGraphic.SetDestinationRect (v : TRect);
begin
FDestinationRect := v;
end;
procedure TIpAnimatedGraphic.SetDisposalMethod (v : TDisposalMethod);
begin
if v <> FDisposalMethod then
FDisposalMethod := v;
end;
procedure TIpAnimatedGraphic.SetDrawingCanvas (v : TCanvas);
begin
// Drawing Canvas is a weird property. It IS the canvas to which the drawing
// will take place. We use := to assign it.
if v <> FDrawingCanvas then
FDrawingCanvas := v;
end;
procedure TIpAnimatedGraphic.SetDrawingRect (v : TRect);
begin
// Drawing Rect is a weird property. It IS the rectangle on the canvas to
// hich the drawing will take place. We use := to assign it.
FDrawingRect := v;
end;
procedure TIpAnimatedGraphic.SetFrameChangeNotify (v : Boolean);
begin
if v <> FFrameChangeNotify then
FFrameChangeNotify := v;
end;
procedure TIpAnimatedGraphic.SetHeight(v : Integer);
begin
if v <> FRealHeight then begin
FBitmap.height := v;
FRealHeight := v;
end;
end;
procedure TIpAnimatedGraphic.SetImages (v : TIpAnimationFrameList);
var
i : integer;
begin
FImages.List.Clear;
FImages.List.Capacity := v.List.Capacity;
FImages.List.Count := v.List.Count;
for i := 0 to v.List.Count - 1 do
FImages.List.Add(v.List[i]);
end;
procedure TIpAnimatedGraphic.SetNumFrames (v : Integer);
begin
if v <> FNumFrames then
FNumFrames := v;
end;
procedure TIpAnimatedGraphic.SetWidth(v : Integer);
begin
if v <> FRealWidth then begin
FBitmap.Width := v;
FRealWidth := v;
end;
end;
function TIpAnimatedGraphic.StartAnimation : boolean;
begin
Result := True;
FTimer.Enabled := False;
if NumFrames > 1 then begin
if FDelayTime <= 1 then
FTimer.Interval := 100
else
FTimer.Interval := Images[0].DelayTime * 10;
FTimer.Enabled := True;
end else
Result := False;
end;
procedure TIpAnimatedGraphic.StopAnimation;
begin
FTimer.Enabled := False;
end;
procedure TIpAnimatedGraphic.TimerTimeoutHandler (Sender : TObject);
var
NewFrame : Integer;
CanChange : Boolean;
begin
if NumFrames < 1 then
exit;
FTimer.Enabled := False;
try
NewFrame := FCurrentFrame;
Inc (NewFrame);
if (NewFrame >= NumFrames) then
NewFrame := 0;
CanChange := True;
if Assigned (FOnBeforeFrameChange) then
FOnBeforeFrameChange (self,
FCurrentFrame,
NewFrame,
Images,
CanChange);
if CanChange then
ChangeFrame (NewFrame);
if NumFrames >= 1 then begin
FTimer.Interval := Images[FCurrentFrame].DelayTime * 10;
if FTImer.Interval < 10 then
FTImer.Interval := 50;
end else
FTimer.Interval := 32767;
finally
FTimer.Enabled := True;
end;
end;
end.

746
components/turbopower_ipro/ipconst.pas Normal file
View File

@ -0,0 +1,746 @@
{******************************************************************}
{* IPCONST.PAS - Miscellaneous String Constants *}
{******************************************************************}
{ $Id$ }
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower Internet Professional
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 2000-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* Markus Kaemmerer <mk@happyarts.de> SourceForge: mkaemmerer
*
* ***** END LICENSE BLOCK ***** *)
unit IpConst;
interface
const
IpCRLF = #13#10;
const
ReadLineErr = 8001; {!!.03}
resourcestring
{ General IPRO Errors }
SWinSockErr = 'WinSock Error (%d): %s, on API ''%s''';
SRasErr = 'Ras Error (%d): on API ''%s''';
SActiveErr = 'Cannot set property on an active socket';
SAccessProcErr = 'Win32 error loading ''%s'' pointer: %s';
SNoWinSock2Err = '%s requires WinSock 2, and this system only has WinSock 1';
SNoSockErr = 'Socket not assigned';
SNoStreamErr = 'Stream not assigned';
SNoTimerErr = 'Not enough system timers available';
SIndexErr = 'Index out of range';
SSocksErr = 'SOCKS request refused - %d';
SReadLineErr = 'Received line too long, exceeds MaxLineBuf'; {!!.03}
SNoMemoryStreamErr = 'No Memory Stream assigned';
{ Event log }
SEventConnect = 'Connect: Loc: %s Rem: %s';
SEventDisconnect = 'Close: Loc: %s Rem: %s';
{ Terminal Errors }
SNotEnoughData = 'Not enough data in queue (%s bytes) to satisfy read request (%s bytes)';
SRowColOOR = '%s: either row %d or col %d is out of range';
SRowRowOOR = 'TIpTerminalArray.ScrollRows: either start row %d or end row %d is out of range';
SInvItemSize = 'TIpTerminalArray.GetItemPtr: invalid item size';
SLessZero = '%s: new col count %d is less than zero';
SPosReqd = '%s: count must be positive';
SRowOOR = '%s: row number is out of range';
SInvScrollRow = 'TIpTerminalBuffer.SetScrollRegion: invalid row number(s)';
SCountTooSmall = '%s: new count too small';
{ General WinSock Errors }
SwsaEIntr = 'Interrupted function call';
SwsaEBadF = 'Bad file descriptor';
SwsaEAcces = 'Permission denied';
SwsaEFault = 'Bad address';
SwsaEInval = 'Invalid argument';
SwsaEMFile = 'Too many open files';
SwsaEWouldBlock = 'Resource temporarily unavailable';
SwsaEInProgress = 'Operation now in progress';
SwsaEAlReady = 'Operation already in progress';
SwsaENotSock = 'Socket operation on nonsocket';
SwsaEDestAddrReq = 'Destination address required';
SwsaEMsgSize = 'Message too long';
SwsaEPrototype = 'Protocol wrong type for socket';
SwsaENoProtoOpt = 'Bad protocol option';
SwsaEProtoNoSupport = 'Protocol not supported';
SwsaESocktNoSupport = 'Socket type not supported';
SwsaEOpNotSupp = 'Operation not supported';
SwsaEPfNoSupport = 'Protocol family not supported';
SwsaEAfNoSupport = 'Address family not supported by protocol family';
SwsaEAddrInUse = 'Address already in use';
SwsaEAddrNotAvail = 'Cannot assign requested address';
SwsaENetDown = 'Network is down';
SwsaENetUnreach = 'Network is unreachable';
SwsaENetReset = 'Network dropped connection on reset';
SwsaEConnAborted = 'Software caused connection abort';
SwsaEConnReset = 'Connection reset by peer';
SwsaENoBufs = 'No buffer space available';
SwsaEIsConn = 'Socket is already connected';
SwsaENotConn = 'Socket is not connected';
SwsaEShutDown = 'Cannot send after socket shutdown';
SwsaETooManyRefs = 'Too many references; cannot splice';
SwsaETimedOut = 'Connection timed out';
SwsaEConnRefused = 'Connection refused';
SwsaELoop = 'Too many levels of symbolic links';
SwsaENameTooLong = 'File name too long';
SwsaEHostDown = 'Host is down';
SwsaEHostUnreach = 'No route to host';
SwsaENotEmpty = 'Directory not empty';
SwsaEProcLim = 'Too many processes';
SwsaEUsers = 'Too many users';
SwsaEDQuot = 'Disk quota exceeded';
SwsaEStale = 'Stale NFS file handle';
SwsaERemote = 'Too many levels of remote in path';
SwsaSysNotReady = 'Network subsystem is unavailable';
SwsaVerNotSupported = 'WinSock DLL version not supported';
SwsaNotInitialised = 'Successful WSAStartup not yet performed';
SwsaEDiscOn = 'Graceful shutdown in progress';
SwsaENoMore = 'No more data available';
SwsaECancelled = 'Cancelled';
SwsaEInvalidProcTable = 'Invalid procedure table from service provider';
SwsaEInvalidProvider = 'Invalid service provider version number';
SwsaEProviderFailedInit = 'Unable to initialize a service provider';
SwsaSysCallFailure = 'System call failure';
SwsaService_Not_Found = 'Service not found';
SwsaType_Not_Found = 'Type not found';
Swsa_E_No_More = 'No more data available';
Swsa_E_Cancelled = 'Lookup cancelled';
SwsaERefused = 'Refused';
SwsaHost_Not_Found = 'Host not found';
SwsaTry_Again = 'Nonauthoritative host not found';
SwsaNo_Recovery = 'This is a nonrecoverable error';
SwsaNo_Data = 'Valid name, no data record of requested type';
Swsa_Qos_Receivers = 'At least one Reserve has arrived';
Swsa_Qos_Senders = 'At least one Path has arrived';
Swsa_Qos_No_Senders = 'There are no senders';
Swsa_Qos_No_Receivers = 'There are no receivers';
Swsa_Qos_Request_Confirmed = 'Reserve has been confirmed';
Swsa_Qos_Admission_Failure = 'Error due to lack of resources';
Swsa_Qos_Policy_Failure = 'Rejected for administrative reasons - bad credentials';
Swsa_Qos_Bad_Style = 'Unknown or conflicting style';
Swsa_Qos_Bad_Object = 'Problem filterspec or providerspecific buffer';
Swsa_Qos_Traffic_Ctrl_Error = 'Problem with some part of the flowspec';
Swsa_Qos_Generic_Error = 'General error';
{ HTML Errors}
SHTMLNotContainer = 'Parent is not a container';
SHTMLLineError = 'Error "%s" at line %d, position %d';
SHTMLCharStackOverfl = 'Character stack overflow';
SHTMLTokenStackOverfl = 'Token stack overflow';
SHTMLEncNotSupported = ' encoding not supported';
SHTMLInternal = 'Internal error';
SHTMLNoDataProvider = 'No data provider assigned';
SHTMLResUnavail = 'Resource unavailable:';
SHTMLUnsupProtocol = 'Unsupported protocol in URL:%s';
SHTMLExp = ' expected';
SHTMLDashExp = '- expected';
SHTMLInvType = 'Invalid type specified';
SHTMLUnknownTok = 'Unknown token';
SHTMLInvInt = 'Invalid integer constant';
SHTMLInvAlign = 'Invalid alignment specified';
SHTMLInvValType = 'Invalid value type specified';
SHTMLInvShape = 'Invalid shape specified';
SHTMLInvMethod = 'Invalid method specified';
SHTMLInvDir = 'Invalid dir value specified';
SHTMLInvColor = 'Invalid color constant:';
SHTMLInvFrame = 'Invalid frame specified';
SHTMLInvRule = 'Invalid rule specified';
SHTMLInvScope = 'Invalid scope specified';
SHTMLInvScroll = 'Invalid scrolling specified';
SHTMLDefSubmitCaption = 'Submit';
SHTMLDefResetCaption = 'Reset';
SHTMLDefBrowseCaption = 'Browse...';
SHTMLInvPicture = 'Invalid picture returned'; {!!.02}
SHTMLNoGraphic = 'Picture object contains no graphic object';{!!.02}
SHTMLInvGraphic = 'Invalid graphic returned'; {!!.02}
SHTMLNoGetImage = 'No OnGetImage event handler assigned'; {!!.02}
{ RAS status messages }
SRasOpenPort = 'Open port';
SRasPortOpened = 'Port opened';
SRasConnectDevice = 'Connect device';
SRasDeviceConnected = 'Device connected';
SRasAllDevicesConnected = 'All devices connected';
SRasAuthenticate = 'Authenticate';
SRasAuthNotify = 'Authenticate notify';
SRasAuthRetry = 'Authenticate retry';
SRasAuthCallback = 'Authenticate callback';
SRasAuthChangePassword = 'Authenticate change password';
SRasAuthProject = 'Authenticate project';
SRasAuthLinkSpeed = 'Authenticate link speed';
SRasAuthAck = 'Authenticate acknowledged';
SRasReAuthenticate = 'Re-authenticate';
SRasAuthenticated = 'Authenticated';
SRasPrepareForCallback = 'Prepare for callback';
SRasWaitForModemReset = 'Wait for modem reset';
SRasWaitForCallback = 'Wait for callback';
SRasProjected = 'Projected';
SRasStartAuthentication = 'Start authentication';
SRasCallbackComplete = 'Callback complete';
SRasLogonNetwork = 'Logon network';
SRasSubEntryConnected = 'Sub-entry connected';
SRasSubEntryDisconnected = 'Sub-entry disconnected';
SRasPaused = 'Paused';
SRasInteractive = 'Interactive';
SRasRetryAuthentication = 'Retry authentication';
SRasCallbackSetByCaller = 'Callback set by caller';
SRasPasswordExpired = 'Password expired';
SRasConnected = 'Connected';
SRasDisconnected = 'Disconnected';
{ Ansi Text Stream Errors and Messages }
SNoSeekForRead = 'No seek for read';
SNoSeekForWrite = 'No seek for write';
SCannotWriteToStream = 'Cannot write to stream';
SBadSeekOrigin = 'Invalid seek origin';
SBadLineTerminator = 'Invalid line terminator';
SBadLineLength = 'Invalid line length';
SBadPath = 'Path does not exist';
SStreamCreated = 'Successfully created ';
SStreamCreateError = 'Stream create error ';
SDestroying = 'Destroying';
SAttemptingToRead = 'Attempting to read ';
SAttemptingToWrite = 'Attempting to write ';
SBytesFromStream = ' bytes from stream';
SBytesToStream = ' bytes to stream';
SBytesReadFromStream = ' bytes read from stream';
SBytesWrittenToStream = ' bytes written to stream';
SFileName = ' Filename: ';
SRenamedDiskFileTo = 'Renamed disk file to ';
SSeekingDiskFileTo = 'Seeking disk file to ';
SWriteAfterRename = '***Write after rename';
SOriginFromBegin = 'When origin is soFromBeginning, Offset must be >= 0';
SOriginFromEnd = 'When origin is soFromEnd, Offset must be <= 0';
SMemMapFilenameRequired = 'You must specify a file name for TIpMemMapStream';
SMemMapMustBeClosed = 'The %s method requires the TIpMemMapStream instance to be closed';
SMemMapMustBeOpen = 'The %s method requires the TIpMemMapStream instance to be opened';
{ Mime message class errors and messages }
SBadOffset = 'Invalid stream offset';
SNoBoundary = 'No Mime boundary';
SListNotAssigned = 'List not assigned';
SBinHexBadFormat = 'Invalid BinHex format';
SBinHexColonExpected = '":" expected';
SBinHexBadChar = 'Invalid BinHex character';
SBinHexOddChar = 'One odd character';
SBinHexBadHeaderCRC = 'Bad header CRC';
SBinHexBadDataCRC = 'Bad header CRC';
SBinHexLengthErr = 'Invalid data length';
SBinHexResourceForkErr = 'Resource fork present';
SUUEncodeCountErr = 'Count <> Len or Count > 63';
SLineLengthErr = 'Invalid line length for encoded text'; {!!.01}
SUnsupportedEncoding = 'Encoding method not supported'; {!!.01}
{ ICMP errors and messages }
SIpICMP_SUCCESS = 'Successful';
SIpICMP_BUF_TOO_SMALL = 'Buffer too small';
SIpICMP_DEST_NET_UNREACHABLE = 'Destination network unreachable';
SIpICMP_DEST_HOST_UNREACHABLE = 'Destination host unreachable';
SIpICMP_DEST_PROT_UNREACHABLE = 'Destination protocol unreachable';
SIpICMP_DEST_PORT_UNREACHABLE = 'Destination port unreachable';
SIpICMP_NO_RESOURCES = 'Destination does not have resources to complete';
SIpICMP_BAD_OPTION = 'Bad option';
SIpICMP_HW_ERROR = 'Hardware error';
SIpICMP_PACKET_TOO_BIG = 'Packet too large';
SIpICMP_REQ_TIMED_OUT = 'Request timed out';
SIpICMP_BAD_REQ = 'Bad request';
SIpICMP_BAD_ROUTE = 'Bad route';
SIpICMP_TTL_EXPIRED_TRANSIT = 'Time to live expired during transmit';
SIpICMP_TTL_EXPIRED_REASSEM = 'Time to live expired during reassembly';
SIpICMP_PARAM_PROBLEM = 'Parameter problem';
SIpICMP_SOURCE_QUENCH = 'Destination is busy';
SIpICMP_OPTION_TOO_BIG = 'Option too large';
SIpICMP_BAD_DESTINATION = 'Bad destination';
SIpICMP_Unknown = 'Unknown status';
SlogIcmpClass = '[ICMP] ';
SIcmpEcho = 'Echo reply (Hop number: %d)'+ IpCRLF +
' Status = %d' + IpCRLF +
' RTTime = %d' + IpCRLF +
' Ttl = %d' + IpCRLF +
' Tos = %d' + IpCRLF +
' IpFlags = %d';
SIcmpEchoString = 'Echo string: %s';
SIcmpPingStart = 'Pinging %s with %d bytes data';
SIcmpTraceStart = 'Trace to %s started';
SIcmpTraceComplete = 'Trace complete (%s), %d hops';
SIcmpThreadExecute = 'Thread %d executing (Hop number = %d)';
SIcmpThreadTerminate = 'Thread %d terminating (Hop number = %d)';
{ Internet Messaging errors and messages }
{ TIpSmtpClient }
{ State descriptions }
SWrongStateErr = 'Can not comply, wrong state';
SNoRecipients = 'No recipients specified';
SInvalRespCode = 'Invalid response code';
SssNoOp = 'No operation';
SssConnect = 'Connecting';
SssEhlo = 'Logging on with EHLO';
SssHelo = 'Logging on with HELO';
SssMailFrom = 'Sending sender''s info';
SssRcptTo = 'Sending MailTo info';
SssRcptCc = 'Sending CC info';
SssRcptBcc = 'Sending BCC info';
SssData = 'Sending Data';
SssRSet = 'Resetting server';
SssSend = 'ssSend';
SssSoml = 'ssSoml';
SssSaml = 'ssSaml';
SssVerify = 'Verifying';
SssExpand = 'Expanding';
SssHelp = 'Help';
SssTurn = 'ssTurn';
SssQuit = 'Quit';
SssSendEnvelope = 'Sending Envelope';
SssSendMessage = 'Sending Message';
SssSpecial = 'Sending special command';
SssAuthLogin = 'Requesting authentication'; {!!.12}
SssAuthUser = 'Authenticating username'; {!!.12}
SssAuthPass = 'Authenticating password'; {!!.12}
{ Task descriptions }
SstNoTask = 'None';
SstLogon = 'Logging on';
SstSendMail = 'Sending mail';
SstError = 'An error has occured during this task.'; {!!.11}
{ SMTP response codes, used by the TIpSmtpClient.ResultMsg method }
SSmtpResponse02 = 'Success, ';
SSmtpResponse04 = 'Transient, ';
SSmtpResponse05 = 'Persistent, ';
SSmtpResponse10 = 'Other address status';
SSmtpResponse11 = 'Bad destination mailbox address';
SSmtpResponse12 = 'Bad destination system address';
SSmtpResponse13 = 'Bad destination mailbox address syntax';
SSmtpResponse14 = 'Destination mailbox address ambiguous';
SSmtpResponse15 = 'Destination mailbox address valid';
SSmtpResponse16 = 'Mailbox has moved';
SSmtpResponse17 = 'Bad sender''s mailbox address syntax';
SSmtpResponse18 = 'Bad sender''s system address';
SSmtpResponse20 = 'Other or undefined mailbox status';
SSmtpResponse21 = 'Mailbox disabled, not accepting messages';
SSmtpResponse22 = 'Mailbox full';
SSmtpResponse23 = 'Message length exceeds administrative limit.';
SSmtpResponse24 = 'Mailing list expansion problem';
SSmtpResponse30 = 'Other or undefined mail system status';
SSmtpResponse31 = 'Mail system full';
SSmtpResponse32 = 'System not accepting network messages';
SSmtpResponse33 = 'System not capable of selected features';
SSmtpResponse34 = 'Message too big for system';
SSmtpResponse40 = 'Other or undefined network or routing status';
SSmtpResponse41 = 'No answer from host';
SSmtpResponse42 = 'Bad connection';
SSmtpResponse43 = 'Routing server failure';
SSmtpResponse44 = 'Unable to route';
SSmtpResponse45 = 'Network congestion';
SSmtpResponse46 = 'Routing loop detected';
SSmtpResponse47 = 'Delivery time expired';
SSmtpResponse50 = 'Other or undefined protocol status';
SSmtpResponse51 = 'Invalid command';
SSmtpResponse52 = 'Syntax error';
SSmtpResponse53 = 'Too many recipients';
SSmtpResponse54 = 'Invalid command arguments';
SSmtpResponse55 = 'Wrong protocol version';
SSmtpResponse60 = 'Other or undefined media error';
SSmtpResponse61 = 'Media not supported';
SSmtpResponse62 = 'Conversion required and prohibited';
SSmtpResponse63 = 'Conversion required but not supported';
SSmtpResponse64 = 'Conversion with loss performed';
SSmtpResponse65 = 'Conversion failed';
SSmtpResponse70 = 'Other or undefined security status';
SSmtpResponse71 = 'Delivery not authorized, message refused';
SSmtpResponse72 = 'Mailing list expansion prohibited';
SSmtpResponse73 = 'Security conversion required but not possible';
SSmtpResponse74 = 'Security features not supported';
SSmtpResponse75 = 'Cryptographic failure';
SSmtpResponse76 = 'Cryptographic algorithm not supported';
SSmtpResponse77 = 'Message integrity failure';
SSmtpResponseUnknown = 'Unknown response code';
SSmtpResponseSubUnknown = 'Unknown subcode';
SLogSmtpClass = '[SMTP] ';
SLogMultiLine = 'Generating OnMultiLineResponse event';
SLogResponse = 'Generating OnResponse event, Code = ';
SLogSmtpNextMessage = 'Generating OnNextMessage event';
SLogEncodeActionStart = 'Generating OnEncodeAction(Start)';
SLogEncodeActionStop = 'Generating OnEncodeAction(Stop)';
SLogTaskComplete = 'Generating OnTaskComplete event ';
SLogTaskStart = 'Starting task: ';
SLogNextMessageReady = 'Next message ready';
SLogNextMessageNotReady = 'Next message not ready';
SLogssNoOp = ' (ssNoOp)';
SLogssConnect = ' (ssConnect)';
SLogEhlo = ' (ssEhlo)';
SLogHelo = ' (ssHelo)';
SLogMailFrom = ' (ssMailFrom)';
SLogRcptTo = ' (ssRcptTo)';
SLogRcptCc = ' (ssRcptCc)';
SLogRcptBcc = ' (ssRcptBcc)';
SLogData = ' (ssData)';
SLogRSet = ' (ssRSet)';
SLogSend = ' (ssSend)';
SLogSoml = ' (ssSoml)';
SLogSaml = ' (ssSaml)';
SLogVerify = ' (ssVerify)';
SLogExpand = ' (ssExpand)';
SLogHelp = ' (ssHelp)';
SLogTurn = ' (ssTurn)';
SLogQuit = ' (ssQuit)';
SLogSendEnvelope = ' (ssSendEnvelope)';
SLogSendMessage = ' (ssSendMessage)';
SLogSpecial = ' (ssSpecial)';
SLogAuthLogin = ' (ssAuthLogin)'; {!!.12}
SLogAuthUser = ' (ssAuthUser)'; {!!.12}
SLogAuthPass = ' (ssAuthPass)'; {!!.12}
SLogstNoTask = ' (stNoTask)';
SLogstLogon = ' (stLogon)';
SLogstSendMail = ' (stSendMail)';
{ TIpPop3Client }
SPop3OKResp = '+OK';
SPop3ErrResp = '-ERR';
SPop3NotTransacting = '%s can not be called in authentication state';
SPop3NotAuthenticating = '%s can not be called in transaction state';
SPop3CmdApop = 'APOP';
SPop3CmdTop = 'TOP';
SPop3CmdList = 'LIST';
SPop3CmdRset = 'RSET';
SPop3CmdRetr = 'RETR';
SPop3CmdDele = 'DELE';
SPop3CmdPass = 'PASS';
SPop3CmdQuit = 'QUIT';
SPop3CmdStat = 'STAT';
SPop3CmdUidl = 'UIDL';
SPop3CmdUser = 'USER';
SPop3CmdNoOp = 'NOOP';
SpsNoOp = 'No operation';
SpsConnect = 'Connecting to server';
SpsUser = 'Logging on with User';
SpsPass = 'Logging on with Password';
SpsStat = 'Retrieving mailbox status';
SpsList = 'Retrieving mailbox list';
SpsRetr = 'Retrieving message';
SpsDele = 'Marking message for deletion';
SpsRset = 'Resetting messages';
SpsApop = 'Logging on with APOP';
SpsTop = 'Retrieving top of message';
SpsUidl = 'Retrieving mailbox UID list';
SpsQuit = 'Disconnecting';
SpsSpecial = 'Special command';
SpsUnknown = 'Unknown state';
SptNone = 'No task';
SptLogon = 'Logging on';
SptList = 'Retrieving mailbox list';
SptUIDL = 'Retrieving mailbox UID list';
SptError = 'An error occured with the last task.'; {!!.11}
SptUnknown = 'Unknown task';
SLogPop3Class = '[POP3] ';
SLogState = 'State change: ';
sLogptNone = ' (ptNone)';
sLogptLogon = ' (ptLogon)';
sLogptList = ' (ptList)';
sLogptUIDL = ' (ptUIDL)';
SLogpsNoOp = ' {psNoOp)';
SLogpsConnect = ' (psConnect)';
SLogpsUser = ' (psUser)';
SLogpsPass = ' (psPass)';
SLogpsStat = ' (psStat)';
SLogosList = ' (psList)';
SLogpsRetr = ' (psRetr)';
SLogpsDele = ' (psDele)';
SLogpsRSet = ' (psRSet)';
SLogpsApop = ' (psApop)';
SLogpsTop = ' (psTop)';
SLogpsUidl = ' (psUidl)';
SLogpsQuit = ' (psQuit)';
SLogpsSpecial = ' (psSpecial)';
SLogPop3Message= 'Generating OnMessage event';
SLogPop3Top = 'Generating OnTop event';
{ TIpNntpClient }
SNntpCmdArticle = 'ARTICLE';
SNntpCmdAuthPass = 'AUTHINFO PASS';
SNntpCmdAuthUser = 'AUTHINFO USER';
SNntpCmdBody = 'BODY';
SNntpCmdHead = 'HEAD';
SNntpCmdStat = 'STAT';
SNntpCmdDate = 'DATE';
SNntpCmdGroup = 'GROUP';
SNntpCmdHelp = 'HELP';
SNntpCmdLast = 'LAST';
SNntpCmdList = 'LIST';
SNntpCmdListActTimes = 'LIST ACTIVE.TIMES';
SNntpCmdListDistribPats = 'LIST DISTRIB.PATS';
SNntpCmdListDistrib = 'LIST DISTRIBUTIONS';
SNntpCmdListNewsgroups = 'LIST NEWSGROUPS';
SNntpCmdListOverFmt = 'LIST OVERVIEW.FMT';
SNntpCmdListGroup = 'LISTGROUP';
SNntpCmdNewGroups = 'NEWGROUPS';
SNntpCmdNewNews = 'NEWNEWS';
SNntpCmdNext = 'NEXT';
SNntpCmdXOver = 'XOVER'; {!!.12}
SNntpCmdPat = 'PAT';
SNntpCmdPost = 'POST';
SNntpCmdQuit = 'QUIT';
SNntpCmdListExt = 'LIST EXTENSIONS';
SnsNoOp = 'No operation';
SnsConnect = 'Connecting';
SnsNewGroups = 'Getting new news groups';
SnsNewNews = 'Getting new articles';
SnsArticle = 'Retrieving article';
SnsStat = 'Retrieving status';
SnsBody = 'Retrieving body';
SnsHead = 'Retrieving heading';
SnsGroup = 'Selecting group';
SnsList = 'Retrieving list';
SnsLast = 'Selecting previous article';
SnsNext = 'Selecting next article';
SnsPrePost = 'Preparing to post article';
SnsPost = 'Posting article';
SnsQuit = 'Disconnecting';
SnsHelp = 'Retrieving help';
SnsSpecial = 'Sending special command';
SnsAuthUser = 'Authorizing user';
SnsAuthPass = 'Authorizing password';
SnsListExt = 'Retrieving list of extended commands';
SnsListActiveTimes = 'Retrieving active times';
SnsListDistributions = 'Retrieving list of distributions';
SnsListDistribPats = 'Retrieving distribution patterns';
SnsListNewsGroups = 'Retrieving list of available news groups';
SnsListOverviewFmt = 'Retrieving overview format';
SnsListGroup = 'Retrieving article numbers';
SnsOver = 'Retrieving overview';
SnsPat = 'Retrieving patterns';
SnsDate = 'Retrieving server date';
SntNoTask = 'No task';
SntAuthenticate = 'Authenticating';
SntSelectGroup = 'Selecting Group';
SntNewNews = 'Retrieving new news';
SntPostTo = 'Posting article';
SLogNntpClass = '[NNTP] ';
SLogArticle = 'Generating OnArticle event';
SLogntNoTask = ' (ntNoTask)';
SLogntAuthenticate = ' (ntAuthenticate)';
SLogntSelectGroup = ' (ntSelectGroup)';
SLogntNewNews = ' (ntNewNews)';
SLogntPostTo = ' (ntPostTo)';
SLognsNoOp = ' (nsNoOp)';
SLognsConnect = ' (nsConnect)';
SLognsNewGroups = ' (nsNewGroups)';
SLognsNewNews = ' (nsNewNews)';
SLognsArticle = ' (nsArticle)';
SLognsStat = ' (nsStat)';
SLognsBody = ' (nsBody)';
SLognsHead = ' (nsHead)';
SLognsGroup = ' (nsGroup)';
SLognsList = ' (nsList)';
SLognsLast = ' (nsLast)';
SLognsNext = ' (nsNext)';
SLognsPrePost = ' (nsPrePost)';
SLognsPost = ' (nsPost)';
SLognsQuit = ' (nsQuit)';
SLognsHelp = ' (nsHelp)';
SLognsSpecial = ' (nsSpecial)';
SLognsAuthUser = ' (nsAuthUser)';
SLognsAuthPass = ' (nsAuthPass)';
SLognsListExt = ' (nsListExt)';
SLognsListActiveTimes = ' (nsListActiveTimes)';
SLognsListDistributions = ' (nsListDistributions)';
SLognsListDistribPats = ' (nsListDistribPats)';
SLognsListNewsGroups = ' (nsListNewsGroups)';
SLognsListOverviewFmt = ' (nsListOverviewFmt)';
SLognsListGroup = ' (nsListGroup)';
SLognsOver = ' (nsOver)';
SLognsPat = ' (nsPat)';
SLognsDate = ' (nsDate)';
{ TIpHttpClient }
HttpConnect = 'Connected: (%s)';
HttpDisconnect = 'Disconnected: (%s), %s Total bytes received';
HttpProgress = 'Progress Made: (%s), %s bytes received';
HttpGet = 'GET: (%s)';
HttpGetError = 'GET: (%s) FAILED';
HttpHead = 'HEAD: (%s)';
HttpHeadError = 'HEAD: (%s) FAILED';
HttpPost = 'POST: (%s)';
HttpPostError = 'POST: (%s) FAILED';
HttpDownload = 'Download: (%s), Error downloading';
HttpSizeMismatch = 'Download: (%s), Size Mismatch expecting %s , got %s';
HttpGotHeader = 'Download: (%s), Got Header Data';
HttpCantLoadGraphic = 'Unable to load graphic %s';
HttpNoHeaderData = 'No Header Data for Entity';
{ TIpCache }
CacheDirNotExist = 'Cache directory %s does not exist.';
CacheAdding = 'Caching item (%s = %s)';
CacheRetrieving = 'Loading from Cache (%s = %s)';
CacheCheckFreshness = 'Checking Freshness (%s)';
{ TIpCustomHtmlDataProvider }
ProviderUnknownPicture = 'Invalid picture format';
ProviderUnknownFormat = 'Don''t know how to handle %s';
ProviderUnknownRequest = 'Unknown request type "%s"';
{ TIpAnimationFrameList }
sBadFrameListObject = 'Unrecognized object of class %s in GIF Frame List';
{ TIpAnimatedImageLibImage }
sBadImageLibFileFormat = 'Unrecognized file format';
sBadImageLibStream = 'ImageLib must use TMemoryStreams';
{ TIpPNGImage }
sPNGBadPixelDepth = 'Unrecognized pixel depth of %d';
sPNGMissingIHDR = 'IHDR Chunk is missing';
sPNGChunkIDAndLength = 'PNG Chunk: %s Length: %d';
sPNGMissingIEND = 'End of PNG found with no IEND chunk';
sPNGEffectiveFilter = 'Effective filter is %s';
sPNGBadInterlaceMethod = 'Unrecognized Interlace Method';
sPNGDefilterPass = 'Unfilering Pass %d Size: %dx%d From: %dx%d';
sPNGFilterChange = 'Filter changed on Row %d to %x';
sPNGBadColorType = 'Unrecognized color type of %d';
sPNGErrorConstant = '**** ERROR ****';
sPNGWarningConstant = '**** WARNING ****';
sPNGBadBitDepth = 'Unsupported Bit Depth of %d';
sPNGBadChunkType = 'Unrecognized Chunk Type: %s';
sPNGBadSignature = 'Invalid PNG Signature';
sPNGNoClipboard = 'PNG Clipboard support is not supported.';
sPNGUnsupportedFeature = 'A %s chunk was found in the PNG File. ' +
'This feature is not ' +
'supported in this version of the PNG decoder';
sPNGBufferTooSmall = 'PNG Buffer too small.';
sPNGMemoryRequired = 'Memory required for image: %d bytes';
sPNGGAMATooLong = 'gAMA chunk is long';
sPNGGAMATooShort = 'gAMA chunk is short';
sPNGGammaCorrection = 'Gamma Correction: %f';
sPNGIHDRTooLong = 'IHDR chunk is long.';
sPNGIHDRTooShort = 'IHDR chunk is short.';
sPNGImageSize = 'Image size is %dx%d pixels';
sPNGBitDepth = 'Bit Depth: %d';
sPNGColorType = 'Color Type: %d';
sPNGCOmpressionMethod = 'Compression Method: %d';
sPNGFilterMethod = 'Filter Method: %d';
sPNGInterlaceMethod = 'Interlace Method: %d';
sPNGBadPaletteLength = 'Invalid Palette Length';
sPNGPaletteTooLong = 'Too many palette entries';
sPNGPaletteEntry = 'Palette Entry %d - Red: %d Green: %d Blue: %d';
sPNGTimeTooLong = 'tIME chunk is long.';
sPNGTimeTooShort = 'tIME chunk is short.';
sPNGModificationDate = 'Modification Date: %s';
sPNGBadModificationTime = 'Invalid Modification Time';
sPNGPaletteTransparency = 'Palette Transparency: %d Alpha %d';
sPNGTransparentColor = 'Transparent Color: %x';
sPNGTruncatedData = 'Chunk data is truncated';
sPNGTruncatedCRC = 'CRC Code is truncated';
sPNGCannotSave = 'PNG Saving is not supported';
{ TIpWebImageAccess }
sWebImageNotFound = '%s was not found';
sWebImageCannotLoad = 'Cannot load %s';
sWebImageStreamBad = 'Cannot load image from stream';
{ TIpFtpClient }
sFtpOpen = 'Connected to ';
sFtpClose = 'Disconnected';
sFtpLogin = ' logged in';
sFtpLogout = ' logged out';
sFtpDelete = 'Deleting ';
sFtpRename = 'Renaming ';
sFtpRetrieve = 'Retrieving ';
sFtpStore = 'Storing ';
sFtpComplete = 'Transfer complete. ';
sFtpBytesTransferred = ' bytes Transferred';
sFtpRestart = 'Attempting to re-start transfer of ';
sFtpTimeout = 'Transfer timed out';
sFtpUserAbort = 'Transfer aborted by user';
{ Broker classes }
sBrokerDownloadReq = 'Download %s?';
sBrokerDownloadTitle = 'Download?';
{RSA}
sBIBufferNotAssigned = 'Buffer not assigned';
{ SSL }
sSSLNoCertificate = 'Certificate is not available.';
sSSLUnsupportedEncoding = 'Unsupported public encoding.';
sSSLUnsupportedChiper = 'Unsupported cipher chosen.';
sSSLBadPublicEncoding = 'Bad public encoding type.';
sSSLPaddingError = 'Padding error.';
sSSLParserError = 'Parsing error.';
sSSLInvalidCipher = 'Invalid cipher.';
sSSLCloseNotify = 'Server sent close notify.';
sSSLUnexpectedMessage = 'Server received an unexpected message.';
sSSLBadRecordMac = 'Server received a bad record MAC.';
sSSLCompressionFailure = 'Compression failure.';
sSSLHandShakeFailure = 'Handshake failure.';
sSSLBadCertificate = 'Bad certificate.';
sSSLUnsupportedCertificate = 'Unsupported Certificate.';
sSSLRevokedCertificate = 'Revoked Certificate.';
sSSLExpiredCertificate = 'Expired Certificate.';
sSSLUnknownCertificate = 'Unknown Certificate.';
sSSLIllegalParameter = 'Illegal Parameter.';
sSSLReadSizeMissMatch = 'Read size miss-match.';
sSSLReadError = 'Read error.';
sSSLPointerNotAssigned = 'Pointer not assigned.';
sSSLFailedhelloParse = 'Did not parse server hello correctly.';
sSSLEncryptionType = 'Encryption type not defined.';
sSSLBlockSizeError = 'Block size error';
sSSLServerNoHandShake = 'Server cid not return a handshake message.';
sSSLServerNoServerHello = 'Server cid not return a server hello message.';
sSSLBadCompressionValue = 'Compression value is wrong.';
sSSLBadCertType = 'Cert type not found';
sSSLBadKeyExchangeType = 'Key exchange message expected but not received';
sSSLBufferOverFlow = 'Buffer overflow error.';
sSSLNoHashType = 'No hash type selected.';
sSSLNoMessageEncSlected = 'No message encoding type selected.';
sSSLBadMac = 'MAC did not match.';
sSSLSessIDToLong = 'Session ID is longer than 32 bytes.';
sSSLBadMD5Hash = 'MD5 hash did not match.';
sSSLBadSHA1Hash = 'SHA1 hash did not match.';
sSSLEncryptBuf2Small = 'Encrypt buffer to small.';
sSSLSHAbuf2Small = 'SHA1 buffer to small.';
sSSLBufferSizeMissMatch = 'Buffer size miss-match.';
sSSLNotEnoughKeyMaterail = 'Not enough key material.';
SSLNoPreMasterSecret = 'No pre-master secret.';
sSSLNoRoom = 'Not enough memory available to read SSL record.';
sSSLUnprocessedData = 'SSL data processing error.';
sSSLConnectChange = 'Can not change SSL status while connected.';
implementation
{
$Log$
Revision 1.1 2003/03/27 18:25:34 mattias
added ipro html components, compilable but not yet working
Revision 1.2 2003/02/17 21:24:50 mkaemmerer
- added SNoMemoryStreamErr
}
end.

17469
components/turbopower_ipro/iphtml.pas Normal file
View File

File diff suppressed because it is too large Load Diff

315
components/turbopower_ipro/iphtmlpv.pas Normal file
View File

@ -0,0 +1,315 @@
{******************************************************************}
{* IPHTMLPV.PAS - HTML Browser Print Preview *}
{******************************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower Internet Professional
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 2000-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{ Global defines potentially affecting this unit }
{$I IPDEFINE.INC}
unit IpHtmlPv;
interface
uses
{$IFDEF IP_LAZARUS}
LCLType,
GraphType,
LCLLinux,
Buttons,
{$ELSE}
Windows,
{$ENDIF}
Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, IpHtml;
type
TIpHTMLPreview = class(TForm)
Label3: TLabel;
ZoomCombo: TComboBox;
PaperPanel: TPanel;
PaintBox1: TPaintBox;
procedure btnNextClick(Sender: TObject);
procedure btnLastClick(Sender: TObject);
procedure edtPageChange(Sender: TObject);
procedure btnPrintClick(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ZoomComboChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
published
Panel1: TPanel;
btnPrint: TButton;
btnFirst: TButton;
btnPrev: TButton;
btnNext: TButton;
btnLast: TButton;
btnClose: TButton;
edtPage: TEdit;
Label1: TLabel;
Label2: TLabel;
lblMaxPage: TLabel;
ScrollBox1: TScrollBox;
procedure FormShow(Sender: TObject);
procedure btnFirstClick(Sender: TObject);
procedure btnPrevClick(Sender: TObject);
procedure SetCurPage(const Value: Integer);
protected
FClipRect, SourceRect: TRect;
Scratch: TBitmap;
FScale: double;
FZoom: Integer;
procedure SetZoom(const Value: Integer);
procedure ResizeCanvas;
procedure ScaleSourceRect;
procedure AlignPaintBox;
procedure Render;
public
FCurPage: Integer;
HTML : TIpHtml;
PageRect: TRect;
OwnerPanel: TIpHtmlInternalPanel;
property ClipRect: TRect read FClipRect write FClipRect;
property CurPage: Integer read FCurPage write SetCurPage;
procedure RenderPage(PageNo: Integer);
property Zoom: Integer read FZoom write SetZoom;
property Scale: double read FScale;
end;
implementation
{$IFNDEF IP_LAZARUS}
uses
Printers;
{$R *.DFM}
{$ENDIF}
const
SCRATCH_WIDTH = 800; //640;
SCRATCH_HEIGHT = 600; //480;
procedure TIpHTMLPreview.FormShow(Sender: TObject);
begin
Zoom := 100;
ResizeCanvas;
RenderPage(CurPage);
end;
procedure TIpHTMLPreview.RenderPage(PageNo: Integer);
var
CR : TRect;
begin
CR := Rect(0, 0, OwnerPanel.PrintWidth, 0);
CR.Top := (PageNo - 1) * OwnerPanel.PrintHeight;
CR.Bottom := Cr.Top + OwnerPanel.PrintHeight;
PageRect := CR;
PaintBox1.Invalidate;
end;
procedure TIpHTMLPreview.btnFirstClick(Sender: TObject);
begin
CurPage := 1;
end;
procedure TIpHTMLPreview.btnPrevClick(Sender: TObject);
begin
CurPage := CurPage - 1;
end;
procedure TIpHTMLPreview.SetCurPage(const Value: Integer);
begin
if (Value <> FCurPage)
and (Value >= 1)
and (Value <= OwnerPanel.PageCount) then begin
FCurPage := Value;
RenderPage(Value);
edtPage.Text := IntToStr(CurPage);
end;
end;
procedure TIpHTMLPreview.btnNextClick(Sender: TObject);
begin
CurPage := CurPage + 1;
end;
procedure TIpHTMLPreview.btnLastClick(Sender: TObject);
begin
CurPage := OwnerPanel.PageCount;
end;
procedure TIpHTMLPreview.edtPageChange(Sender: TObject);
begin
CurPage := StrToInt(edtPage.Text);
end;
procedure TIpHTMLPreview.btnPrintClick(Sender: TObject);
begin
Screen.Cursor := crHourglass;
ScaleFonts := False;
try
OwnerPanel.PrintPages(1, OwnerPanel.PageCount);
finally
ScaleFonts := True;
Screen.Cursor := crDefault;
end;
end;
procedure TIpHTMLPreview.ScaleSourceRect;
begin
SourceRect.Left := round(SourceRect.Left / Scale);
SourceRect.Top := round(SourceRect.Top / Scale);
SourceRect.Right := round(SourceRect.Right / Scale);
SourceRect.Bottom := round(SourceRect.Bottom / Scale);
end;
procedure TIpHTMLPreview.Render;
var
TTop, TLeft,
WindowTop, WindowLeft: Integer;
R: TRect;
begin
{GDI won't let us create a bitmap for a whole page
since it would become too big for large resolutions,
so we have to do banding by hand}
Screen.Cursor := crHourglass;
try
PaintBox1.Canvas.Brush.Color := clWhite;
PaintBox1.Canvas.FillRect(PaintBox1.Canvas.ClipRect);
WindowTop := SourceRect.Top;
TTop := 0;
while WindowTop < SourceRect.Bottom do begin
WindowLeft := SourceRect.Left;
TLeft := 0;
while WindowLeft < SourceRect.Right do begin
R.Left := WindowLeft;
R.Top := WindowTop;
R.Right := R.Left + SCRATCH_WIDTH + 1;
R.Bottom := R.Top + SCRATCH_HEIGHT + 1;
HTML.Render(Scratch.Canvas, R, False, Point(0, 0));
R.Left := PaintBox1.Canvas.ClipRect.Left + round(TLeft * Scale);
R.Top := PaintBox1.Canvas.ClipRect.Top + round(TTop * Scale);
R.Right := R.Left + round(SCRATCH_WIDTH * Scale) + 1;
R.Bottom := R.Top + round(SCRATCH_HEIGHT * Scale) + 1;
PaintBox1.Canvas.StretchDraw(R, Scratch);
inc(WindowLeft, SCRATCH_WIDTH);
inc(TLeft, SCRATCH_WIDTH);
end;
inc(WindowTop, SCRATCH_HEIGHT);
inc(TTop, SCRATCH_HEIGHT);
end;
finally
Screen.Cursor := crDefault;
end;
end;
procedure TIpHTMLPreview.PaintBox1Paint(Sender: TObject);
begin
SourceRect := PaintBox1.Canvas.ClipRect;
ScaleSourceRect;
ClipRect := SourceRect;
OffsetRect(SourceRect, 0, PageRect.Top);
Render;
end;
procedure TIpHTMLPreview.FormDestroy(Sender: TObject);
begin
Scratch.Free;
end;
procedure TIpHTMLPreview.ZoomComboChange(Sender: TObject);
var
S: string;
begin
with ZoomCombo do
S := Items[ItemIndex];
Zoom := StrToInt(copy(S, 1, length(S) - 1));
end;
procedure TIpHTMLPreview.FormCreate(Sender: TObject);
begin
ZoomCombo.ItemIndex := 4;
Scratch := TBitmap.Create;
Scratch.Width := SCRATCH_WIDTH;
Scratch.Height := SCRATCH_HEIGHT;
end;
procedure TIpHTMLPreview.SetZoom(const Value: Integer);
var
Scale1, Scale2, Scale0: double;
begin
FZoom := Value;
Scale1 := Double(ClientHeight)
/ {$IFDEF IP_LAZARUS}500{$ELSE}Printer.PageHeight{$ENDIF};
Scale2 := Double(ClientWidth)
/ {$IFDEF IP_LAZARUS}500{$ELSE}Printer.PageWidth{$ENDIF};
if Scale1 < Scale2 then
Scale0 := Scale1
else
Scale0 := Scale2;
FScale := Scale0 * FZoom / 100;
ResizeCanvas;
AlignPaintBox;
end;
procedure TIpHTMLPreview.ResizeCanvas;
begin
ScrollBox1.HorzScrollBar.Position := 0;
ScrollBox1.VertScrollBar.Position := 0;
PaperPanel.Width := round({$IFDEF IP_LAZARUS}500{$ELSE}Printer.PageWidth{$ENDIF} * Scale);
PaperPanel.Height := round({$IFDEF IP_LAZARUS}500{$ELSE}Printer.PageHeight{$ENDIF} * Scale);
PaintBox1.Width := round(OwnerPanel.PrintWidth * Scale);
PaintBox1.Height := round(OwnerPanel.PrintHeight * Scale);
PaintBox1.Left := round(OwnerPanel.PrintTopLeft.x * Scale);
PaintBox1.Top := round(OwnerPanel.PrintTopLeft.y * Scale);
AlignPaintBox;
end;
procedure TIpHTMLPreview.AlignPaintBox;
begin
if PaperPanel.Width < ClientWidth then
PaperPanel.Left := ClientWidth div 2 - (PaperPanel.Width div 2)
else
PaperPanel.Left := 0;
if PaperPanel.Height < ClientHeight then
PaperPanel.Top := ClientHeight div 2 - (PaperPanel.Height div 2)
else
PaperPanel.Top := 0;
end;
procedure TIpHTMLPreview.FormResize(Sender: TObject);
begin
SetZoom(Zoom); {force recalc of preview sizes}
end;
end.

3947
components/turbopower_ipro/ipmsg.pas Normal file
View File

File diff suppressed because it is too large Load Diff

1799
components/turbopower_ipro/ipstrms.pas Normal file
View File

File diff suppressed because it is too large Load Diff

2779
components/turbopower_ipro/iputils.pas Normal file
View File

File diff suppressed because it is too large Load Diff