unit PngImageListEditor;

interface

uses
  Windows, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
  ExtDlgs, pngimage, PngFunctions, PngBitBtn, PngImageList, Buttons;

type
  TPngImageListEditorDlg = class(TForm)
    cmbBackgroundColor: TComboBox;
    cmbPreviewBackground: TComboBox;
    dlgColor: TColorDialog;
    dlgOpenPicture: TOpenPictureDialog;
    edtName: TEdit;
    gbxImageInfo: TGroupBox;
    gbxProperties: TGroupBox;
    lblBackgroundColor: TLabel;
    lblColorDepth: TLabel;
    lblColorDepthValue: TLabel;
    lblCompression: TLabel;
    lblCompressionValue: TLabel;
    lblDimensions: TLabel;
    lblDimensionsValue: TLabel;
    lblFiltering: TLabel;
    lblFilteringValue: TLabel;
    lblName: TLabel;
    lblTransparency: TLabel;
    lblTransparencyValue: TLabel;
    lbxImages: TListBox;
    pnlActionButtons: TPanel;
    pnlBackgroundColor: TPanel;
    pnlMain: TPanel;
    btnAdd: TPngBitBtn;
    btnDelete: TPngBitBtn;
    btnReplace: TPngBitBtn;
    btnClear: TPngBitBtn;
    btnUp: TPngBitBtn;
    btnDown: TPngBitBtn;
    Images: TPngImageCollection;
    pnlButtons: TPanel;
    pnlModalButtons: TPanel;
    btnOK: TPngBitBtn;
    btnCancel: TPngBitBtn;
    chkUseFilenames: TCheckBox;
    btnExport: TPngBitBtn;
    btnSelectAll: TPngBitBtn;
    procedure btnAddClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure btnDownClick(Sender: TObject);
    procedure btnReplaceClick(Sender: TObject);
    procedure btnUpClick(Sender: TObject);
    procedure cmbBackgroundColorChange(Sender: TObject);
    procedure cmbBackgroundColorDblClick(Sender: TObject);
    procedure cmbBackgroundColorExit(Sender: TObject);
    procedure cmbPreviewBackgroundChange(Sender: TObject);
    procedure cmbPreviewBackgroundDrawItem(Control: TWinControl; Index: Integer;
      ARect: TRect; State: TOwnerDrawState);
    procedure edtNameChange(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure lbxImagesClick(Sender: TObject);
    procedure lbxImagesDblClick(Sender: TObject);
    procedure lbxImagesDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure lbxImagesDrawItem(Control: TWinControl; Index: Integer;
      ARect: TRect; State: TOwnerDrawState);
    procedure lbxImagesEnter(Sender: TObject);
    procedure lbxImagesExit(Sender: TObject);
    procedure lbxImagesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure lbxImagesMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
    procedure lbxImagesMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure lbxImagesStartDrag(Sender: TObject; var DragObject: TDragObject);
    procedure btnExportClick(Sender: TObject);
    procedure btnSelectAllClick(Sender: TObject);
  private
    FDraggingIndex: Integer;
    FImageHeight: Integer;
    FImageWidth: Integer;
    FMaxWidth: Integer;
    FSelectionBodyColor: TColor;
    FSelectionBorderColor: TColor;
    function ConformDimensions(Png: TPngImage): Boolean;
    function ConformAdjustDimensions(Png: TPngImage; const AFileName: string): Boolean;
    function FirstSelected: Integer;
    function LastSelected: Integer;
    procedure DrawBackground(Canvas: TCanvas; const ARect: TRect; ScrollPos, Index: Integer;
      BlendColor: TColor = clNone; IgnoreScrollPos: Boolean = False);
    procedure GetColorProc(const S: string);
    procedure ParseBackgroundColor(Sender: TObject; CanDisplayError, CanChangeText: Boolean);
    procedure SelectBackgroundColor(Sender: TObject; Color: TColor);
  public
    property ImageHeight: Integer read FImageHeight write FImageHeight;
    property ImageWidth: Integer read FImageWidth write FImageWidth;
  end;

var
  PngImageListEditorDlg: TPngImageListEditorDlg;

implementation

{$WARN UNIT_PLATFORM OFF}
uses
  SysUtils, Math, FileCtrl, IOUtils;
{$WARN UNIT_PLATFORM ON}

resourcestring
  SAreYouSureYouWantToDelete = 'Are you sure you want to delete %s?';
  SAnd = ' and ';
  SThisWillClearTheEntireImageList = 'This will clear the entire image list. Are you sure you want to do this?';
  SIsNotAValidColorValue = '"%s" is not a valid color value';

{$R *.dfm}

//For calculating OfficeXP colors
const
  WeightR: single = 0.764706;
  WeightG: single = 1.52941;
  WeightB: single = 0.254902;

const
  SIncorrectSize =
    'The selected PNG "%s" must be %dx%d in size, while its actual size is %dx%d';
  SAgustSize = 'Adjust size of imagelist to match loaded image?';
var
  ResX, ResY: Integer;

  { Globals }

function Blend(C1, C2: TColor; W1: Integer): TColor;
var
  W2, A1, A2, D, F, G: Integer;
begin
  if C1 < 0 then
    C1 := GetSysColor(C1 and $FF);
  if C2 < 0 then
    C2 := GetSysColor(C2 and $FF);

  if W1 >= 100 then
    D := 1000
  else
    D := 100;

  W2 := D - W1;
  F := D div 2;

  A2 := C2 shr 16 * W2;
  A1 := C1 shr 16 * W1;
  G := (A1 + A2 + F) div D and $FF;
  Result := G shl 16;

  A2 := (C2 shr 8 and $FF) * W2;
  A1 := (C1 shr 8 and $FF) * W1;
  G := (A1 + A2 + F) div D and $FF;
  Result := Result or G shl 8;

  A2 := (C2 and $FF) * W2;
  A1 := (C1 and $FF) * W1;
  G := (A1 + A2 + F) div D and $FF;
  Result := Result or G;
end;

function ColorDistance(C1, C2: Integer): Single;
var
  DR, DG, DB: Integer;
begin
  DR := (C1 and $FF) - (C2 and $FF);
  Result := Sqr(DR * WeightR);
  DG := (C1 shr 8 and $FF) - (C2 shr 8 and $FF);
  Result := Result + Sqr(DG * WeightG);
  DB := (C1 shr 16) - (C2 shr 16);
  Result := Result + Sqr(DB * WeightB);
  Result := Sqrt(Result);
end;

function GetAdjustedThreshold(BkgndIntensity, Threshold: Single): Single;
begin
  if BkgndIntensity < 220 then
    Result := (2 - BkgndIntensity / 220) * Threshold
  else
    Result := Threshold;
end;

function IsContrastEnough(AColor, ABkgndColor: Integer; DoAdjustThreshold: Boolean; Threshold: Single): Boolean;
begin
  if DoAdjustThreshold then
    Threshold := GetAdjustedThreshold(ColorDistance(ABkgndColor, $000000),
      Threshold);
  Result := ColorDistance(ABkgndColor, AColor) > Threshold;
end;

procedure AdjustContrast(var AColor: Integer; ABkgndColor: Integer; Threshold: Single);
var
  X, Y, Z: Single;
  R, G, B: Single;
  RR, GG, BB: Integer;
  I1, I2, S, Q, W: Single;
  DoInvert: Boolean;
begin
  I1 := ColorDistance(AColor, $000000);
  I2 := ColorDistance(ABkgndColor, $000000);
  Threshold := GetAdjustedThreshold(I2, Threshold);

  if I1 > I2 then
    DoInvert := I2 < 442 - Threshold
  else
    DoInvert := I2 < Threshold;

  X := (ABkgndColor and $FF) * WeightR;
  Y := (ABkgndColor shr 8 and $FF) * WeightG;
  Z := (ABkgndColor shr 16) * WeightB;

  R := (AColor and $FF) * WeightR;
  G := (AColor shr 8 and $FF) * WeightG;
  B := (AColor shr 16) * WeightB;

  if DoInvert then begin
    R := 195 - R;
    G := 390 - G;
    B := 65 - B;
    X := 195 - X;
    Y := 390 - Y;
    Z := 65 - Z;
  end;

  S := Sqrt(Sqr(B) + Sqr(G) + Sqr(R));
  if S < 0.01 then
    S := 0.01;

  Q := (R * X + G * Y + B * Z) / S;

  X := Q / S * R - X;
  Y := Q / S * G - Y;
  Z := Q / S * B - Z;

  W := Sqrt(Sqr(Threshold) - Sqr(X) - Sqr(Y) - Sqr(Z));

  R := (Q - W) * R / S;
  G := (Q - W) * G / S;
  B := (Q - W) * B / S;

  if DoInvert then begin
    R := 195 - R;
    G := 390 - G;
    B := 65 - B;
  end;

  if R < 0 then
    R := 0
  else if R > 195 then
    R := 195;
  if G < 0 then
    G := 0
  else if G > 390 then
    G := 390;
  if B < 0 then
    B := 0
  else if B > 65 then
    B := 65;

  RR := Trunc(R * (1 / WeightR) + 0.5);
  GG := Trunc(G * (1 / WeightG) + 0.5);
  BB := Trunc(B * (1 / WeightB) + 0.5);

  if RR > $FF then
    RR := $FF
  else if RR < 0 then
    RR := 0;
  if GG > $FF then
    GG := $FF
  else if GG < 0 then
    GG := 0;
  if BB > $FF then
    BB := $FF
  else if BB < 0 then
    BB := 0;

  AColor := (BB and $FF) shl 16 or (GG and $FF) shl 8 or (RR and $FF);
end;

procedure SetContrast(var Color: TColor; BkgndColor: TColor; Threshold: Integer);
var
  T: Single;
begin
  if Color < 0 then
    Color := GetSysColor(Color and $FF);
  if BkgndColor < 0 then
    BkgndColor := GetSysColor(BkgndColor and $FF);
  T := Threshold;
  if not IsContrastEnough(Color, BkgndColor, True, T) then
    AdjustContrast(Integer(Color), BkgndColor, T);
end;

function ResizeProportionalX(InitialValue: Integer): Integer;
begin
  Result := InitialValue * ResX div 96;
end;

function ResizeProportionalY(InitialValue: Integer): Integer;
begin
  Result := InitialValue * ResY div 96;
end;

procedure InitResolution;
var
  DC: HDC;
begin
  DC := GetDC(0);
  ResX := GetDeviceCaps(DC, LOGPIXELSX);
  ResY := GetDeviceCaps(DC, LOGPIXELSY);
  ReleaseDC(0, DC);
end;

{ TPngImageListEditorDlg }

function TPngImageListEditorDlg.ConformDimensions(Png: TPngImage): Boolean;
begin
  //Returns whether an image conforms the specified dimensions, if available
  Result := ((ImageHeight = 0) and (ImageWidth = 0)) or ((ImageHeight =
    Png.Height) and (ImageWidth = Png.Width));
end;

function TPngImageListEditorDlg.FirstSelected: Integer;
begin
  //Return the first selected image
  Result := 0;
  while not lbxImages.Selected[Result] and (Result < lbxImages.Items.Count) do
    Inc(Result);
end;

function TPngImageListEditorDlg.LastSelected: Integer;
begin
  //Return the last selected image
  Result := lbxImages.Items.Count - 1;
  while not lbxImages.Selected[Result] and (Result >= 0) do
    Dec(Result);
end;

procedure TPngImageListEditorDlg.DrawBackground(Canvas: TCanvas; const ARect: TRect;
    ScrollPos, Index: Integer; BlendColor: TColor; IgnoreScrollPos: Boolean);
var
  I, X, Y: Integer;
  PatBitmap, BkBitmap: TBitmap;
  Even: Boolean;
begin
  //Draw the background of the listbox, if any
  if Index = 0 then begin
    //No background, then skip the hard part
    if BlendColor = clNone then
      Canvas.Brush.Color := clWindow
    else
      Canvas.Brush.Color := BlendColor;
    Canvas.FillRect(ARect);
    Exit;
  end;

  //Draw the background
  BkBitmap := TBitmap.Create;
  PatBitmap := TBitmap.Create;
  try
    PatBitmap.Height := 16;
    PatBitmap.Width := 16;
    with PatBitmap.Canvas do begin
      //First, draw the background for the pattern bitmap
      if BlendColor = clNone then begin
        Brush.Color := clWindow;
        FillRect(Rect(0, 0, PatBitmap.Height, PatBitmap.Width));
        Brush.Color := Blend(clWindow, clBtnFace, 50);
      end
      else begin
        Brush.Color := Blend(clWindow, BlendColor, 50);
        FillRect(Rect(0, 0, PatBitmap.Height, PatBitmap.Width));
        Brush.Color := BlendColor;
      end;

      //Then, draw the foreground on the pattern bitmap
      Pen.Color := Brush.Color;
      case Index of
        1: begin
            //Checkerboard background
            FillRect(Rect(PatBitmap.Width div 2, 0, PatBitmap.Width, PatBitmap.Height div 2));
            FillRect(Rect(0, PatBitmap.Height div 2, PatBitmap.Width div 2, PatBitmap.Height));
          end;
        2: begin
            //Diamonds background
            PatBitmap.Width := 10;
            PatBitmap.Height := 10;
            Polygon([Point(PatBitmap.Width div 2, 0), Point(PatBitmap.Width,
                PatBitmap.Height div 2), Point(PatBitmap.Width div 2,
                PatBitmap.Height), Point(0, PatBitmap.Height div 2)]);
          end;
        3: begin
            //Slashed background
            Even := True;
            I := 2;
            while I < PatBitmap.Width + PatBitmap.Height do begin
              if I < PatBitmap.Width then begin
                MoveTo(I, 0);
                LineTo(-1, I + 1);
              end
              else begin
                MoveTo(PatBitmap.Width, I - PatBitmap.Width);
                LineTo(I - PatBitmap.Width, PatBitmap.Height);
              end;
              if Even then
                Inc(I, 1)
              else
                Inc(I, 3);
              Even := not Even;
            end;
          end;
        4: begin
            //Backslashed background
            Even := True;
            I := 2;
            while I < PatBitmap.Width + PatBitmap.Height do begin
              if I < PatBitmap.Width then begin
                MoveTo(I, 0);
                LineTo(PatBitmap.Width, PatBitmap.Height - I);
              end
              else begin
                MoveTo(0, I - PatBitmap.Width - 1);
                LineTo(PatBitmap.Width - (I - PatBitmap.Width) + 1,
                  PatBitmap.Height);
              end;
              if Even then
                Inc(I, 1)
              else
                Inc(I, 3);
              Even := not Even;
            end;
          end;
      end;
    end;

    //The actual background bitmap, its width and height are increased to compensate
    //for scrolling distance
    BkBitmap.Width := ARect.Left mod PatBitmap.Width + ARect.Right - ARect.Left;
    if IgnoreScrollPos then
      ScrollPos := 0
    else
      ScrollPos := (ARect.Top + ScrollPos) mod PatBitmap.Height;
    BkBitmap.Height := ScrollPos + ARect.Bottom - ARect.Top;

    //Now repeat the pattern bitmap onto the background bitmap
    with BkBitmap.Canvas do begin
      Y := 0;
      while Y < BkBitmap.Height do begin
        X := 0;
        while X < BkBitmap.Width do begin
          Draw(X, Y, PatBitmap);
          Inc(X, PatBitmap.Width);
        end;
        Inc(Y, PatBitmap.Height);
      end;
    end;

    //And finally, draw the background bitmap to the canvas
    BitBlt(Canvas.Handle, ARect.Left, ARect.Top, ARect.Right - ARect.Left,
      ARect.Bottom - ARect.Top, BkBitmap.Canvas.Handle, ARect.Left mod
      PatBitmap.Width, ScrollPos, SRCCOPY);
  finally
    BkBitmap.Free;
    PatBitmap.Free;
  end;
end;

//Method for getting color values

procedure TPngImageListEditorDlg.GetColorProc(const S: string);
begin
  cmbBackgroundColor.Items.Add(S);
end;

//Parse a background color name or code

procedure TPngImageListEditorDlg.ParseBackgroundColor(Sender: TObject; CanDisplayError, CanChangeText: Boolean);
var
  S: string;
  I, ParsedColor: Integer;
begin
  with cmbBackgroundColor do begin
    //First, see if its a known color name
    if IdentToColor(Text, ParsedColor) then begin
      ItemIndex := Items.IndexOf(Text);
      pnlBackgroundColor.Color := ParsedColor;
    end
    else begin
      S := Text;
      //Replace # with $ so StringToColor recognizes it
      if (Length(S) > 0) and (S[1] = '#') then
        S[1] := '$';
      try
        //Try to convert to a real color value
        ParsedColor := StringToColor(S);
        if CanChangeText then begin
          //And try to convert back to an identifier (i.e. if you type in $000000, it'll become clBlack)
          if ColorToIdent(ParsedColor, S) then
            ItemIndex := Items.IndexOf(S)
          else
            Text := S;
        end;
        pnlBackgroundColor.Color := ParsedColor;
      except
        //If it fails, display a message if neccesary
        on EConvertError do
          if CanDisplayError then begin
            MessageBox(Self.Handle,
              PChar(Format(SIsNotAValidColorValue, [Text])),
              PChar(Self.Caption), MB_ICONERROR or MB_OK);
            SetFocus;
          end;
      end;
    end;
  end;
  //And finally, set the background color to every selected image
  if (Sender <> lbxImages) then
    for I := 0 to lbxImages.Items.Count - 1 do
      if lbxImages.Selected[I] then
        Images.Items[I].Background := pnlBackgroundColor.Color;
end;

procedure TPngImageListEditorDlg.SelectBackgroundColor(Sender: TObject; Color: TColor);
var
  S: string;
begin
  //This happens after a background color has been slected from the color dialog
  //Try to convert a color into an identifier, or else into a hexadecimal representation
  if ColorToIdent(Color, S) then
    cmbBackgroundColor.ItemIndex := cmbBackgroundColor.Items.IndexOf(S)
  else
    cmbBackgroundColor.Text := '$' + IntToHex(dlgColor.Color, 6);
  ParseBackgroundColor(Sender, False, True);
end;

procedure TPngImageListEditorDlg.btnAddClick(Sender: TObject);
var
  Png: TPngImageCollectionItem;
  I, Selected, FirstSelected: Integer;
begin
  //The Add button is pressed, let the programmer look for an image
  dlgOpenPicture.Options := dlgOpenPicture.Options + [ofAllowMultiSelect];
  if dlgOpenPicture.Execute then begin
    for I := 0 to lbxImages.Items.Count - 1 do
      lbxImages.Selected[I] := False;
    FirstSelected := -1;
    for I := 0 to dlgOpenPicture.Files.Count - 1 do begin
      Png := Images.Items.Add;
      with Png.PngImage do begin
        //Load the image, but remove any gamma, so that the gamma won't be reapplied
        //when loading the image from the DFM
        LoadFromFile(dlgOpenPicture.Files[I]);
        if Png.PngImage.Header.ColorType in [COLOR_RGB, COLOR_RGBALPHA,
          COLOR_PALETTE] then
          Chunks.RemoveChunk(Chunks.ItemFromClass(TChunkgAMA));
      end;
      //Does the image conform the specified dimensions, if any?
      if ConformAdjustDimensions(Png.PngImage, ExtractFilename(dlgOpenPicture.Files[I])) then begin
        //Update maximum image width
        if FMaxWidth < Png.PngImage.Width then
          FMaxWidth := Png.PngImage.Width;

        //Invent a name for the image, and initialize its background color
        if chkUseFilenames.Checked then
          Png.Name := ChangeFileExt(ExtractFileName(dlgOpenPicture.Files[I]), '')
        else
          Png.Name := 'PngImage' + IntToStr(Images.Items.Count - 1); // do not localize
        Png.Background := clWindow;

        //Finally, add it and select it
        Selected := lbxImages.Items.AddObject(Png.Name, Png);
        lbxImages.Selected[Selected] := True;
        if FirstSelected = -1 then
          FirstSelected := Selected;
      end
      else begin
        //The image does not conform the specified dimensions
        Images.Items.Delete(Png.Index);
      end;
    end;

    //Focus the first selected (added) image
    lbxImages.ItemIndex := FirstSelected;
    lbxImages.SetFocus;
    lbxImagesClick(nil);
  end;
end;

procedure TPngImageListEditorDlg.btnClearClick(Sender: TObject);
begin
  //Clear the listbox and the collection
  if (lbxImages.Items.Count > 0) and (MessageBox(Handle,
    PChar(SThisWillClearTheEntireImageList),
    PChar(Self.Caption), MB_ICONEXCLAMATION or MB_YESNO or MB_DEFBUTTON2) =
    IDYES) then begin
    lbxImages.Items.Clear;
    Images.Items.Clear;
    lbxImagesClick(nil);
  end;
end;

procedure TPngImageListEditorDlg.btnDeleteClick(Sender: TObject);

  function GetCommaList: string;
  var
    I: Integer;
    S: TStringList;
  begin
    //Get a comma list of the names of the selected images in the form "name1,
    //name2 and name3"
    Result := '';
    S := TStringList.Create;
    try
      for I := 0 to lbxImages.Items.Count - 1 do
        if lbxImages.Selected[I] then
          S.Add(Images.Items[I].Name);
      for I := 0 to S.Count - 1 do begin
        Result := Result + S[I];
        if I < S.Count - 2 then
          Result := Result + ', '
        else if I < S.Count - 1 then
          Result := Result + SAnd;
      end;
    finally
      S.Free;
    end;
  end;

var
  I, NewIndex: Integer;
begin
  with lbxImages do
    if (SelCount > 0) and (MessageBox(Handle,
      PChar(Format(SAreYouSureYouWantToDelete, [GetCommaList])),
      PChar(Self.Caption), MB_ICONEXCLAMATION or MB_YESNO) = IDYES) then begin
      //Delete every selected image from the listbox and from the collection
      NewIndex := -1;
      I := 0;
      while I < Items.Count do
        if Selected[I] then begin
          if NewIndex = -1 then
            NewIndex := I;
          lbxImages.Items.Delete(I);
          Images.Items.Delete(I);
        end
        else
          Inc(I);

      //Figure out the new selection index
      if NewIndex > Items.Count - 1 then
        NewIndex := Items.Count - 1
      else if (NewIndex = -1) and (Items.Count > 0) then
        NewIndex := 0;
      Selected[NewIndex] := True;
      ItemIndex := NewIndex;
      lbxImagesClick(nil);
    end;
end;

procedure TPngImageListEditorDlg.btnDownClick(Sender: TObject);
var
  I: Integer;
begin
  //Move the selected items one position down
  with lbxImages do
    if (SelCount > 0) and (LastSelected < Items.Count - 1) then
      for I := Items.Count - 1 downto 0 do
        if Selected[I] then begin
          Images.Items[I].Index := I + 1;
          Items.Exchange(I, I + 1);
          Selected[I + 1] := True;
        end;
  lbxImagesClick(nil);
end;

procedure TPngImageListEditorDlg.btnExportClick(Sender: TObject);
var
  Directory, FileName: string;
  Item: TPngImageCollectionItem;
  I: Integer;
begin
  if SelectDirectory('Select directory to save exported images to', '', Directory, [sdNewFolder, sdShowEdit, sdNewUI, sdValidateDir]) then
  begin
    for I := 0 to lbxImages.Items.Count - 1 do
    begin
      if lbxImages.Selected[I] then
      begin
        Item := Images.Items[I];
        FileName := TPath.Combine(Directory, Item.Name + '.png');
        Item.PngImage.SaveToFile(FileName);
      end;
    end;
  end;
end;

procedure TPngImageListEditorDlg.btnReplaceClick(Sender: TObject);
var
  Item: TPngImageCollectionItem;
  Index: Integer;
  Png: TPngImage;
begin
  //The Replace button is pressed, let the programmer look for an image
  Index := FirstSelected;
  Item := Images.Items[Index];
  dlgOpenPicture.FileName := Item.Name;
  dlgOpenPicture.Options := dlgOpenPicture.Options - [ofAllowMultiSelect];
  with lbxImages do
    if (SelCount = 1) and dlgOpenPicture.Execute then begin
      Png := TPngImage.Create;
      try
        //First see if the image conforms the specified dimensions
        Png.LoadFromFile(dlgOpenPicture.Filename);
        if ConformDimensions(Png) then begin
          //Then remove any gamma, so that the gamma won't be reapplied when loading the
          //image from the DFM
          if Png.Header.ColorType in [COLOR_RGB, COLOR_RGBALPHA] then
            Png.Chunks.RemoveChunk(Png.Chunks.ItemFromClass(TChunkgAMA));
          Item.PngImage := Png;

          //Update the maximum image width
          if FMaxWidth < Item.PngImage.Width then
            FMaxWidth := Item.PngImage.Width;

          //Repaint and update everything, to be sure
          lbxImages.Repaint;
          lbxImagesClick(nil);
        end
        else
          MessageBox(Handle, PChar(Format(SIncorrectSize,
            [ExtractFilename(dlgOpenPicture.Filename), ImageWidth, ImageHeight,
            Png.Width, Png.Height])), PChar(Caption), MB_ICONERROR or MB_OK);
      finally
        Png.Free;
      end;
    end;
end;

procedure TPngImageListEditorDlg.btnSelectAllClick(Sender: TObject);
begin
  lbxImages.SelectAll;
  lbxImagesClick(nil);
end;

procedure TPngImageListEditorDlg.btnUpClick(Sender: TObject);
var
  I: Integer;
begin
  //Move the selected items one position up
  with lbxImages do
    if (SelCount > 0) and (FirstSelected > 0) then
      for I := 0 to Items.Count - 1 do
        if Selected[I] then begin
          Images.Items[I].Index := I - 1;
          Items.Exchange(I, I - 1);
          Selected[I - 1] := True;
        end;
  lbxImagesClick(nil);
end;

procedure TPngImageListEditorDlg.cmbBackgroundColorChange(Sender: TObject);
begin
  //While typing, try parsing the background color, but without any error messages
  ParseBackgroundColor(Sender, False, False);
end;

procedure TPngImageListEditorDlg.cmbBackgroundColorDblClick(Sender: TObject);
begin
  //Just like in Delphi, when doubleclicking a color, the color dialog pops up
  dlgColor.Color := pnlBackgroundColor.Color;
  if dlgColor.Execute then
    SelectBackgroundColor(Sender, dlgColor.Color);
end;

procedure TPngImageListEditorDlg.cmbBackgroundColorExit(Sender: TObject);
begin
  //When leaving the background combobox, parse the color, but this with error
  //message, if neccesary
  ParseBackgroundColor(Sender, True, True);
end;

procedure TPngImageListEditorDlg.cmbPreviewBackgroundChange(Sender: TObject);
begin
  //Pewview background is changes, repaint all items
  lbxImages.Repaint;
end;

procedure TPngImageListEditorDlg.cmbPreviewBackgroundDrawItem(Control: TWinControl;
    Index: Integer; ARect: TRect; State: TOwnerDrawState);
var
  IconWidth: Integer;
begin
  with cmbPreviewBackground do begin
    //Draw the background "icon" of the preview background combobox
    IconWidth := (ARect.Bottom - ARect.Top) * 4 div 3;
    DrawBackground(Canvas, Rect(ARect.Left, ARect.Top, ARect.Left + IconWidth, ARect.Bottom),
      0, Index, clNone, True);
    Inc(ARect.Left, IconWidth);

    //Background color of the rest of the item
    if odSelected in State then
      Canvas.Brush.Color := clHighlight
    else
      Canvas.Brush.Color := clWindow;
    Canvas.FillRect(ARect);
    Inc(ARect.Left, 4);

    //And the text
    DrawText(Canvas.Handle, PChar(Items[Index]), -1, ARect, DT_LEFT or DT_NOPREFIX
      or DT_SINGLELINE or DT_VCENTER);

    Canvas.Brush.Color := clWindow;
  end;
end;

{ TPngImageListEditorDlg }

function TPngImageListEditorDlg.ConformAdjustDimensions(Png: TPngImage; const AFileName: string): Boolean;
begin
  Result := ConformDimensions(Png);
  if not Result then begin
    if Images.Items.Count = 1 then begin
      { The image does not conform the specified dimensions, but is the first image loaded.
        We offer to adjust the image size of the imagelist to the size of the just loaded image. }
      if MessageBox(Handle, PChar(Format(SIncorrectSize + #13 + SAgustSize,
        [AFileName, ImageWidth, ImageHeight,
        Png.Width, Png.Height])), PChar(Caption), MB_ICONQUESTION or MB_YESNO) = mrYes then begin
        ImageWidth := Png.Width;
        ImageHeight := Png.Height;
        Result := True;
      end;
    end
    else begin
      { The image does not conform the specified dimensions }
      MessageBox(Handle, PChar(Format(SIncorrectSize,
        [AFileName, ImageWidth, ImageHeight,
        Png.Width, Png.Height])), PChar(Caption), MB_ICONERROR or MB_OK);
    end;
  end;
end;

procedure TPngImageListEditorDlg.edtNameChange(Sender: TObject);
begin
  //Update the selected image with the entered name, in realtime
  with lbxImages do
    if ItemIndex >= 0 then begin
      Images.Items[ItemIndex].Name := edtName.Text;
      Items[ItemIndex] := edtName.Text;
    end;
end;

procedure TPngImageListEditorDlg.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TPngImageListEditorDlg.FormCreate(Sender: TObject);
var
  Space8H: Integer;
begin
  //Initialize OfficeXP colors for selection
  FSelectionBodyColor := Blend(clHighlight, clWindow, 30);
  SetContrast(FSelectionBodyColor, Blend(clWindow, clBtnFace, 165), 50);
  FSelectionBorderColor := clHighlight;

  //Initialize a value that keeps track of dragging
  FDraggingIndex := -1;

  //Get all available color names
  GetColorValues(GetColorProc);

  //Initialize the background to clWindow
  cmbBackgroundColor.ItemIndex := cmbBackgroundColor.Items.IndexOf('clWindow'); // do not localize
  cmbBackgroundColorChange(nil);

  //Do not specify image width and height by default (the imagelist will fill
  //these up, so that you cannot select an image other than these dimensions)
  ImageWidth := 0;
  ImageHeight := 0;

  //Resize everything to make it fit on "large fonts" setting. Note that these
  //operations are also needed on normal setting.
  Space8H := lbxImages.Top;
  Width := ResizeProportionalX(Width);
  Height := ResizeProportionalY(Height);
  Constraints.MinHeight := gbxProperties.Top + cmbBackgroundColor.Top +
    cmbBackgroundColor.Height + Space8H + Space8H + gbxImageInfo.Height + Space8H
    + (Height - pnlMain.Height);
  Constraints.MinWidth := Width;
  pnlButtons.Align := alBottom;
  pnlMain.Align := alClient;
  cmbPreviewBackground.ItemHeight :=
    ResizeProportionalY(cmbPreviewBackground.ItemHeight);
  pnlBackgroundColor.Height := cmbBackgroundColor.Height;

  //Make sure the background color isn't reset when themes are enabled
  pnlBackgroundColor.ParentBackground := True;
  pnlBackgroundColor.ParentBackground := False;
end;

procedure TPngImageListEditorDlg.FormResize(Sender: TObject);
begin
  //There appears to be a bug that prevents a listbox from being redrawn correctly
  //when the form is resized
  lbxImages.Repaint;
end;

procedure TPngImageListEditorDlg.FormShow(Sender: TObject);
var
  I: Integer;
begin
  //Initialize the maximum width of the images, to align text in the listbox
  FMaxWidth := 0;
  for I := 0 to Images.Items.Count - 1 do
    if Images.Items[I].PngImage.Width > FMaxWidth then
      FMaxWidth := Images.Items[I].PngImage.Width;

  //Fill the listbox with the images
  for I := 0 to Images.Items.Count - 1 do
    lbxImages.Items.AddObject(Images.Items[I].Name, Images.Items[I]);
  if lbxImages.Items.Count > 0 then begin
    lbxImages.Selected[0] := True;
    lbxImages.ItemIndex := 0;
  end;
  lbxImages.SetFocus;
  lbxImagesClick(nil);

  cmbPreviewBackground.ItemIndex := 0;
  FormResize(nil);
end;

procedure TPngImageListEditorDlg.lbxImagesClick(Sender: TObject);

  function GetDimensions(Png: TPngImage): string;
  begin
    //Return the formatted dimensions of an image
    Result := Format('%dx%d', [Png.Width, Png.Height]);
    if Png.InterlaceMethod <> imNone then
      Result := Result + ' interlace';
  end;

  function GetColorDepth(Png: TPngImage): string;
  begin
    //Return the color depth, including whether the image is grayscale or paletted
    case Png.Header.ColorType of
      COLOR_GRAYSCALE, COLOR_GRAYSCALEALPHA:
        Result := Format('%d-bits grayscale', [Png.Header.BitDepth]);
      COLOR_RGB, COLOR_RGBALPHA:
        Result := Format('%d-bits', [Png.Header.BitDepth * 3]);
      COLOR_PALETTE:
        Result := Format('%d-bits paletted', [Png.Header.BitDepth]);
    end;
  end;

  function GetTransparency(Png: TPngImage): string;
  begin
    //Return the formatted transparency depth, or transparency mode
    if Png.Header.ColorType in [COLOR_GRAYSCALEALPHA, COLOR_RGBALPHA] then
      Result := Format('%d-bits alpha', [Png.Header.BitDepth])
    else
      case Png.TransparencyMode of
        ptmBit: Result := 'bitmask';
        ptmPartial: Result := 'indexed';
      else
        Result := 'none';
      end;
  end;

  function GetCompression(Png: TPngImage): string;
  begin
    //Return the formatted compression level
    Result := Format('level %d', [Png.CompressionLevel]);
  end;

  function GetFiltering(Png: TPngImage): string;
  begin
    //Return the formatted filtering method
    case Png.Header.FilterMethod of
      FILTER_SUB: Result := 'sub';
      FILTER_UP: Result := 'up';
      FILTER_AVERAGE: Result := 'average';
      FILTER_PAETH: Result := 'paeth';
    else
      Result := 'none';
    end;
  end;

  function SameBackgroundColor: Boolean;
  var
    FirstBgColor: TColor;
    I: Integer;
    First: Boolean;
  begin
    //Determine whether the background color of all selected images is the same
    FirstBgColor := clNone;
    First := True;
    Result := True;
    for I := 0 to lbxImages.Items.Count - 1 do
      if lbxImages.Selected[I] then
        if First then begin
          //Found the first selected and its background color
          FirstBgColor := Images.Items[I].Background;
          First := False;
        end
        else begin
          //If not equal to first background color, then break, continue otherwise
          Result := FirstBgColor = Images.Items[I].Background;
          if not Result then
            Break;
        end;
  end;

const
  NoneSelected = '[ none ]';
  MultipleSelected = '[ multiple ]';
begin
  with lbxImages do begin
    //Refresh the enabled state of the buttons and controls
    btnReplace.Enabled := SelCount = 1;
    btnDelete.Enabled := SelCount > 0;
    btnClear.Enabled := Items.Count > 0;
    btnUp.Enabled := (SelCount > 0) and (FirstSelected > 0);
    btnDown.Enabled := (SelCount > 0) and (LastSelected < Items.Count - 1);
    btnExport.Enabled := (SelCount > 0);
    btnSelectAll.Enabled := (SelCount > 0) and (SelCount < Items.Count);
    lblName.Enabled := SelCount = 1;
    edtName.Enabled := SelCount = 1;
    lblBackgroundColor.Enabled := SelCount > 0;
    cmbBackgroundColor.Enabled := SelCount > 0;
    case SelCount of
      0: begin
          //None is selected, so no information to display
          lblDimensionsValue.Caption := NoneSelected;
          lblColorDepthValue.Caption := NoneSelected;
          lblTransparencyValue.Caption := NoneSelected;
          lblCompressionValue.Caption := NoneSelected;
          lblFilteringValue.Caption := NoneSelected;
        end;
      1: with Images.Items[FirstSelected] do begin
          edtName.OnChange := nil;
          try
            //One item is selected, display its properties and information
            edtName.Text := Name;
            SelectBackgroundColor(Sender, Background);
            lblDimensionsValue.Caption := GetDimensions(PngImage);
            lblColorDepthValue.Caption := GetColorDepth(PngImage);
            lblTransparencyValue.Caption := GetTransparency(PngImage);
            lblCompressionValue.Caption := GetCompression(PngImage);
            lblFilteringValue.Caption := GetFiltering(PngImage);
          finally
            edtName.OnChange := edtNameChange;
          end;
        end;
    else begin
        //More than 1 is selected, so no image information can be displayed
        if SameBackgroundColor then
          SelectBackgroundColor(Sender, Images.Items[FirstSelected].Background)
        else
          SelectBackgroundColor(Sender, clNone);
        lblDimensionsValue.Caption := MultipleSelected;
        lblColorDepthValue.Caption := MultipleSelected;
        lblTransparencyValue.Caption := MultipleSelected;
        lblCompressionValue.Caption := MultipleSelected;
        lblFilteringValue.Caption := MultipleSelected;
      end;
    end;
  end;
end;

procedure TPngImageListEditorDlg.lbxImagesDblClick(Sender: TObject);
begin
  //Doubleclicking is the same as the Replace button
  if lbxImages.SelCount = 1 then
    btnReplaceClick(nil);
end;

procedure TPngImageListEditorDlg.lbxImagesDragOver(Sender, Source: TObject;
    X, Y: Integer; State: TDragState; var Accept: Boolean);

  procedure MoveItem(Index, Delta: Integer);
  begin
    //Move a single item up or down, depending on Delta
    if lbxImages.Selected[Index] then begin
      Images.Items[Index].Index := Index + Delta;
      lbxImages.Items.Exchange(Index, Index + Delta);
      lbxImages.Selected[Index + Delta] := True;
    end;
  end;

  function InRange(Index: Integer): Boolean;
  begin
    //Return whether Index exists in the listbox
    Result := (Index >= 0) and (Index < lbxImages.Items.Count);
  end;

var
  NewIndex, NewItemIndex, Delta, I: Integer;
begin
  Accept := FDraggingIndex >= 0;
  if Accept then begin
    //Figure out to which index is dragged
    NewIndex := lbxImages.ItemAtPos(Point(X, Y), False);
    if NewIndex > lbxImages.Items.Count - 1 then
      NewIndex := lbxImages.Items.Count - 1;

    //Figure out the distance (delta) of the drag
    Delta := NewIndex - FDraggingIndex;

    //The destination index has to exist and has to be differend from where we
    //started the drag. On to pof that, the drag destination of the first and
    //last selected items have to be in range.
    if (NewIndex >= 0) and (NewIndex <> FDraggingIndex) and InRange(FirstSelected
      + Delta) and InRange(LastSelected + Delta) then begin
      //Calc the new focus index
      NewItemIndex := lbxImages.ItemIndex + Delta;

      //To prevent things to get messed up, moving downwards needs walking through the
      //images in opposite direction
      if Delta < 0 then
        for I := 0 to lbxImages.Items.Count - 1 do
          MoveItem(I, Delta)
      else
        for I := lbxImages.Items.Count - 1 downto 0 do
          MoveItem(I, Delta);

      //Set the new focus index and tracking value of the drag
      lbxImages.ItemIndex := NewItemIndex;
      FDraggingIndex := NewIndex;

      lbxImagesClick(nil);
    end;
  end;
end;

procedure TPngImageListEditorDlg.lbxImagesDrawItem(Control: TWinControl; Index: Integer; ARect: TRect; State: TOwnerDrawState);
var
  DrawRect: TRect;
  ScrollInfo: TScrollInfo;
  I, ScrollPos: Integer;
begin
  //Get the scrolling distance
  ScrollPos := 0;
  ScrollInfo.cbSize := SizeOf(ScrollInfo);
  ScrollInfo.fMask := SIF_POS;
  if GetScrollInfo(lbxImages.Handle, SB_VERT, ScrollInfo) then
    for I := 0 to ScrollInfo.nPos - 1 do
      with lbxImages.ItemRect(I) do
        Inc(ScrollPos, Bottom - Top);

  //First, draw the background
  if odSelected in State then
    if lbxImages.Focused then
      DrawBackground(lbxImages.Canvas, ARect, ScrollPos,
        cmbPreviewBackground.ItemIndex, FSelectionBodyColor)
    else
      DrawBackground(lbxImages.Canvas, ARect, ScrollPos,
        cmbPreviewBackground.ItemIndex, Blend(FSelectionBodyColor, clWindow, 50))
  else
    DrawBackground(lbxImages.Canvas, ARect, ScrollPos,
      cmbPreviewBackground.ItemIndex);
  with lbxImages.Canvas do begin
    //Then, draw a focus border, if focused
    Brush.Style := bsClear;
    if odFocused in State then begin
      if lbxImages.Focused then
        Pen.Color := FSelectionBorderColor
      else
        Pen.Color := Blend(FSelectionBorderColor, clWindow, 50);
      Pen.Style := psSolid;
      Rectangle(ARect);
    end;

    //Draw the image at the center of (ARect.Left, ARect.Top, ARect.Left + FMaxWidth, ARect.Bottom)
    with Images.Items[Index] do begin
      {$IF RTLVersion < 23 }
      if (ARect.Right - ARect.Left) < PngImage.Height then begin
        DrawRect.Left := ARect.Left + 2;
        DrawRect.Top := ARect.Top;
        DrawRect.Right := DrawRect.Left + Round(PngImage.Width * (ARect.Right - ARect.Left)/PngImage.Height);
        DrawRect.Bottom := ARect.Bottom;
      end
      else begin
        DrawRect.Left := ARect.Left + (FMaxWidth - PngImage.Width) div 2 + 2;
        DrawRect.Top := ARect.Top + (ARect.Bottom - ARect.Top - PngImage.Height) div 2;
        DrawRect.Right := DrawRect.Left + PngImage.Width;
        DrawRect.Bottom := DrawRect.Top + PngImage.Height;
      end;
      {$ELSE}
      if ARect.Height < PngImage.Height then begin
        DrawRect.Left := ARect.Left + 2;
        DrawRect.Top := ARect.Top;
        DrawRect.Right := DrawRect.Left + Round(PngImage.Width * ARect.Height/PngImage.Height);
        DrawRect.Bottom := ARect.Bottom;
      end
      else begin
        DrawRect.Left := ARect.Left + (FMaxWidth - PngImage.Width) div 2 + 2;
        DrawRect.Top := ARect.Top + (ARect.Bottom - ARect.Top - PngImage.Height) div 2;
        DrawRect.Right := DrawRect.Left + PngImage.Width;
        DrawRect.Bottom := DrawRect.Top + PngImage.Height;
      end;
      {$IFEND}
      PngImage.Draw(lbxImages.Canvas, DrawRect);
    end;

    //Draw the image index number and the name
    Font.Color := clWindowText;
    DrawRect := Rect(ARect.Left + FMaxWidth + 8, ARect.Top, ARect.Left +
      FMaxWidth + Canvas.TextWidth(IntToStr(lbxImages.Items.Count - 1)) + 8,
      ARect.Bottom);
    DrawText(Handle, PChar(IntToStr(Index)), -1, DrawRect, DT_RIGHT or
      DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER);
    DrawRect.Left := DrawRect.Right;
    DrawRect.Right := ARect.Right;
    DrawText(Handle, PChar(' - ' + Images.Items[Index].Name), -1, DrawRect,
      DT_END_ELLIPSIS or DT_LEFT or DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER);

    //Draw the normal focusrect, so that it'll become invisible
    if (odFocused in State) and lbxImages.Focused then
      DrawFocusRect(ARect);
  end;
end;

procedure TPngImageListEditorDlg.lbxImagesEnter(Sender: TObject);
begin
  //Just to be sure
  lbxImages.Repaint;
end;

procedure TPngImageListEditorDlg.lbxImagesExit(Sender: TObject);
begin
  //Just to be sure
  lbxImages.Repaint;
end;

procedure TPngImageListEditorDlg.lbxImagesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  //I would expect this "ctrl"-navigation would work standardly, but appearantly
  //it doesn't, so we'll have to code it ourselves
  with lbxImages do
    if ssCtrl in Shift then begin
      case Key of
        VK_DOWN: begin
            if ItemIndex < Items.Count - 1 then
              ItemIndex := ItemIndex + 1;
            Key := 0;
          end;
        VK_UP: begin
            if ItemIndex > 0 then
              ItemIndex := ItemIndex - 1;
            Key := 0;
          end;
        VK_SPACE: begin
            Selected[ItemIndex] := not Selected[ItemIndex];
            lbxImagesClick(nil);
            Key := 0;
          end;
      end;
    end;
end;

procedure TPngImageListEditorDlg.lbxImagesMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
var
  Temp: Integer;
begin
  //Figure out the height of an item, when editing an image collection, the height
  //of an image may differ
  Height := Images.Items[Index].PngImage.Height + 4;
  Temp := lbxImages.Canvas.TextHeight('0') + 4;
  if Temp > Height then
    Height := Temp;
  if Height > 255 then
    Height := 255;
end;

procedure TPngImageListEditorDlg.lbxImagesMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  //If the mouse button is released, the tracking value of the drag needs to be
  //reset as well
  FDraggingIndex := -1;
end;

procedure TPngImageListEditorDlg.lbxImagesStartDrag(Sender: TObject; var DragObject: TDragObject);
var
  Pos: TPoint;
begin
  //Figure out where this drag start is
  GetCursorPos(Pos);
  FDraggingIndex := lbxImages.ItemAtPos(lbxImages.ScreenToClient(Pos), True);
  if FDraggingIndex >= 0 then
    lbxImages.ItemIndex := FDraggingIndex;
end;

initialization
  InitResolution;

end.
