unit SRVHints;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, SRVControl, SRVSkinManager, SRVSBar, ExtCtrls;

type
  TCalculateDrawItemCount = function(FirstItem, Height, HintItemHeight : Integer) : Integer of object;

  TFSRVHints = class(TForm)
    Image1: TImage;
    procedure FormDeactivate(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    FScrollBar: TSRVScrollBar;
    isResize : Boolean;
    OldFormSize : TPoint;
    MouseIn : Boolean;
    isMouseDown : Boolean;
    IsByse : Boolean;
    lockUpdate : Integer;
    procedure UpdateBuffer;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure HookOnScroll(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: Integer);
    procedure WMRepaintControl(var Message: TMessage); message WM_REPAINT_CONTROL;
  public
    { Public declarations }
    UseItemFontNames : Boolean;
    AutoDropDown : Boolean;
    Buffer : TBitmap;
    SBButtonHeight : Integer;
    FirstItem : Integer;
    OffX : Integer;
    OffY : Integer;
    ItemIndex : Integer;
    MouseMoveIndex : Integer;
    HintItemHeight : Integer;
    DropDownHints : Integer;
    EditHints: TStringList;
    ScaleX, ScaleY : Single;
    ImgList: TImageList;
    CalculateDrawItemCount : TCalculateDrawItemCount;
    FOnDrawItem: TDrawItemEvent;
    OnMeasureItem: TMeasureItemEvent;
    SkinManager : TSRVSkinManager;
    SkinSchemeIndex : Integer;
    ScrollBarSkinSchemeIndex : Integer;
    ItemSkinSchemeIndex : Integer;
    procedure Resize; override;
    procedure Paint; override;
    procedure Invalidate; override;
    function GetTopItem(ItemIndex : Integer) : Integer;
    function GetHintItemHeight(Index : Integer) : Integer;
    procedure Reset;
    property ScrollBar: TSRVScrollBar read FScrollBar;
 end;

var
  FSRVHints: TFSRVHints;

implementation

uses Math;

{$R *.DFM}

procedure TFSRVHints.FormDeactivate(Sender: TObject);
begin
//  if not AutoDropDown then
//    Close;
end;

procedure TFSRVHints.Resize;
begin
  inherited;

  Buffer.Width := Width;
  Buffer.Height := Height;
  UpdateBuffer;
end;

procedure TFSRVHints.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
     yy, ItemH, yItem, index, OldMouseMoveIndex : Integer;
     Message: TWMMouse;
begin
  if isResize and ((X <> OldFormSize.x) or (Y <> OldFormSize.y)) then begin

    SetBounds(Left, Top,
              Max(Width + X - OldFormSize.x, SBButtonHeight),
              Max(Height + Y - OldFormSize.y, Round((SBButtonHeight*2 + 14 + Image1.Height) * ScaleY)));
    OldFormSize := Point(X, Y);
    Reset;
    Exit;
  end;

  yy := Round(Y / ScaleY);
  if FScrollBar.Visible and
    (X >= Width-1 - Round(FScrollBar.Width * ScaleX)) then begin
    // in scrollbar
    Message.XPos := Round((X - Width-1 + FScrollBar.Width * ScaleX) / ScaleX);
    Message.YPos := Round(Y / ScaleY);
    with TMessage(Message) do
      PostMessage(FScrollBar.Handle, WM_MOUSEMOVE, WParam, LParam);
    Paint;
    Exit;
  end else begin
    If not IsByse and FScrollBar.InMouse then begin
      IsByse := True;
      with Message do
        SendMessage(FScrollBar.Handle, CM_MOUSELEAVE, 0, 0);
      IsByse := False;
    end;
    // Items
    OldMouseMoveIndex := MouseMoveIndex;
    yItem:= 0;
    for index := FirstItem to FirstItem + CalculateDrawItemCount(FirstItem, Round(Height / ScaleY), HintItemHeight)-1 do begin
      ItemH := GetHintItemHeight(index);
      if (yy >= yItem) and (yy < yItem + ItemH) then begin
        MouseMoveIndex := index;
        break;
      end;
      yItem := yItem + ItemH;
    end;

    if Assigned(EditHints) and
       ((MouseMoveIndex < -1) or (MouseMoveIndex >= EditHints.Count)) then
      MouseMoveIndex := OldMouseMoveIndex;
  end;
  Paint;
end;

procedure TFSRVHints.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
     Message: TWMMouse;
begin
  // Resize
  if (X >= Width-1 - Round(Image1.Width * ScaleX)) and
     (Y >= Height-1 - Round(Image1.Height * ScaleY)) then begin
    OldFormSize := Point(X, Y);
    isResize := True;
    Exit;
  end;
  // ScrollBar
  if FScrollBar.Visible and
    (X >= Width-1 - Round(FScrollBar.Width * ScaleX)) then begin
    // in scrollbar
    Message.XPos := Round((X - Width-1 + FScrollBar.Width * ScaleX) / ScaleX);
    Message.YPos := Round(Y / ScaleY);
    with TMessage(Message) do
      PostMessage(FScrollBar.Handle, WM_LBUTTONDOWN, WParam, LParam);
    Paint;
    Exit;
  end else begin
    // choice
    if (MouseMoveIndex > -1) and (MouseMoveIndex < EditHints.Count) then begin
      ItemIndex := MouseMoveIndex;
      Close;
    end else begin
      // Items
      ItemIndex := MouseMoveIndex;
      Close;
    end;
    exit;
  end;
  Paint;
end;

procedure TFSRVHints.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  isResize := False;
  isMouseDown := False;
end;

procedure TFSRVHints.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  Handled := True;
  if WheelDelta <= 0 then
    FScrollBar.Position := FScrollBar.Position + Mouse.WheelScrollLines
  else
    FScrollBar.Position := FScrollBar.Position - Mouse.WheelScrollLines;
  FirstItem := FScrollBar.Position;
  Paint;
end;

procedure TFSRVHints.FormCreate(Sender: TObject);
begin
  IsByse := False;
  isResize := False;
  isMouseDown := False;
  MouseIn := False;
  lockUpdate := 0;
  Buffer := TBitmap.Create;

  FScrollBar := TSRVScrollBar.Create(Self);
  FScrollBar.Parent := Self;
  FScrollBar.Kind := sbVertical;
  FScrollBar.Width := GetSystemMetrics(SM_CXVSCROLL);
//  FScrollBar.Align := alRight;
  FScrollBar.SmallChange := 1;
  FScrollBar.LargeChange := 5;
  FScrollBar.TabStop := False;
  FScrollBar.OnScroll := HookOnScroll;
  FScrollBar.Enabled := True;
  FScrollBar.Visible := False;
end;

procedure TFSRVHints.FormDestroy(Sender: TObject);
begin
  Buffer.Free;
  FScrollBar.Destroy;
  FScrollBar := nil;
end;

procedure TFSRVHints.UpdateBuffer;
var
  OldMapMode: Integer;
  OldWindowOrg, OldWindowExt, OldViewportOrg, OldViewportExt: TSize;
  i, X, Y, OffImgY, OffTextY, HintItemHeight, ImgIndex : Integer;
  R, RClient : TRect;
  DoSkin : Boolean;
begin
  if not Assigned(EditHints) then
    exit;

  Buffer.Canvas.Lock;

  OldMapMode := GetMapMode(Buffer.Canvas.Handle);
  SetMapMode(Buffer.Canvas.Handle, MM_ANISOTROPIC);
  SetWindowOrgEx(Buffer.Canvas.Handle, 0, 0, @OldWindowOrg);
  SetWindowExtEx(Buffer.Canvas.Handle, ClientRect.Right,
    ClientRect.Bottom, @OldWindowExt);

  SetViewportOrgEx(Buffer.Canvas.Handle, 0, 0, @OldViewportOrg);
  SetViewportExtEx(Buffer.Canvas.Handle, Round(ClientRect.Right * ScaleX),
     Round(ClientRect.Bottom * ScaleY), @OldViewportExt);

  RClient := Bounds(0, 0, Round(Width / ScaleX), Round(Height / ScaleY));
  DrawBoxBG(Buffer.Canvas, RClient, SkinManager, SkinSchemeIndex, True,
    MouseIn, isMouseDown, Enabled, Focused, 1, Color);

  Y := 1;
  Buffer.Canvas.Font := Font;
  for i:=FirstItem to EditHints.Count-1 do begin
    HintItemHeight := GetHintItemHeight(i);
    X := 1;
    Buffer.Canvas.Font.Color := clWhite;
    if (MouseMoveIndex = i) then begin
      // draw select
      Buffer.Canvas.Brush.Color := clHighlight;
      Buffer.Canvas.Pen.Color := clGray;
      Buffer.Canvas.Font.Color := clWhite;
      Buffer.Canvas.Brush.Style := bsSolid;
      Buffer.Canvas.Pen.Style := psSolid;
      ImgIndex := -1;
//      ImgIndex := EditHints.Items[i].SelectedImageIndex;
    end else begin
      // draw normal
      Buffer.Canvas.Pen.Color := clNone;
      Buffer.Canvas.Brush.Color := clNone;
      Buffer.Canvas.Font.Color := Font.Color;
      Buffer.Canvas.Pen.Style := psClear;
      Buffer.Canvas.Brush.Style := bsClear;
//      ImgIndex := EditHints.Items[i].ImageIndex;
      ImgIndex := -1;
    end;
    if FScrollBar.Visible then
      R := Bounds(1, Y, Round(Width / ScaleX) - SBButtonHeight-1, HintItemHeight)
    else
      R := Bounds(1, Y, Round(Width / ScaleX)-1, HintItemHeight);

    DoSkin := DrawBoxBG(Buffer.Canvas, R, SkinManager, ItemSkinSchemeIndex, True,
      MouseMoveIndex = i, ItemIndex = i, Enabled, Focused, 1, clNone);

    if not DoSkin and (Buffer.Canvas.Pen.Style = psSolid) then
      with R do
        Buffer.Canvas.Rectangle(Left, Top, Right, Bottom);

    if  not Assigned(FOnDrawItem) then begin
      // draw image
      If Assigned(ImgList) then begin
        OffImgY := (HintItemHeight - ImgList.Height) div 2;
        ImgList.Draw(Buffer.Canvas,
                    OffX + 1, Y + OffImgY, ImgIndex);
        X := X + ImgList.Width + 2;
      end;
      // draw text
      OffTextY := (HintItemHeight - Buffer.Canvas.TextHeight('Text')) div 2;
      Buffer.Canvas.TextOut(OffX + X, Y + OffTextY, EditHints[i]);
    end else
      if (MouseMoveIndex = i) then
        FOnDrawItem(Self, i, R, [odSelected])
      else
        FOnDrawItem(Self, i, R, []);

    DrawBoxBorder(Buffer.Canvas, R, SkinManager, ItemSkinSchemeIndex, True,
      MouseMoveIndex = i, ItemIndex = i, Enabled, Focused, 1);

    Y := Y + HintItemHeight;
  end;

  if FScrollBar.Visible then
    FScrollBar.PaintTo(Buffer.Canvas.Handle, RClient.right - FScrollBar.Width-1, 1);

  Buffer.Canvas.Draw(Round((Width-1)/ ScaleX) - Image1.Width,
                     Round((Height-1)/ ScaleY) - Image1.Height,
                     Image1.Picture.Graphic);

  DoSkin := DrawBoxBorder(Buffer.Canvas, RClient, SkinManager, SkinSchemeIndex, True,
    MouseIn, isMouseDown, Enabled, Focused, 1);

  If not DoSkin then begin
    Buffer.Canvas.Brush.Color := clBlack;
    Buffer.Canvas.FrameRect(RClient);
  end;

  SetViewportOrgEx(Buffer.Canvas.Handle, OldViewportOrg.cx, OldViewportOrg.cy, nil);
  SetViewportExtEx(Buffer.Canvas.Handle, OldViewportExt.cx, OldViewportExt.cy, nil);
  SetWindowOrgEx(Buffer.Canvas.Handle, OldWindowOrg.cx, OldWindowOrg.cy, nil);
  SetWindowExtEx(Buffer.Canvas.Handle, OldWindowExt.cx, OldWindowExt.cy, nil);
  SetMapMode(Buffer.Canvas.Handle, OldMapMode);

  If not DoSkin then begin
    Buffer.Canvas.Brush.Color := clBlack;
    Buffer.Canvas.FrameRect(ClientRect);
  end;

  Buffer.Canvas.Unlock;
end;

procedure TFSRVHints.Paint;
begin
  UpdateBuffer;
  Canvas.Draw(0, 0, Buffer);
end;

procedure TFSRVHints.Invalidate;
begin
  if Assigned(EditHints) then
    Canvas.Draw(0, 0, Buffer);
end;

procedure TFSRVHints.FormShow(Sender: TObject);
begin
//  Resize;
  Paint;
end;

procedure TFSRVHints.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
     OldPosition : Integer;
begin
  if (Key = VK_RETURN) or (Key = VK_SPACE) and
     (MouseMoveIndex > -1) and (MouseMoveIndex < EditHints.Count) then begin
    ItemIndex := MouseMoveIndex;
    OldPosition := FScrollBar.Position;
    Reset;
    FScrollBar.Position := OldPosition;
    FirstItem := FScrollBar.Position;

    if not (ssCtrl in Shift) then
      Close;
  end;

  if (Key = VK_F4) or (Key = VK_ESCAPE) then
    Close;

  if Key = VK_UP then
    if ssAlt in Shift then
      Close
    else
      MouseMoveIndex := Max(MouseMoveIndex -1, 0);

  if Key = VK_DOWN then
    MouseMoveIndex := Min(MouseMoveIndex + 1, EditHints.Count-1);

  if Key = VK_PRIOR then
    MouseMoveIndex := Max(MouseMoveIndex - DropDownHints-1, 0);

  if Key = VK_NEXT then
    MouseMoveIndex := Min(MouseMoveIndex + DropDownHints-1, EditHints.Count-1);

  if Key = VK_HOME then
    MouseMoveIndex := Min(0, EditHints.Count - 1);

  if Key = VK_END then
    MouseMoveIndex := EditHints.Count - 1;

  if (MouseMoveIndex <> -1) and
     ((MouseMoveIndex < FirstItem) or
     (MouseMoveIndex >= FirstItem + DropDownHints)) then begin
    if (MouseMoveIndex < FirstItem) then
      FirstItem := MouseMoveIndex;
    if (MouseMoveIndex >= FirstItem + DropDownHints) then
      FirstItem := MouseMoveIndex - DropDownHints + 1;

    FirstItem := Min(Max(FirstItem, 0), EditHints.Count - DropDownHints);
    FScrollBar.Position := FirstItem;
  end;
  Key := 0;
  Paint;
end;

function TFSRVHints.GetTopItem(ItemIndex : Integer) : Integer;
var
     i : Integer;
begin
  Result := -1;
  if FirstItem <= ItemIndex then begin
    Result := 0;
    for i:= FirstItem to ItemIndex-1 do
      Result := Result + GetHintItemHeight(ItemIndex);
  end;
end;

procedure TFSRVHints.Reset;
var
     MaxPos, PageSize : Integer;
begin
  FScrollBar.Position := 0;
  FirstItem := 0;

  DropDownHints := CalculateDrawItemCount(0, Round(Height / ScaleY), HintItemHeight);
  MaxPos := EditHints.Count;
  PageSize := MaxPos - Max(DropDownHints, 1);
  PageSize := Max(PageSize, 0);
  FScrollBar.Max := MaxPos;
  FScrollBar.PageSize := ScrollBar.Max - PageSize + 1;

  FScrollBar.Visible := PageSize > 0;
  FScrollBar.Height := Max(Round(Height / ScaleY) - Image1.Height, 0);
  Paint;
end;

function TFSRVHints.GetHintItemHeight(Index : Integer) : Integer;
begin
  Result := HintItemHeight;
  if (Index = -1) or (Index >= EditHints.Count) then Exit;
  if Assigned(OnMeasureItem) then
    OnMeasureItem(Self, Index, Result);
end;

procedure TFSRVHints.CMMouseEnter(var Message: TMessage);
begin
  inherited;
    MouseIn := True;
end;

procedure TFSRVHints.CMMouseLeave(var Message: TMessage);
begin
  If IsByse then
    Exit;

  inherited;

  If not IsByse and FScrollBar.InMouse  then begin
    IsByse := True;
    with Message do
      SendMessage(FScrollBar.Handle, CM_MOUSELEAVE, 0, 0);
    IsByse := False;
  end;

  MouseIn := False;
  Paint;
end;

procedure TFSRVHints.HookOnScroll(Sender: TObject; ScrollCode: TScrollCode;
  var ScrollPos: Integer);
begin
  FirstItem := Min(Max(ScrollPos, 0), FScrollBar.Max);
  Paint;
end;

{-----------------------------------------------------------------------}
procedure TFSRVHints.WMRepaintControl(var Message: TMessage);
begin
  Paint;
end;
{-----------------------------------------------------------------------}

end.

