source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/fImagePickExisting.pas@ 1679

Last change on this file since 1679 was 801, checked in by Kevin Toppenberg, 14 years ago

Bug fixes. Improved Adding Image

File size: 5.7 KB
Line 
1unit fImagePickExisting;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, fImages, StdCtrls, Buttons, ExtCtrls;
8
9type
10 TfrmImagePickExisting = class(TForm)
11 pnlButtons: TPanel;
12 btnOK: TBitBtn;
13 btnCancel: TBitBtn;
14 ScrollBox: TScrollBox;
15 Image1: TImage;
16 procedure FormShow(Sender: TObject);
17 procedure FormCreate(Sender: TObject);
18 procedure FormDestroy(Sender: TObject);
19 procedure ImageClick(Sender: TObject);
20 procedure ImageDblClick(Sender: TObject);
21 procedure btnOKClick(Sender: TObject);
22 procedure ScrollBoxClick(Sender: TObject);
23 private
24 { Private declarations }
25 ShownImagesList : TList; //owns objects
26 Row, Col : integer;
27 NextInsert : TPoint;
28 CurRowHeight : integer;
29 SelectedIndex : integer;
30 function GetImageFName : string;
31 function GetSelectedImageInfo : TImageInfo;
32 procedure InitImagePlacement;
33 procedure BoxImage(Index: integer; Selected : boolean);
34 procedure ImagesListClear;
35 procedure ShowImages;
36 procedure ShowSelected;
37 public
38 { Public declarations }
39 property SelectedImageInfo : TImageInfo read GetSelectedImageInfo;
40 property SelectedImageFName : string read GetImageFName;
41 end;
42
43const
44 IMAGE_SPACING = 5;
45 COLS_PER_ROW = 3;
46
47var
48 frmImagePickExisting: TfrmImagePickExisting;
49
50implementation
51
52{$R *.dfm}
53
54procedure TfrmImagePickExisting.FormShow(Sender: TObject);
55begin
56 ShowImages;
57end;
58
59procedure TfrmImagePickExisting.FormCreate(Sender: TObject);
60begin
61 ShownImagesList := TList.Create; //owns objects
62 InitImagePlacement;
63end;
64
65procedure TfrmImagePickExisting.FormDestroy(Sender: TObject);
66begin
67 ImagesListClear;
68 ShownImagesList.Free;
69end;
70
71//------------------------------------------------------------
72//Event handlers
73//------------------------------------------------------------
74procedure TfrmImagePickExisting.ImageClick(Sender: TObject);
75begin
76 SelectedIndex := TImage(Sender).Tag;
77 ShowSelected;
78end;
79
80procedure TfrmImagePickExisting.ImageDblClick(Sender: TObject);
81begin
82 SelectedIndex := TImage(Sender).Tag;
83 ShowSelected;
84 btnOK.Click;
85end;
86
87procedure TfrmImagePickExisting.btnOKClick(Sender: TObject);
88begin
89 //kt
90end;
91
92procedure TfrmImagePickExisting.ScrollBoxClick(Sender: TObject);
93begin
94 SelectedIndex := -1;
95 ShowSelected;
96end;
97
98//------------------------------------------------------------
99//-----------------------------------------------------------
100
101procedure TfrmImagePickExisting.ShowSelected;
102var i : integer;
103begin
104 for i := 0 to ShownImagesList.Count-1 do begin
105 BoxImage(i, (i=SelectedIndex));
106 end;
107end;
108
109procedure TfrmImagePickExisting.ImagesListClear;
110var i : integer;
111 Image : TImage;
112begin
113 for i := 0 to ShownImagesList.Count-1 do begin
114 Image := TImage(ShownImagesList.Items[i]);
115 Image.Free;
116 end;
117 InitImagePlacement;
118end;
119
120procedure TfrmImagePickExisting.InitImagePlacement;
121begin
122 Row := 0;
123 Col := 0;
124 NextInsert.X := IMAGE_SPACING;
125 NextInsert.Y := IMAGE_SPACING;
126 CurRowHeight := 0;
127 SelectedIndex := -1;
128end;
129
130
131procedure TfrmImagePickExisting.ShowImages;
132var i : integer;
133 Image : TImage;
134 Rec : TImageInfo;
135
136begin
137 frmImages.EnsureALLImagesDownloaded;
138 ImagesListClear;
139 for i := 0 to frmImages.ImagesCount - 1 do begin
140 Rec := frmImages.ImageInfo[i];
141 Image := TImage.Create(Self);
142 ShownImagesList.Add(Image); //index will match Image.Tag below
143 Image.Visible := false;
144 Image.Parent := ScrollBox;
145 if FileExists(Rec.CacheThumbFName) then begin
146 Image.Picture.Bitmap.LoadFromFile(Rec.CacheThumbFName);
147 end else begin
148 frmImages.GetThumbnailBitmapForFName(Rec.CacheFName,
149 Image.Picture.Bitmap);
150 end;
151 Image.Top := NextInsert.Y;
152 Image.Left := NextInsert.X;
153 Image.Tag := i;
154 Image.OnClick := ImageClick;
155 Image.OnDblclick := ImageDblClick;
156 Image.Visible := true;
157 If Image.Picture.Bitmap.Height > CurRowHeight then begin
158 CurRowHeight := Image.Picture.Bitmap.Height;
159 end;
160 Inc (Col);
161 if Col > COLS_PER_ROW then begin
162 Col := 0;
163 Inc (Row);
164 NextInsert.X := IMAGE_SPACING;
165 NextInsert.Y := NextInsert.Y + CurRowHeight + IMAGE_SPACING;
166 end else begin
167 NextInsert.X := NextInsert.X + Image.Picture.Bitmap.Width + IMAGE_SPACING;
168 end;
169 end;
170end;
171
172function TfrmImagePickExisting.GetSelectedImageInfo : TImageInfo;
173//Returns nil if not selcted.
174begin
175 if SelectedIndex> -1 then begin
176 Result := frmImages.ImageInfo[SelectedIndex];
177 end else begin
178 Result := nil;
179 end;
180end;
181
182function TfrmImagePickExisting.GetImageFName : string;
183var
184 Rec : TImageInfo;
185begin
186 Rec := GetSelectedImageInfo;
187 if Assigned(Rec) then begin
188 Result := Rec.CacheFName;
189 end else begin
190 Result := '';
191 end;
192end;
193
194procedure TfrmImagePickExisting.BoxImage(Index: integer; Selected : boolean);
195var
196 Image : TImage;
197 Rect : TRect;
198begin
199 if (Index < 0) or (Index >= ShownImagesList.Count) then exit;
200 Image := TImage(ShownImagesList.Items[Index]);
201 if Image = nil then exit;
202 Rect.Top := 0; Rect.Left := 0;
203 Rect.Right := Image.Picture.Bitmap.Width-1;
204 Rect.Bottom := Image.Picture.Bitmap.Height-1;
205 if Selected then begin
206 Image.Canvas.Pen.Color := clRed;
207 end else begin
208 Image.Canvas.Pen.Color := clBtnFace;
209 end;
210 Image.Canvas.PenPos := Rect.TopLeft;
211 Image.Canvas.LineTo(Rect.Left,Rect.Bottom);
212 Image.Canvas.LineTo(Rect.Right,Rect.Bottom);
213 Image.Canvas.LineTo(Rect.Right,Rect.Top);
214 Image.Canvas.LineTo(Rect.Left,Rect.Top);
215 //Image.Canvas.Rectangle(Rect); //This fills in center with brush.
216end;
217
218
219end.
220
Note: See TracBrowser for help on using the repository browser.