source: trunk/Packages/bgracontrols/bgrabitmapthemeutils.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 13.6 KB
Line 
1{
2This unit is deprecated use BGRASliceScaling in the BGRABitmap package instead.
3}
4
5unit bgrabitmapthemeutils;
6
7{$mode objfpc}{$H+}
8
9interface
10
11uses
12 Classes, Graphics,
13 bgrabitmap, bgrabitmaptypes;
14
15type
16 TBGRABitmapArray = array of TBGRABitmap;
17 TBGRABitmapArrays = array of TBGRABitmapArray;
18
19{ TBGRABitmap functions }
20
21function GetBGRABitmap(ABitmap: TBGRABitmap; Number: integer): TBGRABitmapArray;
22function GetBGRABitmap(AFilename: string; Number: integer): TBGRABitmapArray;
23function GetBGRABitmap(AStream: TStream; Number: integer): TBGRABitmapArray;
24
25function GetBGRABitmapPart(Source: TBGRABitmap;
26 BorderWidth, BorderHeight: integer): TBGRABitmapArray;
27
28function GetBGRABitmapElements(ABitmap: TBGRABitmap;
29 Number, BorderWidth, BorderHeight: integer): TBGRABitmapArrays;
30function GetBGRABitmapElements(AFilename: string;
31 Number, BorderWidth, BorderHeight: integer): TBGRABitmapArrays;
32function GetBGRABitmapElements(AStream: TStream;
33 Number, BorderWidth, BorderHeight: integer): TBGRABitmapArrays;
34
35function DrawBGRABitmap(Source: TBGRABitmapArray;
36 DestWidth, DestHeight, BorderWidth, BorderHeight: integer;
37 FillLeft: boolean = False; FillTop: boolean = False; FillRight: boolean = False;
38 FillBottom: boolean = False; FillCenter: boolean = False;
39 DrawMode: TDrawMode = dmDrawWithTransparency;
40 ResampleMode: TResampleMode = rmSimpleStretch;
41 ResampleFilter: TResampleFilter = rfBestQuality): TBGRABitmap;
42
43type
44
45 { TBGRABitmapThemeUtil }
46
47 TBGRABitmapThemeUtil = class
48 private
49 BorWidth: integer;
50 BorHeight: integer;
51 public
52 BGRAbmpArrays: TBGRABitmapArrays;
53 constructor Create(ABitmap: TBGRABitmap; Number, BorderWidth, BorderHeight: integer);
54 constructor Create(ABitmap: TBitmap; Number, BorderWidth, BorderHeight: integer);
55 constructor Create(AFilename: string; Number, BorderWidth, BorderHeight: integer);
56 constructor Create(AStream: TStream; Number, BorderWidth, BorderHeight: integer);
57 destructor Destroy; override;
58 function Draw(AWidth, AHeight: integer; Number: integer;
59 FillLeft: boolean = False; FillTop: boolean = False;
60 FillRight: boolean = False; FillBottom: boolean = False;
61 FillCenter: boolean = False; DrawMode: TDrawMode = dmDrawWithTransparency;
62 ResampleMode: TResampleMode = rmSimpleStretch;
63 ResampleFilter: TResampleFilter = rfBestQuality): TBGRABitmap;
64 procedure Draw(ACanvas: TCanvas; X, Y, W, H, Number: integer;
65 FillLeft: boolean = False; FillTop: boolean = False;
66 FillRight: boolean = False; FillBottom: boolean = False;
67 FillCenter: boolean = False; DrawMode: TDrawMode = dmDrawWithTransparency;
68 ResampleMode: TResampleMode = rmSimpleStretch;
69 ResampleFilter: TResampleFilter = rfBestQuality);
70 procedure Draw(ABitmap: TBGRABitmap; X, Y, W, H, Number: integer;
71 FillLeft: boolean = False; FillTop: boolean = False;
72 FillRight: boolean = False; FillBottom: boolean = False;
73 FillCenter: boolean = False; DrawMode: TDrawMode = dmDrawWithTransparency;
74 ResampleMode: TResampleMode = rmSimpleStretch;
75 ResampleFilter: TResampleFilter = rfBestQuality);
76 end;
77
78implementation
79
80{ TBGRABitmap functions }
81
82function GetBGRABitmap(ABitmap: TBGRABitmap; Number: integer): TBGRABitmapArray;
83var
84 i, s: integer;
85begin
86 s := ABitmap.Height div Number;
87 SetLength(Result, Number);
88 for i := Low(Result) to High(Result) do
89 Result[i] := TBGRABitmap(ABitmap.GetPtrBitmap(s * i, s * (i + 1)));
90end;
91
92function GetBGRABitmap(AFilename: string; Number: integer): TBGRABitmapArray;
93var
94 temp: TBGRABitmap;
95begin
96 temp := TBGRABitmap.Create(AFilename);
97 Result := GetBGRABitmap(temp, Number);
98 temp.Free;
99end;
100
101function GetBGRABitmap(AStream: TStream; Number: integer): TBGRABitmapArray;
102var
103 temp: TBGRABitmap;
104begin
105 temp := TBGRABitmap.Create(AStream);
106 Result := GetBGRABitmap(temp, Number);
107 temp.Free;
108end;
109
110function GetBGRABitmapPart(Source: TBGRABitmap;
111 BorderWidth, BorderHeight: integer): TBGRABitmapArray;
112var
113 bmpArray: TBGRABitmapArray;
114begin
115 SetLength(bmpArray, 9);
116 Result := bmpArray;
117
118 { Top Left }
119 bmpArray[0] := TBGRABitmap.Create(BorderWidth, BorderHeight);
120 bmpArray[0].PutImage(0, 0, Source, dmDrawWithTransparency);
121
122 { Top Right }
123 bmpArray[1] := TBGRABitmap.Create(BorderWidth, BorderHeight);
124 bmpArray[1].PutImage(BorderWidth - Source.Width, 0, Source, dmDrawWithTransparency);
125
126 { Bottom Left }
127 bmpArray[2] := TBGRABitmap.Create(BorderWidth, BorderHeight);
128 bmpArray[2].PutImage(0, BorderHeight - Source.Height, Source, dmDrawWithTransparency);
129
130 { Bottom Right }
131 bmpArray[3] := TBGRABitmap.Create(BorderWidth, BorderHeight);
132 bmpArray[3].PutImage(BorderWidth - Source.Width, BorderHeight -
133 Source.Height, Source, dmDrawWithTransparency);
134
135 { Center }
136 bmpArray[4] := TBGRABitmap.Create(Source.Width - BorderWidth * 2,
137 Source.Height - BorderHeight * 2);
138 bmpArray[4].PutImage(-BorderWidth, -BorderHeight, Source, dmDrawWithTransparency);
139
140 { Top }
141 bmpArray[5] := TBGRABitmap.Create(Source.Width - BorderWidth * 2, BorderHeight);
142 bmpArray[5].PutImage(-BorderWidth, 0, Source, dmDrawWithTransparency);
143
144 { Left }
145 bmpArray[6] := TBGRABitmap.Create(BorderWidth, Source.Height - BorderHeight * 2);
146 bmpArray[6].PutImage(0, -BorderHeight, Source, dmDrawWithTransparency);
147
148 { Right }
149 bmpArray[7] := TBGRABitmap.Create(BorderWidth, Source.Height - BorderHeight * 2);
150 bmpArray[7].PutImage(BorderWidth - Source.Width, -BorderHeight,
151 Source, dmDrawWithTransparency);
152
153 { Bottom }
154 bmpArray[8] := TBGRABitmap.Create(Source.Width - BorderWidth * 2, BorderHeight);
155 bmpArray[8].PutImage(-BorderWidth, BorderHeight - Source.Height,
156 Source, dmDrawWithTransparency);
157end;
158
159function GetBGRABitmapElements(ABitmap: TBGRABitmap;
160 Number, BorderWidth, BorderHeight: integer): TBGRABitmapArrays;
161var
162 bmpArrayStates: TBGRABitmapArray;
163 i, tempWidth, tempHeight: integer;
164begin
165 bmpArrayStates := GetBGRABitmap(ABitmap, Number);
166
167 if (BorderWidth * 2 > bmpArrayStates[0].Width) or (BorderWidth < 0) then
168 tempWidth := Trunc(bmpArrayStates[0].Width div 2)
169 else
170 tempWidth := BorderWidth;
171
172 if (BorderHeight * 2 > bmpArrayStates[0].Height) or (BorderHeight < 0) then
173 tempHeight := Trunc(bmpArrayStates[0].Height div 2)
174 else
175 tempHeight := BorderHeight;
176
177 SetLength(Result, Number, 9);
178 for i := Low(bmpArrayStates) to High(bmpArrayStates) do
179 begin
180 Result[i] := GetBGRABitmapPart(bmpArrayStates[i], tempWidth, tempHeight);
181 bmpArrayStates[i].Free;
182 bmpArrayStates[i] := nil;
183 end;
184
185 bmpArrayStates := nil;
186end;
187
188function GetBGRABitmapElements(AFilename: string;
189 Number, BorderWidth, BorderHeight: integer): TBGRABitmapArrays;
190var
191 temp: TBGRABitmap;
192begin
193 temp := TBGRABitmap.Create(AFilename);
194 Result := GetBGRABitmapElements(temp, Number, BorderWidth, BorderHeight);
195 temp.Free;
196end;
197
198function GetBGRABitmapElements(AStream: TStream;
199 Number, BorderWidth, BorderHeight: integer): TBGRABitmapArrays;
200var
201 temp: TBGRABitmap;
202begin
203 temp := TBGRABitmap.Create(AStream);
204 Result := GetBGRABitmapElements(temp, Number, BorderWidth, BorderHeight);
205 temp.Free;
206end;
207
208function DrawBGRABitmap(Source: TBGRABitmapArray;
209 DestWidth, DestHeight, BorderWidth, BorderHeight: integer;
210 FillLeft: boolean = False; FillTop: boolean = False; FillRight: boolean = False;
211 FillBottom: boolean = False; FillCenter: boolean = False;
212 DrawMode: TDrawMode = dmDrawWithTransparency;
213 ResampleMode: TResampleMode = rmSimpleStretch;
214 ResampleFilter: TResampleFilter = rfBestQuality): TBGRABitmap;
215
216 procedure StretchAndDraw(Source, Dest: TBGRABitmap; x, y, w, h: integer;
217 Fill: boolean = False);
218 var
219 temp: TBGRABitmap;
220 begin
221 if Fill then
222 begin
223 temp := TBGRABitmap.Create(w, h);
224 temp.ResampleFilter := ResampleFilter;
225 temp.Fill(Source);
226 end
227 else
228 begin
229 temp := TBGRABitmap.Create(0, 0);
230 temp.ResampleFilter := ResampleFilter;
231 BGRAReplace(temp, Source.Resample(w, h, ResampleMode));
232 end;
233 Dest.PutImage(x, y, temp, DrawMode);
234 temp.Free;
235 end;
236
237 procedure DrawEachPart(Source: TBGRABitmapArray; dest: TBGRABitmap;
238 DestWidth, DestHeight, BorderWidth, BorderHeight: integer);
239 begin
240 //center
241 if (DestWidth > BorderWidth * 2) and (DestHeight > BorderHeight * 2) then
242 StretchAndDraw(Source[4], dest, BorderWidth, BorderHeight,
243 DestWidth - 2 * BorderWidth, DestHeight - 2 * BorderHeight, FillCenter);
244 //top
245 StretchAndDraw(Source[5], dest, BorderWidth, 0, DestWidth - 2 *
246 BorderWidth, BorderHeight, FillTop);
247 //left
248 StretchAndDraw(Source[6], dest, 0, BorderHeight, BorderWidth,
249 DestHeight - 2 * BorderHeight, FillLeft);
250 //right
251 StretchAndDraw(Source[7], dest, DestWidth - BorderWidth, BorderHeight,
252 BorderWidth, DestHeight - 2 * BorderHeight, FillRight);
253 //bottom
254 StretchAndDraw(Source[8], dest, BorderWidth, DestHeight - BorderHeight,
255 DestWidth - 2 * BorderWidth, BorderHeight, FillBottom);
256 //top left
257 StretchAndDraw(Source[0], dest, 0, 0, BorderWidth, BorderHeight);
258 //top right
259 StretchAndDraw(Source[1], dest, DestWidth - BorderWidth, 0,
260 BorderWidth, BorderHeight);
261 //bottom left
262 StretchAndDraw(Source[2], dest, 0, DestHeight - BorderHeight,
263 BorderWidth, BorderHeight);
264 //bottom right
265 StretchAndDraw(Source[3], dest, DestWidth - BorderWidth, DestHeight -
266 BorderHeight, BorderWidth, BorderHeight);
267 end;
268
269var
270 temp: TBGRABitmap;
271 tempWidth, tempHeight: integer;
272begin
273 if (BorderWidth < 1) or (BorderHeight < 1) then
274 begin
275 Result := TBGRABitmap.Create(DestWidth, DestHeight);
276 StretchAndDraw(Source[4], Result, 0, 0, DestWidth, DestHeight);
277 exit;
278 end;
279
280 if DestWidth < BorderWidth * 2 then
281 tempWidth := BorderWidth * 2
282 else
283 tempWidth := DestWidth;
284
285 if DestHeight < BorderHeight * 2 then
286 tempHeight := BorderHeight * 2
287 else
288 tempHeight := DestHeight;
289
290 temp := TBGRABitmap.Create(tempWidth, tempHeight);
291 DrawEachPart(Source, temp, tempWidth, tempHeight, BorderWidth, BorderHeight);
292
293 if (tempWidth <> DestWidth) or (tempHeight <> DestHeight) then
294 begin
295 Result := TBGRABitmap.Create(DestWidth, DestHeight);
296 StretchAndDraw(temp, Result, 0, 0, DestWidth, DestHeight);
297 temp.Free;
298 end
299 else
300 Result := temp;
301end;
302
303{ TBGRABitmapThemeUtil }
304
305constructor TBGRABitmapThemeUtil.Create(ABitmap: TBGRABitmap;
306 Number, BorderWidth, BorderHeight: integer);
307begin
308 BGRABmpArrays := GetBGRABitmapElements(ABitmap, Number, BorderWidth, BorderHeight);
309 BorWidth := BGRABmpArrays[0, 0].Width;
310 BorHeight := BGRABmpArrays[0, 0].Height;
311 inherited Create;
312end;
313
314constructor TBGRABitmapThemeUtil.Create(ABitmap: TBitmap;
315 Number, BorderWidth, BorderHeight: integer);
316var
317 temp: TBGRABitmap;
318begin
319 temp := TBGRABitmap.Create(ABitmap);
320 BGRABmpArrays := GetBGRABitmapElements(temp, Number, BorderWidth, BorderHeight);
321 temp.Free;
322 BorWidth := BGRABmpArrays[0, 0].Width;
323 BorHeight := BGRABmpArrays[0, 0].Height;
324 inherited Create;
325end;
326
327constructor TBGRABitmapThemeUtil.Create(AFilename: string;
328 Number, BorderWidth, BorderHeight: integer);
329begin
330 BGRABmpArrays := GetBGRABitmapElements(AFilename, Number, BorderWidth, BorderHeight);
331 BorWidth := BGRABmpArrays[0, 0].Width;
332 BorHeight := BGRABmpArrays[0, 0].Height;
333 inherited Create;
334end;
335
336constructor TBGRABitmapThemeUtil.Create(AStream: TStream;
337 Number, BorderWidth, BorderHeight: integer);
338begin
339 BGRABmpArrays := GetBGRABitmapElements(AStream, Number, BorderWidth, BorderHeight);
340 BorWidth := BGRABmpArrays[0, 0].Width;
341 BorHeight := BGRABmpArrays[0, 0].Height;
342 inherited Create;
343end;
344
345destructor TBGRABitmapThemeUtil.Destroy;
346var
347 i, j: integer;
348begin
349 for i := Low(BGRAbmpArrays) to High(BGRABMPArrays) do
350 begin
351 for j := Low(BGRABMPArrays[i]) to High(BGRABMPArrays[i]) do
352 begin
353 BGRABMPArrays[i, j].Free;
354 BGRABMPArrays[i, j] := nil;
355 end;
356 BGRABMPArrays[i] := nil;
357 end;
358 inherited Destroy;
359end;
360
361function TBGRABitmapThemeUtil.Draw(AWidth, AHeight: integer; Number: integer;
362 FillLeft: boolean = False; FillTop: boolean = False; FillRight: boolean = False;
363 FillBottom: boolean = False; FillCenter: boolean = False;
364 DrawMode: TDrawMode = dmDrawWithTransparency;
365 ResampleMode: TResampleMode = rmSimpleStretch;
366 ResampleFilter: TResampleFilter = rfBestQuality): TBGRABitmap;
367begin
368 Result := DrawBGRABitmap(BGRAbmpArrays[Number], AWidth, AHeight,
369 BorWidth, BorHeight, FillLeft, FillTop, FillRight, FillBottom,
370 FillCenter, DrawMode, ResampleMode, ResampleFilter);
371end;
372
373procedure TBGRABitmapThemeUtil.Draw(ACanvas: TCanvas; X, Y, W, H, Number: integer;
374 FillLeft: boolean = False; FillTop: boolean = False; FillRight: boolean = False;
375 FillBottom: boolean = False; FillCenter: boolean = False;
376 DrawMode: TDrawMode = dmDrawWithTransparency;
377 ResampleMode: TResampleMode = rmSimpleStretch;
378 ResampleFilter: TResampleFilter = rfBestQuality);
379var
380 temp: TBGRABitmap;
381begin
382 temp := DrawBGRABitmap(BGRAbmpArrays[Number], W, H, BorWidth,
383 BorHeight, FillLeft, FillTop, FillRight, FillBottom, FillCenter,
384 DrawMode, ResampleMode, ResampleFilter);
385 temp.Draw(ACanvas, X, Y, False);
386 temp.Free;
387end;
388
389procedure TBGRABitmapThemeUtil.Draw(ABitmap: TBGRABitmap;
390 X, Y, W, H, Number: integer; FillLeft: boolean = False; FillTop: boolean = False;
391 FillRight: boolean = False; FillBottom: boolean = False;
392 FillCenter: boolean = False; DrawMode: TDrawMode = dmDrawWithTransparency;
393 ResampleMode: TResampleMode = rmSimpleStretch;
394 ResampleFilter: TResampleFilter = rfBestQuality);
395var
396 temp: TBGRABitmap;
397begin
398 temp := DrawBGRABitmap(BGRAbmpArrays[Number], W, H, BorWidth,
399 BorHeight, FillLeft, FillTop, FillRight, FillBottom, FillCenter,
400 DrawMode, ResampleMode, ResampleFilter);
401 ABitmap.PutImage(X, Y, temp, DrawMode);
402 temp.Free;
403end;
404
405end.
406
Note: See TracBrowser for help on using the repository browser.