unit HJHelp;

{
based on

----------------------------------------------------------------
THKHelp v1.1 by Harry Kakoulidis 1/2000
kcm@mailbox.gr
http://kakoulidis.homepage.com
----------------------------------------------------------------

but overwritten completely to do something else:

call Application.HelpJump with parameter = Name of the active
component. Name eventually stripped off part after '_'  and added
preffix or suffix.

}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Clipbrd, {RichEdit,}ComCtrls, Buttons, ExtCtrls
  {$IFDEF DESIGNINT}
  ,  DsgnIntf
  {$ENDIF}
  ;


type
  THJHelp = class;
  THelpEvent = Procedure(Control : TControl) of object;

  THelpItem = class(TCollectionItem)
  private
   FOldWndMethod : TWndMethod;
   FControl : TControl;
   FBorderColor,FBackColor : TColor;
   FWidth,FHeight,FBorderWidth : Integer;
   {FPaste : Boolean;
   FRTF : String;}
   FTest : Boolean;
   Procedure SetControl(value : TControl);
   Procedure SubClassWndProc(var Message: TMessage);
   {Procedure SetPaste(Value : Boolean);}
   Procedure OpenHelp;
   Procedure SetTest(b : boolean);
  Public
   Constructor Create(Collection : TCollection); override;
   Procedure Assign(Source : TPersistent); override;
   Destructor Destroy; override;
  Published
   property Control : TControl read FControl write SetControl;
   Property BackColor : TColor read FBackColor write FBackColor;
   Property BorderColor : TColor read FBorderColor write FBorderColor;
   Property BorderWidth : Integer read FBorderWidth write FBorderWidth;
   {Property Paste : Boolean read FPaste write SetPaste stored False;
   Property RTF : String read FRTF write FRTF;}
   Property Width : Integer read FWidth write FWidth;
   Property Height : Integer read FHeight write FHeight;
   Property Test : Boolean read FTest write SetTest stored false;
  end;

  THelpCol = class(TCollection)
  private
   FHJHelp : THJHelp;
   Function GetItem(index : integer): THelpItem;
   Procedure SetItem(index : integer; Value: THelpItem);
  protected
   function GetOwner: TPersistent; override;
   procedure Update(item : TCollectionItem); override;
  public
   Constructor Create(HJHelp : THJHelp);
   Function Add : THelpItem;
   Property Items[Index : Integer]: THelpItem read GetItem write SetItem; default;
  end;

  THJHelp = class(TComponent)
  Private
   FHelpCol: THelpCol;
   FHelpMode,
   FEnabled : Boolean;
   FHelpOpen,FHelpClose : THelpEvent;
   Procedure SetHelpCol(value : THelpCol);
   Procedure SetHelpMode(mode : Boolean);
  protected
   {j}
   procedure Loaded;override;
   {/j}
  Public
   constructor Create(AOwner : TComponent); override;
   Destructor Destroy; override;
   {j}
   procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  {/j}
  Published
   property HelpWindows : THelpCol read FHelpCol Write SetHelpCol;
   Property HelpMode : Boolean read FHelpMode write SetHelpMode stored false;
   property OnHelpOpen : THelpEvent read FHelpOpen write FHelpOpen;
   property OnHelpClose : THelpEvent read FHelpClose write FHelpClose;
   Property Enabled : Boolean read FEnabled write FEnabled;
  end;

{
  THelpWin = class(TForm)
    RichEdit: TRichEdit;
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
   Public
    FHelpOpen,FHelpClose : THelpEvent;
    FControl : TControl;
   Private
    procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
    Procedure WMRButtonDown(Var M: TWMRButtonDown); message WM_NCRBUTTONUP;
   end;
}
{$IFDEF DESIGNINT}
  THJComponentEditor = class(TComponentEditor)
  Public
   Procedure ExecuteVerb(index : Integer); override;
   Function GetVerb(Index : Integer) : string; override;
   Function GetVerbCount : Integer; override;
  end;
{$ENDIF}
procedure Register;

