home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / graphics32 / GR32_Image.pas < prev    next >
Pascal/Delphi Source File  |  2005-01-24  |  54KB  |  2,052 lines
  1. unit GR32_Image;
  2.  
  3. (* ***** BEGIN LICENSE BLOCK *****
  4.  * Version: MPL 1.1
  5.  *
  6.  * The contents of this file are subject to the Mozilla Public License Version
  7.  * 1.1 (the "License"); you may not use this file except in compliance with
  8.  * the License. You may obtain a copy of the License at
  9.  * http://www.mozilla.org/MPL/
  10.  *
  11.  * Software distributed under the License is distributed on an "AS IS" basis,
  12.  * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  13.  * for the specific language governing rights and limitations under the
  14.  * License.
  15.  *
  16.  * The Original Code is Graphics32
  17.  *
  18.  * The Initial Developer of the Original Code is
  19.  * Alex A. Denisov
  20.  *
  21.  * Portions created by the Initial Developer are Copyright (C) 2000-2004
  22.  * the Initial Developer. All Rights Reserved.
  23.  *
  24.  * Contributor(s):
  25.  * Mattias Andersson <mattias@centaurix.com>
  26.  * Andre Beckedorf <Andre@metaException.de>
  27.  * Andrew P. Rybin <aprybin@users.sourceforge.net>
  28.  *
  29.  * ***** END LICENSE BLOCK ***** *)
  30.  
  31. interface
  32.  
  33. {$I GR32.inc}
  34.  
  35. uses
  36. {$IFDEF CLX}
  37.   Qt, Types, QControls, QGraphics, QForms, QConsts,
  38.   {$IFDEF LINUX}Libc,{$ENDIF}
  39.   {$IFDEF MSWINDOWS}Windows,{$ENDIF}
  40. {$ELSE}
  41.   Windows, Messages, Controls, Graphics, Forms,
  42. {$ENDIF}
  43.   Classes, SysUtils, GR32, GR32_Layers, GR32_RangeBars;
  44.  
  45. const
  46.   { Paint Stage Constants }
  47.   PST_CUSTOM            = 1;   // Calls OnPaint with # of current stage in parameter
  48.   PST_CLEAR_BUFFER      = 2;   // Clears the buffer
  49.   PST_CLEAR_BACKGND     = 3;   // Clears a visible buffer area
  50.   PST_DRAW_BITMAP       = 4;   // Draws a bitmap
  51.   PST_DRAW_LAYERS       = 5;   // Draw layers (Parameter = Layer Mask)
  52.   PST_CONTROL_FRAME     = 6;   // Draws a dotted frame around the control
  53.   PST_BITMAP_FRAME      = 7;   // Draws a dotted frame around the scaled bitmap
  54.  
  55. type
  56.   TPaintStageEvent = procedure(Sender: TObject; Buffer: TBitmap32; StageNum: Cardinal) of object;
  57.  
  58.   { TPaintStage }
  59.   PPaintStage = ^TPaintStage;
  60.   TPaintStage = record
  61.     DsgnTime: Boolean;
  62.     RunTime: Boolean;
  63.     Stage: Cardinal;             // a PST_* constant
  64.     Parameter: Cardinal;         // an optional parameter
  65.   end;
  66.  
  67.   { TPaintStages }
  68.   TPaintStages = class
  69.   private
  70.     FItems: array of TPaintStage;
  71.     function GetItem(Index: Integer): PPaintStage;
  72.   public
  73.     destructor Destroy; override;
  74.     function  Add: PPaintStage;
  75.     procedure Clear;
  76.     function  Count: Integer;
  77.     procedure Delete(Index: Integer);
  78.     function  Insert(Index: Integer): PPaintStage;
  79.     property Items[Index: Integer]: PPaintStage read GetItem; default;
  80.   end;
  81.  
  82.   { Alignment of the bitmap in TCustomImage32 }
  83.   TBitmapAlign = (baTopLeft, baCenter, baTile, baCustom);
  84.   TScaleMode = (smNormal, smStretch, smScale, smResize);
  85.   TPaintBoxOptions = set of (pboWantArrowKeys, pboAutoFocus);
  86.  
  87.   { TCustomPaintBox32 }
  88.   TCustomPaintBox32 = class(TCustomControl)
  89.   private
  90.     FBuffer: TBitmap32;
  91.     FBufferOversize: Integer;
  92.     FBufferValid: Boolean;
  93.     FOptions: TPaintBoxOptions;
  94.     FOnGDIOverlay: TNotifyEvent;
  95.     FMouseInControl: Boolean;
  96.     FOnMouseEnter: TNotifyEvent;
  97.     FOnMouseLeave: TNotifyEvent;
  98.     procedure SetBufferOversize(Value: Integer);
  99. {$IFNDEF CLX}
  100.     procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
  101.     procedure WMGetDlgCode(var Msg: TWmGetDlgCode); message WM_GETDLGCODE;
  102.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  103.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  104. {$ENDIF}
  105.   protected
  106.     procedure DoPaintBuffer; virtual;
  107.     procedure DoPaintGDIOverlay; virtual;
  108.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  109. {$IFDEF CLX}
  110.     procedure MouseEnter(AControl: TControl); override;
  111.     procedure MouseLeave(AControl: TControl); override;
  112. {$ELSE}
  113.     procedure MouseEnter; virtual;
  114.     procedure MouseLeave; virtual;
  115. {$ENDIF}
  116.     procedure Paint; override;
  117.     procedure ResizeBuffer;
  118.     property  BufferValid: Boolean read FBufferValid write FBufferValid;
  119. {$IFDEF CLX}
  120.     function WidgetFlags: Integer; override;
  121. {$ENDIF}
  122.   public
  123.     constructor Create(AOwner: TComponent); override;
  124.     destructor Destroy; override;
  125.     function  GetViewportRect: TRect; virtual;
  126.     procedure Flush; overload;
  127.     procedure Flush(const SrcRect: TRect); overload;
  128.     procedure Invalidate; override;
  129.     procedure Loaded; override;
  130.     procedure Resize; override;
  131.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  132.     property Buffer: TBitmap32 read FBuffer;
  133.     property BufferOversize: Integer read FBufferOversize write SetBufferOversize;
  134.     property Options: TPaintBoxOptions read FOptions write FOptions default [];
  135.     property MouseInControl: Boolean read FMouseInControl;
  136.     property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
  137.     property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  138.     property OnGDIOverlay: TNotifyEvent read FOnGDIOverlay write FOnGDIOverlay;
  139.   end;
  140.  
  141.   { TPaintBox32 }
  142.   TPaintBox32 = class(TCustomPaintBox32)
  143.   private
  144.     FOnPaintBuffer: TNotifyEvent;
  145.   protected
  146.     procedure DoPaintBuffer; override;
  147.   public
  148.     property Canvas;
  149.   published
  150.     property Align;
  151.     property Anchors;
  152. {$IFNDEF CLX}
  153.     property AutoSize;
  154. {$ENDIF}
  155.     property Constraints;
  156.     property Cursor;
  157. {$IFNDEF CLX}
  158.     property DragCursor;
  159. {$ENDIF}
  160.     property Options;
  161.     property ParentShowHint;
  162.     property PopupMenu;
  163.     property ShowHint;
  164.     property TabOrder;
  165.     property TabStop;
  166.     property Visible;
  167. {$IFNDEF CLX}
  168.     property OnCanResize;
  169. {$ENDIF}
  170.     property OnClick;
  171. {$IFDEF DELPHI5}
  172.     property OnContextPopup;
  173. {$ENDIF}
  174.     property OnDblClick;
  175.     property OnDragDrop;
  176.     property OnDragOver;
  177.     property OnEndDrag;
  178.     property OnGDIOverlay;
  179.     property OnMouseDown;
  180.     property OnMouseMove;
  181.     property OnMouseUp;
  182.     property OnMouseWheel;
  183.     property OnMouseWheelDown;
  184.     property OnMouseWheelUp;
  185.     property OnMouseEnter;
  186.     property OnMouseLeave;
  187.     property OnPaintBuffer: TNotifyEvent read FOnPaintBuffer write FOnPaintBuffer;
  188.     property OnResize;
  189.     property OnStartDrag;
  190.   end;
  191.  
  192.   { TCustomImage32 }
  193.   TImgMouseEvent = procedure(Sender: TObject; Button: TMouseButton;
  194.     Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer) of object;
  195.   TImgMouseMoveEvent = procedure(Sender: TObject; Shift: TShiftState;
  196.     X, Y: Integer; Layer: TCustomLayer) of object;
  197.  
  198.   TCustomImage32 = class(TCustomPaintBox32)
  199.   private
  200.     FBitmap: TBitmap32;
  201.     FBitmapAlign: TBitmapAlign;
  202.     FLayers: TLayerCollection;
  203.     FOffsetHorz: Single;
  204.     FOffsetVert: Single;
  205.     FPaintStages: TPaintStages;
  206.     FScale: Single;
  207.     FScaleMode: TScaleMode;
  208.     FUpdateCount: Integer;
  209.     FOnBitmapResize: TNotifyEvent;
  210.     FOnChange: TNotifyEvent;
  211.     FOnInitStages: TNotifyEvent;
  212.     FOnMouseDown: TImgMouseEvent;
  213.     FOnMouseMove: TImgMouseMoveEvent;
  214.     FOnMouseUp: TImgMouseEvent;
  215.     FOnPaintStage: TPaintStageEvent;
  216.     procedure ResizedHandler(Sender: TObject);
  217.     procedure ChangedHandler(Sender: TObject);
  218.     function  GetOnPixelCombine: TPixelCombineEvent;
  219.     procedure GDIUpdateHandler(Sender: TObject);
  220.     procedure SetBitmap(Value: TBitmap32); {$IFDEF CLX}reintroduce;{$ENDIF}
  221.     procedure SetBitmapAlign(Value: TBitmapAlign);
  222.     procedure SetLayers(Value: TLayerCollection);
  223.     procedure SetOffsetHorz(Value: Single);
  224.     procedure SetOffsetVert(Value: Single);
  225.     procedure SetScale(Value: Single);
  226.     procedure SetScaleMode(Value: TScaleMode);
  227.     procedure SetOnPixelCombine(Value: TPixelCombineEvent);
  228.   protected
  229.     CachedBitmapRect: TRect;
  230.     CachedXForm: TCoordXForm;
  231.     CacheValid: Boolean;
  232.     OldSzX, OldSzY: Integer;
  233.     PaintToMode: Boolean;
  234.     procedure BitmapResized; virtual;
  235. {$IFNDEF CLX}
  236.     function  CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
  237. {$ENDIF}
  238.     procedure DoInitStages; virtual;
  239.     procedure DoPaintBuffer; override;
  240.     procedure DoPaintGDIOverlay; override;
  241.     procedure DoScaleChange; virtual;
  242.     procedure InitDefaultStages; virtual;
  243.     procedure InvalidateCache;
  244.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); overload; override;
  245.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); overload; override;
  246.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); overload; override;
  247.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer); reintroduce; overload; virtual;
  248.     procedure MouseMove(Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer); reintroduce; overload; virtual;
  249.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer); reintroduce; overload; virtual;
  250. {$IFDEF CLX}
  251.     procedure MouseLeave(AControl: TControl); override;
  252. {$ELSE}
  253.     procedure MouseLeave; override;
  254. {$ENDIF}
  255.     procedure UpdateCache;
  256.     property  UpdateCount: Integer read FUpdateCount;
  257.   public
  258.     constructor Create(AOwner: TComponent); override;
  259.     destructor Destroy; override;
  260.     procedure BeginUpdate; virtual;
  261.     function  BitmapToControl(const APoint: TPoint): TPoint;
  262.     procedure Changed; virtual;
  263.     function  ControlToBitmap(const APoint: TPoint): TPoint;
  264.     procedure EndUpdate; virtual;
  265.     procedure ExecBitmapFrame(Dest: TBitmap32; StageNum: Integer); virtual;   // PST_BITMAP_FRAME
  266.     procedure ExecClearBuffer(Dest: TBitmap32; StageNum: Integer); virtual;   // PST_CLEAR_BUFFER
  267.     procedure ExecClearBackgnd(Dest: TBitmap32; StageNum: Integer); virtual;  // PST_CLEAR_BACKGND
  268.     procedure ExecControlFrame(Dest: TBitmap32; StageNum: Integer); virtual;  // PST_CONTROL_FRAME
  269.     procedure ExecCustom(Dest: TBitmap32; StageNum: Integer); virtual;        // PST_CUSTOM
  270.     procedure ExecDrawBitmap(Dest: TBitmap32; StageNum: Integer); virtual;    // PST_DRAW_BITMAP
  271.     procedure ExecDrawLayers(Dest: TBitmap32; StageNum: Integer); virtual;    // PST_DRAW_LAYERS
  272.     function  GetBitmapRect: TRect; virtual;
  273.     function  GetBitmapSize: TSize; virtual;
  274.     procedure Invalidate; override;
  275.     procedure Loaded; override;
  276.     procedure PaintTo(Dest: TBitmap32; DestRect: TRect);
  277.     procedure Resize; override;
  278.     procedure SetupBitmap(DoClear: Boolean = False; ClearColor: TColor32 = $FF000000);
  279.     property Bitmap: TBitmap32 read FBitmap write SetBitmap;
  280.     property BitmapAlign: TBitmapAlign read FBitmapAlign write SetBitmapAlign;
  281.     property Canvas;
  282.     property Layers: TLayerCollection read FLayers write SetLayers;
  283.     property OffsetHorz: Single read FOffsetHorz write SetOffsetHorz;
  284.     property OffsetVert: Single read FOffsetVert write SetOffsetVert;
  285.     property PaintStages: TPaintStages read FPaintStages;
  286.     property Scale: Single read FScale write SetScale;
  287.     property ScaleMode: TScaleMode read FScaleMode write SetScaleMode;
  288.     property OnBitmapResize: TNotifyEvent read FOnBitmapResize write FOnBitmapResize;
  289.     property OnBitmapPixelCombine: TPixelCombineEvent read GetOnPixelCombine write SetOnPixelCombine;
  290.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  291.     property OnInitStages: TNotifyEvent read FOnInitStages write FOnInitStages;
  292.     property OnMouseDown: TImgMouseEvent read FOnMouseDown write FOnMouseDown;
  293.     property OnMouseMove: TImgMouseMoveEvent read FOnMouseMove write FOnMouseMove;
  294.     property OnMouseUp: TImgMouseEvent read FOnMouseUp write FOnMouseUp;
  295.     property OnPaintStage: TPaintStageEvent read FOnPaintStage write FOnPaintStage;
  296.   end;
  297.  
  298.   TImage32 = class(TCustomImage32)
  299.   published
  300.     property Align;
  301.     property Anchors;
  302. {$IFNDEF CLX}
  303.     property AutoSize;
  304. {$ENDIF}
  305.     property Bitmap;
  306.     property BitmapAlign;
  307.     property Color;
  308.     property Constraints;
  309.     property Cursor;
  310. {$IFNDEF CLX}
  311.     property DragCursor;
  312. {$ENDIF}
  313.     property ParentColor;
  314.     property ParentShowHint;
  315.     property PopupMenu;
  316.     property Scale;
  317.     property ScaleMode;
  318.     property ShowHint;
  319.     property TabOrder;
  320.     property TabStop;
  321.     property Visible;
  322.     property OnBitmapResize;
  323. {$IFNDEF CLX}
  324.     property OnCanResize;
  325. {$ENDIF}
  326.     property OnClick;
  327.     property OnChange;
  328. {$IFDEF DELPHI5}
  329.     property OnContextPopup;
  330. {$ENDIF}
  331.     property OnDblClick;
  332.     property OnGDIOverlay;
  333.     property OnDragDrop;
  334.     property OnDragOver;
  335.     property OnEndDrag;
  336.     property OnInitStages;
  337.     property OnKeyDown;
  338.     property OnKeyPress;
  339.     property OnKeyUp;
  340.     property OnMouseDown;
  341.     property OnMouseMove;
  342.     property OnMouseUp;
  343.     property OnMouseWheel;
  344.     property OnMouseWheelDown;
  345.     property OnMouseWheelUp;
  346.     property OnMouseEnter;
  347.     property OnMouseLeave;
  348.     property OnPaintStage;
  349.     property OnResize;
  350.     property OnStartDrag;
  351.   end;
  352.  
  353.   TCustomImgView32 = class;
  354.  
  355.   { TIVScrollProperties }
  356.   TIVScrollProperties = class(TArrowBarAccess)
  357.   private
  358.     function GetIncrement: Integer;
  359.     function GetSize: Integer;
  360.     procedure SetIncrement(Value: Integer);
  361.     procedure SetSize(Value: Integer);
  362.   protected
  363.     ImgView: TCustomImgView32;
  364.   published
  365.     property Increment: Integer read GetIncrement write SetIncrement default 8;
  366.     property Size: Integer read GetSize write SetSize default 0;
  367.   end;
  368.  
  369.   TSizeGripStyle = (sgAuto, sgNone, sgAlways);
  370.  
  371.   { TCustomImgView32 }
  372.   TCustomImgView32 = class(TCustomImage32)
  373.   private
  374.     FCentered: Boolean;
  375.     FScrollBarSize: Integer;
  376.     FScrollBars: TIVScrollProperties;
  377.     FSizeGrip: TSizeGripStyle;
  378.     FOnScroll: TNotifyEvent;
  379.     FOverSize: Integer;
  380.     procedure SetCentered(Value: Boolean);
  381.     procedure SetScrollBars(Value: TIVScrollProperties);
  382.     procedure SetSizeGrip(Value: TSizeGripStyle);
  383.     procedure SetOverSize(const Value: Integer);
  384.   protected
  385.     DisableScrollUpdate: Boolean;
  386.     HScroll: TCustomRangeBar;
  387.     VScroll: TCustomRangeBar;
  388.     procedure AlignAll;
  389.     procedure BitmapResized; override;
  390.     procedure DoDrawSizeGrip(R: TRect);
  391.     procedure DoScaleChange; override;
  392.     procedure DoScroll; virtual;
  393.     function  GetScrollBarSize: Integer;
  394.     function  GetSizeGripRect: TRect;
  395.     function  IsSizeGripVisible: Boolean;
  396.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  397.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  398.     procedure Paint; override;
  399.     procedure ScrollHandler(Sender: TObject); virtual;
  400.     procedure UpdateImage; virtual;
  401.     procedure UpdateScrollBars; virtual;
  402.   public
  403.     constructor Create(AOwner: TComponent); override;
  404.     destructor Destroy; override;
  405.     function  GetViewportRect: TRect; override;
  406.     procedure Loaded; override;
  407.     procedure Resize; override;
  408.     procedure ScrollToCenter(X, Y: Integer);
  409.     procedure Scroll(Dx, Dy: Integer);
  410.     property Centered: Boolean read FCentered write SetCentered default True;
  411.     property ScrollBars: TIVScrollProperties read FScrollBars write SetScrollBars;
  412.     property SizeGrip: TSizeGripStyle read FSizeGrip write SetSizeGrip;
  413.     property OverSize: Integer read FOverSize write SetOverSize;    
  414.     property OnScroll: TNotifyEvent read FOnScroll write FOnScroll;
  415.   end;
  416.  
  417.   TImgView32 = class(TCustomImgView32)
  418.     property Align;
  419.     property Anchors;
  420. {$IFNDEF CLX}
  421.     property AutoSize;
  422. {$ENDIF}
  423.     property Bitmap;
  424.     property Centered;
  425.     property Color;
  426.     property Constraints;
  427.     property Cursor;
  428. {$IFNDEF CLX}
  429.     property DragCursor;
  430. {$ENDIF}    
  431.     property ParentColor;
  432.     property ParentShowHint;
  433.     property PopupMenu;
  434.     property Scale;
  435.     property ScrollBars;
  436.     property ShowHint;
  437.     property SizeGrip;
  438.     property OverSize;
  439.     property TabOrder;
  440.     property TabStop;
  441.     property Visible;
  442.     property OnBitmapResize;
  443. {$IFNDEF CLX}
  444.     property OnCanResize;
  445. {$ENDIF}
  446.     property OnClick;
  447.     property OnChange;
  448. {$IFDEF DELPHI5}
  449.     property OnContextPopup;
  450. {$ENDIF}
  451.     property OnDblClick;
  452.     property OnDragDrop;
  453.     property OnDragOver;
  454.     property OnEndDrag;
  455.     property OnGDIOverlay;
  456.     property OnInitStages; 
  457.     property OnKeyDown;
  458.     property OnKeyPress;
  459.     property OnKeyUp;
  460.     property OnMouseDown;
  461.     property OnMouseEnter;
  462.     property OnMouseLeave;
  463.     property OnMouseMove;
  464.     property OnMouseUp;
  465.     property OnMouseWheel;
  466.     property OnMouseWheelDown;
  467.     property OnMouseWheelUp;
  468.     property OnPaintStage;
  469.     property OnResize;
  470.     property OnScroll;
  471.     property OnStartDrag;
  472.   end;
  473.  
  474.   { TBitmap32Item }
  475.   { A bitmap container designed to be inserted into TBitmap32Collection }
  476.   TBitmap32Item = class(TCollectionItem)
  477.   private
  478.     FBitmap: TBitmap32;
  479.     procedure SetBitmap(ABitmap: TBitmap32);
  480.   public
  481.     constructor Create(Collection: TCollection); override;
  482.     destructor Destroy; override;
  483.   published
  484.     property Bitmap: TBitmap32 read FBitmap write SetBitmap;
  485.   end;
  486.  
  487.   TBitmap32ItemClass = class of TBitmap32Item;
  488.  
  489.   { TBitmap32Collection }
  490.   { A collection of TBitmap32Item objects }
  491.   TBitmap32Collection = class(TCollection)
  492.   private
  493.     FOwner: TPersistent;
  494.     function  GetItem(Index: Integer): TBitmap32Item;
  495.     procedure SetItem(Index: Integer; Value: TBitmap32Item);
  496.   protected
  497.     function  GetOwner: TPersistent; override;
  498.   public
  499.     constructor Create(AOwner: TPersistent; ItemClass: TBitmap32ItemClass);
  500.     function Add: TBitmap32Item;
  501.     property Items[Index: Integer]: TBitmap32Item read GetItem write SetItem; default;
  502.   end;
  503.  
  504.   { TBitmap32List }
  505.   { A component that stores TBitmap32Collection }
  506.   TBitmap32List = class(TComponent)
  507.   private
  508.     FBitmap32Collection: TBitmap32Collection;
  509.     procedure SetBitmap(Index: Integer; Value: TBitmap32);
  510.     function GetBitmap(Index: Integer): TBitmap32;
  511.     procedure SetBitmap32Collection(Value: TBitmap32Collection);
  512.   public
  513.     constructor Create(AOwner: TComponent); override;
  514.     destructor Destroy; override;
  515.     property Bitmap[Index: Integer]: TBitmap32 read GetBitmap write SetBitmap; default;
  516.   published
  517.     property Bitmaps: TBitmap32Collection read FBitmap32Collection write SetBitmap32Collection;
  518.   end;
  519.  
  520. implementation
  521.  
  522. uses Math, TypInfo, GR32_System;
  523.  
  524. type
  525.   TBitmap32Access = class(TBitmap32);
  526.   TLayerAccess = class(TCustomLayer);
  527.   TLayerCollectionAccess = class(TLayerCollection);
  528.  
  529. const
  530.   UnitXForm: TCoordXForm = (
  531.     ScaleX: $10000;
  532.     ScaleY: $10000;
  533.     ShiftX: 0;
  534.     ShiftY: 0;
  535.     RevScaleX: 65536;
  536.     RevScaleY: 65536);
  537.  
  538. { TPaintStages }
  539.  
  540. function TPaintStages.Add: PPaintStage;
  541. var
  542.   L: Integer;
  543. begin
  544.   L := Length(FItems);
  545.   SetLength(FItems, L + 1);
  546.   Result := @FItems[L];
  547.   with Result^ do
  548.   begin
  549.     DsgnTime := False;
  550.     RunTime := True;
  551.     Stage := 0;
  552.     Parameter := 0;
  553.   end;
  554. end;
  555.  
  556. procedure TPaintStages.Clear;
  557. begin
  558.   FItems := nil;
  559. end;
  560.  
  561. function TPaintStages.Count: Integer;
  562. begin
  563.   Result := Length(FItems);
  564. end;
  565.  
  566. procedure TPaintStages.Delete(Index: Integer);
  567. var
  568.   Count: Integer;
  569. begin
  570.   if (Index < 0) or (Index > High(FItems)) then
  571.     raise EListError.Create('Invalid stage index');
  572.   Count := Length(FItems) - Index - 1;
  573.   if Count > 0 then
  574.     Move(FItems[Index + 1], FItems[Index], Count * SizeOf(TPaintStage));
  575.   SetLength(FItems, High(FItems));
  576. end;
  577.  
  578. destructor TPaintStages.Destroy;
  579. begin
  580.   Clear;
  581.   inherited;
  582. end;
  583.  
  584. function TPaintStages.GetItem(Index: Integer): PPaintStage;
  585. begin
  586.   Result := @FItems[Index];
  587. end;
  588.  
  589. function TPaintStages.Insert(Index: Integer): PPaintStage;
  590. var
  591.   Count: Integer;
  592. begin
  593.   if Index < 0 then Index := 0
  594.   else if Index > Length(FItems) then Index := Length(FItems);
  595.   Count := Length(FItems) - Index;
  596.   SetLength(FItems, Length(FItems) + 1);
  597.   if Count > 0 then
  598.     Move(FItems[Index], FItems[Index + 1], Count * SizeOf(TPaintStage));
  599.   Result := @FItems[Index];
  600.   with Result^ do
  601.   begin
  602.     DsgnTime := False;
  603.     RunTime := True;
  604.     Stage := 0;
  605.     Parameter := 0;
  606.   end;
  607. end;
  608.  
  609.  
  610. { TCustomPaintBox32 }
  611.  
  612. {$IFNDEF CLX}
  613. procedure TCustomPaintBox32.CMMouseEnter(var Message: TMessage);
  614. begin
  615.   inherited;
  616.   MouseEnter;
  617. end;
  618.  
  619. procedure TCustomPaintBox32.CMMouseLeave(var Message: TMessage);
  620. begin
  621.   MouseLeave;
  622.   inherited;
  623. end;
  624. {$ENDIF}
  625.  
  626. constructor TCustomPaintBox32.Create(AOwner: TComponent);
  627. begin
  628.   inherited;
  629.   FBuffer := TBitmap32.Create;
  630.   FBuffer.BeginUpdate; // just to speed the things up a little
  631.   FBufferOversize := 40;
  632.   Height := 192;
  633.   Width := 192;
  634. end;
  635.  
  636. destructor TCustomPaintBox32.Destroy;
  637. begin
  638.   FBuffer.Free;
  639.   inherited;
  640. end;
  641.  
  642. procedure TCustomPaintBox32.DoPaintBuffer;
  643. begin
  644.   // do nothing by default, descendants should override this method
  645.   // for painting operations, not the Paint method!!!
  646.   FBufferValid := True;
  647. end;
  648.  
  649. procedure TCustomPaintBox32.DoPaintGDIOverlay;
  650. begin
  651.   if Assigned(FOnGDIOverlay) then FOnGDIOverlay(Self);
  652. end;
  653.  
  654. procedure TCustomPaintBox32.Flush;
  655. begin
  656. {$IFDEF CLX}
  657.   if Assigned(Canvas.Handle) and Assigned(FBuffer.Handle) then
  658. {$ELSE}
  659.   if (Canvas.Handle <> 0) and (FBuffer.Handle <> 0) then
  660. {$ENDIF}
  661.   begin
  662.     Canvas.Lock;
  663.     try
  664.       FBuffer.Lock;
  665.       try
  666.         with GetViewportRect do
  667. {$IFDEF CLX}
  668.         begin
  669.           if not QPainter_isActive(FBuffer.Handle) then
  670.             if not QPainter_begin(FBuffer.Handle, FBuffer.Pixmap) then
  671.               raise EInvalidGraphicOperation.CreateRes(@SInvalidCanvasState);
  672.           QPainter_drawPixmap(Canvas.Handle, Top, Left, FBuffer.Pixmap, 0, 0, Right - Left, Bottom - Top);
  673.           QPainter_end(FBuffer.Handle);
  674.  
  675.           TBitmap32Access(FBuffer).CheckPixmap; // try to avoid QPixmap -> QImage conversion, since we don't need that.
  676.         end;
  677. {$ELSE}
  678.           BitBlt(Canvas.Handle, Left, Top, Right - Left, Bottom - Top,
  679.             FBuffer.Handle, 0, 0, SRCCOPY);
  680. {$ENDIF}
  681.       finally
  682.         FBuffer.Unlock;
  683.       end;
  684.     finally
  685.       Canvas.Unlock;
  686.     end;
  687.   end;
  688. end;
  689.  
  690. procedure TCustomPaintBox32.Flush(const SrcRect: TRect);
  691. var
  692.   R: TRect;
  693. begin
  694. {$IFDEF CLX}
  695.   if Assigned(Canvas.Handle) and Assigned(FBuffer.Handle) then
  696. {$ELSE}
  697.   if (Canvas.Handle <> 0) and (FBuffer.Handle <> 0) then
  698. {$ENDIF}
  699.   begin
  700.     Canvas.Lock;
  701.     try
  702.       FBuffer.Lock;
  703.       try
  704.         R := GetViewPortRect;
  705.         with SrcRect do
  706. {$IFDEF CLX}
  707.         begin
  708.           if not QPainter_isActive(FBuffer.Handle) then
  709.             if not QPainter_begin(FBuffer.Handle, FBuffer.Pixmap) then
  710.               raise EInvalidGraphicOperation.CreateRes(@SInvalidCanvasState);
  711.           QPainter_drawPixmap(Canvas.Handle, Top + R.Top, Left + R.Left,
  712.             FBuffer.Pixmap, 0, 0, Right - Left, Bottom - Top);
  713.           QPainter_end(FBuffer.Handle);
  714.  
  715.           TBitmap32Access(FBuffer).CheckPixmap; // try to avoid QPixmap -> QImage conversion, since we don't need that.
  716.         end;
  717. {$ELSE}
  718.           BitBlt(Canvas.Handle, Left + R.Left, Top + R.Top, Right - Left, Bottom - Top,
  719.             FBuffer.Handle, Left, Top, SRCCOPY);
  720. {$ENDIF}
  721.       finally
  722.         FBuffer.Unlock;
  723.       end;
  724.     finally
  725.       Canvas.Unlock;
  726.     end;
  727.   end;
  728. end;
  729.  
  730. function TCustomPaintBox32.GetViewportRect: TRect;
  731. begin
  732.   // returns position of the buffered area within the control bounds
  733.   with Result do
  734.   begin
  735.     // by default, the whole control is buffered
  736.     Left := 0;
  737.     Top := 0;
  738.     Right := Width;
  739.     Bottom := Height;
  740.   end;
  741. end;
  742.  
  743. procedure TCustomPaintBox32.Invalidate;
  744. begin
  745.   FBufferValid := False;
  746.   inherited;
  747. end;
  748.  
  749. procedure TCustomPaintBox32.Loaded;
  750. begin
  751.   FBufferValid := False;
  752.   inherited;
  753. end;
  754.  
  755. procedure TCustomPaintBox32.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  756. begin
  757.   if (pboAutoFocus in Options) and CanFocus then SetFocus;
  758.   inherited;
  759. end;
  760.  
  761. {$IFDEF CLX}
  762. procedure TCustomPaintBox32.MouseEnter(AControl: TControl);
  763. begin
  764.   FMouseInControl := True;
  765.   inherited;
  766. end;
  767.  
  768. procedure TCustomPaintBox32.MouseLeave(AControl: TControl);
  769. begin
  770.   FMouseInControl := False;
  771.   inherited;
  772. end;
  773.  
  774. {$ELSE}
  775.  
  776. procedure TCustomPaintBox32.MouseEnter;
  777. begin
  778.   FMouseInControl := True;
  779.   if Assigned(FOnMouseEnter) then
  780.     FOnMouseEnter(Self);
  781. end;
  782.  
  783. procedure TCustomPaintBox32.MouseLeave;
  784. begin
  785.   FMouseInControl := False;
  786.   if Assigned(FOnMouseLeave) then
  787.     FOnMouseLeave(Self);
  788. end;
  789. {$ENDIF}
  790.  
  791. procedure TCustomPaintBox32.Paint;
  792. begin
  793.   ResizeBuffer;
  794.   if not FBufferValid then
  795.   begin
  796. {$IFDEF CLX}
  797.     TBitmap32Access(FBuffer).ImageNeeded;
  798. {$ENDIF}
  799.     DoPaintBuffer;
  800.   end;
  801.  
  802.   FBuffer.Lock;
  803.   try
  804.     with GetViewportRect do
  805. {$IFDEF CLX}
  806.     begin
  807.       if not QPainter_isActive(FBuffer.Handle) then
  808.         if not QPainter_begin(FBuffer.Handle, FBuffer.Pixmap) then
  809.           raise EInvalidGraphicOperation.CreateRes(@SInvalidCanvasState);
  810.       QPainter_drawPixmap(Canvas.Handle, Top, Left, FBuffer.Pixmap, 0, 0, Right - Left, Bottom - Top);
  811.       QPainter_end(FBuffer.Handle);
  812.  
  813.       TBitmap32Access(FBuffer).CheckPixmap; // try to avoid QPixmap -> QImage conversion, since we don't need that.
  814.     end;
  815. {$ELSE}
  816.       BitBlt(Canvas.Handle, Left, Top, Right - Left, Bottom - Top,
  817.         FBuffer.Handle, 0, 0, SRCCOPY);
  818. {$ENDIF}
  819.   finally
  820.     FBuffer.Unlock;
  821.   end;
  822.   DoPaintGDIOverlay;
  823. end;
  824.  
  825. procedure TCustomPaintBox32.Resize;
  826. begin
  827.   ResizeBuffer;
  828.   BufferValid := False;
  829.   inherited;
  830. end;
  831.  
  832. procedure TCustomPaintBox32.ResizeBuffer;
  833. var
  834.   NewWidth, NewHeight, W, H: Integer;
  835. begin
  836.   // get the viewport parameters
  837.   with GetViewportRect do
  838.   begin
  839.     NewWidth := Right - Left;
  840.     NewHeight := Bottom - Top;
  841.   end;
  842.   if NewWidth < 0 then NewWidth := 0;
  843.   if NewHeight < 0 then NewHeight := 0;
  844.  
  845.   W := FBuffer.Width;
  846.  
  847.   if NewWidth > W then
  848.     W := NewWidth + FBufferOversize
  849.   else if NewWidth < W - FBufferOversize then
  850.     W := NewWidth;
  851.  
  852.   if W < 1 then W := 1;
  853.  
  854.   H := FBuffer.Height;
  855.  
  856.   if NewHeight > H then
  857.     H := NewHeight + FBufferOversize
  858.   else if NewHeight < H - FBufferOversize then
  859.     H := NewHeight;
  860.  
  861.   if H < 1 then H := 1;
  862.  
  863.   if (W <> FBuffer.Width) or (H <> FBuffer.Height) then
  864.   begin
  865.     FBuffer.Lock;
  866.     FBuffer.SetSize(W, H);
  867.     FBuffer.Unlock;
  868.     FBufferValid := False;
  869.   end;
  870. end;
  871.  
  872. procedure TCustomPaintBox32.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  873. begin
  874.   FBufferValid := False;
  875.   inherited;
  876. end;
  877.  
  878. procedure TCustomPaintBox32.SetBufferOversize(Value: Integer);
  879. begin
  880.   if Value < 0 then Value := 0;
  881.   FBufferOversize := Value;
  882. end;
  883.  
  884. {$IFDEF CLX}
  885. function TCustomPaintBox32.WidgetFlags: Integer;
  886. begin
  887.   Result := Inherited WidgetFlags or Integer(WidgetFlags_WRepaintNoErase) or
  888.     Integer(WidgetFlags_WResizeNoErase);
  889. end;
  890. {$ELSE}
  891. procedure TCustomPaintBox32.WMEraseBkgnd(var Message: TWmEraseBkgnd);
  892. begin
  893.   Message.Result := 1;
  894. end;
  895.  
  896. procedure TCustomPaintBox32.WMGetDlgCode(var Msg: TWmGetDlgCode);
  897. begin
  898.   with Msg do if pboWantArrowKeys in Options then
  899.     Result:= Result or DLGC_WANTARROWS
  900.   else
  901.     Result:= Result and not DLGC_WANTARROWS;
  902. end;
  903. {$ENDIF}
  904.  
  905.  
  906.  
  907. { TPaintBox32 }
  908.  
  909. procedure TPaintBox32.DoPaintBuffer;
  910. begin
  911.   if Assigned(FOnPaintBuffer) then FOnPaintBuffer(Self);
  912.   inherited;
  913. end;    
  914.  
  915.  
  916.  
  917.  
  918.  
  919. { TCustomImage32 }
  920.  
  921. procedure TCustomImage32.BeginUpdate;
  922. begin
  923.   // disable OnChange & OnChanging generation
  924.   Inc(FUpdateCount);
  925. end;
  926.  
  927. procedure TCustomImage32.BitmapResized;
  928. {$IFNDEF CLX}
  929. var
  930.   W, H: Integer;
  931. begin
  932.   if AutoSize then
  933.   begin
  934.     W := Bitmap.Width;
  935.     H := Bitmap.Height;
  936.     if ScaleMode = smScale then
  937.     begin
  938.       W := Round(W * Scale);
  939.       H := Round(H * Scale);
  940.     end;
  941.     if AutoSize and (W > 0) and (H > 0) then SetBounds(Left, Top, W, H);
  942.   end;
  943. {$ELSE}
  944. begin
  945. {$ENDIF}
  946.   if (FUpdateCount <> 0) and Assigned(FOnBitmapResize) then FOnBitmapResize(Self);
  947.   InvalidateCache;
  948.   Invalidate;
  949. end;
  950.  
  951. function TCustomImage32.BitmapToControl(const APoint: TPoint): TPoint;
  952. begin
  953.   // convert coordinates from bitmap's ref. frame to control's ref. frame
  954.   UpdateCache;
  955.   with CachedXForm, APoint do
  956.   begin
  957.     Result.X := X * ScaleX div $10000 + ShiftX;
  958.     Result.Y := Y * ScaleY div $10000 + ShiftY;
  959.   end;
  960. end;
  961.  
  962. {$IFNDEF CLX}
  963. function TCustomImage32.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
  964. var
  965.   W, H: Integer;
  966. begin
  967.   InvalidateCache;
  968.   Result := True;
  969.   W := Bitmap.Width;
  970.   H := Bitmap.Height;
  971.   if ScaleMode = smScale then
  972.   begin
  973.     W := Round(W * Scale);
  974.     H := Round(H * Scale);
  975.   end;
  976.   if not (csDesigning in ComponentState) or (W > 0) and (H > 0) then
  977.   begin
  978.     if Align in [alNone, alLeft, alRight] then NewWidth := W;
  979.     if Align in [alNone, alTop, alBottom] then NewHeight := H;
  980.   end;
  981. end;
  982. {$ENDIF}
  983.  
  984. procedure TCustomImage32.Changed;
  985. begin
  986.   if FUpdateCount = 0 then
  987.   begin
  988.     Invalidate;
  989.     if Assigned(FOnChange) then FOnChange(Self);
  990.   end;
  991. end;
  992.  
  993. procedure TCustomImage32.ChangedHandler(Sender: TObject);
  994. begin
  995.   Changed;
  996. end;
  997.  
  998. function TCustomImage32.ControlToBitmap(const APoint: TPoint): TPoint;
  999. begin
  1000.   // convert point coords from control's ref. frame to bitmap's ref. frame
  1001.   // the coordinates are not clipped to bitmap image boundary
  1002.   UpdateCache;
  1003.   with CachedXForm, APoint do
  1004.   begin
  1005.     Result.X := (X - ShiftX) * RevScaleX div $10000;
  1006.     Result.Y := (Y - ShiftY) * RevScaleY div $10000;
  1007.   end;
  1008. end;
  1009.  
  1010. constructor TCustomImage32.Create(AOwner: TComponent);
  1011. begin
  1012.   inherited;
  1013.   ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
  1014.     csDoubleClicks, csReplicatable, csOpaque];
  1015.   FBitmap := TBitmap32.Create;
  1016.   FBitmap.OnChange := ChangedHandler;
  1017.   FBitmap.OnResize := ResizedHandler;
  1018.   FLayers := TLayerCollection.Create(Self);
  1019.   with TLayerCollectionAccess(FLayers) do
  1020.   begin
  1021.     CoordXForm := @CachedXForm;
  1022.     OnChange := ChangedHandler;
  1023.     OnGDIUpdate := GDIUpdateHandler;
  1024.   end;
  1025.   FPaintStages := TPaintStages.Create;
  1026.   FScale := 1.0;
  1027.   InitDefaultStages;
  1028. end;
  1029.  
  1030. destructor TCustomImage32.Destroy;
  1031. begin
  1032.   BeginUpdate;
  1033.   FPaintStages.Free;
  1034.   FLayers.Free;
  1035.   FBitmap.Free;
  1036.   inherited;
  1037. end;
  1038.  
  1039. procedure TCustomImage32.DoInitStages;
  1040. begin
  1041.   if Assigned(FOnInitStages) then FOnInitStages(Self);
  1042. end;
  1043.  
  1044. procedure TCustomImage32.DoPaintBuffer;
  1045. var
  1046.   I: Integer;
  1047.   DT, RT: Boolean;
  1048. begin
  1049.   UpdateCache;
  1050.   DT := csDesigning in ComponentState;
  1051.   RT := not DT;
  1052.  
  1053.   for I := 0 to FPaintStages.Count - 1 do
  1054.     with FPaintStages[I]^ do
  1055.       if (DsgnTime and DT) or (RunTime and RT) then
  1056.         case Stage of
  1057.           PST_CUSTOM: ExecCustom(Buffer, I);
  1058.           PST_CLEAR_BUFFER: ExecClearBuffer(Buffer, I);
  1059.           PST_CLEAR_BACKGND: ExecClearBackgnd(Buffer, I);
  1060.           PST_DRAW_BITMAP: ExecDrawBitmap(Buffer, I);
  1061.           PST_DRAW_LAYERS: ExecDrawLayers(Buffer, I);
  1062.           PST_CONTROL_FRAME: ExecControlFrame(Buffer, I);
  1063.           PST_BITMAP_FRAME: ExecBitmapFrame(Buffer, I);
  1064.         end;
  1065.   inherited;
  1066. end;
  1067.  
  1068. procedure TCustomImage32.DoPaintGDIOverlay;
  1069. var
  1070.   I: Integer;
  1071. begin
  1072.   for I := 0 to Layers.Count - 1 do
  1073.     if (Layers[I].LayerOptions and $40000000) <> 0 then
  1074.       TLayerAccess(Layers[I]).PaintGDI(Canvas);
  1075.   inherited;
  1076. end;
  1077.  
  1078. procedure TCustomImage32.DoScaleChange;
  1079. begin
  1080.   // do nothing here
  1081. end;
  1082.  
  1083. procedure TCustomImage32.EndUpdate;
  1084. begin
  1085.   // re-enable OnChange & OnChanging generation
  1086.   Dec(FUpdateCount);
  1087.   Assert(FUpdateCount >= 0, 'Unpaired EndUpdate call');
  1088. end;
  1089.  
  1090. procedure TCustomImage32.ExecBitmapFrame(Dest: TBitmap32; StageNum: Integer);
  1091. begin
  1092.   Dest.Canvas.DrawFocusRect(CachedBitmapRect);
  1093. end;
  1094.  
  1095. procedure TCustomImage32.ExecClearBackgnd(Dest: TBitmap32; StageNum: Integer);
  1096. var
  1097.   C: TColor32;
  1098. begin
  1099.   C := Color32(Color);
  1100.   if (Bitmap.Empty) or (Bitmap.DrawMode <> dmOpaque) then Dest.Clear(C)
  1101.   else
  1102.     with CachedBitmapRect do
  1103.     begin
  1104.       if (Left > 0) or (Right < Width) or (Top > 0) or (Bottom < Height) and
  1105.         not (BitmapAlign = baTile) then
  1106.       begin
  1107.         // clean only the part of the buffer lying around image edges
  1108.         Dest.FillRectS(0, 0, Width, Top, C);          // top
  1109.         Dest.FillRectS(0, Bottom, Width, Height, C);  // bottom
  1110.         Dest.FillRectS(0, Top, Left, Bottom, C);      // left
  1111.         Dest.FillRectS(Right, Top, Width, Bottom, C); // right
  1112.       end;
  1113.     end;
  1114. end;
  1115.  
  1116. procedure TCustomImage32.ExecClearBuffer(Dest: TBitmap32; StageNum: Integer);
  1117. begin
  1118.   Dest.Clear(Color32(Color));
  1119. end;
  1120.  
  1121. procedure TCustomImage32.ExecControlFrame(Dest: TBitmap32; StageNum: Integer);
  1122. begin
  1123.   {$IFDEF CLX}
  1124.   Dest.Canvas.DrawFocusRect(Rect(0, 0, Width, Height));
  1125.   {$ELSE}
  1126.   DrawFocusRect(Dest.Handle, Rect(0, 0, Width, Height));
  1127.   {$ENDIF}
  1128. end;
  1129.  
  1130. procedure TCustomImage32.ExecCustom(Dest: TBitmap32; StageNum: Integer);
  1131. begin
  1132.   if Assigned(FOnPaintStage) then FOnPaintStage(Self, Dest, StageNum);
  1133. end;
  1134.  
  1135. procedure TCustomImage32.ExecDrawBitmap(Dest: TBitmap32; StageNum: Integer);
  1136. var
  1137.   I, J, Tx, Ty: Integer;
  1138.   R: TRect;
  1139. begin
  1140.   if Bitmap.Empty or IsRectEmpty(CachedBitmapRect) then Exit;
  1141.   Bitmap.Lock;
  1142.   try
  1143.     if BitmapAlign <> baTile then Bitmap.DrawTo(Dest, CachedBitmapRect)
  1144.     else with CachedBitmapRect do
  1145.     begin
  1146.       Tx := Dest.Width div Right;
  1147.       Ty := Dest.Height div Bottom;
  1148.       for J := 0 to Ty do
  1149.         for I := 0 to Tx do
  1150.         begin
  1151.           R := CachedBitmapRect;
  1152.           OffsetRect(R, Right * I, Bottom * J);
  1153.           Bitmap.DrawTo(Dest, R);
  1154.         end;
  1155.     end;
  1156.   finally
  1157.     Bitmap.Unlock;
  1158.   end;
  1159. end;
  1160.  
  1161. procedure TCustomImage32.ExecDrawLayers(Dest: TBitmap32; StageNum: Integer);
  1162. var
  1163.   I: Integer;
  1164.   Mask: Cardinal;
  1165. begin
  1166.   Mask := PaintStages[StageNum]^.Parameter;
  1167.   for I := 0 to Layers.Count - 1 do
  1168.     if (Layers.Items[I].LayerOptions and Mask) <> 0 then
  1169.       TLayerAccess(Layers.Items[I]).DoPaint(Dest);
  1170. end;
  1171.  
  1172. procedure TCustomImage32.GDIUpdateHandler(Sender: TObject);
  1173. begin
  1174.   Paint;
  1175. end;
  1176.  
  1177. function TCustomImage32.GetBitmapRect: TRect;
  1178. var
  1179.   Size: TSize;
  1180. begin
  1181.   if Bitmap.Empty then
  1182.     with Result do
  1183.     begin
  1184.       Left := 0;
  1185.       Right := 0;
  1186.       Top := 0;
  1187.       Bottom := 0;
  1188.     end
  1189.   else
  1190.   begin
  1191.     Size := GetBitmapSize;
  1192.     with Size do
  1193.     begin
  1194.       Result := Rect(0, 0, Cx, Cy);
  1195.       if BitmapAlign = baCenter then
  1196.         OffsetRect(Result, (Width - Cx) div 2, (Height - Cy) div 2)
  1197.       else if BitmapAlign = baCustom then
  1198.         OffsetRect(Result, Round(OffsetHorz), Round(OffsetVert));
  1199.     end;
  1200.   end;
  1201. end;
  1202.  
  1203. function TCustomImage32.GetBitmapSize: TSize;
  1204. var
  1205.   ScaleX, ScaleY: Single;
  1206. begin
  1207.   with Result do
  1208.   begin
  1209.     if Bitmap.Empty or (Width = 0) or (Height = 0) then
  1210.     begin
  1211.       Cx := 0;
  1212.       Cy := 0;
  1213.       Exit;
  1214.     end;
  1215.  
  1216.     case ScaleMode of
  1217.       smNormal:
  1218.         begin
  1219.           Cx := Bitmap.Width;
  1220.           Cy := Bitmap.Height;
  1221.         end;
  1222.  
  1223.       smStretch:
  1224.         begin
  1225.           Cx := Width;
  1226.           Cy := Height;
  1227.         end;
  1228.  
  1229.       smResize:
  1230.         begin
  1231.           Cx := Bitmap.Width;
  1232.           Cy := Bitmap.Height;
  1233.           ScaleX := Width / Cx;
  1234.           ScaleY := Height / Cy;
  1235.           if ScaleX >= ScaleY then
  1236.           begin
  1237.             Cx := Round(Cx * ScaleY);
  1238.             Cy := Height;
  1239.           end
  1240.           else
  1241.           begin
  1242.             Cx := Width;
  1243.             Cy := Round(Cy * ScaleX);
  1244.           end;
  1245.         end;
  1246.     else // smScale
  1247.       begin
  1248.         Cx := Round(Bitmap.Width * Scale);
  1249.         Cy := Round(Bitmap.Height * Scale);
  1250.       end;
  1251.     end;
  1252.     if Cx <= 0 then Cx := 0;
  1253.     if Cy <= 0 then Cy := 0;
  1254.   end;
  1255. end;
  1256.  
  1257. function TCustomImage32.GetOnPixelCombine: TPixelCombineEvent;
  1258. begin
  1259.   Result := FBitmap.OnPixelCombine;
  1260. end;
  1261.  
  1262. procedure TCustomImage32.InitDefaultStages;
  1263. begin
  1264.   // background
  1265.   with PaintStages.Add^ do
  1266.   begin
  1267.     DsgnTime := True;
  1268.     RunTime := True;
  1269.     Stage := PST_CLEAR_BACKGND;
  1270.   end;
  1271.  
  1272.   // control frame
  1273.   with PaintStages.Add^ do
  1274.   begin
  1275.     DsgnTime := True;
  1276.     RunTime := False;
  1277.     Stage := PST_CONTROL_FRAME;
  1278.   end;
  1279.  
  1280.   // bitmap
  1281.   with PaintStages.Add^ do
  1282.   begin
  1283.     DsgnTime := True;
  1284.     RunTime := True;
  1285.     Stage := PST_DRAW_BITMAP;
  1286.   end;
  1287.  
  1288.   // bitmap frame
  1289.   with PaintStages.Add^ do
  1290.   begin
  1291.     DsgnTime := True;
  1292.     RunTime := False;
  1293.     Stage := PST_BITMAP_FRAME;
  1294.   end;
  1295.  
  1296.   // layers
  1297.   with PaintStages.Add^ do
  1298.   begin
  1299.     DsgnTime := True;
  1300.     RunTime := True;
  1301.     Stage := PST_DRAW_LAYERS;
  1302.     Parameter := $80000000;
  1303.   end;
  1304. end;
  1305.  
  1306. procedure TCustomImage32.Invalidate;
  1307. begin
  1308.   BufferValid := False;
  1309.   CacheValid := False;
  1310.   inherited;
  1311. end;
  1312.  
  1313. procedure TCustomImage32.InvalidateCache;
  1314. begin
  1315.   CacheValid := False;
  1316. end;
  1317.  
  1318. procedure TCustomImage32.Loaded;
  1319. begin
  1320.   inherited;
  1321.   DoInitStages;
  1322. end;
  1323.  
  1324. procedure TCustomImage32.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1325. var
  1326.   Layer: TCustomLayer;
  1327. begin
  1328.   inherited;
  1329.  
  1330.   if TabStop and CanFocus then SetFocus;
  1331.   
  1332.   if Layers.MouseEvents then
  1333.     Layer := TLayerCollectionAccess(Layers).MouseDown(Button, Shift, X, Y)
  1334.   else
  1335.     Layer := nil;
  1336.  
  1337.   // lock the capture only if mbLeft was pushed or any mouse listener was activated
  1338.   if (Button = mbLeft) or (TLayerCollectionAccess(Layers).MouseListener <> nil) then
  1339.     MouseCapture := True;
  1340.  
  1341.   MouseDown(Button, Shift, X, Y, Layer);
  1342. end;
  1343.  
  1344. procedure TCustomImage32.MouseMove(Shift: TShiftState; X, Y: Integer);
  1345. var
  1346.   Layer: TCustomLayer;
  1347. begin
  1348.   inherited;
  1349.   if Layers.MouseEvents then
  1350.     Layer := TLayerCollectionAccess(Layers).MouseMove(Shift, X, Y)
  1351.   else
  1352.     Layer := nil;
  1353.  
  1354.   MouseMove(Shift, X, Y, Layer);
  1355. end;
  1356.  
  1357. procedure TCustomImage32.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1358. var
  1359.   Layer: TCustomLayer;
  1360. begin
  1361.   if Layers.MouseEvents then
  1362.     Layer := TLayerCollectionAccess(Layers).MouseUp(Button, Shift, X, Y)
  1363.   else
  1364.     Layer := nil;
  1365.  
  1366.   // unlock the capture only if mbLeft was raised and there is no active mouse listeners
  1367.   if (Button = mbLeft) and (TLayerCollectionAccess(Layers).MouseListener = nil) then
  1368.     MouseCapture := False;
  1369.  
  1370.   MouseUp(Button, Shift, X, Y, Layer);
  1371. end;
  1372.  
  1373. procedure TCustomImage32.MouseDown(Button: TMouseButton;
  1374.   Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
  1375. begin
  1376.   if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, X, Y, Layer);
  1377. end;
  1378.  
  1379. procedure TCustomImage32.MouseMove(Shift: TShiftState; X, Y: Integer;
  1380.   Layer: TCustomLayer);
  1381. begin
  1382.   if Assigned(FOnMouseMove) then FOnMouseMove(Self, Shift, X, Y, Layer);
  1383. end;
  1384.  
  1385. procedure TCustomImage32.MouseUp(Button: TMouseButton; Shift: TShiftState;
  1386.   X, Y: Integer; Layer: TCustomLayer);
  1387. begin
  1388.   if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, X, Y, Layer);
  1389. end;
  1390.  
  1391. {$IFDEF CLX}
  1392. procedure TCustomImage32.MouseLeave(AControl: TControl);
  1393. begin
  1394.   if (Layers.MouseEvents) and (Layers.MouseListener = nil) then
  1395.     Screen.Cursor := crDefault;
  1396.   inherited;
  1397. end;
  1398.  
  1399. {$ELSE}
  1400.  
  1401. procedure TCustomImage32.MouseLeave;
  1402. begin
  1403.   if (Layers.MouseEvents) and (Layers.MouseListener = nil) then
  1404.     Screen.Cursor := crDefault;
  1405.   inherited;
  1406. end;
  1407. {$ENDIF}
  1408.  
  1409. procedure TCustomImage32.PaintTo(Dest: TBitmap32; DestRect: TRect);
  1410. var
  1411.   I: Integer;
  1412. begin
  1413.   CachedBitmapRect := DestRect;
  1414.  
  1415.   with CachedBitmapRect, CachedXForm do
  1416.   begin
  1417.     if (Right - Left <= 0) or (Bottom - Top <= 0) or Bitmap.Empty then
  1418.       CachedXForm := UnitXForm
  1419.     else
  1420.     begin
  1421.       ShiftX := Left;
  1422.       ShiftY := Top;
  1423.       ScaleX := MulDiv(Right - Left, $10000, Bitmap.Width);
  1424.       ScaleY := MulDiv(Bottom - Top, $10000, Bitmap.Height);
  1425.       RevScaleX := MulDiv(Bitmap.Width, $10000, Right - Left);
  1426.       RevScaleY := MulDiv(Bitmap.Height, $10000, Bottom - Top);
  1427.     end;
  1428.   end;
  1429.   CacheValid := True;
  1430.  
  1431.   PaintToMode := True;
  1432.   try
  1433.     for I := 0 to FPaintStages.Count - 1 do
  1434.       with FPaintStages[I]^ do
  1435.         if RunTime then
  1436.           case Stage of
  1437.             PST_CUSTOM: ExecCustom(Dest, I);
  1438.             PST_CLEAR_BUFFER: ExecClearBuffer(Dest, I);
  1439.             PST_CLEAR_BACKGND: ExecClearBackgnd(Dest, I);
  1440.             PST_DRAW_BITMAP: ExecDrawBitmap(Dest, I);
  1441.             PST_DRAW_LAYERS: ExecDrawLayers(Dest, I);
  1442.             PST_CONTROL_FRAME: ExecControlFrame(Dest, I);
  1443.             PST_BITMAP_FRAME: ExecBitmapFrame(Dest, I);
  1444.           end;
  1445.   finally
  1446.     PaintToMode := False;
  1447.   end;
  1448.   CacheValid := False;
  1449. end;
  1450.  
  1451. procedure TCustomImage32.Resize;
  1452. begin
  1453.   InvalidateCache;
  1454.   inherited;
  1455. end;
  1456.  
  1457. procedure TCustomImage32.ResizedHandler(Sender: TObject);
  1458. begin
  1459. {$IFDEF CLX}
  1460.   // workaround to stop CLX from calling BitmapResized and to prevent
  1461.   // AV when accessing Layers. Layers is already freed at that time
  1462.   if not(csDestroying in ComponentState) then
  1463. {$ENDIF}
  1464.   BitmapResized;
  1465. end;
  1466.  
  1467. procedure TCustomImage32.SetBitmap(Value: TBitmap32);
  1468. begin
  1469.   InvalidateCache;
  1470.   FBitmap.Assign(Value);
  1471. end;
  1472.  
  1473. procedure TCustomImage32.SetBitmapAlign(Value: TBitmapAlign);
  1474. begin
  1475.   InvalidateCache;
  1476.   FBitmapAlign := Value;
  1477.   Changed;
  1478. end;
  1479.  
  1480. procedure TCustomImage32.SetLayers(Value: TLayerCollection);
  1481. begin
  1482.   FLayers.Assign(Value);
  1483. end;
  1484.  
  1485. procedure TCustomImage32.SetOffsetHorz(Value: Single);
  1486. begin
  1487.   if Value <> FOffsetHorz then
  1488.   begin
  1489.     InvalidateCache;
  1490.     FOffsetHorz := Value;
  1491.     Changed;
  1492.   end;
  1493. end;
  1494.  
  1495. procedure TCustomImage32.SetOffsetVert(Value: Single);
  1496. begin
  1497.   if Value <> FOffsetVert then
  1498.   begin
  1499.     FOffsetVert := Value;
  1500.     InvalidateCache;
  1501.     Changed;
  1502.   end;
  1503. end;
  1504.  
  1505. procedure TCustomImage32.SetOnPixelCombine(Value: TPixelCombineEvent);
  1506. begin
  1507.   FBitmap.OnPixelCombine := Value;
  1508.   Changed;
  1509. end;
  1510.  
  1511. procedure TCustomImage32.SetScale(Value: Single);
  1512. begin
  1513.   if Value < 0.001 then Value := 0.001;
  1514.   if Value <> FScale then
  1515.   begin
  1516.     InvalidateCache;
  1517.     FScale := Value;
  1518.     DoScaleChange;
  1519.     Changed;
  1520.   end;
  1521. end;
  1522.  
  1523. procedure TCustomImage32.SetScaleMode(Value: TScaleMode);
  1524. begin
  1525.   if Value <> FScaleMode then
  1526.   begin
  1527.     InvalidateCache;
  1528.     FScaleMode := Value;
  1529.     Changed;
  1530.   end;
  1531. end;
  1532.  
  1533. procedure TCustomImage32.SetupBitmap(DoClear: Boolean = False; ClearColor: TColor32 = $FF000000);
  1534. begin
  1535.   FBitmap.BeginUpdate;
  1536.   with GetViewPortRect do
  1537.     FBitmap.SetSize(Right - Left, Bottom - Top);
  1538.   if DoClear then FBitmap.Clear(ClearColor);
  1539.   FBitmap.EndUpdate;
  1540.   InvalidateCache;
  1541.   Changed;
  1542. end;
  1543.  
  1544. procedure TCustomImage32.UpdateCache;
  1545. begin
  1546.   if CacheValid then Exit;
  1547.   CachedBitmapRect := GetBitmapRect;
  1548.   with CachedBitmapRect, CachedXForm do
  1549.   begin
  1550.     if Bitmap.Empty then CachedXForm := UnitXForm
  1551.     else
  1552.     begin
  1553.       Assert((Right > Left) and (Bottom > Top));
  1554.       ShiftX := Left;
  1555.       ShiftY := Top;
  1556.       ScaleX := MulDiv(Right - Left, $10000, Bitmap.Width);
  1557.       ScaleY := MulDiv(Bottom - Top, $10000, Bitmap.Height);
  1558.       RevScaleX := MulDiv(Bitmap.Width, $10000, Right - Left);
  1559.       RevScaleY := MulDiv(Bitmap.Height, $10000, Bottom - Top);
  1560.     end;
  1561.   end;
  1562.   CacheValid := True;
  1563. end;
  1564.  
  1565.  
  1566.  
  1567.  
  1568. { TIVScrollProperties }
  1569.  
  1570. function TIVScrollProperties.GetIncrement: Integer;
  1571. begin
  1572.   Result := Round(TCustomRangeBar(Master).Increment);
  1573. end;
  1574.  
  1575. function TIVScrollProperties.GetSize: Integer;
  1576. begin
  1577.   Result := ImgView.FScrollBarSize;
  1578. end;
  1579.  
  1580. procedure TIVScrollProperties.SetIncrement(Value: Integer);
  1581. begin
  1582.   TCustomRangeBar(Master).Increment := Value;
  1583.   TCustomRangeBar(Slave).Increment := Value;
  1584. end;
  1585.  
  1586. procedure TIVScrollProperties.SetSize(Value: Integer);
  1587. begin
  1588.   ImgView.FScrollBarSize := Value;
  1589.   ImgView.AlignAll;
  1590. end;
  1591.  
  1592.  
  1593.  
  1594.  
  1595. { TCustomImgView32 }
  1596.  
  1597. procedure TCustomImgView32.AlignAll;
  1598. begin
  1599.   with GetViewportRect do
  1600.   begin
  1601.     If Assigned(HScroll) then
  1602.     begin
  1603.       HScroll.BoundsRect := Rect(Left, Bottom, Right, Height);
  1604.       HScroll.Repaint;
  1605.     end;
  1606.  
  1607.     If Assigned(VScroll) then
  1608.     begin
  1609.       VScroll.BoundsRect := Rect(Right, Top, Width, Bottom);
  1610.       VScroll.Repaint;
  1611.     end;
  1612.   end;
  1613. end;
  1614.  
  1615. procedure TCustomImgView32.BitmapResized;
  1616. begin
  1617.   inherited;
  1618.   UpdateScrollBars;
  1619.   if Centered then ScrollToCenter(Bitmap.Width div 2, Bitmap.Height div 2)
  1620.   else
  1621.   begin
  1622.     HScroll.Position := 0;
  1623.     VScroll.Position := 0;
  1624.     UpdateImage;
  1625.   end;
  1626. end;
  1627.  
  1628. constructor TCustomImgView32.Create(AOwner: TComponent);
  1629. begin
  1630.   inherited;
  1631.  
  1632.   HScroll := TCustomRangeBar.Create(Self);
  1633.   VScroll := TCustomRangeBar.Create(Self);
  1634.  
  1635.   with HScroll do
  1636.   begin
  1637.     HScroll.Parent := Self;
  1638.     BorderStyle := bsNone;
  1639.     Centered := True;
  1640.     OnUserChange := ScrollHandler;
  1641.   end;
  1642.  
  1643.   with VScroll do
  1644.   begin
  1645.     Parent := Self;
  1646.     BorderStyle := bsNone;
  1647.     Centered := True;
  1648.     Kind := sbVertical;
  1649.     OnUserChange := ScrollHandler;
  1650.   end;
  1651.  
  1652.   FCentered := True;
  1653.   ScaleMode := smScale;
  1654.   BitmapAlign := baCustom;
  1655.   with GetViewportRect do
  1656.   begin
  1657.     OldSzX := Right - Left;
  1658.     OldSzY := Bottom - Top;
  1659.   end;
  1660.  
  1661.   FScrollBars := TIVScrollProperties.Create;
  1662.   FScrollBars.ImgView := Self;
  1663.   FScrollBars.Master := HScroll;
  1664.   FScrollBars.Slave := VScroll;
  1665.  
  1666.   AlignAll;
  1667. end;
  1668.  
  1669. destructor TCustomImgView32.Destroy;
  1670. begin
  1671.   FScrollBars.Free;
  1672.   inherited;
  1673. end;
  1674.  
  1675. procedure TCustomImgView32.DoDrawSizeGrip(R: TRect);
  1676. begin
  1677. {$IFNDEF CLX}
  1678.   if USE_THEMES then
  1679.   begin
  1680.     Canvas.Brush.Color := clBtnFace;
  1681.     Canvas.FillRect(R);
  1682.     DrawThemeBackground(SCROLLBAR_THEME, Canvas.Handle, SBP_SIZEBOX, SZB_RIGHTALIGN, R, nil);
  1683.   end
  1684.   else
  1685.     DrawFrameControl(Canvas.Handle, R, DFC_SCROLL, DFCS_SCROLLSIZEGRIP)
  1686. {$ENDIF}
  1687. end;
  1688.  
  1689. procedure TCustomImgView32.DoScaleChange;
  1690. begin
  1691.   InvalidateCache;
  1692.   UpdateScrollBars;
  1693.   UpdateImage;
  1694.   Invalidate;
  1695. end;
  1696.  
  1697. procedure TCustomImgView32.DoScroll;
  1698. begin
  1699.   if Assigned(FOnScroll) then FOnScroll(Self);
  1700. end;
  1701.  
  1702. function TCustomImgView32.GetScrollBarSize: Integer;
  1703. {$IFDEF CLX}
  1704. var
  1705.   Size: TSize;
  1706. {$ENDIF}
  1707. begin
  1708.   Result := FScrollBarSize;
  1709. {$IFDEF CLX}
  1710.   QStyle_scrollBarExtent(Application.Style.Handle, @Size);
  1711.   if Result = 0 then Result := Size.cy;
  1712. {$ELSE}
  1713.   if Result = 0 then Result := GetSystemMetrics(SM_CYHSCROLL);
  1714. {$ENDIF}
  1715. end;
  1716.  
  1717. function TCustomImgView32.GetSizeGripRect: TRect;
  1718. var
  1719.   Sz: Integer;
  1720. begin
  1721.   Sz := GetScrollBarSize;
  1722.   Result := GetClientRect;
  1723.   with Result do
  1724.   begin
  1725.     Left := Right - Sz;
  1726.     Top := Bottom - Sz;
  1727.   end;
  1728. end;
  1729.  
  1730. function TCustomImgView32.GetViewportRect: TRect;
  1731. var
  1732.   Sz: Integer;
  1733. begin
  1734.   Result := Rect(0, 0, Width, Height);
  1735.   Sz := GetScrollBarSize;
  1736.   Dec(Result.Right, Sz);
  1737.   Dec(Result.Bottom, Sz);
  1738. end;
  1739.  
  1740. function TCustomImgView32.IsSizeGripVisible: Boolean;
  1741. var
  1742.   P: TWinControl;
  1743. begin
  1744.   case SizeGrip of
  1745.     sgAuto:
  1746.       begin
  1747.         Result := False;
  1748.         if Align <> alClient then Exit;
  1749.         P := Parent;
  1750.         while True do
  1751.         begin
  1752.           if P is TCustomForm then
  1753.           begin
  1754.             Result := True;
  1755.             Break;
  1756.           end
  1757.           else if not Assigned(P) or (P.Align <> alClient) then Exit;
  1758.           P := P.Parent;
  1759.         end;
  1760.       end;
  1761.  
  1762.     sgNone: Result := False
  1763.  
  1764.   else { sgAlways }
  1765.     Result := True;
  1766.   end;
  1767. end;
  1768.  
  1769. procedure TCustomImgView32.Loaded;
  1770. begin
  1771.   AlignAll;
  1772.   Invalidate;
  1773.   UpdateScrollBars;
  1774.   if Centered then with Bitmap do ScrollToCenter(Width div 2, Height div 2);
  1775.   inherited;
  1776. end;
  1777.  
  1778. procedure TCustomImgView32.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1779. {$IFNDEF CLX}
  1780. var
  1781.   Action: Cardinal;
  1782.   Msg: TMessage;
  1783.   P: TPoint;
  1784. begin
  1785.   if IsSizeGripVisible and (Owner is TCustomForm) then
  1786.   begin
  1787.     P.X := X; P.Y := Y;
  1788.     if PtInRect(GetSizeGripRect, P) then
  1789.     begin
  1790.       Action := HTBOTTOMRIGHT;
  1791.       Application.ProcessMessages;
  1792.       Msg.Msg := WM_NCLBUTTONDOWN;
  1793.       Msg.WParam := Action;
  1794.       SetCaptureControl(nil);
  1795.       with Msg do SendMessage(TCustomForm(Owner).Handle, Msg, wParam, lParam);
  1796.       Exit;
  1797.     end;
  1798.   end;
  1799. {$ELSE}
  1800. begin  
  1801. {$ENDIF}
  1802.   inherited;
  1803. end;
  1804.  
  1805. procedure TCustomImgView32.MouseMove(Shift: TShiftState; X, Y: Integer);
  1806. var
  1807.   P: TPoint;
  1808. begin
  1809.   inherited;
  1810.   if IsSizeGripVisible then
  1811.   begin
  1812.     P.X := X; P.Y := Y;
  1813.     if PtInRect(GetSizeGripRect, P) then Screen.Cursor := crSizeNWSE;
  1814.   end;
  1815. end;
  1816.  
  1817. procedure TCustomImgView32.Paint;
  1818. begin
  1819.   if IsSizeGripVisible then
  1820.     DoDrawSizeGrip(GetSizeGripRect)
  1821.   else
  1822.   begin
  1823.     Canvas.Brush.Color := clBtnFace;
  1824.     Canvas.FillRect(GetSizeGripRect);
  1825.   end;
  1826.   inherited;
  1827. end;
  1828.  
  1829. procedure TCustomImgView32.Resize;
  1830. begin
  1831.   AlignAll;
  1832.   if IsSizeGripVisible then
  1833.     DoDrawSizeGrip(GetSizeGripRect)
  1834.   else
  1835.   begin
  1836.     Canvas.Brush.Color := clBtnFace;
  1837.     Canvas.FillRect(GetSizeGripRect);
  1838.   end;
  1839.   InvalidateCache;
  1840.   UpdateScrollBars;
  1841.   UpdateImage;
  1842.   Invalidate;
  1843.   inherited;
  1844. end;
  1845.  
  1846. procedure TCustomImgView32.Scroll(Dx, Dy: Integer);
  1847. begin
  1848.   DisableScrollUpdate := True;
  1849.   HScroll.Position := HScroll.Position + Dx;
  1850.   VScroll.Position := VScroll.Position + Dy;
  1851.   DisableScrollUpdate := False;
  1852.   UpdateImage;
  1853. end;
  1854.  
  1855. procedure TCustomImgView32.ScrollHandler(Sender: TObject);
  1856. begin
  1857.   if DisableScrollUpdate then Exit;
  1858.   if Sender = HScroll then HScroll.Repaint;
  1859.   if Sender = VScroll then VScroll.Repaint;
  1860.   UpdateImage;
  1861.   DoScroll;
  1862.   Repaint;
  1863. end;
  1864.  
  1865. procedure TCustomImgView32.ScrollToCenter(X, Y: Integer);
  1866. var
  1867.   ScaledDOversize: Integer;
  1868. begin
  1869.   DisableScrollUpdate := True;
  1870.   AlignAll;
  1871.  
  1872.   ScaledDOversize := Round(FOversize * Scale);
  1873.   with GetViewportRect do
  1874.   begin
  1875.     HScroll.Position := X * Scale - (Right - Left) / 2 + ScaledDOversize;
  1876.     VScroll.Position := Y * Scale - (Bottom - Top) / 2 + ScaledDOversize;
  1877.   end;
  1878.   DisableScrollUpdate := False;
  1879.   UpdateImage;
  1880. end;
  1881.  
  1882. procedure TCustomImgView32.SetCentered(Value: Boolean);
  1883. begin
  1884.   InvalidateCache;
  1885.   FCentered := Value;
  1886.   HScroll.Centered := Value;
  1887.   VScroll.Centered := Value;
  1888.   UpdateScrollBars;
  1889.   UpdateImage;
  1890.   if Value then with Bitmap do ScrollToCenter(Width div 2, Height div 2)
  1891.   else ScrollToCenter(0, 0);
  1892. end;
  1893.  
  1894. procedure TCustomImgView32.SetOverSize(const Value: Integer);
  1895. begin
  1896.   if Value <> FOverSize then
  1897.   begin
  1898.     FOverSize := Value;
  1899.     Invalidate;
  1900.   end;
  1901. end;
  1902.  
  1903. procedure TCustomImgView32.SetScrollBars(Value: TIVScrollProperties);
  1904. begin
  1905.   FScrollBars.Assign(Value);
  1906. end;
  1907.  
  1908. procedure TCustomImgView32.SetSizeGrip(Value: TSizeGripStyle);
  1909. begin
  1910.   if Value <> FSizeGrip then
  1911.   begin
  1912.     FSizeGrip := Value;
  1913.     Invalidate;
  1914.   end;
  1915. end;
  1916.  
  1917. procedure TCustomImgView32.UpdateImage;
  1918. var
  1919.   Sz: TSize;
  1920.   W, H: Integer;
  1921.   ScaledOversize: Integer;
  1922. begin
  1923.   Sz := GetBitmapSize;
  1924.   ScaledOversize := Round(FOversize * Scale);
  1925.  
  1926.   with GetViewportRect do
  1927.   begin
  1928.     W := Right - Left;
  1929.     H := Bottom - Top;
  1930.   end;
  1931.   BeginUpdate;
  1932.   if not Centered then
  1933.   begin
  1934.     OffsetHorz := -HScroll.Position + ScaledOversize;
  1935.     OffsetVert := -VScroll.Position + ScaledOversize;
  1936.   end
  1937.   else
  1938.   begin
  1939.     if W > Sz.Cx + 2 * ScaledOversize then // Viewport is bigger than scaled Bitmap
  1940.       OffsetHorz := (W - Sz.Cx) / 2
  1941.     else
  1942.       OffsetHorz := -HScroll.Position + ScaledOversize;
  1943.  
  1944.     if H > Sz.Cy + 2 * ScaledOversize then // Viewport is bigger than scaled Bitmap
  1945.       OffsetVert := (H - Sz.Cy) / 2
  1946.     else
  1947.       OffsetVert := -VScroll.Position + ScaledOversize;
  1948.   end;
  1949.   InvalidateCache;
  1950.   EndUpdate;    
  1951.   Changed;     
  1952. end;
  1953.  
  1954. procedure TCustomImgView32.UpdateScrollBars;
  1955. var
  1956.   Sz: TSize;
  1957.   ScaledDOversize: Integer;
  1958. begin
  1959.   If Assigned(HScroll) and Assigned(VScroll) then
  1960.   begin
  1961.     Sz := GetBitmapSize;
  1962.     ScaledDOversize := Round(2 * FOversize * Scale);
  1963.  
  1964.     HScroll.Range := Sz.Cx + ScaledDOversize;
  1965.     VScroll.Range := Sz.Cy + ScaledDOversize;
  1966.   end;
  1967. end;
  1968.  
  1969. { TBitmap32Item }
  1970.  
  1971. constructor TBitmap32Item.Create(Collection: TCollection);
  1972. begin
  1973.   inherited;
  1974.   FBitmap := TBitmap32.Create;
  1975. end;
  1976.  
  1977. destructor TBitmap32Item.Destroy;
  1978. begin
  1979.   FBitmap.Free;
  1980.   inherited;
  1981. end;
  1982.  
  1983. procedure TBitmap32Item.SetBitmap(ABitmap: TBitmap32);
  1984. begin
  1985.   FBitmap.Assign(ABitmap)
  1986. end;
  1987.  
  1988.  
  1989.  
  1990.  
  1991. { TBitmap32Collection }
  1992.  
  1993. function TBitmap32Collection.Add: TBitmap32Item;
  1994. begin
  1995.   Result := TBitmap32Item(inherited Add);
  1996. end;
  1997.  
  1998. constructor TBitmap32Collection.Create(AOwner: TPersistent; ItemClass: TBitmap32ItemClass);
  1999. begin
  2000.   inherited Create(ItemClass);
  2001.   FOwner := AOwner;
  2002. end;
  2003.  
  2004. function TBitmap32Collection.GetItem(Index: Integer): TBitmap32Item;
  2005. begin
  2006.   Result := TBitmap32Item(inherited GetItem(Index));
  2007. end;
  2008.  
  2009. function TBitmap32Collection.GetOwner: TPersistent;
  2010. begin
  2011.   Result := FOwner;
  2012. end;
  2013.  
  2014. procedure TBitmap32Collection.SetItem(Index: Integer; Value: TBitmap32Item);
  2015. begin
  2016.   inherited SetItem(Index, Value);
  2017. end;
  2018.  
  2019.  
  2020.  
  2021.  
  2022. { TBitmap32List }
  2023.  
  2024. constructor TBitmap32List.Create(AOwner: TComponent);
  2025. begin
  2026.   inherited;
  2027.   FBitmap32Collection := TBitmap32Collection.Create(Self, TBitmap32Item);
  2028. end;
  2029.  
  2030. destructor TBitmap32List.Destroy;
  2031. begin
  2032.   FBitmap32Collection.Free;
  2033.   inherited;
  2034. end;
  2035.  
  2036. function TBitmap32List.GetBitmap(Index: Integer): TBitmap32;
  2037. begin
  2038.   Result := FBitmap32Collection.Items[Index].Bitmap;
  2039. end;
  2040.  
  2041. procedure TBitmap32List.SetBitmap(Index: Integer; Value: TBitmap32);
  2042. begin
  2043.   FBitmap32Collection.Items[Index].Bitmap := Value;
  2044. end;
  2045.  
  2046. procedure TBitmap32List.SetBitmap32Collection(Value: TBitmap32Collection);
  2047. begin
  2048.   FBitmap32Collection := Value;
  2049. end;
  2050.  
  2051. end.
  2052.