paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-25 18:42:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

TurboPower_iPro: Remove Delphi compatibility {$ifdef IP_LAZARUS}. Did not work with Delphi anyways. Issue #37990, patch from Zaher Dirkey.

Browse Source 
git-svn-id: trunk@64097 -
This commit is contained in:
juha 2020-11-01 10:37:53 +00:00
parent 9f72483225
commit d75f2eda2b
12 changed files with 198 additions and 1219 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
components/turbopower_ipro/examples/htmfileexp1.pas
View File

@ -3,23 +3,14 @@ unit HtmFileExp1;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{.$define UsePreview} {.$define UsePreview}
{$IFDEF LCL}
{$DEFINE IP_LAZARUS}
{$ENDIF}
interface interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
{$IFDEF IP_LAZARUS} {$ifdef UsePreview}
{$ifdef UsePreview} OsPrinters,
OsPrinters, {$endif}
{$endif}
{$ELSE}
GIFImage,
JPeg,
ImageDLLLoader, PNGLoader, LinarBitmap, //from ImageFileLib of Michael Vinther: http://www.logicnet.dk/lib/
{$ENDIF}
IpUtils, IpHtml, ExtCtrls, StdCtrls, FileUtil; IpUtils, IpHtml, ExtCtrls, StdCtrls, FileUtil;
type type
@ -123,10 +114,6 @@ procedure TFHtmFileExp1.HTMLGetImageX(Sender: TIpHtmlNode; const URL: string;
var var
PicCreated: Boolean; PicCreated: Boolean;
FN, nURL: string; FN, nURL: string;
{$IFNDEF IP_LAZARUS}
Ext: string;
BitMap: Graphics.TBitMap;
{$ENDIF}
begin begin
PicCreated := False; PicCreated := False;
try try
@ -139,15 +126,10 @@ begin
FN := Concat (FN, nURL); FN := Concat (FN, nURL);
if FileExistsUTF8(FN) then begin if FileExistsUTF8(FN) then begin
if Picture = nil then begin if Picture = nil then begin
Picture := TPicture.Create; Picture := TPicture.Create;
PicCreated := True; PicCreated := True;
end; end;
{$IFNDEF IP_LAZARUS}
Ext := LowerCase (Copy (ExtractFileExt (FN), 2, MaxInt));
if (Ext = 'bmp') or (Ext = 'emf') or (Ext = 'wmf') or (Ext = 'gif') or (Ext = 'jpg') then begin
{$ENDIF}
Picture.LoadFromFile(FN); Picture.LoadFromFile(FN);
{$IFNDEF IP_LAZARUS}
end end
else begin else begin
PicCreated := False; PicCreated := False;

32
components/turbopower_ipro/examples/htmfileexp2.pas
View File

@ -3,23 +3,14 @@ unit HtmFileExp2;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{.$define UsePreview} {.$define UsePreview}
{$IFDEF LCL}
{$DEFINE IP_LAZARUS}
{$ENDIF}
interface interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
{$IFDEF IP_LAZARUS} {$ifdef UsePreview}
{$ifdef UsePreview} OsPrinters,
OsPrinters, {$endif}
{$endif}
{$ELSE}
GIFImage,
JPeg,
ImageDLLLoader, PNGLoader, LinarBitmap, //from ImageFileLib of Michael Vinther: http://www.logicnet.dk/lib/
{$ENDIF}
IpHtml, ExtCtrls, StdCtrls, FileUtil; IpHtml, ExtCtrls, StdCtrls, FileUtil;
type type
@ -119,10 +110,6 @@ procedure TIpHtmlPanelH.HTMLGetImageX(Sender: TIpHtmlNode; const URL: string;
var var
PicCreated: Boolean; PicCreated: Boolean;
FN, nURL: string; FN, nURL: string;
{$IFNDEF IP_LAZARUS}
Ext: string;
BitMap: Graphics.TBitMap;
{$ENDIF}
begin begin
PicCreated := False; PicCreated := False;
try try
@ -135,17 +122,12 @@ begin
FN := Concat (FN, nURL); FN := Concat (FN, nURL);
if FileExistsUTF8(FN) then begin if FileExistsUTF8(FN) then begin
if Picture = nil then begin if Picture = nil then begin
Picture := TPicture.Create; Picture := TPicture.Create;
PicCreated := True; PicCreated := True;
end; end;
{$IFNDEF IP_LAZARUS}
Ext := LowerCase (Copy (ExtractFileExt (FN), 2, MaxInt));
if (Ext = 'bmp') or (Ext = 'emf') or (Ext = 'wmf') or (Ext = 'gif') or (Ext = 'jpg') then begin
{$ENDIF}
Picture.LoadFromFile(FN); Picture.LoadFromFile(FN);
{$IFNDEF IP_LAZARUS}
end end
else begin else begin
PicCreated := False; PicCreated := False;
BitMap := Graphics.TBitMap.Create; BitMap := Graphics.TBitMap.Create;
with TLinearBitmap.Create do with TLinearBitmap.Create do

9
components/turbopower_ipro/ipanim.pas
View File

@ -37,14 +37,9 @@ unit IpAnim;
interface interface
uses uses
{$IFDEF IP_LAZARUS}
LCLType, LCLType,
GraphType, GraphType,
LCLIntf, LCLIntf,
{$ELSE}
Windows,
Messages,
{$ENDIF}
SysUtils, Classes, Graphics, Controls, Forms, Dialogs, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, IpConst; ExtCtrls, IpConst;
@ -607,9 +602,7 @@ var
UseTransparentCopy : Boolean; UseTransparentCopy : Boolean;
begin begin
{$IFDEF IP_LAZARUS}
if (CurrentFrame=nil) then ; if (CurrentFrame=nil) then ;
{$ENDIF}
// Basic clear frame. This should work for just about anything. // Basic clear frame. This should work for just about anything.
DefaultDrawing := False; DefaultDrawing := False;
UseTransparentCopy := False; UseTransparentCopy := False;
@ -756,9 +749,7 @@ procedure TIpAnimatedGraphic.LoadFromStream (Stream: TStream);
image. image.
} }
begin begin
{$IFDEF IP_LAZARUS}
if (Stream=nil) then ; if (Stream=nil) then ;
{$ENDIF}
Width := 50; Width := 50;
Height := 50; Height := 50;
Bitmap.Canvas.Brush.Color := clWhite; Bitmap.Canvas.Brush.Color := clWhite;

20
components/turbopower_ipro/ipfilebroker.pas
View File

