jvgstringgrid.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvgStringGrid.PAS, released on 2003-01-15.

The Initial Developer of the Original Code is Andrey V. Chudin,  [chudin att yandex dott ru]
Portions created by Andrey V. Chudin are Copyright (C) 2003 Andrey V. Chudin.
All Rights Reserved.

Contributor(s):
Michael Beck [mbeck att bigfoot dott com].

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvgStringGrid.pas,v 1.20 2005/02/17 10:21:21 marquardt Exp $

unit JvgStringGrid;

{$I jvcl.inc}

interface

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$ENDIF USEJVCL}
  Windows, Messages, Classes, Controls, Graphics, ExtCtrls,
  Grids, StdCtrls, Forms,
  {$IFDEF USEJVCL}
  JVCLVer,
  {$ENDIF USEJVCL}
  JvgTypes, JvgCommClasses, JvgUtils;

const
  JvDefaultEditorColor = $00FEE392;

type
  TglStringGridExtOption = (fsgVertCaptions, fsgHottrack, fsgMemoEditor,
    fsgWordWrap, fsgCellHeightAutoSize, fsgTabThroughCells);
  TglStringGridExtOptions = set of TglStringGridExtOption;

  TglGridCellStyle = record
    Hottracking: Boolean;
    GradientFilling: Boolean;
    Default_Drawing: Boolean;
    R: TRect;
    CellBorders: TglSides;
    BevelInner: TPanelBevel;
    BevelOuter: TPanelBevel;
    BevelBold: Boolean;
    FontStyle: TFontStyles;
    FontColor: TColor;
    BackgrColor: TColor;
    Interspace: Integer
  end;

  TglOnGetCellStyleEvent = procedure(Sender: TObject; ACol, ARow: Longint;
    var Style: TglGridCellStyle) of object;
  TglOnGetCellGradientParamsEvent = procedure(Sender: TObject;
    ACol, ARow: Longint; var CellRect: TRect; var Gradient: TJvgGradient) of object;

  TJvgStringGrid = class(TStringGrid)
  private
    {$IFDEF USEJVCL}
    FAboutJVCL: TJVCLAboutInfo;
    {$ENDIF USEJVCL}
    FCaptionTextAlignment: TAlignment;
    FCaptionFont: TFont;
    FBitmap: TBitmap;
    FBmp: TBitmap;
    FImage: TImage;
    FCaptions: TStringList;
    FHottrackThrought: Boolean;
    AHottrackCol: Longint;
    AHottrackRow: Longint;
    Memo: TMemo;
    MemoCell: TGridCoord;
    Gradient: TJvgGradient;
    FOnGetCellStyle: TglOnGetCellStyleEvent;
    FOnGetCellGradientParams: TglOnGetCellGradientParamsEvent;
    FExtOptions: TglStringGridExtOptions;
    FTextAlignment: TAlignment;
    FEditorColor: TColor;
    FEditorFont: TFont;
    MemoUpdateTimer: TTimer;
    procedure SetCaptionTextAlignment(Value: TAlignment);
    procedure SetCaptionFont(Value: TFont);
    function GetBitmap: TBitmap;
    procedure SetBitmap(Value: TBitmap);
    procedure SetImage(Value: TImage);
    function GetCaptions: TStrings;
    procedure SetCaptions(Value: TStrings);
    procedure SetVertCaptions(Value: Boolean);
    procedure OnMemoChange(Sender: TObject);
    procedure OnMemoExit(Sender: TObject);
    procedure ShowEditorAtCell(X, Y: Longint);
    procedure UpdateCaptions(Sender: TObject);
    procedure SetHottrack(const Value: Boolean);
    procedure SetMemoEditor(const Value: Boolean);
    procedure SetWordWrap(const Value: Boolean);
    procedure SetExtOptions(const Value: TglStringGridExtOptions);
    procedure SetTextAlignment(const Value: TAlignment);
  protected
    //    function CreateEditor: TInplaceEdit; override;
    function CanEditShow: Boolean; override;

    procedure Loaded; override;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState:
      TGridDrawState); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    procedure CMChildKey(var Msg: TMessage); message CM_CHILDKEY;
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;

    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    //    procedure DblClick; dynamic;

    procedure GetCellStyle(Sender: TObject; var ACol, ARow: Integer; var
      Style: TglGridCellStyle); virtual;
    procedure GetCellGradientParams(Sender: TObject; ACol, ARow: Longint; var
      CellRect: TRect; var Gradient: TJvgGradient); virtual;
  public
    //    property InplaceEditor;
    AlignAll: Boolean;
    ColsBold: Integer;
    RowsBold: Integer;
    HottrackColor: TColor;

    property VertCaptions: Boolean write SetVertCaptions default False;
    property Hottrack: Boolean write SetHottrack default False;
    property MemoEditor: Boolean write SetMemoEditor default False;
    property WordWrap: Boolean write SetWordWrap default False;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure GetPriorCell(var X, Y: Longint);
    procedure GetNextCell(var X, Y: Longint);
    procedure ClearSelection;
  published
    {$IFDEF USEJVCL}
    property AboutJVCL: TJVCLAboutInfo read FAboutJVCL write FAboutJVCL stored False;
    {$ENDIF USEJVCL}
    property CaptionTextAlignment: TAlignment read FCaptionTextAlignment write
      SetCaptionTextAlignment default taCenter;
    property TextAlignment: TAlignment read FTextAlignment write
      SetTextAlignment default taLeftJustify;
    property CaptionFont: TFont read FCaptionFont write SetCaptionFont;
    property Captions: TStrings read GetCaptions write SetCaptions;
    property Bitmap: TBitmap read GetBitmap write SetBitmap;
    property Image: TImage read FImage write SetImage;
    property ExtOptions: TglStringGridExtOptions read FExtOptions write SetExtOptions;
    property EditorColor: TColor read FEditorColor write FEditorColor default JvDefaultEditorColor;
    property EditorFont: TFont read FEditorFont write FEditorFont;
    property OnGetCellStyle: TglOnGetCellStyleEvent read FOnGetCellStyle write FOnGetCellStyle;
    property OnGetCellGradientParams: TglOnGetCellGradientParamsEvent read
      FOnGetCellGradientParams write FOnGetCellGradientParams;
  end;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvgStringGrid.pas,v $';
    Revision: '$Revision: 1.20 $';
    Date: '$Date: 2005/02/17 10:21:21 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

