unit JFGrid;

interface

  Uses
    Controls, Grids, Classes, Types, Messages, Graphics;

  Type
    // If a string is missing or invalid, it should be set to ''.  If a double
    // is missing or invalid it should be set to NaN.
    TJFEntry =
      Record
        Time : String;
        Symbol : String;
        Change : Double;
        BB : Double;
        Volume : Integer;
        Count : Integer;
        Rank : Double;  // 0.0 is unranked.  1.0 is the top rank.
        RelVol : Double;
      End;
    TJFEntries = Array Of TJFEntry;

    TJFGrid =
      Class(TDrawGrid)
      Private
        FEntries : TJFEntries;
        FTextColor : TColor;
        Procedure UpdateColumnHeaders;
        Procedure SetColWidth(ACol : LongInt; Const SizeHint : String);
        Procedure WMNCCalcSize(var msg: TMessage); message WM_NCCALCSIZE;
        Procedure FontChanged(Sender : TObject);

      Protected
        Procedure DrawCell(ACol, ARow: Longint;
                           ARect: TRect;
                           AState: TGridDrawState);  Override;
        Procedure MouseUp(Button: TMouseButton;
                          Shift: TShiftState;
                          X, Y: Integer);  Override;

      Public
        // I make a copy of this so you can change the original.
        // The stuff you want to show up on top is entry 0 of the array.
        Procedure SetEntries(Entries : TJFEntries);

        // Presumably you just set visible = true, and align = alClient.
        // We set the Parent to be the Owner.  That is required to make the
        // initialization go smoothly.
        Constructor Create(AOwner: TWinControl);  Reintroduce;

        // Use Color to change the background color, and TextColor to change the
        // foreground color.  We do not automatically redraw when these are
        // changed.  We could, but for simplicity I'm assuming that these will
        // only be set on creation.
        Property TextColor : TColor Read FTextColor Write FTextColor;
      End;

