Unit SymbolOnlyGrid;

Interface

  Uses
    QuickStrikeGrid,
    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.
    TSymbolOnlyEntry = TQuickStrikeEntry;
    TSymbolOnlyEntries = TQuickStrikeEntries;

    TSymbolOnlyGrid =
      Class(TDrawGrid)
      Private
        // 0 means to draw the newest one on the top left corner.  1 means to go
        // down one row.  After enough we get to the bottom, we move up to the
        // top of the second column.
        FOffset : Integer;

        FEntries : TSymbolOnlyEntries;
        FTextColor : TColor;
        FInitialized : Boolean;
        Function GetColWidth(Const SizeHint : String) : Integer;
        Procedure WMNCCalcSize(var msg: TMessage); message WM_NCCALCSIZE;
        Procedure DoResize(Force : Boolean);
        Procedure GetDataIndex(ACol, ARow : Longint;
                               Var DataIndex : Integer; Var Valid : Boolean);

      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 : TSymbolOnlyEntries);

        // 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;

  Procedure TSymbolOnlyGrid.DoResize(Force : Boolean);
    Var
      OldCols, OldRows : Integer;
    Begin
      OldCols := ColCount;
      OldRows := RowCount;
      ColCount := Max(Succ(FixedCols), Width Div DefaultColWidth);
      RowCount := Max(Succ(FixedRows), Height Div DefaultRowHeight);
      If Force Or (RowCount <> OldRows) Or (ColCount <> OldCols) Then
        Begin
          // If the grid is not full, put the oldest entry on the top left.  If
          // the grid is full, put the newest entry on the bottom right.
          FOffset := Pred(Min(Length(FEntries), ColCount * Pred(RowCount)));
          Invalidate
        End
    End;

  Procedure TSymbolOnlyGrid.WMNCCalcSize(var msg: TMessage);
    Var
      Style : Integer;
      PreferredStyle : 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 );
      PreferredStyle := Style And Not (WS_HSCROLL Or WS_VSCROLL);
      If Style <> PreferredStyle Then
        SetWindowLong(Handle, GWL_STYLE, PreferredStyle);
      DoResize(False);
      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 TSymbolOnlyGrid.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('%.2f%s', [Adjusted, Symbol]);
          If TooWide(Result) Then
            Begin
              Result := Format('%.1f%s', [Adjusted, Symbol]);
              If TooWide(Result) Then
                Begin
                  Result := Format('%.0f%s', [Adjusted, Symbol]);
                  If TooWide(Result) Then
                    Result := '...'
                End
            End
        End;
      Begin
        Result := Format('%d', [I]);
        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('%f%%', [P]);
        If TooWide(Result) Then
          Result := '...'
      End;
    Var
      DataIndex : Integer;
      EntryValid : Boolean;
      FgColor, BgColor, SwapColor : TColor;
    Begin  { TSymbolOnlyGrid.DrawCell }
      GetDataIndex(ACol, ARow, DataIndex, EntryValid);
      Canvas.Font.Style := [];
      If gdFixed In AState Then
        Begin
          BgColor := FixedColor;
          FgColor := clBlack
        End
      Else
        Begin
          BgColor := Color;
          FgColor := TextColor
        End;
      If EntryValid And (DataIndex = 0) Then
        Begin
          // Swap the colors for the most recent entry.
          SwapColor := FgColor;
          FgColor := BgColor;
          BgColor := SwapColor
        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
        TextCenter(MakeStringFit('Symbol'))
      Else If EntryValid Then
        With FEntries[DataIndex] Do
          TextLeftJustify(MakeStringFit(Symbol))
    End;  { TSymbolOnlyGrid.DrawCell }

  Procedure TSymbolOnlyGrid.GetDataIndex(ACol, ARow : Longint;
                                         Var DataIndex : Integer;
                                         Var Valid : Boolean);
    Begin
      DataIndex := Pred(ARow) + ACol * Pred(RowCount);
      DataIndex := FOffset - DataIndex;
      If DataIndex < 0 Then
        DataIndex := DataIndex + ColCount * Pred(RowCount);
      Valid := (ARow <> 0) And (DataIndex >= 0) And (DataIndex < Length(FEntries))
    End;

  Procedure TSymbolOnlyGrid.SetEntries(Entries : TSymbolOnlyEntries);
    Begin
      If Length(Entries) = 0 Then
        Begin
          SetLength(FEntries, 0);
          // This is a bit of overkill, but it ensures that we restart in the
          // top left, just like a new window.
          DoResize(True)
        End
      Else
        Begin
          If Not FInitialized Then
            Begin
              // We call this in the constructor, but it doesn't work great
              // there.  It does the width right, but not the height.
              DoResize(True);
              FInitialized := True
            End;
          FEntries := Entries;
          SetLength(FEntries, Length(FEntries));
          FOffset := Succ(FOffset) Mod (ColCount * Pred(RowCount));
          Invalidate
        End;
    End;

  Function TSymbolOnlyGrid.GetColWidth(Const SizeHint : String) : Integer;
    Begin
      If Ctl3D Then
        Result := 16 + Canvas.TextWidth(SizeHint)
      Else
        Result := 12 + Canvas.TextWidth(SizeHint)
    End;

  Procedure TSymbolOnlyGrid.MouseUp(Button: TMouseButton;
                                     Shift: TShiftState;
                                     X, Y: Integer);
    Var
      DataIndex, Col, Row : Integer;
      DataValid : Boolean;
    Begin
      Inherited;
      If Button = mbLeft Then
        Begin
          MouseToCell(X, Y, Col, Row);
          GetDataIndex(Col, Row, DataIndex, DataValid);
          If DataValid Then
            ExternalLinkingWindow.SendSymbol(FEntries[DataIndex].Symbol)
        End
    End;

  Constructor TSymbolOnlyGrid.Create(AOwner: TWinControl);
    Begin
      Inherited Create(AOwner);
      DoubleBuffered := True;
      Color := clBlack;
      TextColor := clWhite;
      ColCount := 6;
      RowCount := 2;
      FixedRows := 1;
      FixedCols := 0;
      Options := [goThumbTracking];
      DefaultDrawing := False;
      If Assigned(AOwner) Then
        Begin
          Parent := AOwner;
          Canvas.Font := Font;
          DefaultRowHeight := Canvas.TextHeight('Xy()') + 4;
          DefaultColWidth := GetColWidth('Symbol');
          DoResize(True)
        End
    End;

End.