implementation
{ $R *.DFM}

var
 HelpShowing : Boolean;
{ HelpWin : THelpWin;}

procedure Register;
begin
  {$IFDEF DESIGNINT}
  RegisterComponentEditor(THJHelp,THJComponentEditor);
  {$ENDIF}
  RegisterComponents('NonVis', [THJHelp]);
end;

procedure THelpItem.SetTest(b: boolean);
begin
  if Assigned(FControl) then
    OpenHelp;
  FTest := false;
end;
{
procedure THelpItem.SetPaste(Value: Boolean);
var h: thandle; p: pchar; C: integer;
begin
 ClipBoard.Open;
 try
  c:=RegisterClipboardFormat(pchar(CF_RTF));
  H := Clipboard.GetAsHandle(C);
  p := GlobalLock(h);
  FRTF:= StrPas(p);
  GlobalUnlock(h);
 finally
  Clipboard.Close;
  FPaste:=false;
 end;
end;
}
procedure THelpItem.SetControl(Value: TControl);
var
  a: integer;
  F: boolean;
begin
  if Assigned(Value) then begin
    f := false;
    For a := 0 to Collection.count-1 do begin
     if Assigned(THelpItem(Collection.Items[a]).FControl) and
       (THelpItem(Collection.Items[a]).FControl.Name = Value.name)
     then
      f := true;
    end;
    if not f then begin
     if Assigned(FOldWndMethod) then
       if Assigned(FControl) then
         FControl.WindowProc := FOldWndMethod;
     FControl := Value;
     FOldWndMethod := FControl.WindowProc;
     FControl.WindowProc := SubClassWndProc;
    end else begin
     FControl := nil;
     raise Exception.Create('Control already linked!');
    end;
  end else begin
    if assigned(FOldWndMethod) then
     if assigned(FControl) then
       FControl.WindowProc := FOldWndMethod;
    FOldWndMethod := nil;
    FControl := nil;
  end;
end;

procedure THelpItem.OpenHelp;
var
  ms : TMemoryStream;
  IsLeft,IsTop : Boolean;
  p:integer; s:string;
