Сообщение об ошибке

Deprecated function: The each() function is deprecated. This message will be suppressed on further calls в функции menu_set_active_trail() (строка 2405 в файле /home/kpaco123/e-helper/includes/menu.inc).

Приклад табличного редактора в Delphi

 

Приклад табличного редактора в Delphi

 

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ActnList, ActnCtrls, XPStyleActnCtrls, ActnMan, ToolWin,

  ActnMenus, Grids, Menus;

 

type

 cellr=record

  cellTEXT:string[255];

  cellWIDTH:Integer;

  cellHEIGHT:Integer;

  cellX,cellY:Integer;

  fontNAME:string[255];

  fontSIZE:Integer;

  fontCOLOR:TCOLOR;

  fontBOLD,fontITALIC,fontUNDERLINE:Boolean;

   end;

 

  {

   action1  - Open file

   action2  - Save file

   action3  - Save file as

   action4  - Add line

   action5  - Remove line

   action6  - Add column

   action7  - Remove column

   action8  - New file

   action9  - Font

   action10 - Bold

   action11 - Italic

   action12 - Underline

   action13 - Find dialog

   action14 - Status

  }

 

type

  TForm1 = class(TForm)

    ActionMainMenuBar1: TActionMainMenuBar;

    ActionManager1: TActionManager;

    ActionToolBar1: TActionToolBar;

    Action1: TAction;

    OpenDialog1: TOpenDialog;

    Action2: TAction;

    FontDialog1: TFontDialog;

    StringGrid1: TStringGrid;

    Action3: TAction;

    PopupMenu1: TPopupMenu;

    Action4: TAction;

    Action5: TAction;

    Action6: TAction;

    Action7: TAction;

    N1: TMenuItem;

    N2: TMenuItem;

    N3: TMenuItem;

    N4: TMenuItem;

    Action8: TAction;

    SaveDialog1: TSaveDialog;

    Action9: TAction;

    Action10: TAction;

    Action11: TAction;

    Action12: TAction;

    FindDialog1: TFindDialog;

    Action13: TAction;

    Action14: TAction;

    procedure StringGridUpdate; //Update StringGrid from Sheet

    procedure EmptySheet; //Erases all data in sheet

    procedure FillSheet;  //fill sheet from StringGrid

    procedure EmptyCellr(var c:cellr);  //Empty cellr structure

    procedure Action1Execute(Sender: TObject);

    procedure Action4Execute(Sender: TObject);

    procedure Action5Execute(Sender: TObject);

    procedure Action6Execute(Sender: TObject);

    procedure Action7Execute(Sender: TObject);

    procedure Action8Execute(Sender: TObject);

    procedure Action3Execute(Sender: TObject);

    procedure FormShow(Sender: TObject);

    procedure Action2Execute(Sender: TObject);

    procedure Action9Execute(Sender: TObject);

    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

      Rect: TRect; State: TGridDrawState);

    procedure Action10Execute(Sender: TObject);

    procedure Action11Execute(Sender: TObject);

    procedure Action12Execute(Sender: TObject);

    procedure FindDialog1Find(Sender: TObject);

    procedure Action13Execute(Sender: TObject);

    procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;

      var CanSelect: Boolean);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

Const

 MaxRow=250;

 MaxCol=250;

 

var

  Form1: TForm1;

  b:cellr;

  sheet:Array [0..MaxRow,0..MaxCol] of cellr;

  sheetH,sheetW:Integer;

  FName:String='';

 

implementation

 

{$R *.dfm}

 

procedure TForm1.FillSheet;

Var

 x,y:Integer;

Begin

for y:=0 to StringGrid1.RowCount-1 do

for x:=0 to StringGrid1.ColCount-1 do

 Begin

  sheet[x,y].cellTEXT:=StringGrid1.Cells[x,y];

  sheet[x,y].cellWIDTH:=StringGrid1.ColWidths[x];

  sheet[x,y].cellHeight:=StringGrid1.RowHeights[y];

 End;

End;

 

procedure TForm1.EmptySheet;

Var

 x,y:Integer;

Begin

For x:=0 to MaxCol do

 For y:=0 to MaxRow do

 Begin

  EmptyCellr(sheet[x,y]);

  sheet[x,y].cellX:=x;

  sheet[x,y].cellY:=y;

 End;

End;

 

procedure Tform1.StringGridUpdate;

Var

 x,y:Integer;

Begin

 StringGrid1.ColCount:=sheetW;

 StringGrid1.RowCount:=sheetH;

