API tools faq
paste
Advertisement
Stella_209

AL_ZoomImg.pas

Stella_209
May 21st, 2018
175
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 105.23 KB | None | 0 0
raw download clone embed print report
  1. // ===========================================================================
  2. // TALZoomImage
  3. //          is a flicker-free visual reprezentation of memory bitmap
  4. //          By Agócs Lászlo StellaSOFT, Hungary 2009
  5. //          Test in Delphi 5
  6. //          Licens: Absolutely Free!!!!
  7. // Load/Save image files: JPG, BMP;  (You can develope for other formats!)
  8. // You can dragging the image by pressed left mouse button,
  9. //     and zooming width rotating of mouse wheel button.
  10. // Any point move to the centre by double click or right click
  11. // Optimized speed for drawing.
  12. // If you click on the the component it will be focused if Tabstop property= True;
  13. //
  14. // Needed files:
  15. //        Cursors.res      // curzor images
  16. //        JPeg.pas         // For JPEG images
  17. // ===========================================================================
  18.  
  19. unit AL_ZoomImg;
  20.  
  21. interface
  22.  
  23. uses
  24.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  25.   ExtCtrls, {DesignEditors,} Vcl.Imaging.jpeg, ClipBrd, NewGeom,
  26.   STAF_Imp, AlType;
  27.  
  28.  
  29. Const
  30.   WM_IMAGEMOUSEDOWN    = WM_USER + 1000;
  31.   WM_IMAGEMOUSEMOVE    = WM_USER + 1001;
  32.   WM_IMAGEMOUSEUP      = WM_USER + 1002;
  33.   WM_IMAGECHANGE       = WM_USER + 1003;
  34.  
  35. Type
  36.   TImageTypes = (itNone, itBMP, itJPG);
  37.  
  38.   { Clipboard copy/paste: Total image; Only on Screen; Only the selected area}
  39.   TClipBoardAction = (cbaTotal,        // Total Image
  40.                       cbaScreen,       // Only the screen image
  41.                       cbaSelected,     // Only the selected area
  42.                       cbaScreenSelected,// Only the selected area from screen
  43.                       cbaFixArea,      // Fix rect from image
  44.                       cbaFixWindow);   // Fix rect from screen
  45.  
  46.    PRGBTripleArray = ^TRGBTripleArray;
  47.    TRGBTripleArray = array[0..32767] of TRGBTriple;
  48.  
  49.   //Events type for zooming or dragging of component picture
  50.   TChangeWindow = procedure(Sender: TObject; xCent,yCent,xWorld,yWorld,Zoom: double;
  51.                             MouseX,MouseY: integer) of object;
  52.  
  53.   TBeforePaint = procedure(Sender: TObject; xCent,yCent: double;
  54.                             DestRect: TRect) of object;
  55.  
  56. type
  57. {
  58.   TFileProperty = class(TStringProperty)
  59.   private
  60.     FileType : string[3];
  61.   public
  62.     FOpenDialog : TOpenDialog;
  63.     function GetAttributes: TPropertyAttributes; override;
  64.     function GetValue: string; override;
  65.     procedure SetValue(const Value: string); override;
  66.     procedure Edit; override;
  67.   end;
  68. }
  69.   TImageGrid = Class(TPersistent)
  70.   private
  71.     fVisible: boolean;
  72.     FOnChange: TNotifyEvent;
  73.     fOnlyOnPaper: boolean;
  74.     FGridPen: TPen;
  75.     FSubGridPen: TPen;
  76.     FGridDistance: double;
  77.     FSubGridDistance: double;
  78.     FScale: boolean;
  79.     FScaleFont: TFont;
  80.     FPixelGrid: boolean;
  81.     FScaleBrush: TBrush;
  82.     FFix: boolean;
  83.     procedure SetVisible(const Value: boolean);
  84.     procedure SetOnlyOnPaper(const Value: boolean);
  85.     procedure SetGridPen(const Value: TPen);
  86.     procedure SetSubGridPen(const Value: TPen);
  87.     procedure SetGridDistance(const Value: double);
  88.     procedure SetSubGridDistance(const Value: double);
  89.     procedure SetScale(const Value: boolean);
  90.     procedure SetScaleFont(const Value: TFont);
  91.     procedure SetPixelGrid(const Value: boolean);
  92.     procedure SetScaleBrush(const Value: TBrush);
  93.     procedure StyleChanged(Sender: TObject);
  94.     procedure SetFix(const Value: boolean);
  95.   protected
  96.     procedure Changed;
  97.   public
  98.     constructor Create;
  99.     destructor Destroy; override;
  100.   published
  101.     property Fix: boolean read FFix write SetFix;
  102.     property GridDistance: double read FGridDistance write SetGridDistance;
  103.     property GridPen: TPen read FGridPen write fGridPen;
  104.     property SubGridPen: TPen read FSubGridPen write fSubGridPen;
  105.     property SubGridDistance: double read FSubGridDistance write SetSubGridDistance;
  106.     property OnlyOnPaper: boolean read fOnlyOnPaper write SetOnlyOnPaper default True;
  107.     property PixelGrid : boolean read FPixelGrid write SetPixelGrid;
  108.     property Scale: boolean read FScale write SetScale;  // Scale text visible
  109.     property ScaleFont: TFont read FScaleFont write fScaleFont;
  110.     property ScaleBrush: TBrush read FScaleBrush write fScaleBrush;
  111.     property Visible: boolean read fVisible write SetVisible default True;
  112.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  113.   end;
  114.  
  115.   TRGBSet = (rgbRGB, rgbR, rgbG, rgbB);
  116.  
  117.   // Object for signifícant of R,G,B chanel visibility:
  118.   // Original composite picture then R=True; G=True and B=True;
  119.   TRGBChanel = class(TPersistent)
  120.   private
  121.     FG: boolean;
  122.     FR: boolean;
  123.     FB: boolean;
  124.     FOnChange: TNotifyEvent;
  125.     FMonoRGB: boolean;
  126.     FRGB: boolean;
  127.     procedure SetB(const Value: boolean);
  128.     procedure SetG(const Value: boolean);
  129.     procedure SetR(const Value: boolean);
  130.     procedure SetMonoRGB(const Value: boolean);
  131.     procedure SetRGB(const Value: boolean);
  132.   protected
  133.     procedure Changed;
  134.   public
  135.     RGBBMP : TBitmap;
  136.     constructor Create;
  137.     destructor Destroy; override;
  138.     procedure ChangeRGB(mono,rr,gg,bb: boolean);
  139.   published
  140.     property MonoRGB : boolean read FMonoRGB write SetMonoRGB;
  141.     property RGB     : boolean read FRGB write SetRGB;
  142.     property R : boolean read FR write SetR default True;
  143.     property G : boolean read FG write SetG default True;
  144.     property B : boolean read FB write SetB default True;
  145.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  146.   end;
  147.  
  148.   // DataSource component for some other viewers
  149.   TALImageSource = class(TComponent)
  150.   private
  151.     FFileName: TFileName;
  152.     FRGBList: TRGBChanel;
  153.     procedure SetFileName(const Value: TFileName);
  154.     procedure SetRGBList(const Value: TRGBChanel);
  155.   protected
  156.     Loading   : boolean;
  157.   public
  158.     OrigBMP        : TBitmap;      // Original bmp in memory
  159.     WorkBMP        : TBitmap;      // bmp copy for working in memory
  160.     CopyBMP        : TBitmap;      // Temporary bmp for internal use (save,rotate,...)
  161.     constructor Create(AOwner: TComponent);
  162.     destructor Destroy; override;
  163.     procedure Change(Sender: TObject);
  164.     procedure New(nWidth, nHeight: integer; nColor: TColor);
  165.     function  LoadFromFile(FileName: TFileName):boolean;
  166.     function  SaveToFile(FileName: TFileName):boolean;
  167.     procedure RestoreOriginal;
  168.     procedure SaveAsOriginal;
  169.   published
  170.     property FileName    : TFileName read FFileName write SetFileName;
  171. //    property RGBList     : TRGBChanel read FRGBList write SetRGBList;
  172.   end;
  173.  
  174.   TALCustomImageView = class(TCustomControl)
  175.   private
  176.     FClipBoardAction: TClipBoardAction;
  177.     FCentered: boolean;
  178.     FOverMove: boolean;
  179.     FEnableActions: boolean;
  180.     FBackCross: boolean;
  181.     FPixelGrid: boolean;
  182.     FEnableSelect: boolean;
  183.     fCentralCross: boolean;
  184.     fCursorCross: boolean;
  185.     fZoom: extended;
  186.     FBulbRadius: integer;
  187.     FAfterPaint: TBeforePaint;
  188.     FBeforePaint: TBeforePaint;
  189.     FChangeWindow: TChangeWindow;
  190.     FBackColor: TColor;
  191.     FFileName: TFileName;
  192.     FGrid: TImageGrid;
  193.     FMouseLeave: TNotifyEvent;
  194.     FMouseEnter: TNotifyEvent;
  195.     FRGBList: TRGBChanel;
  196.     FActualPixel: TPoint;
  197.     FSelRectVisible: boolean;
  198.     FFitting: boolean;
  199.     FImageSource: TALImageSource;
  200.     procedure WMEraseBkGnd(var Message:TWMEraseBkGnd); message WM_ERASEBKGND;
  201.     procedure WMSize(var Msg: TWMSize); message WM_SIZE;
  202.     procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;
  203.     procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
  204.     procedure SetBackColor(const Value: TColor);
  205.     procedure SetBackCross(const Value: boolean);
  206.     procedure SetBulbRadius(const Value: integer);
  207.     procedure SetCentered(const Value: boolean);
  208.     procedure SetCentralCross(const Value: boolean);
  209.     procedure SetCursorCross(const Value: boolean);
  210.     procedure SetFileName(const Value: TFileName);
  211.     procedure SetOverMove(const Value: boolean);
  212.     procedure SetPixelGrid(const Value: boolean);
  213.     procedure SetRGBList(const Value: TRGBChanel);
  214.     procedure SetZoom(const Value: extended);
  215.     procedure SetSelRectVisible(const Value: boolean);
  216.     procedure SetImageSource(const Value: TALImageSource);
  217.   protected
  218.     timer               : TTimer;     // Timer for any doing;
  219.     pFazis              : integer;    // Fazis for any action
  220.     Origin,MovePt       : TPoint;
  221.     oldOrigin,oldMovePt : TPoint;
  222.     mouseLeft           : boolean;
  223.     oldCursor           : TCursor;
  224.     oldCursorCross      : boolean;
  225.     MouseInOut          : integer;   // Mouse in:1, Mouse:0, Mouse out:-1
  226.     WinRgn              : HRgn;      // Window region;
  227.     AutoPopup           : boolean;   // PopupMenu enable
  228.     procedure Change(Sender: TObject);
  229.     procedure OnTimer(Sender: TObject);
  230.     procedure CalculateRects;
  231.     procedure InitSelWindow;
  232.     procedure SelToScreen;
  233.     procedure InitBackImage;
  234.     procedure pChange(Sender: TObject);
  235.     procedure DrawMouseCross(o:TPoint;PenMode:TPenMode);
  236.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  237.     procedure KeyPress(var Key: Char); override;
  238.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  239.       X, Y: Integer); override;
  240.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  241.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  242.       X, Y: Integer); override;
  243.     function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  244.       MousePos: TPoint): Boolean; override;
  245.     function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
  246.     function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
  247.     procedure Click;  override;
  248.     procedure DblClick;  override;
  249.   public
  250.     BackBMP        : TBitmap;      // Ready bmp for copy to screen
  251.     PasteBMP       : TBitmap;      // Temporary bmp for Paste special
  252.     BMPOffset      : TPoint;
  253.     Sizes          : TPoint;       // OriginalBmp sizes (width, height)
  254.     sCent          : TPoint2d;     // Centrum of the source rectangle on WorkBMP
  255.     newCent        : TPoint2d;     // Centrum of the source rectangle on CopyBMP
  256.     sRect          : TRect2d;      // Rectangle for part of source bitmap
  257.     dRect          : TRect;        // Rectangle for stretching to the screen
  258.     SelRect        : TRect;        // Selected area on the screen;
  259.     FixRect        : TRect;        // Fix rectangle on image
  260.     FixWinRect     : TRect;        // Fix rectangle on screen
  261.     oldPos         : TPoint;       // Store the old mouse position in window
  262.     cPen           : TPen;         // Pen for central cross;
  263.     Loading        : boolean;      // Something in progress
  264.     Moving         : boolean;      // Indicates the image dragging by mouse
  265.     constructor Create(AOwner: TComponent); override;
  266.     destructor Destroy; override;
  267.     procedure Paint; override;
  268.     procedure wChange(Sender: TObject);  // if WorkBMP Changed
  269.     procedure New(nWidth, nHeight: integer; nColor: TColor);
  270.     function LoadFromFile(FileName: TFileName):boolean;
  271.     function SaveToFile(FileName: TFileName):boolean;
  272.     procedure CutToClipboard;
  273.     procedure CopyToClipboard;
  274.     procedure PasteFromClipboard;
  275.     procedure PasteSpecial;
  276.     procedure EnablePopup(en: boolean);   // Enable/disable popup menu
  277.     function XToW(x: integer): double;
  278.     function YToW(y: integer): double;
  279.     function XToS(x: double): integer;
  280.     function YToS(y: double): integer;
  281.     function WToS(p: TPoint2d): TPoint;
  282.     function SToW(p: TPoint): TPoint2d;
  283.     function ScreenRectToWorld(R: TRect): TRect;
  284.     function WorldRectToScreen(R: TRect): TRect;
  285.     procedure FitToScreen;
  286.     procedure MoveWindow(x,y: double); overload;
  287.     procedure ShiftWindow(x, y: double);
  288.     procedure MoveToCentrum(x,y: double);
  289.     procedure PixelToCentrum(x,y: integer);
  290.     procedure RestoreOriginal;
  291.     procedure SaveAsOriginal;
  292.     procedure FadeOut(Pause: Integer);
  293.     function GetRGB(x,y: integer): TRGB24;
  294.     function GetPixelColor(p: TPoint): TColor;
  295.     procedure SetPixelColor(p: TPoint; Co: TColor);
  296.       // Drawing
  297.     procedure FillRect(R: TRect; co: TColor);
  298.     procedure DrawGrid;
  299.     procedure DrawPixelGrid;
  300.     property Canvas;
  301.       // Actual pixel coordinates for operation
  302.     property ActualPixel : TPoint read FActualPixel write FActualPixel;
  303.     property SelRectVisible : boolean read FSelRectVisible write SetSelRectVisible;
  304.     // Published properties
  305.     property ClipBoardAction: TClipBoardAction read FClipBoardAction write FClipBoardAction;
  306.     property BackColor   : TColor read FBackColor write SetBackColor;
  307.     property BackCross   : boolean read FBackCross write SetBackCross;
  308.     property BulbRadius  : integer read FBulbRadius write SetBulbRadius default 0;
  309.     property Centered    : boolean read FCentered write SetCentered;
  310.     property CentralCross: boolean read fCentralCross write SetCentralCross;
  311.     property CursorCross : boolean read fCursorCross write SetCursorCross;
  312.     property ImageSource : TALImageSource read FImageSource write SetImageSource;
  313.     property EnableSelect: boolean read FEnableSelect write FEnableSelect;
  314.     property EnableActions: boolean read FEnableActions write FEnableActions default True;
  315.     property FileName    : TFileName read FFileName write SetFileName;
  316.     property Fitting     : boolean read FFitting write FFitting;
  317.     property Grid        : TImageGrid read FGrid write FGrid;
  318.     property OverMove    : boolean read FOverMove write SetOverMove;
  319.     property PixelGrid   : boolean read FPixelGrid write SetPixelGrid;
  320.     property RGBList     : TRGBChanel read FRGBList write SetRGBList;
  321.     property Zoom        : extended read fZoom write SetZoom;
  322.     property OnChangeWindow: TChangeWindow read FChangeWindow write FChangeWindow;
  323.     property OnBeforePaint: TBeforePaint read FBeforePaint write FBeforePaint;
  324.     property OnAfterPaint: TBeforePaint read FAfterPaint write FAfterPaint;
  325.     property OnMouseEnter: TNotifyEvent read FMouseEnter write FMouseEnter;
  326.     property OnMouseLeave: TNotifyEvent read FMouseLeave write FMouseLeave;
  327.   end;
  328.  
  329.   TALCustomZoomImage = class(TCustomControl)
  330.   private
  331.     FClipBoardAction: TClipBoardAction;
  332.     FCentered: boolean;
  333.     FOverMove: boolean;
  334.     FEnableActions: boolean;
  335.     FBackCross: boolean;
  336.     FPixelGrid: boolean;
  337.     FEnableSelect: boolean;
  338.     fCentralCross: boolean;
  339.     fCursorCross: boolean;
  340.     fZoom: extended;
  341.     FBulbRadius: integer;
  342.     FAfterPaint: TBeforePaint;
  343.     FBeforePaint: TBeforePaint;
  344.     FChangeWindow: TChangeWindow;
  345.     FBackColor: TColor;
  346.     FFileName: string;
  347.     FGrid: TImageGrid;
  348.     FMouseLeave: TNotifyEvent;
  349.     FMouseEnter: TNotifyEvent;
  350.     FRGBList: TRGBChanel;
  351.     FActualPixel: TPoint;
  352.     FSelRectVisible: boolean;
  353.     FFitting: boolean;
  354.     FRotateAngle: double;
  355.     FVisibleImage: boolean;
  356.     FChange: TNotifyEvent;
  357.     FEnableFocus: boolean;
  358.     FOffset: TPoint2d;
  359.     fHinted: boolean;
  360.     Hint1   : THintWindow;
  361.     HintActive : boolean;
  362.     oldHintStr: string;
  363.     FImageVisible: boolean;
  364.     FVisibleOverlay: boolean;
  365.     fCircleWindow: boolean;
  366.     procedure WMEraseBkGnd(var Message:TWMEraseBkGnd); message WM_ERASEBKGND;
  367.     procedure WMSize(var Msg: TWMSize); message WM_SIZE;
  368.     procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;
  369.     procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
  370.     Procedure CMChildkey( Var msg: TCMChildKey ); message CM_CHILDKEY;
  371.     procedure SetBackColor(const Value: TColor);
  372.     procedure SetBackCross(const Value: boolean);
  373.     procedure SetBulbRadius(const Value: integer);
  374.     procedure SetCentered(const Value: boolean);
  375.     procedure SetCentralCross(const Value: boolean);
  376.     procedure SetCursorCross(const Value: boolean);
  377.     procedure SetFileName(const Value: string);
  378.     procedure SetOverMove(const Value: boolean);
  379.     procedure SetPixelGrid(const Value: boolean);
  380.     procedure SetRGBList(const Value: TRGBChanel);
  381.     procedure SetZoom(const Value: extended);
  382.     procedure SetSelRectVisible(const Value: boolean);
  383.     procedure SetRotateAngle(const Value: double);
  384.     procedure SetVisibleImage(const Value: boolean);
  385.     procedure Draw_Grid(gRect: TRect2d; GridWidth: double; Scale: boolean);
  386.     procedure oChange(Sender: TObject);
  387.     procedure SetFitting(const Value: boolean);
  388.     procedure SetVisibleOverlay(const Value: boolean);
  389.     procedure SetClipBoardAction(const Value: TClipBoardAction);
  390.     procedure SetCircleWindow(const Value: boolean);
  391.   protected
  392.     elso                : boolean;
  393.     timer               : TTimer;     // Timer for any doing;
  394.     pFazis              : integer;    // Fazis for any action
  395.     oldOrigin,oldMovePt : TPoint;
  396.     mouseLeft           : boolean;
  397.     oldCursor           : TCursor;
  398.     oldCursorCross      : boolean;
  399.     MouseInOut          : integer;   // Mouse in:1, Mouse:0, Mouse out:-1
  400.     WinRgn              : HRgn;      // Window region;
  401.     AutoPopup           : boolean;   // PopupMenu enable
  402.     SelDirect           : integer;
  403.     procedure Change(Sender: TObject);
  404.     procedure OnTimer(Sender: TObject);
  405.     procedure CalculateRects;
  406.     procedure InitSelWindow;
  407.     procedure SelToScreen;
  408.     procedure InitBackImage;
  409.     function  GetNewCent(origCent: TPoint2d): TPoint2d;
  410.     procedure pChange(Sender: TObject);
  411.     procedure wChange(Sender: TObject);  // if WorkBMP Changed
  412.     procedure DrawMouseCross(o:TPoint;PenMode:TPenMode);
  413.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  414.     procedure KeyPress(var Key: Char); override;
  415.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  416.       X, Y: Integer); override;
  417.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  418.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  419.       X, Y: Integer); override;
  420.     function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  421.       MousePos: TPoint): Boolean; override;
  422.     function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
  423.     function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
  424.     procedure Click;  override;
  425.     procedure DblClick;  override;
  426.   public
  427.     OrigBMP        : TBitmap;      // Original bmp in memory
  428.     WorkBMP        : TBitmap;      // bmp copy for working in memory
  429.     BackBMP        : TBitmap;      // Redy bmp for copy to screen
  430.     CopyBMP        : TBitmap;      // Temporary bmp for internal use
  431.     PasteBMP       : TBitmap;      // Temporary bmp for Paste special
  432.     StretchBitmap  : TStretchBitmap;  // For special effects (Rotate,Skew)
  433.     InnerStream    : TMemoryStream;   // For save workBMP when image not shoe
  434.     BMPOffset      : TPoint;
  435.     Sizes          : TPoint;       // OriginalBmp sizes (width, height)
  436.     sCent          : TPoint2d;     // Centrum of the source rectangle on WorkBMP
  437.     newCent        : TPoint2d;     // Centrum of the source rectangle on CopyBMP
  438.     sRect          : TRect2d;      // Rectangle for part of source bitmap
  439.     dRect          : TRect;        // Rectangle for stretching to the screen
  440.     SelRect        : TRect;        // Selected area on the screen;
  441.     FixRect        : TRect;        // Fix rectangle on image
  442.     FixSizes       : TPoint;       // Fix rectangle sizes: width,height
  443.     FixWinRect     : TRect;        // Fix rectangle on screen
  444.     oldPos         : TPoint;       // Store the old mouse position in window
  445.     cPen           : TPen;         // Pen for central cross;
  446.     Origin,MovePt  : TPoint;
  447.     Loading        : boolean;      // Something in progress
  448.     Moving         : boolean;      // Indicates the image dragging by mouse
  449.     constructor Create(AOwner: TComponent); override;
  450.     destructor Destroy; override;
  451.     procedure Paint; override;
  452.     procedure ReDraw;
  453.     procedure New(nWidth, nHeight: integer; nColor: TColor);
  454.     function LoadFromFile(FileName: TFileName):boolean;
  455.     function SaveToFile(FileName: TFileName):boolean;
  456.     function LoadFromStream(stm: TStream; ImageType: TImageTypes): boolean;
  457.     function SaveToStream(stm: TStream; ImageType: TImageTypes): boolean;
  458.     procedure CutToClipboard;
  459.     procedure CopyToClipboard;
  460.     procedure PasteFromClipboard;
  461.     procedure PasteSpecial;
  462.     procedure CropSelected;
  463.     procedure EnablePopup(en: boolean);   // Enable/disable popup menu
  464.     function XToW(x: integer): double;
  465.     function YToW(y: integer): double;
  466.     function XToS(x: double): integer;
  467.     function YToS(y: double): integer;
  468.     function WToS(p: TPoint2d): TPoint;
  469.     function SToW(p: TPoint): TPoint2d;
  470.     function WorldToScreen(p: TPoint2d): TPoint;
  471.     function ScreenToWorld(p: TPoint): TPoint2d;
  472.     function ScreenRectToWorld(R: TRect): TRect;
  473.     function WorldRectToScreen(R: TRect): TRect;
  474.     procedure FitToScreen;
  475.     procedure MoveWindow(x,y: double); overload;
  476.     procedure ShiftWindow(x, y: double);
  477.     procedure MoveToCentrum(x,y: double);
  478.     procedure Transform(x,y,rot : double);
  479.     procedure PixelToCentrum(x,y: integer);
  480.     procedure SelRectToCentrum;
  481.     procedure RestoreOriginal;
  482.     procedure SaveAsOriginal;
  483.     function GetRGB(x,y: integer): TRGB24;
  484.     function GetPixelColor(p: TPoint): TColor;
  485.     procedure SetPixelColor(p: TPoint; Co: TColor);
  486.       // Drawing
  487.     procedure FillRect(R: TRect; co: TColor);
  488.     procedure DrawGrid;
  489.     procedure DrawPixelGrid;
  490.     procedure ShowHintPanel(Show: Boolean; x,y: integer; HintText: string);
  491.     procedure CloseHintPanel;
  492.  
  493.     // RGB Colors (only for display)
  494.     procedure SetVRGB;
  495.     procedure SetVR;
  496.     procedure SetVG;
  497.     procedure SetVB;
  498.  
  499.     procedure Clear;
  500.     procedure TurnLeft;
  501.     procedure TurnRight;
  502.     procedure MirrorHorizontal;
  503.     procedure MirrorVertical;
  504.     procedure FadeOut(Pause: Integer);
  505.     procedure Negative;
  506.     procedure MonoChrome;
  507.     procedure BlackAndWhite;
  508.     procedure Saturation(Amount: Integer);
  509.     procedure Lightness(Amount: Integer);
  510.     procedure Darkness(Amount: integer);
  511.     procedure Contrast(Amount: Integer);
  512.     procedure Sepia(depth:byte);
  513.     Procedure Blur;
  514.     procedure Posterize(amount: integer);
  515.  
  516.     property Canvas;
  517.       // Actual pixel coordinates for operation
  518.     property ActualPixel : TPoint read FActualPixel write FActualPixel;
  519.     property SelRectVisible : boolean read FSelRectVisible write SetSelRectVisible;
  520.     property Offset      : TPoint2d read FOffset write FOffset;
  521.     // Published properties
  522.     property ClipBoardAction: TClipBoardAction read FClipBoardAction write SetClipBoardAction;
  523.     property BackColor   : TColor read FBackColor write SetBackColor;
  524.     property BackCross   : boolean read FBackCross write SetBackCross;
  525.     property BulbRadius  : integer read FBulbRadius write SetBulbRadius default 0;
  526.     property Centered    : boolean read FCentered write SetCentered;
  527.     property CentralCross: boolean read fCentralCross write SetCentralCross;
  528.     property CursorCross : boolean read fCursorCross write SetCursorCross;
  529.     property CircleWindow: boolean read fCircleWindow write SetCircleWindow;
  530.     property EnableFocus : boolean read FEnableFocus write FEnableFocus;
  531.     property EnableSelect: boolean read FEnableSelect write FEnableSelect;
  532.     property EnableActions: boolean read FEnableActions write FEnableActions;
  533.     property FileName    : string read FFileName write SetFileName;
  534.     property Fitting     : boolean read FFitting write SetFitting;
  535.     property Grid        : TImageGrid read FGrid write FGrid;
  536.     property Hinted      : boolean read fHinted write fHinted;
  537.     property OverMove    : boolean read FOverMove write SetOverMove;
  538.     property PixelGrid   : boolean read FPixelGrid write SetPixelGrid;
  539.     property RGBList     : TRGBChanel read FRGBList write SetRGBList;
  540.     property RotateAngle : double read FRotateAngle write SetRotateAngle;
  541.     property Zoom        : extended read fZoom write SetZoom;
  542.     property VisibleImage  : boolean read FVisibleImage write SetVisibleImage;
  543.     property VisibleOverlay: boolean read FVisibleOverlay write SetVisibleOverlay;
  544.     property OnChange    : TNotifyEvent read FChange write FChange;
  545.     property OnChangeWindow: TChangeWindow read FChangeWindow write FChangeWindow;
  546.     property OnBeforePaint: TBeforePaint read FBeforePaint write FBeforePaint;
  547.     property OnAfterPaint: TBeforePaint read FAfterPaint write FAfterPaint;
  548.     property OnMouseEnter: TNotifyEvent read FMouseEnter write FMouseEnter;
  549.     property OnMouseLeave: TNotifyEvent read FMouseLeave write FMouseLeave;
  550.   end;
  551.  
  552.   // Draws an RGB Diagramm for ZoomImage active line
  553.   TALCustomRGBDiagram = class(TCustomControl)
  554.   private
  555.     FGColor: boolean;
  556.     FBColor: boolean;
  557.     FRColor: boolean;
  558.     FRGBColor: boolean;
  559.     FZoomImage: TALCustomZoomImage;
  560.     FFixLine: boolean;
  561.     FDotVisible: boolean;
  562.     FBackColor: TColor;
  563.     FPenWidth: integer;
  564.     FAlignToImage: boolean;
  565.     FRGBStatistic: boolean;
  566.     procedure WMEraseBkGnd(var Message:TWMEraseBkGnd); message WM_ERASEBKGND;
  567.     procedure WMMouseMove(var Msg: TMessage); message WM_IMAGEMOUSEMOVE;
  568.     procedure WMChange(var Msg: TMessage); message WM_IMAGECHANGE;
  569.     procedure SetZoomImage(const Value: TALCustomZoomImage);
  570.     procedure SetDotVisible(const Value: boolean);
  571.     procedure SetBackColor(const Value: TColor);
  572.     procedure SetPenWidth(const Value: integer);
  573.     procedure SetBColor(const Value: boolean);
  574.     procedure SetGColor(const Value: boolean);
  575.     procedure SetRColor(const Value: boolean);
  576.     procedure SetRGBColor(const Value: boolean);
  577.     procedure SetAlignToImage(const Value: boolean);
  578.     procedure SetRGBStatistic(const Value: boolean);
  579.   protected
  580.     BMP: TBitmap;
  581. (*
  582.     oldMouseDown : TMouseEvent;
  583.     oldMouseMove : TMouseMoveEvent;
  584.     oldMouseUp   : TMouseEvent;
  585.     oldChangeWindow : TChangeWindow;
  586.     procedure ImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
  587.       X, Y: Integer);
  588.     procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  589.     procedure ImageChangeWindow(Sender: TObject; xCent,yCent,xWorld,yWorld,Zoom: double;
  590.                             MouseX,MouseY: integer);
  591. *)
  592.     procedure Resize; override;
  593.   public
  594.     MouseX,MouseY: integer;
  595.     rgbMax : TRGB24;
  596.     constructor Create(AOwner: TComponent); override;
  597.     destructor Destroy; override;
  598.     procedure Paint; override;
  599.     procedure ReDraw(x,y: integer);
  600.     procedure DrawGraph(SourceBMP: TBitmap;x,y,PixelWidth: integer);
  601.     procedure ReadRGBStatistic;
  602.  
  603.     property AlignToImage : boolean read FAlignToImage  write SetAlignToImage;
  604.     property BackColor : TColor  read FBackColor write SetBackColor;
  605.     property PenWidth  : integer read FPenWidth  write SetPenWidth;
  606.     property RGBColor  : boolean read FRGBColor write SetRGBColor;
  607.     property RColor    : boolean read FRColor write SetRColor;
  608.     property GColor    : boolean read FGColor write SetGColor;
  609.     property BColor    : boolean read FBColor write SetBColor;
  610.              { A kép középvonalának diagramja }
  611.     property FixLine   : boolean read FFixLine write FFixLine;
  612.              { A diagram pontok rajzolása }
  613.     property DotVisible: boolean read FDotVisible write SetDotVisible;
  614.     property RGBStatistic: boolean read FRGBStatistic write SetRGBStatistic;
  615.              { Forrás kép }
  616.     property ZoomImage: TALCustomZoomImage read FZoomImage write SetZoomImage;
  617.   end;
  618.  
  619.   TALCustomRGBDiagram3D = class(TCustomControl)
  620.   private
  621.     FZoomImage: TALCustomZoomImage;
  622.     FBackColor: TColor;
  623.     procedure SetBackColor(const Value: TColor);
  624.     procedure SetZoomImage(const Value: TALCustomZoomImage);
  625.   protected
  626.   public
  627.     constructor Create(AOwner: TComponent); override;
  628.     destructor Destroy; override;
  629.     procedure Paint; override;
  630.     procedure DrawGraph(SourceBMP: TBitmap;x,y,PixelWidth: integer);
  631.     property BackColor : TColor  read FBackColor write SetBackColor;
  632.              { Forrás kép }
  633.     property ZoomImage: TALCustomZoomImage read FZoomImage write SetZoomImage;
  634.   end;
  635.  
  636. (*
  637.   // ZoomImage descendat for astrophotography
  638.   TALCustomAstroImage = class(TALCustomZoomImage)
  639.   private
  640.     FImageVisible: boolean;
  641.     FStarVisible: boolean;
  642.     FStarBrush: TBrush;
  643.     procedure SetImageVisible(const Value: boolean);
  644.     procedure SetStarBrush(const Value: TBrush);
  645.     procedure SetStarVisible(const Value: boolean);
  646.   protected
  647.   public
  648.     StarList  : TStarList;
  649.     constructor Create(AOwner: TComponent); override;
  650.     destructor Destroy; override;
  651.     function StarDetect: integer;
  652.     function PrecizeStarDetect: integer;
  653.     property ImageVisible : boolean read FImageVisible write SetImageVisible;
  654.     property StarVisible  : boolean read FStarVisible write SetStarVisible;
  655.     property StarBrush    : TBrush  read FStarBrush   write SetStarBrush;
  656.   end;
  657. *)
  658. // ==================== Component definitions ========================
  659.  
  660.   TALZoomImage = class(TALCustomZoomImage)
  661.   published
  662.     property Align;
  663.     property ClipBoardAction;
  664.     property BackColor;
  665.     property BackCross;
  666.     property BulbRadius;
  667.     property Centered;
  668.     property CentralCross;
  669.     property CircleWindow;
  670.     property CursorCross;
  671.     property EnableFocus;
  672.     property EnableSelect;
  673.     property EnableActions;
  674.     property FileName;
  675.     property Fitting;
  676.     property Grid;
  677.     property OverMove;
  678.     property RGBList;
  679.     property RotateAngle;
  680.     property TabStop;
  681.     property Zoom;
  682.     property OnMouseEnter;
  683.     property OnMouseLeave;
  684.     property OnBeforePaint;
  685.     property OnAfterPaint;
  686.     property OnChangeWindow;
  687.     property OnClick;
  688.     property OnDblClick;
  689.     property OnEnter;
  690.     property OnExit;
  691.     property OnMouseDown;
  692.     property OnMouseMove;
  693.     property OnMouseUp;
  694.     property OnMouseWheel;
  695.     property OnMouseWheelDown;
  696.     property OnMouseWheelUp;
  697.   end;
  698.  
  699.   TALImageView = class(TALCustomImageView)
  700.   published
  701.     property Align;
  702.     property ImageSource;
  703.     property ClipBoardAction;
  704.     property BackColor;
  705.     property BackCross;
  706.     property BulbRadius;
  707.     property Centered;
  708.     property CentralCross;
  709.     property CursorCross;
  710.     property EnableSelect;
  711.     property EnableActions;
  712.     property FileName;
  713.     property Fitting;
  714.     property Grid;
  715.     property OverMove;
  716.     property PixelGrid;
  717.     property RGBList;
  718.     property TabStop;
  719.     property Zoom;
  720.     property OnMouseEnter;
  721.     property OnMouseLeave;
  722.     property OnBeforePaint;
  723.     property OnAfterPaint;
  724.     property OnChangeWindow;
  725.     property OnClick;
  726.     property OnDblClick;
  727.     property OnEnter;
  728.     property OnExit;
  729.     property OnMouseDown;
  730.     property OnMouseMove;
  731.     property OnMouseUp;
  732.     property OnMouseWheel;
  733.     property OnMouseWheelDown;
  734.     property OnMouseWheelUp;
  735.   end;
  736.  
  737.   TALRGBDiagram = class(TALCustomRGBDiagram)
  738.   published
  739.     property Align;
  740.     property AlignToImage;
  741.     property BackColor;
  742.     property DotVisible;
  743.     property RGBColor;
  744.     property RColor;
  745.     property GColor;
  746.     property BColor;
  747.     property FixLine;
  748.     property PenWidth;
  749.     property PopupMenu;
  750.     property Visible;
  751.     property ZoomImage;
  752.   end;
  753.  
  754.   procedure Register;
  755.   procedure Send_Message(HW: TWinControl; Msag: Cardinal; wPar: WPARAM; Lpar: LPARAM; Res: LRESULT);
  756.  
  757. implementation
  758. {
  759. function TFileProperty.GetAttributes: TPropertyAttributes;
  760. begin
  761.     Result := [paDialog,paAutoUpdate];
  762. end;
  763.  
  764. procedure TFileProperty.SetValue(const Value: string);
  765. begin
  766.      SetStrValue(Value);
  767. end;
  768.  
  769. function TFileProperty.GetValue: string;
  770. begin
  771.   Result := GetStrValue;
  772. end;
  773.  
  774. procedure TFileProperty.Edit;
  775. var fn: string;
  776.     ftype: string;
  777. begin
  778.     FOpenDialog := TOpenDialog.Create(Application);
  779.     try
  780.         FOpenDialog.InitialDir:=ExtractFilePath(GetValue);
  781.         With FOpenDialog do begin
  782.              FileName  :=GetValue;
  783.              ftype := UpperCase(GetName);
  784.              If ftype='FILENAME' then begin
  785.                 FileName:='*.BMP;*.JPG';
  786.                 Filter :=
  787.                           'Bitmap file (*.BMP)|*.BMP|'+
  788.                           'JPEG file (*.JPG)|*.JPG|';
  789.              end;
  790.              Title:=GetName+' megnyitása';
  791.              If execute then SetStrValue(Filename);
  792.         end;
  793.     finally
  794.         FOpenDialog.Free;
  795.     end;
  796. end;
  797. }
  798. procedure Register;
  799. begin
  800.   RegisterComponents('AL',[TALZoomImage,TALImageSource,TALImageView,TALRGBDiagram]);
  801. //  RegisterPropertyEditor(TypeInfo(string), TALZoomImage, 'FileName', TFileProperty);
  802. end;
  803.  
  804. // =============================================================================
  805.  
  806. { TImageGrid }
  807.  
  808. procedure TImageGrid.Changed;
  809. begin if Assigned(FOnChange) then FOnChange(Self); end;
  810.  
  811. constructor TImageGrid.Create;
  812. begin
  813.   fGridPen       := TPen.Create;
  814.   with fGridPen do begin
  815.        Width := 1;
  816.        Color := clGray;
  817.        Style := psSolid;
  818.        Mode  := pmCopy;
  819.        OnChange := StyleChanged;
  820.   end;
  821.   fSubgridPen    := TPen.Create;
  822.   with fSubGridPen do begin
  823.        Width := 1;
  824.        Color := $005F5F5F;
  825.        Style := psSolid;
  826.        Mode  := pmCopy;
  827.        OnChange := StyleChanged;
  828.   end;
  829.   fGridDistance  := 100;
  830.   fSubGridDistance  := 10;
  831.   fScale            := False;
  832.   fScaleFont        := TFont.Create;
  833.   fScaleFont.Name   := 'Arial';
  834.   fScaleFont.Size   := 8;
  835.   fScaleFont.Color  := clWhite;
  836.   fScaleBrush       := TBrush.Create;
  837.   with fScaleBrush do begin
  838.        Style := bsSolid;
  839.        Color := clGray;
  840.        OnChange := StyleChanged;
  841.   end;
  842.   fOnlyOnPaper   := True;
  843.   Changed;
  844. end;
  845.  
  846. destructor TImageGrid.Destroy;
  847. begin
  848.   fSubgridPen.Free;
  849.   fGridPen.Free;
  850.   fScaleFont.Free;
  851.   fScaleBrush.Free;
  852.   inherited;
  853. end;
  854.  
  855. procedure TImageGrid.SetGridDistance(const Value: double);
  856. begin
  857.   FGridDistance := Value;
  858.   Changed;
  859. end;
  860.  
  861. procedure TImageGrid.SetGridPen(const Value: TPen);
  862. begin
  863.   FGridPen := Value;
  864.   Changed;
  865. end;
  866.  
  867. procedure TImageGrid.SetOnlyOnPaper(const Value: boolean);
  868. begin
  869.   FOnlyOnPaper := Value;
  870.   Changed;
  871. end;
  872.  
  873. procedure TImageGrid.SetPixelGrid(const Value: boolean);
  874. begin
  875.   FPixelGrid := Value;
  876.   Changed;
  877. end;
  878.  
  879. procedure TImageGrid.SetScale(const Value: boolean);
  880. begin
  881.   FScale := Value;
  882.   Changed;
  883. end;
  884.  
  885. procedure TImageGrid.StyleChanged(Sender: TObject);
  886. begin
  887.   Changed;
  888. end;
  889.  
  890. procedure TImageGrid.SetScaleBrush(const Value: TBrush);
  891. begin
  892.   FScaleBrush := Value;
  893.   Changed;
  894. end;
  895.  
  896. procedure TImageGrid.SetScaleFont(const Value: TFont);
  897. begin
  898.   FScaleFont := Value;
  899.   Changed;
  900. end;
  901.  
  902. procedure TImageGrid.SetSubGridDistance(const Value: double);
  903. begin
  904.   FSubGridDistance := Value;
  905.   Changed;
  906. end;
  907.  
  908. procedure TImageGrid.SetSubGridPen(const Value: TPen);
  909. begin
  910.   FSubGridPen := Value;
  911.   Changed;
  912. end;
  913.  
  914. procedure TImageGrid.SetVisible(const Value: boolean);
  915. begin
  916.   FVisible := Value;
  917.   Changed;
  918. end;
  919.  
  920. procedure TImageGrid.SetFix(const Value: boolean);
  921. begin
  922.   FFix := Value;
  923.   Changed;
  924. end;
  925.  
  926. { TRGBChanel }
  927.  
  928. procedure TRGBChanel.Changed;
  929. begin
  930.   If Assigned(FOnChange) then FOnChange(Self);
  931. end;
  932.  
  933. procedure TRGBChanel.ChangeRGB(mono, rr, gg, bb: boolean);
  934. begin
  935.   FR := rr;
  936.   FG := gg;
  937.   FB := bb;
  938.   FMonoRGB := mono;
  939.   Changed;
  940. end;
  941.  
  942. constructor TRGBChanel.Create;
  943. begin
  944.   FR := True;
  945.   FG := True;
  946.   FB := True;
  947.   FRGB := True;
  948.   FMonoRGB := False;
  949. end;
  950.  
  951. destructor TRGBChanel.Destroy;
  952. begin
  953.   inherited;
  954. end;
  955.  
  956. procedure TRGBChanel.SetB(const Value: boolean);
  957. begin
  958.   ChangeRGB(FMonoRGB,FR,FG,Value);
  959. end;
  960.  
  961. procedure TRGBChanel.SetG(const Value: boolean);
  962. begin
  963.   ChangeRGB(FMonoRGB,FR,Value,FB);
  964. end;
  965.  
  966. procedure TRGBChanel.SetMonoRGB(const Value: boolean);
  967. begin
  968.   ChangeRGB(Value,FR,FG,FB);
  969. end;
  970.  
  971. procedure TRGBChanel.SetR(const Value: boolean);
  972. begin
  973.   ChangeRGB(FMonoRGB,Value,FG,FB);
  974. end;
  975.  
  976. procedure TRGBChanel.SetRGB(const Value: boolean);
  977. begin
  978.   FRGB := Value;
  979.   ChangeRGB(not Value,True,True,True);
  980. end;
  981. (*
  982. procedure TRGBChanel.SetRGBChanel(const _Mono, _R, _G, _B: boolean);
  983. begin
  984.   FRGB := _Mono;
  985.   FR   := _R;
  986.   FG   := _G;
  987.   FB   := _B;
  988.   Changed;
  989. end;
  990. *)
  991.  
  992. { TALCustomZoomImage }
  993.  
  994. constructor TALCustomZoomImage.Create(AOwner: TComponent);
  995. begin
  996.   inherited;
  997.   Screen.Cursors[crKez1]     :=  LoadCursor(HInstance, 'SKEZ_1');
  998.   Screen.Cursors[crKez2]     :=  LoadCursor(HInstance, 'SKEZ_2');
  999.   Screen.Cursors[crRealZoom] :=  LoadCursor(HInstance, 'SREAL_ZOOM');
  1000.   Screen.Cursors[crNyilUp]   :=  LoadCursor(HInstance, 'SNYIL_UP');
  1001.   Screen.Cursors[crNyilDown] :=  LoadCursor(HInstance, 'SNYIL_DOWN');
  1002.   Screen.Cursors[crNyilLeft] :=  LoadCursor(HInstance, 'SNYIL_LEFT');
  1003.   Screen.Cursors[crNyilRight]:=  LoadCursor(HInstance, 'SNYIL_RIGHT');
  1004.   Screen.Cursors[crZoomIn]   :=  LoadCursor(HInstance, 'SZOOM_IN');
  1005.   Screen.Cursors[crZoomOut]  :=  LoadCursor(HInstance, 'SZOOM_OUT');
  1006.   Screen.Cursors[crKereszt]  :=  LoadCursor(HInstance, 'SKERESZT');
  1007.   Screen.Cursors[crHelp]     :=  LoadCursor(HInstance, 'SHELP_CUR');
  1008.  
  1009.   OrigBMP        := TBitmap.Create;
  1010.   WorkBMP        := TBitmap.Create;
  1011.   CopyBMP        := TBitmap.Create;
  1012.   BackBMP        := TBitmap.Create;
  1013.   PasteBMP       := TBitmap.Create;
  1014.   OrigBMP.OnChange  := oChange;
  1015.   PasteBMP.OnChange := pChange;
  1016.   WorkBMP.PixelFormat := pf24bit;
  1017.   CopyBMP.PixelFormat := pf24bit;
  1018.   StretchBitmap  := TStretchBitmap.Create;
  1019.   StretchBitmap.SourceBitmap := WorkBMP;
  1020.   StretchBitmap.TargetBitmap := CopyBMP;
  1021.   cPen           := TPen.Create;
  1022.   Grid           := TImageGrid.Create;
  1023.   fGrid.OnChange := Change;
  1024.   fGrid.fVisible := False;
  1025.   fGrid.FOnlyOnPaper := True;
  1026.   FPixelGrid     := False;
  1027.   Hinted         := True;
  1028.   Hint1          := THintWindow.Create(Self);
  1029.   with cPen do begin
  1030.        Color := clRed;
  1031.        Style := psSolid;
  1032.        Mode  := pmCopy;
  1033.   end;
  1034.   RGBList        := TRGBChanel.Create;
  1035.   RGBList.RGB    := True;
  1036.   RGBList.OnChange := Change;
  1037.   CentralCross   := True;
  1038.   BackColor      := clSilver;
  1039.   BMPOffset      := Point(0,0);
  1040.   fZoom          := 1.0;
  1041.   fOverMove      := False;
  1042.   fCursorCross   := False;
  1043.   oldCursorCross := False;
  1044.   MouseInOut     := 1;
  1045.   oldMovePt      := Point(-1,-1);
  1046.   Sizes          := Point(0,0);
  1047.   sRect          := Rect2d(0,0,0,0);
  1048.   ControlStyle   := ControlStyle+[csFramed,csReflector,csCaptureMouse];
  1049.   TabStop        := True;
  1050.   DoubleBuffered := True;
  1051.   timer          := TTimer.Create(Self);
  1052.   timer.Interval := 10;
  1053.   timer.Ontimer  := OnTimer;
  1054.   FClipBoardAction := cbaTotal;
  1055.   FixRect        := Rect(0,0,100,100);
  1056.   FixWinRect     := Rect(0,0,100,100);
  1057.   Width          := 100;
  1058.   Height         := 100;
  1059.   FEnableSelect  := True;
  1060.   AutoPopup      := True;
  1061.   FEnableFocus   := True;
  1062.   FEnableActions := True;
  1063.   FVisibleImage  := True;
  1064.   FVisibleOverlay:= True;
  1065.   SelRect        := Rect(0,0,0,0);
  1066.   FixSizes       := Point(200,100);
  1067.   InitSelWindow;
  1068.   elso := True;
  1069. end;
  1070.  
  1071. destructor TALCustomZoomImage.Destroy;
  1072. begin
  1073.   OrigBMP.Free;
  1074.   WorkBMP.Free;
  1075.   BackBMP.Free;
  1076.   CopyBMP.Free;
  1077.   PasteBMP.Free;
  1078.   StretchBitmap.Free;
  1079.   cPen.Free;
  1080.   Grid.Free;
  1081.   Hint1.Free;
  1082.   RGBList.Free;
  1083.   timer.free;
  1084.   inherited;
  1085. end;
  1086.  
  1087. procedure TALCustomZoomImage.oChange(Sender: TObject);
  1088. begin
  1089. //    if Assigned(FChange) then FChange(Self);
  1090. end;
  1091.  
  1092. procedure TALCustomZoomImage.pChange(Sender: TObject);
  1093. begin
  1094.   EnablePopup(PasteBMP.Empty);
  1095.   Invalidate;
  1096. end;
  1097.  
  1098. procedure TALCustomZoomImage.EnablePopup(en: boolean);
  1099. begin
  1100.   if PopupMenu<>nil then PopupMenu.AutoPopup := en;
  1101. end;
  1102.  
  1103.  
  1104. procedure TALCustomZoomImage.CMChildkey(var msg: TCMChildKey);
  1105. var dx,dy: integer;
  1106.     k:integer;
  1107. begin
  1108.   k:=16;
  1109.   dx := 0; dy:=0;
  1110.   msg.result := 1; // declares key as handled
  1111.   Case msg.charcode of
  1112.     VK_LEFT    : dx:=-k;
  1113.     VK_RIGHT   : dx:=k;
  1114.     VK_UP      : dy:=-k;
  1115.     VK_DOWN    : dy:=k;
  1116.   Else
  1117.     msg.result:= 0;
  1118.     inherited;
  1119.   End;
  1120.   if (dx<>0) or (dy<>0) then
  1121.      ShiftWindow(dx,dy);
  1122.   inherited;
  1123. end;
  1124.  
  1125. procedure TALCustomZoomImage.CMMouseEnter(var msg: TMessage);
  1126. begin
  1127.     inherited;
  1128.     MouseInOut:=1;
  1129.     oldCursorCross:=CursorCross;
  1130.     oldMovePt := Point(-1,-1);
  1131.     if EnableFocus then SetFocus;
  1132.     invalidate;
  1133.     if Assigned(FMouseEnter) then FMouseEnter(Self);
  1134. end;
  1135.  
  1136. procedure TALCustomZoomImage.CMMouseLeave(var msg: TMessage);
  1137. begin
  1138.     inherited;
  1139.     MouseInOut:=-1;
  1140.     CursorCross:=oldCursorCross;
  1141.     oldCursorCross := False;
  1142.     CloseHintPanel;
  1143.     Screen.Cursor := crDefault;
  1144.     invalidate;
  1145.     if Assigned(FMouseLeave) then FMouseLeave(Self);
  1146. end;
  1147.  
  1148. procedure TALCustomZoomImage.WMEraseBkGnd(var Message: TWMEraseBkGnd);
  1149. begin
  1150.   Message.Result := 1
  1151. end;
  1152.  
  1153. procedure TALCustomZoomImage.WMSize(var Msg: TWMSize);
  1154. var sc : TPoint2d;
  1155. begin
  1156. (*
  1157.   sc := newCent;
  1158.   if Fitting then FitToScreen
  1159.   else
  1160.       MoveToCentrum(sc.x,sc.y);
  1161. *)
  1162.   invalidate;
  1163. end;
  1164.  
  1165. procedure TALCustomZoomImage.SetBackColor(const Value: TColor);
  1166. begin
  1167.   FBackColor := Value;
  1168.   StretchBitmap.BackgroundColor := Value;
  1169.   invalidate;
  1170. end;
  1171.  
  1172. procedure TALCustomZoomImage.SetBackCross(const Value: boolean);
  1173. begin
  1174.   FBackCross := Value;
  1175.   invalidate;
  1176. end;
  1177.  
  1178. procedure TALCustomZoomImage.SetBulbRadius(const Value: integer);
  1179. begin
  1180.   FBulbRadius := Value;
  1181.   invalidate;
  1182. end;
  1183.  
  1184. procedure TALCustomZoomImage.SetCentered(const Value: boolean);
  1185. begin
  1186.   FCentered := Value;
  1187.   if Value then sCent := Point2d(Sizes.x/2,Sizes.y/2);
  1188.   Invalidate;
  1189. end;
  1190.  
  1191. procedure TALCustomZoomImage.SetCentralCross(const Value: boolean);
  1192. begin
  1193.   fCentralCross := Value;
  1194.   invalidate;
  1195. end;
  1196.  
  1197. procedure TALCustomZoomImage.SetCircleWindow(const Value: boolean);
  1198. begin
  1199.   fCircleWindow := Value;
  1200.   Redraw;
  1201. end;
  1202.  
  1203. procedure TALCustomZoomImage.SetClipBoardAction(const Value: TClipBoardAction);
  1204. begin
  1205.   FClipBoardAction := Value;
  1206.   if Ord(Value)>3 then begin
  1207.      SelRectVisible := Ord(Value)>3;
  1208.   end;
  1209. end;
  1210.  
  1211. procedure TALCustomZoomImage.SetCursorCross(const Value: boolean);
  1212. begin
  1213.   fCursorCross := Value;
  1214.   oldCursorCross := Value;
  1215.   invalidate;
  1216. end;
  1217.  
  1218. procedure TALCustomZoomImage.SetFileName(const Value: string);
  1219. begin
  1220.      if LoadFromFile(Value) then
  1221.         FFileName := Value
  1222.      else
  1223.         FFileName := '';
  1224. end;
  1225.  
  1226. procedure TALCustomZoomImage.SetOverMove(const Value: boolean);
  1227. begin
  1228.   FOverMove := Value;
  1229.   invalidate;
  1230. end;
  1231.  
  1232. procedure TALCustomZoomImage.SetPixelGrid(const Value: boolean);
  1233. begin
  1234.   FPixelGrid := Value;
  1235.   Grid.Visible := Value;
  1236.   invalidate;
  1237. end;
  1238.  
  1239. procedure TALCustomZoomImage.SetRGBList(const Value: TRGBChanel);
  1240. var cBMP : TBitmap;
  1241. begin
  1242. Try
  1243.   FRGBList := Value;
  1244.   cBMP := TBitmap.Create;
  1245.   WorkBMP.OnChange := nil;
  1246.   cBMP.Assign(WorkBMP);
  1247.     ChangeRGBChanel(WorkBMP,FRGBList.MonoRGB,FRGBList.FR,FRGBList.FG,FRGBList.FB);
  1248.   ReDraw;
  1249. finally
  1250.   WorkBMP.Assign(cBMP);
  1251.   WorkBMP.OnChange := wChange;
  1252.   cBMP.Free;
  1253. end;
  1254. end;
  1255.  
  1256. procedure TALCustomZoomImage.SetZoom(const Value: extended);
  1257. var cx,cy,w,h : double;
  1258. begin
  1259.   if fZoom <> Value then begin
  1260.      // Limited zoom
  1261.      Sizes := Point(WorkBMP.Width,WorkBMP.Height);
  1262.      if Value>100 then fZoom:=100
  1263.      else
  1264.      if (Value*Sizes.x>8) and (Value*Sizes.y>8) then
  1265.          fZoom := Value;
  1266.      if WorkBMP.Width<1 then
  1267.          fZoom := Value;
  1268.  
  1269.      if Ord(FClipboardAction)=4 then begin
  1270.         w  := FixSizes.x/2;
  1271.         h  := FixSizes.y/2;
  1272.         cx := SelRect.Left+(SelRect.Right-SelRect.Left)/2;
  1273.         cy := SelRect.Top+(SelRect.Bottom-SelRect.Top)/2;
  1274.         SelRect := Rect(Trunc(cx-FZoom*w),Trunc(cy-FZoom*h),
  1275.                         Trunc(cx+FZoom*w),Trunc(cy+FZoom*h));
  1276.      end;
  1277.  
  1278.      if Assigned(FChangeWindow) then
  1279.         FChangeWindow(Self,sCent.x,sCent.y,XToW(oldPos.x),YToW(oldPos.y),
  1280.                       Zoom,oldPos.x,oldPos.y);
  1281.      invalidate;
  1282.   end;
  1283. end;
  1284.  
  1285. procedure TALCustomZoomImage.Change(Sender: TObject);
  1286. begin
  1287.   IF Sender = RGBList then
  1288.      RGBList := RGBList
  1289.   else
  1290.   invalidate;
  1291. end;
  1292.  
  1293. procedure TALCustomZoomImage.OnTimer(Sender: TObject);
  1294. var step: double;
  1295. begin
  1296.   step := 4;
  1297.   if FEnableActions and mouseLeft then
  1298.   begin
  1299.        if not SelrectVisible then
  1300.        if (MouseInOut>-1) then
  1301.        begin
  1302.             if Cursor=crNyilUp then ShiftWindow(0,-step);
  1303.             if Cursor=crNyilDown then ShiftWindow(0,step);
  1304.             if Cursor=crNyilLeft then ShiftWindow(-step,0);
  1305.             if Cursor=crNyilRight then ShiftWindow(step,0);
  1306.             if (Cursor > 18002) and (Cursor<18007) then
  1307.                Moving := True;
  1308.        end;
  1309.  
  1310.        if SelrectVisible then
  1311.        begin
  1312.           step:=1;
  1313.           if MovePt.Y<20 then ShiftWindow(0,-step);
  1314.           if MovePt.Y>(Height-20) then ShiftWindow(0,step);
  1315.           if MovePt.x<20 then ShiftWindow(-step,0);
  1316.           if MovePt.X>(Width-20) then ShiftWindow(step,0);
  1317.           Moving := True;
  1318.        end;
  1319.   end;
  1320. end;
  1321.  
  1322. procedure TALCustomZoomImage.Click;
  1323. begin
  1324.   if TabStop then SetFocus;
  1325.   inherited;
  1326. end;
  1327.  
  1328. procedure TALCustomZoomImage.DblClick;
  1329. begin
  1330.   if (not Loading) and FEnableActions then begin
  1331.      MoveWindow(((Width/2)-oldPos.x)/Zoom,((Height/2)-oldPos.y)/Zoom);
  1332.      SelRectVisible:=False;
  1333.      Moving:=True;
  1334.      pFazis := -1;
  1335.      inherited;
  1336.   end;
  1337. end;
  1338.  
  1339. function TALCustomZoomImage.DoMouseWheel(Shift: TShiftState;
  1340.   WheelDelta: Integer; MousePos: TPoint): Boolean;
  1341. begin
  1342.   Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
  1343. //  if EnableActions then begin
  1344.   if WheelDelta<0 then Zoom:=0.9*Zoom
  1345.   else Zoom:=1.1*Zoom;
  1346. //  end;
  1347.   if Assigned(FChangeWindow) then
  1348.      FChangeWindow(Self,sCent.x,sCent.y,XToW(MousePos.x),YToW(MousePos.y),Zoom,MousePos.x,MousePos.y);
  1349.   Result := True;
  1350. end;
  1351.  
  1352. function TALCustomZoomImage.DoMouseWheelDown(Shift: TShiftState;
  1353.   MousePos: TPoint): Boolean;
  1354. begin
  1355.   Result := True;
  1356.   inherited DoMouseWheelDown(Shift, MousePos);
  1357. end;
  1358.  
  1359. function TALCustomZoomImage.DoMouseWheelUp(Shift: TShiftState;
  1360.   MousePos: TPoint): Boolean;
  1361. begin
  1362.   Result := inherited DoMouseWheelUp(Shift, MousePos);
  1363. end;
  1364.  
  1365. procedure TALCustomZoomImage.DrawMouseCross(o: TPoint; PenMode: TPenMode);
  1366. var DC:HDC;
  1367.     oldPen: TPen;
  1368.     R: integer;
  1369. begin
  1370. Try
  1371.     oldPen:=Canvas.Pen;
  1372.     Canvas.pen.Color := clRed;
  1373.     Canvas.pen.Mode := PenMode;
  1374.     With Canvas do begin
  1375.       MoveTo(0,o.y); LineTo(Width,o.y);
  1376.       MoveTo(o.x,0); LineTo(o.x,Height);
  1377.       If BulbRadius<>0 then begin
  1378.          R := Round(BulbRadius*Zoom);
  1379.          Ellipse(o.x-R,o.y-R,o.x+R,o.y+R);
  1380.       end;
  1381.     end;
  1382. Finally
  1383.     Canvas.Pen:=oldPen;
  1384. end;
  1385. end;
  1386.  
  1387. procedure TALCustomZoomImage.InitSelWindow;
  1388. begin
  1389.   SelRectVisible := False;
  1390.   pFazis         := -1;
  1391. end;
  1392.  
  1393. procedure TALCustomZoomImage.KeyDown(var Key: Word; Shift: TShiftState);
  1394. begin
  1395.   if EnableActions and (not (moving or Loading)) then begin
  1396.   if Shift=[] then
  1397.   Case Key of
  1398.   VK_RETURN   : FitToScreen;
  1399.   VK_ESCAPE   : begin
  1400.                      IF SelRectVisible then SelRectVisible:=False;
  1401.                      RestoreOriginal;
  1402.                 end;
  1403.   VK_ADD,190   : Zoom := 1.1*Zoom;
  1404.   VK_SUBTRACT,189 : Zoom := 0.9*Zoom;
  1405.   VK_SPACE    : RotateAngle := 0;
  1406.   end;
  1407.   if Shift=[ssCtrl] then
  1408.   Case Key of
  1409.   VK_DELETE   : New(0,0,BackColor);     // Ctrl+Del: Deletes image
  1410.   end;
  1411.   END;
  1412.   inherited;
  1413. end;
  1414.  
  1415. procedure TALCustomZoomImage.KeyPress(var Key: Char);
  1416. begin
  1417.   if EnableActions and (not (moving or Loading)) then
  1418.   Case Key of
  1419.   ^X          : CutToClipboard;
  1420.   ^C          : COPYToClipboard;
  1421.   ^V          : PasteFromClipboard;
  1422.   ^K          : CropSelected;
  1423.   'G','g'     : Grid.Visible := not Grid.Visible;
  1424.   'C','c'     : CursorCross  := not CursorCross;
  1425.   'K','k'     : CentralCross := not CentralCross;
  1426.   'Q','q'     : CircleWindow := not CircleWindow;
  1427.   'F','f'     : FitToScreen;
  1428.   'O','o'     : RestoreOriginal;
  1429.   '1'         : Zoom := 1;
  1430.   'R','r'     : RotateAngle := RotateAngle+1;
  1431.   'L','l'     : RotateAngle := RotateAngle-1;
  1432.   ^R          : SetVR;
  1433.   ^G          : SetVG;
  1434.   ^B          : SetVB;
  1435.   'A','a'     : begin
  1436.                 FRgbList.RGB := True;
  1437.                 SetRGBList(FRgbList);
  1438.                 end;
  1439.   'M','m'     : begin
  1440.                 FRgbList.MonoRGB := True;
  1441.                 SetRGBList(FRgbList);
  1442.                 end;
  1443.   'I','i'     : Negative;
  1444.   end;
  1445.   INVALIDATE;
  1446. end;
  1447.  
  1448. function TALCustomZoomImage.LoadFromFile(FileName: TFileName): boolean;
  1449. var ext: string;
  1450.     jpgIMG: TJpegImage;
  1451. begin
  1452. Try
  1453.   Result := False;
  1454.   Loading := True;
  1455.   if FileExists(FileName) then
  1456.   Try
  1457.     if Assigned(FChange) then FChange(Self);
  1458.      ext := UpperCase(ExtractFileExt(FileName));
  1459.      If ext='.BMP' then OrigBMP.LoadFromFile(FileName);
  1460.      If ext='.JPG' then
  1461.      begin
  1462.         jpgIMG := TJpegImage.Create;
  1463.         jpgIMG.LoadFromFile(FileName);
  1464.         OrigBMP.Assign(jpgIMG);
  1465.         if jpgIMG<>nil then jpgIMG.Free;
  1466.      end;
  1467.   except
  1468.     if jpgIMG<>nil then jpgIMG.Free;
  1469.     exit;
  1470.   end;
  1471. finally
  1472.   WorkBMP.OnChange := nil;
  1473.   OrigBMP.PixelFormat := pf24bit;
  1474.   WorkBMP.PixelFormat := pf24bit;
  1475.   RestoreOriginal;
  1476.   // New image move to the centre of window and with original sizes
  1477.   Sizes := Point(OrigBMP.Width,OrigBMP.Height);
  1478.   FFilename := FileName;
  1479.   Result := True;
  1480.  
  1481.   if elso then begin
  1482.      FitToScreen;
  1483.      elso:=False;
  1484.   end else
  1485.   if Fitting then FitToScreen;
  1486.   if Centered then Centered:=True;
  1487.  
  1488.   WorkBMP.OnChange := wChange;
  1489.   Loading := False;
  1490. end;
  1491. end;
  1492.  
  1493. function TALCustomZoomImage.LoadFromStream(stm: TStream; ImageType: TImageTypes): boolean;
  1494. Var jpgIMG: TJpegImage;
  1495. begin
  1496. Try
  1497.   Result := False;
  1498.   Loading := True;
  1499.   Case ImageType of
  1500.   itBMP: WorkBMP.LoadFromStream(STM);
  1501.   itJPG:
  1502.          Try
  1503.            jpgIMG := TJpegImage.Create;
  1504.            jpgIMG.LoadFromStream(stm);
  1505.            WorkBMP.Assign(jpgIMG);
  1506.          finally
  1507.            jpgIMG.Free;
  1508.          end;
  1509.   end;
  1510. finally
  1511. //  RestoreOriginal;
  1512.   Sizes := Point(WorkBMP.Width,WorkBMP.Height);
  1513.   Result := True;
  1514.   if Fitting then FitToScreen;
  1515.   if Centered then Centered:=True;
  1516.   invalidate;
  1517.   Loading := False;
  1518. end;
  1519. end;
  1520.  
  1521. function TALCustomZoomImage.SaveToStream(stm: TStream; ImageType: TImageTypes): boolean;
  1522. Var jpgIMG: TJpegImage;
  1523. begin
  1524. Try
  1525.   Result := False;
  1526.   Loading := True;
  1527.   Case ImageType of
  1528.   itBMP: WorkBMP.SaveToStream(STM);
  1529.   itJPG:
  1530.          Try
  1531.            jpgIMG := TJpegImage.Create;
  1532.            jpgIMG.Assign(WorkBMP);
  1533.            jpgIMG.SaveToStream(stm);
  1534.          finally
  1535.            jpgIMG.Free;
  1536.          end;
  1537.   end;
  1538. finally
  1539.   Loading := False;
  1540.   Result := True;
  1541. end;                  
  1542. end;
  1543.  
  1544. procedure Send_Message(HW: TWinControl; Msag: Cardinal; wPar: WPARAM; Lpar: LPARAM; Res: LRESULT);
  1545. Var msg: TMessage;
  1546. begin
  1547.   msg.Msg    := msag;
  1548.   msg.WParam := wPar;
  1549.   msg.LParam := lPar;
  1550.   msg.Result := Res;
  1551.   HW.Broadcast(msg);
  1552. end;
  1553.  
  1554. procedure TALCustomZoomImage.MonoChrome;
  1555. begin
  1556.   STAF_Imp.GrayScale(WorkBMP);
  1557.   Redraw;
  1558. end;
  1559.  
  1560. procedure TALCustomZoomImage.MouseDown(Button: TMouseButton;
  1561.   Shift: TShiftState; X, Y: Integer);
  1562. var cx,cy,rx,ry: integer;
  1563. begin
  1564.   if EnableFocus then SetFocus;
  1565.   ActualPixel := Point(Trunc(XToW(x)),Trunc(YToW(y)));
  1566.   oldPos := Point(x,y);
  1567.  
  1568.   inherited;
  1569.  
  1570.   if EnableActions and (not (moving or Loading)) then begin
  1571.  
  1572.   CASE Button of
  1573.   mbLeft:
  1574.   begin
  1575.  
  1576.   // Manipulating the Selected Area
  1577.   if FEnableSelect then
  1578.   BEGIN
  1579.  
  1580.      if (y>SelRect.Top) and (y<SelRect.Bottom) then
  1581.      begin
  1582.      if (Abs(x-SelRect.Left)<5) then
  1583.         SelDirect := 1;
  1584.      if (Abs(x-SelRect.Right)<5) then
  1585.         SelDirect := 3;
  1586.      end;
  1587.      if (x<SelRect.Right) and (x>SelRect.Left) then
  1588.      begin
  1589.      if (Abs(y-SelRect.Top)<5) then
  1590.         SelDirect := 2;
  1591.      if (Abs(y-SelRect.Bottom)<5) then
  1592.         SelDirect := 4;
  1593.      end;
  1594.  
  1595.   if (Cursor<>crSizeWE) and (Cursor<>crSizeNS) then
  1596.   if SelRectVisible and (pFazis > 1) and (Cursor <> crZoomIn)
  1597.   then begin
  1598.       SelRect := CorrectRect(Rect(Origin.x,Origin.y,x,y));
  1599.       cx := (SelRect.Right + SelRect.Left) div 2;
  1600.       cy := (SelRect.Bottom + SelRect.Top) div 2;
  1601.       rx := (SelRect.Right - SelRect.Left) div 2;
  1602.       ry := (SelRect.Bottom - SelRect.Top) div 2;
  1603.       pFazis  := 0;
  1604.       if (rx<0) and (ry<0) then begin
  1605.          pFazis  := 0;
  1606.          SelRectVisible := False;
  1607.       end else begin
  1608.          FixWinRect := SelRect;
  1609.          FixRect := Rect(Round(XToW(SelRect.Left)),Round(YToW(SelRect.Top)),
  1610.                          Round(XToW(SelRect.Right)),Round(YToW(SelRect.Bottom)));
  1611.          InitSelWindow;
  1612.       end;
  1613.   end
  1614.   else
  1615.   begin
  1616.  
  1617.   if (Shift = [ssAlt,ssLeft]) or (Shift = [ssCtrl,ssLeft]) then
  1618.      begin
  1619.         // Bigin draw selrect
  1620.         SelRect := Rect(x,y,x,y);
  1621.         SelRectVisible := True;
  1622.         SelDirect := 0;
  1623.         pFazis  := 1;
  1624.      end
  1625.      else
  1626.      if SelRectVisible then begin
  1627.         if Cursor = crZoomIn then
  1628.            SelToScreen
  1629.         else begin
  1630.            InitSelWindow;
  1631.         end;
  1632.      end;
  1633.  
  1634.      invalidate;
  1635.   end;
  1636.   END;
  1637.  
  1638.   Origin := Point(x,y);
  1639.   MovePt := Point(x,y);
  1640.   oldMovePt := Point(x,y);
  1641.  
  1642.   // Cursors
  1643.   if x<20 then Cursor := crNyilLeft;
  1644.   if x>Width-20 then Cursor := crNyilRight;
  1645.   if y<20 then Cursor := crNyilUp;
  1646.   if y>Height-20 then Cursor := crNyilDown;
  1647.   if PtInRect(Rect(20,20,width-20,height-20),Point(x,y)) then Cursor := crDefault;
  1648.  
  1649.   if not PasteBMP.Empty then begin
  1650.      WorkBMP.Canvas.Draw(ActualPixel.x,ActualPixel.y,PasteBMP);
  1651.      CopyBMP.Assign(WorkBMP);
  1652.      PasteBMP.ReleaseHandle;
  1653.      SelRectVisible := False;
  1654.      invalidate;
  1655.   end;
  1656.   end;
  1657.  
  1658.   END; // Case
  1659.  
  1660.       mouseLeft := Button=mbLeft;
  1661.       Moving := False;
  1662.   end;
  1663. end;
  1664.  
  1665. procedure TALCustomZoomImage.MouseMove(Shift: TShiftState; X, Y: Integer);
  1666. var msg: TMessage;
  1667.   Hintstr: string;
  1668.   HintRect: TRect;
  1669.   p: TPoint;
  1670.   w,he: integer;
  1671. begin
  1672. if EnableActions then begin
  1673.   MovePt := Point(x,y);
  1674.   ActualPixel := Point(Trunc(XToW(x)),Trunc(YToW(y)));
  1675.  
  1676.   if PasteBMP<>nil then begin
  1677.      invalidate;
  1678.   end;
  1679.  
  1680.   if EnableActions and ((not moving) or (not Loading)) then begin
  1681.   if Shift = [] then begin
  1682.      if x<10 then Cursor := crNyilLeft;
  1683.      if x>Width-10 then Cursor := crNyilRight;
  1684.      if y<10 then Cursor := crNyilUp;
  1685.      if y>Height-10 then Cursor := crNyilDown;
  1686.   end;
  1687.   if PtInRect(Rect(20,20,width-20,height-20),Point(x,y)) then Cursor := crDefault;
  1688.  
  1689.   if (Shift = [ssAlt,ssLeft]) or (Shift = [ssCtrl,ssLeft]) then begin
  1690.      if FEnableSelect and SelRectVisible and (pFazis > 0) then begin
  1691.         SelRect := CorrectRect(Rect(Origin.x,Origin.y,x,y));
  1692.         pFazis := 2;
  1693.         Repaint;
  1694.      end;
  1695.      if not PasteBMP.Empty then Repaint;
  1696.   end;
  1697.  
  1698.   // Cursor for border of selected rect
  1699.   if SelRectVisible then
  1700.   begin
  1701.  
  1702.   if Shift = [] then
  1703.   if Ord(FClipboardAction)<4 then begin
  1704.      if ((Abs(x-SelRect.Left)<5) or (Abs(x-SelRect.Right)<5))
  1705.         and (y>SelRect.Top) and (y<SelRect.Bottom)
  1706.         then
  1707.             Cursor:=crSizeWE;
  1708.      if ((Abs(y-SelRect.Top)<5) or (Abs(y-SelRect.Bottom)<5))
  1709.         and (x<SelRect.Right) and (x>SelRect.Left)
  1710.         then
  1711.             Cursor:=crSizeNS;
  1712.   end else begin
  1713.       if Ord(FClipboardAction)=4 then
  1714.       SelRect := Rect(x-Trunc((FixSizes.X div 2)*FZoom),y-Trunc((FixSizes.Y div 2)*FZoom),
  1715.                       x+Trunc((FixSizes.X div 2)*FZoom),y+Trunc((FixSizes.Y div 2)*FZoom));
  1716.       if Ord(FClipboardAction)=5 then
  1717.       SelRect := Rect(x-(FixSizes.X div 2),y-(FixSizes.Y div 2),
  1718.                       x+(FixSizes.X div 2),y+(FixSizes.Y div 2));
  1719.   end;
  1720.  
  1721.   if SelRectVisible then
  1722.   if PtInRect(SelRect,MovePt) then
  1723.      if Ord(FClipboardAction)<4 then
  1724.         Cursor := crZoomIn
  1725.      else
  1726.         Cursor := crCross;
  1727.  
  1728.   if Shift = [ssLeft] then
  1729.   begin
  1730.      Case SelDirect of
  1731.      1: SelRect.Left := x;
  1732.      2: SelRect.Top := y;
  1733.      3: SelRect.Right := x;
  1734.      4: SelRect.Bottom := y;
  1735.      end;
  1736.      Repaint;
  1737.   end;
  1738.   end else
  1739.     If (oldMovePt.x<>MovePt.x) or (oldMovePt.y<>MovePt.y) then begin
  1740.      If (Shift=[ssLeft]) then begin
  1741.         MoveWindow((x-oldPos.x)/Zoom,(y-oldPos.y)/Zoom);
  1742.         oldPos := Point(x,y);
  1743.         Moving := True;
  1744.      end;
  1745.      If (Shift=[ssRight]) then begin
  1746.         if (oldMovePt.y-MovePt.y)>0 then Zoom := Zoom*1.1
  1747.              else Zoom := Zoom*0.9;
  1748.      end;
  1749.   end;
  1750.  
  1751.   MouseInOut:=0;
  1752.   end;
  1753. end;
  1754.  
  1755.   if Assigned(FChangeWindow) then
  1756.      FChangeWindow(Self,sCent.x,sCent.y,XToW(x),YToW(y),Zoom,x,y);
  1757.   oldMovePt := Point(x,y);
  1758.  
  1759.   msg.Msg := WM_IMAGEMOUSEMOVE;
  1760.   msg.WParam := x;
  1761.   msg.LParam := y;
  1762.   msg.Result := 0;
  1763.   Broadcast(msg);
  1764.  
  1765.   inherited;
  1766. end;
  1767.  
  1768. procedure TALCustomZoomImage.MouseUp(Button: TMouseButton;
  1769.   Shift: TShiftState; X, Y: Integer);
  1770. begin
  1771.   if EnableActions and (not (moving or Loading)) then begin
  1772.   ActualPixel := Point(Trunc(XToW(x)),Trunc(YToW(y)));
  1773.   if Button=mbRight then begin
  1774. //     if PopupMenu=nil then DblClick;
  1775.      if not PasteBMP.Empty then begin
  1776.         PasteBMP.ReleaseHandle;
  1777.         EnablePopup(PasteBMP.Empty);
  1778.         invalidate;
  1779.      end;
  1780.      SelRectVisible:=False;
  1781.      pFazis := -1;
  1782.   end;
  1783.   end;
  1784.  
  1785. (*
  1786.   {Hint ablak rajzolása}
  1787.   If Hinted then begin
  1788.   If (CPMatch or CurveIn) and (Shift = []) then begin
  1789.      Hint1.Font.Size:=4;
  1790.      FCurve := FCurveList.Items[CPCurve];
  1791.      If CPMatch then
  1792.         Hintstr := fCurve.Name+' ['+IntToStr(CPCurve)+'-'+IntToStr(CPIndex)+'/'+IntToStr(FCurve.Count)+']   ';
  1793. //     else
  1794. //     If CurveIn then
  1795. //        Hintstr := ' ['+IntToStr(CPCurve)+'] ';
  1796.      p := ClientToScreen(point(x+8,y-18));
  1797.      w := Hint1.Canvas.TextWidth(Hintstr);
  1798.      he := Hint1.Canvas.TextHeight(Hintstr)+2;
  1799.      HintRect := Rect(p.x,p.y,p.x+w,p.y+he);
  1800.      If (not HintActive) or (Hintstr<>oldHintstr) then begin
  1801.         Hint1.ActivateHint(HintRect,Hintstr);
  1802.         oldHintstr := Hintstr;
  1803.         HintActive:=True;
  1804.      end;
  1805.   end else
  1806.     If HintActive then begin
  1807.        Hint1.ReleaseHandle;
  1808.        HintActive := False;
  1809.     end;
  1810.   end;
  1811. *)
  1812.  
  1813.   Cursor := oldCursor;
  1814.   mouseLeft := False;
  1815.   MovePt := Point(x,y);
  1816.   oldMovePt := Point(x,y);
  1817.   Moving := False;
  1818.   inherited;
  1819. end;
  1820.  
  1821. procedure TALCustomZoomImage.New(nWidth, nHeight: integer; nColor: TColor);
  1822. begin
  1823.   if Assigned(FChange) then FChange(Self);
  1824.   OrigBMP.Width := nWidth;
  1825.   OrigBMP.Height := nHeight;
  1826.   Cls(OrigBMP.Canvas,nColor);
  1827.   RestoreOriginal;
  1828.   FFileName := '';
  1829.   invalidate;
  1830. end;
  1831.  
  1832. procedure TALCustomZoomImage.MoveWindow(x, y: double);
  1833. var pCent : TPoint2d;
  1834. begin
  1835.   pCent     := Elforgatas(Point2d(x,y),Point2d(0,0),Rad(-RotateAngle));
  1836.   sCent     := Point2d(sCent.x-pCent.x, sCent.y-pCent.y);
  1837.   if Assigned(FChangeWindow) then
  1838.      FChangeWindow(Self,sCent.x,sCent.y,0,0,Zoom,0,0);
  1839.   invalidate;
  1840. end;
  1841.  
  1842. procedure TALCustomZoomImage.ShiftWindow(x, y: double);
  1843. var pCent : TPoint2d;
  1844. begin
  1845.   pCent     := Elforgatas(Point2d(x,y),Point2d(0,0),Rad(-RotateAngle));
  1846.   sCent     := Point2d(sCent.x+(pCent.x/Zoom),sCent.y+(pCent.y/Zoom));
  1847.   if SelrectVisible then
  1848.      begin
  1849.        OffsetRect(SelRect,Round(-x),Round(-y));
  1850.      end;
  1851.   if Assigned(FChangeWindow) then
  1852.      FChangeWindow(Self,sCent.x,sCent.y,0,0,Zoom,0,0);
  1853.   invalidate;
  1854. end;
  1855.  
  1856. procedure TALCustomZoomImage.ShowHintPanel(Show: Boolean; x,y: integer; HintText: string);
  1857. Var
  1858.   HintRect: TRect;
  1859.   p: TPoint;
  1860.   w,he: integer;
  1861. begin
  1862.   {Hint ablak rajzolása}
  1863.   if Show then begin
  1864.      Hint1.Canvas.Font.Name := 'Courir New';
  1865.      Hint1.Canvas.Font.Size := 8;
  1866.      p := ClientToScreen(point(x+8,y-18));
  1867.      w := Pos(chr(13),HintText);
  1868.      if w=0 then
  1869.         w := Hint1.Canvas.TextWidth(HintText)
  1870.      else
  1871.         w := Hint1.Canvas.TextWidth(Copy(HintText,1,w+1));
  1872.      he := Hint1.Canvas.TextHeight(HintText)+2+48;
  1873.      HintRect := Rect(p.x,p.y,p.x+w,p.y+he);
  1874.      Hint1.Color := clWhite;
  1875.      Hint1.ActivateHint(HintRect,HintText);
  1876.      HintActive:=True;
  1877.   end else
  1878.     If HintActive then begin
  1879.        Hint1.ReleaseHandle;
  1880.        HintActive := False;
  1881.     end;
  1882. end;
  1883.  
  1884. procedure TALCustomZoomImage.CloseHintPanel;
  1885. begin
  1886.     If HintActive then begin
  1887.        Hint1.ReleaseHandle;
  1888.        HintActive := False;
  1889.     end;
  1890. end;
  1891.  
  1892. function TALCustomZoomImage.GetNewCent(origCent: TPoint2d): TPoint2d;
  1893. var dx,dy: double;    // Differences to the upper left corner
  1894.     pCent: TPoint2d;
  1895. begin
  1896.   pCent := Point2d(sCent.x-WorkBMP.Width/2,origCent.y-WorkBMP.Height/2);
  1897.   pCent := Elforgatas(pCent,Point2d(0,0),Rad(RotateAngle));
  1898.   dx    := pCent.X;
  1899.   dy    := pCent.Y;
  1900.   Result := Point2d(dx+CopyBMP.Width/2,dy+CopyBMP.Height/2);
  1901. end;
  1902.  
  1903. procedure TALCustomZoomImage.CalculateRects;
  1904. var w,h : double;
  1905. begin
  1906.   newCent := GetNewCent(sCent);
  1907.   Sizes := Point(CopyBMP.Width,CopyBMP.Height);
  1908.  
  1909.   // newCent need to be on the source bitmap
  1910.   w := width/(2*Zoom);
  1911.   h := height/(2*Zoom);
  1912.  
  1913.   // Calculate the rect of the source window to view
  1914.   sRect := Rect2d(Round(newCent.x-w-1),Round(newCent.y-h-1),
  1915.                   Round(newCent.x+w+1),Round(newCent.y+h+1));
  1916.   dRect := Rect(XToS(sRect.x1),YToS(sRect.y1),
  1917.                 XToS(sRect.x2),YToS(sRect.y2));
  1918.   BMPOffset := Point(dRect.left,dRect.top);
  1919.   if not OverMove then begin
  1920.      if newCent.x<0 then newCent.x:=0;
  1921.      if newCent.y<0 then newCent.y:=0;
  1922.      if newCent.x>Sizes.x then newCent.x:=Sizes.x;
  1923.      if newCent.y>Sizes.y then newCent.y:=Sizes.y;
  1924.      if sCent.x<0 then sCent.x:=0;
  1925.      if sCent.y<0 then sCent.y:=0;
  1926.      if sCent.x>WorkBMP.Width then sCent.x:=WorkBMP.Width;
  1927.      if sCent.y>WorkBMP.Height then sCent.y:=WorkBMP.Height;
  1928.   end;
  1929.  
  1930. end;
  1931.  
  1932. procedure TALCustomZoomImage.Paint;
  1933. var tps: tagPAINTSTRUCT;
  1934.     R  : TRect;
  1935.     s  : string;
  1936.     siz: TSize;
  1937.     Rgn: HRGN;
  1938.     w  : integer;
  1939. begin
  1940.   IF (not WorkBMP.Empty) and (not Loading) then begin
  1941.      beginpaint(BackBMP.Canvas.Handle,tps );
  1942.      Canvas.Lock;
  1943.  
  1944.      InitBackImage;
  1945.      CalculateRects;
  1946.  
  1947.      if Assigned(FBeforePaint) then
  1948.         FBeforePaint(Self,sCent.x,sCent.y,dRect);
  1949.  
  1950.      if FVisibleImage then
  1951.      begin
  1952.      SetStretchBltMode(BackBMP.Canvas.Handle, STRETCH_DELETESCANS);
  1953.      StretchBlt(BackBMP.Canvas.Handle,BMPOffset.x,BMPOffset.y,
  1954.              dRect.Right-dRect.Left,dRect.Bottom-dRect.Top,
  1955.              CopyBMP.Canvas.Handle,
  1956.              Round(sRect.x1),Round(sRect.y1),
  1957.              Round(sRect.x2-sRect.x1),Round(sRect.y2-sRect.y1),
  1958.              SRCCOPY);
  1959.      end;
  1960.  
  1961.      if SelrectVisible then begin
  1962.         BackBMP.Canvas.Brush.Style := bsClear;
  1963.         BackBMP.Canvas.Pen.Color   := clBlack;
  1964.         BackBMP.Canvas.Pen.Style   := psSolid;
  1965.         DrawShape(BackBMP.Canvas,dtRectangle,Point(SelRect.Left,SelRect.Top),
  1966.                        Point(SelRect.Right,SelRect.Bottom),pmNotXor);
  1967.         BackBMP.Canvas.Pen.Color   := clWhite;
  1968.         BackBMP.Canvas.Pen.Mode   := pmNotXor;
  1969.         with BackBMP.Canvas.Font do begin
  1970.              Name := 'Arial';
  1971.              Color:= clWhite;
  1972.              Size := 8;
  1973.         end;
  1974.         s := IntToStr(SelRect.Right-SelRect.Left)+'x'+IntToStr(SelRect.Bottom-SelRect.Top);
  1975.         siz:=BackBMP.Canvas.TextExtent(s);
  1976.         BackBMP.Canvas.TextOut(SelRect.Left,SelRect.Top,s);
  1977.      end;
  1978.      if not PasteBMP.Empty then begin
  1979.         R := PasteBMP.Canvas.ClipRect;
  1980.         R := Rect(0,0,Trunc(Zoom*PasteBMP.Width),Trunc(Zoom*PasteBMP.Height));
  1981.         OffsetRect(R,MovePt.x,MovePt.y);
  1982.         BackBMP.Canvas.StretchDraw(R,TGraphic(PasteBMP));
  1983.      end;
  1984.      if Grid.PixelGrid then DrawPixelGrid;
  1985.      if Grid.Visible then DrawGrid;
  1986.      if CentralCross then DrawCentralCross(BackBMP.Canvas,cPen);
  1987.  
  1988.      if Assigned(FAfterPaint) and not (csDestroying in ComponentState) then
  1989.         FAfterPaint(Self,sCent.x,sCent.y,dRect);
  1990.  
  1991.   end else begin
  1992.      InitBackImage;
  1993.   end;
  1994.  
  1995.      if FCircleWindow then begin
  1996.         Cls(Canvas,clBlack);
  1997.         if Width>Height
  1998.            then w:=Height div 2
  1999.            else w:=Width div 2;
  2000.         Rgn := CreateEllipticRgn((Width div 2)-w, (Height div 2)-w, (Width div 2)+w, (Height div 2)+w);
  2001.         SelectClipRgn(Canvas.Handle, Rgn);
  2002.         Canvas.Draw(0, 0, BackBMP);
  2003.      end else
  2004.         BitBlt(Canvas.Handle,0,0,Width,Height,
  2005.              BackBMP.Canvas.Handle,0,0,SRCCOPY);
  2006.  
  2007.      If oldCursorCross then DrawMouseCross(oldMovePt,pmNotXor);
  2008.      endpaint(BackBMP.Canvas.Handle,tps);
  2009.      Canvas.UnLock;
  2010.  
  2011. end;
  2012.  
  2013. function TALCustomZoomImage.SaveToFile(FileName: TFileName): boolean;
  2014. var ext: string;
  2015.     jpgIMG: TJpegImage;
  2016. begin
  2017. Try
  2018.   Result := False;
  2019.   Loading := True;
  2020.   Try
  2021.      ext := UpperCase(ExtractFileExt(FileName));
  2022.      If ext='.BMP' then WorkBMP.SaveToFile(FileName);
  2023.      If ext='.JPG' then
  2024.      begin
  2025.         jpgIMG := TJpegImage.Create;
  2026.         jpgIMG.Assign(WorkBMP);
  2027.         jpgIMG.SaveToFile(FileName);
  2028.         jpgIMG.Free;
  2029.      end;
  2030.   except
  2031.     exit;
  2032.   end;
  2033. finally
  2034.   OrigBMP.Assign(WorkBMP);
  2035.   Result := True;
  2036.   Loading := False;
  2037.   invalidate;
  2038. end;
  2039. end;
  2040.  
  2041. procedure TALCustomZoomImage.SelToScreen;
  2042. var dxy,sxy: double;
  2043.     cx,cy,rx,ry: integer;
  2044. begin
  2045.   if SelRectVisible then begin
  2046.       SelRect := CorrectRect(SelRect);
  2047.       cx := (SelRect.Right + SelRect.Left) div 2;
  2048.       cy := (SelRect.Bottom + SelRect.Top) div 2;
  2049.       rx := (SelRect.Right - SelRect.Left) div 2;
  2050.       ry := (SelRect.Bottom - SelRect.Top) div 2;
  2051.       sCent := Point2d(XToW(cx),YToW(cy));
  2052.       dxy := Width/height;
  2053.       sxy := rx/ry;
  2054.       if dxy<sxy then
  2055.          Zoom := zoom*width/(2*rx)
  2056.       else
  2057.          Zoom := zoom*Height/(2*ry);
  2058.       InitSelWindow;
  2059.       invalidate;
  2060.   end;
  2061. end;
  2062.  
  2063. procedure TALCustomZoomImage.CopyToClipboard;
  2064. var BMP: TBitmap;
  2065.     R  : TRect;
  2066.     oldClipBoardAction : TClipBoardAction;
  2067. begin
  2068. Try
  2069.   BMP := TBitmap.Create;
  2070.   oldClipBoardAction := FClipBoardAction;
  2071.   if SelrectVisible then begin
  2072.   if oldClipBoardAction in [cbaScreen,cbaScreenSelected] then
  2073.      FClipBoardAction := cbaScreenSelected
  2074.   else
  2075.      FClipBoardAction := cbaSelected;
  2076.   end;
  2077.   Case FClipBoardAction of
  2078.   cbaTotal    : BMP.Assign(CopyBMP);
  2079.   cbaScreen   : begin
  2080.                   R := Canvas.ClipRect;
  2081.                   BMPResize(BMP,Width,Height);
  2082.                   BMP.canvas.CopyRect(R,Canvas,R);
  2083.                 end;
  2084.   //BMP.Assign(BackBMP);
  2085.   cbaSelected : if SelRectVisible then begin
  2086.                   SelRectVisible := False;
  2087.                   R := Rect(Round(XToW(SelRect.Left+1)),Round(YToW(SelRect.Top+1)),
  2088.                                   Round(XToW(SelRect.Right-1)),Round(YToW(SelRect.Bottom-1)));
  2089.                   BMP.Width := R.Right - R.Left;
  2090.                   BMP.Height:= R.Bottom - R.Top;
  2091.                   BMP.canvas.CopyRect(Rect(0,0,BMP.Width,BMP.Height),CopyBMP.Canvas,R);
  2092.                 end;
  2093.   cbaScreenSelected :
  2094.                 if SelRectVisible then begin
  2095.                   SelRectVisible := False;
  2096.                   R := Rect(SelRect.Left+1,SelRect.Top+1,
  2097.                                   SelRect.Right-1,SelRect.Bottom-1);
  2098.                   BMP.Width := R.Right - R.Left;
  2099.                   BMP.Height:= R.Bottom - R.Top;
  2100.                   BMP.canvas.CopyRect(Rect(0,0,BMP.Width,BMP.Height),Canvas,R);
  2101.                 end;
  2102.   cbaFixArea   :
  2103.                 begin
  2104.                   BMP.Width := FixRect.Right - FixRect.Left;
  2105.                   BMP.Height:= FixRect.Bottom - FixRect.Top;
  2106.                   BMP.canvas.CopyRect(Rect(0,0,BMP.Width,BMP.Height),CopyBMP.Canvas,FixRect);
  2107.                 end;
  2108.   cbaFixWindow :
  2109.                 begin
  2110.                   BMP.Width := FixWinRect.Right - FixWinRect.Left;
  2111.                   BMP.Height:= FixWinRect.Bottom - FixWinRect.Top;
  2112.                   BMP.canvas.CopyRect(Rect(0,0,BMP.Width,BMP.Height),Canvas,FixWinRect);
  2113.                 end;
  2114.   end;
  2115. Finally
  2116.   Clipboard.Assign(BMP);
  2117.   BMP.Free;
  2118.   FClipBoardAction := oldClipBoardAction;
  2119.   invalidate;
  2120. end;
  2121. end;
  2122.  
  2123. procedure TALCustomZoomImage.CutToClipboard;
  2124. begin
  2125.   CopyToClipboard;
  2126.   if ClipboardAction = cbaSelected then
  2127.      FillRect(SelRect,clBlack)
  2128.   else
  2129.      FillRect(Rect(0,0,WorkBMP.Width,WorkBMP.Height),clBlack);
  2130. end;
  2131.  
  2132.     procedure TALCustomZoomImage.Draw_Grid(gRect: TRect2d; GridWidth: double;
  2133.                                            Scale: boolean);  // Distance between lines
  2134.     var
  2135.        kp,kp0: TPoint2d;
  2136.        vp,vp0: TPoint2d;
  2137.        x,y   : integer;
  2138.        n : double;
  2139.        sCorr: integer;
  2140.     begin
  2141.       kp := Point2d(gRect.x1,gRect.y1);
  2142.       vp := Point2d(gRect.x2,gRect.y2);
  2143.       sCorr:=-Grid.ScaleFont.Height+4;
  2144.       With BackBmp.Canvas do begin
  2145.            if Scale then begin
  2146.               Font.Assign(Grid.ScaleFont);
  2147.            end;
  2148.  
  2149.       n := 0;
  2150.       Brush.Style := bsClear;
  2151.       While kp.x<=vp.x do begin
  2152.             if Grid.FFix then begin
  2153.                x := Round(kp.x);
  2154.                y := Round(vp.y);
  2155.             end else begin
  2156.                x := XToS(kp.x);
  2157.                y := YToS(vp.y);
  2158.             end;
  2159.             if x>sCorr then begin
  2160.                MoveTo(x,sCorr);
  2161.                LineTo(x,y);
  2162.                if Scale and (n=0) then
  2163.                   TextOut(x,0,IntToStr(Trunc(kp.x)));
  2164.                n := n+GridWidth*Zoom;
  2165.                if n>32 then n:=0;
  2166.             end;
  2167.             kp.x:=kp.x+GridWidth;
  2168.       end;
  2169.  
  2170.       n := 0;
  2171.       Brush.Style := bsClear;
  2172.       While kp.y<=vp.y do begin
  2173.             if Grid.FFix then begin
  2174.                x := Round(vp.x);
  2175.                y := Round(kp.y);
  2176.             end else begin
  2177.                x := XToS(vp.x);
  2178.                y := YToS(kp.y);
  2179.             end;
  2180.             if y>sCorr then begin
  2181.                MoveTo(sCorr,y);
  2182.                LineTo(x,y);
  2183.                if Scale and (Trunc(n)=0) then
  2184.                   RotText(BackBmp.Canvas,0,y,IntToStr(Trunc(kp.y)),900);
  2185.                n := n+GridWidth*Zoom;
  2186.                if n>32 then n:=0;
  2187.             end;
  2188.             kp.y:=kp.y+GridWidth;
  2189.       end;
  2190.       end;
  2191.     end;
  2192.  
  2193. procedure TALCustomZoomImage.DrawGrid;
  2194. var
  2195.     R : TRect2d;
  2196.     scale : boolean;
  2197. begin
  2198. If Grid.Visible then
  2199.   With BackBmp.Canvas do begin
  2200.  
  2201.        if Grid.OnlyOnPaper or Grid.FFix then
  2202.           R := Rect2d(0,0,CopyBMP.Width,CopyBMP.Height)
  2203.        else
  2204.           R := Rect2d(Trunc(sRect.x1-1),Trunc(sRect.y1-1),Trunc(sRect.x2+1),Trunc(sRect.y2+1));
  2205.  
  2206.       // Scale horz. rectange drawing
  2207.       if Scale then begin
  2208.          Brush.Assign(Grid.ScaleBrush);
  2209.          Rectangle(0,0,width,-Grid.ScaleFont.Height+4);
  2210.       end;
  2211.       // Scale vert. rectange drawing
  2212.       if Scale then begin
  2213.          Brush.Assign(Grid.ScaleBrush);
  2214.          Rectangle(0,0,-Grid.ScaleFont.Height+4,Height+4);
  2215.       end;
  2216.  
  2217.       Brush.Style := bsClear;
  2218.       Font.assign(Grid.ScaleFont);
  2219.       if (Zoom*Grid.SubGridDistance)>32 then begin
  2220.          Pen.Assign(Grid.SubGridPen);
  2221.          if Grid.PixelGrid and (Zoom>4) then Pen.Width := 2* Grid.SubGridPen.width
  2222.             else Pen.Width := Grid.GridPen.width;
  2223.          scale := (Zoom*Grid.SubGridDistance)>1;
  2224.          Font.color := clGray;
  2225.          Draw_Grid(R,Grid.SubGridDistance,Scale);
  2226.       end;
  2227.       if (Zoom*Grid.GridDistance)>12 then begin
  2228.          Pen.Assign(Grid.GridPen);
  2229.          Font.color := clYellow;
  2230.          Draw_Grid(R,Grid.GridDistance,True);
  2231.       end;
  2232.  
  2233.   end;
  2234.   if Zoom>20 then
  2235.   DrawPixelGrid;
  2236. end;
  2237.  
  2238. procedure TALCustomZoomImage.DrawPixelGrid;
  2239. var
  2240.     R : TRect2d;
  2241.     scale : boolean;
  2242. begin
  2243. If Grid.Visible then
  2244.   With BackBmp.Canvas do begin
  2245.  
  2246.        if Grid.OnlyOnPaper then
  2247.           R := Rect2d(0,0,CopyBMP.Width,CopyBMP.Height)
  2248.        else
  2249.           R := Rect2d(Trunc(sRect.x1-1),Trunc(sRect.y1-1),Trunc(sRect.x2+1),Trunc(sRect.y2+1));
  2250.  
  2251.  
  2252.       Pen.Assign(Grid.SubgridPen);
  2253.       Pen.Width := 1;
  2254.  
  2255.       Brush.Style := bsClear;
  2256.       Pen.Assign(Grid.GridPen);
  2257.       Rectangle(XToS(R.x1),YToS(R.y1),XToS(R.x2),YToS(R.y2));
  2258.  
  2259.       if (Zoom)>4 then begin
  2260.          Pen.Assign(Grid.SubGridPen);
  2261.          scale := (Zoom)>32;
  2262.          Draw_Grid(R,1,Scale);
  2263.       end;
  2264.  
  2265.   end;
  2266. end;
  2267.  
  2268. procedure TALCustomZoomImage.FadeOut(Pause: Integer);
  2269. begin
  2270.  
  2271. end;
  2272.  
  2273. procedure TALCustomZoomImage.FillRect(R: TRect; co: TColor);
  2274. begin
  2275.   With WorkBMP.Canvas do begin
  2276.        Pen.Color := co;
  2277.        Brush.Color := co;
  2278.        Brush.Style := bsSolid;
  2279.        Rectangle(R);
  2280.   end;
  2281.   repaint;
  2282. end;
  2283.  
  2284. procedure TALCustomZoomImage.FitToScreen;
  2285. var dxy,sxy: double;
  2286. begin
  2287. if not WorkBMP.Empty then
  2288. Try
  2289.   dxy := Width/height;
  2290.   Sizes := Point(CopyBMP.Width,CopyBMP.Height);
  2291.   sxy   := Height/Width;
  2292.   sCent := Point2d(WorkBMP.Width/2,WorkBMP.Height/2);
  2293.   sxy := Sizes.x/Sizes.y;
  2294.   if (Sizes.x>0) and (Sizes.y>0) then
  2295.   if dxy<sxy then
  2296.      Zoom := 0.99*width/Sizes.x
  2297.   else
  2298.      Zoom := 0.99*Height/Sizes.y;
  2299. //  invalidate;
  2300. except
  2301. end;
  2302. end;
  2303.  
  2304. function TALCustomZoomImage.GetPixelColor(p: TPoint): TColor;
  2305. begin
  2306.   Result := WorkBMp.Canvas.Pixels[p.x,p.y];
  2307. end;
  2308.  
  2309. // Get RGB values from screen pixel
  2310. function TALCustomZoomImage.GetRGB(x, y: integer): TRGB24;
  2311. var co: TColor;
  2312.     wPoint : TPoint2d;
  2313. begin
  2314.   wPoint := ScreenToWorld(Point(x,y));
  2315.   co := CopyBMP.Canvas.Pixels[Trunc(wPoint.x),Trunc(wPoint.y)];
  2316.   With Result do begin
  2317.        R := GetRValue(co);
  2318.        B := GetBValue(co);
  2319.        G := GetGValue(co);
  2320.   end;
  2321. end;
  2322.  
  2323. procedure TALCustomZoomImage.MoveToCentrum(x, y: double);
  2324. begin
  2325.   sCent     := Point2d(x,y);
  2326.   invalidate;
  2327. end;
  2328.  
  2329. procedure TALCustomZoomImage.PasteFromClipboard;
  2330. begin
  2331.   if Clipboard.HasFormat(CF_PICTURE) then begin
  2332.     if Assigned(FChange) then FChange(Self);
  2333.     OrigBMP.Assign(Clipboard);
  2334.     OrigBMP.PixelFormat := pf24bit;
  2335.     RestoreOriginal;
  2336.     FitToScreen;
  2337.   end;
  2338. end;
  2339.  
  2340. // Pate the clipboard image to the world coordinate on the workBMP
  2341. procedure TALCustomZoomImage.PasteSpecial;
  2342. begin
  2343.   if Clipboard.HasFormat(CF_PICTURE) then begin
  2344.       PasteBMP.Assign(Clipboard);
  2345.       EnablePopup(False);
  2346.   end else begin
  2347.       PasteBMP.ReleaseHandle;
  2348.       EnablePopup(True);
  2349.   end;
  2350. end;
  2351.  
  2352. procedure TALCustomZoomImage.PixelToCentrum(x, y: integer);
  2353. begin
  2354.   sCent := Point2d(x + 0.5,y + 0.5);
  2355.   Invalidate;
  2356. end;
  2357.  
  2358. procedure TALCustomZoomImage.RestoreOriginal;
  2359. begin
  2360.   loading := True;
  2361.   WorkBMP.Assign(OrigBMP);
  2362.   CopyBMP.Assign(WorkBMP);
  2363.   if Fitting then FitToScreen;
  2364.   loading := False;
  2365.   Invalidate;
  2366. end;
  2367.  
  2368. procedure TALCustomZoomImage.SaveAsOriginal;
  2369. begin
  2370.   OrigBMP.Assign(WorkBMP);
  2371.   Invalidate;
  2372. end;
  2373.  
  2374. function TALCustomZoomImage.ScreenRectToWorld(R: TRect): TRect;
  2375. begin
  2376.   Result := Rect(Round(XToW(R.Left)),Round(YToW(R.Top)),
  2377.                  Round(XToW(R.Right)),Round(YToW(R.Bottom)))
  2378. end;
  2379.  
  2380. procedure TALCustomZoomImage.SetPixelColor(p: TPoint; Co: TColor);
  2381. begin
  2382.   WorkBMp.Canvas.Pixels[p.x,p.y]:=co;
  2383.   invalidate;
  2384. end;
  2385.  
  2386. // Transform the Screen Coordinates to World Coordinates
  2387. function TALCustomZoomImage.SToW(p: TPoint): TPoint2d;
  2388. var Vec : TPoint2d;
  2389. begin
  2390.    Vec := Point2d(p.x-Width/2,p.y-Height/2);
  2391.    Vec := Elforgatas(Vec,Point2d(0,0),Rad(-FRotateAngle));
  2392.    Result := Point2d(Vec.x/Zoom+sCent.x,Vec.y/Zoom+sCent.y);
  2393. //  Result := Point2d(XToW(p.x),YToW(p.y));
  2394. end;
  2395.  
  2396. function TALCustomZoomImage.WorldRectToScreen(R: TRect): TRect;
  2397. begin
  2398.   Result := Rect(XToS(R.Left),YToS(R.Top),
  2399.                  XToS(R.Right),YToS(R.Bottom))
  2400. end;
  2401.  
  2402. // Transform the World Coordinates to Screen Coordinates
  2403. function TALCustomZoomImage.WToS(p: TPoint2d): TPoint;
  2404. var Vec : TPoint2d;
  2405. begin
  2406.    Vec := Point2d(p.x-sCent.x,p.y-sCent.y);
  2407.    Vec := Elforgatas(Vec,Point2d(0,0),Rad(FRotateAngle));
  2408.    Result := Point(Trunc(Zoom*Vec.x+Width/2),Trunc(Zoom*Vec.y+Height/2));
  2409. //  Result := Point(XToS(p.x),YToS(p.y));
  2410. end;
  2411.  
  2412. // world x to Screen x
  2413. function TALCustomZoomImage.XToS(x: double): integer;
  2414. begin
  2415.   Result := Round((Width/2) + Zoom*(x-newCent.x));
  2416. end;
  2417.  
  2418. // X coordinate on the CopyBMP from Screen x coordinate
  2419. function TALCustomZoomImage.XToW(x: integer): double;
  2420. begin
  2421.   Result := newCent.x + (x-(Width/2))/Zoom;
  2422. end;
  2423.  
  2424. // world y to Screen y
  2425. function TALCustomZoomImage.YToS(y: double): integer;
  2426. begin
  2427.   Result := Round((Height/2) + Zoom*(y-newCent.y));
  2428. end;
  2429.  
  2430. function TALCustomZoomImage.YToW(y: integer): double;
  2431. begin
  2432.   Result := {-0.5 + }newCent.y + (y-(Height/2))/Zoom;
  2433. end;
  2434.  
  2435. procedure TALCustomZoomImage.SetSelRectVisible(const Value: boolean);
  2436. begin
  2437.   FSelRectVisible := Value;
  2438.   EnablePopup(Value);
  2439.   invalidate;
  2440. end;
  2441.  
  2442. // Clears the BackBMP with BackColor brush
  2443. procedure TALCustomZoomImage.InitBackImage;
  2444. begin
  2445.   BackBMP.Width := Width;
  2446.   BackBMP.Height:= Height;
  2447.   Cls(BackBMP.Canvas,FBackColor);
  2448.   if BackCross then
  2449.   with BackBMP.Canvas do begin
  2450.        Pen.Assign(cPen);
  2451.        MoveTo(0,0);LineTo(Width,Height);
  2452.        MoveTo(0,Height);LineTo(Width,0);
  2453.   end;
  2454. end;
  2455.  
  2456. procedure TALCustomZoomImage.SetRotateAngle(const Value: double);
  2457. begin
  2458.   FRotateAngle := Value;
  2459.   WorkBMP.PixelFormat := pf24bit;
  2460.   CopyBMP.Assign(WorkBMP);
  2461.   if Value<>0 then
  2462.      StretchBitmap.RotateIt(FRotateAngle);
  2463.   if Assigned(FChangeWindow) then
  2464.      FChangeWindow(Self,sCent.x,sCent.y,0,0,Zoom,0,0);
  2465.   Repaint;
  2466. end;
  2467.  
  2468. procedure TALCustomZoomImage.SetVisibleImage(const Value: boolean);
  2469. begin
  2470.   FVisibleImage := Value;
  2471.   invalidate;
  2472. end;
  2473.  
  2474. procedure TALCustomZoomImage.SetVisibleOverlay(const Value: boolean);
  2475. begin
  2476.   FVisibleOverlay := Value;
  2477.   invalidate;
  2478. end;
  2479.  
  2480. procedure TALCustomZoomImage.wChange(Sender: TObject);
  2481. begin
  2482.   RotateAngle := FRotateAngle;
  2483. end;
  2484.  
  2485. // Get the new centrum, from original centrum on the WorkBMP
  2486.  
  2487. function TALCustomZoomImage.ScreenToWorld(p: TPoint): TPoint2d;
  2488. begin
  2489.   Result := SToW(p);
  2490. end;
  2491.  
  2492. function TALCustomZoomImage.WorldToScreen(p: TPoint2d): TPoint;
  2493. begin
  2494.   Result := WToS(p);
  2495. end;
  2496.  
  2497. // Croping the selected image area
  2498. // Kivágja a kép kiválasztott részletét és ez lesz a kép: Ctrl+K
  2499. procedure TALCustomZoomImage.CropSelected;
  2500. var BMP: TBitmap;
  2501.     R  : TRect;
  2502. begin
  2503.   If SelRectVisible then begin
  2504.      SelRectVisible := False;
  2505.      Crop(CopyBMP,Rect(Round(XToW(SelRect.Left+1)),Round(YToW(SelRect.Top+1)),
  2506.         Round(XToW(SelRect.Right-1)),Round(YToW(SelRect.Bottom-1))));
  2507.      OrigBMP.Assign(CopyBMP);
  2508.      RestoreOriginal;
  2509.      FitToScreen;
  2510.   end;
  2511. (*
  2512.   if SelrectVisible then begin
  2513.   Try
  2514.      SelRectVisible := False;
  2515.      BMP := TBitmap.Create;
  2516.      R := Rect(Round(XToW(SelRect.Left+1)),Round(YToW(SelRect.Top+1)),
  2517.           Round(XToW(SelRect.Right-1)),Round(YToW(SelRect.Bottom-1)));
  2518.      BMP.Width := R.Right - R.Left;
  2519.      BMP.Height:= R.Bottom - R.Top;
  2520.      BMP.canvas.CopyRect(Rect(0,0,BMP.Width,BMP.Height),CopyBMP.Canvas,R);
  2521.   finally
  2522.      OrigBMP.Assign(BMP);
  2523.      RestoreOriginal;
  2524.   end;
  2525.   end;
  2526. *)
  2527. end;
  2528.  
  2529. procedure TALCustomZoomImage.SetFitting(const Value: boolean);
  2530. begin
  2531.   FFitting := Value;
  2532.   if Value then FitToScreen;
  2533. end;
  2534.  
  2535. procedure TALCustomZoomImage.ReDraw;
  2536. begin
  2537.   RotateAngle:=FRotateAngle;
  2538. end;
  2539.  
  2540. procedure TALCustomZoomImage.Transform(x, y, rot: double);
  2541. begin
  2542.   MoveWindow(x,y);
  2543.   RotateAngle := rot;
  2544. end;
  2545.  
  2546. procedure TALCustomZoomImage.MirrorHorizontal;
  2547. begin
  2548.   FlipHorizontal(WorkBMP);
  2549.   sCent := Point2d(WorkBMP.width-sCent.x,sCent.y);
  2550.   Redraw;
  2551. end;
  2552.  
  2553. procedure TALCustomZoomImage.MirrorVertical;
  2554. begin
  2555.   FlipVertical(WorkBMP);
  2556.   sCent := Point2d(sCent.x,WorkBMP.Height-sCent.y);
  2557.   Redraw;
  2558. end;
  2559.  
  2560. procedure TALCustomZoomImage.TurnLeft;
  2561. var R,yy: double;
  2562.     BMP: TBitmap;
  2563. begin
  2564.     WorkBMP.OnChange := nil;
  2565.     BMP := TBitmap.Create;
  2566.     BMP := CreateRotatedBitmap(WorkBMP,90,clBlack);
  2567.     sCent := Point2d(sCent.y,WorkBMP.width-sCent.x);
  2568.     WorkBMP.Assign(BMP);
  2569.     BMP.Free;
  2570.     WorkBMP.OnChange := wChange;
  2571.     ReDraw;
  2572. end;
  2573.  
  2574. procedure TALCustomZoomImage.TurnRight;
  2575. var R,yy: double;
  2576.     BMP: TBitmap;
  2577. begin
  2578.     WorkBMP.OnChange := nil;
  2579.     BMP := TBitmap.Create;
  2580.     BMP := CreateRotatedBitmap(WorkBMP,-90,clBlack);
  2581.     sCent := Point2d(WorkBMP.Height-sCent.y,sCent.x);
  2582.     WorkBMP.Assign(BMP);
  2583.     BMP.Free;
  2584.     WorkBMP.OnChange := wChange;
  2585.     ReDraw;
  2586. end;
  2587.  
  2588. procedure TALCustomZoomImage.SelRectToCentrum;
  2589. var dx,dy: integer;
  2590. begin
  2591.   dx := (Width - (SelRect.Right + SelRect.Left)) div 2;
  2592.   dy := (Height - (SelRect.Bottom + SelRect.Top)) div 2;
  2593.   OffsetRect(SelRect,dx,dy);
  2594.   invalidate;
  2595. end;
  2596.  
  2597. procedure TALCustomZoomImage.BlackAndWhite;
  2598. begin
  2599.   STAF_Imp.BlackAndWhite(WorkBMP);
  2600.   Redraw;
  2601. end;
  2602.  
  2603. procedure TALCustomZoomImage.Blur;
  2604. begin
  2605.   STAF_Imp.Blur(WorkBMP);
  2606.   Redraw;
  2607. end;
  2608.  
  2609. procedure TALCustomZoomImage.Contrast(Amount: Integer);
  2610. begin
  2611.   CopyBMP.Assign(WorkBMP);
  2612.   Contrastness(CopyBMP,Amount);
  2613.   WorkBMP.Assign(CopyBMP);
  2614. end;
  2615.  
  2616. procedure TALCustomZoomImage.Darkness(Amount: integer);
  2617. begin
  2618.   WorkBMP.Assign(OrigBMP);
  2619.   STAF_Imp.Darkness(WorkBMP,Amount);
  2620.   Redraw;
  2621. end;
  2622.  
  2623. procedure TALCustomZoomImage.Lightness(Amount: Integer);
  2624. begin
  2625.   WorkBMP.Assign(OrigBMP);
  2626.   STAF_Imp.Lightness(WorkBMP,Amount);
  2627.   Redraw;
  2628. end;
  2629.  
  2630. procedure TALCustomZoomImage.Negative;
  2631. begin
  2632.   STAF_Imp.Negative(WorkBMP);
  2633.   Redraw;
  2634. end;
  2635.  
  2636. procedure TALCustomZoomImage.Posterize(amount: integer);
  2637. begin
  2638.   STAF_Imp.Posterize(WorkBMP,Amount);
  2639.   Redraw;
  2640. end;
  2641.  
  2642. procedure TALCustomZoomImage.Saturation(Amount: Integer);
  2643. begin
  2644.   STAF_Imp.Saturation(WorkBMP,Amount);
  2645.   Redraw;
  2646. end;
  2647.  
  2648. procedure TALCustomZoomImage.Sepia(depth: byte);
  2649. begin
  2650.   STAF_Imp.Sepia(WorkBMP,depth);
  2651.   Redraw;
  2652. end;
  2653.  
  2654. procedure TALCustomZoomImage.Clear;
  2655. begin
  2656.   OrigBMP.Dormant;
  2657.   OrigBMP.FreeImage;
  2658.   OrigBMP.Width := 0;
  2659.   OrigBMP.Height := 0;
  2660.   RestoreOriginal;
  2661. end;
  2662.  
  2663. procedure TALCustomZoomImage.SetVB;
  2664. begin
  2665.                 FRgbList.FR := False;
  2666.                 FRgbList.FG := False;
  2667.                 FRgbList.FB := True;
  2668.                 SetRGBList(FRgbList);
  2669. end;
  2670.  
  2671. procedure TALCustomZoomImage.SetVG;
  2672. begin
  2673.                 FRgbList.FR := False;
  2674.                 FRgbList.FG := True;
  2675.                 FRgbList.FB := False;
  2676.                 SetRGBList(FRgbList);
  2677. end;
  2678.  
  2679. procedure TALCustomZoomImage.SetVR;
  2680. begin
  2681.                 FRgbList.FR := True;
  2682.                 FRgbList.FG := False;
  2683.                 FRgbList.FB := False;
  2684.                 SetRGBList(FRgbList);
  2685. end;
  2686.  
  2687. procedure TALCustomZoomImage.SetVRGB;
  2688. begin
  2689.                 FRgbList.FRGB := True;
  2690.                 SetRGBList(FRgbList);
  2691. end;
  2692.  
  2693. { TALImageSource }
  2694.  
  2695. constructor TALImageSource.Create(AOwner: TComponent);
  2696. begin
  2697.   inherited;
  2698.   OrigBMP        := TBitmap.Create;
  2699.   WorkBMP        := TBitmap.Create;
  2700.   CopyBMP        := TBitmap.Create;
  2701. //  RGBList        := TRGBChanel.Create;
  2702. //  RGBList.FOnChange := Change;
  2703. end;
  2704.  
  2705. destructor TALImageSource.Destroy;
  2706. begin
  2707.   OrigBMP.Free;
  2708.   WorkBMP.Free;
  2709.   CopyBMP.Free;
  2710. //  RGBList.Free;
  2711.   inherited;
  2712. end;
  2713.  
  2714. procedure TALImageSource.SetFileName(const Value: TFileName);
  2715. begin
  2716.   If FFileName <> Value then begin
  2717.      if LoadFromFile(Value) then
  2718.         FFileName := Value;
  2719.   end;
  2720. end;
  2721.  
  2722. function TALImageSource.LoadFromFile(FileName: TFileName): boolean;
  2723. var ext: string;
  2724.     jpgIMG: TJpegImage;
  2725. begin
  2726. Try
  2727.   Result := False;
  2728.   Loading := True;
  2729.   if FileExists(FileName) then
  2730.   Try
  2731.      ext := UpperCase(ExtractFileExt(FileName));
  2732.      If ext='.BMP' then OrigBMP.LoadFromFile(FileName);
  2733.      If ext='.JPG' then
  2734.      begin
  2735.         jpgIMG := TJpegImage.Create;
  2736.         jpgIMG.LoadFromFile(FileName);
  2737.         OrigBMP.Assign(jpgIMG);
  2738.         if jpgIMG<>nil then jpgIMG.Free;
  2739.      end;
  2740.   except
  2741.     if jpgIMG<>nil then jpgIMG.Free;
  2742.     exit;
  2743.   end;
  2744. finally
  2745.   WorkBMP.Assign(OrigBMP);
  2746.   FFilename := FileName;
  2747.   Result := True;
  2748.   Loading := False;
  2749. end;
  2750. end;
  2751.  
  2752. procedure TALImageSource.New(nWidth, nHeight: integer; nColor: TColor);
  2753. begin
  2754.   OrigBMP.Width := nWidth;
  2755.   OrigBMP.Height := nHeight;
  2756.   Cls(OrigBMP.Canvas,nColor);
  2757.   WorkBMP.Assign(OrigBMP);
  2758. end;
  2759.  
  2760. function TALImageSource.SaveToFile(FileName: TFileName): boolean;
  2761. var ext: string;
  2762.     jpgIMG: TJpegImage;
  2763. begin
  2764. Try
  2765.   Result := False;
  2766.   Loading := True;
  2767.   Try
  2768.      ext := UpperCase(ExtractFileExt(FileName));
  2769.      If ext='.BMP' then WorkBMP.SaveToFile(FileName);
  2770.      If ext='.JPG' then
  2771.      begin
  2772.         jpgIMG := TJpegImage.Create;
  2773.         jpgIMG.Assign(WorkBMP);
  2774.         jpgIMG.SaveToFile(FileName);
  2775.         if jpgIMG<>nil then jpgIMG.Free;
  2776.      end;
  2777.   except
  2778.     if jpgIMG<>nil then jpgIMG.Free;
  2779.     exit;
  2780.   end;
  2781. finally
  2782.   OrigBMP.Assign(WorkBMP);
  2783.   Result := True;
  2784.   Loading := False;
  2785. end;
  2786. end;
  2787.  
  2788. procedure TALImageSource.SetRGBList(const Value: TRGBChanel);
  2789. begin
  2790.   FRGBList := Value;
  2791.   RestoreOriginal;
  2792.   ChangeRGBChanel(WorkBMP,FRGBList.MonoRGB,FRGBList.FR,FRGBList.FG,FRGBList.FB);
  2793. end;
  2794.  
  2795. procedure TALImageSource.RestoreOriginal;
  2796. begin
  2797.   WorkBMP.Assign(OrigBMP);
  2798. end;
  2799.  
  2800. procedure TALImageSource.SaveAsOriginal;
  2801. begin
  2802.   OrigBMP.Assign(WorkBMP);
  2803. end;
  2804.  
  2805. procedure TALImageSource.Change(Sender: TObject);
  2806. begin
  2807. //  IF Sender = RGBList then
  2808. //     RGBList := RGBList;
  2809. end;
  2810.  
  2811. { TALCustomImageView }
  2812.  
  2813. procedure TALCustomImageView.CalculateRects;
  2814. var w,h : double;
  2815. begin
  2816.   Sizes := Point(ImageSource.WorkBMP.Width,ImageSource.WorkBMP.Height);
  2817.  
  2818.   // sCent need to be on the source bitmap
  2819.   w := width/(2*Zoom);
  2820.   h := height/(2*Zoom);
  2821.  
  2822.   if not OverMove then begin
  2823.      if sCent.x<0 then sCent.x:=0;
  2824.      if sCent.y<0 then sCent.y:=0;
  2825.      if sCent.x>Sizes.x then sCent.x:=Sizes.x;
  2826.      if sCent.y>Sizes.y then sCent.y:=Sizes.y;
  2827.   end;
  2828. (*   else begin
  2829.      if sCent.x<w then sCent.x:=w;
  2830.      if sCent.y<h then sCent.y:=h;
  2831.      if sCent.x>Sizes.x-w then sCent.x:=Sizes.x-w;
  2832.      if sCent.y>Sizes.y-h then sCent.y:=Sizes.y-h;
  2833.   end;*)
  2834.  
  2835.   // Calculate the rect of the source window to view
  2836.   sRect := Rect2d(Round(sCent.x-w-1),Round(sCent.y-h-1),
  2837.                   Round(sCent.x+w+1),Round(sCent.y+h+1));
  2838.   dRect := Rect(XToS(sRect.x1),YToS(sRect.y1),
  2839.                 XToS(sRect.x2),YToS(sRect.y2));
  2840.   BMPOffset := Point(dRect.left,dRect.top);
  2841. end;
  2842.  
  2843. procedure TALCustomImageView.Change(Sender: TObject);
  2844. begin
  2845.   IF Sender = RGBList then
  2846.      RGBList := RGBList;
  2847.   invalidate;
  2848. end;
  2849.  
  2850. procedure TALCustomImageView.Click;
  2851. begin
  2852.   inherited;
  2853.  
  2854. end;
  2855.  
  2856. procedure TALCustomImageView.CMMouseEnter(var msg: TMessage);
  2857. begin
  2858.  
  2859. end;
  2860.  
  2861. procedure TALCustomImageView.CMMouseLeave(var msg: TMessage);
  2862. begin
  2863.  
  2864. end;
  2865.  
  2866. procedure TALCustomImageView.CopyToClipboard;
  2867. begin
  2868.  
  2869. end;
  2870.  
  2871. constructor TALCustomImageView.Create(AOwner: TComponent);
  2872. begin
  2873.   inherited;
  2874.   Screen.Cursors[crKez1]     :=  LoadCursor(HInstance, 'SKEZ_1');
  2875.   Screen.Cursors[crKez2]     :=  LoadCursor(HInstance, 'SKEZ_2');
  2876.   Screen.Cursors[crRealZoom] :=  LoadCursor(HInstance, 'SREAL_ZOOM');
  2877.   Screen.Cursors[crNyilUp]   :=  LoadCursor(HInstance, 'SNYIL_UP');
  2878.   Screen.Cursors[crNyilDown] :=  LoadCursor(HInstance, 'SNYIL_DOWN');
  2879.   Screen.Cursors[crNyilLeft] :=  LoadCursor(HInstance, 'SNYIL_LEFT');
  2880.   Screen.Cursors[crNyilRight]:=  LoadCursor(HInstance, 'SNYIL_RIGHT');
  2881.   Screen.Cursors[crZoomIn]   :=  LoadCursor(HInstance, 'SZOOM_IN');
  2882.   Screen.Cursors[crZoomOut]  :=  LoadCursor(HInstance, 'SZOOM_OUT');
  2883.   Screen.Cursors[crKereszt]  :=  LoadCursor(HInstance, 'SKERESZT');
  2884.   Screen.Cursors[crHelp]     :=  LoadCursor(HInstance, 'SHELP_CUR');
  2885.  
  2886.   BackBMP        := TBitmap.Create;
  2887.   PasteBMP       := TBitmap.Create;
  2888.   PasteBMP.OnChange := pChange;
  2889.   cPen           := TPen.Create;
  2890.   Grid           := TImageGrid.Create;
  2891.   fGrid.OnChange := Change;
  2892.   fGrid.fVisible := False;
  2893.   fGrid.FOnlyOnPaper := True;
  2894.   FPixelGrid     := False;
  2895.   with cPen do begin
  2896.        Color := clRed;
  2897.        Style := psSolid;
  2898.        Mode  := pmCopy;
  2899.   end;
  2900.   RGBList        := TRGBChanel.Create;
  2901. //  RGBList.OnChange := Change;
  2902.   CentralCross   := True;
  2903.   BackColor      := clSilver;
  2904.   BMPOffset      := Point(0,0);
  2905.   fZoom          := 1.0;
  2906.   fOverMove      := True;
  2907.   fCursorCross   := True;
  2908.   oldCursorCross := True;
  2909.   MouseInOut     := 1;
  2910.   oldMovePt      := Point(-1,-1);
  2911.   Sizes          := Point(0,0);
  2912.   sRect          := Rect2d(0,0,0,0);
  2913.   ControlStyle   := ControlStyle+[csFramed,csReflector,csCaptureMouse];
  2914.   TabStop        := True;
  2915.   DoubleBuffered := False;
  2916.   timer          := TTimer.Create(Self);
  2917.   timer.Interval := 10;
  2918.   timer.Ontimer  := OnTimer;
  2919.   FClipBoardAction := cbaTotal;
  2920.   FixRect        := Rect(0,0,100,100);
  2921.   FixWinRect     := Rect(0,0,100,100);
  2922.   Width          := 100;
  2923.   Height         := 100;
  2924.   InitSelWindow;
  2925.   FEnableSelect  := True;
  2926.   FEnableActions := True;
  2927.   AutoPopup      := True;
  2928. end;
  2929.  
  2930. destructor TALCustomImageView.Destroy;
  2931. begin
  2932.   BackBMP.Free;
  2933.   PasteBMP.Free;
  2934.   cPen.Free;
  2935.   Grid.Free;
  2936.   RGBList.Free;
  2937.   timer.free;
  2938.   inherited;
  2939. end;
  2940.  
  2941. procedure TALCustomImageView.CutToClipboard;
  2942. begin
  2943.  
  2944. end;
  2945.  
  2946. procedure TALCustomImageView.DblClick;
  2947. begin
  2948.   inherited;
  2949.  
  2950. end;
  2951.  
  2952. function TALCustomImageView.DoMouseWheel(Shift: TShiftState;
  2953.   WheelDelta: Integer; MousePos: TPoint): Boolean;
  2954. begin
  2955.  
  2956. end;
  2957.  
  2958. function TALCustomImageView.DoMouseWheelDown(Shift: TShiftState;
  2959.   MousePos: TPoint): Boolean;
  2960. begin
  2961.  
  2962. end;
  2963.  
  2964. function TALCustomImageView.DoMouseWheelUp(Shift: TShiftState;
  2965.   MousePos: TPoint): Boolean;
  2966. begin
  2967.  
  2968. end;
  2969.  
  2970. procedure TALCustomImageView.DrawGrid;
  2971. begin
  2972.  
  2973. end;
  2974.  
  2975. procedure TALCustomImageView.DrawMouseCross(o: TPoint; PenMode: TPenMode);
  2976. begin
  2977.  
  2978. end;
  2979.  
  2980. procedure TALCustomImageView.DrawPixelGrid;
  2981. begin
  2982.  
  2983. end;
  2984.  
  2985. procedure TALCustomImageView.EnablePopup(en: boolean);
  2986. begin
  2987.  
  2988. end;
  2989.  
  2990. procedure TALCustomImageView.FadeOut(Pause: Integer);
  2991. begin
  2992.  
  2993. end;
  2994.  
  2995. procedure TALCustomImageView.FillRect(R: TRect; co: TColor);
  2996. begin
  2997.  
  2998. end;
  2999.  
  3000. procedure TALCustomImageView.FitToScreen;
  3001. begin
  3002.  
  3003. end;
  3004.  
  3005. function TALCustomImageView.GetPixelColor(p: TPoint): TColor;
  3006. begin
  3007.  
  3008. end;
  3009.  
  3010. function TALCustomImageView.GetRGB(x, y: integer): TRGB24;
  3011. begin
  3012.  
  3013. end;
  3014.  
  3015. procedure TALCustomImageView.InitBackImage;
  3016. begin
  3017.   BackBMP.Width := Width;
  3018.   BackBMP.Height:= Height;
  3019.   Cls(BackBMP.Canvas,FBackColor);
  3020.   if BackCross then
  3021.   with BackBMP.Canvas do begin
  3022.        Pen.Assign(cPen);
  3023.        MoveTo(0,0);LineTo(Width,Height);
  3024.        MoveTo(0,Height);LineTo(Width,0);
  3025.   end;
  3026. end;
  3027.  
  3028. procedure TALCustomImageView.InitSelWindow;
  3029. begin
  3030.  
  3031. end;
  3032.  
  3033. procedure TALCustomImageView.KeyDown(var Key: Word; Shift: TShiftState);
  3034. begin
  3035.   inherited;
  3036.  
  3037. end;
  3038.  
  3039. procedure TALCustomImageView.KeyPress(var Key: Char);
  3040. begin
  3041.   inherited;
  3042.  
  3043. end;
  3044.  
  3045. function TALCustomImageView.LoadFromFile(FileName: TFileName): boolean;
  3046. begin
  3047.  
  3048. end;
  3049.  
  3050. procedure TALCustomImageView.MouseDown(Button: TMouseButton;
  3051.   Shift: TShiftState; X, Y: Integer);
  3052. begin
  3053.   inherited;
  3054.  
  3055. end;
  3056.  
  3057. procedure TALCustomImageView.MouseMove(Shift: TShiftState; X, Y: Integer);
  3058. begin
  3059.   inherited;
  3060.  
  3061. end;
  3062.  
  3063. procedure TALCustomImageView.MouseUp(Button: TMouseButton;
  3064.   Shift: TShiftState; X, Y: Integer);
  3065. begin
  3066.   inherited;
  3067.  
  3068. end;
  3069.  
  3070. procedure TALCustomImageView.MoveToCentrum(x, y: double);
  3071. begin
  3072.  
  3073. end;
  3074.  
  3075. procedure TALCustomImageView.MoveWindow(x, y: double);
  3076. var pCent : TPoint2d;
  3077. begin
  3078. //  pCent     := Elforgatas(Point2d(x,y),Point2d(0,0),Rad(-RotateAngle));
  3079.   sCent     := Point2d(sCent.x-pCent.x, sCent.y-pCent.y);
  3080.   if Assigned(FChangeWindow) then
  3081.      FChangeWindow(Self,sCent.x,sCent.y,0,0,Zoom,0,0);
  3082.   invalidate;
  3083. end;
  3084.  
  3085. procedure TALCustomImageView.New(nWidth, nHeight: integer; nColor: TColor);
  3086. begin
  3087.  
  3088. end;
  3089.  
  3090. procedure TALCustomImageView.OnTimer(Sender: TObject);
  3091. begin
  3092.  
  3093. end;
  3094.  
  3095. procedure TALCustomImageView.Paint;
  3096. var tps: tagPAINTSTRUCT;
  3097.     R  : TRect;
  3098. begin
  3099. Try
  3100. if ImageSource<>nil then begin
  3101.   IF (not ImageSource.WorkBMP.Empty) and (not Loading) then begin
  3102.      beginpaint(Canvas.Handle,tps );
  3103.  
  3104.      InitBackImage;
  3105.      CalculateRects;
  3106.  
  3107.      if Assigned(FBeforePaint) then
  3108.         FBeforePaint(Self,sCent.x,sCent.y,dRect);
  3109.  
  3110.      SetStretchBltMode(BackBMP.Canvas.Handle, STRETCH_DELETESCANS);
  3111.      StretchBlt(BackBMP.Canvas.Handle,BMPOffset.x,BMPOffset.y,
  3112.              dRect.Right-dRect.Left,dRect.Bottom-dRect.Top,
  3113.              ImageSource.WorkBMP.Canvas.Handle,
  3114.              Round(sRect.x1),Round(sRect.y1),
  3115.              Round(sRect.x2-sRect.x1),Round(sRect.y2-sRect.y1),
  3116.              SRCCOPY);
  3117.  
  3118.      endpaint(Canvas.Handle,tps);
  3119.   end else begin
  3120.      InitBackImage;
  3121.   end;
  3122.   end else begin
  3123.      InitBackImage;
  3124.      inherited Paint;
  3125.   end;
  3126. Finally
  3127.      if PixelGrid then DrawPixelGrid;
  3128.      if Grid.Visible then DrawGrid;
  3129.      if CentralCross then DrawCentralCross(BackBMP.Canvas,cPen);
  3130.      if SelrectVisible then begin
  3131.         BackBMP.Canvas.Brush.Style := bsClear;
  3132.         BackBMP.Canvas.Pen.Color   := clBlack;
  3133.         BackBMP.Canvas.Pen.Style   := psSolid;
  3134.         DrawShape(BackBMP.Canvas,dtRectangle,Point(SelRect.Left,SelRect.Top),
  3135.                        Point(SelRect.Right,SelRect.Bottom),pmNotXor);
  3136.      end;
  3137.      if not PasteBMP.Empty then begin
  3138.         R := PasteBMP.Canvas.ClipRect;
  3139.         R := Rect(0,0,Trunc(Zoom*PasteBMP.Width),Trunc(Zoom*PasteBMP.Height));
  3140.         OffsetRect(R,MovePt.x,MovePt.y);
  3141.         BackBMP.Canvas.StretchDraw(R,TGraphic(PasteBMP));
  3142.      end;
  3143.  
  3144.      BitBlt(Canvas.Handle,0,0,Width,Height,
  3145.              BackBMP.Canvas.Handle,0,0,SRCCOPY);
  3146.  
  3147.      If oldCursorCross then DrawMouseCross(oldMovePt,pmNotXor);
  3148.  
  3149.      if Assigned(FAfterPaint) then
  3150.         FAfterPaint(Self,sCent.x,sCent.y,dRect);
  3151. end;
  3152. end;
  3153.  
  3154. procedure TALCustomImageView.PasteFromClipboard;
  3155. begin
  3156.  
  3157. end;
  3158.  
  3159. procedure TALCustomImageView.PasteSpecial;
  3160. begin
  3161.  
  3162. end;
  3163.  
  3164. procedure TALCustomImageView.pChange(Sender: TObject);
  3165. begin
  3166.  
  3167. end;
  3168.  
  3169. procedure TALCustomImageView.PixelToCentrum(x, y: integer);
  3170. begin
  3171.  
  3172. end;
  3173.  
  3174. procedure TALCustomImageView.RestoreOriginal;
  3175. begin
  3176.  
  3177. end;
  3178.  
  3179. procedure TALCustomImageView.SaveAsOriginal;
  3180. begin
  3181.  
  3182. end;
  3183.  
  3184. function TALCustomImageView.SaveToFile(FileName: TFileName): boolean;
  3185. begin
  3186.  
  3187. end;
  3188.  
  3189. function TALCustomImageView.ScreenRectToWorld(R: TRect): TRect;
  3190. begin
  3191.  
  3192. end;
  3193.  
  3194. procedure TALCustomImageView.SelToScreen;
  3195. begin
  3196.  
  3197. end;
  3198.  
  3199. procedure TALCustomImageView.SetBackColor(const Value: TColor);
  3200. begin
  3201.  
  3202. end;
  3203.  
  3204. procedure TALCustomImageView.SetBackCross(const Value: boolean);
  3205. begin
  3206.  
  3207. end;
  3208.  
  3209. procedure TALCustomImageView.SetBulbRadius(const Value: integer);
  3210. begin
  3211.  
  3212. end;
  3213.  
  3214. procedure TALCustomImageView.SetCentered(const Value: boolean);
  3215. begin
  3216.  
  3217. end;
  3218.  
  3219. procedure TALCustomImageView.SetCentralCross(const Value: boolean);
  3220. begin
  3221.  
  3222. end;
  3223.  
  3224. procedure TALCustomImageView.SetCursorCross(const Value: boolean);
  3225. begin
  3226.  
  3227. end;
  3228.  
  3229. procedure TALCustomImageView.SetFileName(const Value: TFileName);
  3230. begin
  3231.  
  3232. end;
  3233.  
  3234. procedure TALCustomImageView.SetImageSource(const Value: TALImageSource);
  3235. begin
  3236.   FImageSource := Value;
  3237.   invalidate;
  3238. end;
  3239.  
  3240. procedure TALCustomImageView.SetOverMove(const Value: boolean);
  3241. begin
  3242.  
  3243. end;
  3244.  
  3245. procedure TALCustomImageView.SetPixelColor(p: TPoint; Co: TColor);
  3246. begin
  3247.  
  3248. end;
  3249.  
  3250. procedure TALCustomImageView.SetPixelGrid(const Value: boolean);
  3251. begin
  3252.  
  3253. end;
  3254.  
  3255. procedure TALCustomImageView.SetRGBList(const Value: TRGBChanel);
  3256. begin
  3257.  
  3258. end;
  3259.  
  3260. procedure TALCustomImageView.SetSelRectVisible(const Value: boolean);
  3261. begin
  3262.  
  3263. end;
  3264.  
  3265. procedure TALCustomImageView.SetZoom(const Value: extended);
  3266. begin
  3267. if FImageSource<>nil then
  3268.   if fZoom <> Value then begin
  3269.      // Limited zoom
  3270.      Sizes := Point(FImageSource.WorkBMP.Width,FImageSource.WorkBMP.Height);
  3271.      if Value>100 then fZoom:=100
  3272.      else
  3273.      if (Value*Sizes.x>8) and (Value*Sizes.y>8) then
  3274.          fZoom := Value;
  3275.      if Assigned(FChangeWindow) then
  3276.         FChangeWindow(Self,sCent.x,sCent.y,XToW(oldPos.x),YToW(oldPos.y),
  3277.                       Zoom,oldPos.x,oldPos.y);
  3278.      SelRectVisible := False;
  3279.      invalidate;
  3280.   end;
  3281. end;
  3282.  
  3283. procedure TALCustomImageView.ShiftWindow(x, y: double);
  3284. begin
  3285.  
  3286. end;
  3287.  
  3288. procedure TALCustomImageView.WMEraseBkGnd(var Message: TWMEraseBkGnd);
  3289. begin
  3290.  
  3291. end;
  3292.  
  3293. procedure TALCustomImageView.WMSize(var Msg: TWMSize);
  3294. begin
  3295.  
  3296. end;
  3297.  
  3298. function TALCustomImageView.WorldRectToScreen(R: TRect): TRect;
  3299. begin
  3300.  
  3301. end;
  3302.  
  3303. function TALCustomImageView.WToS(p: TPoint2d): TPoint;
  3304. begin
  3305.   Result := Point(XToS(p.x),YToS(p.y));
  3306. end;
  3307.  
  3308. function TALCustomImageView.XToS(x: double): integer;
  3309. begin
  3310.   Result := Round((Width/2) + Zoom*(x-newCent.x));
  3311. end;
  3312.  
  3313. function TALCustomImageView.XToW(x: integer): double;
  3314. begin
  3315.   Result := newCent.x + (x-(Width/2))/Zoom;
  3316. end;
  3317.  
  3318. function TALCustomImageView.YToS(y: double): integer;
  3319. begin
  3320.   Result := Round((Height/2) + Zoom*(y-newCent.y));
  3321. end;
  3322.  
  3323. function TALCustomImageView.YToW(y: integer): double;
  3324. begin
  3325.   Result := {-0.5 + }newCent.y + (y-(Height/2))/Zoom;
  3326. end;
  3327.  
  3328. procedure TALCustomImageView.wChange(Sender: TObject);
  3329. begin
  3330. //  RotateAngle := FRotateAngle;
  3331. end;
  3332.  
  3333. function TALCustomImageView.SToW(p: TPoint): TPoint2d;
  3334. begin
  3335.   Result := Point2d(XToW(p.x),YToW(p.y));
  3336. end;
  3337.  
  3338. { TALCustomRGBDiagram }
  3339.  
  3340. constructor TALCustomRGBDiagram.Create(AOwner: TComponent);
  3341. begin
  3342.   inherited;
  3343.   BMP:= TBitmap.Create;
  3344.   rgbMax.R := 0;
  3345.   rgbMax.G := 0;
  3346.   rgbMax.B := 0;
  3347.   FBackColor  := clWhite;
  3348.   FDotVisible := False;
  3349.   FPenWidth   := 1;
  3350.   FRColor := True;
  3351.   FGColor := True;
  3352.   FBColor := True;
  3353.   FRGBColor := False;
  3354.   Width   := 100;
  3355.   Height  := 100;
  3356. end;
  3357.  
  3358. destructor TALCustomRGBDiagram.Destroy;
  3359. begin
  3360.   BMP.Free;
  3361.   inherited;
  3362. end;
  3363.  
  3364. procedure TALCustomRGBDiagram.DrawGraph(SourceBMP: TBitmap;x,y,PixelWidth: integer);
  3365. // RGB Grafikon rajzolása
  3366. var i,x0,n,w,h: integer;
  3367.     dx: double;
  3368.     co: byte;
  3369.     szin: TColor;
  3370.     pixColor : TColor;
  3371.     xx,yy: integer;      // koordináta pontok a grafikonon
  3372.     Row: pPixelArray;
  3373.     lin: boolean;
  3374. begin
  3375. Try
  3376.   with BMP.Canvas do begin
  3377.        Brush.Color := FBackColor;
  3378.        FillRect(Cliprect);
  3379.        w := Cliprect.Right-Cliprect.Left;
  3380.        h := Cliprect.Bottom-Cliprect.Top;
  3381.  
  3382.        // koordináta vonalak és feliratok
  3383.        Pen.Color := clSilver;
  3384.        for i:=0 to 5 do begin
  3385.            yy := Round(h*(1-(50*i/255)));
  3386.            MoveTo(0,yy);
  3387.            LineTo(w,yy);
  3388.        end;
  3389.        Font.Name := 'Arial';
  3390.        Font.Size := 6;
  3391.        yy := Round(H*(1-(100/255)));
  3392.        TextOut(W div 2,yy,'100');
  3393.        yy := Round(H*(1-(200/255)));
  3394.        TextOut(W div 2,yy,'200');
  3395.        Pen.Color := clSilver;
  3396.        MoveTo(W div 2,0);
  3397.        LineTo(W div 2,H);
  3398.  
  3399.        if (SourceBMP<>nil) then begin
  3400.  
  3401.        if  FAlignToImage then begin
  3402.        x0 := x-PixelWidth;    // Eredeti képen a kezdőpont x
  3403.        n  := 2*PixelWidth+1;  // n darab pixelt kell vizsgálni
  3404.        dx := W/(2*PixelWidth+1);
  3405.        end else begin
  3406.        x0 := x-PixelWidth*Trunc(w/FZoomImage.Width);    // Eredeti képen a kezdőpont x
  3407.        n  := 2*PixelWidth*Trunc(w/FZoomImage.Width)+1;  // n darab pixelt kell vizsgálni
  3408.        dx := W/(2*PixelWidth+1);
  3409.        end;
  3410.  
  3411.        { Diagram rajzolás }
  3412.        Pen.Width := FPenWidth;
  3413.        for szin := 0 to 3 do begin
  3414.  
  3415.            Case szin of
  3416.            0: Pen.Color := clRed;
  3417.            1: Pen.Color := clGreen;
  3418.            2: Pen.Color := clBlue;
  3419.            3: begin
  3420.               Pen.Color := clBlack;
  3421.               Pen.Width := 2;
  3422.               end;
  3423.            end;
  3424.  
  3425.            if FRGBStatistic then begin
  3426.               i := Pen.Width;
  3427.               Pen.Width := 2;
  3428.            Case szin of
  3429.            0: begin
  3430.               yy := H-Trunc(H*(rgbMax.R/255));
  3431.               MoveTo(0,yy); LineTo(w,yy);
  3432.               end;
  3433.            1: begin
  3434.               yy := H-Trunc(H*(rgbMax.G/255));
  3435.               MoveTo(0,yy); LineTo(w,yy);
  3436.               end;
  3437.            2: begin
  3438.               yy := H-Trunc(H*(rgbMax.B/255));
  3439.               MoveTo(0,yy); LineTo(w,yy);
  3440.               end;
  3441.            end;
  3442.               Pen.Width := i;
  3443.            end;
  3444.  
  3445.            IF ((szin=0) and RColor) or ((szin=1) and GColor) or
  3446.               ((szin=2) and BColor) or ((szin=3) and RGBColor)
  3447.               then
  3448.            if (y>-1) and (y<SourceBMP.Height-1) then begin
  3449.  
  3450.               Row:=SourceBMP.ScanLine[y];
  3451.               lin := True;
  3452.  
  3453.               for i:=0 to n-1 do
  3454.               With Row[x0+i] DO
  3455.               begin
  3456.  
  3457.                    if ((x0+i)>-1) and ((x0+i)<SourceBMP.Width-1) then begin
  3458.  
  3459.                    Case szin of
  3460.                    0: co := rgbtRed;
  3461.                    1: co := rgbtGreen;
  3462.                    2: co := rgbtBlue;
  3463.                    end;
  3464.                    xx := Trunc( (dx/2)+i*dx );
  3465.                    if FRGBColor then begin
  3466.                       pixColor := RGB(rgbtRed,rgbtGreen,rgbtBlue);
  3467.                       yy := H-Trunc(H*(pixColor/(16581375)));
  3468.                    end
  3469.                    else
  3470.                       yy := H-Trunc(H*(co/255));
  3471.                    if FDotVisible then
  3472.                       ellipse(xx-2,yy-2,xx+2,yy+2);
  3473.                    if lin then begin
  3474.                       MoveTo(xx,yy);
  3475.                       lin := False;
  3476.                    end else
  3477.                       Lineto(xx,yy);
  3478.  
  3479.                    end;
  3480.  
  3481.               end;
  3482.            end;
  3483.  
  3484.        end;
  3485.  
  3486.        Pen.Color := clBlack;
  3487.        end;
  3488.   end;
  3489. finally
  3490.   Canvas.Draw(0,0,BMP);
  3491. end;
  3492. end;
  3493.  
  3494. (*
  3495. procedure TALCustomRGBDiagram.ImageChangeWindow(Sender: TObject; xCent,
  3496.   yCent, xWorld, yWorld, Zoom: double; MouseX, MouseY: integer);
  3497. begin
  3498.   Repaint;
  3499.      if FZoomImage<>nil then begin
  3500.      Try
  3501.         FZoomImage.OnChangeWindow := oldChangeWindow;
  3502.         FZoomImage.OnChangeWindow(Self,xCent,yCent,xWorld,yWorld,Zoom,MouseX,MouseY);
  3503.         FZoomImage.OnChangeWindow := ImageChangeWindow;
  3504.      except
  3505.         exit;
  3506.      End;
  3507.      end;
  3508.   inherited;
  3509. end;
  3510.  
  3511. procedure TALCustomRGBDiagram.ImageMouseDown(Sender: TObject; Button: TMouseButton;
  3512.   Shift: TShiftState; X, Y: Integer);
  3513. begin
  3514. //  FixLine := not FixLine;
  3515.   MouseX:=x; MouseY:=y;
  3516.   Repaint;
  3517.      if FZoomImage<>nil then begin
  3518.         FZoomImage.OnMouseDown := oldMouseDown;
  3519.         FZoomImage.MouseDown(Button,Shift,x,y);
  3520.         FZoomImage.OnMouseDown := ImageMouseDown;
  3521.      end;
  3522.   inherited;
  3523. end;
  3524.  
  3525. procedure TALCustomRGBDiagram.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  3526.   Y: Integer);
  3527. begin
  3528.      MouseY:=y;
  3529.      MouseX:=x;
  3530.  
  3531.      if FZoomImage<>nil then begin
  3532.         FZoomImage.OnMouseMove := oldMouseMove;
  3533.         FZoomImage.MouseMove(Shift,x,y);
  3534.         FZoomImage.OnMouseMove := ImageMouseMove;
  3535.         Repaint;
  3536.      end;
  3537.  
  3538.      inherited;
  3539. end;
  3540. *)
  3541.  
  3542. procedure TALCustomRGBDiagram.Paint;
  3543. begin
  3544. if FZoomImage<>nil then begin
  3545.   BMP.Width := Width;
  3546.   BMP.Height := Height;
  3547.   if FixLine then
  3548.      MouseY:=FZoomImage.Height div 2;
  3549.      DrawGraph(FZoomImage.CopyBMP,Round(FZoomImage.XToW(WIDTH div 2)),
  3550.                                    Round(FZoomImage.YToW(MouseY)),
  3551.                                    Round(WIDTH/(2*FZoomImage.Zoom)));
  3552.   Canvas.MoveTo(MouseX,0);
  3553.   Canvas.LineTo(MouseX,Height);
  3554.   FZoomImage.Repaint;
  3555. end else
  3556.   DrawGraph(nil,0,0,0);
  3557.   inherited;
  3558. end;
  3559.  
  3560. procedure TALCustomRGBDiagram.ReadRGBStatistic;
  3561. begin
  3562.   rgbMax := GetRGBStatisticMax(fZoomImage.WorkBMP);
  3563. end;
  3564.  
  3565. procedure TALCustomRGBDiagram.ReDraw(x, y: integer);
  3566. begin
  3567.   MouseX := x;
  3568.   MouseY := y;
  3569.   Repaint;
  3570. end;
  3571.  
  3572. procedure TALCustomRGBDiagram.Resize;
  3573. begin
  3574.   BMP.Width := Width;
  3575.   BMP.Height := Height;
  3576.   inherited;
  3577. end;
  3578.  
  3579. procedure TALCustomRGBDiagram.SetAlignToImage(const Value: boolean);
  3580. begin
  3581.   FAlignToImage := Value;
  3582.   invalidate;
  3583. end;
  3584.  
  3585. procedure TALCustomRGBDiagram.SetBackColor(const Value: TColor);
  3586. begin
  3587.   FBackColor := Value;
  3588.   invalidate;
  3589. end;
  3590.  
  3591. procedure TALCustomRGBDiagram.SetBColor(const Value: boolean);
  3592. begin
  3593.   FBColor := Value;
  3594.   invalidate;
  3595. end;
  3596.  
  3597. procedure TALCustomRGBDiagram.SetDotVisible(const Value: boolean);
  3598. begin
  3599.   FDotVisible := Value;
  3600.   invalidate;
  3601. end;
  3602.  
  3603. procedure TALCustomRGBDiagram.SetGColor(const Value: boolean);
  3604. begin
  3605.   FGColor := Value;
  3606.   invalidate;
  3607. end;
  3608.  
  3609. procedure TALCustomRGBDiagram.SetPenWidth(const Value: integer);
  3610. begin
  3611.   FPenWidth := Value;
  3612.   invalidate;
  3613. end;
  3614.  
  3615. procedure TALCustomRGBDiagram.SetRColor(const Value: boolean);
  3616. begin
  3617.   FRColor := Value;
  3618.   invalidate;
  3619. end;
  3620.  
  3621. procedure TALCustomRGBDiagram.SetRGBColor(const Value: boolean);
  3622. begin
  3623.   FRGBColor := Value;
  3624.   invalidate;
  3625. end;
  3626.  
  3627. procedure TALCustomRGBDiagram.SetRGBStatistic(const Value: boolean);
  3628. begin
  3629.   FRGBStatistic := Value;
  3630.   if Value then ReadRGBStatistic;
  3631.   invalidate;
  3632. end;
  3633.  
  3634. procedure TALCustomRGBDiagram.SetZoomImage(const Value: TALCustomZoomImage);
  3635. begin
  3636.   FZoomImage := Value;
  3637. (*
  3638.   if FZoomImage<>nil then begin
  3639.      oldMouseDown := FZoomImage.OnMouseDown;
  3640.      oldMouseMove := FZoomImage.OnMouseMove;
  3641.      oldChangeWindow := FZoomImage.OnChangeWindow;
  3642.      FZoomImage.OnMouseDown := ImageMouseDown;
  3643.      FZoomImage.OnMouseMove := ImageMouseMove;
  3644.      FZoomImage.OnChangeWindow := ImageChangeWindow;
  3645.   end;
  3646. *)
  3647. end;
  3648.  
  3649. procedure TALCustomRGBDiagram.WMChange(var Msg: TMessage);
  3650. begin
  3651.    if ZoomImage<>nil then begin
  3652.       Repaint;
  3653.    end;
  3654.   inherited;
  3655. end;
  3656.  
  3657. procedure TALCustomRGBDiagram.WMEraseBkGnd(var Message: TWMEraseBkGnd);
  3658. begin
  3659.   Message.Result := 1
  3660. end;
  3661.  
  3662. procedure TALCustomRGBDiagram.WMMouseMove(var Msg: TMessage);
  3663. begin
  3664.    if ZoomImage<>nil then begin
  3665.       Repaint;
  3666.    end;
  3667.   inherited;
  3668. end;
  3669.  
  3670. { TALCustomRGBDiagram3D }
  3671.  
  3672. constructor TALCustomRGBDiagram3D.Create(AOwner: TComponent);
  3673. begin
  3674.   inherited;
  3675.  
  3676. end;
  3677.  
  3678. destructor TALCustomRGBDiagram3D.Destroy;
  3679. begin
  3680.   inherited;
  3681.  
  3682. end;
  3683.  
  3684. procedure TALCustomRGBDiagram3D.DrawGraph(SourceBMP: TBitmap; x, y,
  3685.   PixelWidth: integer);
  3686. begin
  3687.  
  3688. end;
  3689.  
  3690. procedure TALCustomRGBDiagram3D.Paint;
  3691. begin
  3692.   inherited;
  3693. end;
  3694.  
  3695. procedure TALCustomRGBDiagram3D.SetBackColor(const Value: TColor);
  3696. begin
  3697.   FBackColor := Value;
  3698. end;
  3699.  
  3700. procedure TALCustomRGBDiagram3D.SetZoomImage(
  3701.   const Value: TALCustomZoomImage);
  3702. begin
  3703.   FZoomImage := Value;
  3704. end;
  3705.  
  3706. (*
  3707. { TALCustomAstroImage }
  3708.  
  3709. constructor TALCustomAstroImage.Create(AOwner: TComponent);
  3710. begin
  3711.   inherited;
  3712.   StarList := TStarList.Create;
  3713.   FStarBrush := TBrush.Create;
  3714.   with FStarBrush do begin
  3715.        Color := clLime;
  3716.        Style := bsClear;
  3717.   end;
  3718. end;
  3719.  
  3720. destructor TALCustomAstroImage.Destroy;
  3721. begin
  3722.   FStarBrush.Free;
  3723.   StarList.Free;
  3724.   inherited;
  3725. end;
  3726.  
  3727. function TALCustomAstroImage.StarDetect: integer;
  3728. begin
  3729.   result := AutomaticStarDetection(WorkBMP);
  3730.   invalidate;
  3731. end;
  3732.  
  3733. function TALCustomAstroImage.PrecizeStarDetect: integer;
  3734. begin
  3735.  
  3736. end;
  3737.  
  3738. procedure TALCustomAstroImage.SetImageVisible(const Value: boolean);
  3739. begin
  3740.   FImageVisible := Value;
  3741.   invalidate;
  3742. end;
  3743.  
  3744. procedure TALCustomAstroImage.SetStarBrush(const Value: TBrush);
  3745. begin
  3746.   FStarBrush := Value;
  3747.   invalidate;
  3748. end;
  3749.  
  3750. procedure TALCustomAstroImage.SetStarVisible(const Value: boolean);
  3751. begin
  3752.   FStarVisible := Value;
  3753.   invalidate;
  3754. end;
  3755. *)
  3756. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!