{***********************************************************
                R&A Library
       Copyright (C) 1996-2000 R&A

       components  : ...
       description : Ht Controls

       author      : Andrei Prygounkov
       e-mail      : a.prygounkov@gmx.de
       www         : http://ralib.hotbox.ru
************************************************************}
{$INCLUDE RA.INC}                

unit RAHtControls;

interface                          

uses
  SysUtils, Classes,
{$IFDEF RA_VCL}
  Windows, Messages, Graphics, Controls, StdCtrls
{$ENDIF RA_VCL}
{$IFDEF RA_CLX}
  QGraphics, QControls, QStdCtrls, Types
{$ENDIF RA_CLX}
  ;

type

  TRAhtListBox = class(TCustomListBox)
  private
    FHideSel: Boolean;
  {$IFDEF RA_VCL}
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  {$ENDIF RA_VCL}
    procedure SetHideSel(Value: Boolean);
    function GetPlainItems(index: integer): string;
  protected
  {$IFDEF RA_VCL}
    procedure DrawItem(Index: Integer; Rect: TRect;
      State: TOwnerDrawState); override;
  {$ENDIF RA_VCL}
  {$IFDEF RA_CLX}
    function DrawItem(Index: Integer; Rect: TRect;
      State: TOwnerDrawState): Boolean; override;
  {$ENDIF RA_CLX}
  {$IFDEF RA_CLX}
    procedure FontChanged; override;
  {$ENDIF RA_CLX}
  public
    constructor Create(AOwner: TComponent); override;
    property PlainItems [index: Integer] : string read GetPlainItems;
  published
    property HideSel: Boolean read FHideSel write SetHideSel;

    property Align;
    property BorderStyle;
    property Color;
    property Columns;
{$IFDEF RA_VCL}
    property Ctl3D;
    property DragCursor;
{$ENDIF RA_VCL}
    property DragMode;
    property Enabled;
    property ExtendedSelect;
    property Font;
  //  property IntegralHeight;
  //  property ItemHeight;
    property Items;
    property MultiSelect;
    property ParentColor;
{$IFDEF RA_VCL}
    property ParentCtl3D;
{$ENDIF RA_VCL}
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
  //  property Style;
    property TabOrder;
    property TabStop;
{$IFDEF RA_VCL}
    property TabWidth;
{$ENDIF RA_VCL}
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
  //  property OnDrawItem;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
  //  property OnMeasureItem;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  {$IFDEF RA_D3H}
  {$IFDEF RA_VCL}
    property ImeMode;
    property ImeName;
  {$ENDIF RA_VCL}
  {$ENDIF RA_D3H}
  {$IFDEF RA_D4H}
    property Anchors;
  {$IFDEF RA_VCL}
    property AutoSize;
    property BiDiMode;
  {$ENDIF RA_VCL}
    property Constraints;
  {$IFDEF RA_VCL}
    property DragKind;
    property ParentBiDiMode;
    property OnEndDock;
    property OnStartDock;
  {$ENDIF RA_VCL}
  {$ENDIF RA_D4H}
  end;

  TRAhtComboBox = class(TCustomComboBox)
  private
    FHideSel: Boolean;
    FDropWidth : integer;
    procedure SetHideSel(Value: Boolean);
    function GetPlainItems(index: integer): string;
    procedure SetDropWidth(ADropWidth : integer);
  protected
   {$IFDEF RA_VCL}
    procedure DrawItem(Index: Integer; Rect: TRect;
      State: TOwnerDrawState); override;
    procedure CreateWnd; override;
   {$ENDIF RA_VCL}
   {$IFDEF RA_CLX}
    function DrawItem(Index: Integer; Rect: TRect;
      State: TOwnerDrawState): Boolean; override;
    procedure CreateWidget; override;
   {$ENDIF RA_CLX}
  public
    constructor Create(AOwner: TComponent); override;
    property PlainItems [index: Integer] : string read GetPlainItems;
  published
    property HideSel: Boolean read FHideSel write SetHideSel;
    property DropWidth : integer read FDropWidth write SetDropWidth;
  published
    property Color;
  {$IFDEF RA_VCL}
    property Ctl3D;
  {$ENDIF RA_VCL}
    property DragMode;
  {$IFDEF RA_VCL}
    property DragCursor;
  {$ENDIF RA_VCL}
    property DropDownCount;
    property Enabled;
    property Font;
  //  property ItemHeight;
    property Items;
    property MaxLength;
    property ParentColor;
  {$IFDEF RA_VCL}
    property ParentCtl3D;
  {$ENDIF RA_VCL}
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
  //  property OnDrawItem;
    property OnDropDown;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
  //  property OnMeasureItem;
    property OnStartDrag;
  {$IFDEF RA_D3H}
  {$IFDEF RA_VCL}
    property ImeMode;
    property ImeName;
  {$ENDIF RA_VCL}
  {$ENDIF RA_D3H}
  {$IFDEF RA_D4H}
  {$IFDEF RA_VCL}
    property AutoSize;
    property BiDiMode;
  {$ENDIF RA_VCL}
    property Constraints;
  {$IFDEF RA_VCL}
    property DragKind;
    property ParentBiDiMode;
    property OnEndDock;
    property OnStartDock;
  {$ENDIF RA_VCL}
  {$ENDIF RA_D4H}
  end;

  TRAhtLabel = class(TCustomLabel)
  private
  {$IFNDEF RA_D4H}
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  {$ENDIF}
  {$IFDEF RA_VCL}
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  {$ENDIF RA_VCL}
  protected
  {$IFDEF RA_CLX}
    procedure FontChanged; override;
  {$ENDIF RA_CLX}
    procedure AdjustBounds; {$IFDEF RA_D35H} override; {$ENDIF}
    procedure SetAutoSize(Value: Boolean); override;
    procedure Paint; override;
    procedure Loaded; override;
  published
    property Align;
    property Alignment;
    property AutoSize;
    property Caption;
    property Color;
  {$IFDEF RA_VCL}
    property DragCursor;
  {$ENDIF RA_VCL}
    property DragMode;
    property Enabled;
    property FocusControl;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
   // property ShowAccelChar;
    property ShowHint;
    property Transparent;
    property Visible;
   // property WordWrap;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  {$IFDEF RA_D3H}
    property Layout;
  {$ENDIF RA_D3H}
  {$IFDEF RA_D4H}
  {$IFDEF RA_VCL}
    property BiDiMode;
  {$ENDIF RA_VCL}
    property Constraints;
  {$IFDEF RA_VCL}
    property DragKind;
    property ParentBiDiMode;
    property OnEndDock;
    property OnStartDock;
  {$ENDIF RA_VCL}
  {$ENDIF RA_D4H}
  end;

  procedure ItemHtDrawEx(Canvas : TCanvas; Rect: TRect;
    const State: TOwnerDrawState; const Text : string;
    const HideSelColor: Boolean; var PlainItem: string;
    var Width: Integer; CalcWidth: Boolean);
  { example for Text parameter : 'Item 1 <b>bold</b> <i>italic ITALIC <c:Red>red <c:Green>green <c:blue>blue </i>' }

  function ItemHtDraw(Canvas : TCanvas; Rect: TRect;
    const State: TOwnerDrawState; const Text : string;
    const HideSelColor: Boolean): string;

  function ItemHtWidth(Canvas : TCanvas; Rect: TRect;
    const State: TOwnerDrawState; const Text : string;
    const HideSelColor: Boolean): Integer;

  function ItemHtPlain(const Text : string): string;


