mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-07 15:19:25 +01:00
added htmllite
git-svn-id: trunk@3744 -
This commit is contained in:
mattias
parent
c9dfc381a4
commit
1428729afd
12
.gitattributes
vendored
12
.gitattributes
vendored
@ -44,6 +44,18 @@ components/gtk/gtkglarea/gtkopengl.pas svneol=native#text/pascal
|
|||||||
components/gtk/gtkglarea/nvgl.pp svneol=native#text/pascal
|
components/gtk/gtkglarea/nvgl.pp svneol=native#text/pascal
|
||||||
components/gtk/gtkglarea/nvglx.pp svneol=native#text/pascal
|
components/gtk/gtkglarea/nvglx.pp svneol=native#text/pascal
|
||||||
components/gtk/gtkglarea/tgtkglareacontrol.xpm -text svneol=native#image/x-xpixmap
|
components/gtk/gtkglarea/tgtkglareacontrol.xpm -text svneol=native#image/x-xpixmap
|
||||||
|
components/htmllite/html32.res svneol=native#unset
|
||||||
|
components/htmllite/htmllite.dcr -text svneol=native#application/x-director
|
||||||
|
components/htmllite/htmllite.pas svneol=native#text/pascal
|
||||||
|
components/htmllite/litecons.inc svneol=native#text/pascal
|
||||||
|
components/htmllite/litedith.pas svneol=native#text/pascal
|
||||||
|
components/htmllite/litegif1.pas svneol=native#text/pascal
|
||||||
|
components/htmllite/litegif2.pas svneol=native#text/pascal
|
||||||
|
components/htmllite/litepars.pas svneol=native#text/pascal
|
||||||
|
components/htmllite/litereadthd.pas svneol=native#text/pascal
|
||||||
|
components/htmllite/litesbs1.pas svneol=native#text/pascal
|
||||||
|
components/htmllite/litesubs.pas svneol=native#text/pascal
|
||||||
|
components/htmllite/liteun2.pas svneol=native#text/pascal
|
||||||
components/synedit/allunits.pp svneol=native#text/pascal
|
components/synedit/allunits.pp svneol=native#text/pascal
|
||||||
components/synedit/languages/synedit.de.po svneol=native#text/plain
|
components/synedit/languages/synedit.de.po svneol=native#text/plain
|
||||||
components/synedit/languages/synedit.po svneol=native#text/plain
|
components/synedit/languages/synedit.po svneol=native#text/plain
|
||||||
|
|||||||
45
components/htmllite/dclLVw3.dpk
Normal file
45
components/htmllite/dclLVw3.dpk
Normal file
@ -0,0 +1,45 @@
|
|||||||
|
package dclLVw3;
|
||||||
|
|
||||||
|
{$R *.RES}
|
||||||
|
{$R 'htmllite.dcr'}
|
||||||
|
{$ALIGN ON}
|
||||||
|
{$ASSERTIONS OFF}
|
||||||
|
{$BOOLEVAL OFF}
|
||||||
|
{$DEBUGINFO OFF}
|
||||||
|
{$EXTENDEDSYNTAX ON}
|
||||||
|
{$IMPORTEDDATA ON}
|
||||||
|
{$IOCHECKS ON}
|
||||||
|
{$LOCALSYMBOLS OFF}
|
||||||
|
{$LONGSTRINGS ON}
|
||||||
|
{$OPENSTRINGS ON}
|
||||||
|
{$OPTIMIZATION ON}
|
||||||
|
{$OVERFLOWCHECKS OFF}
|
||||||
|
{$RANGECHECKS OFF}
|
||||||
|
{$REFERENCEINFO OFF}
|
||||||
|
{$SAFEDIVIDE OFF}
|
||||||
|
{$STACKFRAMES OFF}
|
||||||
|
{$TYPEDADDRESS OFF}
|
||||||
|
{$VARSTRINGCHECKS ON}
|
||||||
|
{$WRITEABLECONST ON}
|
||||||
|
{$MINENUMSIZE 1}
|
||||||
|
{$IMAGEBASE $00400000}
|
||||||
|
{$DESIGNONLY}
|
||||||
|
{$IMPLICITBUILD ON}
|
||||||
|
|
||||||
|
requires
|
||||||
|
vcl30;
|
||||||
|
|
||||||
|
contains
|
||||||
|
LiteUn2,
|
||||||
|
LitePars,
|
||||||
|
LiteSbs1,
|
||||||
|
LiteSubs,
|
||||||
|
HTMLLite,
|
||||||
|
jpeg,
|
||||||
|
jconsts,
|
||||||
|
LiteDith,
|
||||||
|
LiteReadThd,
|
||||||
|
litegif2,
|
||||||
|
litegif1;
|
||||||
|
|
||||||
|
end.
|
||||||
45
components/htmllite/dclLVw4.dpk
Normal file
45
components/htmllite/dclLVw4.dpk
Normal file
@ -0,0 +1,45 @@
|
|||||||
|
package dclLVw4;
|
||||||
|
|
||||||
|
{$R *.RES}
|
||||||
|
{$R 'htmllite.dcr'}
|
||||||
|
{$ALIGN ON}
|
||||||
|
{$ASSERTIONS ON}
|
||||||
|
{$BOOLEVAL OFF}
|
||||||
|
{$DEBUGINFO OFF}
|
||||||
|
{$EXTENDEDSYNTAX ON}
|
||||||
|
{$IMPORTEDDATA ON}
|
||||||
|
{$IOCHECKS ON}
|
||||||
|
{$LOCALSYMBOLS OFF}
|
||||||
|
{$LONGSTRINGS ON}
|
||||||
|
{$OPENSTRINGS ON}
|
||||||
|
{$OPTIMIZATION ON}
|
||||||
|
{$OVERFLOWCHECKS OFF}
|
||||||
|
{$RANGECHECKS OFF}
|
||||||
|
{$REFERENCEINFO OFF}
|
||||||
|
{$SAFEDIVIDE OFF}
|
||||||
|
{$STACKFRAMES OFF}
|
||||||
|
{$TYPEDADDRESS OFF}
|
||||||
|
{$VARSTRINGCHECKS ON}
|
||||||
|
{$WRITEABLECONST ON}
|
||||||
|
{$MINENUMSIZE 1}
|
||||||
|
{$IMAGEBASE $00400000}
|
||||||
|
{$DESCRIPTION 'ThtmlLite'}
|
||||||
|
{$DESIGNONLY}
|
||||||
|
{$IMPLICITBUILD OFF}
|
||||||
|
|
||||||
|
requires
|
||||||
|
vcl40,
|
||||||
|
VCLJPG40;
|
||||||
|
|
||||||
|
contains
|
||||||
|
LiteUn2 in 'LiteUn2.pas',
|
||||||
|
LitePars in 'LitePars.pas',
|
||||||
|
LiteSbs1 in 'LiteSbs1.pas',
|
||||||
|
LiteSubs in 'LiteSubs.pas',
|
||||||
|
HTMLLite in 'HTMLLite.pas',
|
||||||
|
LiteDith in 'LiteDith.pas',
|
||||||
|
LiteReadThd in 'LiteReadThd.pas',
|
||||||
|
litegif1 in 'litegif1.pas',
|
||||||
|
litegif2 in 'litegif2.pas';
|
||||||
|
|
||||||
|
end.
|
||||||
47
components/htmllite/dclLVw5.dpk
Normal file
47
components/htmllite/dclLVw5.dpk
Normal file
@ -0,0 +1,47 @@
|
|||||||
|
package dclLVw5;
|
||||||
|
|
||||||
|
{$R *.RES}
|
||||||
|
{$R 'htmllite.dcr'}
|
||||||
|
{$ALIGN OFF}
|
||||||
|
{$ASSERTIONS OFF}
|
||||||
|
{$BOOLEVAL OFF}
|
||||||
|
{$DEBUGINFO OFF}
|
||||||
|
{$EXTENDEDSYNTAX ON}
|
||||||
|
{$IMPORTEDDATA OFF}
|
||||||
|
{$IOCHECKS ON}
|
||||||
|
{$LOCALSYMBOLS OFF}
|
||||||
|
{$LONGSTRINGS ON}
|
||||||
|
{$OPENSTRINGS ON}
|
||||||
|
{$OPTIMIZATION ON}
|
||||||
|
{$OVERFLOWCHECKS OFF}
|
||||||
|
{$RANGECHECKS OFF}
|
||||||
|
{$REFERENCEINFO OFF}
|
||||||
|
{$SAFEDIVIDE OFF}
|
||||||
|
{$STACKFRAMES OFF}
|
||||||
|
{$TYPEDADDRESS OFF}
|
||||||
|
{$VARSTRINGCHECKS ON}
|
||||||
|
{$WRITEABLECONST ON}
|
||||||
|
{$MINENUMSIZE 1}
|
||||||
|
{$IMAGEBASE $400000}
|
||||||
|
{$DESCRIPTION 'ThtmlLite'}
|
||||||
|
{$DESIGNONLY}
|
||||||
|
{$IMPLICITBUILD ON}
|
||||||
|
|
||||||
|
requires
|
||||||
|
vcl50,
|
||||||
|
VCLJPG50;
|
||||||
|
|
||||||
|
{%File 'LiteCons.inc'}
|
||||||
|
|
||||||
|
contains
|
||||||
|
HTMLLite in 'HTMLLite.pas',
|
||||||
|
LiteUn2 in 'LiteUn2.pas',
|
||||||
|
LitePars in 'LitePars.pas',
|
||||||
|
LiteSbs1 in 'LiteSbs1.pas',
|
||||||
|
LiteSubs in 'LiteSubs.pas',
|
||||||
|
LiteDith in 'LiteDith.pas',
|
||||||
|
litegif1 in 'litegif1.pas',
|
||||||
|
litegif2 in 'litegif2.pas',
|
||||||
|
LiteReadThd in 'LiteReadThd.pas';
|
||||||
|
|
||||||
|
end.
|
||||||
47
components/htmllite/dclLVw6.dpk
Normal file
47
components/htmllite/dclLVw6.dpk
Normal file
@ -0,0 +1,47 @@
|
|||||||
|
package dclLVw6;
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
{$R 'htmllite.dcr'}
|
||||||
|
{$ALIGN 1}
|
||||||
|
{$ASSERTIONS OFF}
|
||||||
|
{$BOOLEVAL OFF}
|
||||||
|
{$DEBUGINFO OFF}
|
||||||
|
{$EXTENDEDSYNTAX ON}
|
||||||
|
{$IMPORTEDDATA OFF}
|
||||||
|
{$IOCHECKS ON}
|
||||||
|
{$LOCALSYMBOLS OFF}
|
||||||
|
{$LONGSTRINGS ON}
|
||||||
|
{$OPENSTRINGS ON}
|
||||||
|
{$OPTIMIZATION ON}
|
||||||
|
{$OVERFLOWCHECKS OFF}
|
||||||
|
{$RANGECHECKS OFF}
|
||||||
|
{$REFERENCEINFO OFF}
|
||||||
|
{$SAFEDIVIDE OFF}
|
||||||
|
{$STACKFRAMES OFF}
|
||||||
|
{$TYPEDADDRESS OFF}
|
||||||
|
{$VARSTRINGCHECKS ON}
|
||||||
|
{$WRITEABLECONST ON}
|
||||||
|
{$MINENUMSIZE 1}
|
||||||
|
{$IMAGEBASE $400000}
|
||||||
|
{$DESCRIPTION 'ThtmlLite'}
|
||||||
|
{$DESIGNONLY}
|
||||||
|
{$IMPLICITBUILD ON}
|
||||||
|
|
||||||
|
requires
|
||||||
|
vcl,
|
||||||
|
vcljpg;
|
||||||
|
|
||||||
|
{%File 'LiteCons.inc'}
|
||||||
|
|
||||||
|
contains
|
||||||
|
HTMLLite in 'HTMLLite.pas',
|
||||||
|
LiteUn2 in 'LiteUn2.pas',
|
||||||
|
LitePars in 'LitePars.pas',
|
||||||
|
LiteSbs1 in 'LiteSbs1.pas',
|
||||||
|
LiteSubs in 'LiteSubs.pas',
|
||||||
|
LiteDith in 'LiteDith.pas',
|
||||||
|
LiteReadThd in 'LiteReadThd.pas',
|
||||||
|
litegif2 in 'litegif2.pas',
|
||||||
|
litegif1 in 'litegif1.pas';
|
||||||
|
|
||||||
|
end.
|
||||||
48
components/htmllite/dclLVw7.dpk
Normal file
48
components/htmllite/dclLVw7.dpk
Normal file
@ -0,0 +1,48 @@
|
|||||||
|
package dclLVw7;
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
{$R 'htmllite.dcr'}
|
||||||
|
{$ALIGN 1}
|
||||||
|
{$ASSERTIONS OFF}
|
||||||
|
{$BOOLEVAL OFF}
|
||||||
|
{$DEBUGINFO OFF}
|
||||||
|
{$EXTENDEDSYNTAX ON}
|
||||||
|
{$IMPORTEDDATA OFF}
|
||||||
|
{$IOCHECKS ON}
|
||||||
|
{$LOCALSYMBOLS OFF}
|
||||||
|
{$LONGSTRINGS ON}
|
||||||
|
{$OPENSTRINGS ON}
|
||||||
|
{$OPTIMIZATION ON}
|
||||||
|
{$OVERFLOWCHECKS OFF}
|
||||||
|
{$RANGECHECKS OFF}
|
||||||
|
{$REFERENCEINFO OFF}
|
||||||
|
{$SAFEDIVIDE OFF}
|
||||||
|
{$STACKFRAMES OFF}
|
||||||
|
{$TYPEDADDRESS OFF}
|
||||||
|
{$VARSTRINGCHECKS ON}
|
||||||
|
{$WRITEABLECONST ON}
|
||||||
|
{$MINENUMSIZE 1}
|
||||||
|
{$IMAGEBASE $400000}
|
||||||
|
{$DESCRIPTION 'ThtmlLite'}
|
||||||
|
{$DESIGNONLY}
|
||||||
|
{$IMPLICITBUILD ON}
|
||||||
|
|
||||||
|
requires
|
||||||
|
vcl,
|
||||||
|
vcljpg,
|
||||||
|
rtl;
|
||||||
|
|
||||||
|
{%File 'LiteCons.inc'}
|
||||||
|
|
||||||
|
contains
|
||||||
|
HTMLLite in 'HTMLLite.pas',
|
||||||
|
LiteUn2 in 'LiteUn2.pas',
|
||||||
|
LitePars in 'LitePars.pas',
|
||||||
|
LiteSbs1 in 'LiteSbs1.pas',
|
||||||
|
LiteSubs in 'LiteSubs.pas',
|
||||||
|
LiteDith in 'LiteDith.pas',
|
||||||
|
LiteReadThd in 'LiteReadThd.pas',
|
||||||
|
litegif2 in 'litegif2.pas',
|
||||||
|
litegif1 in 'litegif1.pas';
|
||||||
|
|
||||||
|
end.
|
||||||
BIN
components/htmllite/html32.res
Normal file
BIN
components/htmllite/html32.res
Normal file
Binary file not shown.
BIN
components/htmllite/htmllite.dcr
Normal file
BIN
components/htmllite/htmllite.dcr
Normal file
Binary file not shown.
2983
components/htmllite/htmllite.pas
Normal file
2983
components/htmllite/htmllite.pas
Normal file
File diff suppressed because it is too large
Load Diff
91
components/htmllite/litecons.inc
Normal file
91
components/htmllite/litecons.inc
Normal file
@ -0,0 +1,91 @@
|
|||||||
|
{Version 7.25}
|
||||||
|
{Do not use this file with C++Builder 5}
|
||||||
|
|
||||||
|
{$IFDEF HL_LAZARUS}
|
||||||
|
|
||||||
|
{$mode ObjFPC}{$H+}
|
||||||
|
{$Define ver100_plus}
|
||||||
|
{$Define ver120_plus}
|
||||||
|
{$Define NoGIF}
|
||||||
|
|
||||||
|
{$ELSE}
|
||||||
|
|
||||||
|
{$A+,B-,F-,G+,I+,P+,T-,V+,X+,R-}
|
||||||
|
|
||||||
|
{$ifdef Win32}
|
||||||
|
{$J+} {typed constants are modifiable}
|
||||||
|
{$H+} {LongStrings On}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifndef DebugIt}
|
||||||
|
{$W-} {Stack frames off}
|
||||||
|
{$Q-} {overflow checking off}
|
||||||
|
{$S-} {stack checking off}
|
||||||
|
{$C-} {Assertions off}
|
||||||
|
{$ifdef Win32}
|
||||||
|
{$O+} {optimization on}
|
||||||
|
{$endif}
|
||||||
|
{$else}
|
||||||
|
{$W+} {Stack frames on}
|
||||||
|
{$Q+} {overflow checking on}
|
||||||
|
{$S+} {stack checking on}
|
||||||
|
{$C+} {Assertions on}
|
||||||
|
{$ifdef Win32}
|
||||||
|
{$O-} {optimization off}
|
||||||
|
{$endif}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$Define Delphi6_Plus}
|
||||||
|
|
||||||
|
{$ifdef ver100} {Delphi 3}
|
||||||
|
{$Define ver100_plus}
|
||||||
|
{$UnDef Delphi6_Plus}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef ver110} {C++Builder 3}
|
||||||
|
{$ObjExportAll On}
|
||||||
|
{$Define CppBuilder}
|
||||||
|
{$Define ver100_plus}
|
||||||
|
{$UnDef Delphi6_Plus}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef Ver120} {Delphi 4}
|
||||||
|
{$Define ver100_plus}
|
||||||
|
{$Define ver120_plus}
|
||||||
|
{$UnDef Delphi6_Plus}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef ver125} {C++Builder 4}
|
||||||
|
{$ObjExportAll On}
|
||||||
|
{$Define CppBuilder}
|
||||||
|
{$Define ver100_plus}
|
||||||
|
{$Define ver120_plus}
|
||||||
|
{$UnDef Delphi6_Plus}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef Ver130} {Delphi 5}
|
||||||
|
{$Define ver100_plus}
|
||||||
|
{$Define ver120_plus}
|
||||||
|
{$UnDef Delphi6_Plus}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef Ver140} {Delphi 6}
|
||||||
|
{$Define ver100_plus}
|
||||||
|
{$Define ver120_plus}
|
||||||
|
{$Warn Symbol_Platform Off}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef Ver150} {Delphi 7}
|
||||||
|
{$Define ver100_plus}
|
||||||
|
{$Define ver120_plus}
|
||||||
|
{$Warn Symbol_Platform Off}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
|
||||||
|
{.$Define NoGIF} {To eliminate GIF image capability, define "NoGIF" by
|
||||||
|
removing the '.'.}
|
||||||
|
|
||||||
|
{$DEFINE HL_INTERFACE}
|
||||||
|
{$DEFINE HL_IMPLEMENTATION}
|
||||||
|
|
||||||
|
{$ENDIF}
|
||||||
1745
components/htmllite/litedith.pas
Normal file
1745
components/htmllite/litedith.pas
Normal file
File diff suppressed because it is too large
Load Diff
28
components/htmllite/litedith.rst
Normal file
28
components/htmllite/litedith.rst
Normal file
@ -0,0 +1,28 @@
|
|||||||
|
|
||||||
|
# hash value = 248645073
|
||||||
|
litedith.soutofdata='Premature end of data'
|
||||||
|
|
||||||
|
|
||||||
|
# hash value = 232926562
|
||||||
|
litedith.soutofmemdib='Failed to allocate memory for GIF DIB'
|
||||||
|
|
||||||
|
|
||||||
|
# hash value = 191780000
|
||||||
|
litedith.sdibcreate='Failed to create DIB from Bitmap'
|
||||||
|
|
||||||
|
|
||||||
|
# hash value = 205693938
|
||||||
|
litedith.snodib='Image has no DIB'
|
||||||
|
|
||||||
|
|
||||||
|
# hash value = 24203412
|
||||||
|
litedith.sinvalidbitmap='Bitmap image is not valid'
|
||||||
|
|
||||||
|
|
||||||
|
# hash value = 76435972
|
||||||
|
litedith.sinvalidpixelformat='Invalid pixel format'
|
||||||
|
|
||||||
|
|
||||||
|
# hash value = 159898837
|
||||||
|
litedith.sscanline='Scan line index out of range'
|
||||||
|
|
||||||
2053
components/htmllite/litegif1.pas
Normal file
2053
components/htmllite/litegif1.pas
Normal file
File diff suppressed because it is too large
Load Diff
641
components/htmllite/litegif2.pas
Normal file
641
components/htmllite/litegif2.pas
Normal file
@ -0,0 +1,641 @@
|
|||||||
|
{Version 9.03}
|
||||||
|
{*********************************************************}
|
||||||
|
{* LITEGIF2.PAS *}
|
||||||
|
{* Copyright (c) 2001-2002 by *}
|
||||||
|
{* L. David Baldwin *}
|
||||||
|
{* All rights reserved. *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{$i litecons.inc}
|
||||||
|
|
||||||
|
unit LiteGIF2;
|
||||||
|
|
||||||
|
{$ifndef NoGIF}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Windows, SysUtils, Classes, Graphics, Controls, ExtCtrls, LiteUN2, mmSystem,
|
||||||
|
litegif1;
|
||||||
|
|
||||||
|
type
|
||||||
|
TRGBColor = packed Record
|
||||||
|
Red,
|
||||||
|
Green,
|
||||||
|
Blue: Byte;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TDisposalType = (dtUndefined, {Take no action}
|
||||||
|
dtDoNothing, {Leave graphic, next frame goes on top of it}
|
||||||
|
dtToBackground,{restore original background for next frame}
|
||||||
|
dtToPrevious); {restore image as it existed before this frame}
|
||||||
|
|
||||||
|
type
|
||||||
|
ThtBitmap=class(TBitmap)
|
||||||
|
protected
|
||||||
|
htMask: TBitmap;
|
||||||
|
htTransparent: boolean;
|
||||||
|
procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
|
||||||
|
procedure StretchDraw(ACanvas: TCanvas; const DestRect,
|
||||||
|
SrcRect: TRect);
|
||||||
|
public
|
||||||
|
destructor Destroy; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TGIFImage = class;
|
||||||
|
|
||||||
|
TgfFrame = class
|
||||||
|
private
|
||||||
|
{ private declarations }
|
||||||
|
frLeft: Integer;
|
||||||
|
frTop: Integer;
|
||||||
|
frWidth: Integer;
|
||||||
|
frHeight: Integer;
|
||||||
|
|
||||||
|
frDelay: Integer;
|
||||||
|
frDisposalMethod: TDisposalType;
|
||||||
|
TheEnd: boolean; {end of what gets copied}
|
||||||
|
|
||||||
|
IsCopy: boolean;
|
||||||
|
|
||||||
|
Public
|
||||||
|
constructor Create;
|
||||||
|
constructor CreateCopy(Item: TgfFrame);
|
||||||
|
destructor Destroy; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TgfFrameList = class(TList)
|
||||||
|
private
|
||||||
|
function GetFrame(I: integer): TgfFrame;
|
||||||
|
public
|
||||||
|
{note: Frames is 1 based, goes from [1..Count]}
|
||||||
|
property Frames[I: integer]: TgfFrame read GetFrame; default;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TGIFImage = class(TPersistent)
|
||||||
|
private
|
||||||
|
{ Private declarations }
|
||||||
|
FAnimated: Boolean;
|
||||||
|
FCurrentFrame: Integer;
|
||||||
|
FImageWidth: Integer;
|
||||||
|
FImageHeight: Integer;
|
||||||
|
FNumFrames: Integer;
|
||||||
|
FNumIterations: Integer;
|
||||||
|
FTransparent: Boolean;
|
||||||
|
FVisible: Boolean;
|
||||||
|
Strip: ThtBitmap;
|
||||||
|
|
||||||
|
TheEnd: boolean; {copy to here}
|
||||||
|
|
||||||
|
FBitmap: TBitmap;
|
||||||
|
FMaskedBitmap, FMask: TBitmap;
|
||||||
|
FAnimate: Boolean;
|
||||||
|
FStretchedRect: TRect;
|
||||||
|
WasDisposal: TDisposalType;
|
||||||
|
|
||||||
|
Frames: TgfFrameList;
|
||||||
|
|
||||||
|
CurrentIteration: Integer;
|
||||||
|
LastTime: DWord;
|
||||||
|
CurrentInterval: DWord;
|
||||||
|
|
||||||
|
procedure SetAnimate(AAnimate: Boolean);
|
||||||
|
procedure SetCurrentFrame(AFrame: Integer);
|
||||||
|
function GetMaskedBitmap: TBitmap;
|
||||||
|
function GetMask: TBitmap;
|
||||||
|
function GetBitMap: TBitmap;
|
||||||
|
|
||||||
|
procedure NextFrame(OldFrame: Integer);
|
||||||
|
|
||||||
|
public
|
||||||
|
ShowIt: boolean;
|
||||||
|
IsCopy: boolean; {set if this is a copy of one in Cache}
|
||||||
|
|
||||||
|
{ Public declarations }
|
||||||
|
constructor Create;
|
||||||
|
constructor CreateCopy(Item: TGIFImage);
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure Draw(Canvas: TCanvas; MasterList, Cell: TObject; X, Y, Wid, Ht: integer);
|
||||||
|
property Bitmap: TBitmap read GetBitmap;
|
||||||
|
property MaskedBitmap: TBitmap read GetMaskedBitmap;
|
||||||
|
property Mask: TBitmap read GetMask;
|
||||||
|
property IsAnimated: Boolean read FAnimated;
|
||||||
|
property IsTransparent: Boolean read FTransparent;
|
||||||
|
property NumFrames: Integer read FNumFrames;
|
||||||
|
property NumIterations: Integer read FNumIterations;
|
||||||
|
|
||||||
|
procedure CheckTime(WinControl: TWinControl);
|
||||||
|
|
||||||
|
property Width: integer read FImageWidth;
|
||||||
|
property Height: integer read FImageHeight;
|
||||||
|
property Animate: Boolean read FAnimate write SetAnimate;
|
||||||
|
property CurrentFrame: Integer read FCurrentFrame write SetCurrentFrame;
|
||||||
|
property Visible: Boolean read FVisible write FVisible;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CreateAGifFromStream(var NonAnimated: boolean;
|
||||||
|
Stream: TStream): TGifImage;
|
||||||
|
function CreateAGif(const Name: string; var NonAnimated: boolean): TGifImage;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
litesubs;
|
||||||
|
|
||||||
|
function CreateBitmap(Width, Height: integer): TBitmap;
|
||||||
|
begin
|
||||||
|
Result := TBitmap.Create;
|
||||||
|
Result.Width := Width;
|
||||||
|
Result.Height := Height;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CreateAGifFromStream(var NonAnimated: boolean;
|
||||||
|
Stream: TStream): TGifImage;
|
||||||
|
var
|
||||||
|
AGif: TGif;
|
||||||
|
Frame: TgfFrame;
|
||||||
|
I: integer;
|
||||||
|
ABitmap, AMask: TBitmap;
|
||||||
|
begin
|
||||||
|
Result := Nil;
|
||||||
|
try
|
||||||
|
NonAnimated := True;
|
||||||
|
AGif := TGif.Create;
|
||||||
|
Try
|
||||||
|
AGif.LoadFromStream(Stream);
|
||||||
|
Result := TGifImage.Create;
|
||||||
|
|
||||||
|
Result.FNumFrames := AGif.ImageCount;
|
||||||
|
Result.FAnimated := Result.FNumFrames > 1;
|
||||||
|
NonAnimated := not Result.FAnimated;
|
||||||
|
Result.FImageWidth := AGif.Width;
|
||||||
|
Result.FImageHeight := AGif.Height;
|
||||||
|
Result.FNumIterations:= AGif.LoopCount;
|
||||||
|
if Result.FNumIterations <= 0 then
|
||||||
|
Result.FNumIterations := 0; {loop forever}
|
||||||
|
Result.FTransparent := AGif.Transparent;
|
||||||
|
|
||||||
|
with Result do
|
||||||
|
begin
|
||||||
|
Strip := ThtBitmap.Create;
|
||||||
|
ABitmap := AGif.GetStripBitmap(AMask);
|
||||||
|
try
|
||||||
|
Strip.Assign(ABitmap);
|
||||||
|
Strip.htMask := AMask;
|
||||||
|
Strip.htTransparent := Assigned(AMask);
|
||||||
|
finally
|
||||||
|
ABitmap.Free;
|
||||||
|
end;
|
||||||
|
DeleteObject(Result.Strip.ReleasePalette);
|
||||||
|
Result.Strip.Palette := CopyPalette(ThePalette);
|
||||||
|
end;
|
||||||
|
|
||||||
|
for I := 0 to Result.FNumFrames-1 do
|
||||||
|
begin
|
||||||
|
Frame := TgfFrame.Create;
|
||||||
|
try
|
||||||
|
Frame.frDisposalMethod := TDisposalType(AGif.ImageDisposal[I]);
|
||||||
|
Frame.frLeft := AGif.ImageLeft[I];
|
||||||
|
Frame.frTop := AGif.ImageTop[I];
|
||||||
|
Frame.frWidth := AGif.ImageWidth[I];
|
||||||
|
Frame.frHeight := AGif.ImageHeight[I];
|
||||||
|
Frame.frDelay := IntMax(30, AGif.ImageDelay[I] * 10);
|
||||||
|
except
|
||||||
|
Frame.Free;
|
||||||
|
Raise;
|
||||||
|
end;
|
||||||
|
Result.Frames.Add(Frame);
|
||||||
|
end;
|
||||||
|
if Result.IsAnimated then
|
||||||
|
Result.WasDisposal := dtToBackground;
|
||||||
|
finally
|
||||||
|
AGif.Free;
|
||||||
|
end;
|
||||||
|
except
|
||||||
|
FreeAndNil(Result);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CreateAGif(const Name: string; var NonAnimated: boolean): TGifImage;
|
||||||
|
var
|
||||||
|
Stream: TFileStream;
|
||||||
|
begin
|
||||||
|
Result := Nil;
|
||||||
|
try
|
||||||
|
Stream := TFileStream.Create(Name, fmOpenRead or fmShareDenyWrite);
|
||||||
|
try
|
||||||
|
Result := CreateAGifFromStream(NonAnimated, Stream);
|
||||||
|
finally
|
||||||
|
Stream.Free;
|
||||||
|
end;
|
||||||
|
except
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------TgfFrame.Create}
|
||||||
|
constructor TgfFrame.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TgfFrame.CreateCopy(Item: TgfFrame);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
System.Move(Item.frLeft, frLeft, DWord(@TheEnd)-DWord(@frLeft));
|
||||||
|
IsCopy := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------TgfFrame.Destroy}
|
||||||
|
destructor TgfFrame.Destroy;
|
||||||
|
begin
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------TGIFImage.Create}
|
||||||
|
constructor TGIFImage.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FVisible := True;
|
||||||
|
FCurrentFrame := 1;
|
||||||
|
Frames := TgfFrameList.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TGIFImage.CreateCopy(Item: TGIFImage);
|
||||||
|
var
|
||||||
|
I: integer;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FImageWidth := Item.Width;
|
||||||
|
FimageHeight := Item.Height;
|
||||||
|
System.Move(Item.FAnimated, FAnimated, DWord(@TheEnd)-DWord(@FAnimated));
|
||||||
|
IsCopy := True;
|
||||||
|
|
||||||
|
Frames := TgfFrameList.Create;
|
||||||
|
for I := 1 to FNumFrames do
|
||||||
|
Frames.Add(TgfFrame.CreateCopy(Item.Frames[I]));
|
||||||
|
FCurrentFrame := 1;
|
||||||
|
CurrentIteration := 1;
|
||||||
|
if FAnimated then
|
||||||
|
WasDisposal := dtToBackground;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------TGIFImage.Destroy}
|
||||||
|
destructor TGIFImage.Destroy;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
for I := Frames.Count downto 1 do
|
||||||
|
Frames[I].Free;
|
||||||
|
Frames.Free;
|
||||||
|
FreeAndNil(FBitmap);
|
||||||
|
if not IsCopy then
|
||||||
|
FreeAndNil(Strip);
|
||||||
|
FMaskedBitmap.Free;
|
||||||
|
FreeAndNil(FMask);
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------TGIFImage.Draw}
|
||||||
|
procedure TGIFImage.Draw(Canvas: TCanvas; MasterList, Cell: TObject; X, Y, Wid, Ht: integer);
|
||||||
|
var
|
||||||
|
SRect: TRect;
|
||||||
|
ALeft: integer;
|
||||||
|
begin
|
||||||
|
FStretchedRect := Rect(X, Y, X+Wid, Y+Ht);
|
||||||
|
|
||||||
|
SetStretchBltMode(Canvas.Handle, ColorOnColor);
|
||||||
|
if (FVisible) and (FNumFrames > 0) then
|
||||||
|
begin
|
||||||
|
with Frames[FCurrentFrame] do
|
||||||
|
begin
|
||||||
|
ALeft := (FCurrentFrame-1)*Width;
|
||||||
|
SRect := Rect(ALeft, 0, ALeft+Width, Height); {current frame location in Strip bitmap}
|
||||||
|
end;
|
||||||
|
|
||||||
|
Canvas.CopyMode := cmSrcCopy;
|
||||||
|
{draw the correct portion of the strip}
|
||||||
|
Strip.StretchDraw(Canvas, FStretchedRect, SRect);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------TGifImage.CheckTime}
|
||||||
|
procedure TGifImage.CheckTime(WinControl: TWinControl);
|
||||||
|
var
|
||||||
|
ThisTime: DWord;
|
||||||
|
begin
|
||||||
|
if not FAnimate then Exit;
|
||||||
|
|
||||||
|
ThisTime := timeGetTime;
|
||||||
|
if ThisTime - LastTime < CurrentInterval then
|
||||||
|
Exit;
|
||||||
|
|
||||||
|
LastTime := ThisTime;
|
||||||
|
|
||||||
|
if (FCurrentFrame = FNumFrames) then
|
||||||
|
begin
|
||||||
|
if (FNumIterations > 0) and (CurrentIteration >= FNumIterations) then
|
||||||
|
begin
|
||||||
|
SetAnimate(False);
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
Inc(CurrentIteration);
|
||||||
|
end;
|
||||||
|
NextFrame(FCurrentFrame);
|
||||||
|
Inc(FCurrentFrame);
|
||||||
|
if (FCurrentFrame > FNumFrames) or (FCurrentFrame <= 0) then
|
||||||
|
FCurrentFrame := 1;
|
||||||
|
|
||||||
|
InvalidateRect(WinControl.Handle, @FStretchedRect, True);
|
||||||
|
|
||||||
|
CurrentInterval := IntMax(Frames[FCurrentFrame].frDelay, 1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------TGIFImage.SetAnimate}
|
||||||
|
procedure TGIFImage.SetAnimate(AAnimate: Boolean);
|
||||||
|
begin
|
||||||
|
if AAnimate = FAnimate then Exit;
|
||||||
|
|
||||||
|
FAnimate := AAnimate;
|
||||||
|
CurrentIteration := 1;
|
||||||
|
if AAnimate and (FNumFrames > 1) then
|
||||||
|
begin
|
||||||
|
CurrentInterval := IntMax(Frames[FCurrentFrame].frDelay, 1);
|
||||||
|
LastTime := timeGetTime;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------TGIFImage.SetCurrentFrame}
|
||||||
|
procedure TGIFImage.SetCurrentFrame(AFrame: Integer);
|
||||||
|
begin
|
||||||
|
if AFrame = FCurrentFrame then Exit;
|
||||||
|
|
||||||
|
NextFrame(FCurrentFrame);
|
||||||
|
if AFrame > FNumFrames then FCurrentFrame := 1
|
||||||
|
else if AFrame < 1 then FCurrentFrame := FNumFrames
|
||||||
|
else FCurrentFrame := AFrame;
|
||||||
|
if FAnimated then
|
||||||
|
WasDisposal := dtToBackground;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------TGIFImage.GetBitmap}
|
||||||
|
function TGIFImage.GetBitmap: TBitmap;
|
||||||
|
begin
|
||||||
|
Result := GetMaskedBitmap;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------TGIFImage.GetMaskedBitmap:}
|
||||||
|
function TGIFImage.GetMaskedBitmap: TBitmap;
|
||||||
|
{This returns frame 1}
|
||||||
|
begin
|
||||||
|
if not Assigned(FMaskedBitmap) then
|
||||||
|
begin
|
||||||
|
FMaskedBitmap := TBitmap.Create;
|
||||||
|
FMaskedBitmap.Assign(Strip);
|
||||||
|
FMaskedBitmap.Width := FImageWidth;
|
||||||
|
if Strip.htTransparent then
|
||||||
|
begin
|
||||||
|
FMask := CreateBitmap(FImageWidth, FImageHeight);
|
||||||
|
FMask.Assign(Strip.htMask);
|
||||||
|
end;
|
||||||
|
FMaskedBitmap.Transparent := False;
|
||||||
|
end;
|
||||||
|
Result := FMaskedBitmap;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------TGIFImage.GetMask:}
|
||||||
|
function TGIFImage.GetMask: TBitmap;
|
||||||
|
{This returns mask for frame 1. Content is black, background is white}
|
||||||
|
begin
|
||||||
|
if not FTransparent then
|
||||||
|
Result := nil
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if not Assigned(FMask) then
|
||||||
|
GetMaskedBitmap;
|
||||||
|
Result := FMask;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------TGIFImage.NextFrame}
|
||||||
|
procedure TGIFImage.NextFrame(OldFrame: Integer);
|
||||||
|
begin
|
||||||
|
WasDisposal := Frames[OldFrame].frDisposalMethod;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------TgfFrameList.GetFrame}
|
||||||
|
function TgfFrameList.GetFrame(I: integer): TgfFrame;
|
||||||
|
begin
|
||||||
|
Assert((I <= Count) and (I >= 1 ), 'Frame index out of range');
|
||||||
|
Result := TgfFrame(Items[I-1]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ ThtBitmap }
|
||||||
|
var
|
||||||
|
AHandle: THandle;
|
||||||
|
|
||||||
|
destructor ThtBitmap.Destroy;
|
||||||
|
begin
|
||||||
|
htMask.Free;
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------ThtBitmap.Draw}
|
||||||
|
procedure ThtBitmap.Draw(ACanvas: TCanvas; const Rect: TRect);
|
||||||
|
var
|
||||||
|
OldPalette: HPalette;
|
||||||
|
RestorePalette: Boolean;
|
||||||
|
DoHalftone: Boolean;
|
||||||
|
Pt: TPoint;
|
||||||
|
BPP: Integer;
|
||||||
|
MaskDC: HDC;
|
||||||
|
Save: THandle;
|
||||||
|
begin
|
||||||
|
with Rect do
|
||||||
|
begin
|
||||||
|
AHandle := ACanvas.Handle; {LDB}
|
||||||
|
PaletteNeeded;
|
||||||
|
OldPalette := 0;
|
||||||
|
RestorePalette := False;
|
||||||
|
|
||||||
|
if Palette <> 0 then
|
||||||
|
begin
|
||||||
|
OldPalette := SelectPalette(ACanvas.Handle, Palette, True);
|
||||||
|
RealizePalette(ACanvas.Handle);
|
||||||
|
RestorePalette := True;
|
||||||
|
end;
|
||||||
|
BPP := GetDeviceCaps(ACanvas.Handle, BITSPIXEL) *
|
||||||
|
GetDeviceCaps(ACanvas.Handle, PLANES);
|
||||||
|
DoHalftone := (BPP <= 8) and (PixelFormat in [pf15bit, pf16bit, pf24bit]);
|
||||||
|
if DoHalftone then
|
||||||
|
begin
|
||||||
|
GetBrushOrgEx(ACanvas.Handle, pt);
|
||||||
|
SetStretchBltMode(ACanvas.Handle, HALFTONE);
|
||||||
|
SetBrushOrgEx(ACanvas.Handle, pt.x, pt.y, @pt);
|
||||||
|
end else if not Monochrome then
|
||||||
|
SetStretchBltMode(ACanvas.Handle, STRETCH_DELETESCANS);
|
||||||
|
try
|
||||||
|
AHandle := Canvas.Handle; {LDB}
|
||||||
|
if htTransparent then
|
||||||
|
begin
|
||||||
|
Save := 0;
|
||||||
|
MaskDC := 0;
|
||||||
|
try
|
||||||
|
MaskDC := CreateCompatibleDC(0); {LDB}
|
||||||
|
Save := SelectObject(MaskDC, MaskHandle);
|
||||||
|
TransparentStretchBlt(ACanvas.Handle, Left, Top, Right - Left,
|
||||||
|
Bottom - Top, Canvas.Handle, 0, 0, Width,
|
||||||
|
Height, htMask.Canvas.Handle, 0, 0); {LDB}
|
||||||
|
finally
|
||||||
|
if Save <> 0 then SelectObject(MaskDC, Save);
|
||||||
|
if MaskDC <> 0 then DeleteDC(MaskDC);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
StretchBlt(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top,
|
||||||
|
Canvas.Handle, 0, 0, Width,
|
||||||
|
Height, ACanvas.CopyMode);
|
||||||
|
finally
|
||||||
|
if RestorePalette then
|
||||||
|
SelectPalette(ACanvas.Handle, OldPalette, True);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ThtBitmap.StretchDraw(ACanvas: TCanvas; const DestRect, SrcRect: TRect);
|
||||||
|
{Draw parts of this bitmap on ACanvas}
|
||||||
|
var
|
||||||
|
OldPalette: HPalette;
|
||||||
|
RestorePalette: Boolean;
|
||||||
|
DoHalftone: Boolean;
|
||||||
|
Pt: TPoint;
|
||||||
|
BPP: Integer;
|
||||||
|
begin
|
||||||
|
with DestRect do
|
||||||
|
begin
|
||||||
|
AHandle := ACanvas.Handle; {LDB}
|
||||||
|
PaletteNeeded;
|
||||||
|
OldPalette := 0;
|
||||||
|
RestorePalette := False;
|
||||||
|
|
||||||
|
if Palette <> 0 then
|
||||||
|
begin
|
||||||
|
OldPalette := SelectPalette(ACanvas.Handle, Palette, True);
|
||||||
|
RealizePalette(ACanvas.Handle);
|
||||||
|
RestorePalette := True;
|
||||||
|
end;
|
||||||
|
BPP := GetDeviceCaps(ACanvas.Handle, BITSPIXEL) *
|
||||||
|
GetDeviceCaps(ACanvas.Handle, PLANES);
|
||||||
|
DoHalftone := (BPP <= 8) and (PixelFormat in [pf15bit, pf16bit, pf24bit]);
|
||||||
|
if DoHalftone then
|
||||||
|
begin
|
||||||
|
GetBrushOrgEx(ACanvas.Handle, pt);
|
||||||
|
SetStretchBltMode(ACanvas.Handle, HALFTONE);
|
||||||
|
SetBrushOrgEx(ACanvas.Handle, pt.x, pt.y, @pt);
|
||||||
|
end else if not Monochrome then
|
||||||
|
SetStretchBltMode(ACanvas.Handle, STRETCH_DELETESCANS);
|
||||||
|
try
|
||||||
|
AHandle := Canvas.Handle; {LDB}
|
||||||
|
if htTransparent then
|
||||||
|
TransparentStretchBlt(ACanvas.Handle, Left, Top, Right - Left,
|
||||||
|
Bottom - Top, Canvas.Handle,
|
||||||
|
SrcRect.Left, SrcRect.Top, SrcRect.Right - SrcRect.Left, SrcRect.Bottom - SrcRect.Top,
|
||||||
|
htMask.Canvas.Handle, SrcRect.Left, SrcRect.Top) {LDB}
|
||||||
|
else
|
||||||
|
StretchBlt(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top,
|
||||||
|
Canvas.Handle,
|
||||||
|
SrcRect.Left, SrcRect.Top, SrcRect.Right - SrcRect.Left, SrcRect.Bottom - SrcRect.Top,
|
||||||
|
ACanvas.CopyMode);
|
||||||
|
finally
|
||||||
|
if RestorePalette then
|
||||||
|
SelectPalette(ACanvas.Handle, OldPalette, True);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$else}
|
||||||
|
|
||||||
|
{Dummy routines for NoGif option}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFDEF HL_LAZARUS}
|
||||||
|
Classes, SysUtils, Graphics, Controls, ExtCtrls;
|
||||||
|
{$ELSE}
|
||||||
|
Windows, SysUtils, Classes, Graphics, Controls, ExtCtrls;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
type
|
||||||
|
TGIFImage = class(TPersistent)
|
||||||
|
private
|
||||||
|
{ Private declarations }
|
||||||
|
FCurrentFrame: Integer;
|
||||||
|
FImageWidth: Integer;
|
||||||
|
FImageHeight: Integer;
|
||||||
|
FNumFrames: Integer;
|
||||||
|
FTransparent: Boolean;
|
||||||
|
FVisible: Boolean;
|
||||||
|
FBitmap: TBitmap;
|
||||||
|
FAnimate: Boolean;
|
||||||
|
FMaskedBitmap: TBitmap;
|
||||||
|
FMask: TBitmap;
|
||||||
|
|
||||||
|
public
|
||||||
|
ShowIt: boolean;
|
||||||
|
IsCopy: boolean; {set if this is a copy of one in Cache}
|
||||||
|
|
||||||
|
{ Public declarations }
|
||||||
|
constructor CreateCopy(Item: TGIFImage);
|
||||||
|
procedure Draw(Canvas: TCanvas; MasterList, Cell: TObject; X, Y, Wid, Ht: integer);
|
||||||
|
property Bitmap: TBitmap read FBitmap;
|
||||||
|
property MaskedBitmap: TBitmap read FMaskedBitmap;
|
||||||
|
property Mask: TBitmap read FMask;
|
||||||
|
property IsTransparent: Boolean read FTransparent;
|
||||||
|
property NumFrames: Integer read FNumFrames;
|
||||||
|
|
||||||
|
procedure CheckTime(WinControl: TWinControl);
|
||||||
|
|
||||||
|
property Width: integer read FImageWidth;
|
||||||
|
property Height: integer read FImageHeight;
|
||||||
|
property Animate: Boolean read FAnimate write FAnimate;
|
||||||
|
property CurrentFrame: Integer read FCurrentFrame write FCurrentFrame;
|
||||||
|
property Visible: Boolean read FVisible write FVisible;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CreateAGifFromStream(var NonAnimated: boolean;
|
||||||
|
Stream: TStream): TGifImage;
|
||||||
|
function CreateAGif(const Name: string; var NonAnimated: boolean): TGifImage;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
function CreateAGifFromStream(var NonAnimated: boolean;
|
||||||
|
Stream: TStream): TGifImage;
|
||||||
|
begin
|
||||||
|
Result := Nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CreateAGif(const Name: string; var NonAnimated: boolean): TGifImage;
|
||||||
|
begin
|
||||||
|
Result := Nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TGIFImage.CreateCopy(Item: TGIFImage);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------TGIFImage.Draw}
|
||||||
|
procedure TGIFImage.Draw(Canvas: TCanvas; MasterList, Cell: TObject; X, Y, Wid, Ht: integer);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------TGifImage.CheckTime}
|
||||||
|
procedure TGifImage.CheckTime(WinControl: TWinControl);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
||||||
2573
components/htmllite/litepars.pas
Normal file
2573
components/htmllite/litepars.pas
Normal file
File diff suppressed because it is too large
Load Diff
86
components/htmllite/litereadthd.pas
Normal file
86
components/htmllite/litereadthd.pas
Normal file
@ -0,0 +1,86 @@
|
|||||||
|
{*********************************************************}
|
||||||
|
{* LITEREADTHD.PAS *}
|
||||||
|
{* Copyright (c) 2002 by *}
|
||||||
|
{* L. David Baldwin *}
|
||||||
|
{* All rights reserved. *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{$i LiteCons.inc}
|
||||||
|
|
||||||
|
unit LiteReadThd;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, LitePars;
|
||||||
|
|
||||||
|
type
|
||||||
|
TParseThread = class(TThread)
|
||||||
|
private
|
||||||
|
{ Private declarations }
|
||||||
|
protected
|
||||||
|
procedure Execute; override;
|
||||||
|
public
|
||||||
|
Parser: ThlParser;
|
||||||
|
St: string;
|
||||||
|
ASectionList: TList;
|
||||||
|
AIncludeEvent: TIncludeType;
|
||||||
|
ASoundEvent: TSoundType;
|
||||||
|
AMetaEvent: TMetaType;
|
||||||
|
ANameList: TStringList;
|
||||||
|
Buffer, BuffEnd: PChar;
|
||||||
|
Text: boolean;
|
||||||
|
Done: boolean;
|
||||||
|
|
||||||
|
constructor Create(CreateSuspended: Boolean);
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure Synchronize(Method: TThreadMethod);
|
||||||
|
procedure AddString(S: string);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
constructor TParseThread.Create(CreateSuspended: Boolean);
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
FreeOnTerminate := False;
|
||||||
|
St := '';
|
||||||
|
Buffer := PChar(St);
|
||||||
|
BuffEnd := Buffer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TParseThread.AddString(S: string);
|
||||||
|
{Call only when thread is suspended}
|
||||||
|
var
|
||||||
|
Space: integer;
|
||||||
|
begin
|
||||||
|
Space := Buffer - PChar(St);
|
||||||
|
St := St + S;
|
||||||
|
Buffer := PChar(St) + Space;
|
||||||
|
BuffEnd := PChar(St) + Length(St);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TParseThread.Execute;
|
||||||
|
begin
|
||||||
|
if Text then
|
||||||
|
Parser.HTMLParseTextString(ASectionList, ANameList)
|
||||||
|
else
|
||||||
|
Parser.HTMLParseString(ASectionList, ANameList, AIncludeEvent, ASoundEvent, AMetaEvent);
|
||||||
|
ReturnValue := 0;
|
||||||
|
Done := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TParseThread.Synchronize(Method: TThreadMethod);
|
||||||
|
begin
|
||||||
|
inherited Synchronize(Method);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TParseThread.Destroy;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
738
components/htmllite/litesbs1.pas
Normal file
738
components/htmllite/litesbs1.pas
Normal file
@ -0,0 +1,738 @@
|
|||||||
|
{Version 7.5}
|
||||||
|
{*********************************************************}
|
||||||
|
{* LITESBS1.PAS *}
|
||||||
|
{* Copyright (c) 1995-2002 by *}
|
||||||
|
{* L. David Baldwin *}
|
||||||
|
{* All rights reserved. *}
|
||||||
|
{*********************************************************}
|
||||||
|
|
||||||
|
{$i LiteCons.inc}
|
||||||
|
|
||||||
|
unit LiteSbs1;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
{$IFDEF HL_LAZARUS}
|
||||||
|
Classes, SysUtils, LCLType, LCLLinux, Messages, GraphType, Graphics, Controls,
|
||||||
|
Forms, Dialogs, StdCtrls, ExtCtrls, LiteUn2, LiteSubs;
|
||||||
|
{$ELSE}
|
||||||
|
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
|
||||||
|
Forms, Dialogs, StdCtrls, ExtCtrls, LiteUn2, LiteGif2, LiteSubs;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
Type
|
||||||
|
|
||||||
|
TParagraphSpace = class(TSectionBase) {spacing for a <p>}
|
||||||
|
procedure UpdateSpacing; override;
|
||||||
|
procedure CopyToClipboard; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
THeadingSpace = class(TSectionBase) {spacing for <Hn>}
|
||||||
|
HeadingSize: integer;
|
||||||
|
|
||||||
|
constructor Create(AMasterList: TSectionList; AHeadingSize: integer);
|
||||||
|
procedure CopyToClipboard; override;
|
||||||
|
procedure UpdateSpacing; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
THorzLine = class(TSectionBase) {a horizontal line, <hr>}
|
||||||
|
VSize: integer;
|
||||||
|
HWidth: integer;
|
||||||
|
AsPercent: boolean;
|
||||||
|
Color: TColor;
|
||||||
|
Align: JustifyType;
|
||||||
|
NoShade: boolean;
|
||||||
|
BkGnd: boolean;
|
||||||
|
constructor Create(AMasterList: TSectionList; L: TAttributeList);
|
||||||
|
procedure CopyToClipboard; override;
|
||||||
|
function DrawLogic(Canvas : TCanvas; Y: integer; IMgr: IndentManager;
|
||||||
|
var MaxWidth: integer; var Curs: integer): integer; override;
|
||||||
|
function Draw(Canvas: TCanvas; const ARect: TRect;
|
||||||
|
IMgr: IndentManager; X : integer; Y: integer) : integer; override;
|
||||||
|
procedure UpdateSpacing; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TPreFormated = class(TSection)
|
||||||
|
{section for preformated, <pre>}
|
||||||
|
public
|
||||||
|
procedure AddTokenObj(S : TokenObj; NoBreak: boolean); override;
|
||||||
|
function DrawLogic(Canvas : TCanvas; Y: integer; IMgr: IndentManager;
|
||||||
|
var MaxWidth: integer; var Curs: integer): integer; override;
|
||||||
|
procedure MinMaxWidth(Canvas: TCanvas; var Min, Max: integer); override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TUListItem = class(TSection) {Unordered List}
|
||||||
|
Plain: boolean;
|
||||||
|
constructor Create(AMasterList: TSectionList;
|
||||||
|
{$IFDEF HL_LAZARUS}NewLevel{$ELSE}Level{$ENDIF}: integer; AFont: TMyFont;
|
||||||
|
AnURL: TUrlTarget);
|
||||||
|
end;
|
||||||
|
|
||||||
|
TDListItem = class(TUListItem) {Definition List}
|
||||||
|
constructor Create(AMasterList: TSectionList;
|
||||||
|
{$IFDEF HL_LAZARUS}NewLevel{$ELSE}Level{$ENDIF}: integer; AFont:
|
||||||
|
TMyFont; AnURL: TUrlTarget);
|
||||||
|
end;
|
||||||
|
|
||||||
|
TOListItem = class(TUListItem) {Ordered List}
|
||||||
|
IndexType: char; {1,a,A,i,I}
|
||||||
|
constructor Create(AMasterList: TSectionList;
|
||||||
|
{$IFDEF HL_LAZARUS}NewLevel{$ELSE}Level{$ENDIF}, ItemNumb: integer;
|
||||||
|
Index: char; AFont: TMyFont; AnURL: TUrlTarget);
|
||||||
|
end;
|
||||||
|
|
||||||
|
TListBoxFormControlObj = class(TFormControlObj)
|
||||||
|
{<select> with Multiple set or Size > 1}
|
||||||
|
public
|
||||||
|
LBSize, Longest: integer;
|
||||||
|
TheOptions: TStringList;
|
||||||
|
constructor Create(AMasterList: TSectionList; Position: integer; L: TAttributeList);
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure AddStr(const S,
|
||||||
|
{$IFDEF HL_LAZARUS}NewValue{$ELSE}Value{$ENDIF}: string; Selected: boolean);
|
||||||
|
procedure ResetToValue; override;
|
||||||
|
procedure SetHeightWidth(Canvas: TCanvas); override;
|
||||||
|
function GetSubmission(Index: integer; var S: string): boolean; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TComboFormControlObj = class(TListBoxFormControlObj)
|
||||||
|
{<select> with size = 1, no multiple}
|
||||||
|
public
|
||||||
|
constructor Create(AMasterList: TSectionList; Position: integer; L: TAttributeList);
|
||||||
|
procedure ResetToValue; override;
|
||||||
|
procedure SetHeightWidth(Canvas: TCanvas); override;
|
||||||
|
function GetSubmission(Index: integer; var S: string): boolean; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TTextAreaFormControlObj = class(TFormControlObj)
|
||||||
|
public
|
||||||
|
Rows, Cols: integer;
|
||||||
|
TheText: TStringList;
|
||||||
|
constructor Create(AMasterList: TSectionList; Position: integer; L: TAttributeList);
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure AddStr(const S: string);
|
||||||
|
procedure ResetToValue; override;
|
||||||
|
procedure SetHeightWidth(Canvas: TCanvas); override;
|
||||||
|
function GetSubmission(Index: integer; var S: string): boolean; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TFormControlList = class(TList) {a list of TFormControlObj's} {not TFreeList}
|
||||||
|
Public
|
||||||
|
function FindControl(Posn: integer): TFormControlObj;
|
||||||
|
function GetHeightAt(Posn: integer; var BaseLine: boolean) : Integer;
|
||||||
|
function GetWidthAt(Posn: integer) : integer;
|
||||||
|
function GetControlCountAt(Posn: integer): integer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
LitePars, htmllite;
|
||||||
|
|
||||||
|
{----------------TParagraphSpace.UpdateSpacing}
|
||||||
|
procedure TParagraphSpace.UpdateSpacing;
|
||||||
|
begin
|
||||||
|
SectionHeight := MulDiv(14, ParentSectionList.FontSize, 12); {scale to FontSize}
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TParagraphSpace.CopyToClipboard;
|
||||||
|
begin
|
||||||
|
ParentSectionList.CB.AddTextCr('', 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------THeadingSpace.Create}
|
||||||
|
constructor THeadingSpace.Create(AMasterList: TSectionList; AHeadingSize: integer);
|
||||||
|
begin
|
||||||
|
inherited Create(AMasterList);
|
||||||
|
HeadingSize := AHeadingSize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure THeadingSpace.CopyToClipboard;
|
||||||
|
begin
|
||||||
|
ParentSectionList.CB.AddTextCR('', 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure THeadingSpace.UpdateSpacing;
|
||||||
|
var
|
||||||
|
SH: integer;
|
||||||
|
begin
|
||||||
|
case HeadingSize of {these are just a guess}
|
||||||
|
0: SH := 8;
|
||||||
|
1: SH := 16;
|
||||||
|
2: SH := 12;
|
||||||
|
3: SH := 10;
|
||||||
|
4: SH := 8;
|
||||||
|
5: SH := 6;
|
||||||
|
6: SH := 4;
|
||||||
|
else SH := 8;
|
||||||
|
end;
|
||||||
|
SectionHeight := MulDiv(SH, ParentSectionList.FontSize, 12); {scale to FontSize}
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------THorzLine.Create}
|
||||||
|
constructor THorzLine.Create(AMasterList: TSectionList; L: TAttributeList);
|
||||||
|
var
|
||||||
|
LwName: string[10];
|
||||||
|
I: integer;
|
||||||
|
begin
|
||||||
|
inherited Create(AMasterList);
|
||||||
|
VSize := 2;
|
||||||
|
HWidth := -1;
|
||||||
|
Align := Centered;
|
||||||
|
for I := 0 to L.Count-1 do
|
||||||
|
with TAttribute(L[I]) do
|
||||||
|
case Which of
|
||||||
|
SizeSy: if (Value > 0) and (Value <= 20) then
|
||||||
|
VSize := Value;
|
||||||
|
WidthSy:
|
||||||
|
if Value > 0 then
|
||||||
|
if Pos('%', Name) > 0 then
|
||||||
|
begin
|
||||||
|
if (Value <= 100) then HWidth := Value;
|
||||||
|
AsPercent := True;
|
||||||
|
end
|
||||||
|
else HWidth := Value;
|
||||||
|
ColorSy: BkGnd := GetColor(Name, Color);
|
||||||
|
AlignSy:
|
||||||
|
begin
|
||||||
|
LwName := Lowercase(Name);
|
||||||
|
if LwName = 'left' then Align := Left
|
||||||
|
else if LwName = 'right' then Align := Right;
|
||||||
|
end;
|
||||||
|
NoShadeSy: NoShade := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------THorzLine.UpdateSpacing}
|
||||||
|
procedure THorzLine.UpdateSpacing;
|
||||||
|
begin
|
||||||
|
SectionHeight := MulDiv(20, ParentSectionList.FontSize, 12)
|
||||||
|
-2 + VSize; {scale to FontSize}
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure THorzLine.CopyToClipboard;
|
||||||
|
begin
|
||||||
|
ParentSectionList.CB.AddTextCR('', 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function THorzLine.DrawLogic(Canvas : TCanvas; Y: integer; IMgr: IndentManager;
|
||||||
|
var MaxWidth: integer; var Curs: integer): integer;
|
||||||
|
begin
|
||||||
|
Result := inherited DrawLogic(Canvas, Y, IMgr, MaxWidth, Curs);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------THorzLine.Draw}
|
||||||
|
function THorzLine.Draw(Canvas: TCanvas; const ARect: TRect;
|
||||||
|
IMgr: IndentManager; X: integer; Y: integer) : integer;
|
||||||
|
var
|
||||||
|
XR, L, R, W2 : integer;
|
||||||
|
YT, YO: integer;
|
||||||
|
White, BlackBorder: boolean;
|
||||||
|
begin
|
||||||
|
Result := inherited Draw(Canvas, ARect, IMgr, X, Y);
|
||||||
|
YO := Y - ParentSectionList.YOff;
|
||||||
|
if (YO+SectionHeight >= ARect.Top) and (YO < ARect.Bottom) then
|
||||||
|
with Canvas do
|
||||||
|
begin
|
||||||
|
YT := YO+(SectionHeight - VSize) div 2;
|
||||||
|
L := IMgr.LeftIndent(Y);
|
||||||
|
R := IMgr.RightSide(Y);
|
||||||
|
if HWidth < 0 then
|
||||||
|
begin
|
||||||
|
X := L+10;
|
||||||
|
XR := R - 10;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if AsPercent then
|
||||||
|
W2 := MulDiv(R-L, HWidth, 100)
|
||||||
|
else W2 := HWidth;
|
||||||
|
case Align of
|
||||||
|
Left: X := L;
|
||||||
|
Centered: X := L + (R - L - W2) div 2;
|
||||||
|
Right: X := R-W2;
|
||||||
|
end;
|
||||||
|
XR := X+W2;
|
||||||
|
end;
|
||||||
|
if BkGnd then
|
||||||
|
begin
|
||||||
|
Brush.Color := Color or $2000000;
|
||||||
|
Brush.Style := bsSolid;
|
||||||
|
FillRect(Rect(X, YT, XR, YT+VSize));
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
with ParentSectionList do
|
||||||
|
begin
|
||||||
|
White := ((Background and $FFFFFF = clWhite) or
|
||||||
|
((Background = clWindow) and (GetSysColor(Color_Window) = $FFFFFF)));
|
||||||
|
BlackBorder := NoShade or ((GetDeviceCaps(Handle, BITSPIXEL) = 1) and
|
||||||
|
(GetDeviceCaps(Handle, PLANES) = 1));
|
||||||
|
end;
|
||||||
|
if BlackBorder then Pen.Color := clBlack
|
||||||
|
else Pen.Color := clBtnShadow;
|
||||||
|
MoveTo(X, YT+VSize);
|
||||||
|
LineTo(X, YT);
|
||||||
|
LineTo(XR, YT);
|
||||||
|
if BlackBorder then
|
||||||
|
Pen.Color := clBlack
|
||||||
|
else if White then
|
||||||
|
Pen.Color := clSilver
|
||||||
|
else Pen.Color := clBtnHighLight;
|
||||||
|
LineTo(XR, YT+VSize);
|
||||||
|
LineTo(X, YT+VSize);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPreformated.AddTokenObj(S : TokenObj; NoBreak: boolean);
|
||||||
|
var
|
||||||
|
L : integer;
|
||||||
|
begin
|
||||||
|
if Length(S.S) = 0 then Exit;
|
||||||
|
if Len > 20000 then Exit;
|
||||||
|
L := Len+Length(S.S);
|
||||||
|
if BuffSize < L+1 then Allocate(L + 100); {L+1 so there is always extra for font at end}
|
||||||
|
Move(S.S[1], (Buff+Len)^, Length(S.S));
|
||||||
|
Move(S.I[1], XP^[Len], Length(S.S)*Sizeof(integer));
|
||||||
|
Len := L;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TPreformated.MinMaxWidth(Canvas: TCanvas; var Min, Max: integer);
|
||||||
|
begin
|
||||||
|
if Len = 0 then
|
||||||
|
begin
|
||||||
|
Max := Indent;
|
||||||
|
Min := Indent;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Max := FindTextWidth(Canvas, Buff, Len, False) + Indent;
|
||||||
|
Min := IntMin(2000, Max); {arbitrary selection}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TPreFormated.DrawLogic(Canvas : TCanvas; Y: integer; IMgr: IndentManager;
|
||||||
|
var MaxWidth: integer; var Curs: integer): integer;
|
||||||
|
var
|
||||||
|
Dummy: integer;
|
||||||
|
Save: integer;
|
||||||
|
begin
|
||||||
|
if Len = 0 then
|
||||||
|
begin
|
||||||
|
Result := DefFont.Size;
|
||||||
|
SectionHeight := Result;
|
||||||
|
MaxWidth := 0;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{call with large width to prevent wrapping}
|
||||||
|
Save := IMgr.Width;
|
||||||
|
IMgr.Width := 32000;
|
||||||
|
Result := inherited DrawLogic(Canvas, Y, IMgr, Dummy, Curs);
|
||||||
|
IMgr.Width := Save;
|
||||||
|
MinMaxWidth(Canvas, Dummy, MaxWidth); {return MaxWidth}
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------TUListItem.Create}
|
||||||
|
constructor TUListItem.Create(AMasterList: TSectionList;
|
||||||
|
{$IFDEF HL_LAZARUS}NewLevel{$ELSE}Level{$ENDIF}: integer;
|
||||||
|
AFont: TMyFont; AnURL: TUrlTarget);
|
||||||
|
begin
|
||||||
|
inherited Create(AMasterList, {$IFDEF HL_LAZARUS}NewLevel{$ELSE}Level{$ENDIF},
|
||||||
|
AFont, AnURL, Left);
|
||||||
|
ListType := Unordered;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TDListItem.Create(AMasterList: TSectionList;
|
||||||
|
{$IFDEF HL_LAZARUS}NewLevel{$ELSE}Level{$ENDIF}: integer;
|
||||||
|
AFont: TMyFont; AnURL: TUrlTarget);
|
||||||
|
begin
|
||||||
|
inherited Create(AMasterList,
|
||||||
|
{$IFDEF HL_LAZARUS}NewLevel{$ELSE}Level{$ENDIF},
|
||||||
|
AFont, AnURL); {ancestor is TUListItem}
|
||||||
|
ListType := Definition;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TOListItem.Create(AMasterList: TSectionList;
|
||||||
|
{$IFDEF HL_LAZARUS}NewLevel{$ELSE}Level{$ENDIF}, ItemNumb:integer;
|
||||||
|
Index: char; AFont: TMyFont; AnURL: TUrlTarget);
|
||||||
|
begin
|
||||||
|
inherited Create(AMasterList, {$IFDEF HL_LAZARUS}NewLevel{$ELSE}Level{$ENDIF},
|
||||||
|
AFont, AnURL);
|
||||||
|
ListNumb := ItemNumb;
|
||||||
|
ListType := Ordered;
|
||||||
|
IndexType := Index;
|
||||||
|
end;
|
||||||
|
|
||||||
|
type
|
||||||
|
TOptionObj = class(TObject) {used by TListBoxFormControlObj}
|
||||||
|
Value: String;
|
||||||
|
Selected: boolean;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------TListBoxFormControlObj.Create}
|
||||||
|
constructor TListBoxFormControlObj.Create(AMasterList: TSectionList;
|
||||||
|
Position: integer; L: TAttributeList);
|
||||||
|
var
|
||||||
|
T: TAttribute;
|
||||||
|
Multiple: boolean;
|
||||||
|
PntPanel: TPaintPanel;
|
||||||
|
begin
|
||||||
|
inherited Create(AMasterList, Position, L);
|
||||||
|
TheOptions := TStringList.Create;
|
||||||
|
Multiple := L.Find(MultipleSy, T);
|
||||||
|
if L.Find(SizeSy, T) then
|
||||||
|
LBSize := T.Value
|
||||||
|
else LBSize := -1;
|
||||||
|
Longest := 3; {the minimum size}
|
||||||
|
PntPanel := TPaintPanel(AMasterList.PPanel);
|
||||||
|
FControl := TListBox.Create(PntPanel);
|
||||||
|
with TListBox(FControl) do
|
||||||
|
begin
|
||||||
|
Top := -400; {so will be invisible until placed}
|
||||||
|
Font.Name := AMasterList.PreFontName;
|
||||||
|
Font.Size := 10;
|
||||||
|
MultiSelect := Multiple;
|
||||||
|
ExtendedSelect := Multiple;
|
||||||
|
OnEnter := {$IFDEF HL_LAZARUS}@{$ENDIF}EnterEvent;
|
||||||
|
OnExit := {$IFDEF HL_LAZARUS}@{$ENDIF}ExitEvent;
|
||||||
|
OnClick := {$IFDEF HL_LAZARUS}@{$ENDIF}FormControlClick;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TListBoxFormControlObj.Destroy;
|
||||||
|
var
|
||||||
|
I: integer;
|
||||||
|
begin
|
||||||
|
for I := 0 to TheOptions.Count-1 do
|
||||||
|
with TOptionObj(TheOptions.Objects[I]) do
|
||||||
|
Free;
|
||||||
|
TheOptions.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TListBoxFormControlObj.AddStr(const S,
|
||||||
|
{$IFDEF HL_LAZARUS}NewValue{$ELSE}Value{$ENDIF}: string; Selected: boolean);
|
||||||
|
var
|
||||||
|
Opt: TOptionObj;
|
||||||
|
begin
|
||||||
|
Opt := TOptionObj.Create;
|
||||||
|
Opt.Value := {$IFDEF HL_LAZARUS}NewValue{$ELSE}Value{$ENDIF};
|
||||||
|
Opt.Selected := Selected;
|
||||||
|
TheOptions.AddObject(S, Opt);
|
||||||
|
Longest := IntMax(Longest, Length(S));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TListBoxFormControlObj.ResetToValue;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
Tmp: boolean;
|
||||||
|
begin
|
||||||
|
with (FControl as TListBox) do
|
||||||
|
begin
|
||||||
|
Clear;
|
||||||
|
for I := 0 to TheOptions.Count-1 do
|
||||||
|
begin
|
||||||
|
Items.Add(TheOptions[I]);
|
||||||
|
Tmp := (TheOptions.Objects[I] as TOptionObj).Selected;
|
||||||
|
if MultiSelect then
|
||||||
|
Selected[I] := Tmp
|
||||||
|
else if Tmp then
|
||||||
|
ItemIndex := I;
|
||||||
|
end;
|
||||||
|
if ItemIndex < 0 then
|
||||||
|
ItemIndex := 0;
|
||||||
|
TopIndex := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TListBoxFormControlObj.SetHeightWidth(Canvas: TCanvas);
|
||||||
|
begin
|
||||||
|
if not Assigned(FControl.Parent) then
|
||||||
|
begin
|
||||||
|
FControl.Parent := TPaintPanel(MasterList.PPanel);
|
||||||
|
ResetToValue;
|
||||||
|
end;
|
||||||
|
with TListBox(FControl) do
|
||||||
|
begin
|
||||||
|
Canvas.Font := Font;
|
||||||
|
if LBSize = -1 then LBSize := IntMax(1, IntMin(8, TheOptions.Count));
|
||||||
|
ClientHeight := Canvas.TextHeight('A')*LBSize;
|
||||||
|
ClientWidth := Canvas.TextWidth('A')*Longest + 15;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TListBoxFormControlObj.GetSubmission(Index: integer;
|
||||||
|
var S: string): boolean;
|
||||||
|
begin
|
||||||
|
with (FControl as TListBox) do
|
||||||
|
if (Index < Items.Count) then
|
||||||
|
begin
|
||||||
|
Result := True;
|
||||||
|
S := '';
|
||||||
|
if MultiSelect and Selected[Index] or
|
||||||
|
not MultiSelect and (ItemIndex = Index) then
|
||||||
|
begin
|
||||||
|
S := Self.Name+'=';
|
||||||
|
with TheOptions.Objects[Index] as TOptionObj do
|
||||||
|
if Value <> '' then S := S + Value
|
||||||
|
else S := S + Items[Index];
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else Result := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------TComboFormControlObj.Create}
|
||||||
|
constructor TComboFormControlObj.Create(AMasterList: TSectionList;
|
||||||
|
Position: integer; L: TAttributeList);
|
||||||
|
var
|
||||||
|
PntPanel: TPaintPanel;
|
||||||
|
begin
|
||||||
|
inherited Create(AMasterList, Position, L);
|
||||||
|
PntPanel := TPaintPanel(AMasterList.PPanel);
|
||||||
|
FControl.Free; {don't want the inherited one}
|
||||||
|
FControl := TComboBox.Create(PntPanel);
|
||||||
|
with TComboBox(FControl) do
|
||||||
|
begin
|
||||||
|
Top := -400; {so will be invisible until placed}
|
||||||
|
Font.Name := AMasterList.PreFontName;
|
||||||
|
Font.Size := 10;
|
||||||
|
Style := csDropDownList;
|
||||||
|
OnEnter := {$IFDEF HL_LAZARUS}@{$ENDIF}EnterEvent;
|
||||||
|
OnExit := {$IFDEF HL_LAZARUS}@{$ENDIF}ExitEvent;
|
||||||
|
OnDropDown := {$IFDEF HL_LAZARUS}@{$ENDIF}FormControlClick;
|
||||||
|
OnClick := {$IFDEF HL_LAZARUS}@{$ENDIF}FormControlClick;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TComboFormControlObj.ResetToValue;
|
||||||
|
var
|
||||||
|
I: Integer;
|
||||||
|
begin
|
||||||
|
with (FControl as TComboBox) do
|
||||||
|
begin
|
||||||
|
Clear;
|
||||||
|
for I := 0 to TheOptions.Count-1 do
|
||||||
|
begin
|
||||||
|
Items.Add(TheOptions[I]);
|
||||||
|
if (TheOptions.Objects[I] as TOptionObj).Selected then
|
||||||
|
ItemIndex := I;
|
||||||
|
end;
|
||||||
|
if ItemIndex < 0 then
|
||||||
|
ItemIndex := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TComboFormControlObj.SetHeightWidth(Canvas: TCanvas);
|
||||||
|
var
|
||||||
|
Wid: integer;
|
||||||
|
DC: HDC;
|
||||||
|
A: Char;
|
||||||
|
ExtS: TSize;
|
||||||
|
begin
|
||||||
|
if not Assigned(FControl.Parent) then
|
||||||
|
begin
|
||||||
|
FControl.Parent := TPaintPanel(MasterList.PPanel);
|
||||||
|
ResetToValue;
|
||||||
|
end;
|
||||||
|
with TComboBox(FControl) do
|
||||||
|
begin
|
||||||
|
A := 'A';
|
||||||
|
DC := GetDC(0);
|
||||||
|
{$ifdef Windows}
|
||||||
|
Wid := LoWord(GetTextExtent(DC, @A, 1));
|
||||||
|
{$else}
|
||||||
|
GetTextExtentPoint32(DC, @A, 1, ExtS);
|
||||||
|
Wid := ExtS.cx;
|
||||||
|
{$endif}
|
||||||
|
ReleaseDC(0, DC);
|
||||||
|
ClientWidth := Wid * Longest + 30;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TComboFormControlObj.GetSubmission(Index: integer;
|
||||||
|
var S: string): boolean;
|
||||||
|
begin
|
||||||
|
with (FControl as TComboBox) do
|
||||||
|
if (Index < Items.Count) then
|
||||||
|
begin
|
||||||
|
Result := True;
|
||||||
|
S := '';
|
||||||
|
if ItemIndex = Index then
|
||||||
|
begin
|
||||||
|
S := Self.Name+'=';
|
||||||
|
with TheOptions.Objects[Index] as TOptionObj do
|
||||||
|
if Value <> '' then S := S + Value
|
||||||
|
else S := S + Items[Index];
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else Result := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{----------------TTextAreaFormControlObj.Create}
|
||||||
|
constructor TTextAreaFormControlObj.Create(AMasterList: TSectionList;
|
||||||
|
Position: integer; L: TAttributeList);
|
||||||
|
var
|
||||||
|
PntPanel: TPaintPanel;
|
||||||
|
I: integer;
|
||||||
|
Wrap: boolean;
|
||||||
|
SB: TScrollStyle;
|
||||||
|
begin
|
||||||
|
inherited Create(AMasterList, Position, L);
|
||||||
|
TheText := TStringList.Create;
|
||||||
|
Rows := 5;
|
||||||
|
Cols := 30;
|
||||||
|
Wrap := False;
|
||||||
|
SB := ssBoth;
|
||||||
|
|
||||||
|
for I := 0 to L.Count-1 do
|
||||||
|
with TAttribute(L[I]) do
|
||||||
|
case Which of
|
||||||
|
RowsSy: Rows := Value;
|
||||||
|
ColsSy: Cols := Value;
|
||||||
|
WrapSy:
|
||||||
|
if (Lowercase(Name) = 'soft') or (Lowercase(Name) = 'hard') then
|
||||||
|
begin
|
||||||
|
SB := ssVertical;
|
||||||
|
Wrap := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
PntPanel := TPaintPanel(AMasterList.PPanel);
|
||||||
|
FControl := TMemo.Create(PntPanel);
|
||||||
|
with TMemo(FControl) do
|
||||||
|
begin
|
||||||
|
Top := -400; {so will be invisible until placed}
|
||||||
|
Font.Name := AMasterList.PreFontName;
|
||||||
|
Font.Size := 10;
|
||||||
|
ScrollBars := SB;
|
||||||
|
Wordwrap := Wrap;
|
||||||
|
OnKeyDown := {$IFDEF HL_LAZARUS}@{$ENDIF}MyForm.ControlKeyDown;
|
||||||
|
OnEnter := {$IFDEF HL_LAZARUS}@{$ENDIF}EnterEvent;
|
||||||
|
OnExit := {$IFDEF HL_LAZARUS}@{$ENDIF}ExitEvent;
|
||||||
|
OnClick := {$IFDEF HL_LAZARUS}@{$ENDIF}FormControlClick;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TTextAreaFormControlObj.Destroy;
|
||||||
|
begin
|
||||||
|
TheText.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTextAreaFormControlObj.SetHeightWidth(Canvas: TCanvas);
|
||||||
|
begin
|
||||||
|
if not Assigned(FControl.Parent) then
|
||||||
|
begin
|
||||||
|
FControl.Parent := TPaintPanel(MasterList.PPanel);
|
||||||
|
ResetToValue;
|
||||||
|
end;
|
||||||
|
with TMemo(FControl) do
|
||||||
|
begin
|
||||||
|
Canvas.Font := Font;
|
||||||
|
ClientHeight := Canvas.TextHeight('A')*Rows + 5;
|
||||||
|
ClientWidth := Canvas.TextWidth('A')*Cols + 5;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTextAreaFormControlObj.AddStr(const S: string);
|
||||||
|
begin
|
||||||
|
TheText.Add(S);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTextAreaFormControlObj.ResetToValue;
|
||||||
|
begin
|
||||||
|
with (FControl as TMemo) do
|
||||||
|
begin
|
||||||
|
Lines := TheText;
|
||||||
|
SelStart := 0;
|
||||||
|
SelLength := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TTextAreaFormControlObj.GetSubmission(Index: integer;
|
||||||
|
var S: string): boolean;
|
||||||
|
var
|
||||||
|
I: integer;
|
||||||
|
begin
|
||||||
|
if Index = 0 then
|
||||||
|
begin
|
||||||
|
Result := True;
|
||||||
|
S := Name+'=';
|
||||||
|
with (FControl as TMemo) do
|
||||||
|
for I := 0 to Lines.Count-1 do
|
||||||
|
begin
|
||||||
|
S := S + Lines[I];
|
||||||
|
if (I < Lines.Count-1) and not WordWrap then
|
||||||
|
S := S + ^M^J;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else Result := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFormControlList.FindControl(Posn: integer): TFormControlObj;
|
||||||
|
{find the control at a given character position}
|
||||||
|
var
|
||||||
|
I: integer;
|
||||||
|
begin
|
||||||
|
for I := 0 to Count-1 do
|
||||||
|
if TFormControlObj(Items[I]).Pos = Posn then
|
||||||
|
begin
|
||||||
|
Result := TFormControlObj(Items[I]);
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
Result := Nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFormControlList.GetHeightAt(Posn: integer;
|
||||||
|
var BaseLine: boolean) : Integer;
|
||||||
|
var
|
||||||
|
Ctrl: TFormControlObj;
|
||||||
|
begin
|
||||||
|
Ctrl := FindControl(Posn);
|
||||||
|
if Assigned(Ctrl) then
|
||||||
|
begin
|
||||||
|
Result := Ctrl.FControl.Height;
|
||||||
|
BaseLine := Ctrl.BaseLine;
|
||||||
|
end
|
||||||
|
else Result := -1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFormControlList.GetWidthAt(Posn: integer) : integer;
|
||||||
|
var
|
||||||
|
Ctrl: TFormControlObj;
|
||||||
|
begin
|
||||||
|
Ctrl := FindControl(Posn);
|
||||||
|
if Assigned(Ctrl) then
|
||||||
|
Result := Ctrl.FControl.Width
|
||||||
|
else Result := -1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TFormControlList.GetControlCountAt(Posn: integer): integer;
|
||||||
|
{Return count of chars before the next form control. 0 if at the control,
|
||||||
|
9999 if no controls after Posn}
|
||||||
|
var
|
||||||
|
I, Pos: integer;
|
||||||
|
begin
|
||||||
|
if Count = 0 then
|
||||||
|
begin
|
||||||
|
Result := 9999;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
I := 0;
|
||||||
|
while I < count do
|
||||||
|
begin
|
||||||
|
Pos := TFormControlObj(Items[I]).Pos;
|
||||||
|
if Pos >= Posn then break;
|
||||||
|
Inc(I);
|
||||||
|
end;
|
||||||
|
if I = Count then Result := 9999
|
||||||
|
else
|
||||||
|
Result := TFormControlObj(Items[I]).Pos - Posn;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
5900
components/htmllite/litesubs.pas
Normal file
5900
components/htmllite/litesubs.pas
Normal file
File diff suppressed because it is too large
Load Diff
2194
components/htmllite/liteun2.pas
Normal file
2194
components/htmllite/liteun2.pas
Normal file
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user