Tips (1565)

Tip Rating (7):

unit MainGrid;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, ExtCtrls, StdCtrls;

type
  PGridTexte = ^TGridTexte;
  TGridTexte = record
    Msg: string;
    Zeit: TTime;
    ZeitStr: string;
  end;
  TStringGrid = class(Grids.TStringGrid)
  private
    procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
    procedure GridTexteDestroy;
    procedure FMemoSetze;
    procedure FMemoOnEnter(Sender: TObject);
    procedure FMemoOnExit(Sender: TObject);
    procedure FRowNull;
    function NewGridTexte(T: TTime): PGridTexte;
  public
    FMemo: TMemo;
    FTextList: TList;
    FRow,
    FCol: Integer;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure GridTexteCreate(Max: Integer);
  end;
  //***************************************
  TMain = class(TForm)
    PanelZeitBox: TPanel;
    StringGrid: TStringGrid;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormShow(Sender: TObject);
  private
  public
    { Public-Deklarationen }
  end;
var
  Main: TMain;

implementation

uses
  DateUtils;
{$R *.dfm}
{$I MainGrid.inc}

procedure TMain.FormCreate(Sender: TObject);
begin
  PanelZeitBox.Align := alRight;
  PanelZeitBox.Width := 300;
  with StringGrid do
  begin
    Parent           := PanelZeitBox;
    DefaultRowHeight := PanelZeitBox.Height div 12;
    Height           := PanelZeitBox.Height;
    DefaultColWidth  := 60;
    RowCount         := 24 * 4;
    ColWidths[1]     := PanelZeitBox.Width - DefaultColWidth - 18;
    GridTexteCreate(RowCount);
    FMemoSetze;
  end;
end;
//------------------------------------------------------------------------------

procedure TMain.FormShow(Sender: TObject);
begin
  StringGrid.FMemo.SetFocus;
end;
//------------------------------------------------------------------------------

procedure TMain.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  S: string;
  I: Integer;
  Hour, Min, Sec, MSec: Word;
begin
  with StringGrid, Canvas do
  begin
    FRowNull;
    if ACol > 0 then
    begin
      S := PGridTexte(FTextList[ARow])^.Msg;
      DrawText(Canvas.Handle, PChar(S), Length(S), Rect, DT_WordBreak);
    end 
    else 
    begin
      S := PGridTexte(FTextList[ARow])^.ZeitStr;
      DecodeTime(PGridTexte(FTextList[ARow])^.Zeit, Hour, Min, Sec, MSec);
      if Min = 0 then Font.Style := [fsBold]
      else 
        Font.Style := [];
      Rect.Right := Rect.Right - 5;
      Rect.Top   := Rect.Top + TextHeight(S);
      DrawText(Canvas.Handle, PChar(S), Length(S), Rect, DT_RIGHT);
    end;
  end;
end;

{TStringGrid-public************************************************************}

procedure TStringGrid.WMSetCursor(var Msg: TWMSetCursor);
begin
  inherited;
  FMemo.Visible := True;
  if FMemo.Focused then Exit;
  FCol := Col;
  FRow := Row;
  FMemoSetze;
  FMemo.SetFocus;
end;
//------------------------------------------------------------------------------
constructor TStringGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTextList := TList.Create;
  FMemo     := TMemo.Create(Self);
  with FMemo do
  begin
    Parent      := Self;
    BorderStyle := bsNone;
    MaxLength   := 100;//sollten nur max 2 Zeilen werden
    Color       := TColor($00C8D6DD);
    OnEnter     := FMemoOnEnter;
    OnExit      := FMemoOnExit
  end;
  FixedCols   := 1;
  FixedRows   := 0;
  FixedColor  := $00BBCCD5;
  Color       := $00BBCCD5;
  ScrollBars  := ssVertical;
  BorderStyle := bsNone;
  Options     := [goHorzLine];
  FCol        := 1;
  FRow        := 0;
  ColCount    := 2;
end;
//------------------------------------------------------------------------------
destructor TStringGrid.Destroy;
begin
  FMemo.Free;
  GridTexteDestroy;
  inherited Destroy;
end;
//------------------------------------------------------------------------------

procedure TStringGrid.GridTexteCreate(Max: Integer);
var
  I: Integer;
  T: TTime;
begin
  T := 0;
  for I := 0 to Max do
  begin
    FTextList.Add(NewGridTexte(T));
    T := IncMinute(T, 15);//DateUtils
  end;
end;
//Private-----------------------------------------------------------------------

procedure TStringGrid.GridTexteDestroy;
var
  I: Integer;
begin
  for I := 0 to FTextList.Count - 1 do dispose(PGridTexte(FTextList[I]));
  FTextList.Free;
end;
//------------------------------------------------------------------------------

procedure TStringGrid.FMemoSetze;
var
  R: TRect;
begin
  FRowNull;
  if (FCol = 1) and (FRow < RowCount) then
  begin
    R        := CellRect(FCol, FRow);
    R.Left   := R.Left + Left;
    R.Right  := R.Right + Left;
    R.Top    := R.Top + Top;
    R.Bottom := R.Bottom + Top;
    with FMemo do
    begin
      Left    := R.Left - 1;
      Top     := R.Top - 1;
      Width   := R.Right - R.Left;
      Height  := R.Bottom - R.Top;
      Visible := True;
      Text    := PGridTexte(FTextList[FRow])^.Msg;
    end;
  end;
end;
//------------------------------------------------------------------------------

procedure TStringGrid.FMemoOnEnter(Sender: TObject);
const
  NoSelection: TGridRect = (Left: - 1; Top: - 1; Right: - 1; Bottom: - 1);
begin
  repaint;
  FRowNull;
  FMemo.Text := PGridTexte(FTextList[FRow])^.Msg;
  Selection  := NoSelection;
end;
//------------------------------------------------------------------------------

procedure TStringGrid.FMemoOnExit(Sender: TObject);
begin
  FRowNull;
  PGridTexte(FTextList[FRow])^.Msg := FMemo.Text;
end;
//------------------------------------------------------------------------------

procedure TStringGrid.FRowNull;
begin
  if (FRow < 0) or (FRow > FTextList.Count - 1) then FRow := 0;
end;
//------------------------------------------------------------------------------

function TStringGrid.NewGridTexte(T: TTime): PGridTexte;
begin
  Result := new(PGridTexte);
  with Result^ do
  begin
    Msg     := '';
    Zeit    := T;
    ZeitStr := TimeToStr(T);
  end;
end;

//TStringGrid-Ende**************************************************************

end.