unit TextGrid; 
 
interface 
 
uses 
  Windows, SysUtils, Classes, Graphics, Menus, 
  Controls, StdCtrls, Messages, ExtCtrls, ClipBrd; 
 
type 
  TTextGrid = class; 
  TTGSelS = (tgFull, tgPart); 
  TTGEd = (tgSelf, tgNo, tgStrange); 
  TTGCDraw = procedure(Sender: TObject; ACol, ARow: Integer; Rect: TRect; 
    Selected: boolean; var DefaultDraw: boolean) of object; 
  TTGDirection = (tgUpWards, tgDownWards, tgLeftWards, tgRightWards); 
  TTGWheel = procedure(Sender: TObject; Direction: TTGDirection; 
    ACol, ARow: Integer; var Handled: Boolean) of object; 
  TTGEDiting = procedure(Sender: TObject; ACol, ARow: Integer; 
    var EditType: TTGEd; var Edit: TCustomEdit) of object; 
  TTGEDited = procedure(Sender: TObject; ACol, ARow: Integer; 
    var S: string) of object; 
  TTGBack = (tgOpaque, tgPicture, tgTransparent, 
    tgPicTransparent, tgPicFixTransparent, tgTooFixTransparent); 
  TTGProc = procedure(Sender: TObject; ACol, ARow: Integer; Different: Boolean) 
    of object; 
  TTGEPos = (tgEditBottomLeft, tgEditBottomRight, tgEditLeftBottom, 
    tgEditLeftTop, tgEditRightTop, tgEditRightBottom, 
    tgEditTopLeft, tgEditTopRight); 
  TTGMul = (tgMultiLine, tgSingleLine, tgSingleVCenter, tgDefault); 
  TTGAlig = (tgLeft, tgCenter, tgRight, tgOuter); 
  TTGMM = array[0..1, 0..1] of integer; 
  TTGBorder = (tgNone, tgSingle); 
 
  TTGArr = record 
    width, height, Teilew, Teileh: word; 
    select, different: boolean; 
    FColor: integer; 
    FTextLine: TTGMul; 
    Text: string; 
  end; 
 
  TFHlpCtrl = class(TWinControl) 
  private 
    FGrphCtrl: TTextGrid; 
  protected 
    FEdit: TMemo; 
    FL: TLabel; 
    function KeyDataToShiftState(KeyData: Longint): TShiftState; 
    procedure Mousewheel(var M: TMessage); message WM_MOUSEWHEEL; 
    procedure CMDIALOGKEY(var Alt: TWMKey); message CM_DIALOGKEY; 
    procedure WMKeyDown(var M: TWMKeyDown); message WM_KEYDOWN; 
    procedure CMEnter(var M: TWMNoParams); message CM_ENTER; 
    procedure CMExit(var M: TWMNoParams); message CM_EXIT; 
    procedure WMKeyUp(var M: TWMKeyUp); message WM_KEYUP; 
    procedure WndProc(var M: TMessage); override; 
  public 
    procedure zuClick(Sender: TObject); 
    constructor Create(AOwner: TComponent; 
      GrphCtrl: TTextGrid); reintroduce; 
    destructor Destroy; override; 
    property TabStop; 
    property TabOrder; 
  end; 
  TTextGrid = class(TGraphicControl) 
  private 
    FSD2, FSPS, FCol, FRow, Fi, FMs, FMz, Fu, FSelx, FSely, FZahl: integer; 
    FFlat, FFoc, FMsg, Fedg, Fda, FDown, FFixBttn, FDD, FDDP, 
      FEdge, FCt, FTip, FAuto, FPermit, FMatic, FRast: boolean; 
    FFixC, FPC, FSelC, FNofo, FDisC, FFDisC, FFocusC: TColor; 
    FLW, FZ, FD2, FFC, FFR, FNW, FNH, FMedg: byte; 
    FOnEnter, FOnExit: TNotifyEvent; 
    FOnKeyDown, FOnKeyUp: TKeyEvent; 
    FArr: array of array of TTGArr; 
    Fmi: array[0..9] of TMenuItem; 
    FProcDwn, FProcUp: TTGProc; 
    FS1, FS2, FVersion: string; 
    FAlig: array of integer; 
    FWheel, FDrct: TTGWheel; 
    FCurM, FCurC: TCursor; 
    FEditing: TTGEditing; 
    FFStyle: TFontstyles; 
    FHlpCtrl: TFHlpCtrl; 
    FEdited: TTGEDited; 
    FPop: TPopupMenu; 
    FRand: TTGBorder; 
    FCDraw: TTGCDraw; 
    FStelle: TPoint; 
    FTimer: TTimer; 
    FBack: TTGBack; 
    FPic: TPicture; 
    FEPos: TTGEPos; 
    FCC, FRC: word; 
    FSelS: TTGSelS; 
    FMulti: TTGMul; 
    FBmp: TBitmap; 
  protected 
    procedure weg; 
    procedure danach; 
    procedure setNoFo(c: TColor); 
    procedure setEFont(f: TFont); 
    procedure setEdge(b: boolean); 
    procedure setFCt(b: boolean); 
    procedure meldung(s: string); 
    procedure setEPos(p: TTGEPos); 
    procedure setFixstyle(f: TFontstyles); 
    procedure SetParent(AParent: TWinControl); override; 
    procedure SetTabOrder(const Value: Integer); 
    procedure SetTabStop(const Value: Boolean); 
    procedure DestroyHlpControl; 
    procedure DoKeyDown(var Key: Word; Shift: TShiftState); 
    procedure DoKeyUp(var Key: Word; Shift: TShiftState); 
    procedure CreateHlpControl(AOwner: TComponent; AParent: TWinControl); 
    procedure setFocusC(c: TColor); 
    procedure SetPen(Clr: TColor; Width: Integer; Style: TPenStyle); 
    procedure paint; override; 
    procedure Resize; override; 
    procedure setFEC(c: TColor); 
    procedure setDisC(c: TColor); 
    procedure setFDisC(c: TColor); 
    procedure setRand(r: TTGBorder); 
    procedure setColv(i: integer); 
    procedure setFoc(c: boolean); 
    procedure setRowv(i: integer); 
    procedure setMulti(b: TTGMul); 
    procedure setFlat(b: boolean); 
    procedure setSelC(c: TColor); 
    procedure setCol(i: integer); 
    procedure setRow(i: integer); 
    procedure setCC(w: word); 
    procedure setRC(w: word); 
    procedure setFLW(b: byte); 
    procedure setFFC(b: byte); 
    procedure setFFR(b: byte); 
    procedure setPC(c: TColor); 
    procedure setFNH(b: byte); 
    procedure setFNW(b: byte); 
    procedure setFix(c: TColor); 
    procedure setBack(b: TTGBack); 
    procedure setPic(p: TPicture); 
    procedure setCll(x, y: Word; s: string); 
    procedure setFCl(x, y: word; t: integer); 
    procedure setCLine(x, y: word; t: TTGMul); 
    procedure setrh(y, i: word); 
    procedure setcw(x, i: word); 
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; 
      X: integer; Y: Integer); override; 
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; 
      X: integer; Y: Integer); override; 
    procedure MouseMove(Shift: TShiftState; 
      X: integer; Y: Integer); override; 
    procedure EditKeyDown(Sender: TObject; var Key: Word; 
      Shift: TShiftState); 
    procedure prfLine(x, y: integer; s: string); 
    procedure setAl(x: word; u: TTGAlig); 
    procedure OnTimer(Sender: TObject); 
    procedure click0(sender: TObject); 
    procedure click1(sender: TObject); 
    procedure click2(sender: TObject); 
    procedure click3(sender: TObject); 
    procedure click4(sender: TObject); 
    procedure click6(sender: TObject); 
    procedure click8(sender: TObject); 
    procedure EditTipFontC(c: Tcolor); 
    procedure nachrechts(b: boolean); 
    procedure nachunten(b: boolean); 
    procedure nachlinks(b: boolean); 
    procedure nachoben(b: boolean); 
    procedure setSelS(s: TTGSelS); 
    procedure setFtip(b: boolean); 
    procedure EditTipC(c: Tcolor); 
    procedure home(b: boolean); 
    procedure ende(b: boolean); 
    procedure selectieren; 
    procedure einrichten; 
    procedure buildRow; 
    procedure makeback; 
    procedure buildCol; 
    procedure DoEnter; 
    procedure DoExit; 
    procedure MWeis; 
    procedure loose; 
    procedure neu; 
    procedure ok; 
    function cw(w: word): word; 
    function GetFocused: Boolean; 
    function GetTabStop: Boolean; 
    function GetCanFocus: Boolean; 
    function ueberschreiben: boolean; 
    function multpw(x, y: word): word; 
    function multph(x, y: word): word; 
    function waag(x, y: integer): integer; 
    function senk(x, y: integer): integer; 
    function zelle(x, y: integer): TPoint; 
    function l0test(x1, y1, x2, y2: word; out p: TPoint): byte; 
    function LoadGrid(st: TStream; q: integer): boolean; 
    function SaveGrid(st: TStream; q: integer): boolean; 
    function istext(b, immer: boolean): boolean; 
    function innercol(x1, x2: word): boolean; 
    function innerrow(y1, y2: word): boolean; 
    function cline(x, y: word): TTGMul; 
    function fcl(x, y: word): integer; 
    function cll(x, y: Word): string; 
    function Al(x: word): TTGAlig; 
    function GetTabOrder: Integer; 
    function rh(w: word): word; 
    function getETFC: TColor; 
    function getEfont: TFont; 
    function getETC: TColor; 
    function minmax: TTGMM; 
    function FEC: TColor; 
  public 
    constructor Create(Owner: TComponent); override; 
    destructor Destroy; override; 
    function SelCount: Cardinal; 
    function DifferentCount: Cardinal; 
    function SeparateCells(x, y: word): boolean; 
    function SaveToStream(st: TStream): boolean; 
    function Inside(x, y: integer): boolean; 
    function LoadFromStream(st: TStream): boolean; 
    function AlignmentToStr(alg: TTGAlig): string; 
    function SaveBasicsToStream(st: TStream): boolean; 
    function LoadBasicsFromStream(st: TStream): boolean; 
    procedure MouseToCell(x, y: integer; Rahmen: boolean; 
      out ACol, ARow: integer); 
    procedure Reset; 
    procedure SetFocus; 
    procedure ClearText; 
    procedure SeparateAll; 
    procedure DeleteCols(x1, x2: word); 
    procedure DeleteRows(y1, y2: word); 
    procedure ColWidthsX(x1, x2, degree: word); 
    procedure MergeCells(x1, y1, x2, y2: word); 
    procedure RowHeightsX(y1, y2, degree: word); 
    property CellLine[x, y: word]: TTGMul read cline write setcline; 
    property FontColor[x, y: Word]: integer read fcl write setfcl; 
    property Alignments[x: word]: TTGAlig read Al write setAl; 
    property Cells[x, y: Word]: string read cll write setCll; 
    property RowHeights[y: word]: word read rh write setrh; 
    property ColWidths[x: word]: word read cw write setcw; 
    property CanFocus: Boolean read GetCanFocus; 
    property Focused: Boolean read GetFocused; 
    property Canvas; 
  published 
    property Font; 
    property Color; 
    property Visible; 
    property Enabled; 
    property ShowHint; 
    property ParentFont; 
    property ParentColor; 
    property ParentShowHint; 
    property MoveCopy: boolean read FDDP write FDDP; 
    property CursorIfMove: TCursor read FCurM write FCurM; 
    property CursorIfCopy: TCursor read FCurC write FCurC; 
    property FixFontStyle: TFontstyles read FFStyle write setFixStyle; 
    property EditTipFontColor: TColor read getETFC write EditTipFontC; 
    property TabOrder: Integer read GetTabOrder write SetTabOrder; 
    property FixDisabledColor: TColor read FFDisc write setFDisC; 
    property LineFocusColor: TColor read FFocusC write setFocusc; 
    property TabStop: Boolean read GetTabStop write SetTabStop; 
    property FixButtons: boolean read FFixBttn write FFixBttn; 
    property NoFocusSelColor: TColor read FNofo write setNofo; 
    property BorderStyle: TTGBorder read Frand write setRand; 
    property WheelPermit: boolean read FPermit write FPermit; 
    property EditTipColor: TColor read getETC write EditTipC; 
    property DisabledColor: TColor read FDisc write setDisC; 
    property EditPosition: TTGEPos read FEPos write setEPos; 
    property SelectStyle: TTGSelS read FSelS write setSels; 
    property DefaultRowHeight: byte read FNH write setFNH; 
    property EditFont: TFont read getEFont write SetEFont; 
    property EditBackGround: TColor read FEC write setFEC; 
    property SelectColor: TColor read FSelc write setSelC; 
    property BackGround: TTGBack read FBack write setBack; 
    property EditShowTip: boolean read FTip write setFTip; 
    property TextLine: TTGMul read FMulti write setMulti; 
    property DefaultColWidth: byte read FNW write setFNW; 
    property AutoSpread: boolean read FAuto write FAuto; 
    property FixFlat: boolean read FFlat write setFlat; 
    property FocusRect: boolean read FFoc write setFoc; 
    property Picture: TPicture read FPic write setPic; 
    property FixCenter: boolean read FCt write setFCt; 
    property FixColor: TColor read FFixC write setFix; 
    property Messages: boolean read FMsg write FMsg; 
    property LineColor: TColor read FPC write setPC; 
    property Edge: boolean read FEdge write setEdge; 
    property Editing: boolean read Fedg write Fedg; 
    property LineWidth: byte read FLW write setFLW; 
    property FixedCols: byte read FFC write setFFC; 
    property FixedRows: byte read FFR write setFFR; 
    property ColCount: Word read FCC write setCC; 
    property RowCount: Word read FRC write setRC; 
    property Col: integer read FCol write setCol; 
    property Row: integer read FRow write setRow; 
    property OnFixButtonDown: TTGProc read FProcDwn write FProcDwn; 
    property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown; 
    property OnEditing: TTGEDiting read FEditing write FEditing; 
    property OnEnter: TNotifyEvent read FOnEnter write FOnEnter; 
    property OnFixButtonUp: TTGProc read FProcUp write FProcUp; 
    property OnExit: TNotifyEvent read FOnExit write FOnExit; 
    property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp; 
    property OnChgDirection: TTGWheel read FDrct write FDrct; 
    property OnEdited: TTGEdited read FEdited write FEdited; 
    property OnDrawCell: TTGCDraw read FCDraw write FCDraw; 
    property OnWheel: TTGWheel read FWheel write FWheel; 
    property OnMouseDown; 
    property OnMouseMove; 
    property OnDblClick; 
    property OnMouseUp; 
    property OnClick; 
  end; 
 