begin
  {
  if HelpShowing then
    HelpWin.Close;
  if not THelpCol(Collection).FHJHelp.Enabled then
   exit;
  HelpWin := THelpWin.Create(Application);
  HelpWin.FHelpOpen := nil;
  HelpWin.FHelpClose := nil;
  with THelpCol(Collection).FHJHelp do
    if ComponentState=[] then begin
      HelpWin.FHelpOpen:=FHelpOpen;
      HelpWin.FHelpClose:=FHelpClose;
    end;
  HelpWin.Fcontrol:=FControl;
  HelpWin.Color:=BorderColor;
  HelpWin.Width:=FWidth;
  HelpWin.Height:=FHeight;
  HelpWin.RichEdit.Color:=BackColor;
  HelpWin.BorderWidth:=BorderWidth;
  if FControl is TWinControl then
  HelpWin.HelpContext:=TWinControl(FControl).helpcontext;
  ms:=TMemoryStream.create;
  try
  ms.Write(pchar(FRtf)^,length(FRTF));
  ms.Position:=0;
  HelpWin.RichEdit.lines.LoadFromStream(ms);
  finally
  ms.free
  end;
  IsLeft:=FControl.ClientOrigin.x<Screen.Width div 2;
  isTop:=FControl.ClientOrigin.y<Screen.height div 2;
  if IsTop
  then HelpWin.top:=FControl.ClientOrigin.y+FControl.height+5
  else HelpWin.top:=FControl.ClientOrigin.y-HelpWin.Height-5;
  if isLeft
  then HelpWin.Left:=FControl.ClientOrigin.X+5
  else HelpWin.Left:=FControl.ClientOrigin.X-HelpWin.Width-5;
  if HelpWin.Left<0 then HelpWin.Left:=5;
  if HelpWin.Top<0 then HelpWin.Top:=5;
  if HelpWin.Left+HelpWin.Width>Screen.Width
  then HelpWin.Left:=Screen.Width-HelpWin.Width-5;
  if HelpWin.Top+HelpWin.Height>Screen.Height
  then HelpWin.Top:=Screen.Height-helpwin.height-5;
  if THelpCol(Collection).FHJHelp.ComponentState=[]
  then HelpWin.show
  else begin HelpWin.ShowModal; end;
  }
  if not THelpCol(Collection).FHJHelp.Enabled then
    exit;
  s := FControl.Name;
  p := pos('_', s);
  if p > 0 then
    s := copy(s, 1, p - 1);
  Application.HelpJump(s);
  {
  HelpWin := THelpWin.Create(Application);
  HelpWin.FHelpOpen := nil;
  HelpWin.FHelpClose := nil;
  with THelpCol(Collection).FHJHelp do
    if ComponentState=[] then begin
      HelpWin.FHelpOpen:=FHelpOpen;
      HelpWin.FHelpClose:=FHelpClose;
    end;
  HelpWin.Fcontrol:=FControl;
  HelpWin.Color:=BorderColor;
  HelpWin.Width:=FWidth;
  HelpWin.Height:=FHeight;
  HelpWin.RichEdit.Color:=BackColor;
  HelpWin.BorderWidth:=BorderWidth;
  if FControl is TWinControl then
  HelpWin.HelpContext:=TWinControl(FControl).helpcontext;
  ms:=TMemoryStream.create;
  try
  ms.Write(pchar(FRtf)^,length(FRTF));
  ms.Position:=0;
  HelpWin.RichEdit.lines.LoadFromStream(ms);
  finally
  ms.free
  end;
  IsLeft:=FControl.ClientOrigin.x<Screen.Width div 2;
  isTop:=FControl.ClientOrigin.y<Screen.height div 2;
  if IsTop
  then HelpWin.top:=FControl.ClientOrigin.y+FControl.height+5
  else HelpWin.top:=FControl.ClientOrigin.y-HelpWin.Height-5;
  if isLeft
  then HelpWin.Left:=FControl.ClientOrigin.X+5
  else HelpWin.Left:=FControl.ClientOrigin.X-HelpWin.Width-5;
  if HelpWin.Left<0 then HelpWin.Left:=5;
  if HelpWin.Top<0 then HelpWin.Top:=5;
  if HelpWin.Left+HelpWin.Width>Screen.Width
  then HelpWin.Left:=Screen.Width-HelpWin.Width-5;
  if HelpWin.Top+HelpWin.Height>Screen.Height
  then HelpWin.Top:=Screen.Height-helpwin.height-5;
  if THelpCol(Collection).FHJHelp.ComponentState=[]
  then HelpWin.show
  else begin HelpWin.ShowModal; end;
  }
end;


procedure THelpItem.SubClassWndProc(var Message: TMessage);
begin
  If ((THelpCol(Collection).FHJHelp.HelpMode) and (Message.msg=WM_LBUTTONDOWN)) or
    (message.msg = WM_Help) then
  begin
    THelpCol(Collection).FHJHelp.HelpMode:=false;
    Message.msg:=0;
    OpenHelp;
  end else
    FOldWndMethod(Message);
end;

procedure THelpItem.Assign(Source: TPersistent);
begin
 if source is THelpItem then begin
   Control:=THelpItem(Source).control;
   BorderWidth:=THelpItem(source).BorderWidth;
   BackColor:=THelpItem(source).BackColor;
   BorderColor:=THelpItem(source).BorderColor;
   {RTF:=THelpItem(source).RTF;}
   Width:=THelpItem(source).Width;
   height:=THelpItem(source).Height;
 end
 else inherited Assign(Source);
end;