implementation

uses RAStrUtil;


function Max(x,y:integer):integer;
begin
  if x > y then Result := x else Result := y;
end;

procedure ItemHtDrawEx(Canvas : TCanvas; Rect: TRect;
  const State: TOwnerDrawState; const Text : string;
  const HideSelColor: Boolean; var PlainItem: string;
  var Width: Integer; CalcWidth: Boolean);
var
  CL : string;
  i : integer;
  M1 : string;
  OriRect: TRect; // it's added

  function Cmp(M1 : string) : boolean;
  begin
    Result := ANSIStrLIComp(PChar(Text)+ i, PChar(M1), Length(M1)) = 0;
  end;

  function Cmp1(M1 : string) : boolean;
  begin
    Result := ANSIStrLIComp(PChar(Text)+ i, PChar(M1), Length(M1)) = 0;
    if Result then inc(i, Length(M1));
  end;

  function CmpL(M1 : string) : boolean;
  begin
    Result := Cmp(M1 + '>');
  end;

  function CmpL1(M1 : string) : boolean;
  begin
    Result := Cmp1(M1 + '>');
  end;

  procedure Draw(const M : string);
  begin
    if not Assigned(Canvas) then Exit;
    if not CalcWidth then
      Canvas.TextOut(Rect.Left, Rect.Top, M);
    Rect.Left :=  Rect.Left + Canvas.TextWidth(M);
  end;

  procedure Style(const Style: TFontStyle; const Include: boolean);
  begin
    if not Assigned(Canvas) then Exit;
    if Include then
      Canvas.Font.Style := Canvas.Font.Style + [Style]
    else
      Canvas.Font.Style := Canvas.Font.Style - [Style];
  end;    { if }