procedure Register; 
 
implementation 
 
constructor TTextGrid.Create(Owner: TComponent); 
var 
  x, y: integer; 
begin 
  inherited Create(Owner); 
  ParentFont := false; 
  FHlpCtrl := nil; 
  CreateHlpControl(nil, TWinControl(Owner)); 
  FPop := TPopupMenu.create(Self); 
  for x := 0 to high(Fmi) do begin 
    Fmi[x] := TMenuItem.Create(FPop); 
    FPop.items.add(Fmi[x]); 
  end; 
  FTimer := TTimer.create(self); 
  FTimer.interval := 0; 
  FTimer.OnTimer := OnTimer; 
  Fmi[0].caption := 'Zellen verbinden'; 
  Fmi[1].caption := 'Zellen separieren'; 
  Fmi[2].caption := 'Zell-Text editieren'; 
  Fmi[3].caption := 'Zell-Text löschen'; 
  Fmi[4].caption := 'Alle Texte löschen'; 
  Fmi[5].caption := 'Alle Zellverbände separieren'; 
  Fmi[6].caption := 'Ausschneiden'; 
  Fmi[7].caption := 'Kopieren'; 
  Fmi[8].caption := 'Einfügen'; 
  Fmi[9].caption := 'Abbrechen'; 
  Fmi[0].onclick := click0; 
  Fmi[1].onclick := click1; 
  Fmi[2].onclick := click2; 
  Fmi[3].onclick := click3; 
  Fmi[4].onclick := click4; 
  Fmi[5].onclick := click4; 
  Fmi[6].onclick := click6; 
  Fmi[7].onclick := click6; 
  Fmi[8].onclick := click8; 
  FS1 := 'HINWEIS'; 
  FS2 := ' nicht bearbeitet werden, ' + 
    'da sonst Zellverbände zerstört würden.  '; 
  FVersion := 'DBRTG1.6'; 
  Fedg := true; 
  FEPos := tgEditBottomLeft; 
  FSPS := PS_GEOMETRIC or PS_ENDCAP_SQUARE or PS_JOIN_BEVEL; 
  FDD := false; 
  FDDP := true; 
  FMsg := true; 
  color := clWhite; 
  FNofo := $DFD4D2; 
  FFixC := clBtnFace; 
  FPic := TPicture.create; 
  FBmp := TBitmap.create; 
  FEdge := true; 
  FMedg := 0; 
  FTip := true; 
  FRast := false; 
  FAuto := false; 
  FMulti := tgSingleVCenter; 
  FMatic := false; 
  FFixBttn := true; 
  Fu := DT_SINGLELINE; 
  FFDisC := clBtnShadow; 
  FFocusC := clblack; 
  FDisC := clBtnFace; 
  FSelC := $BFB4B2; 
  FPC := $999999; 
  FNW := 64; 
  FNH := 24; 
  FCC := 5; 
  FRC := 5; 
  FLW := 1; 
  FFC := 1; 
  FFR := 1; 
  FZ := 0; 
  FZahl := 0; 
  FSelx := -1; 
  FSely := FSelx; 
  FFoc := false; 
  FPermit := true; 
  setlength(FArr, FCC + 1, FRC + 1); 
  setlength(FAlig, FCC + 1); 
  for x := 0 to FCC do begin 
    FAlig[x] := DT_LEFT; 
    for y := 0 to FRC do begin 
      FArr[x, y].width := FNW; 
      FArr[x, y].height := FNH; 
      FArr[x, y].select := false; 
      FArr[x, y].different := false; 
      FArr[x, y].text := ''; 
      FArr[x, y].FColor := maxint; 
      FArr[x, y].FTextLine := tgDefault; 
      FArr[x, y].Teilew := 1; 
      FArr[x, y].Teileh := 1; 
    end; 
  end; 
  FCol := 1; 
  FRow := 1; 
  FArr[FCOL, FROW].select := true; 
  FCurM := crDrag; 
  FCurC := crMultiDrag; 
end; 
 
procedure TTextGrid.SetPen(Clr: TColor; 
  Width: Integer; Style: TPenStyle); 
var 
  LogBrush: TLogBrush; 
begin 
  ZeroMemory(@LogBrush, SizeOf(LogBrush)); 
  LogBrush.lbColor := Clr; 
  Canvas.Pen.Handle := ExtCreatePen(FSPS or Ord(Style), 
    Width, LogBrush, 0, nil); 
end; 
 
destructor TTextGrid.Destroy; 
var 
  x: integer; 
begin 
  DestroyHlpControl; 
  for x := 0 to high(Fmi) do Fmi[x].free; 
  FPop.free; 
  FBmp.free; 
  FPic.free; 
  FTimer.free; 
  inherited Destroy; 
end; 
 
destructor TFHlpCtrl.Destroy; 
begin 
  FEdit.free; 
  FL.free; 
  inherited Destroy; 
end; 
 
procedure TFHlpCtrl.zuClick(Sender: TObject); 
begin 
  FGrphCtrl.ok; 
end; 
 
function TFHlpCtrl.KeyDataToShiftState(KeyData: Longint): TShiftState; 
begin 
  Result := []; 
  if GetKeyState(VK_SHIFT) < 0 then Include(Result, ssShift); 
  if GetKeyState(VK_CONTROL) < 0 then Include(Result, ssCtrl); 
  if KeyData and $20000000 <> 0 then Include(Result, ssAlt); 
end; 
 
procedure TTextGrid.paint; 
var 
  x, y, z, x1, y1, x2, y2, i, j, tp, bt, m, fd, u, th: integer; 
  rct, irct: TRect; 
  f, fsd, dd, d3: Boolean; 
  ftc: TColor; 
  fs: TFontStyles; 
  s: string; 
  function ohne(const ss: string): string; 
  var 
    a: integer; 
  begin 
    result := ''; 
    for a := 1 to length(ss) do 
      if ss[a] = #13 then result := result + #32 
      else if ss[a] <> #10 then result := result + ss[a]; 
  end; 
  function tst: boolean; 
  begin 
    result := not FFlat or (FDown and (x = FCol) and (Y = FRow)); 
  end; 
begin 
  fd := 0; 
  Canvas.Font := Font; 
  ftc := Font.color; 
  fs := Font.style; 
  fsd := GetFocused; 
  with Canvas do begin 
    th := textheight('Äy'); 
    if (FBack = tgPicture) or (FBack = tgPicTransparent) 
      or (FBack = tgPicFixTransparent) 
      then begin 
      makeback; 
      draw(0, 0, FBmp); 
    end; 
    if (FBack = tgOpaque) 
      then begin 
      if enabled then brush.color := color 
      else brush.color := FDisC; 
      fillrect(cliprect); 
    end; 
    y1 := fz + FD2 - FMedg; 
    for y := 0 to FRC - 1 do begin 
      y2 := y1 + Farr[FCC, y].height + FLW; 
      m := y2; 
      x1 := fz + FD2 - FMedg; 
      x2 := x1 + FArr[0, y].width + FLW; 
      for x := 0 to FCC - 1 do begin 
        d3 := (FArr[x, y].height > 2) and (FArr[x, y].width > 2); 
        f := (x < FFC) or (y < FFR); 
        if FLW = 0 then pen.style := psclear else begin 
          if fsd then SetPen(FFocusC, FLW, psSolid) 
          else SetPen(FPC, FLW, psSolid); 
        end; 
        if (FArr[x, y].FTextline = tgDefault) 
          and (FMulti <> tgMultiLine) 
          or (FArr[x, y].FTextline <> tgDefault) 
          and (FArr[x, y].FTextline <> tgMultiLine) 
          then 
          s := ohne(FArr[x, y].text) 
        else s := FArr[x, y].text; 
        if f then 
          u := DT_VCENTER or DT_SINGLELINE or FAlig[x] * ord(not FCT) 
            or ord(FCT) * DT_CENTER 
        else begin 
          if FARR[x, y].FTextline <> tgDefault then begin 
            case FARR[x, y].FTextline of 
              tgMultiline: 
                u := DT_WORD_ELLIPSIS or DT_WORDBREAK; 
              tgSingleVCenter: u := DT_SINGLELINE or DT_VCENTER 
                or FAlig[x]; 
            else u := DT_SINGLELINE or FAlig[x]; 
            end; 
            u := u or DT_END_ELLIPSIS * ord(FAlig[x] = DT_LEFT); 
          end else begin 
            u := Fu or ord(FMulti = tgSingleVCenter) * DT_VCENTER; 
            u := u or DT_END_ELLIPSIS * ord(FAlig[x] = DT_LEFT) 
              or FAlig[x] * ord(FMulti <> tgMultiLine); 
          end; 
        end; 
        i := 0; 
        j := 0; 
        if FArr[x, y].width > 0 then begin 
          j := -FLW * ord(FArr[x, FRC].width = 0); 
          z := succ(x); 
          while (FArr[z, y].width = 0) do 
          begin 
            if (FArr[z, FRC].width > 0) then 
              inc(j, FLW); 
            inc(z); 
          end; 
        end; 
        if not f or (FBack = tgTooFixTransparent) 
          or (FBack = tgPicFixTransparent) 
          then brush.style := bsclear; 
        if FArr[x, y].height > 0 then begin 
          y2 := y1 + FArr[x, y].height + FLW; 
          i := -FLW * ord(FArr[FCC, y].height = 0); 
          z := succ(y); 
          while (FArr[x, z].height = 0) do begin 
            if (FArr[FCC, z].height > 0) then 
              inc(i, FLW); 
            inc(z); 
          end; 
        end else y2 := y1; 
        irct := rect(x1, y1, x2 + j, y2 + i); 
        dd := true; 
        if assigned(FCDraw) then 
          FCDraw(self, x, y, irct, FArr[x, y].select, dd); 
        if dd then begin 
          Farr[x, y].different := false; 
          if Farr[x, y].select or f then begin 
            if f then begin 
              if (FBack <> tgTooFixTransparent) 
                and (FBack <> tgPicFixTransparent) 
                then begin 
                if enabled then 
                  brush.color := FFixC 
                else brush.color := FFDisC; 
              end; 
            end else begin 
              if fsd then 
                brush.color := FSelC else 
                brush.color := FNofo; 
              if (FSelS = tgPart) then begin 
                inc(irct.left, FsD2 + 3); 
                inc(irct.top, FsD2 + 3); 
                dec(irct.right, FD2 + 2); 
                dec(irct.bottom, FD2 + 2); 
              end; 
            end; 
            fillrect(irct); 
          end; 
        end else 
          FArr[x, y].different := true; 
        moveto(x1, y1); 
        if FArr[x, y].height > 0 then 
          lineto(x2 + j, y1) 
        else moveto(x2 + j, y1); 
        if FArr[x, y].width > 0 
          then lineto(x2 + j, y2 + i) 
        else moveto(x2 + j, y2 + i); 
        if ((FArr[x, y].height > 0) 
          or (y = FRC)) and (FMedg = 0) then 
          lineto(x1, y2 + i) 
        else moveto(x1, y2 + i); 
        if FArr[x, y].width > 0 
          then lineto(x1, y1); 
        if FFoc and (x = FCol) and (y = FRow) and not f and dd 
          and (fsd or (csDesigning in ComponentState)) 
          then drawfocusrect(rect(x1 + 2 + FsD2, y1 + 2 + FsD2, 
            x2 - 1 - FD2 + j, y2 - 1 - FD2 + i)); 
        if f and dd then begin 
          Font.Style := FFStyle; 
          if d3 then begin 
            pen.width := 1; 
            pen.style := pssolid; 
            if not FDown or (x <> FCol) or (Y <> FRow) 
              then begin 
              pen.color := clWhite; 
              fd := 0; 
            end 
            else pen.color := clblack; 
            if tst then begin 
              moveto(x1 + FsD2 + 1, y2 - 1 - FD2); 
              lineto(x1 + FsD2 + 1, y1 + FsD2 + 1); 
              lineto(x2 - FD2, y1 + FsD2 + 1); 
            end; 
            if not FDown or (x <> FCol) or (Y <> FRow) 
              then pen.color := clblack 
            else begin 
              pen.color := clWhite; 
              fd := 1; 
            end; 
            if tst then begin 
              moveto(x2 - 1 - FD2, y1 + 2 + FsD2); 
              lineto(x2 - 1 - FD2, y2 - FD2 - 1); 
              lineto(x1 + FsD2 + 1, y2 - FD2 - 1); 
            end; 
          end; 
        end else begin 
          fd := 0; 
          Font.Style := fs; 
        end; 
        if y2 > y1 then begin 
          if FArr[x, y].FColor <> maxint then 
            Font.Color := FArr[x, y].FColor 
          else Font.color := ftc; 
          if dd and d3 then begin 
            tp := y1 + 4 + FsD2 + fd; 
            if (FMulti = tgMultiline) and (FArr[x, y].FTextline = tgDefault) 
              or (FArr[x, y].FTextline = tgMultiline) then 
              bt := tp + ((y2 - FD2 + i - 3 - tp) div th) * th else 
              bt := y2 - FD2 + i - 3; 
            rct := rect(x1 + FsD2 + 4 + fd, tp, x2 - 3 - FD2 + j, bt); 
            drawtext(handle, pchar(s), -1, rct, u); 
          end; 
        end; 
        x1 := x2; 
        if FArr[x + 1, FRC].width > 0 then 
          x2 := x1 + FArr[x + 1, y].width + FLW; 
      end; 
      y1 := m - ord(FArr[FCC, y].height = 0) * FLW; 
    end; 
    if Frand = tgSingle 
      then begin 
      pen.style := pssolid; 
      pen.width := 1; 
      pen.color := $A0A0A0; 
      moveto(0, height - 1); 
      lineto(0, 0); 
      lineto(width, 0); 
      pen.color := clBlack; 
      moveto(1, height - 2); 
      lineto(1, 1); 
      lineto(width - 1, 1); 
      pen.color := $EEEEEE; 
      moveto(2, height - 2); 
      lineto(width - 2, height - 2); 
      lineto(width - 2, 1); 
      pen.color := clwhite; 
      moveto(1, height - 1); 
      lineto(width - 1, height - 1); 
      lineto(width - 1, 0); 
    end; 
  end; 