implementation

uses
  Math;

constructor TJvgStringGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner); //FHottrackThrought := True;

  FCaptionFont := TFont.Create;
  FEditorFont := TFont.Create;
  MemoUpdateTimer := TTimer.Create(nil);
  MemoUpdateTimer.Enabled := False;
  MemoUpdateTimer.Interval := 200;
  MemoUpdateTimer.OnTimer := OnMemoChange;
  FCaptionTextAlignment := taCenter;
  FCaptions := TStringList.Create;
  FCaptions.OnChange := UpdateCaptions;
  AHottrackCol := -1;
  HottrackColor := clHighlight;
  FEditorColor := JvDefaultEditorColor;
  FExtOptions := [fsgHottrack, fsgMemoEditor, fsgWordWrap,
    fsgCellHeightAutoSize, fsgTabThroughCells];
  Options := Options + [goEditing];

  if csDesigning in ComponentState then
    Exit;
  Memo := TMemo.Create(Self);
  Memo.Visible := False;
  Memo.BorderStyle := bsNone;
  Memo.Parent := Self;
  Memo.OnChange := OnMemoChange;
  Memo.OnExit := OnMemoExit;
  //  Memo.OnKeyDown := OnMemoKeyDown;
  DefaultDrawing := False;
end;

destructor TJvgStringGrid.Destroy;
begin
  FCaptionFont.Free;
  FCaptions.Free;
  FEditorFont.Free;
  MemoUpdateTimer.Free;
  if Assigned(Memo) then
    Memo.Free;
  if Assigned(FBitmap) then
    FBitmap.Free;
  if Assigned(Gradient) then
    Gradient.Free;
  inherited Destroy;
end;

procedure TJvgStringGrid.Loaded;
begin
  inherited Loaded;
  if Assigned(FBitmap) and (not FBitmap.Empty) then
    FBmp := FBitmap;
  VertCaptions := fsgVertCaptions in FExtOptions;
end;

procedure TJvgStringGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState:
  TGridDrawState);
const
  aAlignments: array[TAlignment] of Longint = (DT_LEFT,
    DT_RIGHT, DT_CENTER);
  aWordWrap: array[Boolean] of Longint = (0, DT_WORDBREAK);
var
  R: TRect;
  doHottracking, isFixedCell: Boolean;
  X, X1, Y, Y1, IHeight, IWidth, l, t, I, Interspace: Integer;
  Style: TglGridCellStyle;
  CellTextAlignment: TAlignment;