@ -31,21 +31,13 @@ unit Ipfilebroker;
interface interface
{$IFDEF IP_LAZARUS}
uses Classes, SysUtils, LResources, Graphics, LCLProc, LazFileUtils, LazUTF8, uses Classes, SysUtils, LResources, Graphics, LCLProc, LazFileUtils, LazUTF8,
ipconst, iputils, iphtml, ipmsg; ipconst, iputils, iphtml, ipmsg;
{$ELSE}
uses
Windows, SysUtils, Graphics, Classes, Dialogs, ShellApi,
IpConst, IpUtils, {IpSock, IpCache,} IpHtml, {IpHttp,} IpMsg, IpStrms{, IpFtp};
{$ENDIF}
const const
IP_DEFAULT_SCHEME : string = 'HTTP'; IP_DEFAULT_SCHEME : string = 'HTTP';
{$IFDEF IP_LAZARUS}
function expandLocalHtmlFileName (URL : string) : string; function expandLocalHtmlFileName (URL : string) : string;
{$ENDIF}
type type
@ -124,9 +116,7 @@ type
public public
constructor Create(AOwner : TComponent); override; constructor Create(AOwner : TComponent); override;
function GetHtmlStream(const URL : string; PostData : TIpFormDataEntity) : TStream; override; function GetHtmlStream(const URL : string; PostData : TIpFormDataEntity) : TStream; override;
{$IFDEF IP_LAZARUS}
function DoGetStream(const URL: string): TStream; override; function DoGetStream(const URL: string): TStream; override;
{$ENDIF}
function CheckURL(const URL : string; var ContentType : string) : Boolean; override; function CheckURL(const URL : string; var ContentType : string) : Boolean; override;
procedure Leave(Html : TIpHtml); override; procedure Leave(Html : TIpHtml); override;
procedure Reference(const URL : string); override; procedure Reference(const URL : string); override;
@ -138,7 +128,6 @@ procedure Register;
implementation implementation
{$IFDEF IP_LAZARUS}
function expandLocalHtmlFileName (URL : string) : string; function expandLocalHtmlFileName (URL : string) : string;
begin begin
if pos ('FILE://', ansiuppercase(URL)) = 0 then if pos ('FILE://', ansiuppercase(URL)) = 0 then
@ -146,7 +135,6 @@ begin
else else
result := URL; result := URL;
end; end;
{$ENDIF}
{ TIpCustomHtmlDataProvider } { TIpCustomHtmlDataProvider }
constructor TIpCustomHtmlDataProvider.Create(AOwner : TComponent); constructor TIpCustomHtmlDataProvider.Create(AOwner : TComponent);
@ -165,9 +153,7 @@ function TIpCustomHtmlDataProvider.BuildURL(const Old,
New : string) : string; New : string) : string;
begin begin
Result := IpUtils.BuildURL(Old, New); Result := IpUtils.BuildURL(Old, New);
{$IFDEF IP_LAZARUS}
//DebugLn('TIpCustomHtmlDataProvider.BuildURL Old="',old,'" new="',New,'"'); //DebugLn('TIpCustomHtmlDataProvider.BuildURL Old="',old,'" new="',New,'"');
{$ENDIF}
end; end;
function TIpCustomHtmlDataProvider.CanHandle(const URL : string) : Boolean; function TIpCustomHtmlDataProvider.CanHandle(const URL : string) : Boolean;
@ -299,15 +285,11 @@ var
ContentType, FN : string; ContentType, FN : string;
begin begin
Initialize(FileAddrRec); Initialize(FileAddrRec);
{$IFDEF IP_LAZARUS}
//DebugLn('TIpFileDataProvider.CanHandle('+URL+')'); //DebugLn('TIpFileDataProvider.CanHandle('+URL+')');
{$ENDIF}
FN := BuildURL(FOldURL, URL); FN := BuildURL(FOldURL, URL);
IpParseURL(FN, FileAddrRec); IpParseURL(FN, FileAddrRec);
FN := NetToDosPath(FileAddrRec.Path); FN := NetToDosPath(FileAddrRec.Path);
{$IFDEF IP_LAZARUS}
//DebugLn('TIpFileDataProvider.CanHandle FN="'+FN+'"'); //DebugLn('TIpFileDataProvider.CanHandle FN="'+FN+'"');
{$ENDIF}
ContentType := UpperCase(GetLocalContent(FN)); ContentType := UpperCase(GetLocalContent(FN));
Result := (FileExistsUTF8(FN)) and ((Pos('TEXT/HTML', ContentType) > 0) or Result := (FileExistsUTF8(FN)) and ((Pos('TEXT/HTML', ContentType) > 0) or
(Pos('IMAGE/', ContentType) > 0)); (Pos('IMAGE/', ContentType) > 0));
@ -343,7 +325,6 @@ begin
Finalize(FileAddrRec); Finalize(FileAddrRec);
end; end;
{$IFDEF IP_LAZARUS}
function TIpFileDataProvider.DoGetStream(const URL: string): TStream; function TIpFileDataProvider.DoGetStream(const URL: string): TStream;
var var
FileAddrRec : TIpAddrRec; FileAddrRec : TIpAddrRec;
@ -361,7 +342,6 @@ begin
end; end;
Finalize(FileAddrRec); Finalize(FileAddrRec);
end; end;
{$ENDIF}
procedure TIpFileDataProvider.GetImage(Sender : TIpHtmlNode; procedure TIpFileDataProvider.GetImage(Sender : TIpHtmlNode;
const URL : string; var Picture : TPicture); const URL : string; var Picture : TPicture);

881
components/turbopower_ipro/iphtml.pas
View File

File diff suppressed because it is too large Load Diff

50
components/turbopower_ipro/iphtmlblocklayout.pas
View File