end; 
 
procedure TTextGrid.resize; 
var 
  x, g, w2, h2, a, th: integer; 
begin 
  FMedg := ord(not FEdge) * FLW; 
  a := (Fz - FMedg) * 2; 
  th := Fi * ord(FTip); 
  g := 0; 
  for x := 0 to FCC - 1 do 
    inc(g, multpw(x, FRC) + FLW * ord(Farr[x, FRC].width > 0)); 
  width := (g + FLW) * ord(FNW > 0) + a; 
  g := 0; 
  for x := 0 to FRC - 1 do 
    inc(g, multph(FCC, x) + FLW * ord(Farr[FCC, x].height > 0)); 
  height := (g + FLW) * ord(FNH > 0) + a; 
  if Fda then begin 
    Fda := false; 
    if FTip then 
      FHlpCtrl.brush.color := FHlpCtrl.FL.color; 
    h2 := 89 + th; 
    w2 := 185; 
    case FEPos of 
      tgEditBottomLeft: begin 
          FHlpCtrl.FEdit.height := 85; 
          FHlpCtrl.SetBounds(left, top + height, 
            w2, FHlpCtrl.FEdit.height + th); 
        end; 
      tgEditBottomRight: begin 
          FHlpCtrl.FEdit.height := 85; 
          FHlpCtrl.SetBounds(boundsrect.right - w2, top + height, 
            w2, FHlpCtrl.FEdit.height + th); 
        end; 
      tgEditTopLeft: begin 
          FHlpCtrl.FEdit.height := 85; 
          FHlpCtrl.SetBounds(left, top - FHlpCtrl.FEdit.height - th, 
            w2, FHlpCtrl.FEdit.height + th); 
        end; 
      tgEditTopRight: begin 
          FHlpCtrl.FEdit.height := 85; 
          FHlpCtrl.SetBounds(boundsrect.right - w2, 
            top - FHlpCtrl.FEdit.height - th, 
            w2, FHlpCtrl.FEdit.height + th); 
        end; 
      tgEditRightTop: begin 
          FHlpCtrl.FEdit.height := h2 - th; 
          FHlpCtrl.SetBounds(boundsrect.right, top, 
            w2, h2); 
        end; 
      tgEditRightBottom: begin 
          FHlpCtrl.FEdit.height := h2 - th; 
          FHlpCtrl.SetBounds(boundsrect.right, boundsrect.bottom - h2, 
            w2, h2); 
        end; 
      tgEditLeftTop: begin 
          FHlpCtrl.FEdit.height := h2 - th; 
          FHlpCtrl.SetBounds(left - w2, top, 
            w2, FHlpCtrl.FEdit.height + th); 
        end; 
    else begin 
        FHlpCtrl.FEdit.height := h2 - th; 
        FHlpCtrl.SetBounds(left - w2, boundsrect.bottom - h2, 
          w2, FHlpCtrl.FEdit.height + th); 
      end; 
    end; 
    FHlpCtrl.FEdit.width := FHlpCtrl.width; 
    FHlpCtrl.FL.left := (w2 - FHlpCtrl.FL.width) div 2; 
    FHlpCtrl.FL.top := FHlpCtrl.height - FHlpCtrl.FL.height - 2; 
  end else weg; 
  invalidate; 
end; 
 
procedure TTextGrid.setBack(b: TTGBack); 
begin 
  if b = FBack then exit; 
  FBack := b; 
  invalidate; 
end; 
 
procedure TTextGrid.setRC(w: word); 
var 
  x, m, y, b, i: integer; 
begin 
  if w < 1 then w := 1; 
  if w = FRC then exit; 
  if (w < FRC) and not (csDesigning in ComponentState) then begin 
    if not Fedg then begin 
      meldung('Das Verringern der Zeilenzahl'); 
      exit; 
    end; 
    if innerrow(w, FRC - 1) then exit; 
  end; 
  m := FRC; 
  i := m; 
  FRC := w; 
  if w > m then 
    setlength(FArr, FCC + 1, FRC + 1); 
  for x := 0 to FCC do begin 
    b := FArr[x, i].width; 
    for y := m to w do begin 
      FArr[x, y].Teileh := 1; 
      FArr[x, y].height := FNH; 
      FArr[x, y].width := b; 
      FArr[x, y].Teilew := 1; 
      FArr[x, y].select := false; 
      FArr[x, y].different := false; 
      FArr[x, y].text := ''; 
      FArr[x, y].FColor := Font.color; 
    end; 
  end; 
  if m > w then 
    setlength(FArr, FCC + 1, FRC + 1); 
  neu; 
end; 
 
procedure TTextGrid.setCC(w: word); 
var 
  x, m, y, h, i: integer; 
begin 
  if w < 1 then w := 1; 
  if w = FCC then exit; 
  if (w < FCC) and not (csDesigning in ComponentState) then begin 
    if not Fedg then begin 
      meldung('Das Verringern der Spaltenzahl'); 
      exit; 
    end; 
    if innercol(w, FCC - 1) then exit; 
  end; 
  m := FCC; 
  i := m; 
  FCC := w; 
  setlength(FAlig, FCC + 1); 
  if w > m then 
    setlength(FArr, FCC + 1, FRC + 1); 
  for y := 0 to FRC do begin 
    h := FArr[i, y].height; 
    for x := m to w do begin 
      FArr[x, y].Teilew := 1; 
      FArr[x, y].width := FNW; 
      FArr[x, y].height := h; 
      FArr[x, y].Teileh := 1; 
      FArr[x, y].select := false; 
      FArr[x, y].different := false; 
      FArr[x, y].text := ''; 
      FArr[x, y].FColor := Font.color; 
      FAlig[x] := DT_LEFT; 
    end; 
  end; 
  if m > w then 
    setlength(FArr, FCC + 1, FRC + 1); 
  neu; 
end; 
 
procedure TTextGrid.neu; 
begin 
  resize; 
  invalidate; 
end; 
 
procedure TTextGrid.einrichten; 
var 
  x, y, i: integer; 
begin 
  for x := 0 to FCC - 1 do begin 
    i := 0; 
    for y := 0 to FRC - 1 do begin 
      if FArr[x, y].height > 0 then begin 
        i := y; 
        FArr[x, y].height := FArr[FCC, y].height; 
      end 
      else if FArr[FCC, y].height > 0 then 
        FArr[x, i].height := FArr[x, i].height + FArr[FCC, y].height; 
    end; 
  end; 
  for y := 0 to FRC - 1 do begin 
    i := 0; 
    for x := 0 to FCC - 1 do begin 
      if FArr[x, y].width > 0 then begin 
        i := x; 
        FArr[x, y].width := FArr[x, FRC].width; 
      end 
      else if FArr[x, FRC].width > 0 then 
        FArr[i, y].width := FArr[i, y].width + FArr[x, FRC].width; 
    end; 
  end; 
end; 
 
procedure TTextGrid.setFLW(b: byte); 
begin 
  if b = FLW then exit; 
  FLW := b; 
  FD2 := FLW div 2; 
  FSD2 := pred(FLW) div 2; 
  if FD2 + FsD2 = 0 then FsD2 := -1; 
  einrichten; 
  neu; 
end; 
 
procedure TTextGrid.setFFC(b: byte); 
var 
  x, i, y: integer; 
begin 
  if b > FCC then b := FCC; 
  if b = FFC then exit; 
  i := FFC; 
  FFC := b; 
  if b > FCOl then 
  begin 
    FCol := -1; 
    FRow := -1; 
  end; 
  if FFC > i then 
    for x := i to FFC do 
      for y := FFR to FRC - 1 do 
        FArr[x, y].text := ''; 
  invalidate; 
end; 
 
procedure TTextGrid.setFFR(b: byte); 
var 
  x, i, y: integer; 
begin 
  if b > FRC then b := FRC; 
  if b = FFR then exit; 
  i := FFR; 
  FFR := b; 
  if b > FROW then 
  begin 
    FCol := -1; 
    FRow := -1; 
  end; 
  if FFR > i then 
    for x := FFC to FRC - 1 do 
      for y := i to FFR do 
        FArr[x, y].text := ''; 
  invalidate; 
end; 
 
procedure TTextGrid.setFlat(b: boolean); 
begin 
  if b = FFlat then exit; 
  FFlat := b; 
  invalidate; 
end; 
 
procedure TTextGrid.setPC(c: TColor); 
begin 
  if c = FPC then exit; 
  FPC := c; 
  invalidate; 
end; 
 
procedure TTextGrid.setFNH(b: byte); 
var 
  x, y: integer; 
begin 
  FNH := b; 
  loose; 
  for y := 0 to FRC do 
    for x := 0 to FCC do begin 
      FARR[x, y].height := b; 
      FARR[x, y].Teileh := 1; 
    end; 
  selectieren; 
  neu; 
end; 
 
procedure TTextGrid.setFNW(b: byte); 
var 
  x, y: integer; 
begin 
  FNW := b; 
  loose; 
  for y := 0 to FRC do 
    for x := 0 to FCC do begin 
      FARR[x, y].width := b; 
      FARR[x, y].Teilew := 1; 
    end; 
  selectieren; 
  neu; 
end; 
 
procedure TTextGrid.setRand(r: TTGBorder); 
begin 
  if r = FRand then exit; 
  FRand := r; 
  Fz := ord(r = tgSingle) * 2; 
  neu; 
end; 
 
procedure TTextGrid.setFix(c: TColor); 
begin 
  if c = FFixC then exit; 
  FFixC := c; 
  invalidate; 
end; 
 
procedure TTextGrid.setDisC(c: TColor); 
begin 
  if c = FDisC then exit; 
  FDisC := c; 
  if not enabled then invalidate; 
end; 
 
procedure TTextGrid.setFDisC(c: TColor); 
begin 
  if c = FFDisC then exit; 
  FFDisC := c; 
  if not enabled then invalidate; 
end; 
 
procedure TTextGrid.setpic(p: TPicture); 
begin 
  FPic.assign(p); 
  makeback; 
  invalidate; 
end; 
 
procedure TTextGrid.makeback; 
var 
  x, y, z: integer; 
begin 
  if Fpic = nil then exit; 
  if (FPic.Height > 0) and (FPic.height > 0) then begin 
    FBmp.width := width; 
    FBmp.height := height; 
    with FBmp.canvas do begin 
      brush.color := color; 
      fillrect(cliprect); 
    end; 
    if (FBack <> tgPicTransparent) and (FBack <> tgPicFixTransparent) 
      then FBack := tgPicture; 
    z := height div FPic.height; 
    for x := 0 to width div FPic.width do 
      for y := 0 to z do 
        FBmp.canvas.draw(x * FPic.width, y * FPic.height, FPic.Graphic); 
    if (FBack = tgPicTransparent) or (FBack = tgPicFixTransparent) 
      then begin 
      FBmp.Transparentcolor := color; 
      FBmp.Transparent := true; 
    end else FBmp.Transparent := false; 
  end else begin 
    FBmp.width := 0; 
    FBmp.height := 0; 
  end; 
