Timagelist

koden i den første procedure gemmer billederne fra en imagelist i et bitmap, og den anden kopierer fra samme bitmap, over i en anden imagelist

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ImgList, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ImageList1: TImageList;
    ImageList2: TImageList;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  B: TBitmap;
begin
  //gemmer billederne fra ImageList1 i eet stor bitmap
  B := TBitmap.Create;
  try
    B.Handle := ImageList1.GetImageBitmap;
    B.SaveToFile(\'c:\\images.bmp\');
  finally
    B.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  Source, B: TBitmap;
  i, j, Count: Integer;
begin
  Source := TBitmap.Create;
  try
    Source.LoadFromFile(\'c:\\images.bmp\');

    B := TBitmap.Create;
    try
      B.Width := ImageList1.Width;
      B.Height := ImageList1.Height;

      Count := 0;
      for j := 0 to (Source.Height div ImageList1.Height) - 1 do
        for i := 0 to (Source.Width div ImageList1.Width) - 1 do
        begin
          //klipper bilederne fra det store bitmap ud og gemmer dem i ImageList2
          BitBlt(B.Canvas.Handle, 0, 0, ImageList1.Width, ImageList1.Height,
                Source.Canvas.Handle, i * ImageList1.Width, j * ImageList1.Height, SrcCopy);

          ImageList2.Add(B, nil);

          Inc(Count);
          if Count >= ImageList1.Count then Break;
        end;
    finally
      B.Free;
    end;
  finally
    Source.Free;
  end;
end;

end.

Ved om der findes en modificeret komponent, der giver muligheden?

sikker - ellers er det forholdsvist nemt at lave selv. Du skal bare lave en komponent der arver fra TImageList, og så tilføje de to metoder

her har du den som komponent :
unit NewImageList;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ImgList;

type
  TNewImageList = class(TImageList)
  private
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
    Procedure LoadFromFile(FileName : TFileName);
    Procedure SaveToFile(FileName : TFileName);
  published
    { Published declarations }
  end;

procedure Register;

implementation

Procedure TNewImageList.SaveToFile(FileName : TFileName);
begin
  //gemmer billederne fra ImageList1 i eet stor bitmap
  with TBitmap.Create do
  try
    Handle := GetImageBitmap;
    SaveToFile(FileName);
  finally
    Free;
  end;
end;

Procedure TNewImageList.LoadFromFile(FileName : TFileName);
var
  Source, B: TBitmap;
  i, j, Count: Integer;
begin
  Source := TBitmap.Create;
  try
    Source.LoadFromFile(FileName);

    B := TBitmap.Create;
    try
      B.Width := Width;
      B.Height := Height;

      Count := 0;
      for j := 0 to (Source.Height div Height) - 1 do
        for i := 0 to (Source.Width div Width) - 1 do
        begin
          //klipper bilederne fra det store bitmap ud og gemmer dem i ImageList2
          BitBlt(B.Canvas.Handle, 0, 0, Width, Height,  Source.Canvas.Handle, i * Width, j * Height, SrcCopy);

          Add(B, nil);

          Inc(Count);
          if Count >= Count then
            Break;
        end;
    finally
      B.Free;
    end;
  finally
    Source.Free;
  end;
end;


procedure Register;
begin
  RegisterComponents(\'Samples\', [TNewImageList]);
end;

end.


Jens B

borrisholt>>der er bare det problem, at man ikke ved hvor mange små billeder, det store billede indeholder

joh, det gør man da idet at imagelisten har faste bredder....

hvis du nu har 7 billeder i størrelsen 20 * 20, laver den et billede der er 80 * 40. dvs. der er plads til otte billeder. Så hvis du regner antallet ud ved at bruge de små billeders format i forhold til det store billede, vil du få otte billede hvor det sidste bare er noget flimmer

lukker