Вот как это происходит в диалоге добавления картинок в imagelist:
| Код |
...
if Execute then
begin
// инициализация
Modified := False;
Picture := TPicture.Create;
NewBitmaps := TList.Create;
NewBitmap := TBitmap.Create;
{ Add at least one bitmap and mask }
NewBitmaps.Add(NewBitmap);
AddCount := 0;
...
// для каждого файла выбранного в диалоге открытия файлов
for I := 0 to Files.Count - 1 do
begin
Picture.LoadFromFile(Files[I]);
if Picture.Graphic is TIcon then
begin
...
end;
IWidth := ImageBitmap.Width;
IHeight := ImageBitmap.Height;
if Picture.Graphic is TBitmap then
begin
{ Find out if the new image is a list of bitmaps to be extracted }
SubDivideX := (Picture.Graphic.Width > IWidth) and // нужно ли разделять по оси Х
(Picture.Graphic.Width mod IWidth = 0);
SubDivideY := (Picture.Graphic.Height > IHeight) and // нужно ли разделять по оси Y
(Picture.Graphic.Height mod IHeight = 0);
if SubDivideX then
DivideX := Picture.Graphic.Width div IWidth
else
DivideX := 1;
if SubDivideY then
DivideY := Picture.Graphic.Height div IHeight
else
DivideY := 1;
// если надо, то спросим об этом у пользователя
if SubDivideX or SubDivideY then
begin
...
DialogResult := MessageDlg(Format(SImageListDivide,
[ExtractFileName(Files[I]), DivideX * DivideY]), mtInformation,
[mbYes, mbNo], 0);
end
else
if DialogResult = mrYes then DialogResult := mrNo;
// если не надо, вырежем только одну
if DialogResult in [mrNo, mrNoToAll] then
begin
DivideX := 1; //!
DivideY := 1; //!
IWidth := Picture.Bitmap.Width;
IHeight := Picture.Bitmap.Height;
end;
...
for Y := 0 to DivideY - 1 do
for X := 0 to DivideX - 1 do
begin
// собстевенно процесс добавления картинок путем вырезания из старой
{ Add new bitmap if necessary }
if NewBitmaps.Count <= (Y * DivideX + X) then
begin
NewBitmap := TBitmap.Create;
NewBitmaps.Add(NewBitmap);
end
else
NewBitmap := TBitmap(NewBitmaps[Y * DivideX + X]);
NewBitmap.Assign(Nil);
NewBitmap.Height := IHeight;
NewBitmap.Width := IWidth;
NewBitmap.Canvas.CopyRect(Rect(0, 0, NewBitmap.Width,
NewBitmap.Height), Picture.Bitmap.Canvas,
Rect(X * IWidth, Y * IHeight, (X + 1) * IWidth,
(Y + 1) * IHeight));
end;
...
|
попробуй сделать по образу и подобию. Писать код примера сейчас ужасно лень... |