end; 
 
procedure TTextGrid.setMulti(b: TTGMul); 
var 
  x, y: integer; 
begin 
  FMulti := b; 
  if b = tgMultiline then 
    Fu := DT_Word_ELLIPSIS or DT_WORDBREAK 
  else Fu := DT_SINGLELINE; 
  for x := 0 to FCC - 1 do 
    for y := 0 to FRC - 1 do 
      FArr[x, y].FTextline := tgDefault; 
  invalidate; 
end; 
 
function TTextGrid.cll(x, y: Word): string; 
begin 
  if (x < FCC) and (y < FRC) then 
    result := FArr[x, y].text 
  else result := ''; 
end; 
 
procedure TTextGrid.prfLine(x, y: integer; s: string); 
begin 
  if (FArr[x, y].text = '') and (s <> '') and Parent.visible 
    and (x >= FFC) and (y >= FFR) and (FAlig[x] <> DT_LEFT) 
    and ((FMulti = tgMultiline) and (FArr[x, y].FTextline = tgDefault) 
    or (FArr[x, y].FTextline = tgMultiline)) 
    then MWeis; 
end; 
 
procedure TTextGrid.setCll(x, y: word; s: string); 
begin 
  if (x < FCC) and (y < FRC) 
    then begin 
    if not Fedg and Parent.visible then begin 
      meldung('Das Verändern von Zell-Inhalten'); 
      exit; 
    end; 
    prfLine(x, y, s); 
    FArr[x, y].text := s; 
    invalidate; 
  end; 
end; 
 
function TTextGrid.fcl(x, y: word): integer; 
var 
  i: integer; 
begin 
  if (x < FCC) and (y < FRC) then begin 
    i := FArr[x, y].FColor; 
    if i = maxint then 
      result := Font.color 
    else result := i; 
  end else result := 0; 
end; 
 
function TTextGrid.cline(x, y: word): TTGMul; 
begin 
  if (x < FCC) and (y < FRC) then 
    result := FArr[x, y].FTextline 
  else result := tgDefault; 
end; 
 
procedure TTextGrid.setCLine(x, y: word; t: TTGMul); 
begin 
  if FArr[x, y].FTextline = t then exit; 
  if (x < FCC) and (y < FRC) then 
    FArr[x, y].FTextline := t; 
  if (x >= FFC) and (y >= FFR) and (FArr[x, y].text <> '') 
    and (t = tgMultiline) and (FAlig[x] <> DT_LEFT) then MWeis; 
  invalidate; 
end; 
 
procedure TTextGrid.setFCl(x, y: word; t: integer); 
begin 
  if (x < FCC) and (y < FRC) then 
    FArr[x, y].FColor := t; 
  invalidate; 
end; 
 
procedure TTExtGrid.selectieren; 
begin 
  if (FRow >= FFR) and (FCol >= FFC) 
    and (FRow < FRC) and (FCol < FCC) 
    then FArr[FCol, FRow].select := true; 
end; 
 
procedure TTextGrid.setrh(y, i: word); 
var 
  x: integer; 
begin 
  if (y < FRC) then begin 
    for x := 0 to FCC - 1 do 
      if (FArr[x, y].Teileh > 1) 
        or (FArr[x, y].height = 0) and (FArr[FCC, y].height > 0) 
        then begin 
        if FMsg then 
          messagebox(0, Pchar('Zeile ' + inttostr(y) + ' kann' + 
            FS2), PChar(FS1), mb_IconWarning); 
        exit; 
      end; 
    for x := 0 to FCC do 
      FArr[x, y].height := i; 
    loose; 
    if (FRow = y) and (i = 0) then 
    begin 
      FCol := -1; 
      FRow := -1; 
    end; 
    einrichten; 
    selectieren; 
    neu; 
  end; 
end; 
 
procedure TTextGrid.RowHeightsX(y1, y2, degree: word); 
var 
  x, k: integer; 
begin 
  if y2 < y1 then begin 
    x := y1; 
    y1 := y2; 
    y2 := x; 
  end; 
  if y2 >= FRC then y2 := FRC - 1; 
  if innerrow(y1, y2) then exit; 
  for k := y1 to y2 do 
    for x := 0 to FCC do begin 
      FArr[x, k].height := degree; 
      if (FRow = k) and (degree = 0) then begin 
        FRow := -1; 
        FCol := -1; 
      end; 
    end; 
  loose; 
  einrichten; 
  selectieren; 
  neu; 
end; 
 
function TTextGrid.rh(w: word): word; 
begin 
  if (w < FRC) then 
    result := FArr[FCC, w].height 
  else result := 0; 
end; 
 
procedure TTextGrid.setcw(x, i: word); 
var 
  z: integer; 
begin 
  if (x < FCC) then begin 
    for z := 0 to FRC - 1 do 
      if (FArr[x, z].Teilew > 1) 
        or (FArr[x, z].Width = 0) and (FArr[x, FRC].Width > 0) 
        then begin 
        if FMsg then 
          messagebox(0, Pchar('Spalte ' + inttostr(x) + ' kann' + 
            FS2), PChar(FS1), mb_IconWarning); 
        exit; 
      end; 
    for z := 0 to FRC do 
      FArr[x, z].width := i; 
    loose; 
    if (FCol = x) and (i = 0) then 
    begin 
      FCol := -1; 
      FRow := -1; 
    end; 
    einrichten; 
    selectieren; 
    neu; 
  end; 
end; 
 
procedure TTextGrid.ColWidthsX(x1, x2, degree: word); 
var 
  z, k: integer; 
begin 
  if x1 > x2 then begin 
    z := x1; 
    x1 := x2; 
    x2 := z; 
  end; 
  if x2 >= FCC then x2 := FCC - 1; 
  if innercol(x1, x2) then exit; 
  for k := x1 to x2 do 
    for z := 0 to FRC do begin 
      FArr[k, z].width := degree; 
      if (FCol = k) and (degree = 0) then begin 
        FCol := -1; 
        FRow := -1; 
      end; 
    end; 
  loose; 
  einrichten; 
  selectieren; 
  neu; 
end; 
 
procedure TTextGrid.DeleteCols(x1, x2: word); 
var 
  z, k, i, xx: integer; 
begin 
  if not Fedg then begin 
    meldung('Das Löschen von Spalten'); 
    exit; 
  end; 
  if x1 > x2 then begin 
    z := x1; 
    x1 := x2; 
    x2 := z; 
  end; 
  if x2 >= FCC then x2 := FCC - 1; 
  xx := X2 - x1; 
  if innercol(x1, x2) then exit; 
  if succ(xx) >= FCC then begin 
    if FMsg then 
      messagebox(0, Pchar('Das Löschen der Spalten ist nicht möglich.'#13#10 + 
        'Es muss mindestens eine Spalte übrig bleiben.  '), 
        PChar(FS1), mb_IconWarning); 
    exit; 
  end; 
  for k := 0 to xx do begin 
    for i := x1 to FCC - 1 do begin 
      FAlig[i] := FAlig[i + 1]; 
      for z := 0 to FRC do begin 
        FArr[i, z].Teileh := FArr[i + 1, z].Teileh; 
        FArr[i, z].Teilew := FArr[i + 1, z].Teilew; 
        FArr[i, z].width := FArr[i + 1, z].width; 
        FArr[i, z].height := FArr[i + 1, z].height; 
        FArr[i, z].FColor := FArr[i + 1, z].FColor; 
        FArr[i, z].Text := FArr[i + 1, z].Text; 
      end; 
    end; 
  end; 
  dec(FCC, xx + 1); 
  setlength(FAlig, FCC + 1); 
  danach; 
end; 
 
procedure TTextGrid.danach; 
begin 
  setlength(FArr, FCC + 1, FRC + 1); 
  loose; 
  einrichten; 
  selectieren; 
  neu; 
end; 
 
procedure TTextGrid.DeleteRows(y1, y2: word); 
var 
  z, k, i, xx: integer; 
begin 
  if not Fedg then begin 
    meldung('Das Löschen von Zeilen'); 
    exit; 
  end; 
  if y1 > y2 then begin 
    z := y1; 
    y1 := y2; 
    y2 := z; 
  end; 
  if y2 >= FCC then y2 := FCC - 1; 
  xx := y2 - y1; 
  if innerrow(y1, y2) then exit; 
  if succ(xx) >= FRC then begin 
    if FMsg then 
      messagebox(0, Pchar('Das Löschen der Zeilen ist nicht möglich.'#13#10 + 
        'Es muss mindestens eine Zeile übrig bleiben.  '), 
        PChar(FS1), mb_IconWarning); 
    exit; 
  end; 
  for k := 0 to xx do begin 
    for i := y1 to FRC - 1 do begin 
      for z := 0 to FCC do begin 
        FArr[z, i].Teileh := FArr[z, i + 1].Teileh; 
        FArr[z, i].Teilew := FArr[z, i + 1].Teilew; 
        FArr[z, i].width := FArr[z, i + 1].width; 
        FArr[z, i].height := FArr[z, i + 1].height; 
        FArr[z, i].FColor := FArr[z, i + 1].FColor; 
        FArr[z, i].Text := FArr[z, i + 1].Text; 
      end; 
    end; 
  end; 
  dec(FRC, xx + 1); 
  danach; 
end; 
 
function TTextGrid.cw(w: word): word; 
begin 
  if (w < FCC) then 
    result := FArr[w, FRC].width 
  else result := 0; 
end; 
 
function TTextGrid.Al(x: word): TTGAlig; 
begin 
  if (x < FCC) and (x >= FFC) then begin 
    case FAlig[x] of 
      DT_CENTER: result := tgCenter; 
      DT_RIGHT: result := tgRight; 
    else result := tgLeft; 
    end; 
  end else result := tgOuter; 
end; 
 
procedure TTextGrid.MWeis; 
begin 
  if FMsg then 
    messagebox(0, 
      'Zur Info:'#13#10'Mehrzeiliger Text wird nicht ausgerichtet.  ', 
      'Hinweis', mb_IconInformation); 
end; 
 
procedure TTextGrid.setAl(x: word; u: TTGAlig); 
var 
  y: integer; 
begin 
  if x >= FCC then exit; 
  if x >= FFC then 
    for y := FFR to FRC do begin 
      if ((FMulti = tgMultiline) and (FArr[x, y].FTextline = tgDefault) 
        or (FArr[x, y].FTextline = tgMultiline)) 
        and (FArr[x, y].Text <> '') and (u in [tgCenter, tgRight]) 
        then begin 
        MWeis; 
        break; 
      end; 
    end; 
  case u of 
    tgCenter: FAlig[x] := DT_CENTER; 
    tgRight: FAlig[x] := DT_RIGHT; 
  else FAlig[x] := DT_LEFT; 
  end; 
  invalidate; 
end; 
 
procedure TTextGrid.setFoc(c: boolean); 
begin 
  if c = FFoc then exit; 
  FFoc := c; 
  invalidate; 
end; 
 
procedure TTextGrid.setColv(i: integer); 
begin 
  if (i < -1) or (i >= FCC) or (i < FFC) 
    then i := -1; 
  loose; 
  FCol := i; 
  if (FRow >= FFR) and (FCol >= FFC) then begin 
    while (FCol >= 0) and (FArr[FCol, FRow].width = 0) do dec(FCol); 
    if (FCol >= 0) and (FRow >= 0) then 
      FArr[FCol, FRow].select := true; 
  end; 
end; 
 
procedure TTextGrid.setCol(i: integer); 
begin 
  setColv(i); 
  invalidate; 
end; 
 
procedure TTextGrid.setRowv(i: integer); 
begin 
  if (i < -1) or (i >= FRC) or (i < FFR) 
    then i := -1; 
  loose; 
  FRow := i; 
  if (FRow >= FFR) and (FCol >= FFC) then 
    while (FRow >= 0) and (FArr[FCol, FRow].width = 0) do dec(FCol); 
  if (FCol >= 0) and (FRow >= 0) then 
    FArr[FCol, FRow].select := true; 
end; 
 
procedure TTextGrid.setRow(i: integer); 
begin 
  setrowv(i); 
  invalidate; 
end; 
 
procedure TTextGrid.setSelC(c: TColor); 
begin 
  if c = FSelC then exit; 
  FSelC := c; 
  invalidate; 
end; 
 
procedure TTextGrid.setNofo(c: TColor); 
begin 
  if c = FNofo then exit; 
  FNofo := c; 
  invalidate; 
end; 
 
procedure TTextGrid.loose; 
var 
  x, y: integer; 
begin 
  for x := 0 to FCC - 1 do 
    for y := 0 to FRC - 1 do 
      FArr[x, y].select := false; 
end; 
 
function TTextGrid.waag(x, y: integer): integer; 
var 
  v, h, i, z: integer; 
