Title: How to combine a TMemo with a TStringGrid cell
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 ) 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.