home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE21 / HTMLVIEW / HTMLVIEW.ZIP / UNITS.ZIP / HTMLVIEW.INT < prev    next >
Encoding:
Text File  |  1996-11-26  |  9.9 KB  |  256 lines
  1. {$A+,B-,F-,G+,I+,P+,Q-,R-,S-,T-,V+,W-,X+,O+}
  2. {$ifdef Win32} {$J+} {$endif}
  3.  
  4. {*********************************************************}
  5. {*                     HTMLVIEW.PAS                      *}
  6. {*                Copyright (c) 1995-6 by                *}
  7. {*                   L. David Baldwin                    *}
  8. {*                 All rights reserved.                  *}
  9. {*********************************************************}
  10.  
  11. unit Htmlview;
  12.  
  13. interface
  14.  
  15. uses
  16.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, StdCtrls,
  17.   {$ifdef Win32}
  18.     vwPrint,
  19.   {$endif}
  20.   HTMLUn2, Forms, Dialogs, ExtCtrls, ReadHTML, HTMLSubs, Printers, Menus;
  21.  
  22. const
  23.   wm_FormSubmit = wm_User+100;
  24.   wm_DrawBorder = wm_User+101;
  25.   wm_MouseScroll = wm_User+102;
  26.  
  27. type
  28.   THTMLBorderStyle = (htFocused, htNone, htSingle);    
  29.   THotSpotEvent = procedure(Sender: TObject; const SRC: string) of Object;
  30.   THotSpotClickEvent = procedure(Sender: TObject; const SRC: string;
  31.                      var Handled: boolean) of Object;
  32.   TProcessingEvent = procedure(Sender: TObject; ProcessingOn: boolean) of Object;
  33.  
  34.   TPaintPanel = class(TCustomPanel)
  35.   private
  36.     FOnPaint: TNotifyEvent;
  37.     FViewer: TComponent;
  38.     Canvas2: TCanvas;
  39.     Sizing: boolean;
  40.     procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_EraseBkgnd;
  41.     procedure Paint; override;
  42.     procedure DoBackground(ACanvas: TCanvas);
  43.     constructor Create(AOwner: TComponent; Viewer: TComponent);
  44.     property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
  45.   end;
  46.  
  47. {$ifdef Win32}
  48.   T32ScrollBar = Class(TScrollBar)   {a 32 bit scrollbar}
  49.   private
  50.     FPosition: integer;
  51.     FMin, FMax, FPage: integer;
  52.     procedure SetPosition(Value: integer);
  53.     procedure SetMin(Value: Integer);
  54.     procedure SetMax(Value: Integer);
  55.     procedure CNVScroll(var Message: TWMVScroll); message CN_VSCROLL;
  56.   public
  57.     property Position: integer read FPosition write SetPosition;
  58.     property Min: integer read FMin write SetMin;
  59.     property Max: integer read FMax write SetMax;
  60.     procedure SetParams(APosition, APage, AMin, AMax: Integer);
  61.   end;
  62. {$endif}
  63.  
  64.   THTMLViewer = class(TWinControl)
  65.   private
  66.     { Private declarations }
  67.     DontDraw: boolean;
  68.     FTitle: PString;
  69.     FURL: PString;
  70.     FBase: PString;
  71.     FCurrentFile: PString;
  72.     FNameList: TStringList;
  73.     FOnHotSpotCovered: THotSpotEvent;
  74.     FOnHotSpotClick: THotSpotClickEvent;
  75.     FOnBitmapRequest: TGetBitmapEvent;
  76.     FOnFormSubmit: TFormSubmitEvent;
  77.     FOnHistoryChange: TNotifyEvent;
  78.     FOnProcessing: TProcessingEvent;
  79.     FHistory, FTitleHistory: TStrings;
  80.     FHistoryIndex: integer;
  81.     FHistoryMaxCount: integer;
  82.     FFontName: PString;
  83.     FPreFontName: PString;
  84.     FFontColor: TColor;
  85.     FHotSpotColor: TColor;
  86.     FBackGround: TColor;
  87.     FFontSize: integer;
  88.     FProcessing: boolean;
  89.     FAction, FMethod: PString;
  90.     FStringList: TStringList;
  91.     FOldWidth: integer;  
  92.     FImageCacheCount: integer;
  93.     FNoSelect: boolean;
  94.     FScrollBars: TScrollStyle;
  95.     FBorderStyle: THTMLBorderStyle;  
  96.     sbWidth: integer;
  97.     ScrollWidth: integer;
  98.     MaxVertical: LongInt;
  99.     MouseScrolling: boolean;
  100.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  101.     procedure ScrollTo(Y: LongInt);
  102.     procedure Scroll(Sender: TObject; ScrollCode: TScrollCode;
  103.            var ScrollPos: Integer);
  104.     procedure Layout;
  105.     procedure SetViewImages(Value: boolean);
  106.     function GetViewImages: boolean;
  107.     procedure SetColor(Value: TColor);
  108.     function GetBase: string;
  109.     function GetFURL: string;
  110.     function GetTitle: string;
  111.     function GetCurrentFile: string;
  112.     procedure SetBorderStyle(Value: THTMLBorderStyle);
  113.     function GetPosition: LongInt;
  114.     procedure SetPosition(Value: LongInt);
  115.     function GetScrollPos: integer;
  116.     procedure SetScrollPos(Value: integer);
  117.     function GetScrollBarRange: integer;
  118.     procedure SetHistoryIndex(Value: integer);
  119.     function GetFontName: TFontName;
  120.     procedure SetFontName(Value: TFontName);
  121.     function GetPreFontName: TFontName;
  122.     procedure SetPreFontName(Value: TFontName);
  123.     procedure SetFontSize(Value: integer);
  124.     procedure SetFontColor(Value: TColor);
  125.     procedure SetHotSpotColor(Value: TColor);
  126.     procedure SetOnBitmapRequest(Handler: TGetBitmapEvent);
  127.     procedure SetOnFormSubmit(Handler: TFormSubmitEvent);
  128.     procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
  129.     procedure BackgroundChange(Sender: TObject);
  130.     procedure SubmitForm(Sender: TObject; Action, Method: string;
  131.                 Results: TStringList);
  132.     procedure SetImageCacheCount(Value: integer);
  133.     procedure WMFormSubmit(var Message: TMessage); message WM_FormSubmit;
  134.     procedure WMDrawBorder(var Message: TMessage); message WM_DrawBorder;
  135.     procedure WMMouseScroll(var Message: TMessage); message WM_MouseScroll;
  136.     procedure SetSelLength(Value: LongInt);
  137.     function GetSelLength: LongInt;
  138.     procedure SetNoSelect(Value: boolean);
  139.     procedure SetHistoryMaxCount(Value: integer);
  140.     procedure DoEnter; override;
  141.     procedure DoExit; override;
  142.     procedure DrawBorder;
  143.     procedure DoHilite(X, Y: integer);
  144.     procedure SetScrollBars(Value: TScrollStyle);
  145.  
  146.   protected
  147.     { Protected declarations }
  148.     SectionList: TSectionList;
  149.     PaintPanel: TPaintPanel;
  150.     PaintBox: TPaintBox;
  151.     {$ifdef Win32}
  152.     VScrollBar: T32ScrollBar;
  153.     {$else}
  154.     VScrollBar: TScrollBar;
  155.     {$endif}
  156.     HScrollBar: TScrollBar;
  157.     CaretPos, Sel1: LongInt;
  158.     procedure DoLogic;
  159.     procedure DoScrollBars;
  160.     procedure SetupAndLogic;
  161.     {$ifdef Windows}
  162.     function GetURL(X, Y: integer; var URL: OpenString): boolean;
  163.     {$else}
  164.     function GetURL(X, Y: integer; var URL: String): boolean;
  165.     {$endif}
  166.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  167.     function GetPalette: HPALETTE; override;
  168.     procedure HTMLPaint(Sender: TObject); virtual;
  169.     procedure HTMLMouseDown(Sender: TObject; Button: TMouseButton;
  170.       Shift: TShiftState; X, Y: Integer); virtual;
  171.     procedure HTMLMouseMove(Sender: TObject; Shift: TShiftState; X,
  172.       Y: Integer); virtual;
  173.     procedure HTMLMouseUp(Sender: TObject; Button: TMouseButton;
  174.       Shift: TShiftState; X, Y: Integer); virtual;
  175.     procedure URLAction; virtual;
  176.     function HotSpotClickHandled: boolean; dynamic;
  177.     procedure BumpHistory(const FileName, Title: string; OldPos: LongInt);
  178.     procedure LoadFile(const FileName: string);
  179.     procedure PaintWindow(DC: HDC); override;
  180.     procedure UpdateImageCache;
  181.  
  182.   public
  183.     { Public declarations }
  184.     constructor Create(AOwner: TComponent); override;
  185.     destructor Destroy; override;
  186.     function HTMLExpandFilename(const Filename: string): string; virtual;
  187.     procedure LoadFromFile(const FileName: string);
  188.     procedure LoadStrings(Strings: TStrings);
  189.     procedure LoadFromBuffer(Buffer: PChar; BufSize: LongInt);
  190.     procedure Print(FromPage, ToPage: integer);
  191.     function PositionTo(Dest: string): boolean;
  192.     function Find(const S: String; MatchCase: boolean): boolean;
  193.     procedure Clear; virtual;
  194.     procedure CopyToClipboard;
  195.     procedure SelectAll;
  196.     procedure ClearHistory;    
  197.  
  198.     property DocumentTitle: string read GetTitle;
  199.     property URL: string read GetFURL;
  200.     property Base: string read GetBase;
  201.     property Position: LongInt read GetPosition write SetPosition;
  202.     property VScrollBarPosition: integer read GetScrollPos write SetScrollPos;
  203.     property VScrollBarRange: integer read GetScrollBarRange;
  204.     property CurrentFile: string read GetCurrentFile;
  205.     property History: TStrings read FHistory;
  206.     property TitleHistory: TStrings read FTitleHistory;
  207.     property HistoryIndex: integer read FHistoryIndex write SetHistoryIndex;
  208.     property Processing: boolean read FProcessing;
  209.     property SelLength: LongInt read GetSelLength write SetSelLength;
  210.  
  211.   published
  212.     { Published declarations }
  213.     property OnHotSpotCovered: THotSpotEvent read FOnHotSpotCovered
  214.              write FOnHotSpotCovered;
  215.     property OnHotSpotClick: THotSpotClickEvent read FOnHotSpotClick
  216.              write FOnHotSpotClick;
  217.     property OnBitmapRequest: TGetBitmapEvent read FOnBitmapRequest
  218.              write SetOnBitmapRequest;
  219.     property OnFormSubmit: TFormSubmitEvent read FOnFormSubmit
  220.              write SetOnFormSubmit;
  221.     property OnHistoryChange: TNotifyEvent read FOnHistoryChange
  222.              write FOnHistoryChange;
  223.     property ViewImages: boolean read GetViewImages write SetViewImages;
  224.     property Enabled;
  225.     property TabStop;
  226.     property TabOrder;
  227.     property Align;
  228.     property Name;
  229.     property Tag;
  230.     property PopupMenu;
  231.     property ShowHint;
  232.     property Height default 150;
  233.     property Width default 150;
  234.     property DefBackground: TColor read FBackground write SetColor default clBtnFace;
  235.     property BorderStyle: THTMLBorderStyle read FBorderStyle write SetBorderStyle;
  236.     property Visible;
  237.     property HistoryMaxCount: integer read FHistoryMaxCount write SetHistoryMaxCount;
  238.     property DefFontName: TFontName read GetFontName write SetFontName;
  239.     property DefPreFontName: TFontName read GetPreFontName write SetPreFontName;
  240.     property DefFontSize: integer read FFontSize write SetFontSize default 12;
  241.     property DefFontColor: TColor read FFontColor write SetFontColor
  242.              default clBtnText;
  243.     property DefHotSpotColor: TColor read FHotSpotColor write SetHotSpotColor
  244.              default clBlue;
  245.     property OnProcessing: TProcessingEvent read FOnProcessing write FOnProcessing;
  246.     property ImageCacheCount: integer read FImageCacheCount
  247.                 write SetImageCacheCount default 5;
  248.     property NoSelect: boolean read FNoSelect write SetNoSelect;
  249.     property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth;
  250.     end;
  251.  
  252. procedure Register;
  253.  
  254. implementation
  255.  
  256.