begin 
  result := -1; 
  i := 0; 
  h := fz; 
  while i < FCC do begin 
    v := h + FLW; 
    h := FArr[i, FRC].width + v; 
    if FArr[i, FRC].width = 0 then dec(h, FLW); 
    if (y > -1) and 
      ((FArr[i + 1, y].width = 0) or (FArr[i + 1, y].height = 0)) 
      then z := FLW else z := 0; 
    if (x >= v) and (x < h + z) then begin 
      result := i; 
      break; 
    end; 
    inc(i); 
  end; 
end; 
 
function TTextGrid.senk(x, y: integer): integer; 
var 
  o, u, i, z: integer; 
begin 
  result := -1; 
  u := fz; 
  for i := 0 to FRC - 1 do begin 
    o := u + FLW; 
    u := FArr[FCC, i].height + o; 
    if FArr[FCC, i].height = 0 then dec(u, FLW); 
    if (x > -1) and (FArr[x, i + 1].height = 0) 
      then z := FLW else z := 0; 
    if (y >= o) and (y < u + z) then begin 
      result := i; 
      break; 
    end; 
  end; 
end; 
 
procedure TTextGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; 
  X: integer; Y: Integer); 
var 
  z, i, s: integer; 
  p: TPoint; 
  b, sc: boolean; 
  function ja: boolean; 
  var 
    k, j: integer; 
  begin 
    for k := FFC to FCC - 1 do 
      for j := FFR to FRC - 1 do 
        if (Farr[k, j].Teilew > 1) or (Farr[k, j].Teileh > 1) 
          then begin 
          result := true; 
          exit; 
        end; 
    result := false; 
  end; 
begin 
  if button = mbMiddle then begin 
    FRast := not FRast; 
    exit; 
  end; 
  if Button = mbLeft then 
    loose; 
  sc := (selcount > 1) or (Button = mbright); 
  z := senk(-1, y); 
  if sc and (z = -1) then z := senk(-1, y + FLW); 
  i := waag(x, z); 
  if sc and (i = -1) then i := waag(x + FLW, z); 
  FStelle.x := i; 
  z := senk(i, y); 
  if sc and (z = -1) then z := senk(i, y - FLW); 
  FStelle.y := z; 
  b := (FStelle.y >= FFR) and (FStelle.x >= FFC); 
  s := FStelle.x; 
  z := FStelle.y; 
  if b then begin 
    while FArr[s, z].height = 0 do dec(z); 
    while FArr[s, z].width = 0 do dec(s); 
  end; 
  if Button = mbLeft then begin 
    if (s <> FCol) or (z <> FRow) then FZahl := 0 
    else if FHlpCtrl.height > 0 then FZahl := -1; 
    if (FHlpCtrl.height > 0) and (FMz = z) and (FMs = s) 
      then begin 
      ok; 
      exit; 
    end; 
    DoEnter; 
    FROW := z; 
    FCOL := s; 
    if b then begin 
      FArr[s, z].select := true; 
      invalidate; 
      FDD := (ssAlt in Shift) and (FArr[s, z].text <> '') 
        and (FHlpCtrl.height = 0); 
      if FDD and FDDP then begin 
        FMs := s; 
        FMZ := z; 
        FArr[s, z].select := true; 
        releasecapture; 
        if ssCtrl in Shift then Cursor := FCurC 
        else cursor := FCurM; 
        invalidate; 
      end; 
    end else if FFixBttn and ((z < FFR) or (s < FFC)) 
      and (z > -1) and (s > -1) then begin 
      FDown := true; 
      repaint; 
      if assigned(FProcDwn) then FProcDwn(self, s, z, FArr[s, z].different); 
    end; 
  end else if Button = mbRight then begin 
    DoEnter; 
    if Fedg then begin 
      if not FArr[s, z].select or (selcount < 2) 
        then begin 
        loose; 
        FROW := z; 
        FCOL := s; 
        Farr[s, z].select := true; 
        invalidate; 
      end; 
      Fmi[0].enabled := b and FArr[s, z].select and (selcount > 1); 
      Fmi[1].enabled := Inside(s, z); 
      Fmi[2].enabled := (selcount = 1) and (s = FCol) and (Z = FRow); 
      Fmi[3].enabled := istext(true, false); 
      Fmi[4].enabled := istext(true, true); 
      Fmi[5].enabled := ja; 
      Fmi[6].enabled := (selcount = 1) and (FArr[FCol, FRow].text <> ''); 
      Fmi[7].enabled := Fmi[6].enabled; 
      Fmi[8].enabled := (selcount = 1) and clipboard.hasformat(CF_TEXT); 
      p := clienttoscreen(point(x, y)); 
      Fpop.popup(p.x, p.y); 
    end; 
  end; 
  inherited; 
end; 
 
procedure TTextGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; 
  X: integer; Y: Integer); 
var 
  p: TPoint; 
begin 
  if button = mbleft then begin 
    releasecapture; 
    cursor := crdefault; 
    getcursorpos(p); 
    setcursorpos(p.x + 1, p.y); 
    p := zelle(x, y); 
    if FDD and ((FMs <> p.x) or (FMz <> p.y)) and FDDP 
      and (FMs >= FFC) and (FMz >= FFR) 
      and (p.x >= FFC) and (p.y >= FFR) 
      then begin 
      FCol := p.x; 
      FRow := p.y; 
      if ueberschreiben then begin 
        FArr[p.x, p.y].text := FArr[FMs, FMz].text; 
        if not (ssCtrl in Shift) then 
          FArr[FMs, FMz].text := ''; 
      end; 
      loose; 
      selectieren; 
      FDD := false; 
      invalidate; 
      FMs := -1; 
      FMz := -1; 
    end else begin 
      inc(Fzahl); 
      FTimer.interval := 450; 
      if selcount = 1 then begin 
        if FZahl > 1 then begin 
          FZahl := 0; 
          if not FDD then 
            click2(self); 
        end; 
      end else FZahl := 0; 
    end; 
  end; 
  if FDown then begin 
    FDown := false; 
    repaint; 
    if (FCol > -1) and (FRow > -1) then 
      if assigned(FProcUp) then 
        FProcUp(self, FCol, FRow, FArr[FCol, FRow].different); 
  end; 
  inherited; 
end; 
 
function TTextGrid.Inside(x, y: integer): boolean; 
begin 
  result := (x >= FFC) and (y >= FFR) and 
    ((FArr[x, y].width = 0) and (FArr[x, FRC].width > 0) 
    or (FArr[x, y].height = 0) and (FArr[FCC, y].height > 0) or 
    (FArr[x, y].Teileh > 1) or (FArr[x, y].Teilew > 1)); 
end; 
 
function TTextGrid.zelle(x, y: integer): TPoint; 
var 
  w, s: integer; 
begin 
  s := senk(-1, y); 
  w := waag(x, s); 
  s := senk(w, y); 
  if (s >= FFR) and (w >= FFC) then begin 
    while FArr[w, s].height = 0 do dec(s); 
    while FArr[w, s].width = 0 do dec(w); 
  end; 
  result.x := w; 
  result.y := s; 
end; 
 
procedure TTextGrid.MouseMove(Shift: TShiftState; 
  X: integer; Y: Integer); 
var 
  i, k, xw, xs, a, b: integer; 
  p: TPoint; 
begin 
  cursor := crdefault; 
  if (ssLeft in Shift) and not FDown then begin 
    p := zelle(x, y); 
    if not FDD and (ssAlt in Shift) and FDDP 
      and (FHlpCtrl.height = 0) and (p.x >= FFC) and (p.y >= FFR) 
      and (FArr[p.x, p.y].text <> '') 
      then begin 
      FDD := true; 
      FMs := p.x; 
      FMz := p.y; 
      releasecapture; 
      if ssCtrl in Shift then Cursor := FCurC 
      else cursor := FCurM; 
    end; 
    if FDD and FDDP then begin 
      if (p.x >= FFC) and (p.y >= FFR) then begin 
        if ssCtrl in Shift then Cursor := FCurC 
        else cursor := FCurM; 
        loose; 
        FArr[p.x, p.y].select := true; 
      end else cursor := crNoDrop; 
    end else begin 
      if (p.y >= FFR) and (p.x >= FFC) 
        then begin 
        loose; 
        if (FRow >= FFC) and (FCol >= FFR) then 
          FArr[FCol, FRow].select := true; 
        if (FStelle.x = -1) then FStelle.x := waag(x - FLW, p.y); 
        if (FStelle.x = -1) then FStelle.x := waag(x + FLW, p.y); 
        if p.x < FStelle.x then begin 
          xw := p.x; 
          p.x := FStelle.x; 
        end else xw := FStelle.x; 
        if (FStelle.y = -1) then FStelle.y := senk(p.y, y - FLW); 
        if (FStelle.y = -1) then FStelle.y := senk(p.y, y + FLW); 
        if p.y < FStelle.y then begin 
          xs := p.y; 
          p.y := FStelle.y; 
        end else xs := FStelle.y; 
        if xw < FFC then xw := FFC; 
        if xs < FFR then xs := FFR; 
        for k := xs to p.y do 
          for i := xw to p.x do begin 
            b := k; 
            while FArr[i, b].height = 0 do dec(b); 
            a := i; 
            while FArr[a, k].width = 0 do dec(a); 
            FArr[a, b].select := true; 
          end; 
      end; 
    end; 
    invalidate; 
  end; 
  inherited; 
end; 
 
function TTextGrid.multpw(x, y: word): word; 
begin 
  result := FArr[x, y].width * FArr[x, y].Teilew; 
  if FArr[x, y].width > 0 then 
    inc(result, pred(FArr[x, y].Teilew) * FLW); 
end; 
 
function TTextGrid.multph(x, y: word): word; 
begin 
  result := FArr[x, y].height * FArr[x, y].Teileh; 
  if FArr[x, y].height > 0 then 
    inc(result, pred(FArr[x, y].Teileh) * FLW); 
end; 
 
procedure TTextGrid.MergeCells(x1, y1, x2, y2: word); 
var 
  x, y, w, v, i: integer; 
  b: byte; 
  s: string; 
  procedure fehler; 
  begin 
    if FAuto then s := '' 
    else s := 'überlappende, '; 
    if FMsg then 
      messagebox(0, Pchar('Verborgene, ' + s + 'fremdgezeichnete oder' + 
        ' fixierte Zellbereiche können nicht verbunden werden.  '), 
        PChar(FS1), mb_IconWarning); 
  end; 
  function testen: byte; 
  var 
    bt: byte; 
    p: TPoint; 
  begin 
    result := 0; 
    bt := l0test(x1, y1, x2, y2, p); 
    if bt > 0 then begin 
      if (bt > 1) or not FAuto then begin 
        fehler; 
        result := 2; 
        exit; 
      end else begin 
        FMatic := true; 
        if not 
          separatecells(p.x, p.y) then begin 
          if FMsg then 
            messagebox(0, 'Fehler beim Verbinden aufgetreten.  ', 
              'FEHLER', mb_IconError); 
          result := 2 
        end else result := 1; 
        FMatic := false; 
      end; 
    end; 
  end; 
begin 
  if not Fedg then begin 
    meldung('Das Verbinden von Zellen'); 
    exit; 
  end; 
  if x1 > x2 then begin 
    w := x1; 
    x1 := x2; 
    x2 := w; 
  end; 
  if y1 > y2 then begin 
    w := y1; 
    y1 := y2; 
    y2 := w; 
  end; 
  if x1 < FFC then x1 := FFC; 
  if x2 >= FCC then x2 := FCC - 1; 
  if y1 < FFR then y1 := FFR; 
  if y2 >= FRC then y2 := FRC - 1; 
  repeat 
    b := testen; 
    if b = 2 then exit; 
  until b = 0; 
  v := succ(y2 - y1); 
  w := succ(x2 - x1); 
  if (v < 2) and (w < 2) then begin 
    if FMsg then 
      messagebox(0, 'Verbinden ist nicht möglich.  ', 
        PChar(FS1), mb_IconWarning); 
    exit; 
  end; 
  loose; 
  for y := 0 to v - 1 do begin 
    FArr[x1, y1 + y].teilew := w; 
    i := 0; 
    for x := 0 to w - 1 do 
      i := i + FArr[x1 + x, FRC].width; 
    FArr[x1, y1 + y].width := i; 
    for x := 1 to w - 1 do begin 
      FArr[x1 + x, y1 + y].width := 0; 
      FArr[x1 + x, y1 + y].Teilew := 1; 
      if (x1 + x = FCol) and (y1 + y = FRow) then 
      begin 
        FCol := -1; 
        FRow := -1; 
      end; 
    end; 
  end; 
  for x := 0 to w - 1 do begin 
    FArr[x1 + x, y1].teileh := v; 
    i := 0; 
    for y := 0 to v - 1 do 
      i := i + FArr[FCC, y1 + y].height; 
    FArr[x1 + x, y1].height := i; 
    for y := 1 to v - 1 do begin 
      FArr[x1 + x, y1 + y].height := 0; 
      FArr[x1 + x, y1 + y].Teileh := 1; 
      if (x1 + x = FCol) and (y1 + y = FRow) then 
      begin 
        FCol := -1; 
        FRow := -1; 
      end; 
    end; 
  end; 
  selectieren; 
  invalidate; 
end; 
 