For y:=0 to sheetH-1 do

 For x:=0 to sheetW-1 do

 Begin

  stringGrid1.Cells[x,y]:=sheet[x,y].cellTEXT;

 if sheet[x,y].cellWIDTH>0 then StringGrid1.ColWidths[x]:=sheet[x,y].cellWIDTH;

 if sheet[x,y].cellHEIGHT>0 then StringGrid1.RowHeights[y]:=sheet[x,y].cellHEIGHT;

 End;

End;

 

procedure TForm1.EmptyCellr(var c:cellr);

Begin

 c.cellTEXT:='';

 c.cellWIDTH:=0;

 c.cellHEIGHT:=0;

 c.fontNAME:='';

 c.fontSIZE:=0;

 c.fontCOLOR:=0;

 c.fontBOLD:=false;

 c.fontITALIC:=false;

 c.fontUNDERLINE:=false;

End;

 

Procedure StringGridInsertRow(StrGrid:TStringGrid;NewRow:Integer);

Var

 Row_:Integer;

begin

 StrGrid.RowCount:=StrGrid.RowCount+1;

For Row_:=StrGrid.RowCount-1 downto NewRow do

 StrGrid.Rows[Row_].Assign(StrGrid.Rows[Row_-1]);

 StrGrid.Rows[NewRow-1].Text:='';

end;

 

 

Procedure StringGridInsertColumn(StrGrid:TStringGrid;NewColumn:Integer);

Var

 Column:Integer;

begin

 StrGrid.ColCount:=StrGrid.ColCount+1;

For Column:=StrGrid.ColCount-1 downto NewColumn do

 StrGrid.Cols[Column].Assign(StrGrid.Cols[Column-1]);

 StrGrid.Cols[NewColumn-1].Text:='';

end;

 

procedure StringGridDeleteColumn(var StrGrid: TStringGrid; DelColumn: Integer);

Var Column: Integer;

begin

  If DelColumn <= StrGrid.ColCount then

  Begin

    For Column := DelColumn To StrGrid.ColCount-2 do

      StrGrid.Cols[Column].Assign(StrGrid.Cols[Column+1]);

    StrGrid.ColCount := StrGrid.ColCount-1;

  End;

end;

 

procedure StringGridDeleteRow(yourStringGrid: TStringGrid; ARow: Integer);

var i: Integer;

begin

  with yourStringGrid do

  begin

    for i := ARow to RowCount-2 do

      Rows[i].Assign(Rows[i+1]);

    RowCount := RowCount - 1

  end;

end;

 

procedure TForm1.Action1Execute(Sender: TObject);

Var

 F:File of cellr;

 x,y,maxx,maxy:Integer;

 r:cellr;

begin

if OpenDialog1.Execute then

 Begin

  FName:=OpenDialog1.FileName;

  AssignFile(F,FName);

  Reset(F);maxx:=-2;maxy:=-2;

 While not EOF(F) do

  Begin

   Read(F,r);

   x:=r.cellX;y:=r.cellY;

  if y>maxy then maxy:=y;

  if x>maxx then maxx:=x;

   sheet[x,y]:=r;

  End;

  CloseFile(F);

  sheetW:=maxx;sheetH:=maxy;

  StringGridUpdate;

 End;

end;

 

procedure TForm1.Action4Execute(Sender: TObject);

begin

 StringGridInsertRow(StringGrid1,StringGrid1.Row+1);

end;

 

procedure TForm1.Action5Execute(Sender: TObject);

begin

 StringGridDeleteRow(StringGrid1,StringGrid1.Row);

end;

 

procedure TForm1.Action6Execute(Sender: TObject);

begin

 StringGridInsertColumn(StringGrid1,StringGrid1.Col+1);

end;

 

procedure TForm1.Action7Execute(Sender: TObject);

begin

 StringGridDeleteColumn(StringGrid1,StringGrid1.Col);

end;

 

procedure TForm1.Action8Execute(Sender: TObject);

begin

 EmptySheet;

 sheetW:=6;sheetH:=4;

 StringGridUpdate;

 FName:='';

end;

 

procedure TForm1.Action3Execute(Sender: TObject);

Var

 F:File of cellr;

 x,y:Integer;

begin

 FillSheet;

if SaveDialog1.Execute then

 Begin

  FName:=SaveDialog1.FileName;

  AssignFile(F,FName);

  Rewrite(F);

 for y:=0 to StringGrid1.RowCount do

 for x:=0 to StringGrid1.ColCount do

  Write(F,sheet[x,y]);

  CloseFile(F);

 End;

end;

 