@ -129,7 +129,7 @@ begin
inherited Create(AOwner); inherited Create(AOwner);
FIpHtml := FOwner.Owner; FIpHtml := FOwner.Owner;
FBlockOwner := TIpHtmlNodeBlock(FOwner); FBlockOwner := TIpHtmlNodeBlock(FOwner);
FElementQueue := {$ifdef IP_LAZARUS}TFPList{$else}TList{$endif}.Create; FElementQueue := TFPList.Create;
end; end;
destructor TIpNodeBlockLayouter.Destroy; destructor TIpNodeBlockLayouter.Destroy;
@ -169,17 +169,10 @@ begin // Debug: remove assertions later
Assert(FCanvas.Font.Name = aProps.FontName, 'UpdPropMetrics: FCanvas.Font.Name <> aProps.FontName'); Assert(FCanvas.Font.Name = aProps.FontName, 'UpdPropMetrics: FCanvas.Font.Name <> aProps.FontName');
Assert(FCanvas.Font.Size = aProps.FontSize, 'UpdPropMetrics: FCanvas.Font.Size <> aProps.FontSize'); Assert(FCanvas.Font.Size = aProps.FontSize, 'UpdPropMetrics: FCanvas.Font.Size <> aProps.FontSize');
Assert(FCanvas.Font.Style = aProps.FontStyle, 'UpdPropMetrics: FCanvas.Font.Style <> aProps.FontStyle'); Assert(FCanvas.Font.Style = aProps.FontStyle, 'UpdPropMetrics: FCanvas.Font.Style <> aProps.FontStyle');
{$IFDEF IP_LAZARUS}
FCanvas.GetTextMetrics(TextMetrics); FCanvas.GetTextMetrics(TextMetrics);
aProps.PropA.tmAscent := TextMetrics.Ascender; aProps.PropA.tmAscent := TextMetrics.Ascender;
aProps.PropA.tmDescent := TextMetrics.Descender; aProps.PropA.tmDescent := TextMetrics.Descender;
aProps.PropA.tmHeight := TextMetrics.Height; aProps.PropA.tmHeight := TextMetrics.Height;
{$ELSE}
GetTextMetrics(FCanvas.Handle, TextMetrics);
aProps.PropA.tmAscent := TextMetrics.tmAscent;
aProps.PropA.tmDescent := TextMetrics.tmDescent;
aProps.PropA.tmHeight := TextMetrics.tmHeight;
{$ENDIF}
end; end;
procedure TIpNodeBlockLayouter.Layout(RenderProps: TIpHtmlProps; TargetRect: TRect); procedure TIpNodeBlockLayouter.Layout(RenderProps: TIpHtmlProps; TargetRect: TRect);
@ -256,7 +249,6 @@ begin
end; end;
procedure TIpNodeBlockLayouter.InitMetrics; procedure TIpNodeBlockLayouter.InitMetrics;
{$IFDEF IP_LAZARUS}
var var
TextMetrics : TLCLTextMetric; TextMetrics : TLCLTextMetric;
begin begin
@ -265,16 +257,6 @@ begin
FBlockDescent := TextMetrics.Descender; FBlockDescent := TextMetrics.Descender;
FBlockHeight := TextMetrics.Height; FBlockHeight := TextMetrics.Height;
end; end;
{$ELSE}
var
TextMetrics : TTextMetric;
begin
GetTextMetrics(aCanvas.Handle, TextMetrics);
BlockAscent := TextMetrics.tmAscent;
BlockDescent := TextMetrics.tmDescent;
BlockHeight := TextMetrics.tmHeight;
end;
{$ENDIF}
function TIpNodeBlockLayouter.QueueLeadingObjects: Integer; function TIpNodeBlockLayouter.QueueLeadingObjects: Integer;
// Returns the first element index. // Returns the first element index.
@ -756,20 +738,17 @@ end;
procedure TIpNodeBlockLayouter.SetWordInfoLength(NewLength : Integer); procedure TIpNodeBlockLayouter.SetWordInfoLength(NewLength : Integer);
var var
NewWordInfoSize: Integer; NewWordInfoSize: Integer;
{$IFNDEF IP_LAZARUS}
NewWordInfo: PWordList;
{$ENDIF}
begin begin
if (FWordInfo = nil) or (NewLength > FWordInfoSize) then begin if (FWordInfo = nil) or (NewLength > FWordInfoSize) then begin
NewWordInfoSize := ((NewLength div 256) + 1) * 256; NewWordInfoSize := ((NewLength div 256) + 1) * 256;
{$IFDEF IP_LAZARUS code below does not check if FWordInfo<>nil} //code below does not check if FWordInfo<>nil
ReallocMem(FWordInfo,NewWordInfoSize * sizeof(TWordInfo)); ReallocMem(FWordInfo,NewWordInfoSize * sizeof(TWordInfo));
{$ELSE} (*
NewWordInfo := AllocMem(NewWordInfoSize * sizeof(TWordInfo)); NewWordInfo := AllocMem(NewWordInfoSize * sizeof(TWordInfo));
move(WordInfo^, NewWordInfo^, WordInfoSize); move(WordInfo^, NewWordInfo^, WordInfoSize);
Freemem(WordInfo); Freemem(WordInfo);
WordInfo := NewWordInfo; WordInfo := NewWordInfo;
{$ENDIF} *)
FWordInfoSize := NewWordInfoSize; FWordInfoSize := NewWordInfoSize;
end; end;
end; end;
@ -1237,9 +1216,7 @@ end;
procedure TIpNodeBlockLayouter.DoRenderFont(var aCurWord: PIpHtmlElement); procedure TIpNodeBlockLayouter.DoRenderFont(var aCurWord: PIpHtmlElement);
begin begin
{$IFDEF IP_LAZARUS}
FCanvas.Font.BeginUpdate; // for speedup FCanvas.Font.BeginUpdate; // for speedup
{$ENDIF}
if (FCurProps = nil) or not FCurProps.AIsEqualTo(aCurWord.Props) then if (FCurProps = nil) or not FCurProps.AIsEqualTo(aCurWord.Props) then
with aCurWord.Props do begin with aCurWord.Props do begin
FCanvas.Font.Name := FontName; FCanvas.Font.Name := FontName;
@ -1255,9 +1232,7 @@ begin
if (FCurProps = nil) or not FCurProps.BIsEqualTo(aCurWord.Props) then if (FCurProps = nil) or not FCurProps.BIsEqualTo(aCurWord.Props) then
FCanvas.Font.Color := aCurWord.Props.FontColor; FCanvas.Font.Color := aCurWord.Props.FontColor;
FIpHtml.Target.Font.Quality := FIpHtml.FontQuality; FIpHtml.Target.Font.Quality := FIpHtml.FontQuality;
{$IFDEF IP_LAZARUS}
FIpHtml.Target.Font.EndUpdate; FIpHtml.Target.Font.EndUpdate;
{$ENDIF}
FCurProps := aCurWord.Props; FCurProps := aCurWord.Props;
end; end;
@ -1266,7 +1241,6 @@ procedure TIpNodeBlockLayouter.DoRenderElemWord(aCurWord: PIpHtmlElement;
var var
P : TPoint; P : TPoint;
R : TRect; R : TRect;
{$IFDEF IP_LAZARUS}
TextStyle: TTextStyle; TextStyle: TTextStyle;
OldBrushcolor: TColor; OldBrushcolor: TColor;
OldFontColor: TColor; OldFontColor: TColor;
@ -1291,7 +1265,6 @@ var
FCanvas.Font.Style := OldFontStyle; FCanvas.Font.Style := OldFontStyle;
FCanvas.Font.Quality := OldFontQuality; FCanvas.Font.Quality := OldFontQuality;
end; end;
{$ENDIF}
begin begin
P := FIpHtml.PagePtToScreen(aCurWord.WordRect2.TopLeft); P := FIpHtml.PagePtToScreen(aCurWord.WordRect2.TopLeft);
@ -1302,7 +1275,6 @@ begin
then then
exit; exit;
{$IFDEF IP_LAZARUS}
//if (LastOwner <> aCurWord.Owner) then LastPoint := P; //if (LastOwner <> aCurWord.Owner) then LastPoint := P;
saveCanvasProperties; saveCanvasProperties;
TextStyle := FCanvas.TextStyle; TextStyle := FCanvas.TextStyle;
@ -1323,10 +1295,7 @@ begin
else else
begin begin
TextStyle.Opaque := True; TextStyle.Opaque := True;
{$ENDIF}
FCanvas.Brush.Style := bsClear; FCanvas.Brush.Style := bsClear;
{$IFDEF IP_LAZARUS}
end; end;
if aCurWord.Owner.ParentNode = aCurTabFocus then if aCurWord.Owner.ParentNode = aCurTabFocus then
@ -1334,16 +1303,9 @@ begin
if FCanvas.Font.Color = clNone then if FCanvas.Font.Color = clNone then
FCanvas.Font.Color := clBlack; FCanvas.Font.Color := clBlack;
FCanvas.Font.Quality := FOwner.Owner.FontQuality; FCanvas.Font.Quality := FOwner.Owner.FontQuality;
{$ENDIF}
if aCurWord.AnsiWord <> NAnchorChar then if aCurWord.AnsiWord <> NAnchorChar then
{$IFDEF IP_LAZARUS}
FCanvas.TextRect(R, P.x, P.y, NoBreakToSpace(aCurWord.AnsiWord), TextStyle); FCanvas.TextRect(R, P.x, P.y, NoBreakToSpace(aCurWord.AnsiWord), TextStyle);
{$ELSE}
FCanvas.TextRect(R, P.x, P.y, NoBreakToSpace(aCurWord.AnsiWord));
{$ENDIF}
{$IFDEF IP_LAZARUS}
RestoreCanvasProperties; RestoreCanvasProperties;
{$ENDIF}
FIpHtml.AddRect(aCurWord.WordRect2, aCurWord, FBlockOwner); FIpHtml.AddRect(aCurWord.WordRect2, aCurWord, FBlockOwner);
end; end;
@ -1361,14 +1323,12 @@ begin
L0 := FBlockOwner.Level0; L0 := FBlockOwner.Level0;
FCurProps := nil; FCurProps := nil;
FCanvas := FIpHtml.Target; FCanvas := FIpHtml.Target;
{$IFDEF IP_LAZARUS}
// to draw focus rect // to draw focus rect
i := FIpHtml.TabList.Index; i := FIpHtml.TabList.Index;
if (FIpHtml.TabList.Count > 0) and (i <> -1) then if (FIpHtml.TabList.Count > 0) and (i <> -1) then
CurTabFocus := TIpHtmlNode(FIpHtml.TabList[i]) CurTabFocus := TIpHtmlNode(FIpHtml.TabList[i])
else else
CurTabFocus := nil; CurTabFocus := nil;
{$ENDIF}
for i := 0 to pred(FElementQueue.Count) do begin for i := 0 to pred(FElementQueue.Count) do begin
CurWord := PIpHtmlElement(FElementQueue[i]); CurWord := PIpHtmlElement(FElementQueue[i]);
@ -1533,9 +1493,7 @@ var
begin begin
Props.Assign(RenderProps); Props.Assign(RenderProps);
Props.DelayCache:=True; Props.DelayCache:=True;
{$IFDEF IP_LAZARUS}
FOwner.LoadAndApplyCSSProps; FOwner.LoadAndApplyCSSProps;
{$ENDIF}
//DebugLn('td :', IntToStr(Integer(Props.Alignment))); //DebugLn('td :', IntToStr(Integer(Props.Alignment)));
if FTableElemOwner.BgColor <> clNone then if FTableElemOwner.BgColor <> clNone then
Props.BgColor := FTableElemOwner.BgColor; Props.BgColor := FTableElemOwner.BgColor;

13
components/turbopower_ipro/iphtmlpv.pas
View File

@ -39,14 +39,10 @@ unit IpHtmlPv;
interface interface
uses uses
{$IFDEF IP_LAZARUS}
LCLType, LCLType,
GraphType, GraphType,
LCLIntf, LCLIntf,
Buttons, Buttons,
{$ELSE}
Windows,
{$ENDIF}
Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Spin, IpHtml, IpConst; StdCtrls, ExtCtrls, Spin, IpHtml, IpConst;
@ -123,11 +119,7 @@ implementation
uses uses
Printers; Printers;
{$IFNDEF IP_LAZARUS}
{$R *.DFM}
{$ELSE}
{$R *.lfm} {$R *.lfm}
{$ENDIF}
const const
SCRATCH_WIDTH = 800; //640; SCRATCH_WIDTH = 800; //640;
@ -368,7 +360,6 @@ procedure TIpHTMLPreview.ResizeCanvas;
begin begin
ScrollBox1.HorzScrollBar.Position := 0; ScrollBox1.HorzScrollBar.Position := 0;
ScrollBox1.VertScrollBar.Position := 0; ScrollBox1.VertScrollBar.Position := 0;
{$IFDEF IP_LAZARUS}
if Printer.PageHeight > 0 then if Printer.PageHeight > 0 then
PaperPanel.Height := round(Printer.PageHeight * Scale) PaperPanel.Height := round(Printer.PageHeight * Scale)
else else
@ -377,10 +368,6 @@ begin
PaperPanel.Width := round(Printer.PageWidth * Scale) PaperPanel.Width := round(Printer.PageWidth * Scale)
else else
PaperPanel.Width := round(500 * Scale); PaperPanel.Width := round(500 * Scale);
{$ELSE}
PaperPanel.Width := round(Printer.PageWidth * Scale);
PaperPanel.Height := round(Printer.PageHeight * Scale);
{$ENDIF}
PaintBox1.Left := round(OwnerPanel.PrintTopLeft.x * Scale); PaintBox1.Left := round(OwnerPanel.PrintTopLeft.x * Scale);
PaintBox1.Top := round(OwnerPanel.PrintTopLeft.y * Scale); PaintBox1.Top := round(OwnerPanel.PrintTopLeft.y * Scale);

80
components/turbopower_ipro/iphtmltablelayout.pas
View File

@ -278,11 +278,7 @@ begin
begin begin
if CellNode.Width.LengthValue <= CellNode.ExpParentWidth then if CellNode.Width.LengthValue <= CellNode.ExpParentWidth then
Min0 := MaxI2(Min0, CellNode.Width.LengthValue - 2*FCellPadding Min0 := MaxI2(Min0, CellNode.Width.LengthValue - 2*FCellPadding
{$IFDEF IP_LAZARUS}
- FCellSpacing - RUH); - FCellSpacing - RUH);
{$ELSE}
- 2*CS2 - RUH);
{$ENDIF}
Max0 := Min0; Max0 := Min0;
end; end;
end; end;
@ -318,19 +314,11 @@ begin
TWMin := 0; TWMin := 0;
TWMax := 0; TWMax := 0;
{$IFDEF IP_LAZARUS}
CellOverhead := BL + FCellSpacing + BR; CellOverhead := BL + FCellSpacing + BR;
{$ELSE}
CellOverhead := BL + 2*CS2 + RUH + BR;
{$ENDIF}
for i := 0 to Pred(ColCount) do begin for i := 0 to Pred(ColCount) do begin
Inc(TWMin, ColTextWidthMin[i]); Inc(TWMin, ColTextWidthMin[i]);
Inc(TWMax, ColTextWidthMax[i]); Inc(TWMax, ColTextWidthMax[i]);
{$IFDEF IP_LAZARUS}
Inc(CellOverhead, RUH + 2*FCellPadding + FCellSpacing + RUH); Inc(CellOverhead, RUH + 2*FCellPadding + FCellSpacing + RUH);
{$ELSE}
Inc(CellOverhead, 2*FCellPadding + 2*CS2 + RUH);
{$ENDIF}
FRowSp[i] := 0; FRowSp[i] := 0;
end; end;
@ -466,36 +454,17 @@ var
CellRect1 := TargetRect; CellRect1 := TargetRect;
Inc(CellRect1.Left, ColStart[CurCol]); Inc(CellRect1.Left, ColStart[CurCol]);
{$IFDEF IP_LAZARUS}
Inc(CellRect1.Top, FCellSpacing + RUV); Inc(CellRect1.Top, FCellSpacing + RUV);
{$ELSE}
Inc(CellRect1.Top, CS2 + RUV);
{$ENDIF}
CellRect1.Right := CellRect1.Left + 2*FCellPadding + ColTextWidth[CurCol] CellRect1.Right := CellRect1.Left + 2*FCellPadding + ColTextWidth[CurCol];
{$IFnDEF IP_LAZARUS}
+ 2*CS2
{$ENDIF}
;
for k := 1 to CellNode.ColSpan - 1 do for k := 1 to CellNode.ColSpan - 1 do
Inc(CellRect1.Right, ColTextWidth[CurCol + k] + 2*FCellPadding + Inc(CellRect1.Right, ColTextWidth[CurCol + k] + 2*FCellPadding +
{$IFDEF IP_LAZARUS}
2*RUH + FCellSpacing); 2*RUH + FCellSpacing);
{$ELSE}
2*CS2 + RUH);
{$ENDIF}
{$IFDEF IP_LAZARUS}
// PadRect area of cell excluding rules // PadRect area of cell excluding rules
// CellRect area of text contained in cell // CellRect area of text contained in cell
CellNode.PadRect := CellRect1; CellNode.PadRect := CellRect1;
Inc(CellRect1.Top, FCellPadding); Inc(CellRect1.Top, FCellPadding);
inflateRect(CellRect1, -FCellPadding, 0); inflateRect(CellRect1, -FCellPadding, 0);
{$ELSE}
FPadRect := CellRect1;
InflateRect(FPadRect, -CS2, 0);
Inc(CellRect1.Top, FCellPadding);
InflateRect(CellRect1, -(FCellPadding + CS2), 0);
{$ENDIF}
VA := CellNode.VAlign; VA := CellNode.VAlign;
if VA = hva3Default then if VA = hva3Default then
@ -563,11 +532,7 @@ var
AL := AL0; AL := AL0;
{$IFDEF IP_LAZARUS}
HA := maxYY - (TargetRect.Top + FCellSpacing + RUV); HA := maxYY - (TargetRect.Top + FCellSpacing + RUV);
{$ELSE}
HA := maxYY - TargetRect.Top;
{$ENDIF}
HB := CellNode.PageRect.Bottom - CellNode.PageRect.Top; HB := CellNode.PageRect.Bottom - CellNode.PageRect.Top;
VA := CellNode.VAlign; VA := CellNode.VAlign;
@ -586,30 +551,14 @@ var
if Y0 > 0 then begin if Y0 > 0 then begin
CellRect1 := TargetRect; CellRect1 := TargetRect;
Inc(CellRect1.Left, ColStart[CurCol]); Inc(CellRect1.Left, ColStart[CurCol]);
{$IFDEF IP_LAZARUS}
Inc(CellRect1.Top, FCellSpacing + RUV + Y0); Inc(CellRect1.Top, FCellSpacing + RUV + Y0);
{$ELSE} CellRect1.Right := CellRect1.Left + 2*FCellPadding + ColTextWidth[CurCol];
Inc(CellRect1.Top, CS2 + RUV + Y0);
{$ENDIF}
CellRect1.Right := CellRect1.Left + 2*FCellPadding + ColTextWidth[CurCol]
{$IFnDEF IP_LAZARUS}
+ 2*CS2
{$ENDIF}
;
for k := 1 to CellNode.ColSpan - 1 do for k := 1 to CellNode.ColSpan - 1 do
Inc(CellRect1.Right, ColTextWidth[CurCol + k] + 2*FCellPadding + Inc(CellRect1.Right, ColTextWidth[CurCol + k] + 2*FCellPadding +
{$IFDEF IP_LAZARUS}
2*RUH + FCellSpacing); 2*RUH + FCellSpacing);
{$ELSE}
2*CS2 + RUH);
{$ENDIF}
Inc(CellRect1.Top, FCellPadding); Inc(CellRect1.Top, FCellPadding);
{$IFDEF IP_LAZARUS}
inflateRect(CellRect1, -FCellPadding, 0); inflateRect(CellRect1, -FCellPadding, 0);
{$ELSE}
InflateRect(CellRect1, -(FCellPadding + CS2), 0);
{$ENDIF}
case CellNode.Align of case CellNode.Align of
haDefault : ; haDefault : ;
@ -656,11 +605,7 @@ var
if FRowSp[j] > 0 then if FRowSp[j] > 0 then
FRowSp[j] := FRowSp[j] - 1; FRowSp[j] := FRowSp[j] - 1;
{$IFDEF IP_LAZARUS}
TargetRect.Top := MaxI2(maxYY, TargetRect.Top) + RUV; TargetRect.Top := MaxI2(maxYY, TargetRect.Top) + RUV;
{$ELSE}
TargetRect.Top := MaxI2(maxYY, TargetRect.Top);
{$ENDIF}
DeleteFirstSpanRow; DeleteFirstSpanRow;
end; end;
end; end;
@ -763,11 +708,7 @@ begin
case CellNode.Width.LengthType of case CellNode.Width.LengthType of
hlAbsolute : hlAbsolute :
AdjustCol(CellNode.ColSpan, CellNode.Width.LengthValue - 2*FCellPadding AdjustCol(CellNode.ColSpan, CellNode.Width.LengthValue - 2*FCellPadding
{$IFDEF IP_LAZARUS}
- FCellSpacing - RUH); - FCellSpacing - RUH);
{$ELSE}
- 2*CS2 - RUH);
{$ENDIF}
hlPercent : hlPercent :
AdjustCol(CellNode.Colspan, AdjustCol(CellNode.Colspan,
round((FTableWidth - CellOverhead) * round((FTableWidth - CellOverhead) *
@ -878,19 +819,11 @@ begin
R := BorderRect; R := BorderRect;
end; end;
{$IFDEF IP_LAZARUS}
ColStart[0] := BL + FCellSpacing + RUH; ColStart[0] := BL + FCellSpacing + RUH;
{$ELSE}
ColStart[0] := BL + CS2 + RUH;
{$ENDIF}
FRowSp[0] := 0; FRowSp[0] := 0;
for i := 1 to Pred(ColCount) do begin for i := 1 to Pred(ColCount) do begin
ColStart[i] := ColStart[i-1] + 2*FCellPadding + ColTextWidth[i-1] ColStart[i] := ColStart[i-1] + 2*FCellPadding + ColTextWidth[i-1]
{$IFDEF IP_LAZARUS}
+ FCellSpacing + 2*RUH; + FCellSpacing + 2*RUH;
{$ELSE}
+ 2*CS2 + RUH;
{$ENDIF}
FRowSp[i] := 0; FRowSp[i] := 0;
end; end;
@ -908,11 +841,7 @@ begin
RowFixup.Free; RowFixup.Free;
end; end;
{$IFDEF IP_LAZARUS}
Inc(TargetRect.Top, FCellSpacing + RUV + BB); Inc(TargetRect.Top, FCellSpacing + RUV + BB);
{$ELSE}
Inc(TargetRect.Top, CS2 + RUV + BB);
{$ENDIF}
R.Right := R.Left + FTableWidth; R.Right := R.Left + FTableWidth;
R.Bottom := TargetRect.Top; R.Bottom := TargetRect.Top;
@ -964,11 +893,6 @@ begin
FColCount := c; FColCount := c;
end; end;
end; end;
{$IFnDEF IP_LAZARUS}
CS2 := FCellSpacing div 2;
if (FCellSpacing > 0) and (CS2 = 0) then
CS2 := 1;
{$ENDIF}
RUH := 0; RUH := 0;
RUV := 0; RUV := 0;
case FTableOwner.Rules of case FTableOwner.Rules of

4
components/turbopower_ipro/iphttpbroker.pas
View File

@ -58,9 +58,7 @@ type
destructor Destroy; override; destructor Destroy; override;
function GetHtmlStream(const AUrl: string; function GetHtmlStream(const AUrl: string;
APostData: TIpFormDataEntity): TStream; override; APostData: TIpFormDataEntity): TStream; override;
{$IFDEF IP_LAZARUS}
function DoGetStream(const AUrl: string): TStream; override; function DoGetStream(const AUrl: string): TStream; override;
{$ENDIF}
function CheckURL(const AUrl: string; function CheckURL(const AUrl: string;
var AContentType: string): Boolean; override; var AContentType: string): Boolean; override;
procedure Leave(AHtml: TIpHtml); override; procedure Leave(AHtml: TIpHtml); override;
@ -104,14 +102,12 @@ begin
Result.Seek(0, soFromBeginning); Result.Seek(0, soFromBeginning);
end; end;
{$IFDEF IP_LAZARUS}
function TIpHttpDataProvider.DoGetStream(const AUrl: string): TStream; function TIpHttpDataProvider.DoGetStream(const AUrl: string): TStream;
begin begin
Result := TMemoryStream.Create; Result := TMemoryStream.Create;
Result.CopyFrom(FDocumment, 0); Result.CopyFrom(FDocumment, 0);
Result.Seek(0, soFromBeginning); Result.Seek(0, soFromBeginning);
end; end;
{$ENDIF}
function TIpHttpDataProvider.CheckURL(const AUrl: string; function TIpHttpDataProvider.CheckURL(const AUrl: string;
var AContentType: string): Boolean; var AContentType: string): Boolean;

16
components/turbopower_ipro/ipmsg.pas
View File

@ -40,19 +40,12 @@ unit IpMsg;
interface interface
uses uses
{$IFDEF IP_LAZARUS}
LCLType, LCLType,
LCLIntf, LCLIntf,
LazFileUtils, LazUTF8Classes, LazFileUtils, LazUTF8Classes,
{$ELSE}
Windows,
{$ENDIF}
Classes, Classes,
SysUtils, SysUtils,
IpStrms, IpStrms,
{$IFNDEF IP_LAZARUS}
//IpSock, //JMN
{$ENDIF}
IpUtils, IpUtils,
IpConst; IpConst;
@ -568,15 +561,6 @@ type
procedure SaveToStream(aStream : TStream); procedure SaveToStream(aStream : TStream);
end; end;
{$IFNDEF IP_LAZARUS}
{ dummy class so this unit will be added to the uses clause when an }
{ IpPop3Client, IpSmtpClient or IpNntpClient component is dropped on the form }
(*** //JMN
TIpCustomEmailClass = class(TIpCustomClient)
end;
**)
{$ENDIF}
function IpBase64EncodeString(const InStr: string): string; {!!.02}{!!.03} function IpBase64EncodeString(const InStr: string): string; {!!.02}{!!.03}
{Begin !!.12} {Begin !!.12}

94
components/turbopower_ipro/ipstrms.pas
View File

@ -42,14 +42,10 @@ interface
uses uses
SysUtils, Classes, SysUtils, Classes,
{$IFDEF IP_LAZARUS}
// LCL // LCL
LCLType, LCLType,
// LazUtils // LazUtils
FPCAdds, LazFileUtils, IntegerList, FPCAdds, LazFileUtils, IntegerList,
{$ELSE}
Windows, // put Windows behind Classes because of THandle
{$ENDIF}
IpUtils, IpUtils,
IpConst; IpConst;
@ -147,7 +143,7 @@ type
FBufPos : Longint; FBufPos : Longint;
FBufSize : Longint; FBufSize : Longint;
FDirty : Boolean; FDirty : Boolean;
FSize : {$IFDEF IP_LAZARUS}TStreamSeekType{$ELSE}longint{$ENDIF}; FSize : TStreamSeekType;
FStream : TStream; FStream : TStream;
protected {- methods } protected {- methods }
@ -170,7 +166,7 @@ type
function Write(const Buffer; Count : Longint) : Longint; override; function Write(const Buffer; Count : Longint) : Longint; override;
public {-properties } public {-properties }
property FastSize: {$IFDEF IP_LAZARUS}TStreamSeekType{$ELSE}longint{$ENDIF} property FastSize: TStreamSeekType
read FSize; read FSize;
property Stream : TStream property Stream : TStream
read FStream write bsSetStream; read FStream write bsSetStream;
@ -350,26 +346,21 @@ end;
procedure TIpMemMapStream.CloseFile; procedure TIpMemMapStream.CloseFile;
begin begin
{$IFDEF IP_LAZARUS}
writeln('TIpMemMapStream.CloseFile ToDo'); writeln('TIpMemMapStream.CloseFile ToDo');
{$ELSE} { if mmFileHandle <> 0 then
if mmFileHandle <> 0 then CloseHandle(mmFileHandle);}
CloseHandle(mmFileHandle);
{$ENDIF}
end; end;
{-----------------------------------------------------------------------------} {-----------------------------------------------------------------------------}
procedure TIpMemMapStream.CloseMap; procedure TIpMemMapStream.CloseMap;
begin begin
{$IFDEF IP_LAZARUS}
writeln('TIpMemMapStream.CloseMap ToDo'); writeln('TIpMemMapStream.CloseMap ToDo');
{$ELSE} { FlushViewOfFile(mmPointer, 0);
FlushViewOfFile(mmPointer, 0);
UnMapViewOfFile(mmPointer); UnMapViewOfFile(mmPointer);
if mmMapHandle <> 0 then if mmMapHandle <> 0 then
CloseHandle(mmMapHandle); CloseHandle(mmMapHandle);
{$ENDIF} }
end; end;
{-----------------------------------------------------------------------------} {-----------------------------------------------------------------------------}
@ -383,11 +374,10 @@ end;
{-----------------------------------------------------------------------------} {-----------------------------------------------------------------------------}
procedure TIpMemMapStream.OpenFile; procedure TIpMemMapStream.OpenFile;
{$IFDEF IP_LAZARUS}
begin begin
writeln('TIpMemMapStream.OpenFile ToDo'); writeln('TIpMemMapStream.OpenFile ToDo');
end; end;
{$ELSE} (*
var var
CreateMode, CreateMode,
Flags, Flags,
@ -427,16 +417,15 @@ begin
raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename + raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename +
mmFileName); mmFileName);
end; end;
{$ENDIF} *)
{-----------------------------------------------------------------------------} {-----------------------------------------------------------------------------}
procedure TIpMemMapStream.OpenMap; procedure TIpMemMapStream.OpenMap;
{$IFDEF IP_LAZARUS}
begin begin
writeln('TIpMemMapStream.OpenMap ToDo'); writeln('TIpMemMapStream.OpenMap ToDo');
end; end;
{$ELSE} (*
var var
AccessMode, AccessMode,
ProtectMode, ProtectMode,
@ -480,7 +469,7 @@ begin
mmFileName); mmFileName);
mmPos := 0; mmPos := 0;
end; end;
{$ENDIF} *)
{-----------------------------------------------------------------------------} {-----------------------------------------------------------------------------}
@ -495,9 +484,8 @@ begin
SavPos := mmPos; SavPos := mmPos;
CloseMap; CloseMap;
{$IFDEF IP_LAZARUS}
writeln('TIpMemMapStream.Resize ToDo'); writeln('TIpMemMapStream.Resize ToDo');
{$ELSE} (*
{ Update the size of the file. } { Update the size of the file. }
if SetFilePointer(mmFileHandle, NewSize, nil, FILE_BEGIN) <> $FFFFFFFF then begin if SetFilePointer(mmFileHandle, NewSize, nil, FILE_BEGIN) <> $FFFFFFFF then begin
if SetEndOfFile(mmFileHandle) = false then if SetEndOfFile(mmFileHandle) = false then
@ -507,7 +495,7 @@ begin
else else
raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename + raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename +
mmFileName); mmFileName);
{$ENDIF} *)
{ Update internal size information. } { Update internal size information. }
FSize := NewSize; FSize := NewSize;
@ -1151,32 +1139,12 @@ begin
be less than it because we read the last line of all and it was be less than it because we read the last line of all and it was
short} short}
StLen := FixedLineLength; StLen := FixedLineLength;
{$IFDEF MSWindows}
SetLength(Result, StLen); SetLength(Result, StLen);
{$ELSE}
{$IFDEF IP_LAZARUS}
SetLength(Result, StLen);
{$ELSE}
if (StLen > 255) then
StLen := 255;
Result[0] := char(StLen);
{$ENDIF}
{$ENDIF}
if (Len < StLen) then if (Len < StLen) then
FillChar(Result[Len+1], StLen-Len, ' '); FillChar(Result[Len+1], StLen-Len, ' ');
end end
else {LineTerminator is not ltNone} begin else {LineTerminator is not ltNone} begin
{$IFDEF MSWindows}
SetLength(Result, Len); SetLength(Result, Len);
{$ELSE}
{$IFDEF IP_LAZARUS}
SetLength(Result, Len);
{$ELSE}
if (Len > 255) then
Len := 255;
Result[0] := char(Len);
{$ENDIF}
{$ENDIF}
end; end;
{read the line} {read the line}
Seek(CurPos, soFromBeginning); Seek(CurPos, soFromBeginning);
@ -1596,13 +1564,11 @@ end;
destructor TIpDownloadFileStream.Destroy; destructor TIpDownloadFileStream.Destroy;
begin begin
{$IFDEF IP_LAZARUS}
writeln('ToDo: TIpDownloadFileStream.Destroy '); writeln('ToDo: TIpDownloadFileStream.Destroy ');
{$ELSE} { FlushFileBuffers(FHandle);
FlushFileBuffers(FHandle);
if (Handle <> INVALID_HANDLE_VALUE) then if (Handle <> INVALID_HANDLE_VALUE) then
CloseHandle(Handle); CloseHandle(Handle);
{$ENDIF} }
inherited Destroy; inherited Destroy;
end; end;
@ -1623,12 +1589,11 @@ begin
end; end;
function TIpDownloadFileStream.Read(var Buffer; Count : Longint) : Longint; function TIpDownloadFileStream.Read(var Buffer; Count : Longint) : Longint;
{$IFDEF IP_LAZARUS}
begin begin
writeln('ToDo: TIpDownloadFileStream.Read '); writeln('ToDo: TIpDownloadFileStream.Read ');
Result:=0; Result:=0;
end; end;
{$ELSE} {
var var
ReadOK : Bool; ReadOK : Bool;
begin begin
@ -1639,25 +1604,22 @@ begin
Result := 0; Result := 0;
end; end;
end; end;
{$ENDIF} }
procedure TIpDownloadFileStream.Rename(aNewName : string); procedure TIpDownloadFileStream.Rename(aNewName : string);
var var
NewFullName : string; NewFullName : string;
begin begin
{$IFDEF IP_LAZARUS}
writeln('ToDo: TIpDownloadFileStream.Rename '); writeln('ToDo: TIpDownloadFileStream.Rename ');
{$ENDIF}
{close the current handle} {close the current handle}
{$IFNDEF IP_LAZARUS}
CloseHandle(Handle); // CloseHandle(Handle);
{$ENDIF}
FHandle := IpFileOpenFailed; FHandle := IpFileOpenFailed;
{calculate the full new name} {calculate the full new name}
NewFullName := FPath + '\' + aNewName; NewFullName := FPath + '\' + aNewName;
{rename the file} {rename the file}
{$IFDEF Version6OrHigher} {$IFDEF Version6OrHigher}
{$IFNDEF IP_LAZARUS} {$IFNDEF IP_LAZARUS} //TODO need review
if not MoveFile(PAnsiChar(FFileName), PAnsiChar(NewFullName)) then if not MoveFile(PAnsiChar(FFileName), PAnsiChar(NewFullName)) then
RaiseLastOSError; RaiseLastOSError;
{$ENDIF} {$ENDIF}
@ -1684,17 +1646,13 @@ end;
procedure TIpDownloadFileStream.Move(aNewName : string); procedure TIpDownloadFileStream.Move(aNewName : string);
begin begin
{$IFDEF IP_LAZARUS}
writeln('ToDo: TIpDownloadFileStream.Move '); writeln('ToDo: TIpDownloadFileStream.Move ');
{$ENDIF}
{close the current handle} {close the current handle}
{$IFNDEF IP_LAZARUS} //CloseHandle(Handle);
CloseHandle(Handle);
{$ENDIF}
FHandle := IpFileOpenFailed; FHandle := IpFileOpenFailed;
{copy the file} {!!.01} {copy the file} {!!.01}
{$IFDEF Version6OrHigher} {$IFDEF Version6OrHigher}
{$IFNDEF IP_LAZARUS} {$IFNDEF IP_LAZARUS} //TODO Need review
if not CopyFile(PAnsiChar(FFileName), PAnsiChar(aNewName), False) then if not CopyFile(PAnsiChar(FFileName), PAnsiChar(aNewName), False) then
RaiseLastOSError; RaiseLastOSError;
{$ENDIF} {$ENDIF}
@ -1723,21 +1681,17 @@ end;
function TIpDownloadFileStream.Seek(Offset : Longint; Origin : Word) : Longint; function TIpDownloadFileStream.Seek(Offset : Longint; Origin : Word) : Longint;
begin begin
{$IFDEF IP_LAZARUS}
writeln('ToDo: TIpDownloadFileStream.Seek'); writeln('ToDo: TIpDownloadFileStream.Seek');
Result := 0; Result := 0;
{$ELSE} //Result := SetFilePointer(Handle, Offset, nil, Origin);
Result := SetFilePointer(Handle, Offset, nil, Origin);
{$ENDIF}
end; end;
function TIpDownloadFileStream.Write(const Buffer; Count : Longint) : Longint; function TIpDownloadFileStream.Write(const Buffer; Count : Longint) : Longint;
{$IFDEF IP_LAZARUS}
begin begin
writeln('ToDo: TIpDownloadFileStream.Write'); writeln('ToDo: TIpDownloadFileStream.Write');
Result:=Count; Result:=Count;
end; end;
{$ELSE} {
var var
WriteOK : Bool; WriteOK : Bool;
begin begin
@ -1748,7 +1702,7 @@ begin
Result := 0 Result := 0
end; end;
end; end;
{$ENDIF} }
{ TIpByteStream } { TIpByteStream }