function TTextGrid.l0test(x1, y1, x2, y2: word; out p: TPoint): byte; 
var 
  x, y: integer; 
begin 
  result := 0; 
  for x := x1 to x2 do 
    for y := y1 to y2 do begin 
      if (FArr[x, y].different) then begin 
        result := 2; 
        exit; 
      end; 
      if (FArr[x, y].Teileh > 1) 
        or (FArr[x, y].Teilew > 1) then begin 
        result := 1; 
        p := point(x, y); 
      end; 
      if (FArr[x, y].width = 0) then begin 
        if FArr[x, FRC].width > 0 then begin 
          result := 1; 
          p := point(x, y); 
        end else begin 
          result := 2; 
          exit; 
        end; 
      end; 
      if (FArr[x, y].height = 0) then begin 
        if FArr[FCC, y].height > 0 then begin 
          result := 1; 
          p := point(x, y); 
        end else begin 
          result := 2; 
          exit; 
        end; 
      end; 
    end; 
end; 
 
function TTextGrid.SeparateCells(x, y: word): boolean; 
var 
  i, j, m, n: integer; 
  b: boolean; 
  procedure doit(a, b: integer); 
  begin 
    FArr[a, b].Teileh := 1; 
    FArr[a, b].Teilew := 1; 
    FArr[a, b].width := FArr[a, FRC].width; 
    FArr[a, b].height := FArr[FCC, b].height; 
  end; 
begin 
  result := false; 
  if not Fedg then begin 
    meldung('Das Separieren von Zellen'); 
    exit; 
  end; 
  if x >= FCC then x := FCC - 1; 
  if y >= FRC then y := FRC - 1; 
  if Inside(x, y) then begin 
    loose; 
    while (FArr[x, y].width = 0) do dec(x); 
    while (FArr[x, y].height = 0) do dec(y); 
    doit(x, y); 
    i := x + 1; 
    while ((FArr[i, y].Teileh > 1) and (FArr[i, y].Teilew = 1) 
      or (FArr[i, y].width = 0)) and (i < FCC) 
      do inc(i); 
    dec(i, ord(i > x)); 
    b := i = x; 
    j := y + 1; 
    while (((FArr[x, j].Teilew = 1) and (FArr[x, j].Teileh = 1) 
      or (FArr[x, j].height = 0)) and b 
      or (FArr[x, j].Teilew > 1) and (FArr[x, j].Teileh = 1) and not b) 
      and (j < FRC) 
      do inc(j); 
    dec(j, ord(j > y)); 
    i := x + 1; 
    while ((FArr[i, y].Teilew > 1) and (FArr[i, y].Teileh = 1) and not b 
      or (FArr[i, y].width = 0)) and (i < FCC) 
      do inc(i); 
    dec(i, ord(i > x)); 
    for m := x to i do 
      for n := y to j do 
        doit(m, n); 
    result := true; 
    if FMatic then exit; 
    selectieren; 
    neu; 
  end else 
    if FMsg and not FMatic then 
      messagebox(0, 'Sie befinden sich nicht in einem Zellverbund.  ', 
        PChar(Fmi[1].caption), mb_IconWarning); 
end; 
 
procedure TTextGrid.click1(sender: TObject); 
begin 
  separateCells(FStelle.x, FStelle.y); 
end; 
 
function TTextGrid.minmax: TTGMM; 
var 
  x, y: integer; 
begin 
  result[0, 0] := maxint; 
  result[0, 1] := maxint; 
  result[1, 0] := -1; 
  result[1, 1] := -1; 
  for y := FFR to FRC - 1 do begin 
    for x := FFC to FCC - 1 do begin 
      if (y < result[0, 1]) and Farr[x, y].select 
        then result[0, 1] := y; 
      if (x < result[0, 0]) and Farr[x, y].select 
        then result[0, 0] := x; 
    end; 
  end; 
  for x := FCC - 1 downto FFC do begin 
    for y := FRC - 1 downto FFR do begin 
      if (y > result[1, 1]) and Farr[x, y].select 
        then result[1, 1] := y; 
      if (x > result[1, 0]) and Farr[x, y].select 
        then result[1, 0] := x; 
    end; 
  end; 
end; 
 
procedure TTextGrid.click0(sender: TObject); 
var 
  a: TTGMM; 
  x, y, i, j: integer; 
begin 
  for x := FFC to FCC - 1 do 
    for y := FFR to FRC - 1 do 
      if ((FArr[x, y].Teilew > 1) or (FArr[x, y].Teileh > 1)) 
        and (FArr[x, y].select) then begin 
        i := x + 1; 
        while (i <= FCC - 1) and ((FArr[i, y].Teilew > 1) 
          or (FArr[i, y].width = 0) and (FArr[i, FRC].width > 0)) 
          do begin 
          FArr[i, y].select := true; 
          inc(i); 
        end; 
        dec(i); 
        j := y + 1; 
        while (j <= FRC - 1) and (FArr[i, j].height = 0) 
          and (FArr[FCC, j].height > 0) 
          do begin 
          FArr[i, j].select := true; 
          inc(j); 
        end; 
      end; 
  a := minmax; 
  mergecells(a[0, 0], a[0, 1], a[1, 0], a[1, 1]); 
end; 
 
procedure TTextGrid.click3(sender: TObject); 
var 
  s, w: string; 
  b: boolean; 
begin 
  b := not (sender = Fmi[3]); 
  if selcount <> 1 then s := 'n' else s := ''; 
  if istext(true, b) then begin 
    if not Fedg then begin 
      meldung('Das Löschen von Texten'); 
      exit; 
    end; 
    if not b then w := 'Text der markierten Zelle' + s 
    else w := 'gesamten Text'; 
    if FMsg then begin 
      if messagebox(0, 
        PChar('Wollen Sie wirklich den  ' + w 
        + ' löschen?  '), 'FRAGE', MB_YESNO or MB_ICONQUESTION) <> mryes 
        then exit; 
    end; 
  end; 
  istext(false, b); 
  invalidate; 
end; 
 
function TTextGrid.SelCount: cardinal; 
var 
  x, y: integer; 
begin 
  result := 0; 
  for x := FFC to FCC - 1 do 
    for y := FFR to FRC - 1 do 
      if FArr[x, y].select then inc(result); 
end; 
 
procedure TTextGrid.click2(sender: TObject); 
var 
  b: TTGEd; 
  ed: TCustomEdit; 
begin 
  if (FRow >= FFR) and (FCol >= FFC) then begin 
    ed := nil; 
    b := tgSelf; 
    FMz := FRow; 
    FMs := FCol; 
    if Fedg then 
      if assigned(FEditing) then FEditing(self, FCol, Frow, b, ed); 
    if (b = tgNo) or not Fedg then begin 
      if FMsg then 
        messagebox(0, 'Diese Zelle darf zur Zeit nicht editiert werden.  ', 
          PChar(FS1), mb_IconWarning); 
      exit; 
    end; 
    if (ed = nil) and (b = tgStrange) then begin 
      if FMsg then 
        messagebox(0, 'Es wurde kein Eingabe-Feld zugeordnet.  ', 
          PChar(FS1), mb_IconWarning); 
      exit; 
    end; 
    if b = tgSelf then begin 
      FDa := true; 
      FHlpCtrl.Fedit.text := FArr[FCol, FRow].text; 
      neu; 
      FHlpCtrl.Fedit.setfocus; 
    end else begin 
      FDa := false; 
      cells[FCol, FRow] := ed.text; 
      setfocus; 
    end; 
  end; 
end; 
 
procedure TTextGrid.CreateHlpControl(AOwner: TComponent; 
  AParent: TWinControl); 
begin 
  if not Assigned(FHlpCtrl) then 
  begin 
    FHlpCtrl := TFHlpCtrl.Create(AOwner, Self); 
    try 
      FHlpCtrl.TabStop := True; 
      weg; 
    except 
      raise; 
    end; 
  end; 
end; 
 
procedure TTextGrid.DestroyHlpControl; 
begin 
  if Assigned(FHlpCtrl) then 
  begin 
    if Assigned(FHlpCtrl.Parent) then begin 
      FHlpCtrl.free; 
      FHlpCtrl := nil; 
    end; 
  end; 
end; 
 
constructor TFHlpCtrl.Create(AOwner: TComponent; 
  GrphCtrl: TTextGrid); 
begin 
  inherited Create(AOwner); 
  FGrphCtrl := GrphCtrl; 
  FEdit := TMemo.create(self); 
  GrphCtrl.Fda := false; 
  FEdit.parent := self; 
  FEdit.scrollbars := ssVertical; 
  FEdit.OnkeyDown := GrphCtrl.EditKeyDown; 
  FEdit.color := clwhite; 
  FEdit.Font.color := clblack; 
  FL := TLabel.create(self); 
  FL.caption := ' Bestätigen mit Strg+Enter '; 
  FL.Font.color := clmaroon; 
  FL.Color := clYellow; 
  FL.Font.Style := [fsBold]; 
  FL.parent := self; 
  FL.OnClick := zuClick; 
  FGrphCtrl.Fi := FL.height + 2; 
end; 
 
procedure TFHlpCtrl.CMDIALOGKEY(var Alt: TWMKey); 
var 
  Shift: TShiftState; 
begin 
  if Assigned(FGrphCtrl) then 
    if Alt.CharCode = VK_Menu then begin 
      Shift := KeyDataToShiftState(Alt.KeyData); 
      FGrphCtrl.DoKeyDown(Alt.CharCode, Shift); 
    end; 
  inherited; 
end; 
 
procedure TFHlpCtrl.WMKeyDown(var M: TWMKeyDown); 
var 
  Shift: TShiftState; 
begin 
  if Assigned(FGrphCtrl) then 
  begin 
    Shift := KeyDataToShiftState(M.KeyData); 
    FGrphCtrl.DoKeyDown(M.CharCode, Shift); 
    if ssCtrl in Shift then 
  end; 
  inherited; 
end; 
 
procedure TFHlpCtrl.WMKeyUp(var M: TWMKeyUp); 
var 
  Shift: TShiftState; 
begin 
  if Assigned(FGrphCtrl) then 
  begin 
    Shift := KeyDataToShiftState(M.KeyData); 
    FGrphCtrl.DoKeyUp(M.CharCode, Shift); 
  end; 
  inherited; 
end; 
 
procedure TFHlpCtrl.CMEnter(var M: TWMNoParams); 
begin 
  if Assigned(FGrphCtrl) then 
    FGrphCtrl.DoEnter; 
  inherited; 
end; 
 
procedure TFHlpCtrl.CMExit(var M: TWMNoParams); 
begin 
  if Assigned(FGrphCtrl) then 
    FGrphCtrl.DoExit; 
  inherited; 
end; 
 
function TTextGrid.GetCanFocus: Boolean; 
begin 
  if Assigned(FHlpCtrl) then 
    result := FHlpCtrl.CanFocus 
  else 
    result := False; 
end; 
 
function TTextGrid.GetFocused: Boolean; 
begin 
  if Assigned(FHlpCtrl) then 
    result := FHlpCtrl.Focused 
  else 
    result := False; 
end; 
 
function TTextGrid.GetTabOrder: Integer; 
begin 
  if Assigned(FHlpCtrl) then 
    result := FHlpCtrl.TabOrder 
  else 
    result := -1; 
end; 
 
function TTextGrid.GetTabStop: Boolean; 
begin 
  if Assigned(FHlpCtrl) then 
    result := FHlpCtrl.TabStop 
  else 
    result := False; 
end; 
 
procedure TTextGrid.SetFocus; 
begin 
  if Assigned(FHlpCtrl) then 
    if FHlpCtrl.CanFocus then 
      FHlpCtrl.SetFocus; 
end; 
 
procedure TTextGrid.SetTabOrder(const Value: Integer); 
begin 
  if Assigned(FHlpCtrl) then 
    FHlpCtrl.TabOrder := Value; 
end; 
 
procedure TTextGrid.SetTabStop(const Value: Boolean); 
begin 
  if Assigned(FHlpCtrl) then 
    FHlpCtrl.TabStop := Value; 
end; 
 
procedure TTextGrid.SetParent(AParent: TWinControl); 
begin 
  inherited; 
  if Assigned(Self.Parent) then 
  begin 
    FHlpCtrl.Parent := Self.Parent; 
    FHlpCtrl.Show; 
  end; 
end; 
 
procedure TTextGrid.DoKeyDown(var Key: Word; Shift: TShiftState); 
begin 
  if Assigned(FOnKeyDown) then FOnKeyDown(Self, Key, Shift); 
end; 
 
procedure TTextGrid.DoKeyUp(var Key: Word; Shift: TShiftState); 
begin 
  if Assigned(FOnKeyUp) then FOnKeyUp(Self, Key, Shift); 
end; 
 
procedure TTextGrid.setfocusC(c: TColor); 
begin 
  if c = FFocusC then exit; 
  FFocusC := c; 
  invalidate; 
end; 
 
procedure TTextGrid.DoEnter; 
begin 
  weg; 
  setfocus; 
  if Assigned(FOnEnter) then FOnEnter(Self); 
end; 
 
procedure TTextGrid.DoExit; 
begin 
  weg; 
  if Assigned(FOnExit) then FOnExit(Self); 
end; 
 