var
  oldFontStyles: TFontStyles;
  oldFontColor: TColor;
begin
  PlainItem := '';
  oldFontColor := 0; { satisfy compiler }
  if Canvas <> nil then
  begin
    oldFontStyles := Canvas.Font.Style;
    oldFontColor := Canvas.Font.Color;
  end;
  try
  if HideSelColor and Assigned(Canvas) then
  begin
    Canvas.Brush.Color := clWindow;
    Canvas.Font.Color := clWindowText;
  end;
  if Assigned(Canvas) then
    Canvas.FillRect(Rect);

  Width := Rect.Left;
  Rect.Left := Rect.Left + 2;

  OriRect := Rect;  //save origin rectangle


  M1 := '';
  i := 1;
  while i <= Length(Text) do
  begin
    if (Text[i] = '<') and
      (CmpL('b') or CmpL('/b') or
       CmpL('i') or CmpL('/i') or
       CmpL('u') or CmpL('/u') or
       Cmp('c:') )then
    begin
      Draw(M1);
      PlainItem := PlainItem + M1;

      if CmpL1('b') then
        Style(fsBold, True)
      else if CmpL1('/b') then
        Style(fsBold, False)
      else if CmpL1('i') then
        Style(fsItalic, True)
      else if CmpL1('/i') then
        Style(fsItalic, False)
      else if CmpL1('u') then
        Style(fsUnderline, True)
      else if CmpL1('/u') then
        Style(fsUnderline, False)
      else if Cmp1('c:') then
      begin
        CL := SubStr(PChar(Text)+ i, 0, '>');
        if (HideSelColor or not (odSelected in State)) and Assigned(Canvas) then
          try
            if (Length(CL) > 0) and (CL[1] <> '$') then
              Canvas.Font.Color := StringToColor('cl' + CL)
            else
              Canvas.Font.Color := StringToColor(CL);
          except
          end;
        inc(i, Length(CL) + 1 {'>'});
      end;

      M1 := '';
    end else
        // next lines were added
        if (Text[i] = chr(13)) AND (Cmp1(string(chr(10)))) then
        begin
          // new line
          Draw(M1);
          PlainItem := PlainItem + M1;
          if (Canvas <> nil) then
          begin
            Rect.Left := OriRect.Left;
            Rect.Top := Rect.Top + Canvas.TextHeight(M1);
          end;
          M1 := '';
        end else
          // add text
          M1 := M1 + Text[i];
    inc(i);
  end;    { for }
  Draw(M1);
  PlainItem := PlainItem + M1;
  finally
    if Canvas <> nil then
    begin
      Canvas.Font.Style := oldFontStyles;
      Canvas.Font.Color := oldFontColor;
    end;
  end;
  Width := Rect.Left - Width + 2;
