вторник, 21 января 2014 г.

Lazarus. Загрузка изображений в StringGrid

Ниже приведен код программы, в которой по нажатию на клетки таблицы, в нее будут загружаться флажки разного цвета (зеленый - при первом нажатии и красный - при втором нажатии)

type
  { TForm1 }
//На форме размещаем
  TForm1 = class(TForm)
    Button1: TButton; //Кнопка Restart
    sg: TStringGrid;  //Таблица StringGrid 
    procedure Button1Click(Sender: TObject); //Создаем обработчик события onClick для Button1
    procedure FormCreate(Sender: TObject); //Создаем обработчик события onCreate для Form1
    procedure sgClick(Sender: TObject); //Создаем обработчик события onClick для sg
    procedure sgDrawCell(Sender: TObject; aCol, aRow: integer;
      aRect: TRect; aState: TGridDrawState);//Создаем обработчик события onDrawCell для sg
  private
    { private declarations }
  public
    { public declarations }
  end;


var
  Form1: TForm1;
  // Объявляем переменные типа TBitmap, в которых будут хранится рисунки
  Fon, RedFlag, GreenFlag: TBitmap;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var
  i, j: integer;
begin
  for i := 0 to sg.RowCount - 1 do
    for j := 0 to sg.ColCount - 1 do
      sg.Cells[j, i] := '0';
  // При создании формы инициализируем переменные TBimap
  Fon := tbitmap.Create;
  RedFlag := tbitmap.Create;
  GreenFlag:= tbitmap.Create;
  // Загружаем в каждую переменную нужный рисунок
  Fon.LoadFromFile('fon.bmp');
  GreenFlag.LoadFromFile('pic_green.bmp');
  RedFlag.LoadFromFile('pic_red.bmp');
end;

// Обработчик клика по таблице
procedure TForm1.sgClick(Sender: TObject);
var
  x, y: integer;
begin
  // Запоминаем номер строки, по которой кликнули
  x := sg.selection.left;
  // Запоминаем номер столбца, по которому кликнули
  y := sg.selection.top;
  // Увеличиваем значение в выделенной ячейке на 1
  sg.Cells[x, y] := IntToStr(StrToInt(sg.Cells[x, y]) + 1);
  // Если значение достигло 3, сбрасываем на 0:
  if sg.Cells[x,y] = '3' then
     sg.Cells[x,y] := '0';
end;

// Кнопка Restart сбрасывает все значения в таблице на 0
procedure TForm1.Button1Click(Sender: TObject);
var i,j:integer;
begin
    for i := 0 to sg.RowCount - 1 do
    for j := 0 to sg.ColCount - 1 do
      sg.Cells[j, i] := '0';
    Sg.Repaint;
end;

// Процедура перерисовки таблицы вызывается при любом изменении StringGrid
procedure TForm1.sgDrawCell(Sender: TObject; aCol, aRow: integer;
  aRect: TRect; aState: TGridDrawState);
begin
  // В зависимости от данных, хранимых в ячейках, загружаем разные картинки
  if sg.Cells[aCol, aRow] = '0' then
  begin
    sg.Canvas.CopyRect(aRect, fon.Canvas, Rect(0,0,10,10));
  end
  else if sg.Cells[aCol, aRow] = '1' then
  begin
    sg.Canvas.CopyRect(aRect, GreenFlag.Canvas, Rect(0,0,10,10));
  end
  else if sg.Cells[aCol, aRow] = '2' then
  begin
    sg.Canvas.CopyRect(aRect, RedFlag.Canvas, Rect(0,0,10,10));
  end
end;

end.

Комментариев нет:

Отправить комментарий