procedure TFHlpCtrl.WndProc(var M: TMessage); 
var 
  Shift: TShiftState; 
begin 
  case M.Msg of 
    WM_SETFOCUS, WM_KILLFOCUS: begin 
        if Assigned(FGrphCtrl) then 
          FGrphCtrl.invalidate; 
      end; 
    CN_KEYDOWN: begin 
        Shift := KeyDataToShiftState(M.LParam); 
        case M.wParam of 
          VK_Home: FGrphCtrl.home(ssCtrl in shift); 
          VK_End: FGrphCtrl.Ende(ssCtrl in shift); 
          13: if (FGrphCtrl.selcount = 1) and (height = 0) 
            and FGrphCtrl.Fedg then begin 
              FGrphCtrl.click2(self); 
              M.Result := 1; 
              exit; 
            end; 
          27: begin 
              FGrphCtrl.reset; 
              M.Result := 1; 
              exit; 
            end; 
          VK_DELETE: if height = 0 
            then begin 
              FGrphCtrl.click3(self); 
              M.Result := 1; 
              exit; 
            end; 
          VK_RIGHT: begin 
              M.Result := 1; 
              FGrphCtrl.nachrechts(true); 
              exit; 
            end; 
          VK_Left: begin 
              M.Result := 1; 
              FGrphCtrl.nachlinks(true); 
              exit; 
            end; 
          VK_up: begin 
              M.Result := 1; 
              FGrphCtrl.nachoben(true); 
              exit; 
            end; 
          VK_Down: begin 
              M.Result := 1; 
              FGrphCtrl.nachunten(true); 
              exit; 
            end; 
        end; 
      end; 
  end; 
  inherited; 
end; 
 
procedure TTextgrid.setFCt(b: boolean); 
begin 
  if b = FCt then exit; 
  Fct := b; 
  invalidate; 
end; 
 
procedure TTextgrid.buildCol; 
begin 
  if FCol < FFC then begin 
    FCol := FFC; 
    while FArr[FCol, FRC].width = 0 do inc(FCol); 
  end else 
    while FArr[FCol, FRC].width = 0 do dec(FCol); 
end; 
 
procedure TTextgrid.buildRow; 
begin 
  if FRow < FFR then begin 
    FRow := FFR; 
    while FArr[FCC, FRow].height = 0 do inc(FRow); 
  end else 
    while FArr[FCC, FRow].height = 0 do dec(FRow); 
end; 
 
procedure TTextgrid.nachrechts(b: boolean); 
var 
  o: integer; 
  h: boolean; 
begin 
  h := false; 
  if b then 
    if assigned(FDrct) then FDrct(self, tgRightWards, FCol, FRow, h); 
  if h then exit; 
  buildRow; 
  o := FRow; 
  if (FCol < FFC) then begin 
    FCol := FFC; 
    while (FCol < FCC - 1) and (FArr[FCol, FRow].width = 0) do inc(FCol); 
  end else begin 
    loose; 
    if FCol < FCC - 1 then begin 
      inc(FCol); 
      while (FCol < FCC - 1) and (FArr[FCol, o].width = 0) do inc(FCol); 
      while (o > FFR) and (FArr[FCol, o].height = 0) do dec(o); 
    end; 
  end; 
  while (FCol > FFC) and (FArr[FCol, o].width = 0) do dec(FCol); 
  while (o > FFR) and (FArr[FCol, o].height = 0) do dec(o); 
  FArr[FCol, o].select := true; 
  FRow := o; 
  invalidate; 
end; 
 
procedure TTextgrid.nachlinks(b: boolean); 
var 
  o: integer; 
  h: boolean; 
begin 
  h := false; 
  if b then 
    if assigned(FDrct) then FDrct(self, tgLeftWards, FCol, FRow, h); 
  if h then exit; 
  buildRow; 
  o := FRow; 
  if (FCol < FFC) then begin 
    FCol := FCC - 1; 
    while (FCol > FFC) and (FArr[FCol, FRow].width = 0) do dec(FCol); 
  end else begin 
    loose; 
    if FCol > FFC then begin 
      dec(FCol); 
      while (FCol > FFC) and (FArr[FCol, o].width = 0) do dec(FCol); 
      while (o > FFR) and (FArr[FCol, o].height = 0) do dec(o); 
    end; 
  end; 
  while (FCol < FCC - 1) and (FArr[FCol, o].width = 0) do inc(FCol); 
  while (o > FFR) and (FArr[FCol, o].height = 0) do dec(o); 
  FArr[FCol, o].select := true; 
  FRow := o; 
  invalidate; 
end; 
 
procedure TTextgrid.nachoben(b: boolean); 
var 
  l: integer; 
  h: boolean; 
begin 
  h := false; 
  if b then 
    if assigned(FDrct) then FDrct(self, tgUpWards, FCol, FRow, h); 
  if h then exit; 
  buildCol; 
  l := FCol; 
  if (FRow < FFR) then begin 
    FRow := FRC - 1; 
    while (FRow > FFR) and (FArr[FCol, FRow].height = 0) do dec(FRow); 
  end else begin 
    while (FRow > FFR) and (FArr[FCol, FRow].height = 0) do dec(FRow); 
    loose; 
    if FRow > FFR then begin 
      dec(FRow); 
      while (FRow > FFR) and (FArr[l, FRow].height = 0) do dec(FRow); 
      while (l > FFC) and (FArr[l, FRow].width = 0) do dec(l); 
    end; 
  end; 
  while (FRow < FRC - 1) and (FArr[l, FRow].height = 0) do inc(FRow); 
  while (l > FFC) and (FArr[l, FRow].width = 0) do dec(l); 
  FArr[l, FRow].select := true; 
  FCol := l; 
  invalidate; 
end; 
 
procedure TTextgrid.nachunten(b: boolean); 
var 
  l: integer; 
  h: boolean; 
begin 
  h := false; 
  if b then 
    if assigned(FDrct) then FDrct(self, tgDownWards, FCol, FRow, h); 
  if h then exit; 
  buildCol; 
  l := FCol; 
  if (FRow < FFR) then begin 
    FRow := FFR; 
    while (FRow < FRC - 1) and (FArr[FCol, FRow].height = 0) do inc(FRow); 
  end else begin 
    loose; 
    if FRow < FRC - 1 then begin 
      inc(FRow); 
      while (FRow < FRC - 1) and (FArr[l, FRow].height = 0) 
        do inc(FRow); 
      while (l > FFC) and (FArr[l, FRow].width = 0) do dec(l); 
    end; 
  end; 
  while (FRow > FFR) and (FArr[l, FRow].height = 0) do dec(FRow); 
  while (l > FFC) and (FArr[l, FRow].width = 0) do dec(l); 
  FArr[l, FRow].select := true; 
  FCol := l; 
  invalidate; 
end; 
 
procedure TTextGrid.setEdge(b: boolean); 
begin 
  if b = FEdge then exit; 
  FEdge := b; 
  neu; 
end; 
 
procedure TTextGrid.ok; 
var 
  s: string; 
begin 
  s := FHlpCtrl.Fedit.text; 
  if assigned(FEdited) then FEdited(self, FCol, FRow, s); 
  cells[FCol, FRow] := s; 
  weg; 
  repaint; 
  setfocus; 
end; 
 