188
components/turbopower_ipro/iputils.pas
View File

@ -36,12 +36,7 @@ interface
uses uses
SysUtils, Classes, Controls, Registry, ComCtrls, SysUtils, Classes, Controls, Registry, ComCtrls,
{$IFDEF IP_LAZARUS}
LCLType, GraphType, LCLIntf, LMessages, LazFileUtils, lazutf8classes, LCLProc; LCLType, GraphType, LCLIntf, LMessages, LazFileUtils, lazutf8classes, LCLProc;
{$ELSE}
Messages, Windows, ExtCtrls, SyncObjs;
{$ENDIF}
const const
InternetProfessionalVersion = 1.15; InternetProfessionalVersion = 1.15;
@ -73,9 +68,7 @@ const
CM_IPSMTPEVENT = IpMsgBase + 21; CM_IPSMTPEVENT = IpMsgBase + 21;
CM_IPPOP3EVENT = IpMsgBase + 22; CM_IPPOP3EVENT = IpMsgBase + 22;
CM_IPNNTPEVENT = IpMsgBase + 23; CM_IPNNTPEVENT = IpMsgBase + 23;
{$IFDEF IP_LAZARUS}
CM_IPHOTINVOKE = IpMsgBase + 24; CM_IPHOTINVOKE = IpMsgBase + 24;
{$ENDIF}
type type
TIpLineTerminator = (ltNone, ltCR, ltLF, ltCRLF, ltOther); TIpLineTerminator = (ltNone, ltCR, ltLF, ltCRLF, ltOther);
@ -107,11 +100,7 @@ type
TIpBaseAccess = class TIpBaseAccess = class
private private
{$IFDEF IP_LAZARUS}
baPropCS : TCriticalSection; baPropCS : TCriticalSection;
{$ELSE}
baPropCS : TRTLCriticalSection;
{$ENDIF}
public public
constructor Create; virtual; constructor Create; virtual;
destructor Destroy; override; destructor Destroy; override;
@ -121,11 +110,7 @@ type
TIpBasePersistent = class(TPersistent) TIpBasePersistent = class(TPersistent)
private private
{$IFDEF IP_LAZARUS}
bpPropCS : TCriticalSection; bpPropCS : TCriticalSection;
{$ELSE}
bpPropCS : TRTLCriticalSection;
{$ENDIF}
public public
constructor Create; virtual; constructor Create; virtual;
destructor Destroy; override; destructor Destroy; override;
@ -210,10 +195,8 @@ type
QueryDelim : AnsiChar; QueryDelim : AnsiChar;
end; end;
{$IFDEF IP_LAZARUS}
procedure Initialize(var AddrRec: TIpAddrRec); procedure Initialize(var AddrRec: TIpAddrRec);
procedure Finalize(var AddrRec: TIpAddrRec); procedure Finalize(var AddrRec: TIpAddrRec);
{$ENDIF}
function ExtractEntityName(const NamePath: string): string; function ExtractEntityName(const NamePath: string): string;
function ExtractEntityPath(const NamePath: string): string; function ExtractEntityPath(const NamePath: string): string;
@ -254,16 +237,12 @@ implementation
{ Allow other processes a chance to run } { Allow other processes a chance to run }
function SafeYield : LongInt; function SafeYield : LongInt;
{$IFNDEF IP_LAZARUS}
var
Msg : TMsg;
{$ENDIF}
begin begin
SafeYield := 0; SafeYield := 0;
{$IFDEF IP_LAZARUS}
writeln('ToDo: IpUtils.SafeYield'); writeln('ToDo: IpUtils.SafeYield');
exit; (*
{$ELSE} var
Msg : TMsg;
if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then begin if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then begin
if Msg.Message = wm_Quit then if Msg.Message = wm_Quit then
{Re-post quit message so main message loop will terminate} {Re-post quit message so main message loop will terminate}
@ -274,8 +253,7 @@ begin
end; end;
{Return message so caller can act on message if necessary} {Return message so caller can act on message if necessary}
SafeYield := MAKELONG(Msg.Message, Msg.hwnd); SafeYield := MAKELONG(Msg.Message, Msg.hwnd);
end; *)
{$ENDIF}
end; end;
{ Trim leading and trailing spaces from a string } { Trim leading and trailing spaces from a string }
@ -457,7 +435,6 @@ begin
Result := Result + (Idx - 1); Result := Result + (Idx - 1);
end; end;
{$IFDEF IP_LAZARUS}
procedure Initialize(var AddrRec: TIpAddrRec); procedure Initialize(var AddrRec: TIpAddrRec);
begin begin
AddrRec.QueryDelim:=#0; AddrRec.QueryDelim:=#0;
@ -476,7 +453,6 @@ begin
Query :=''; Query :='';
end; end;
end; end;
{$ENDIF}
const const
CrcBufSize = 2048; CrcBufSize = 2048;
@ -861,7 +837,6 @@ end;
{ Compares two fixed size structures } { Compares two fixed size structures }
function IpCompStruct(const S1, S2; Size : Cardinal) : Integer; function IpCompStruct(const S1, S2; Size : Cardinal) : Integer;
{$IFDEF IP_LAZARUS}
{$IFDEF CPUI386} {$IFDEF CPUI386}
asm asm
push edi push edi
@ -888,34 +863,6 @@ begin
Result := CompareMemRange(@S1, @S2, Size); Result := CompareMemRange(@S1, @S2, Size);
end; end;
{$ENDIF} {$ENDIF}
{$ELSE}
{$IFDEF CPU386}
asm
push edi
push esi
mov esi, eax
mov edi, edx
xor eax, eax
or ecx, ecx
jz @@CSDone
repe cmpsb
je @@CSDone
inc eax
ja @@CSDone
or eax, -1
@@CSDone:
pop esi
pop edi
end;
{$ELSE}
begin
Result := CompareMemRange(@S1, @S2, Size);
end;
{$ENDIF}
{$ENDIF}
function IpCharCount(const Buffer; BufSize : DWORD; C : AnsiChar) : DWORD; function IpCharCount(const Buffer; BufSize : DWORD; C : AnsiChar) : DWORD;
register; register;
@ -1086,17 +1033,13 @@ end;
{ Returns an appropriate string for the given parameters } { Returns an appropriate string for the given parameters }
class function TIpBaseComponent.GetLogString(const S, D1, D2, D3: DWORD): string; class function TIpBaseComponent.GetLogString(const S, D1, D2, D3: DWORD): string;
begin begin
{$IFDEF IP_LAZARUS}
if (S=0) or (D1=0) or (D2=0) or (D3=0) then ; // avoid hints if (S=0) or (D1=0) or (D2=0) or (D3=0) then ; // avoid hints
{$ENDIF} Result := '!!!! Unhandled log entry'#10#13;
Result := '!!!! Unhandled log entry'#10#13;
end; end;
procedure TIpBaseComponent.SetVersion(const Value: string); procedure TIpBaseComponent.SetVersion(const Value: string);
begin begin
{$IFDEF IP_LAZARUS}
if (Value='') then ; // avoid hints if (Value='') then ; // avoid hints
{$ENDIF}
{ Intentionally empty } { Intentionally empty }
end; end;
@ -1109,9 +1052,7 @@ end;
procedure TIpBaseWinControl.SetVersion(const Value : string); procedure TIpBaseWinControl.SetVersion(const Value : string);
begin begin
{$IFDEF IP_LAZARUS}
if (Value='') then ; // avoid hints if (Value='') then ; // avoid hints
{$ENDIF}
{ Intentionally empty } { Intentionally empty }
end; end;
@ -1183,11 +1124,7 @@ begin
for i := 1 to Length(Result) do begin for i := 1 to Length(Result) do begin
case Result[i] of case Result[i] of
'|': Result[i] := ':'; '|': Result[i] := ':';
{$IFDEF IP_LAZARUS}
'/': Result[i] := DirectorySeparator; '/': Result[i] := DirectorySeparator;
{$ELSE}
'/': Result[i] := '\';
{$ENDIF}
else else
{ leave it alone }; { leave it alone };
end; end;
@ -1208,11 +1145,7 @@ begin
for i := 1 to Length(Result) do begin for i := 1 to Length(Result) do begin
case Result[i] of case Result[i] of
':': Result[i] := '|'; ':': Result[i] := '|';
{$IFDEF IP_LAZARUS}
DirectorySeparator: Result[i] := '/'; DirectorySeparator: Result[i] := '/';
{$ELSE}
'\': Result[i] := '/';
{$ENDIF}
else else
{ leave it alone }; { leave it alone };
end; end;
@ -1317,9 +1250,7 @@ var
State : TUrlParseState; State : TUrlParseState;
PotAuth, PotPath : string; PotAuth, PotPath : string;
SchemeSeen: Boolean; SchemeSeen: Boolean;
{$IFDEF IP_LAZARUS}
SlashCount: integer; SlashCount: integer;
{$ENDIF}
procedure ProcessChar; procedure ProcessChar;
begin begin
@ -1398,9 +1329,7 @@ begin
SchemeSeen := True; SchemeSeen := True;
PotAuth := ''; PotAuth := '';
State := psSchemeSlashes; State := psSchemeSlashes;
{$IFDEF IP_LAZARUS}
SlashCount := 0; SlashCount := 0;
{$ENDIF}
end end
else begin else begin
@ -1454,9 +1383,7 @@ begin
SchemeSeen := True; SchemeSeen := True;
PotAuth := ''; PotAuth := '';
State := psSchemeSlashes; State := psSchemeSlashes;
{$IFDEF IP_LAZARUS}
SlashCount := 0; SlashCount := 0;
{$ENDIF}
end; end;
'A'..'Z', 'a'..'z': begin 'A'..'Z', 'a'..'z': begin
@ -1483,30 +1410,25 @@ begin
end; end;
psSchemeSlashes: begin psSchemeSlashes: begin
{$IFDEF IP_LAZARUS}
inc(SlashCount); inc(SlashCount);
if (p^ <> '/') or (SlashCount > 2) then if (p^ <> '/') or (SlashCount > 2) then
{$ENDIF} case P^ of
case P^ of '.', '\','/': begin { start of a local path }
{$IFNDEF IP_LAZARUS} PotPath := PotPath + P^;
'/': { ignore }; State := psLocalPath;
{$ENDIF} end;
'.', '\'{$IFDEF IP_LAZARUS},'/'{$ENDIF}: begin { start of a local path }
PotPath := PotPath + P^;
State := psLocalPath;
end;
else begin
if CharPos('@', URL) > 0 then begin
PotAuth := P^;
State := psUserName;
end
else begin else begin
PotAuth := P^; if CharPos('@', URL) > 0 then begin
State := psPotAuth; PotAuth := P^;
State := psUserName;
end
else begin
PotAuth := P^;
State := psPotAuth;
end;
end; end;
end; end;
end;
end; end;
@ -2655,13 +2577,12 @@ end;
{ returns the current local TimeZone "bias" in minutes from UTC (GMT) } { returns the current local TimeZone "bias" in minutes from UTC (GMT) }
function TimeZoneBias : Integer; function TimeZoneBias : Integer;
{$IFDEF IP_LAZARUS}
begin begin
Result:=0; Result:=0;
writeln('TimeZoneBias ToDo'); writeln('TimeZoneBias ToDo');
end; end;
{$ELSE}
{$IFDEF VERSION3} (*
const const
TIME_ZONE_ID_UNKNOWN = 0; TIME_ZONE_ID_UNKNOWN = 0;
TIME_ZONE_ID_STANDARD = 1; TIME_ZONE_ID_STANDARD = 1;
@ -2677,7 +2598,7 @@ begin
TIME_ZONE_ID_DAYLIGHT : Result := TZI.Bias + TZI.DaylightBias; TIME_ZONE_ID_DAYLIGHT : Result := TZI.Bias + TZI.DaylightBias;
end; end;
end; end;
{$ENDIF} *)
{ Format TDateTime to standard HTTP date string } { Format TDateTime to standard HTTP date string }
function DateTimeToINetDateTimeStr(DateTime: TDateTime): string; function DateTimeToINetDateTimeStr(DateTime: TDateTime): string;
@ -2699,7 +2620,6 @@ end;
{ File/Directory Stuff } { File/Directory Stuff }
{ Retreive Windows "MIME" type for a particular file extension } { Retreive Windows "MIME" type for a particular file extension }
{$IFDEF IP_LAZARUS}
{$ifndef MSWindows} {$ifndef MSWindows}
{define some basic mime types} {define some basic mime types}
const MimeTypeExt : Array[0..4] of String = ('.htm','.html','.txt','.jpg','.png'); const MimeTypeExt : Array[0..4] of String = ('.htm','.html','.txt','.jpg','.png');
@ -2742,105 +2662,39 @@ begin
//DebugLn('IpUtils.GetLocalContent File:'+TheFileName+' Result:'+result); //DebugLn('IpUtils.GetLocalContent File:'+TheFileName+' Result:'+result);
end; end;
{$ELSE}
{ Retreive Windows "MIME" type for a particular file extension }
function GetLocalContent(const TheFileName: string): string;
var
Reg : TRegistry;
Ext : string;
begin
Result := '';
Ext := ExtractFileExt(TheFileName);
Reg := nil;
try
Reg := TRegistry.Create;
Reg.RootKey := HKEY_CLASSES_ROOT;
if Reg.OpenKey(Ext, True) then
Result := Reg.ReadString('Content Type');
finally
Reg.CloseKey;
Reg.Free;
end;
end;
{$ENDIF}
{ Determine if a directory exists } { Determine if a directory exists }
function DirExists(Dir : string): Boolean; function DirExists(Dir : string): Boolean;
{$IFDEF IP_LAZARUS}
begin begin
Result:=DirPathExists(Dir); Result:=DirPathExists(Dir);
end; end;
{$ELSE}
var
Attributes : Integer;
begin
Attributes := GetFileAttributes(PAnsiChar(Dir));
Result := (Attributes <> -1) and
(Attributes and FILE_ATTRIBUTE_DIRECTORY <> 0);
end;
{$ENDIF}
{Begin !!.12} {Begin !!.12}
{ Get temporary filename as string } { Get temporary filename as string }
function GetTemporaryFile(const Path : string) : string; function GetTemporaryFile(const Path : string) : string;
{$IFDEF IP_LAZARUS}
begin begin
Result:=GetTempFileNameUTF8(Path,'IP_'); Result:=GetTempFileNameUTF8(Path,'IP_');
end; end;
{$ELSE}
var
TempFileName : array [0..MAX_PATH] of AnsiChar;
begin
{ Create a new uniquely named file in that folder. }
GetTempFileName(PAnsiChar(Path), 'IP_', 0, TempFileName);
Result := TempFileName;
end;
{$ENDIF}
{End !!.12} {End !!.12}
{ Get Windows system TEMP path in a string } { Get Windows system TEMP path in a string }
function GetTemporaryPath: string; function GetTemporaryPath: string;
{$IFDEF IP_LAZARUS}
begin begin
writeln('ToDo: IpUtils.GetTemporaryPath'); writeln('ToDo: IpUtils.GetTemporaryPath');
Result:=''; Result:='';
end; end;
{$ELSE}
var
PathBuf : array [0..MAX_PATH] of char;
begin
GetTempPath(MAX_PATH + 1, PathBuf);
Result := StrPas(PathBuf);
end;
{$ENDIF}
{ Append backslash to DOS path if needed } { Append backslash to DOS path if needed }
function AppendBackSlash(APath : string) : string; function AppendBackSlash(APath : string) : string;
begin begin
{$IFDEF IP_LAZARUS}
Result := AppendPathDelim(APath); Result := AppendPathDelim(APath);
{$ELSE}
Result := APath;
if (Result <> '') and (Result[Length(APath)] <> '\') then
Result := Result + '\';
{$ENDIF}
end; end;
{ Remove trailing backslash from a DOS path if needed } { Remove trailing backslash from a DOS path if needed }
function RemoveBackSlash(APath: string) : string; function RemoveBackSlash(APath: string) : string;
begin begin
{$IFDEF IP_LAZARUS}
Result := ChompPathDelim(APath); Result := ChompPathDelim(APath);
{$ELSE}
Result := APath;
if Result[Length(Result)] = '\' then
Delete(Result, Length(Result), 1);
{$ENDIF}
end; end;
{***********************************************} {***********************************************}
{cookie support} {cookie support}