Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 5

Project CUSTHINT

Project Structure


CUSTHINT.DPR

program CustHint;

uses
  Forms,
  HintForm in 'HintForm.pas' {Form1};

{$R *.RES}

begin
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

HINTFORM.PAS

unit HintForm;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, AppEvnts;

type
  TForm1 = class(TForm)
    RadioGroup1: TRadioGroup;
    Label1: TLabel;
    ApplicationEvents1: TApplicationEvents;
    procedure RadioGroup1Click(Sender: TObject);
    procedure ShowHint (var HintStr: string;
      var CanShow: Boolean; var HintInfo: THintInfo);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ShowHint (var HintStr: string;
  var CanShow: Boolean; var HintInfo: THintInfo);
var
  RadioItem, RadioHeight: Integer;
  RadioRect: TRect;
begin
  {if the control is the label show the hint in the middle of it}
  with HintInfo do
    if HintControl = Label1 then
      HintPos := HintControl.ClientToScreen (Point (
        HintControl.Width div 2, HintControl.Height div 2))
    else
    { if the control is the radio group, determine which
    radio button the cursor is over, and set a proper
    hint string, hint rectangle, and hint position}
    if HintControl = RadioGroup1 then
    begin
      RadioHeight := (RadioGroup1.Height) div
        RadioGroup1.Items.Count;
      RadioItem := (CursorPos.Y) div RadioHeight;
      HintStr := 'Choose the ' +
        RadioGroup1.Items [RadioItem] + ' button';
      RadioRect := RadioGroup1.ClientRect;
      RadioRect.Top := RadioRect.Top +
        RadioHeight * RadioItem;
      RadioRect.Bottom := RadioRect.Top + RadioHeight;
      // assign the hints rect and pos
      CursorRect := RadioRect;
    end;
end;

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  Label1.Caption := Label1.Caption +
    ' - ' + RadioGroup1.Items [RadioGroup1.ItemIndex];
end;

end.

HINTFORM.DFM

object Form1: TForm1
  Left = 206
  Top = 110
  Width = 478
  Height = 227
  Hint = 'This is the form of the CustHint example'
  Caption = 'CustHint'
  Color = clBtnFace
  Font.Charset = ANSI_CHARSET
  Font.Color = clBlack
  Font.Height = -12
  Font.Name = 'Arial'
  Font.Style = []
  OldCreateOrder = True
  ShowHint = True
  PixelsPerInch = 96
  TextHeight = 15
  object Label1: TLabel
    Left = 136
    Top = 16
    Width = 321
    Height = 177
    Hint = 'Shoes the selection sequence'
    AutoSize = False
    Caption = 'Selection sequence: one'
    Font.Charset = ANSI_CHARSET
    Font.Color = clBlack
    Font.Height = -16
    Font.Name = 'Arial'
    Font.Style = []
    ParentFont = False
    WordWrap = True
  end
  object RadioGroup1: TRadioGroup
    Left = 8
    Top = 8
    Width = 121
    Height = 185
    Hint = 'Choose the button'
    Caption = 'Choose'
    ItemIndex = 0
    Items.Strings = (
      'one'
      'two'
      'three'
      'four')
    TabOrder = 0
    OnClick = RadioGroup1Click
  end
  object ApplicationEvents1: TApplicationEvents
    OnShowHint = ShowHint
    Left = 392
    Top = 16
  end
end