procedure TTextGrid.EditKeyDown(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
begin 
  case key of 
    27: begin 
        weg; 
        setfocus; 
      end; 
    13: if (ssCtrl in Shift) then begin 
        key := 0; 
        ok; 
        setfocus; 
      end; 
  end; 
end; 
 
procedure TTextGrid.setEPos(p: TTGEPos); 
begin 
  if p = FEPos then exit; 
  FEPos := p; 
  if FHlpCtrl.height > 0 then begin 
    FDa := true; 
    resize; 
  end; 
end; 
 
procedure TTextGrid.meldung(s: string); 
begin 
  if FMsg then 
    messagebox(0, PChar(s + ' ist zur Zeit nicht erlaubt.  '), 
      PChar(FS1), mb_IconWarning); 
end; 
 
procedure TTextGrid.weg; 
begin 
  FHlpCtrl.SetBounds(0, 0, 0, 0); 
  FHlpCtrl.FEdit.text := ''; 
end; 
 
function TTextGrid.innercol(x1, x2: word): boolean; 
var 
  s, z: integer; 
begin 
  for s := x1 to x2 do 
    for z := 0 to FRC - 1 do 
      if (FArr[s, z].Teilew > 1) or (FArr[s, z].Teileh > 1) 
        or (FArr[s, z].width = 0) and (FArr[s, FRC].width > 0) 
        or (FArr[s, z].height = 0) and (FArr[FCC, z].height > 0) 
        then begin 
        result := true; 
        if FMsg then 
          messagebox(0, Pchar('Die Spalten können' + 
            FS2), PChar(FS1), mb_IconWarning); 
        exit; 
      end; 
  result := false; 
end; 
 
procedure TTextGrid.setFixstyle(f: TFontstyles); 
begin 
  if f = FFstyle then exit; 
  FFStyle := f; 
  invalidate; 
end; 
 
procedure TTextGrid.setSelS(s: TTGSelS); 
begin 
  if s = FSelS then exit; 
  FSelS := s; 
  invalidate; 
end; 
 
function TTextGrid.innerrow(y1, y2: word): boolean; 
var 
  z, s: integer; 
begin 
  for s := 0 to FCC - 1 do 
    for z := y1 to y2 do 
      if (FArr[s, z].Teilew > 1) or (FArr[s, z].Teileh > 1) 
        or (FArr[s, z].width = 0) and (FArr[s, FRC].width > 0) 
        or (FArr[s, z].height = 0) and (FArr[FCC, z].height > 0) 
        then begin 
        result := true; 
        if FMsg then 
          messagebox(0, Pchar('Die Zeilen können' + 
            FS2), PChar(FS1), mb_IconWarning); 
        exit; 
      end; 
  result := false; 
end; 
 
function TTextGrid.DifferentCount: cardinal; 
var 
  x, y: integer; 
begin 
  result := 0; 
  for x := 0 to FCC - 1 do 
    for y := 0 to FRC - 1 do 
      if FArr[x, y].different then inc(result); 
end; 
 
function TTextGrid.AlignmentToStr(alg: TTGAlig): string; 
begin 
  case alg of 
    tgCenter: result := 'zentriert'; 
    tgRight: result := 'rechtsbündig'; 
    tgLeft: result := 'linksbündig'; 
  else result := 'nicht zu ermitteln'; 
  end; 
end; 
 
function TTextGrid.SaveBasicsToStream(st: TStream): boolean; 
begin 
  result := SaveGrid(st, 12345678); 
end; 
 
function TTextGrid.LoadBasicsFromStream(st: TStream): boolean; 
begin 
  result := LoadGrid(st, 12345678); 
end; 
 
function TTextGrid.SaveToStream(st: TStream): boolean; 
begin 
  result := SaveGrid(st, 87654321); 
end; 
 
function TTextGrid.LoadFromStream(st: TStream): boolean; 
begin 
  result := LoadGrid(st, 87654321); 
end; 
 
function TTextGrid.SaveGrid(st: TStream; q: integer): boolean; 
var 
  x, y, i, w, lg, c: integer; 
  Logfont: TLogFont; 
  b: boolean; 
begin 
  w := sizeof(word); 
  i := sizeof(Integer); 
  x := length(FVersion); 
  c := sizeof(TColor); 
  try 
    st.size := 0; 
    st.writebuffer(x, i); 
    st.writebuffer(FVersion[1], x); 
    st.writebuffer(q, i); 
    st.writebuffer(FCC, w); 
    st.writebuffer(FRC, w); 
    st.writebuffer(FMulti, sizeof(TTGmul)); 
    for x := 0 to FCC do 
      for y := 0 to FRC do begin 
        st.writebuffer(FArr[x, y].width, w); 
        st.writebuffer(FArr[x, y].height, w); 
        st.writebuffer(FArr[x, y].Teilew, w); 
        st.writebuffer(FArr[x, y].Teileh, w); 
        st.writebuffer(FArr[x, y].FColor, i); 
        st.writebuffer(FArr[x, y].select, 1); 
        lg := length(FArr[x, y].Text); 
        st.writebuffer(lg, i); 
        st.writebuffer(FArr[x, y].Text[1], lg); 
        st.writebuffer(FArr[x, y].FTextLine, sizeof(TTGMul)); 
      end; 
    st.writebuffer(Font.color, c); 
    if q = 87654321 then begin 
      st.writebuffer(FFStyle, sizeof(TFontStyles)); 
      st.writebuffer(FFDisc, c); 
      st.writebuffer(FFocusC, c); 
      st.writebuffer(FFixBttn, 1); 
      st.writebuffer(FFoc, 1); 
      st.writebuffer(Frand, sizeof(TTGBorder)); 
      st.writebuffer(FEPos, sizeof(TTGEPos)); 
      st.writebuffer(FNH, 1); 
      st.writebuffer(FSelc, c); 
      st.writebuffer(FNofo, c); 
      st.writebuffer(FBack, sizeof(TTGBack)); 
      st.writebuffer(FNW, 1); 
      st.writebuffer(FFixC, c); 
      st.writebuffer(FFlat, 1); 
      st.writebuffer(color, c); 
      st.writebuffer(FMsg, 1); 
      st.writebuffer(FPC, c); 
      st.writebuffer(Fedg, 1); 
      st.writebuffer(FLW, 1); 
      st.writebuffer(FFC, 1); 
      st.writebuffer(FFR, 1); 
      st.writebuffer(FCol, i); 
      st.writebuffer(FRow, i); 
      st.writebuffer(FDisc, c); 
      st.writebuffer(FSels, sizeof(TTGSelS)); 
      st.writebuffer(Fedge, 1); 
      st.writebuffer(FCt, 1); 
      for x := 0 to FCC - 1 do 
        st.writebuffer(FAlig[x], i); 
      b := FBmp.empty; 
      st.writebuffer(b, 1); 
      if not b then 
        FBmp.savetostream(st); 
      GetObject(Font.Handle, sizeof(Logfont), @Logfont); 
      st.writebuffer(LogFont, sizeof(TLogFont)); 
      x := length(Hint); 
      st.writebuffer(x, i); 
      st.writebuffer(Hint[1], x); 
      GetObject(FHlpCtrl.FEdit.Font.Handle, sizeof(Logfont), @Logfont); 
      st.writebuffer(LogFont, sizeof(TLogFont)); 
      st.writebuffer(FHlpCtrl.FEdit.Font.color, c); 
      st.writebuffer(FHlpCtrl.FEdit.color, c); 
      st.writebuffer(FHlpCtrl.FL.color, c); 
      st.writebuffer(FHlpCtrl.FL.Font.color, c); 
      st.writebuffer(Fu, i); 
    end; 
    result := true; 
  except 
    result := false; 
    if FMsg then 
      messagebox(0, 'Fehler beim Schreiben in den Stream.  ', 
        'FEHLER', mb_IconError); 
  end; 
end; 
 
function TTextGrid.LoadGrid(st: TStream; q: integer): boolean; 
var 
  x, y, i, w, lg, c: integer; 
  s: string; 
  mu: TTGMul; 
  m: boolean; 
  lb: byte; 
  LogFont: TLogfont; 
  cl: TColor; 
begin 
  result := false; 
  w := sizeof(word); 
  i := sizeof(Integer); 
  c := sizeof(TColor); 
  try 
    st.readbuffer(x, i); 
    setlength(s, x); 
    st.readbuffer(s[1], x); 
    st.readbuffer(x, i); 
    if (s <> FVersion) or (x <> q) then begin 
      if FMsg then 
        messagebox(0, 'Ungültige Version oder ungültige Daten.  ', 
          'LOAD TEXTGRID', mb_IconError); 
      exit; 
    end; 
    st.readbuffer(FCC, w); 
    setlength(FAlig, FCC + 1); 
    st.readbuffer(FRC, w); 
    setlength(FArr, FCC + 1, FRC + 1); 
    st.readbuffer(mu, sizeof(TTGmul)); 
    setMulti(mu); 
    for x := 0 to FCC do 
      for y := 0 to FRC do begin 
        st.readbuffer(FArr[x, y].width, w); 
        st.readbuffer(FArr[x, y].height, w); 
        st.readbuffer(FArr[x, y].Teilew, w); 
        st.readbuffer(FArr[x, y].Teileh, w); 
        st.readbuffer(FArr[x, y].FColor, i); 
        st.readbuffer(FArr[x, y].select, 1); 
        st.readbuffer(lg, i); 
        setlength(FArr[x, y].Text, lg); 
        st.readbuffer(FArr[x, y].Text[1], lg); 
        st.readbuffer(FArr[x, y].FTextLine, sizeof(TTGMul)); 
      end; 
    st.readbuffer(cl, c); 
    Font.color := cl; 
    if q = 87654321 then begin 
      st.readbuffer(FFStyle, sizeof(TFontStyles)); 
      st.readbuffer(FFDisc, c); 
      st.readbuffer(FFocusC, c); 
      st.readbuffer(FFixBttn, 1); 
      st.readbuffer(FFoc, 1); 
      st.readbuffer(Frand, sizeof(TTGBorder)); 
      st.readbuffer(FEPos, sizeof(TTGEPos)); 
      st.readbuffer(FNH, 1); 
      st.readbuffer(FSelc, c); 
      st.readbuffer(FNofo, c); 
      st.readbuffer(FBack, sizeof(TTGBack)); 
      st.readbuffer(FNW, 1); 
      st.readbuffer(FFixC, c); 
      st.readbuffer(FFlat, 1); 
      st.readbuffer(cl, c); 
      color := cl; 
      st.readbuffer(FMsg, 1); 
      st.readbuffer(FPC, c); 
      st.readbuffer(Fedg, 1); 
      st.readbuffer(lb, 1); 
      setFLW(lb); 
      st.readbuffer(FFC, 1); 
      st.readbuffer(FFR, 1); 
      st.readbuffer(FCol, i); 
      st.readbuffer(FRow, i); 
      st.readbuffer(FDisc, c); 
      st.readbuffer(FSels, sizeof(TTGSelS)); 
      st.readbuffer(Fedge, 1); 
      st.readbuffer(FCt, 1); 
      for x := 0 to FCC - 1 do 
        st.readbuffer(FAlig[x], i); 
      st.readbuffer(m, 1); 
      if m then begin 
        FPic := nil; 
        FBmp.width := 0; 
        FBmp.height := 0; 
      end else begin 
        FBmp.loadfromstream(st); 
        FPic.assign(FBmp); 
      end; 
      st.readbuffer(LogFont, sizeof(TLogFont)); 
      Font.Handle := CreateFontIndirect(LogFont); 
      st.readbuffer(x, i); 
      setlength(s, x); 
      st.readbuffer(s[1], x); 
      Hint := s; 
      st.readbuffer(LogFont, sizeof(TLogFont)); 
      FHlpCtrl.FEdit.Font.Handle := CreateFontIndirect(LogFont); 
      st.readbuffer(cl, c); 
      FHlpCtrl.FEdit.Font.color := cl; 
      st.readbuffer(cl, c); 
      FHlpCtrl.FEdit.color := cl; 
      st.readbuffer(cl, c); 
      FHlpCtrl.FL.color := cl; 
      st.readbuffer(cl, c); 
      FHlpCtrl.FL.Font.color := cl; 
      st.readbuffer(Fu, i); 
    end; 
    neu; 
    result := true; 
  except 
    if FMsg then 
      messagebox(0, 'Fehler beim Lesen aus dem Stream.  ', 
        'FEHLER', mb_IconError); 
  end; 
end; 
 
procedure TTextGrid.Reset; 
begin 
  loose; 
  FCol := -1; 
  FRow := -1; 
  invalidate; 
end; 
 
procedure TTextGrid.setEFont(f: TFont); 
begin 
  FHlpCtrl.Font.assign(f); 
end; 
 
function TTextGrid.getEFont: TFont; 
begin 
  result := FHlpCtrl.Font; 
end; 
 
procedure TTextGrid.setFEC(c: TColor); 
begin 
  FHlpCtrl.FEdit.Color := c; 
end; 
 
function TTextGrid.FEC: TColor; 
begin 
  result := FHlpCtrl.FEdit.Color; 
end; 
 
procedure TTextGrid.EditTipC(c: TColor); 
begin 
  FHlpCtrl.FL.Color := c; 
end; 
 
procedure TTextGrid.EditTipFontC(c: TColor); 
begin 
  FHlpCtrl.FL.Font.Color := c; 
end; 
 
function TTExtGrid.getETC: TColor; 
begin 
  result := FHlpCtrl.FL.Color; 
end; 
 
function TTExtGrid.getETFC: TColor; 
begin 
  result := FHlpCtrl.FL.Font.Color; 
end; 
 
procedure TTextGrid.setFtip(b: boolean); 
begin 
  if b <> FTip then begin 
    FTip := b; 
    resize; 
  end; 
end; 
 
procedure TTextGrid.home(b: boolean); 
begin 
  FCol := FFC; 
  if b or (FRow < FFR) or (FRow >= FRC) then FRow := FFR; 
  while (FRow < FRC - 1) and (FArr[FCol, FRow].height = 0) do inc(FRow); 
  while (Farr[FCol, FRow].width = 0) and (FCol < FCC - 1) do inc(FCol); 
  loose; 
  if (FArr[FCol, FRow].height > 0) and (FArr[FCol, FRow].width > 0) 
    then Farr[FCol, FRow].select := true; 
  invalidate; 
end; 
 
procedure TTextGrid.ende(b: boolean); 
begin 
  FCol := FCC - 1; 
  if b or (FRow < FFR) or (FRow >= FRC) then FRow := FRC - 1; 
  while (FRow > FFR) and (FArr[FCol, FRow].height = 0) do dec(FRow); 
  while (Farr[FCol, FRow].width = 0) and (FCol > FFC) do dec(FCol); 
  loose; 
  if (FArr[FCol, FRow].height > 0) and (FArr[FCol, FRow].width > 0) 
    then Farr[FCol, FRow].select := true; 
  invalidate; 
end; 
 
function TTextGrid.istext(b, immer: boolean): boolean; 
var 
  x, y: integer; 
begin 
  result := false; 
  for x := FFC to FCC - 1 do 
    for y := FFR to FRC - 1 do 
      if ((FArr[x, y].select) or immer) 
        and (FArr[x, y].text <> '') then begin 
        if b then begin 
          result := true; 
          exit; 
        end; 
        FArr[x, y].text := ''; 
      end; 
end; 
 
procedure TTextGrid.OnTimer(sender: TObject); 
begin 
  FTimer.interval := 0; 
  FZahl := 0; 
end; 
 
procedure TFHlpCtrl.Mousewheel(var M: TMessage); 
var 
  zDelta: shortint; 
  fwKeys: word; 
  b, r: boolean; 
begin 
  with FGrphCtrl do begin 
    if not FPermit then exit; 
    fwKeys := LOWORD(M.wParam); 
    zDelta := HIWORD(M.wParam); 
    b := false; 
    r := (fwKeys = MK_CONTROL) xor Frast; 
    if zDelta < 0 then begin 
      if r then begin 
        if assigned(FWheel) then FWheel(self, tgLeftWards, FCol, FRow, b); 
        if not b 
          then nachlinks(false); 
      end else begin 
        if assigned(FWheel) then FWheel(self, tgDownWards, FCol, FRow, b); 
        if not b 
          then nachunten(false); 
      end; 
    end else begin 
      if r then begin 
        if assigned(FWheel) then FWheel(self, tgRightWards, FCol, FRow, b); 
        if not b 
          then nachrechts(false); 
      end else begin 
        if assigned(FWheel) then FWheel(self, tgUpWards, FCol, FRow, b); 
        if not b 
          then nachoben(false); 
      end; 
    end; 
  end; 
end; 
 
procedure TTextGrid.SeparateAll; 
var 
  x, y: integer; 
begin 
  if not Fedg then begin 
    meldung('Das Separieren von Zellen'); 
    exit; 
  end; 
  loose; 
  FMatic := true; 
  for x := FFC to FCC - 1 do 
    for y := FFR to FRC - 1 do 
      separatecells(x, y); 
  FMatic := false; 
  selectieren; 
  neu; 
end; 
 
procedure TTextGrid.click4(Sender: TObject); 
begin 
  if sender = Fmi[5] then 
    SeparateAll else 
    click3(self); 
end; 
 
procedure TTextGrid.click6(Sender: TObject); 
begin 
  clipboard.asText := FArr[FCol, FRow].text; 
  if sender = Fmi[6] then begin 
    FArr[FCol, FRow].text := ''; 
    invalidate; 
  end; 
end; 
 
function TTextGrid.ueberschreiben: boolean; 
begin 
  result := true; 
  if FMsg and (FArr[FCol, FRow].text <> '') then begin 
    if messagebox(0, 
      PChar('Wollen Sie die Zelle wirklich überschreiben?  '), 
      'FRAGE', MB_YESNO or MB_ICONQUESTION) <> mryes 
      then result := false; 
  end; 
end; 
 
procedure TTextGrid.click8(Sender: TObject); 
begin 
  if ueberschreiben then begin 
    cells[FCol, FRow] := clipboard.astext; 
    invalidate; 
  end; 
end; 
 
procedure TTextGrid.ClearText; 
begin 
  click3(self); 
end; 
 
procedure TTextGrid.MouseToCell 
  (x, y: integer; Rahmen: boolean; out ACol, ARow: integer); 
var 
  p: TPoint; 
begin 
  p := zelle(x, y); 
  if Rahmen then begin 
    if p.x < 0 then begin 
      dec(x, succ(FLW)); 
      p := zelle(x, y); 
    end; 
    if p.x < 0 then begin 
      inc(x, succ(FLW * 2)); 
      p := zelle(x, y); 
    end; 
    if p.y < 0 then begin 
      dec(y, succ(FLW)); 
      p := zelle(x, y); 
    end; 
    if p.y < 0 then begin 
      inc(y, succ(FLW * 2)); 
      p := zelle(x, y); 
    end; 
  end; 
  ACol := p.x; 
  ARow := p.y; 
end; 
 
procedure Register; 
begin 
  RegisterComponents('DBR', [TTextGrid]); 
end; 
 
end.