implementation

  Uses
    ExternalLinkingUnit,
    Math, SysUtils, Windows;

  Const
    ColTime = 0;
    ColSymbol = 1;
    ColChange = 2;
    ColVolume = 3;
    ColRelVol = 4;
    ColBB = 5;
    ColNum = 6;

  // This assumes that we're not using any system colors.  If the first byte
  // is not 0, then that's a system color and it has some special meaning.
  Function ColorMix(Zero, One : TColor; Where : Double) : TColor;
    Function ByteMix(ZeroByte, OneByte : Integer) : Integer;
      Begin
        If Where <= 0.0 Then
          ByteMix := ZeroByte And $ff
        Else If Where >= 1.0 Then
          ByteMix := OneByte And $ff
        Else
          ByteMix := Round((ZeroByte And $ff) * (1.0 - Where) + (OneByte And $ff) * Where)
      End;
    Begin
      Result := ByteMix(Zero, One)
                + (ByteMix(Zero ShR 8, One ShR 8) ShL 8)
                + (ByteMix(Zero ShR 16, One ShR 16) ShL 16)
    End;

  Procedure TJFGrid.WMNCCalcSize(var msg: TMessage);
    Var
      Style : Integer;
    Begin
      // Disable the horizontal scroll bar to make it look more like what they
      // already had.
      // Code inspired by:  http://www.delphi3000.com/articles/article_3254.asp
      style := getWindowLong( handle, GWL_STYLE );
      If (Style And WS_HSCROLL) <> 0 Then
        SetWindowLong(Handle, GWL_STYLE, Style And Not WS_HSCROLL);
      Inherited
    End;

  { This was copied in large part from AlertGrids.Pas in the ActiveX control.
    There are several variations of this out there, but this one seemed like the
    simplest. }
  Procedure TJFGrid.DrawCell(ACol, ARow: Longint;
                                      ARect: TRect;
                                      AState: TGridDrawState);
    Var
      ClientRect : TRect;
    Function ClientWidth : Integer;
      Begin
        Result := ClientRect.Right - ClientRect.Left
      End;
    Function ClientHeight : Integer;
      Begin
        Result := ClientRect.Bottom - ClientRect.Top
      End;
    Procedure TextRightJustify(TextString : String);
      Var
        TextHeight, TextWidth : Integer;
      Begin
        TextHeight := Canvas.TextHeight(TextString);
        TextWidth := Canvas.TextWidth(TextString);
        Canvas.Brush.Style := bsClear;
        Canvas.TextRect(ClientRect,
                        ClientRect.Left + Max(ClientWidth - TextWidth, 0),
                        ClientRect.Top + Max(ClientHeight - TextHeight, 0) Div 2,
                        TextString)
      End;
    Procedure TextLeftJustify(TextString : String);
      Var
        TextHeight : Integer;
      Begin
        TextHeight := Canvas.TextHeight(TextString);
        Canvas.Brush.Style := bsClear;
        Canvas.TextRect(ClientRect, ClientRect.Left,
                        ClientRect.Top + Max(ClientHeight - TextHeight, 0) Div 2,
                        TextString)
      End;
    Procedure TextCenter(TextString : String);
      Var
        TextHeight, TextWidth : Integer;
      Begin
        TextHeight := Canvas.TextHeight(TextString);
        TextWidth := Canvas.TextWidth(TextString);
        Canvas.TextRect(ClientRect,
                        ClientRect.Left + Max(ClientWidth - TextWidth, 0) Div 2,
                        ClientRect.Top + Max(ClientHeight - TextHeight, 0) Div 2,
                        TextString);
      End;
    Function TooWide(TextString : String) : Boolean;
      Begin
        Result := Canvas.TextWidth(TextString) > ClientWidth
      End;
    Function MakeIntegerFit(I : Integer) : String;
      Procedure Adjust(Adjusted : Double; Symbol : Char);
        Begin
          Result := Format('%.2n%s', [Adjusted, Symbol]);
          If TooWide(Result) Then
            Begin
              Result := Format('%.1n%s', [Adjusted, Symbol]);
              If TooWide(Result) Then
                Begin
                  Result := Format('%.0n%s', [Adjusted, Symbol]);
                  If TooWide(Result) Then
                    Result := '...'
                End
            End
        End;
      Begin
        Result := Format('%.0n', [I+0.0]);  // %n won't work with integers!
        If TooWide(Result) Then
          If (I < 1000) Then
            Result := '...'
          Else If (I < 1000000) Then
            Adjust(I / 1.0e+3, 'K')
          Else
            Adjust(I / 1.0e+6, 'M')
      End;
    Function MakeStringFit(S : String) : String;
      Var
        Count, SpaceRemaining : Integer;
      Begin
        If TooWide(S) Then
          Begin
            Count := 1;
            SpaceRemaining := ClientWidth - Canvas.TextWidth('...');
            While Count <= Length(S) Do
              Begin
                SpaceRemaining := SpaceRemaining - Canvas.TextWidth(S[Count]);
                If SpaceRemaining < 0 Then
                  Break;
                Inc(Count)
              End;
            Result := Copy(S, 0, Pred(Count)) + '...';
          End
        Else
          Result := S;
      End;
    Function MakePriceFit(P : Double) : String;
      Begin
        Result := Format('%f', [P]);
        If TooWide(Result) Then
          Result := '...'
      End;
    Function MakePercentFit(P : Double) : String;
      Begin
        Result := Format('%.01f', [P]);
        If TooWide(Result) Then
          Result := '...'
      End;
    Var
      DataIndex, DataTypeIndex : Integer;
      EntryValid : Boolean;
      Name : String;
      FgColor, BgColor : TColor;
      Rank : Double;
    Begin  { TJFGrid.DrawCell }
      DataIndex := Pred(ARow);
      EntryValid := (DataIndex >= 0) And (DataIndex < Length(FEntries));
      DataTypeIndex := ACol;
      Canvas.Font.Style := [];
      If gdFixed In AState Then
        Begin
          BgColor := FixedColor;
          FgColor := clBlack
        End
      Else If (DataTypeIndex = ColNum) And EntryValid
           And (FEntries[DataIndex].Count >= 10) Then
        Begin
          BgColor := clYellow;
          FgColor := clBlack
        End
      Else
        Begin
          If Not EntryValid Then
            Rank := 0.0
          Else
            Rank := FEntries[DataIndex].Rank;
          If Rank = 0.0 Then
            Begin
              BgColor := Color;
              FgColor := TextColor
            End
          Else
            Begin
              BgColor := ColorMix(clWhite, TextColor, Rank);
              FgColor := clBlack
            End
        End;
      Canvas.Brush.Color := BgColor;
      Canvas.Font.Color := FgColor;
      Canvas.FillRect(ARect);
      ClientRect := ARect;
      If (gdFixed In AState) And Ctl3D Then
        Begin
          DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOM Or BF_RIGHT Or BF_TOP Or BF_LEFT);
          Inc(ClientRect.Left);
          Inc(ClientRect.Top);
          Dec(ClientRect.Right);
          Dec(ClientRect.Bottom)
        End;
      If ClientWidth > 14 Then
        Begin
          Inc(ClientRect.Left, 3);
          Dec(ClientRect.Right, 3)
        End;
      If gdFixed In AState Then
        Begin
          Case DataTypeIndex Of
            ColTime : Name := 'Time';
            ColSymbol : Name := 'Symbol';
            ColChange : Name := '%Chg';
            ColVolume : Name := 'Volume';
            ColBB : Name := 'BB';
            ColNum : Name := '#';
            ColRelVol : Name := 'RV'
          Else
            Name := '';
          End;
          TextCenter(MakeStringFit(Name))
          { This is a column or row header.  When we start sorting the items,
            we should consider using the triangles from
            TSortableHeaderCellRenderer.DrawTriangle in MarketViewBase.Pas to
            show which row or column is the sort key, and the direction of the
            sort operation. }
        End
      Else If EntryValid Then
        With FEntries[DataIndex] Do
          Case DataTypeIndex Of
            ColTime : TextRightJustify(MakeStringFit(Time));
            ColSymbol : TextLeftJustify(MakeStringFit(Symbol));
            ColChange :
              If Not IsNaN(Change) Then
               TextRightJustify(MakePercentFit(Change));
            ColVolume :
              If Volume > 0 Then
                TextRightJustify(MakeIntegerFit(Volume));
            ColBB :
              If Not IsNaN(BB) Then
                TextRightJustify(MakePriceFit(BB));
            ColNum :
              If Count > 0 Then
                TextRightJustify(MakeIntegerFit(Count));
            ColRelVol :
              If Not IsNaN(RelVol) Then
                TextRightJustify(MakePriceFit(RelVol));
          End
    End;  { TJFGrid.DrawCell }

  Procedure TJFGrid.SetEntries(Entries : TJFEntries);
    Begin
      FEntries := Entries;
      SetLength(FEntries, Length(FEntries));
      RowCount := Succ(Max(1, Length(FEntries)));
      Invalidate
    End;

  Procedure TJFGrid.SetColWidth(ACol : LongInt;
                                         Const SizeHint : String);
    Begin
      If Ctl3D Then
        ColWidths[ACol] := 16 + Canvas.TextWidth(SizeHint)
      Else
        ColWidths[ACol] := 12 + Canvas.TextWidth(SizeHint)
    End;

  Procedure TJFGrid.MouseUp(Button: TMouseButton;
                                     Shift: TShiftState;
                                     X, Y: Integer);
    Var
      DataIndex, Col, Row : Integer;
    Begin
      Inherited;
      If Button = mbLeft Then
        Begin
          MouseToCell(X, Y, Col, Row);
          DataIndex := Pred(Row);
          If (DataIndex >= 0) And (DataIndex < Length(FEntries)) Then
            ExternalLinkingWindow.SendSymbol(FEntries[DataIndex].Symbol)
        End
    End;

  Constructor TJFGrid.Create(AOwner: TWinControl);
    Begin
      Inherited Create(AOwner);
      DoubleBuffered := True;
      Color := clBlack;
      TextColor := clWhite;
      ColCount := 7;
      RowCount := 2;
      FixedRows := 1;
      FixedCols := 0;
      Options := [goColSizing, goThumbTracking];
      DefaultDrawing := False;
      If Assigned(AOwner) Then
        Begin
          Parent := AOwner;
          UpdateColumnHeaders
        End;
      Font.OnChange := FontChanged;
    End;

  Procedure TJFGrid.UpdateColumnHeaders;
    Begin
      Canvas.Font := Font;
      DefaultRowHeight := Canvas.TextHeight('Xy()') + 4;
      SetColWidth(ColTime, '00:00');
      SetColWidth(ColSymbol, 'Symbol');
      SetColWidth(ColChange, '-1.93');
      SetColWidth(ColVolume, '100,000,000');
      SetColWidth(ColBB, '100.00');
      SetColWidth(ColNum, '10');
      SetColWidth(ColRelVol, '10.00');
      Invalidate
    End;

  Procedure TJFGrid.FontChanged(Sender : TObject);
    Begin
      UpdateColumnHeaders
    End;


End.