Текущий архив: 2010.02.28;
Скачать: CL | DM;

Вниз

вывод части Bitmap   Найти похожие ветки 

← →
Не занят   (2009-12-25 01:47) [40]

> Amoeba ©   (25.12.09 01:43) [39]


Я же написал можно, а не нужно. Понятно, что от деталей зависит...

---

← →
Amoeba ©   (2009-12-25 01:51) [41]

> Игорь Шевченко ©   (25.12.09 01:36) [37]
> Пример хотелось бы увидеть. Работающий.

Есть один проект, к сожалению оставшийся незавершенным по независящим от меня обстоятельствам. Между прочим, картинка в битмап не грузится, файл отображается в память и прямо из него делается отрисовка в ячейках. Код работает. Кода много, а выковыривать нужную для демонстрации часть жалко времени, да и просто лень.

---

← →
Amoeba ©   (2009-12-25 01:55) [42]

> Не занят   (25.12.09 01:47) [40]
>
>
> > Amoeba ©   (25.12.09 01:43) [39]
>
>
> Я же написал можно, а не нужно. Понятно, что от деталей
> зависит...

Не вижу предмета для спора. Полностью согласен.

---

← →
Игорь Шевченко ©   (2009-12-25 02:26) [43]

Раз все такие ленивые, сделал я:

unit main;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, Grids;

type
 TForm1 = class(TForm)
   Grid: TDrawGrid;
   procedure FormCreate(Sender: TObject);
   procedure GridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
     State: TGridDrawState);
   procedure GridSelectCell(Sender: TObject; ACol, ARow: Integer;
     var CanSelect: Boolean);
   procedure FormResize(Sender: TObject);
 private
   FOriginalImage: TBitmap;
   FWorkerImage: TBitmap;
   //Это сделано намерено тупо
   FOpened: array[0..10, 0..10] of Boolean;
   procedure ResizeGrid;
 end;

var
 Form1: TForm1;

implementation

type TGridCracker = class(TCustomGrid) end;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 FOriginalImage := TBitmap.Create;
 FOriginalImage.LoadFromFile(".\core17.bmp");
 ResizeGrid;
end;

function NumToPixels(Grid: TDrawGrid; Col, Row: Integer): TRect;
begin
 Result.Left := Grid.DefaultColWidth * Col;
 Result.Right := Result.Left + Grid.DefaultColWidth;
 Result.Top := Grid.DefaultRowHeight * Row;
 Result.Bottom := Result.Top + Grid.DefaultRowHeight;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
 FWorkerImage.Free;
 ResizeGrid;
end;

procedure TForm1.GridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
 State: TGridDrawState);
begin
 if FOpened[ACol, ARow] then
   Grid.Canvas.CopyRect(Rect, FWorkerImage.Canvas, NumToPixels(Grid, ACol, ARow))
 else
 begin
   Grid.Canvas.Brush.Color := clBlack;
   Grid.Canvas.FillRect(Rect);
 end;
end;

procedure TForm1.GridSelectCell(Sender: TObject; ACol, ARow: Integer;
 var CanSelect: Boolean);
begin
 FOpened[ACol, ARow] := not FOpened[ACol, ARow];
 TGridCracker(Grid).InvalidateCell(ACol, ARow);
end;

procedure TForm1.ResizeGrid;
begin
 FWorkerImage := TBitmap.Create;
 FWorkerImage.Width := Grid.ClientWidth;
 FWorkerImage.Height := Grid.ClientHeight;
 FWorkerImage.Canvas.StretchDraw(
   Rect(0, 0, FWorkerImage.Width, FWorkerImage.Height),
   FOriginalImage);
 Grid.DefaultRowHeight := Grid.ClientHeight div Grid.RowCount;
 Grid.DefaultColWidth := Grid.ClientWidth div Grid.ColCount;
end;

end.

Что не понравилось - не нашел метода перерисовки отдельной ячейки у DrawGrid.

Что понравилось - возможность изменения размера под размер формы, без особенных ухищрений.

То есть, по сути, тот же PaintBox, только с отдельным окном.

---

← →
Германн ©   (2009-12-25 02:30) [44]

> Игорь Шевченко ©   (25.12.09 02:26) [43]
>
> Раз все такие ленивые, сделал я:
>

И что у тебя "чесалось" :)

---

← →
Игорь Шевченко ©   (2009-12-25 02:36) [45]

Германн ©   (25.12.09 02:30) [44]

Гондурас, разумеется

---

← →
Германн ©   (2009-12-25 03:00) [46]

> Игорь Шевченко ©   (25.12.09 02:36) [45]

Мне бы твои проблемы :)

---

← →
MonoLife ©   (2009-12-25 05:33) [47]

> {RASkov} ©   (25.12.09 00:48) [29]

+1 Я тоже люблю StringGrid:)

---

Страницы: 1 2 вся ветка

Текущий архив: 2010.02.28;
Скачать: CL | DM;

Наверх

Память: 0.55 MB
Время: 0.011 c