source: trunk/Packages/bgrabitmap/bgraslicescaling.pas

Last change on this file was 2, checked in by chronos, 6 years ago
File size: 25.2 KB
Line 
1unit BGRASliceScaling;
2
3{$mode objfpc}{$H+}
4
5interface
6
7uses
8 Classes, SysUtils, BGRAGraphics, BGRABitmap, BGRABitmapTypes, IniFiles;
9
10type
11 TMargins = record
12 top, right, bottom, left: integer;
13 end;
14 TSlicePosition = (spTopLeft, spTop, spTopRight, spLeft, spMiddle, spRight,
15 spBottomLeft, spBottom, spBottomRight);
16 TSliceBitmapArray = array[TSlicePosition] of TBGRABitmap;
17 TSliceRectArray = array[TSlicePosition] of TRect;
18 TSliceRepeatPosition = (srpTop, srpLeft, srpMiddleHorizontal,
19 srpMiddleVertical, srpRight, srpBottom);
20 TSliceRepeatArray = array[TSliceRepeatPosition] of boolean;
21
22const
23 SliceRepeatPositionStr : array[TSliceRepeatPosition] of string =
24 ('Top','Left','MiddleHorizontal','MiddleVertical','Right','Bottom');
25
26function Margins(ATop, ARight, ABottom, ALeft: integer): TMargins;
27
28type
29
30 { TBGRASliceScaling }
31
32 TBGRASliceScaling = class
33 private
34 FSliceRectArray: TSliceRectArray;
35 FSliceBitmapArray: TSliceBitmapArray;
36 FSliceRepeat: TSliceRepeatArray;
37 FBitmap: TBGRABitmap;
38 FBitmapOwned: boolean;
39 FBitmapSourceRect: TRect;
40 FMargins: TMargins;
41 FDrawMode: TDrawMode;
42 FResampleMode: TResampleMode;
43 FResampleFilter: TResampleFilter;
44 function GetBitmapHeight: integer;
45 function GetBitmapWidth: integer;
46 function GetSlice(APosition: TSlicePosition): TBGRABitmap;
47 function GetSliceRepeat(Aposition: TSliceRepeatPosition): boolean;
48 function GetSliceRepeatAsString: string;
49 procedure SetBitmap(AValue: TBGRABitmap);
50 procedure SetBitmapSourceRect(AValue: TRect);
51 procedure SetDrawMode(AValue: TDrawMode);
52 procedure SetResampleFilter(AValue: TResampleFilter);
53 procedure SetResampleMode(AValue: TResampleMode);
54 procedure SetSliceRepeat(Aposition: TSliceRepeatPosition; AValue: boolean);
55 procedure SetSliceRepeatAsString(AValue: string);
56 protected
57 // Stuff
58 procedure UpdateSliceRectArray;
59 function ComputeSliceRectArray(ARect: TRect): TSliceRectArray;
60 procedure SliceScalingDraw(ADest: TBGRABitmap; ADestRect: TRect;
61 DrawGrid: boolean = False);
62 procedure Init;
63 procedure ClearBitmapArray;
64 public
65 // Create an instance and stores the bitmap, either as a reference to a TBGRABitmap from the caller,
66 // or as a local owned copy in other cases
67 constructor Create(ABitmap: TBGRABitmap;
68 AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer; ABitmapOwner: boolean = false); overload;
69 constructor Create(ABitmap: TBitmap;
70 AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); overload;
71 constructor Create(AFilename: string;
72 AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); overload;
73 constructor Create(AFilename: string; AIsUtf8: boolean;
74 AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); overload;
75 constructor Create(AStream: TStream;
76 AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); overload;
77 constructor Create(ABitmap: TBGRABitmap; ABitmapOwner: boolean = false); overload;
78 constructor Create(ABitmap: TBitmap); overload;
79 constructor Create(AFilename: string); overload;
80 constructor Create(AFilename: string; AIsUtf8: boolean); overload;
81 constructor Create(AStream: TStream); overload;
82 constructor Create; overload;
83 procedure SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer); overload;
84 procedure SetMargins(AMargins: TMargins); overload;
85 destructor Destroy; override;
86 public
87 procedure NotifyBitmapChanged; //to notify the source bitmap has changed
88 //so new bitmaps should be used
89 // Draw
90 procedure Draw(ABitmap: TBGRABitmap; ARect: TRect; DrawGrid: boolean = False); overload;
91 procedure Draw(ABitmap: TBGRABitmap; ALeft, ATop, AWidth, AHeight: integer;
92 DrawGrid: boolean = False); overload;
93 procedure AutodetectRepeat;
94 public
95 // Property
96 property DrawMode: TDrawMode read FDrawMode write SetDrawMode;
97 property ResampleMode: TResampleMode read FResampleMode write SetResampleMode;
98 property ResampleFilter: TResampleFilter read FResampleFilter
99 write SetResampleFilter;
100 property BitmapWidth: integer read GetBitmapWidth;
101 property BitmapHeight: integer read GetBitmapHeight;
102 property BitmapSource: TBGRABitmap read FBitmap write SetBitmap;
103 property BitmapSourceRect: TRect read FBitmapSourceRect write SetBitmapSourceRect;
104 property Margins: TMargins read FMargins write SetMargins;
105 property SliceBitmap[APosition: TSlicePosition]: TBGRABitmap read GetSlice;
106 property SliceRepeat[Aposition: TSliceRepeatPosition]: boolean
107 read GetSliceRepeat write SetSliceRepeat;
108 property SliceRepeatAsString: string read GetSliceRepeatAsString write SetSliceRepeatAsString;
109 end;
110
111 TSliceScalingArray = array of TBGRASliceScaling;
112 TSliceScalingDirection = (sdHorizontal, sdVertical);
113 TBGRABitmapArray = array of TBGRABitmap;
114
115 { TBGRAMultiSliceScaling }
116
117 TBGRAMultiSliceScaling = class
118 private
119 FSliceScalingArray: TSliceScalingArray;
120 FBitmapOwned: boolean;
121 FBitmap: TBGRABitmap;
122 procedure SetFSliceScalingArray(AValue: TSliceScalingArray);
123 public
124 constructor Create(ABitmap: TBGRABitmap;
125 AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
126 Direction: TSliceScalingDirection; ABitmapOwner: boolean = false); overload;
127 constructor Create(ABitmap: TBitmap;
128 AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
129 Direction: TSliceScalingDirection); overload;
130 constructor Create(ABitmapFilename: string;
131 AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
132 Direction: TSliceScalingDirection); overload;
133 constructor Create(ABitmapFilename: string; AIsUtf8: boolean;
134 AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
135 Direction: TSliceScalingDirection); overload;
136 constructor Create(AStream: TStream;
137 AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
138 Direction: TSliceScalingDirection); overload;
139 destructor Destroy; override;
140 constructor Create(AIniFilename, ASection: string; AIsUtf8Filename: boolean= false); overload;
141 public
142 procedure Draw(ItemNumber: integer; ABitmap: TBGRABitmap;
143 ARect: TRect; DrawGrid: boolean = False); overload;
144 procedure Draw(ItemNumber: integer; ABitmap: TBGRABitmap;
145 ALeft, ATop, AWidth, AHeight: integer; DrawGrid: boolean = False); overload;
146 public
147 property SliceScalingArray: TSliceScalingArray
148 read FSliceScalingArray write SetFSliceScalingArray;
149 end;
150
151implementation
152
153uses BGRAUTF8, Types;
154
155function Margins(ATop, ARight, ABottom, ALeft: integer): TMargins;
156begin
157 Result.top := atop;
158 Result.right := aright;
159 Result.bottom := abottom;
160 Result.left := aleft;
161end;
162
163{ TBGRAMultiSliceScaling }
164
165procedure TBGRAMultiSliceScaling.SetFSliceScalingArray(AValue: TSliceScalingArray);
166begin
167 if FSliceScalingArray = AValue then
168 Exit;
169 FSliceScalingArray := AValue;
170end;
171
172constructor TBGRAMultiSliceScaling.Create(ABitmap: TBGRABitmap;
173 AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
174 Direction: TSliceScalingDirection; ABitmapOwner: boolean = false);
175var
176 i: integer;
177 ItemWidth,ItemHeight,ItemStepX,ItemStepY: integer;
178begin
179 FBitmap := ABitmap;
180 FBitmapOwned := ABitmapOwner;
181 ItemWidth := ABitmap.Width;
182 ItemHeight := ABitmap.Height;
183 ItemStepX := 0;
184 ItemStepY := 0;
185 case Direction of
186 sdVertical: begin
187 ItemHeight:= ABitmap.Height div NumberOfItems;
188 ItemStepY := ItemHeight;
189 end;
190 sdHorizontal:
191 begin
192 ItemWidth:= ABitmap.Width div NumberOfItems;
193 ItemStepX := ItemWidth;
194 end;
195 end;
196
197 SetLength(FSliceScalingArray, NumberOfItems);
198 for i := Low(FSliceScalingArray) to High(FSliceScalingArray) do
199 begin
200 FSliceScalingArray[i] := TBGRASliceScaling.Create(ABitmap,
201 AMarginTop, AMarginRight, AMarginBottom, AMarginLeft);
202 FSliceScalingArray[i].BitmapSourceRect := rect(ItemStepX*i,ItemStepY*i,ItemStepX*i+ItemWidth,ItemStepY*i+ItemHeight);
203 end;
204end;
205
206constructor TBGRAMultiSliceScaling.Create(ABitmap: TBitmap;
207 AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
208 Direction: TSliceScalingDirection);
209begin
210 Create(TBGRABitmap.Create(ABitmap), AMarginTop, AMarginRight, AMarginBottom, AMarginLeft,
211 NumberOfItems, Direction, True);
212end;
213
214constructor TBGRAMultiSliceScaling.Create(ABitmapFilename: string;
215 AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
216 Direction: TSliceScalingDirection);
217begin
218 Create(TBGRABitmap.Create(ABitmapFilename), AMarginTop, AMarginRight, AMarginBottom, AMarginLeft,
219 NumberOfItems, Direction, True);
220end;
221
222constructor TBGRAMultiSliceScaling.Create(ABitmapFilename: string; AIsUtf8: boolean;
223 AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
224 Direction: TSliceScalingDirection);
225begin
226 Create(TBGRABitmap.Create(ABitmapFilename,AIsUtf8), AMarginTop, AMarginRight, AMarginBottom, AMarginLeft,
227 NumberOfItems, Direction, True);
228end;
229
230constructor TBGRAMultiSliceScaling.Create(AStream: TStream;
231 AMarginTop, AMarginRight, AMarginBottom, AMarginLeft, NumberOfItems: integer;
232 Direction: TSliceScalingDirection);
233begin
234 Create(TBGRABitmap.Create(AStream), AMarginTop, AMarginRight, AMarginBottom, AMarginLeft,
235 NumberOfItems, Direction, True);
236end;
237
238destructor TBGRAMultiSliceScaling.Destroy;
239var
240 i: integer;
241begin
242 for i := Low(FSliceScalingArray) to High(FSliceScalingArray) do
243 FSliceScalingArray[i].Free;
244 if FBitmapOwned then FBitmap.Free;
245
246 inherited Destroy;
247end;
248
249constructor TBGRAMultiSliceScaling.Create(AIniFilename, ASection: string;
250 AIsUtf8Filename: boolean);
251var
252 i: integer;
253 temp: TMemIniFile;
254 Direction: TSliceScalingDirection;
255 defaultRepeat: string;
256 IniPathUTF8,BitmapFilename: string;
257begin
258 if AIsUtf8Filename then
259 begin
260 if not FileExistsUTF8(AIniFilename) then exit;
261 temp := TMemIniFile.Create(UTF8ToSys(AIniFilename));
262 IniPathUTF8 := ExtractFilePath(AIniFilename);
263 end else
264 begin
265 if not FileExists(AIniFilename) then exit;
266 temp := TMemIniFile.Create(AIniFilename);
267 IniPathUTF8 := SysToUTF8(ExtractFilePath(AIniFilename));
268 end;
269
270 if temp.ReadBool(ASection, 'HorizontalDirection', False) then
271 Direction := sdHorizontal
272 else
273 Direction := sdVertical;
274
275 BitmapFilename := temp.ReadString(ASection, 'Bitmap', '');
276 if (copy(BitmapFilename,1,2) = '.\') or (copy(BitmapFilename,1,2) = './') then
277 BitmapFilename := IniPathUTF8+SysToUTF8(copy(BitmapFilename,3,Length(BitmapFilename)-2));
278 Create(
279 BitmapFilename,True,
280 temp.ReadInteger(ASection, 'MarginTop', 0),
281 temp.ReadInteger(ASection, 'MarginRight', 0),
282 temp.ReadInteger(ASection, 'MarginBottom', 0),
283 temp.ReadInteger(ASection, 'MarginLeft', 0),
284 temp.ReadInteger(ASection, 'NumberOfItems', 1),
285 Direction);
286
287 defaultRepeat := temp.ReadString(ASection, 'Repeat', 'Auto');
288 for i := 0 to High(FSliceScalingArray) do
289 FSliceScalingArray[i].SliceRepeatAsString := temp.ReadString(ASection, 'Repeat'+IntToStr(i+1), defaultRepeat);
290
291 temp.Free;
292end;
293
294procedure TBGRAMultiSliceScaling.Draw(ItemNumber: integer; ABitmap: TBGRABitmap;
295 ARect: TRect; DrawGrid: boolean);
296begin
297 FSliceScalingArray[ItemNumber].Draw(ABitmap, ARect, DrawGrid);
298end;
299
300procedure TBGRAMultiSliceScaling.Draw(ItemNumber: integer; ABitmap: TBGRABitmap;
301 ALeft, ATop, AWidth, AHeight: integer; DrawGrid: boolean);
302begin
303 FSliceScalingArray[ItemNumber].Draw(ABitmap, ALeft, ATop, AWidth, AHeight, DrawGrid);
304end;
305
306{ TBGRASliceScaling }
307
308procedure TBGRASliceScaling.SetDrawMode(AValue: TDrawMode);
309begin
310 if FDrawMode = AValue then
311 Exit;
312 FDrawMode := AValue;
313end;
314
315procedure TBGRASliceScaling.SetBitmap(AValue: TBGRABitmap);
316begin
317 if FBitmap = AValue then
318 Exit;
319 if FBitmapOwned then
320 FBitmap.Free;
321 FBitmap := AValue;
322 FBitmapOwned := False;
323 UpdateSliceRectArray;
324end;
325
326procedure TBGRASliceScaling.SetBitmapSourceRect(AValue: TRect);
327begin
328 if (FBitmapSourceRect.Left=AValue.Left) and
329 (FBitmapSourceRect.Right=AValue.Right) and
330 (FBitmapSourceRect.Top=AValue.Top) and
331 (FBitmapSourceRect.Bottom=AValue.Bottom) then Exit;
332 FBitmapSourceRect:=AValue;
333 UpdateSliceRectArray;
334end;
335
336function TBGRASliceScaling.GetSlice(APosition: TSlicePosition): TBGRABitmap;
337begin
338 if FSliceBitmapArray[APosition] = nil then
339 with FSliceRectArray[APosition] do
340 begin
341 FSliceBitmapArray[APosition] := TBGRABitmap.Create(right - left, bottom - top);
342 FSliceBitmapArray[APosition].PutImage(-left, -top, FBitmap, dmSet);
343 end;
344 Result := FSliceBitmapArray[APosition];
345end;
346
347function TBGRASliceScaling.GetBitmapHeight: integer;
348begin
349 result := FBitmapSourceRect.Bottom - FBitmapSourceRect.Top;
350end;
351
352function TBGRASliceScaling.GetBitmapWidth: integer;
353begin
354 result := FBitmapSourceRect.Right - FBitmapSourceRect.Left;
355end;
356
357function TBGRASliceScaling.GetSliceRepeat(Aposition: TSliceRepeatPosition): boolean;
358begin
359 Result := FSliceRepeat[Aposition];
360end;
361
362function TBGRASliceScaling.GetSliceRepeatAsString: string;
363var p: TSliceRepeatPosition;
364begin
365 result := '';
366 for p := low(TSliceRepeatPosition) to high(TSliceRepeatPosition) do
367 if SliceRepeat[p] then
368 begin
369 if result <> '' then result += '+';
370 result += SliceRepeatPositionStr[p];
371 end;
372end;
373
374procedure TBGRASliceScaling.SetResampleFilter(AValue: TResampleFilter);
375begin
376 if FResampleFilter = AValue then
377 Exit;
378 FResampleFilter := AValue;
379end;
380
381procedure TBGRASliceScaling.SetResampleMode(AValue: TResampleMode);
382begin
383 if FResampleMode = AValue then
384 Exit;
385 FResampleMode := AValue;
386end;
387
388procedure TBGRASliceScaling.SetSliceRepeat(Aposition: TSliceRepeatPosition;
389 AValue: boolean);
390begin
391 FSliceRepeat[Aposition] := AValue;
392end;
393
394procedure TBGRASliceScaling.SetSliceRepeatAsString(AValue: string);
395var p: TSliceRepeatPosition;
396 attr: string;
397 idx: integer;
398begin
399 AValue := trim(AValue);
400 if compareText(AValue,'All')=0 then
401 begin
402 for p := low(TSliceRepeatPosition) to high(TSliceRepeatPosition) do
403 SliceRepeat[p] := true;
404 exit;
405 end;
406 for p := low(TSliceRepeatPosition) to high(TSliceRepeatPosition) do
407 SliceRepeat[p] := false;
408 if compareText(AValue,'None')=0 then exit;
409
410 while AValue <> '' do
411 begin
412 idx := pos('+',AValue);
413 if idx <> 0 then
414 begin
415 attr := copy(AValue,1,idx-1);
416 delete(AValue,1,idx);
417 end else
418 begin
419 attr := AValue;
420 AValue := '';
421 end;
422 for p := low(TSliceRepeatPosition) to high(TSliceRepeatPosition) do
423 if CompareText(SliceRepeatPositionStr[p],attr)=0 then
424 begin
425 SliceRepeat[p] := true;
426 attr := '';
427 break;
428 end;
429 if compareText(attr,'Auto')=0 then AutodetectRepeat else
430 if attr <> '' then
431 raise exception.Create('Unknown slice repeat attribute ('+attr+')');
432 end;
433end;
434
435procedure TBGRASliceScaling.UpdateSliceRectArray;
436begin
437 ClearBitmapArray;
438 if FBitmap = nil then exit;
439 FSliceRectArray := ComputeSliceRectArray(FBitmapSourceRect);
440end;
441
442function TBGRASliceScaling.ComputeSliceRectArray(ARect: TRect): TSliceRectArray;
443var
444 Width, Height: integer;
445 pos: TSlicePosition;
446 lMargins: TMargins;
447 ratio: single;
448begin
449 Width := ARect.Right - ARect.Left;
450 Height := ARect.Bottom - ARect.Top;
451 if (Width <= 0) or (Height <= 0) then
452 raise Exception.Create('Empty rectangle');
453
454 lMargins := FMargins;
455 if lMargins.top < 0 then
456 lMargins.top := 0;
457 if lMargins.right < 0 then
458 lMargins.right := 0;
459 if lMargins.bottom < 0 then
460 lMargins.bottom := 0;
461 if lMargins.left < 0 then
462 lMargins.left := 0;
463 if lmargins.left + lMargins.right >= Width then
464 begin
465 ratio := Width / (lmargins.left + lMargins.right + 1);
466 lMargins.left := trunc(lMargins.left * ratio);
467 lMargins.right := trunc(lMargins.right * ratio);
468 end;
469 if lmargins.top + lMargins.bottom >= Height then
470 begin
471 ratio := Height / (lmargins.top + lMargins.bottom + 1);
472 lMargins.top := trunc(lMargins.top * ratio);
473 lMargins.bottom := trunc(lMargins.bottom * ratio);
474 end;
475 with lMargins do
476 begin
477 Result[spTopLeft] := rect(0, 0, Left, Top);
478 Result[spTop] := rect(Left, 0, Width - Right, Top);
479 Result[spTopRight] := rect(Width - Right, 0, Width, Top);
480 Result[spLeft] := rect(0, Top, Left, Height - Bottom);
481 Result[spMiddle] := rect(Left, Top, Width - Right, Height - Bottom);
482 Result[spRight] := rect(Width - Right, Top, Width, Height - Bottom);
483 Result[spBottomLeft] := rect(0, Height - Bottom, Left, Height);
484 Result[spBottom] := rect(Left, Height - Bottom, Width - Right, Height);
485 Result[spBottomRight] := rect(Width - Right, Height - Bottom, Width, Height);
486 end;
487 for pos := low(TSlicePosition) to high(TSlicePosition) do
488 OffsetRect(Result[pos], ARect.Left, ARect.Top);
489end;
490
491procedure TBGRASliceScaling.SliceScalingDraw(ADest: TBGRABitmap;
492 ADestRect: TRect; DrawGrid: boolean);
493var
494 pos: TSlicePosition;
495 tempBGRA: TBGRABitmap;
496 DestSliceRect: TSliceRectArray;
497 repeatSlice: boolean;
498begin
499 if (ADestRect.Right <= ADestRect.Left) or (ADestRect.Bottom <= ADestRect.Top) then
500 exit;
501 DestSliceRect := ComputeSliceRectArray(ADestRect);
502 for pos := Low(TSlicePosition) to High(TSlicePosition) do
503 begin
504 with DestSliceRect[pos] do
505 begin
506 if (right > left) and (bottom > top) then
507 begin
508 case pos of
509 spTop: repeatSlice := SliceRepeat[srpTop];
510 spRight: repeatSlice := SliceRepeat[srpRight];
511 spBottom: repeatSlice := SliceRepeat[srpBottom];
512 spLeft: repeatSlice := SliceRepeat[srpLeft];
513 spMiddle: repeatSlice :=
514 SliceRepeat[srpMiddleHorizontal] and SliceRepeat[srpMiddleVertical];
515 else
516 repeatSlice := False;
517 end;
518 //simple copy
519 if (right - left = FSliceRectArray[pos].right - FSliceRectArray[pos].left) and
520 (bottom - top = FSliceRectArray[pos].bottom - FSliceRectArray[pos].top) then
521 begin
522 FBitmap.ScanOffset :=
523 point(FSliceRectArray[pos].left - left, FSliceRectArray[pos].top - top);
524 ADest.FillRect(left, top, right, bottom, FBitmap, FDrawMode);
525 end
526 else
527 //repeat in both direction
528 if repeatSlice then
529 begin
530 tempBGRA := SliceBitmap[pos];
531 tempBGRA.ScanOffset := point(-left, -top);
532 ADest.FillRect(left, top, right, bottom, tempBGRA, FDrawMode);
533 end
534 else
535 //resample in both directions (or in one direction if the other direction has the same size)
536 if (pos <> spMiddle) or (not SliceRepeat[srpMiddleHorizontal] and
537 not SliceRepeat[srpMiddleVertical]) then
538 begin
539 SliceBitmap[pos].ResampleFilter := ResampleFilter;
540 tempBGRA := SliceBitmap[pos].Resample(right - left, bottom -
541 top, FResampleMode) as TBGRABitmap;
542 ADest.PutImage(left, top, tempBGRA, FDrawMode);
543 tempBGRA.Free;
544 end
545 else //one dimension resample, other dimension resample
546 begin
547 SliceBitmap[pos].ResampleFilter := ResampleFilter;
548 if not SliceRepeat[srpMiddleHorizontal] then
549 tempBGRA := SliceBitmap[pos].Resample(
550 right - left, SliceBitmap[pos].Height, FResampleMode) as TBGRABitmap
551 else
552 tempBGRA := SliceBitmap[pos].Resample(
553 SliceBitmap[pos].Width, bottom - top, FResampleMode) as TBGRABitmap;
554 tempBGRA.ScanOffset := point(-left, -top);
555 ADest.FillRect(left, top, right, bottom, tempBGRA, FDrawMode);
556 tempBGRA.Free;
557 end;
558 end;
559 end;
560 end;
561 if DrawGrid then
562 begin
563 ADest.DrawLineAntialias(DestSliceRect[spTop].left, DestSliceRect[spTop].top,
564 DestSliceRect[spBottom].left, DestSliceRect[spBottom].bottom,
565 BGRA(255, 0, 0, 255), BGRAPixelTransparent, 1, False);
566 ADest.DrawLineAntialias(DestSliceRect[spTop].right - 1, DestSliceRect[spTop].top,
567 DestSliceRect[spBottom].right - 1, DestSliceRect[spBottom].bottom,
568 BGRA(255, 0, 0, 255), BGRAPixelTransparent, 1, False);
569 ADest.DrawLineAntialias(DestSliceRect[spLeft].left, DestSliceRect[spLeft].top,
570 DestSliceRect[spRight].right, DestSliceRect[spRight].top,
571 BGRA(255, 0, 0, 255), BGRAPixelTransparent, 1, False);
572 ADest.DrawLineAntialias(DestSliceRect[spLeft].left, DestSliceRect[spLeft].bottom - 1,
573 DestSliceRect[spRight].right, DestSliceRect[spRight].bottom - 1,
574 BGRA(255, 0, 0, 255), BGRAPixelTransparent, 1, False);
575 end;
576end;
577
578procedure TBGRASliceScaling.Init;
579var
580 pos: TSliceRepeatPosition;
581begin
582 FBitmap := nil;
583 FBitmapOwned := False;
584 for pos := low(TSliceRepeatPosition) to high(TSliceRepeatPosition) do
585 FSliceRepeat[pos] := False;
586 SetMargins(0, 0, 0, 0);
587 FBitmapSourceRect := rect(0,0,0,0);
588 DrawMode := dmDrawWithTransparency;
589 ResampleMode := rmFineResample;
590 ResampleFilter := rfHalfCosine;
591end;
592
593procedure TBGRASliceScaling.ClearBitmapArray;
594var
595 pos: TSlicePosition;
596begin
597 for pos := low(TSlicePosition) to high(TSlicePosition) do
598 FreeAndNil(FSliceBitmapArray[pos]);
599end;
600
601constructor TBGRASliceScaling.Create(ABitmap: TBGRABitmap;
602 AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer; ABitmapOwner: boolean = false);
603begin
604 Create(ABitmap, ABitmapOwner);
605 SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft);
606end;
607
608constructor TBGRASliceScaling.Create(ABitmap: TBitmap;
609 AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer);
610begin
611 Create(ABitmap);
612 SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft);
613end;
614
615constructor TBGRASliceScaling.Create(AFilename: string;
616 AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer);
617begin
618 Create(AFilename);
619 SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft);
620end;
621
622constructor TBGRASliceScaling.Create(AFilename: string; AIsUtf8: boolean;
623 AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer);
624begin
625 Create(AFilename, AIsUtf8);
626 SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft);
627end;
628
629constructor TBGRASliceScaling.Create(AStream: TStream;
630 AMarginTop, AMarginRight, AMarginBottom, AMarginLeft: integer);
631begin
632 Create(AStream);
633 SetMargins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft);
634end;
635
636constructor TBGRASliceScaling.Create(ABitmap: TBGRABitmap; ABitmapOwner: boolean = false);
637begin
638 Init;
639 FBitmap := ABitmap;
640 FBitmapOwned := ABitmapOwner;
641 FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height);
642end;
643
644constructor TBGRASliceScaling.Create(ABitmap: TBitmap);
645begin
646 Init;
647 FBitmap := TBGRABitmap.Create(ABitmap);
648 FBitmapOwned := True;
649 FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height);
650end;
651
652constructor TBGRASliceScaling.Create(AFilename: string);
653begin
654 Init;
655 FBitmap := TBGRABitmap.Create(AFilename);
656 FBitmapOwned := True;
657 FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height);
658end;
659
660constructor TBGRASliceScaling.Create(AFilename: string; AIsUtf8: boolean);
661begin
662 Init;
663 FBitmap := TBGRABitmap.Create(AFilename,AIsUtf8);
664 FBitmapOwned := True;
665 FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height);
666end;
667
668constructor TBGRASliceScaling.Create(AStream: TStream);
669begin
670 Init;
671 FBitmap := TBGRABitmap.Create(AStream);
672 FBitmapOwned := True;
673 FBitmapSourceRect := rect(0,0,FBitmap.Width,FBitmap.Height);
674end;
675
676constructor TBGRASliceScaling.Create;
677begin
678 Init;
679end;
680
681procedure TBGRASliceScaling.SetMargins(AMarginTop, AMarginRight,
682 AMarginBottom, AMarginLeft: integer);
683begin
684 SetMargins(BGRASliceScaling.Margins(AMarginTop, AMarginRight, AMarginBottom, AMarginLeft));
685end;
686
687procedure TBGRASliceScaling.SetMargins(AMargins: TMargins);
688begin
689 if (AMargins.top <> FMargins.top) or (AMargins.right <> FMargins.right) or
690 (AMargins.bottom <> FMargins.bottom) or (AMargins.left <> FMargins.left) then
691 begin
692 FMargins := AMargins;
693 UpdateSliceRectArray;
694 end;
695end;
696
697destructor TBGRASliceScaling.Destroy;
698begin
699 ClearBitmapArray;
700 if FBitmapOwned then
701 FreeAndNil(FBitmap);
702 inherited Destroy;
703end;
704
705procedure TBGRASliceScaling.NotifyBitmapChanged;
706begin
707 ClearBitmapArray;
708end;
709
710procedure TBGRASliceScaling.Draw(ABitmap: TBGRABitmap; ARect: TRect; DrawGrid: boolean);
711begin
712 SliceScalingDraw(ABitmap, ARect, DrawGrid);
713end;
714
715procedure TBGRASliceScaling.Draw(ABitmap: TBGRABitmap;
716 ALeft, ATop, AWidth, AHeight: integer; DrawGrid: boolean);
717begin
718 Draw(ABitmap, rect(ALeft, ATop, ALeft + AWidth, ATop + AHeight), DrawGrid);
719end;
720
721procedure TBGRASliceScaling.AutodetectRepeat;
722var
723 middleSlice: TBGRABitmap;
724 x, y: integer;
725 p: PBGRAPixel;
726 c0: TBGRAPixel;
727 isRepeating: boolean;
728begin
729 middleSlice := SliceBitmap[spMiddle];
730 isRepeating := True;
731 for y := 0 to middleSlice.Height - 1 do
732 begin
733 p := middleSlice.ScanLine[y];
734 c0 := p^;
735 for x := middleSlice.Width - 1 downto 0 do
736 begin
737 if p^ <> c0 then
738 begin
739 isRepeating := False;
740 break;
741 end;
742 Inc(p);
743 end;
744 if not isRepeating then
745 break;
746 end;
747 if isRepeating then
748 SliceRepeat[srpMiddleHorizontal] := True;
749
750 isRepeating := True;
751 for x := 0 to middleSlice.Width - 1 do
752 begin
753 c0 := middleSlice.GetPixel(x, 0);
754 for y := middleSlice.Height - 1 downto 1 do
755 begin
756 if middleSlice.GetPixel(x, y) <> c0 then
757 begin
758 isRepeating := False;
759 break;
760 end;
761 end;
762 if not isRepeating then
763 break;
764 end;
765 if isRepeating then
766 SliceRepeat[srpMiddleVertical] := True;
767end;
768
769end.
Note: See TracBrowser for help on using the repository browser.