procedure TForm1.FormShow(Sender: TObject);

begin

 EmptySheet;

end;

 

procedure TForm1.Action2Execute(Sender: TObject);

Var

 F:File of cellr;

 x,y:Integer;

begin

if FName='' then Action3Execute(Self) else

 Begin

  FillSheet;

  AssignFile(F,FName);

  Rewrite(F);

 for y:=0 to StringGrid1.RowCount do

 for x:=0 to StringGrid1.ColCount do

  Write(F,sheet[x,y]);

  CloseFile(F);

 End;

end;

 

procedure TForm1.Action9Execute(Sender: TObject);

Var

 x,y:Integer;

begin

If FontDialog1.Execute then

 Begin

  y:=StringGrid1.Row;x:=StringGrid1.Col;

  sheet[x,y].fontNAME:=FontDialog1.Font.Name;

  sheet[x,y].fontCOLOR:=FontDialog1.Font.Color;

  sheet[x,y].fontSIZE:=FontDialog1.Font.Size;

 if fsBold in FontDialog1.Font.Style then sheet[x,y].fontBOLD:=True

  else sheet[x,y].fontBOLD:=False;

 if fsItalic in FontDialog1.Font.Style then sheet[x,y].fontITALIC:=True

  else sheet[x,y].fontITALIC:=False;

 if fsUnderline in FontDialog1.Font.Style then sheet[x,y].fontUNDERLINE:=True

  else sheet[x,y].fontUNDERLINE:=False;

 End;

end;

 

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

  Rect: TRect; State: TGridDrawState);

Var

 x,y:Integer;

begin

 StringGrid1.Canvas.Font.Style:=[];

 StringGrid1.Canvas.Font.Color:=clBlack;

 x:=ACol;y:=ARow;

if sheet[x,y].fontCOLOR<>0 then

 StringGrid1.Font.Color:=sheet[x,y].fontCOLOR;

if sheet[x,y].fontNAME<>'' then

 StringGrid1.Canvas.Font.Name:=sheet[x,y].fontNAME;

if sheet[x,y].fontSIZE<>0 then

 StringGrid1.Canvas.Font.Size:=sheet[x,y].fontSIZE;

if sheet[x,y].fontBOLD then

 StringGrid1.Canvas.Font.Style:=StringGrid1.Canvas.Font.Style+[fsBold];

if sheet[x,y].fontITALIC then

 StringGrid1.Canvas.Font.Style:=StringGrid1.Canvas.Font.Style+[fsITALIC];

if sheet[x,y].fontUNDERLINE then

 StringGrid1.Canvas.Font.Style:=StringGrid1.Canvas.Font.Style+[fsUNDERLINE];

 StringGrid1.Canvas.TextRect(Rect,Rect.Left,Rect.Top,StringGrid1.Cells[x,y]);

end;

 

procedure TForm1.Action10Execute(Sender: TObject);

begin

 sheet[StringGrid1.Col,StringGrid1.Row].fontBOLD:=

  not sheet[StringGrid1.Col,StringGrid1.Row].fontBOLD;

 StringGrid1.Repaint;

end;

 

procedure TForm1.Action11Execute(Sender: TObject);

begin

 sheet[StringGrid1.Col,StringGrid1.Row].fontITALIC:=

  not sheet[StringGrid1.Col,StringGrid1.Row].fontITALIC;

 StringGrid1.Repaint;

end;

 

procedure TForm1.Action12Execute(Sender: TObject);

begin

 sheet[StringGrid1.Col,StringGrid1.Row].fontUNDERLINE:=

  not sheet[StringGrid1.Col,StringGrid1.Row].fontUNDERLINE;

 StringGrid1.Repaint;

end;

 

procedure TForm1.FindDialog1Find(Sender: TObject);

Var

 x1,y1,x,y:Integer;

begin

 x1:=StringGrid1.Col;

 y1:=StringGrid1.Row;

for x:=x1 to SheetW do

for y:=y1 to SheetH do

 if pos(FindDialog1.FindText,StringGRid1.Cells[x,y])>0 then

  Begin

   StringGrid1.Col:=x;

   StringGrid1.Row:=y;

   break;

  End;

end;

 

procedure TForm1.Action13Execute(Sender: TObject);

begin

 FindDialog1.Execute;

end;

 

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,

  ARow: Integer; var CanSelect: Boolean);

begin

 Action14.Caption:='Строка: '+IntToStr(StringGrid1.Row)+

  ' Столбец : '+IntToStr(StringGrid1.Col);

end;

 

end.