constructor THelpItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FBorderWidth := 2;
  FBackColor := clInfoBK;
  FBorderColor := clBlack;
  {FPaste := False;}
  FWidth := Screen.Width div 3;
  FHeight := Screen.height div 3;
  FOldWndMethod := nil;
end;

destructor THelpItem.Destroy;
begin
  if Assigned(FControl) then
    FControl.WindowProc := FOldWndMethod;
  inherited Destroy;
end;

{ THJHelp }

constructor THJHelp.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHelpMode := False;
  FEnabled := true;
  FHelpCol := THelpCol.Create(self);
end;

procedure THJHelp.Loaded;
var
  c: TComponent;
  i: integer;
  h: THelpItem;
begin
  if Owner = nil then
    exit;
  if csDesigning in ComponentState then
    exit;
  if FHelpCol.Count > 0 then
    exit;
  for i := 0 to Owner.ComponentCount - 1 do begin
    c := Owner.Components[i];
    if c = Self then
      continue;
    if c is TControl then begin
      h := FHelpCol.Add;
      h.Control := TControl(c);
    end;
  end;
end;

procedure THJHelp.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if (Operation = opRemove) then begin
    FHelpCol.Free;
    FHelpCol := nil;
  end;
end;

destructor THJHelp.Destroy;
begin
  FHelpCol.free;
  inherited Destroy;
end;

procedure THJHelp.SetHelpCol(value: THelpCol);
begin
  FHelpCol.Assign(value);
end;

procedure THJHelp.SetHelpMode(mode: Boolean);
begin
 If (mode) and (FHelpCol.Count>0) then
 begin
   Screen.Cursor := crHelp;
   FHelpMode := true;
 end else begin
   Screen.Cursor:=crDefault;
   FHelpMode := false;
 end;
end;

{ THelpCol }

function THelpCol.Add: THelpItem;
begin
 result:=THelpItem(inherited Add);
end;

constructor THelpCol.Create(HJHelp: THJHelp);
begin
  Inherited Create(THelpItem);
  FHJHelp := HJHelp;
end;

function THelpCol.GetItem(index: integer): THelpItem;
begin
  result := THelpItem(inherited getitem(index));
end;

function THelpCol.GetOwner: TPersistent;
begin
 result:=FHJHelp;
end;

procedure THelpCol.SetItem(index: integer; Value: THelpItem);
begin
 inherited SetItem(index,Value);
end;

procedure THelpCol.Update(item: TCollectionItem);
begin
 inherited Update(item);
end;

{ THelpWin

procedure THelpWin.FormKeyPress(Sender: TObject; var Key: Char);
begin
 if key=#27 then begin key:=#0; close; end;
end;

procedure THelpWin.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Action:=CaFree;
 if Assigned(FHelpClose) then
  FHelpClose(FControl);
 HelpShowing:=false;
end;

procedure THelpWin.FormShow(Sender: TObject);
begin
 HelpShowing:=true;
 if Assigned(FHelpOpen) then
  FHelpOpen(FControl);
end;

procedure THelpWin.WMNCHitTest(var M: TWMNCHitTest);
begin
 inherited;
 if  M.Result = htClient then
   M.Result := htCaption;
end;

procedure THelpWin.WMRButtonDown(var M: TWMRButtonDown);
begin
 m.msg:=0;
 close;
end;
}
{$IFDEF DESIGNINT}

{ THJComponentEditor }

procedure THJComponentEditor.ExecuteVerb(index: Integer);
begin
 case index of
  0 : THJHelp(Component).Helpmode:=true;
  1 : MessageDlg('HJHelp v1.0'+#13+#10+'by Harry Kakoulidis'
   +#13#10+'kcm@mailbox.gr', mtInformation, [mbOK], 0);
 end;
end;

function THJComponentEditor.GetVerb(Index: Integer): string;
begin
 case index of
  0 : result:='Test help';
  1 : result:='About...';
 end;
end;

function THJComponentEditor.GetVerbCount: Integer;
begin
  result:=2;
end;
{$ENDIF}
end.