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

fixed compilation of HTMLLite from Jason

Browse Source 
git-svn-id: trunk@5182 -
This commit is contained in:
mattias 2004-02-08 13:06:45 +00:00
parent c111d6709d
commit 683d3564ff
4 changed files with 103 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
components/htmllite/htmllite.pas
View File

@ -11,6 +11,7 @@
unit HTMLLite; unit HTMLLite;
interface interface
{$DEFINE HL_LAZARUS}
{$IFDEF HL_LAZARUS} {$IFDEF HL_LAZARUS}
uses uses
@ -225,7 +226,11 @@ type
procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE; procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
procedure BackgroundChange(Sender: TObject); procedure BackgroundChange(Sender: TObject);
procedure SubmitForm(Sender: TObject; procedure SubmitForm(Sender: TObject;
const Action, TheTarget, EncType, Method: string; Results: TStringList); {$IFDEF HL_LAZARUS}
const TheAction, TheTarget, EncType, Method: string; Results: TStringList);
{$ELSE}
const Action, TheTarget, EncType, Method: string; Results: TStringList);
{$ENDIF}
procedure SetImageCacheCount(Value: integer); procedure SetImageCacheCount(Value: integer);
procedure WMFormSubmit(var Message: TMessage); message WM_FormSubmit; procedure WMFormSubmit(var Message: TMessage); message WM_FormSubmit;
procedure WMMouseScroll(var Message: TMessage); message WM_MouseScroll; procedure WMMouseScroll(var Message: TMessage); message WM_MouseScroll;
@ -2216,11 +2221,20 @@ else FSectionList.SubmitForm := Nil;
end; end;
procedure ThtmlLite.SubmitForm(Sender: TObject; procedure ThtmlLite.SubmitForm(Sender: TObject;
{$IFDEF HL_LAZARUS}
const TheAction, TheTarget, EncType, Method: string; Results: TStringList);
{$ELSE}
const Action, TheTarget, EncType, Method: string; Results: TStringList); const Action, TheTarget, EncType, Method: string; Results: TStringList);
{$ENDIF}
begin begin
if Assigned(FOnFormSubmit) then if Assigned(FOnFormSubmit) then
begin begin
{$IFDEF HL_LAZARUS}
FAction := TheAction;
{$ELSE}
FAction := Action; FAction := Action;
{$ENDIF}
FMethod := Method; FMethod := Method;
FFormTarget := TheTarget; FFormTarget := TheTarget;
FEncType:= EncType; FEncType:= EncType;

4
components/htmllite/lazhtmllite.pas
View File

@ -8,8 +8,8 @@ unit LazHTMLLite;
interface interface
uses uses
HTMLLite, LiteDith, LitePars, LiteReadThd, LiteSbs1, LiteSubs, LiteUn2,
LiteGIF2, LazarusPackageIntf; HTMLLite, LiteDith, LitePars, LiteReadThd, LiteSbs1, LiteSubs, LiteUn2, LiteGIF2, LazarusPackageIntf;
implementation implementation

87
components/htmllite/litepars.pas
View File