end;

function ItemHtDraw(Canvas : TCanvas; Rect: TRect;
 const State: TOwnerDrawState; const Text : string;
 const HideSelColor: Boolean): string;
var
  S: string;
  W: Integer;
begin
  ItemHtDrawEx(Canvas, Rect, State, Text, HideSelColor, S, W, False);
end;

function ItemHtPlain(const Text : string): string;
var
  S: string;
  W: Integer;
begin
  ItemHtDrawEx(nil, Rect(0, 0, -1, -1), [], Text, False, S, W, False);
  Result := S;
end;

function ItemHtWidth(Canvas : TCanvas; Rect: TRect;
  const State: TOwnerDrawState; const Text : string;
  const HideSelColor: Boolean): Integer;
var
  S: string;
  W: Integer;
begin
  ItemHtDrawEx(Canvas, Rect, State, Text, HideSelColor, S, W, True);
  Result := W;
end;


{ TRAhtListBox }

constructor TRAhtListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Style := lbOwnerDrawFixed;
end;    { Create }

{$IFDEF RA_VCL}
procedure TRAhtListBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
{$ENDIF RA_VCL}
{$IFDEF RA_CLX}
function TRAhtListBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState): Boolean;
{$ENDIF RA_CLX}
begin
  ItemHtDraw(Canvas, Rect, State, Items[index], FHideSel);
{$IFDEF RA_CLX}
  Result := True;
{$ENDIF RA_CLX}
end;

{$IFDEF RA_VCL}
procedure TRAhtListBox.CMFontChanged(var Message: TMessage);
{$ENDIF RA_VCL}
{$IFDEF RA_CLX}
procedure TRAhtListBox.FontChanged;
{$ENDIF RA_CLX}
begin
  Canvas.Font := Font;
  ItemHeight := Canvas.TextHeight('W');
end;

procedure TRAhtListBox.SetHideSel(Value: Boolean);
begin
  FHideSel := Value;
  Invalidate;
end;

function TRAhtListBox.GetPlainItems(index: integer): string;
begin
  Result := ItemHtPlain(Items[index]);
end;


{ TRAhtComboBox }

constructor TRAhtComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Style := csOwnerDrawFixed;
end;    { Create }

{$IFDEF RA_VCL}
procedure TRAhtComboBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
{$ENDIF RA_VCL}
{$IFDEF RA_CLX}
function TRAhtComboBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState): Boolean;
{$ENDIF RA_CLX}
begin
  ItemHtDraw(Canvas, Rect, State, Items[index], FHideSel);
{$IFDEF RA_CLX}
  Result := True;
{$ENDIF RA_CLX}
end;

procedure TRAhtComboBox.SetHideSel(Value: Boolean);
begin
  FHideSel := Value;
  Invalidate;
end;

function TRAhtComboBox.GetPlainItems(index: integer): string;
begin
  Result := ItemHtPlain(Items[index]);
end;

{$IFDEF RA_VCL}
procedure TRAhtComboBox.CreateWnd;
{$ENDIF RA_VCL}
{$IFDEF RA_CLX}
procedure TRAhtComboBox.CreateWidget;
{$ENDIF RA_CLX}
var
  Tmp : integer;
begin
  {$IFDEF RA_VCL}
    inherited CreateWnd;
  {$ENDIF RA_VCL}
  {$IFDEF RA_CLX}
    inherited CreateWidget;
  {$ENDIF RA_CLX}
  if DropWidth = 0 then
    DropWidth := Width
  else
  begin
    Tmp := DropWidth;
    DropWidth := 0;
    DropWidth := Tmp;
  end;
end;

procedure TRAhtComboBox.SetDropWidth(ADropWidth : integer);
begin
  if FDropWidth <> ADropWidth then begin
    FDropWidth := ADropWidth;
    {$IFDEF RA_VCL}
    Perform(CB_SETDROPPEDWIDTH, FDropWidth, 0);
    {$ENDIF RA_VCL}
  end;
