Форум: "Начинающим";
Текущий архив: 2010.02.28;
Скачать: [xml.tar.bz2];
Вниз
вывод части 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;
Скачать: [xml.tar.bz2];
Память: 0.53 MB
Время: 0.006 c