@ -614,31 +614,36 @@ try
while I <=5 do while I <=5 do
begin begin
if not (Ch in ['0'..'9']) then if not (Ch in ['0'..'9']) then
begin begin
if Ch = ';' then NextCh; if Ch = ';' then NextCh;
if S <> '' then if S <> '' then
begin begin
N := StrToInt(S); N := StrToInt(S);
if (N > 255) then if (N > 255) then
begin begin
W := WideChar(N); //don't know what to do about widechar , comment out for now
S := WideCharLenToString(@W, 1); {$IFNDEF HL_LAZARUS}
LCToken.AddChar(S[1], SaveIndex); W := WideChar(N);
GoTo 2; S := WideCharLenToString(@W, 1);
LCToken.AddChar(S[1], SaveIndex);
{$ELSE}
LCToken.AddChar({S[1]}' ', SaveIndex);
{$ENDIF}
GoTo 2;
end end
else if (byte(N) in [9, 10, 32..255]) then else if (byte(N) in [9, 10, 32..255]) then
begin begin
if N = 9 then LCToken.AddChar(' ', SaveIndex) if N = 9 then LCToken.AddChar(' ', SaveIndex)
else LCToken.AddChar(chr(N), SaveIndex); else LCToken.AddChar(chr(N), SaveIndex);
GoTo 2; GoTo 2;
end; end;
end; end;
LCToken.Concat(Collect); LCToken.Concat(Collect);
GoTo 2; GoTo 2;
end; end;
S := S+LCh; S := S+LCh;
Inc(I); Inc(I);
NextCh; NextCh;
end; end;
LCToken.Concat(Collect); LCToken.Concat(Collect);
GoTo 2; GoTo 2;
@ -1271,14 +1276,22 @@ procedure ThlParser.GetOptions(Select: TListBoxFormControlObj);
{get the <option>s for Select form control} {get the <option>s for Select form control}
var var
Selected, InOption: boolean; Selected, InOption: boolean;
{$IFDEF HL_LAZARUS}
Answer, S: string[255];
{$ELSE}
Value, S: string[255]; Value, S: string[255];
{$ENDIF}
T: TAttribute; T: TAttribute;
SaveNoBreak: boolean; SaveNoBreak: boolean;
begin begin
SaveNoBreak := NoBreak; SaveNoBreak := NoBreak;
NoBreak := False; NoBreak := False;
Next; Next;
{$IFDEF HL_LAZARUS}
S := ''; Answer := '';
{$ELSE}
S := ''; Value := ''; S := ''; Value := '';
{$ENDIF}
Selected := False; InOption := False; Selected := False; InOption := False;
while not (Sy in[SelectEndSy, EofSy]) do while not (Sy in[SelectEndSy, EofSy]) do
begin begin
@ -1289,9 +1302,17 @@ while not (Sy in[SelectEndSy, EofSy]) do
if S <> '' then if S <> '' then
begin begin
if InOption then if InOption then
{$IFDEF HL_LAZARUS}
Select.AddStr(S, Answer, Selected);
{$ELSE}
Select.AddStr(S, Value, Selected); Select.AddStr(S, Value, Selected);
{$ENDIF}
S := ''; S := '';
{$IFDEF HL_LAZARUS}
Answer := '';
{$ELSE}
Value := ''; Value := '';
{$ENDIF}
Selected := False; Selected := False;
end; end;
InOption := Sy = OptionSy; InOption := Sy = OptionSy;
@ -1299,7 +1320,11 @@ while not (Sy in[SelectEndSy, EofSy]) do
begin begin
Selected := Attributes.Find(SelectedSy, T); Selected := Attributes.Find(SelectedSy, T);
if Attributes.Find(ValueSy, T) then if Attributes.Find(ValueSy, T) then
{$IFDEF HL_LAZARUS}
Answer := T.Name;
{$ELSE}
Value := T.Name; Value := T.Name;
{$ENDIF}
end; end;
end; end;
TextSy: if InOption then TextSy: if InOption then
@ -1311,7 +1336,11 @@ if InOption then
begin begin
S := Trim(S); S := Trim(S);
if S <> '' then if S <> '' then
{$IFDEF HL_LAZARUS}
Select.AddStr(S, Answer, Selected);
{$ELSE}
Select.AddStr(S, Value, Selected); Select.AddStr(S, Value, Selected);
{$ENDIF}
end; end;
NoBreak := SaveNoBreak; NoBreak := SaveNoBreak;
end; end;
@ -1392,17 +1421,30 @@ const
var var
Lang, AName: string; Lang, AName: string;
T: TAttribute; T: TAttribute;
{$IFDEF HL_LAZARUS}
TempStore: PChar;
{$ELSE}
Buffer: PChar; Buffer: PChar;
{$ENDIF}
Pos, Size: integer; Pos, Size: integer;
procedure AddText(const S: string); procedure AddText(const S: string);
begin begin
if Pos + Length(S) >= Size then if Pos + Length(S) >= Size then
begin {Delphi 2,3, add to buffer} {$IFDEF HL_LAZARUS}
begin {Delphi 2,3, add to TempStore}
ReAllocMem(TempStore, Size+10000);
{$ELSE}
begin {Delphi 2,3, add to Buffer}
ReAllocMem(Buffer, Size+10000); ReAllocMem(Buffer, Size+10000);
{$ENDIF}
Inc(Size, 10000); Inc(Size, 10000);
end; end;
{$IFDEF HL_LAZARUS}
Move(S[1], TempStore[Pos], Length(S));
{$ELSE}
Move(S[1], Buffer[Pos], Length(S)); Move(S[1], Buffer[Pos], Length(S));
{$ENDIF}
Inc(Pos, Length(S)); Inc(Pos, Length(S));
end; end;
@ -1464,7 +1506,11 @@ try
AName := T.Name AName := T.Name
else AName := ''; else AName := '';
{$IFDEF HL_LAZARUS}
GetMem(TempStore, Block);
{$ELSE}
GetMem(Buffer, Block); GetMem(Buffer, Block);
{$ENDIF}
Pos := 0; Pos := 0;
Size := Block; Size := Block;
try try
@ -1477,10 +1523,15 @@ try
Next1; Next1;
end; end;
AddText(#0); AddText(#0);
{$IFDEF HL_LAZARUS}
ReAllocMem(TempStore, Size);
AScript(CallingObject, AName, Lang, TempStore);
{$ELSE}
ReAllocMem(Buffer, Size); ReAllocMem(Buffer, Size);
AScript(CallingObject, AName, Lang, Buffer); AScript(CallingObject, AName, Lang, Buffer);
{$ENDIF}
except except
FreeMem(Buffer); FreeMem(TempStore);
Raise; Raise;
end; end;
end end

16
components/htmllite/liteun2.pas
View File

@ -363,6 +363,7 @@ function HTMLToDos(FName: string): string;
var var
I: integer; I: integer;
{$IFDEF HL_LAZARUS}
procedure Replace(Old, New: char); procedure Replace(Old, New: char);
var var
I: integer; I: integer;
@ -374,7 +375,19 @@ var
I := Pos(Old, FName); I := Pos(Old, FName);
end; end;
end; end;
{$ELSE}
procedure Replace(Oldchar, Newchar: char);
var
I: integer;
begin
I := Pos(Oldchar, FName);
while I > 0 do
begin
FName[I] := Newchar;
I := Pos(Oldchar, FName);
end;
end;
{$ENDIF}
procedure ReplaceEscapeChars; procedure ReplaceEscapeChars;
var var
S: string[3]; S: string[3];
@ -394,6 +407,7 @@ var
end; end;
end; end;
begin begin
ReplaceEscapeChars; ReplaceEscapeChars;
I := pos('/', FName); I := pos('/', FName);