unit main1; {$mode objfpc}{$H+} interface uses SysUtils, Classes, fpg_base, fpg_main, fpg_form, fpg_menu, fpg_nicegrid, fpg_button, fpg_checkbox, fpg_label; type TfrmMain = class(TfpgForm) private FFileSubMenu: TfpgPopupMenu; FMenuBar : TfpgMenuBar; Grid1: TfpgNiceGrid; CheckBox1: TfpgCheckBox; CheckBox2: TfpgCheckBox; CheckBox3: TfpgCheckBox; CheckBox4: TfpgCheckBox; CheckBox5: TfpgCheckBox; CheckBox6: TfpgCheckBox; Label1: TfpgLabel; Button1: TfpgButton; Button2: TfpgButton; Button3: TfpgButton; Button4: TfpgButton; procedure CheckBox1Click(Sender: TObject); procedure CheckBox2Click(Sender: TObject); procedure CheckBox3Click(Sender: TObject); procedure CheckBox4Click(Sender: TObject); procedure CheckBox5Click(Sender: TObject); procedure CheckBox6Click(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Grid1DrawHeader(Sender: TObject; ACanvas: TfpgCanvas; Rc: TfpgRect; Str: string; var Handled: Boolean); procedure Grid1InsertRow(Sender: TObject; ARow: Integer); procedure miExitClicked(Sender: TObject); public procedure AfterCreate; override; end; implementation procedure TfrmMain.AfterCreate; var x: integer; begin Name := 'frmMain'; SetPosition(252, 121, 638, 575); WindowTitle := 'NiceGrid - Demo 1'; Hint := ''; FFileSubMenu := TfpgPopupMenu.Create(self); with FFileSubMenu do begin Name := 'FFileSubMenu'; SetPosition(0, 0, 120, 32); end; FFileSubMenu.AddMenuItem('&Quit', 'Ctrl-Q', @miExitClicked); FMenuBar := CreateMenuBar(self); FMenuBar.AddMenuItem('&File', nil).SubMenu := FFileSubMenu; Grid1 := TfpgNiceGrid.Create(self); with Grid1 do begin Name := 'Grid1'; SetPosition(16, 88, 597, 370); Anchors := [anLeft,anRight,anTop,anBottom]; FontDesc := '#Grid'; Hint := ''; // Cursor = 1 RowCount := 20; AutoAddRow := True; DefColWidth := 100; Color:=$ECE9D8; GridColor := clSilver; HeaderLine := 2; HeaderColor := clButtonFace; HeaderLightColor := clHilite1; HeaderDarkColor := clShadow1; HeaderFontColor := clWhite; HeaderFont := 'MS Sans Serif'; FooterFontColor := clRed; SelectionColor := 13816575; BeginUpdate; // JP with Columns.Add do begin Title := 'Merged;Multilined|Merged;Multilined'; Footer := 'Footer 0'; Font:='Arial-8'; FontColor:=clBlack; Width := 100; CanResize := False; end; with Columns.Add do begin Title:='First Group|One'; Footer:='Footer 1'; Width:=100; Font:='Arial-8'; FontColor:=clRed; Color:=$FFFACD;//14024703; HorzAlign:=haCenter; end; with Columns.Add do begin Title:='First Group|Two'; Footer:='Footer 2'; Font:='Arial-8'; FontColor:=clBlack; Width:=100; end; with Columns.Add do begin Title:='Second Group|One'; Footer:='Footer 3'; Width:=100; Font:='Arial-8'; FontColor:=clBlack; Color:=clWhite; HorzAlign:=haRight; end; with Columns.Add do begin Title:='Second Group|Two'; Footer:='Footer 4'; Font:='Arial-8'; FontColor:=clBlack; Width:=100; HorzAlign:=haCenter; end; GutterKind:=gkNumber; GutterWidth:=40; GutterFont:='Arial-8'; GutterFontColor:=clBlack; ShowFooter:=True; OnDrawHeader:=@Grid1DrawHeader; OnInsertRow:=@Grid1InsertRow; TabOrder:=0; EndUpdate; end; {Grid1} Label1:= TfpgLabel.Create(self); with Label1 do begin SetPosition(16, 42, 300, 18); Text:= '- Try to copy paste a cell with Ctrl+c and Ctrl+v' end; CheckBox1:= TfpgCheckBox.Create(self); with CheckBox1 do begin Name:='CheckBox1'; SetPosition(16,470,49,17); Anchors := [anLeft, anBottom]; Text := 'Flat'; Checked := True; TabOrder := 1; OnChange := @CheckBox1Click; end; CheckBox2:= TfpgCheckBox.Create(self); with CheckBox2 do begin Name:='CheckBox2'; SetPosition(78,470,110,17); Anchors := [anLeft, anBottom]; Text:= 'System Colors'; Checked := True; TabOrder := 2; OnChange := @CheckBox2Click; end; CheckBox3:= TfpgCheckBox.Create(self); with CheckBox3 do begin Name:='CheckBox3'; SetPosition(192,470,90,17); Anchors := [anLeft, anBottom]; Text := 'Fit to Width'; TabOrder := 3; OnChange := @CheckBox3Click; end; CheckBox4:= TfpgCheckBox.Create(self); with CheckBox4 do begin Name:='CheckBox4'; SetPosition(288,470,135,17); Anchors := [anLeft, anBottom]; Text := 'Auto Column Width'; TabOrder := 4; OnChange := @CheckBox4Click; end; CheckBox5:= TfpgCheckBox.Create(self); with CheckBox5 do begin Name:='CheckBox5'; SetPosition(424,470,90,17); Anchors := [anLeft, anBottom]; Text := 'Show Grids'; Checked := True; TabOrder := 5; OnChange := @CheckBox5Click; end; CheckBox6:= TfpgCheckBox.Create(self); with CheckBox6 do begin Name:='CheckBox6'; SetPosition(528,470,95,17); Anchors := [anLeft, anBottom]; Text := 'Show Footer'; Checked := True; TabOrder := 10; OnChange:= @CheckBox6Click; end; Button1:= TfpgButton.Create(self); with Button1 do begin Name:='Button1'; SetPosition(272,505,129,25); Anchors:= [anLeft, anBottom]; Text:= 'Hide 3rd Column'; TabOrder:= 8; OnClick:= @Button1Click; end; Button2:= TfpgButton.Create(self); with Button2 do begin Name:='Button2'; SetPosition(16,505,121,25); Anchors:= [anLeft, anBottom]; Text:= 'Insert New Row'; TabOrder:= 6; OnClick:= @Button2Click; end; Button3:= TfpgButton.Create(self); with Button3 do begin Name:='Button3'; SetPosition(144,505,121,25); Anchors:= [anLeft, anBottom]; Text:= 'Delete Current Row'; TabOrder:= 7; OnClick:= @Button3Click; end; Button4:= TfpgButton.Create(self); with Button4 do begin Name:='Button4'; SetPosition(416,505,180,25); Anchors:= [anLeft, anBottom]; Text:= 'Toggle ReadOnly 3rd Column'; TabOrder:= 9; OnClick:=@Button4Click; end; Grid1.BeginUpdate; for x := 0 to 9 do begin Grid1[0, x] := 'Sample Text'; Grid1[1, x] := 'Centered Text'; Grid1[2, x] := 'Left Alignment'; Grid1[3, x] := FormatFloat('### ### ##0.##', Random(20000000)); Grid1[4, x] := IntToStr(Random(2000)); end; Grid1.EndUpdate; end; procedure TfrmMain.miExitClicked(Sender: TObject); begin Close; end; procedure TfrmMain.CheckBox1Click(Sender: TObject); begin Grid1.Flat := CheckBox1.Checked; end; procedure TfrmMain.CheckBox2Click(Sender: TObject); begin if CheckBox2.Checked then begin with Grid1 do begin BeginUpdate; GridColor := clSilver; HeaderColor := clButtonFace; HeaderDarkColor := clShadow1; HeaderLightColor := clHilite1; HeaderFontColor := clBlack; GutterFontColor:=clBlack; EndUpdate; end; end else begin with Grid1 do begin BeginUpdate; GridColor := clGray; HeaderColor := $000000DF; HeaderDarkColor := clBlack; HeaderLightColor := $000080FF; HeaderFontColor := clWhite; GutterFontColor:=clWhite; EndUpdate; end; end; Grid1.Invalidate; end; procedure TfrmMain.CheckBox3Click(Sender: TObject); begin Grid1.FitToWidth := CheckBox3.Checked; end; procedure TfrmMain.CheckBox4Click(Sender: TObject); begin Grid1.AutoColWidth := CheckBox4.Checked; end; procedure TfrmMain.CheckBox5Click(Sender: TObject); begin Grid1.ShowGrid := CheckBox5.Checked; end; procedure TfrmMain.CheckBox6Click(Sender: TObject); begin Grid1.ShowFooter := CheckBox6.Checked; end; procedure TfrmMain.Button1Click(Sender: TObject); begin Grid1.Columns[2].Visible := not Grid1.Columns[2].Visible; end; procedure TfrmMain.Button2Click(Sender: TObject); begin Grid1.InsertRow(Grid1.Row); end; procedure TfrmMain.Button3Click(Sender: TObject); begin Grid1.DeleteRow(Grid1.Row); end; procedure TfrmMain.Button4Click(Sender: TObject); begin Grid1.Columns[2].ReadOnly := not Grid1.Columns[2].ReadOnly; end; procedure TfrmMain.Grid1DrawHeader(Sender: TObject; ACanvas: TfpgCanvas; Rc: TfpgRect; Str: String; var Handled: Boolean); begin if (Str = 'One') then ACanvas.SetTextColor(clRed); end; procedure TfrmMain.Grid1InsertRow(Sender: TObject; ARow: Integer); begin Grid1.Cells[0, ARow] := 'New Row'; end; end.