begin
  ///  dec(ARect.Bottom);

  isFixedCell := (ACol < FixedCols) or (ARow < FixedRows);

  Interspace := 2;
  if Assigned(OnDrawCell) then
    OnDrawCell(Self, ACol, ARow, ARect, AState);
  if ACol < ColsBold then
    Canvas.Font.Style := Canvas.Font.Style + [fsBold];
  if ARow < RowsBold then
    Canvas.Font.Style := Canvas.Font.Style + [fsBold];
  R := ARect;

  if isFixedCell then
    if IsItAFilledBitmap(FBmp) then
    begin
      X := R.Left;
      Y := R.Top;
      IHeight := R.Bottom - R.Top;
      IWidth := R.Right - R.Left - 4;
      X1 := X;
      Y1 := Y;
      l := 0;
      t := DefaultRowHeight * ARow mod FBmp.Height;
      while X1 < R.Right do
      begin
        if X1 + IWidth > R.Right then
          IWidth := R.Right - X1;
        while Y1 < R.Bottom do
        begin
          if Y1 + IHeight > R.Bottom then
            IHeight := R.Bottom - Y1;
          BitBlt(Canvas.Handle, X1, Y1, Min(IWidth, FBmp.Width - l),
            Min(IHeight, FBmp.Height - t), FBmp.Canvas.Handle, l, t, SRCCOPY);
          Inc(Y1, Min(IHeight, FBmp.Height));
        end;
        Inc(X1, Min(IWidth, FBmp.Width));
        Y1 := Y;
      end;
    end;

  if True then
  begin
    if FHottrackThrought then
      doHottracking := (AHottrackCol = ACol) or (AHottrackRow = ARow)
    else
    if fsgHottrack in FExtOptions then
      doHottracking := (AHottrackCol = ACol) and (AHottrackRow = ARow) and
        ((ACol < FixedCols) or (ARow < FixedRows))
    else
      doHottracking := False;

    if isFixedCell then
    begin
      Canvas.Font.Assign(FCaptionFont);
      CellTextAlignment := CaptionTextAlignment;
      Style.BevelOuter := bvRaised;
      Style.BackgrColor := clBtnFace;
    end
    else
    begin
      Canvas.Font.Assign(Font);
      CellTextAlignment := TextAlignment;
      Style.BevelOuter := bvNone;
      if gdSelected in AState then
        Style.BackgrColor := clHighlight
      else
        Style.BackgrColor := Color;
    end;

    if doHottracking then
      Style.FontColor := HottrackColor
    else
      Style.FontColor := Canvas.Font.Color;

    if gdSelected in AState then
      Style.FontColor := clHighlightText;

    Style.Hottracking := doHottracking;
    Style.GradientFilling := False;
    Style.Default_Drawing := True;
    Style.R := R;
    Style.CellBorders := ALLGLSIDES;
    Style.BevelInner := bvNone;

    Style.BevelBold := False;
    Style.FontStyle := Canvas.Font.Style;
    Style.Interspace := Interspace;
    GetCellStyle(Self, ACol, ARow, Style);
    Canvas.Font.Style := Style.FontStyle;
    R := Style.R;
    if not Style.Default_Drawing then
      Exit;

    if Style.GradientFilling then
    begin
      if Gradient = nil then
        Gradient := TJvgGradient.Create;
      Gradient.Active := True;
      ARect := R;
      GetCellGradientParams(Self, ACol, ARow, ARect, Gradient);
      GradientBox(Canvas.Handle, ARect, Gradient, Integer(psSolid), 1);
    end;

    DrawBoxEx(Canvas.Handle, R, Style.CellBorders, Style.BevelInner,
      Style.BevelOuter, Style.BevelBold,
      Style.BackgrColor, {(BackgrColor = clBtnFace)or}
      Style.GradientFilling);
    ARect := R;
    Inc(ARect.Left, Style.Interspace);
    SetTextColor(Canvas.Handle, ColorToRGB(Style.FontColor));
    SetBkMode(Canvas.Handle, TRANSPARENT);
    Windows.DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]), Length(Cells[ACol,
      ARow]), R, aAlignments[CellTextAlignment] or DT_WORDBREAK or
        DT_CALCRECT);

    if (fsgCellHeightAutoSize in ExtOptions) and not isFixedCell then
    begin
      I := R.Bottom - R.Top;
      if (I > DefaultRowHeight) and (RowHeights[ARow] < I) then
      begin
        ///RowHeights[ARow] := I;
        Exit;
      end;
    end;

    ARect.Top := ARect.Top + Max(0, (ARect.Bottom - R.Bottom) div 2);
    Windows.DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]), length(Cells[ACol,
      ARow]), ARect, aAlignments[CellTextAlignment] or aWordWrap[fsgWordWrap in
        FExtOptions]);
    SetTextColor(Canvas.Handle, ColorToRGB(Font.Color));
  end
  else // if AlignAll then
  begin
    Canvas.Brush.Color := Color;
    Canvas.FillRect(ARect);
    Inc(ARect.Left, 2);
    R := ARect;
    Windows.DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]), length(Cells[ACol,
      ARow]), R, DT_LEFT or DT_WORDBREAK or DT_CALCRECT);
    ARect.Top := ARect.Top + Max(0, (ARect.Bottom - R.Bottom) div 2);
    Windows.DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]), length(Cells[ACol,
      ARow]), ARect, DT_LEFT or DT_WORDBREAK)
  end; //  else inherited;
  // DefaultDrawing := True;
end;

procedure TJvgStringGrid.SetCaptionTextAlignment(Value: TAlignment);