end;


{ TRAhtLabel }

{$IFNDEF RA_D4H}
procedure TRAhtLabel.CMTextChanged(var Message: TMessage);
begin
  Invalidate;
  AdjustBounds;
end;
{$ENDIF RA_D4H}

{$IFDEF RA_VCL}
procedure TRAhtLabel.CMFontChanged(var Message: TMessage);
begin
  inherited;
  AdjustBounds;
end;
{$ENDIF RA_VCL}
{$IFDEF RA_CLX}
procedure TRAhtLabel.FontChanged;
begin
  inherited;
  AdjustSize;
end;
{$ENDIF RA_CLX}

procedure TRAhtLabel.Loaded;
begin
  inherited Loaded;
  AdjustBounds;
end;

procedure TRAhtLabel.AdjustBounds;
var
  i: integer;
  DC: HDC;
  X: Integer;
  Rect: TRect;
  Ss: TStrings;
  MaxWidth: Integer;
begin
  if not (csReading in ComponentState) and AutoSize then
  begin
    Rect := ClientRect;
    MaxWidth := 0;
    DC := GetDC(0);
    try
      Canvas.Handle := DC;
      Canvas.Font := Font;
      Ss := TStringList.Create;
      try
        Ss.Text := Caption;
        Rect.Bottom := Canvas.TextHeight('W') * Ss.Count;
        for i := 0 to Ss.Count - 1 do
        begin
          MaxWidth := Max(MaxWidth, ItemHtWidth(Canvas, Bounds(0, 0, 0, 0), [],
            Ss[i], False));
        end;    { for }
      finally
        Ss.Free;
      end;    { try/finally }
    finally
      Canvas.Handle := 0;
      ReleaseDC(0, DC);
    end;    { try/finally }
    Rect.Right := Rect.Left + MaxWidth;
    X := Left;
    if Alignment = taRightJustify then Inc(X, Width - Rect.Right);
    SetBounds(X, Top, Rect.Right, Rect.Bottom);
  end;
end;

procedure TRAhtLabel.SetAutoSize(Value: Boolean);
begin
  if AutoSize <> Value then
  begin
    inherited SetAutoSize(Value);
    AdjustBounds;
    //AdjustSize;
  end;
end;

procedure TRAhtLabel.Paint;
var
  S: string;
  H, W, i: Integer;
  Rect: TRect;
  Ss: TStrings;
begin
  Canvas.Font := Font;
  Canvas.Brush.Color := Color;
  if Transparent then
    Canvas.Brush.Style := bsClear else
    Canvas.Brush.Style := bsSolid;
  Canvas.FillRect(ClientRect);
  H := Canvas.TextHeight('W');
  Ss := TStringList.Create;
  Ss.Text := Caption;
  try
    for i := 0 to Ss.Count - 1 do    { Iterate }
    begin
      S := Ss[i];
      Rect := ClientRect;
     {$IFDEF RA_D3H}
      case Layout of    { }
        tlTop:
          inc(Rect.Top, H * i);
        tlBottom:
          Rect.Top := Rect.Bottom - (Ss.Count - i) * H;
        tlCenter:
          Rect.Top := (Rect.Bottom - Rect.Top - Ss.Count * H) div 2 + H * i;
      end;    { case }
     {$ELSE}
      inc(Rect.Top, H * i);
     {$ENDIF RA_D3H}
      case Alignment of    { }
        taLeftJustify: {nothing};
        taRightJustify:
          begin
            W := ItemHtWidth(Canvas, Rect, [], S, False);
            Rect.Left := Rect.Right - W;
          end;
        taCenter:
          begin
            W := ItemHtWidth(Canvas, Rect, [], S, False);
            Rect.Left := Rect.Left + (Rect.Right - Rect.Left - W) div 2;
          end;
      end;    { case }
      ItemHtDraw(Canvas, Rect, [], S, False);
    end;
  finally
    Ss.Free;
  end;
end;

end.
