1 // SPDX-License-Identifier: LGPL-3.0-linking-exception
2 unit BGRAGraphics;
3 {=== Types imported from Graphics ===}
4 {$mode objfpc}{$H+}
5 {$I bgrabitmap.inc}
6
7 interface
8
9 {$IFDEF BGRABITMAP_USE_LCL}
10 uses Graphics, GraphType, FPImage, FPCanvas;
11
12 type
13 PColor = Graphics.PColor;
14 TColor = Graphics.TColor;
15 TAntialiasingMode = Graphics.TAntialiasingMode;
16 TGradientDirection = Graphics.TGradientDirection;
17 TPenEndCap = Graphics.TPenEndCap;
18 TPenJoinStyle = Graphics.TPenJoinStyle;
19 TPenStyle = Graphics.TPenStyle;
20 TPenMode = Graphics.TPenMode;
21
22 const
23 amDontCare = Graphics.amDontCare;
24 amOn = Graphics.amOn;
25 amOff = Graphics.amOff;
26
27 gdVertical = Graphics.gdVertical;
28 gdHorizontal = Graphics.gdHorizontal;
29
30 pecRound = Graphics.pecRound;
31 pecSquare = Graphics.pecSquare;
32 pecFlat = Graphics.pecFlat;
33
34 pjsRound = Graphics.pjsRound;
35 pjsBevel = Graphics.pjsBevel;
36 pjsMiter = Graphics.pjsMiter;
37
38 psSolid = Graphics.psSolid;
39 psDash = Graphics.psDash;
40 psDot = Graphics.psDot;
41 psDashDot = Graphics.psDashDot;
42 psDashDotDot = Graphics.psDashDotDot;
43 psClear = Graphics.psClear;
44 psInsideframe = Graphics.psInsideframe;
45 psPattern = Graphics.psPattern;
46
47 pmBlack = Graphics.pmBlack;
48 pmWhite = Graphics.pmWhite;
49 pmNop = Graphics.pmNop;
50 pmNot = Graphics.pmNot;
51 pmCopy = Graphics.pmCopy;
52 pmNotCopy = Graphics.pmNotCopy;
53 pmMergePenNot = Graphics.pmMergePenNot;
54 pmMaskPenNot = Graphics.pmMaskPenNot;
55 pmMergeNotPen = Graphics.pmMergeNotPen;
56 pmMaskNotPen = Graphics.pmMaskNotPen;
57 pmMerge = Graphics.pmMerge;
58 pmNotMerge = Graphics.pmNotMerge;
59 pmMask = Graphics.pmMask;
60 pmNotMask = Graphics.pmNotMask;
61 pmXor = Graphics.pmXor;
62 pmNotXor = Graphics.pmNotXor;
63
64 tmAuto = Graphics.tmAuto;
65 tmFixed = Graphics.tmFixed;
66
67 type
68 TPen = Graphics.TPen;
69 TTextLayout = Graphics.TTextLayout;
70 TTextStyle = Graphics.TTextStyle;
71
72 TFillStyle = Graphics.TFillStyle;
73 TFillMode = Graphics.TFillMode;
74 TBrushStyle = Graphics.TBrushStyle;
75
76 const
77 tlTop = Graphics.tlTop;
78 tlCenter = Graphics.tlCenter;
79 tlBottom = Graphics.tlBottom;
80
81 fsSurface = GraphType.fsSurface;
82 fsBorder = GraphType.fsBorder;
83
84 fmAlternate = Graphics.fmAlternate;
85 fmWinding = Graphics.fmWinding;
86
87 bsSolid = Graphics.bsSolid;
88 bsClear = Graphics.bsClear;
89 bsHorizontal = Graphics.bsHorizontal;
90 bsVertical = Graphics.bsVertical;
91 bsFDiagonal = Graphics.bsFDiagonal;
92 bsBDiagonal = Graphics.bsBDiagonal;
93 bsCross = Graphics.bsCross;
94 bsDiagCross = Graphics.bsDiagCross;
95 bsImage = FPCanvas.bsImage;
96
97 type
98 TBrush = Graphics.TBrush;
99 TCanvas = Graphics.TCanvas;
100 TGraphic = Graphics.TGraphic;
101 TRawImage = GraphType.TRawImage;
102 TBitmap = Graphics.TBitmap;
103
104 TRasterImage = Graphics.TRasterImage;
105
106 TFontStyle = Graphics.TFontStyle;
107 TFontStyles = Graphics.TFontStyles;
108 TFontQuality = Graphics.TFontQuality;
109
110 type
111 TFont = Graphics.TFont;
112
113 const
114 fsBold = Graphics.fsBold;
115 fsItalic = Graphics.fsItalic;
116 fsStrikeOut = Graphics.fsStrikeOut;
117 fsUnderline = Graphics.fsUnderline;
118
119 fqDefault = Graphics.fqDefault;
120 fqDraft = Graphics.fqDraft;
121 fqProof = Graphics.fqProof;
122 fqNonAntialiased = Graphics.fqNonAntialiased;
123 fqAntialiased = Graphics.fqAntialiased;
124 fqCleartype = Graphics.fqCleartype;
125 fqCleartypeNatural = Graphics.fqCleartypeNatural;
126
127 clNone = Graphics.clNone;
128
129 clBlack = Graphics.clBlack;
130 clMaroon = Graphics.clMaroon;
131 clGreen = Graphics.clGreen;
132 clOlive = Graphics.clOlive;
133 clNavy = Graphics.clNavy;
134 clPurple = Graphics.clPurple;
135 clTeal = Graphics.clTeal;
136 clGray = Graphics.clGray;
137 clSilver = Graphics.clSilver;
138 clRed = Graphics.clRed;
139 clLime = Graphics.clLime;
140 clYellow = Graphics.clYellow;
141 clBlue = Graphics.clBlue;
142 clFuchsia = Graphics.clFuchsia;
143 clAqua = Graphics.clAqua;
144 clLtGray = Graphics.clLtGray; // clSilver alias
145 clDkGray = Graphics.clDkGray; // clGray alias
146 clWhite = Graphics.clWhite;
147
FPColorToTColornull148 function FPColorToTColor(const FPColor: TFPColor): TColor; inline;
TColorToFPColornull149 function TColorToFPColor(const c: TColor): TFPColor; inline;
ColorToRGBnull150 function ColorToRGB(c: TColor): TColor; inline;
RGBToColornull151 function RGBToColor(R, G, B: Byte): TColor; inline;
152 procedure RedGreenBlue(rgb: TColor; out Red, Green, Blue: Byte); inline;// does not work on system color
clRgbBtnHighlightnull153 function clRgbBtnHighlight: TColor;
clRgbBtnShadownull154 function clRgbBtnShadow: TColor;
155
156 implementation
157
FPColorToTColornull158 function FPColorToTColor(const FPColor: TFPColor): TColor;
159 begin
160 result := Graphics.FPColorToTColor(FPColor);
161 end;
162
TColorToFPColornull163 function TColorToFPColor(const c: TColor): TFPColor;
164 begin
165 result := Graphics.TColorToFPColor(c);
166 end;
167
ColorToRGBnull168 function ColorToRGB(c: TColor): TColor;
169 begin
170 result := Graphics.ColorToRGB(c);
171 end;
172
RGBToColornull173 function RGBToColor(R, G, B: Byte): TColor;
174 begin
175 result := Graphics.RGBToColor(R, G, B);
176 end;
177
178 procedure RedGreenBlue(rgb: TColor; out Red, Green, Blue: Byte);
179 begin
180 Graphics.RedGreenBlue(rgb, Red, Green, Blue);
181 end;
182
clRgbBtnHighlightnull183 function clRgbBtnHighlight: TColor;
184 begin
185 result := Graphics.ColorToRGB(clBtnHighlight);
186 end;
187
clRgbBtnShadownull188 function clRgbBtnShadow: TColor;
189 begin
190 result := Graphics.ColorToRGB(clBtnShadow);
191 end;
192
193 {$ELSE}
194
195 {$IFDEF BGRABITMAP_USE_MSEGUI}
196 {$i bgramsegui_uses.inc}
197 {$ELSE}
198 {$IFDEF BGRABITMAP_USE_FPGUI}
199 {$i bgrafpgui_uses.inc}
200 {$ELSE}
201 {$i bgranogui_uses.inc}
202 {$ENDIF}
203 {$ENDIF}
204
205 type
206 TTransparentMode = (tmAuto, tmFixed);
207 TGraphic = class;
208
209 {$DEFINE INCLUDE_INTERFACE}
210 {$IFDEF BGRABITMAP_USE_MSEGUI}
211 {$i bgramsegui.inc}
212 {$ELSE}
213 {$IFDEF BGRABITMAP_USE_FPGUI}
214 {$i bgrafpgui.inc}
215 {$ELSE}
216 {$i bgranogui.inc}
217 {$ENDIF}
218 {$ENDIF}
219
220 type
221 {* Pointer to a ''TColor'' value }
222 PColor = ^TColor;
223 {* Contains a color stored as RGB. The red/green/blue values
224 range from 0 to 255. The formula to get the color value is:
225 * ''color'' = ''red'' + (''green'' '''shl''' 8) + (''blue'' '''shl''' 16)
226 *except with fpGUI where it is:
227 * ''color'' = (''red'' '''shl''' 16) + (''green'' '''shl''' 8) + ''blue'' }{import
228 TColor = Int32;
229 }
230 {** Converts a ''TFPColor'' into a ''TColor'' value }
FPColorToTColornull231 function FPColorToTColor(const FPColor: TFPColor): TColor;
232 {** Converts a ''TColor'' into a ''TFPColor'' value }
TColorToFPColornull233 function TColorToFPColor(const c: TColor): TFPColor;
234
RGBToColornull235 function RGBToColor(R, G, B: Byte): TColor; inline;
236 procedure RedGreenBlue(rgb: TColor; out Red, Green, Blue: Byte); // does not work on system color
237
238 type
239 {* Direction of change in a gradient }
240 TGradientDirection = (
241 {** Color changes vertically }
242 gdVertical,
243 {** Color changes horizontally }
244 gdHorizontal);
245
246 {* Antialiasing mode for a Canvas }
247 TAntialiasingMode = (
248 {** It does not matter if there is antialiasing or not }
249 amDontCare,
250 {** Antialiasing is required (BGRACanvas provide it) }
251 amOn,
252 {** Antialiasing is disabled }
253 amOff);
254
255 type
256 {* Vertical position of a text }
257 TTextLayout = (tlTop, tlCenter, tlBottom);
258 {* Styles to describe how a text is drawn in a rectangle }
259 TTextStyle = packed record
260 {** Horizontal alignment }
261 Alignment : TAlignment;
262
263 {** Vertical alignment }
264 Layout : TTextLayout;
265
266 {** If WordBreak is false then process #13, #10 as
267 standard chars and perform no Line breaking }
268 SingleLine: boolean;
269
270 {** Clip Text to passed Rectangle }
271 Clipping : boolean;
272
273 {** Replace #9 by apropriate amount of spaces (default is usually 8) }
274 ExpandTabs: boolean;
275
276 {** Process first single '&' per line as an underscore and draw '&&' as '&' }
277 ShowPrefix: boolean;
278
279 {** If line of text is too long too fit between left and right boundaries
280 try to break into multiple lines between words. See also ''EndEllipsis'' }
281 Wordbreak : boolean;
282
283 {** Fills background with current brush }
284 Opaque : boolean;
285
286 {** Use the system font instead of canvas font }
287 SystemFont: Boolean;
288
289 {** For RightToLeft text reading (Text Direction) }
290 RightToLeft: Boolean;
291
292 {** If line of text is too long to fit between left and right boundaries
293 truncates the text and adds "...". If Wordbreak is set as well,
294 Workbreak will dominate }
295 EndEllipsis: Boolean;
296 end;
297
298 {* Option for floodfill (used in BGRACanvas) }
299 TFillStyle =
300 (
301 {** Fill up to the color (it fills all except the specified color) }
302 fsSurface,
303 {** Fill the specified color (it fills only connected pixels of this color) }
304 fsBorder
305 );
306 {* How to handle polygons that intersect with themselves and
307 overlapping polygons }
308 TFillMode = (
309 {** Each time a boundary is found, it enters or exit the filling zone }
310 fmAlternate,
311 {** Adds or subtract 1 depending on the order of the points of the
312 polygons (clockwise or counter clockwise) and fill when the
313 result is non-zero. So, to draw a hole, you must specify the points
314 of the hole in the opposite order }
315 fmWinding);
316
317 type
318 {$IFNDEF TFontStyle}
319 {* Available font styles }
320 TFontStyle = (
321 {** Font is bold }
322 fsBold,
323 {** Font is italic }
324 fsItalic,
325 {** An horizontal line is drawn in the middle of the text }
326 fsStrikeOut,
327 {** Text is underlined }
328 fsUnderline);
329 {** A combination of font styles }
330 TFontStyles = set of TFontStyle;
331 {$ENDIF}
332 {$IFNDEF TFontQuality}
333 {* Quality to use when font is rendered by the system }
334 TFontQuality = (fqDefault, fqDraft, fqProof, fqNonAntialiased, fqAntialiased, fqCleartype, fqCleartypeNatural);
335 {$ENDIF}
336
337 {$IFNDEF TCanvas}
338 { TCanvas }
339 {* A surface on which to draw }
340 TCanvas = class
341 protected
342 FCanvas: TGUICanvas;
343 public
344 constructor Create(ACanvas: TGUICanvas);
345 {** Draw an image with top-left corner at (''x'',''y'') }
346 procedure Draw(x,y: integer; AImage: TGraphic);
347 {** Draw and stretch an image within the rectangle ''ARect'' }
348 procedure StretchDraw(ARect: TRect; AImage: TGraphic);
349 property GUICanvas: TGUICanvas read FCanvas;
350 end;
351 {$ENDIF}
352
353 { TGraphic }
354 {* A class containing any element that can be drawn within rectangular bounds }
355 TGraphic = class(TPersistent)
356 protected
357 procedure Draw(ACanvas: TCanvas; const Rect: TRect); virtual; abstract;
GetEmptynull358 function GetEmpty: Boolean; virtual; abstract;
GetHeightnull359 function GetHeight: Integer; virtual; abstract;
GetWidthnull360 function GetWidth: Integer; virtual; abstract;
GetTransparentnull361 function GetTransparent: Boolean; virtual; abstract;
362 procedure SetTransparent(Value: Boolean); virtual; abstract;
363 procedure SetHeight(Value: Integer); virtual; abstract;
364 procedure SetWidth(Value: Integer); virtual; abstract;
GetMimeTypenull365 function GetMimeType: string; virtual;
366 public
367 constructor Create; virtual;
368 {** Load the content from a given file }
369 procedure LoadFromFile({%H-}const Filename: string); virtual;
370 {** Load the content from a given stream }
371 procedure LoadFromStream(Stream: TStream); virtual; abstract;
372 {** Saves the content to a file }
373 procedure SaveToFile({%H-}const Filename: string); virtual;
374 {** Saves the content into a given stream }
375 procedure SaveToStream(Stream: TStream); virtual; abstract;
376 {** Returns the list of possible file extensions }
GetFileExtensionsnull377 class function GetFileExtensions: string; virtual;
378 {** Clears the content }
379 procedure Clear; virtual;
380 public
381 {** Returns if the content is completely empty }
382 property Empty: Boolean read GetEmpty;
383 {** Returns the height of the bounding rectangle }
384 property Height: Integer read GetHeight write SetHeight;
385 {** Returns the width of the bounding rectangle }
386 property Width: Integer read GetWidth write SetWidth;
387 {** Gets or sets if it is drawn with transparency }
388 property Transparent: Boolean read GetTransparent write SetTransparent;
389 end;
390
391 {$IFNDEF TBitmap}
392 { TBitmap }
393 {* Contains a bitmap }
394 TBitmap = class(TGraphic)
395 private
396 FHeight: integer;
397 FWidth: integer;
398 FInDraw: boolean;
399 FTransparent: boolean;
400 FTransparentColor: TColor;
401 FTransparentMode: TTransparentMode;
GetCanvasnull402 function GetCanvas: TCanvas;
GetRawImagenull403 function GetRawImage: TRawImage;
404 procedure SetTransparentColor(AValue: TColor);
405 procedure SetTransparentMode(AValue: TTransparentMode);
406 protected
407 FRawImage: TRawImage;
408 procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
409 procedure Changed(Sender: TObject); virtual;
GetHeightnull410 function GetHeight: Integer; override;
GetWidthnull411 function GetWidth: Integer; override;
412 procedure SetHeight(Value: Integer); override;
413 procedure SetWidth(Value: Integer); override;
GetEmptynull414 function GetEmpty: Boolean; override;
GetTransparentnull415 function GetTransparent: Boolean; override;
416 procedure SetTransparent({%H-}Value: Boolean); override;
GetMimeTypenull417 function GetMimeType: string; override;
418 public
419 constructor Create; override;
420 destructor Destroy; override;
421 procedure LoadFromStream({%H-}Stream: TStream); override;
422 procedure SaveToStream({%H-}Stream: TStream); override;
423 {** Width of the bitmap in pixels }
424 property Width: integer read GetWidth write SetWidth;
425 {** Height of the bitmap in pixels }
426 property Height: integer read GetHeight write SetHeight;
427 property RawImage: TRawImage read GetRawImage;
428 property Canvas: TCanvas read GetCanvas;
429 property TransparentColor: TColor read FTransparentColor
430 write SetTransparentColor default clDefault;
431 property TransparentMode: TTransparentMode read FTransparentMode
432 write SetTransparentMode default tmAuto;
433 end;
434 {$ENDIF}
435
436 {* Multiply and divide the number allowing big intermediate number and rounding the result }
MulDivnull437 function MulDiv(nNumber, nNumerator, nDenominator: Integer): Integer;
438 {* Round the number using math convention }
MathRoundnull439 function MathRound(AValue: ValReal): Int64; inline;
440
441 {$IFDEF BGRABITMAP_USE_FPCANVAS}
442 {$DEFINE INCLUDE_INTERFACE}
443 {$i bgrafpcanvas.inc}
444 {$ENDIF}
445
446 implementation
447
448 uses sysutils, BGRAUTF8;
449
450 {$DEFINE INCLUDE_IMPLEMENTATION}
451 {$IFDEF BGRABITMAP_USE_MSEGUI}
452 {$i bgramsegui.inc}
453 {$ELSE}
454 {$IFDEF BGRABITMAP_USE_FPGUI}
455 {$i bgrafpgui.inc}
456 {$ELSE}
457 {$i bgranogui.inc}
458 {$ENDIF}
459 {$ENDIF}
460
MathRoundnull461 function MathRound(AValue: ValReal): Int64; inline;
462 begin
463 if AValue >= 0 then
464 Result := Trunc(AValue + 0.5)
465 else
466 Result := Trunc(AValue - 0.5);
467 end;
468
MulDivnull469 function MulDiv(nNumber, nNumerator, nDenominator: Integer): Integer;
470 begin
471 if nDenominator = 0 then
472 Result := -1
473 else
474 Result := MathRound(int64(nNumber) * int64(nNumerator) / nDenominator);
475 end;
476
FPColorToTColornull477 function FPColorToTColor(const FPColor: TFPColor): TColor;
478 begin
479 {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE}
480 Result:=((FPColor.Blue shr 8) and $ff)
481 or (FPColor.Green and $ff00)
482 or ((FPColor.Red shl 8) and $ff0000);
483 {$ELSE}
484 Result:=((FPColor.Red shr 8) and $ff)
485 or (FPColor.Green and $ff00)
486 or ((FPColor.Blue shl 8) and $ff0000);
487 {$ENDIF}
488 end;
489
TColorToFPColornull490 function TColorToFPColor(const c: TColor): TFPColor;
491 begin
492 {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE}
493 Result.Blue:=(c and $ff);
494 Result.Blue:=Result.Blue+(Result.Blue shl 8);
495 Result.Green:=(c and $ff00);
496 Result.Green:=Result.Green+(Result.Green shr 8);
497 Result.Red:=(c and $ff0000) shr 8;
498 Result.Red:=Result.Red+(Result.Red shr 8);
499 {$ELSE}
500 Result.Red:=(c and $ff);
501 Result.Red:=Result.Red+(Result.Red shl 8);
502 Result.Green:=(c and $ff00);
503 Result.Green:=Result.Green+(Result.Green shr 8);
504 Result.Blue:=(c and $ff0000) shr 8;
505 Result.Blue:=Result.Blue+(Result.Blue shr 8);
506 {$ENDIF}
507 Result.Alpha:=FPImage.alphaOpaque;
508 end;
509
510 procedure RedGreenBlue(rgb: TColor; out Red, Green, Blue: Byte);
511 begin
512 {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE}
513 Blue := rgb and $000000ff;
514 Green := (rgb shr 8) and $000000ff;
515 Red := (rgb shr 16) and $000000ff;
516 {$ELSE}
517 Red := rgb and $000000ff;
518 Green := (rgb shr 8) and $000000ff;
519 Blue := (rgb shr 16) and $000000ff;
520 {$ENDIF}
521 end;
522
RGBToColornull523 function RGBToColor(R, G, B: Byte): TColor;
524 begin
525 {$IFDEF TCOLOR_BLUE_IN_LOW_BYTE}
526 Result := (R shl 16) or (G shl 8) or B;
527 {$ELSE}
528 Result := (B shl 16) or (G shl 8) or R;
529 {$ENDIF}
530 end;
531
532 { TGraphic }
533
TGraphic.GetMimeTypenull534 function TGraphic.GetMimeType: string;
535 begin
536 result := '';
537 end;
538
539 constructor TGraphic.Create;
540 begin
541 //nothing
542 end;
543
544 procedure TGraphic.LoadFromFile(const Filename: string);
545 var
546 Stream: TStream;
547 begin
548 Stream := TFileStreamUTF8.Create(Filename, fmOpenRead or fmShareDenyWrite);
549 try
550 LoadFromStream(Stream);
551 finally
552 Stream.Free;
553 end;
554 end;
555
556 procedure TGraphic.SaveToFile(const Filename: string);
557 var
558 Stream: TStream;
559 begin
560 Stream := TFileStreamUTF8.Create(Filename, fmCreate);
561 try
562 SaveToStream(Stream);
563 finally
564 Stream.Free;
565 end;
566 end;
567
TGraphic.GetFileExtensionsnull568 class function TGraphic.GetFileExtensions: string;
569 begin
570 result := '';
571 end;
572
573 procedure TGraphic.Clear;
574 begin
575 //nothing
576 end;
577
578 {$IFNDEF TCanvas}
579 { TCanvas }
580
581 constructor TCanvas.Create(ACanvas: TGUICanvas);
582 begin
583 FCanvas := ACanvas;
584 end;
585
586 procedure TCanvas.Draw(x, y: integer; AImage: TGraphic);
587 begin
588 if AImage is TBitmap then
589 FCanvas.DrawImage(x,y, TBitmap(AImage).RawImage)
590 else
591 AImage.Draw(self, rect(x,y,x+AImage.Width,y+AImage.Height));
592 end;
593
594 procedure TCanvas.StretchDraw(ARect: TRect; AImage: TGraphic);
595 begin
596 if AImage is TBitmap then
597 FCanvas.StretchDraw(ARect.Left,ARect.Top,ARect.Right-ARect.Left,ARect.Bottom-ARect.Top, TBitmap(AImage).RawImage)
598 else
599 AImage.Draw(self, ARect);
600 end;
601 {$ENDIF}
602
603 {$IFNDEF TBitmap}
604 { TBitmap }
605
606 procedure TBitmap.SetWidth(Value: Integer);
607 begin
608 if FWidth=Value then Exit;
609 FWidth:=Value;
610 end;
611
TBitmap.GetEmptynull612 function TBitmap.GetEmpty: Boolean;
613 begin
614 result := (Width = 0) or (Height = 0);
615 end;
616
TBitmap.GetTransparentnull617 function TBitmap.GetTransparent: Boolean;
618 begin
619 result := FTransparent;
620 end;
621
622 procedure TBitmap.SetTransparent(Value: Boolean);
623 begin
624 if Value = FTransparent then exit;
625 FTransparent:= Value;
626 end;
627
628 procedure TBitmap.SetTransparentColor(AValue: TColor);
629 begin
630 if FTransparentColor = AValue then exit;
631 FTransparentColor := AValue;
632
633 if AValue = clDefault
634 then FTransparentMode := tmAuto
635 else FTransparentMode := tmFixed;
636 end;
637
638 procedure TBitmap.SetTransparentMode(AValue: TTransparentMode);
639 begin
640 if AValue = TransparentMode then exit;
641 FTransparentMode := AValue;
642
643 if AValue = tmAuto
644 then TransparentColor := clDefault
645 end;
646
GetMimeTypenull647 function TBitmap.GetMimeType: string;
648 begin
649 Result:= 'image/bmp';
650 end;
651
652 procedure TBitmap.Changed(Sender: TObject);
653 begin
654 //nothing
655 end;
656
657 procedure TBitmap.LoadFromStream(Stream: TStream);
658 begin
659 raise exception.Create('Not implemented');
660 end;
661
662 procedure TBitmap.SaveToStream(Stream: TStream);
663 begin
664 raise exception.Create('Not implemented');
665 end;
666
667 procedure TBitmap.SetHeight(Value: Integer);
668 begin
669 if FHeight=Value then Exit;
670 FHeight:=Value;
671 end;
672
TBitmap.GetRawImagenull673 function TBitmap.GetRawImage: TRawImage;
674 begin
675 FRawImage.BGRASetSizeAndTransparency(FWidth, FHeight, FTransparent);
676 result := FRawImage;
677 end;
678
679 procedure TBitmap.Draw(ACanvas: TCanvas; const Rect: TRect);
680 begin
681 if FInDraw then exit;
682 FInDraw := true;
683 ACanvas.StretchDraw(Rect, self);
684 FInDraw := false;
685 end;
686
TBitmap.GetHeightnull687 function TBitmap.GetHeight: Integer;
688 begin
689 result := FHeight;
690 end;
691
GetWidthnull692 function TBitmap.GetWidth: Integer;
693 begin
694 result := FWidth;
695 end;
696
TBitmap.GetCanvasnull697 function TBitmap.GetCanvas: TCanvas;
698 begin
699 result := nil;
700 raise exception.Create('Canvas not available');
701 end;
702
703 constructor TBitmap.Create;
704 begin
705 FRawImage := TRawImage.Create;
706 FTransparent:= false;
707 end;
708
709 destructor TBitmap.Destroy;
710 begin
711 FRawImage.Free;
712 inherited Destroy;
713 end;
714 {$ENDIF}
715
716 {$IFDEF BGRABITMAP_USE_FPCANVAS}
717 {$DEFINE INCLUDE_IMPLEMENTATION}
718 {$i bgrafpcanvas.inc}
719 {$ENDIF}
720
721 {$ENDIF}
722
723 end.
724
725