1 unit Unit1;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils, Forms, Controls, Graphics, GraphType, ExtCtrls, StdCtrls,
9 ExtDlgs, LazUTF8;
10
11 type
12
13 { TForm1 }
14
15 TForm1 = class(TForm)
16 Button1: TButton;
17 GroupBox1: TGroupBox;
18 GroupBox2: TGroupBox;
19 GroupBox3: TGroupBox;
20 GroupBox4: TGroupBox;
21 GroupBox5: TGroupBox;
22 Image1: TImage;
23 Image2: TImage;
24 Image3: TImage;
25 Image4: TImage;
26 Image5: TImage;
27 ImageList1: TImageList;
28 ListBox1: TListBox;
29 OpenPictureDialog1: TOpenPictureDialog;
30 procedure Button1Click(Sender: TObject);
31 procedure FormCreate(Sender: TObject);
GetImageMapnull32 function GetImageMap(AEffect: TGraphicsDrawEffect): TImage;
33 procedure ListBox1SelectionChange(Sender: TObject; User: boolean);
34 private
35
36 public
37 procedure ShowImages(AIndex: Integer);
38 procedure AddFile(AFileName: String);
39 property ImageMap[AEffect: TGraphicsDrawEffect]: TImage read GetImageMap;
40 end;
41
42 var
43 Form1: TForm1;
44
45 implementation
46
47 {$R *.lfm}
48
49 { TForm1 }
50
LoadBitmapFromFilenull51 function LoadBitmapFromFile(AFileName: String): TCustomBitmap;
52 var
53 Stream: TStream;
54 GraphicClass: TGraphicClass;
55 begin
56 Result := nil;
57 Stream := nil;
58 try
59 Stream := TFileStream.Create(UTF8ToSys(AFileName), fmOpenRead or fmShareDenyNone);
60 GraphicClass := GetGraphicClassForFileExtension(ExtractFileExt(AFileName));
61 if (GraphicClass <> nil) and (GraphicClass.InheritsFrom(TCustomBitmap)) then
62 begin
63 Result := TCustomBitmap(GraphicClass.Create);
64 Result.LoadFromStream(Stream);
65 end;
66 finally
67 Stream.Free;
68 end;
69 end;
70
71 procedure TForm1.FormCreate(Sender: TObject);
72 begin
73 AddFile(ExtractFilePath(ParamStrUTF8(0)) + SetDirSeparators('images/edit-clear.png'));
74 AddFile(ExtractFilePath(ParamStrUTF8(0)) + SetDirSeparators('images/edit-find-replace.png'));
75 end;
76
77 procedure TForm1.Button1Click(Sender: TObject);
78 begin
79 if OpenPictureDialog1.Execute then
80 AddFile(OpenPictureDialog1.FileName);
81 end;
82
GetImageMapnull83 function TForm1.GetImageMap(AEffect: TGraphicsDrawEffect): TImage;
84 begin
85 case AEffect of
86 gdeNormal: Result := Image1;
87 gdeDisabled: Result := Image2;
88 gdeHighlighted: Result := Image3;
89 gdeShadowed: Result := Image4;
90 gde1Bit: Result := Image5;
91 else
92 Result := nil;
93 end;
94 end;
95
96 procedure TForm1.ListBox1SelectionChange(Sender: TObject; User: boolean);
97 begin
98 if ListBox1.ItemIndex <> -1 then
99 ShowImages(ListBox1.ItemIndex);
100 end;
101
102 procedure TForm1.ShowImages(AIndex: Integer);
103 var
104 AEffect: TGraphicsDrawEffect;
105 Bmp: TBitmap;
106 begin
107 for AEffect := Low(TGraphicsDrawEffect) to High(TGraphicsDrawEffect) do
108 begin
109 Bmp := TBitmap.Create;
110 ImageList1.GetBitmap(AIndex, Bmp, AEffect);
111 if ImageMap[AEffect] <> nil then
112 ImageMap[AEffect].Picture.Assign(Bmp);
113 Bmp.Free;
114 end;
115 end;
116
117 procedure TForm1.AddFile(AFileName: String);
118 var
119 bmp: TCustomBitmap;
120 begin
121 bmp := LoadBitmapFromFile(AFileName);
122 if bmp <> nil then
123 begin
124 ImageList1.Add(bmp, nil);
125 ListBox1.Items.Add(ExtractFileName(AFileName));
126 if ListBox1.ItemIndex = -1 then
127 ListBox1.ItemIndex := 0;
128 end;
129 bmp.Free;
130 end;
131
132 end.
133
134
