david
f410727ca1
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.TMSSoftware@8 ccf39c52-e665-a648-be6a-52d81bcb5567
256 lines
9.4 KiB
ObjectPascal
256 lines
9.4 KiB
ObjectPascal
TPicturePosition = (bpTopLeft,bpTopRight,bpBottomLeft,bpBottomRight,bpCenter,bpTiled,bpStretched);
|
|
|
|
THTMLPicture = class;
|
|
|
|
{$IFDEF TMSDOTNET}
|
|
|
|
{$EXTERNALSYM OLE_HANDLE}
|
|
OLE_HANDLE = LongWord;
|
|
|
|
{$EXTERNALSYM OLE_XPOS_PIXELS}
|
|
OLE_XPOS_PIXELS = Longint;
|
|
{$EXTERNALSYM OLE_YPOS_PIXELS}
|
|
OLE_YPOS_PIXELS = Longint;
|
|
{$EXTERNALSYM OLE_XSIZE_PIXELS}
|
|
OLE_XSIZE_PIXELS = Longint;
|
|
{$EXTERNALSYM OLE_YSIZE_PIXELS}
|
|
OLE_YSIZE_PIXELS = Longint;
|
|
|
|
{$EXTERNALSYM OLE_XPOS_HIMETRIC}
|
|
OLE_XPOS_HIMETRIC = Longint;
|
|
{$EXTERNALSYM OLE_YPOS_HIMETRIC}
|
|
OLE_YPOS_HIMETRIC = Longint;
|
|
{$EXTERNALSYM OLE_XSIZE_HIMETRIC}
|
|
OLE_XSIZE_HIMETRIC = Longint;
|
|
{$EXTERNALSYM OLE_YSIZE_HIMETRIC}
|
|
OLE_YSIZE_HIMETRIC = Longint;
|
|
|
|
{$EXTERNALSYM OLE_XPOS_CONTAINER}
|
|
OLE_XPOS_CONTAINER = Single;
|
|
{$EXTERNALSYM OLE_YPOS_CONTAINER}
|
|
OLE_YPOS_CONTAINER = Single;
|
|
{$EXTERNALSYM OLE_XSIZE_CONTAINER}
|
|
OLE_XSIZE_CONTAINER = Single;
|
|
{$EXTERNALSYM OLE_YSIZE_CONTAINER}
|
|
OLE_YSIZE_CONTAINER = Single;
|
|
|
|
|
|
[ComImport,
|
|
GuidAttribute('7BF80980-BF32-101A-8BBB-00AA00300CAB')]
|
|
// InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)]
|
|
IPicture = interface
|
|
function get_Handle(out handle: OLE_HANDLE): HResult;
|
|
function get_hPal(out handle: OLE_HANDLE): HResult;
|
|
function get_Type(out typ: Smallint): HResult;
|
|
function get_Width(out width: OLE_XSIZE_HIMETRIC): HResult;
|
|
function get_Height(out height: OLE_YSIZE_HIMETRIC): HResult;
|
|
function Render(dc: HDC; x, y, cx, cy: Longint;
|
|
xSrc: OLE_XPOS_HIMETRIC; ySrc: OLE_YPOS_HIMETRIC;
|
|
cxSrc: OLE_XSIZE_HIMETRIC; cySrc: OLE_YSIZE_HIMETRIC;
|
|
const rcWBounds: TRect): HResult;
|
|
function set_hPal(hpal: OLE_HANDLE): HResult;
|
|
function get_CurDC(out dcOut: HDC): HResult;
|
|
function SelectPicture(dcIn: HDC; out hdcOut: HDC;
|
|
out bmpOut: OLE_HANDLE): HResult;
|
|
function get_KeepOriginalFormat(out fkeep: BOOL): HResult;
|
|
function put_KeepOriginalFormat(fkeep: BOOL): HResult;
|
|
function PictureChanged: HResult;
|
|
function SaveAsFile(const stream: IStream; fSaveMemCopy: BOOL;
|
|
out cbSize: Longint): HResult;
|
|
function get_Attributes(out dwAttr: Longint): HResult;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
PInternetContent = ^TInternetContent;
|
|
TInternetContent = record
|
|
{$IFDEF USEWININET}
|
|
hresource: hinternet;
|
|
{$ENDIF}
|
|
Complete: Boolean;
|
|
HTMLPicture:THTMLPicture;
|
|
end;
|
|
|
|
TDownloadErrorEvent = procedure(Sender:TObject;err:string) of object;
|
|
TDownloadCompleteEvent = procedure(Sender:TObject) of object;
|
|
TDownloadCancelEvent = procedure(Sender:TObject;var Cancel:boolean) of object;
|
|
TDownloadProgressEvent = procedure(Sender:TObject;dwSize,dwTotSize:dword) of object;
|
|
|
|
TDownLoadThread = class(TThread)
|
|
private
|
|
HTMLPicture:THTMLPicture;
|
|
protected
|
|
procedure Execute; override;
|
|
public
|
|
constructor Create(aHTMLPicture:THTMLPicture);
|
|
end;
|
|
|
|
THTMLPicture = class(TGraphic)
|
|
private
|
|
{ Private declarations }
|
|
FDatastream:TMemoryStream;
|
|
FIsEmpty: Boolean;
|
|
FStretched: Boolean;
|
|
gpPicture: IPicture;
|
|
FLogPixX,FLogPixY: Integer;
|
|
FURL:string;
|
|
FID:string;
|
|
FIsDB: Boolean;
|
|
FAsynch: Boolean;
|
|
FThreadBusy: Boolean;
|
|
FFrame: Integer;
|
|
FFrameCount: Integer;
|
|
FOnFrameChange: TNotifyEvent;
|
|
FFrameXPos: Word;
|
|
FFrameYPos: Word;
|
|
FFrameXSize: Word;
|
|
FFrameYSize: Word;
|
|
FFrameTransp: Boolean;
|
|
FFrameDisposal: Word;
|
|
FAnimMaxX,FAnimMaxY: Word;
|
|
FNextCount: Integer;
|
|
FTimerCount: Integer;
|
|
FOnDownLoadProgress: TDownLoadProgressEvent;
|
|
FOnDownLoadCancel: TDownLoadCancelEvent;
|
|
FOnDownLoadComplete: TDownLoadCompleteEvent;
|
|
FOnDownLoadError: TDownLoadErrorEvent;
|
|
procedure LoadPicture;
|
|
function GetFrameCount: Integer;
|
|
function IsGIFFile: Boolean;
|
|
function GetFrameTime(i: Integer): Integer;
|
|
protected
|
|
{ Protected declarations }
|
|
function GetEmpty: Boolean; override;
|
|
function GetHeight: integer; override;
|
|
function GetWidth: integer; override;
|
|
procedure SetHeight(Value: integer); override;
|
|
procedure SetWidth(Value: integer); override;
|
|
procedure ReadData(Stream: TStream); override;
|
|
procedure WriteData(Stream: TStream); override;
|
|
procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
|
|
procedure DownLoadError(err:string);
|
|
procedure DownLoadComplete;
|
|
procedure DownLoadCancel(var cancel:boolean);
|
|
procedure DownLoadProgress(dwSize,dwTotSize:dword);
|
|
{$IFDEF USEWININET}
|
|
procedure DownLoad;
|
|
{$ENDIF}
|
|
public
|
|
{ Public declarations }
|
|
constructor Create; override;
|
|
destructor Destroy; override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure LoadFromFile(const FileName: string); override;
|
|
procedure LoadFromStream(Stream: TStream); override;
|
|
procedure SaveToStream(Stream: TStream); override;
|
|
procedure LoadFromResourceName(Instance: THandle; const ResName: String);
|
|
procedure LoadFromResourceID(Instance: THandle; ResID: Integer);
|
|
procedure LoadFromURL(url:string);
|
|
procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
|
|
APalette: HPALETTE); override;
|
|
procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
|
|
var APalette: HPALETTE); override;
|
|
property Busy: Boolean read fThreadBusy;
|
|
property Asynch: Boolean read fAsynch write fAsynch;
|
|
property ID: string read FID write FID;
|
|
property IsDB: boolean read FIsDB write FIsDB;
|
|
property IsGIF: Boolean read IsGIFFile;
|
|
property FrameCount:Integer read GetFrameCount;
|
|
property FrameTime[i:Integer]:Integer read GetFrameTime;
|
|
function GetMaxHeight: Integer;
|
|
function GetMaxWidth: Integer;
|
|
procedure SetFrame(const Value:Integer);
|
|
procedure FrameNext;
|
|
procedure FramePrev;
|
|
function Step: Boolean;
|
|
property MaxWidth: integer read GetMaxWidth;
|
|
property MaxHeight: integer read GetMaxHeight;
|
|
property FrameXPos: word read FFrameXPos;
|
|
property FrameYPos: word read FFrameYPos;
|
|
published
|
|
{ Published declarations }
|
|
property Stretch:boolean read FStretched write FStretched;
|
|
property Frame:Integer read FFrame write SetFrame;
|
|
property OnFrameChange: TNotifyEvent read FOnFrameChange write FOnFrameChange;
|
|
property OnDownLoadError:TDownLoadErrorEvent read fOnDownLoadError write fOnDownLoadError;
|
|
property OnDownLoadComplete:TDownLoadCompleteEvent read fOnDownLoadComplete write fOnDownLoadComplete;
|
|
property OnDownLoadCancel:TDownLoadCancelEvent read fOnDownLoadCancel write fOnDownLoadCancel;
|
|
property OnDownLoadProgress:TDownLoadProgressEvent read fOnDownLoadProgress write fOnDownLoadProgress;
|
|
end;
|
|
|
|
THTMLPictureCache = class(TList)
|
|
private
|
|
procedure SetPicture(Index: Integer; Value: THTMLPicture);
|
|
function GetPicture(Index: Integer):THTMLPicture;
|
|
public
|
|
destructor Destroy; override;
|
|
property Items[index: Integer]: THTMLPicture read GetPicture write SetPicture; default;
|
|
function AddPicture:THTMLPicture;
|
|
function FindPicture(ID:string):THTMLPicture;
|
|
procedure ClearPictures;
|
|
function Animate: boolean;
|
|
end;
|
|
|
|
THTMLImage = class(TGraphicControl)
|
|
private
|
|
{ Private declarations }
|
|
FHTMLPicture:THTMLPicture;
|
|
FPicturePosition:TPicturePosition;
|
|
FOnDownLoadCancel: TDownLoadCancelEvent;
|
|
FOnDownLoadComplete: TDownLoadCompleteEvent;
|
|
FOnDownLoadError: TDownLoadErrorEvent;
|
|
FOnDownLoadProgress: TDownLoadProgressEvent;
|
|
procedure SetHTMLPicture(const Value: THTMLPicture);
|
|
procedure PictureChanged(sender:TObject);
|
|
procedure SetPicturePosition(const Value: TPicturePosition);
|
|
procedure DownLoadError(Sender:TObject;err:string);
|
|
procedure DownLoadComplete(Sender:TObject);
|
|
procedure DownLoadCancel(Sender:TObject;var Cancel: Boolean);
|
|
procedure DownLoadProgress(Sender:TObject;dwSize,dwTotSize:dword);
|
|
protected
|
|
{ Protected declarations }
|
|
procedure Paint; override;
|
|
procedure Loaded; override;
|
|
public
|
|
{ Public declarations }
|
|
constructor Create(aOwner:TComponent); override;
|
|
destructor Destroy; override;
|
|
published
|
|
{ Published declarations }
|
|
property HTMLPicture:THTMLPicture read FHTMLPicture write SetHTMLPicture;
|
|
property PicturePosition:TPicturePosition read FPicturePosition write SetPicturePosition;
|
|
{ inherited published properties}
|
|
property Align;
|
|
{$IFDEF DELPHI4_LVL}
|
|
property Anchors;
|
|
property Constraints;
|
|
property DragKind;
|
|
{$ENDIF}
|
|
property DragCursor;
|
|
property DragMode;
|
|
property Hint;
|
|
property ParentShowHint;
|
|
property ShowHint;
|
|
property Visible;
|
|
property OnClick;
|
|
{$IFDEF DELPHI5_LVL}
|
|
property OnContextPopup;
|
|
{$ENDIF}
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
{$IFDEF DELPHI4_LVL}
|
|
property OnEndDock;
|
|
property OnStartDock;
|
|
{$ENDIF}
|
|
property OnEndDrag;
|
|
property OnMouseDown;
|
|
property OnMouseUp;
|
|
property OnMouseMove;
|
|
property OnStartDrag;
|
|
property OnDownLoadError:TDownLoadErrorEvent read FOnDownLoadError write FOnDownLoadError;
|
|
property OnDownLoadComplete:TDownLoadCompleteEvent read FOnDownLoadComplete write FOnDownLoadComplete;
|
|
property OnDownLoadCancel:TDownLoadCancelEvent read FOnDownLoadCancel write FOnDownLoadCancel;
|
|
property OnDownLoadProgress:TDownLoadProgressEvent read FOnDownLoadProgress write FOnDownLoadProgress;
|
|
end;
|