{ Add a "picked" color from an TIEBitmap in TImageEnView to a TListView }
{ If color is present in the TListView do not add the color }
{ Uses ImageEn Version 4.3.0 }
{ Compiled with Delphi 2010 in Windows 7 }
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, Buttons, StdCtrls, ExtCtrls, ExtDlgs, ieview, imageenview;
type
TForm1 = class(TForm)
ImageEnView1: TImageEnView;
Panel1: TPanel;
Open1: TButton;
PickColors1: TSpeedButton;
ListView1: TListView;
Clear1: TButton;
OpenPictureDialog1: TOpenPictureDialog;
Shape1: TShape;
procedure ImageEnView1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
procedure Clear1Click(Sender: TObject);
procedure Open1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PickColors1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses imageenio, hyieutils;
function IsColorInListView(AlistView: TListView; AColor: TColor): boolean;
{ Return True is AColor is in a ListView and False if not }
var
i: integer;
begin
{ If there are colors in the list, search the list to see if the color is present }
if AListView.Items.Count > 0 then
begin
for i := 0 to AListView.Items.Count - 1 do
begin
if AlistView.Items.Item[i].SubItems.IndexOf(ColorToString(AColor)) = -1 then
{ Color is not in the list }
Result := False
else
begin
Result := True;
break; { Color is in the list so return true and break }
end;
end;
end
else { No items in the list so return False }
Result := False;
end;
procedure TForm1.Clear1Click(Sender: TObject);
{ Clear the listview }
begin
ListView1.Items.BeginUpdate;
try
ListView1.Items.Clear;
finally
ListView1.Items.EndUpdate;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
{ Set the OpenPictureDialog filter }
begin
{ Register all ImageEn FileFormats with TGraphic }
IERegisterFormats;
OpenPictureDialog1.Filter := GraphicFilter(TGraphic);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
IEUnRegisterFormats;
end;
procedure TForm1.ImageEnView1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
X,
Y: Integer);
{ Pick a pixel color }
var
iListItem: TListItem;
iColor: TColor;
iMessage: PWideChar;
begin
if (PickColors1.Down) and (ImageEnView1.MouseCapture) then { Pick A Color }
begin
{ Get the color under the cursor }
iColor :=
ImageEnView1.IEBitmap.Canvas.Pixels[ImageEnView1.Layers[ImageEnView1.LayersCurrent].ConvXScr2Bmp(X),
ImageEnView1.Layers[ImageEnView1.LayersCurrent].ConvYScr2Bmp(Y)];
Shape1.Brush.Color := iColor;
{ If color is not present in the listview then add the color as a string }
if not IsColorInListView(ListView1, iColor) then
begin
ListView1.Items.BeginUpdate;
try
iListItem := ListView1.Items.Add;
iListItem.Caption := IntToStr(iListItem.Index + 1);
iListItem.SubItems.Add(ColorToString(iColor));
finally
ListView1.Items.EndUpdate;
end;
end
else
begin
iMessage := PWideChar('The selected color '+ ColorToString(iColor) + ' is already in the list');
MessageBox(0, iMessage, 'Warning', MB_ICONWARNING or MB_OK);
end;
end;
end;
procedure TForm1.Open1Click(Sender: TObject);
{ Load an image into ImageEnView }
var
iFilename: string;
begin
if OpenPictureDialog1.Execute then
begin
iFilename := OpenPictureDialog1.Filename;
ImageEnView1.IO.LoadFromFile(iFilename);
ImageEnView1.Update;
Caption := 'Pick Colors- ' + iFilename;
ImageEnView1.Fit;
end;
end;
procedure TForm1.PickColors1Click(Sender: TObject);
{ Make sure MouseInteract is none and set the mousecursor }
{ To use a pick color cursor load it from a resource file. Cursors 1805 and 1806 are not transparent. }
{ This is a bug fix for ImageEn to handle }
begin
if PickColors1.Down then
begin
{ Make sure selection is none }
ImageEnView1.DeSelect;
ImageEnView1.MouseInteract := [];
ImageEnView1.Cursor := crHandPoint;
end
else
ImageEnView1.Cursor := 1784;
end;
end.

56.89 KB
William Miller
Email: w2m@frontiernet.net
EBook: http://www.imageen.com/ebook/
Apprehend: http://www.frontiernet.net/~w2m/index.html