jvcharmap.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvCharMap.PAS, released on 2003-11-03.

The Initial Developer of the Original Code is Peter Thornqvist <peter3 at sourceforge dot net>
Portions created by Peter Thornqvist are Copyright (c) 2003 Peter Thornqvist
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
* CharRange.Filter only works with contiguous ranges, so ufPrivateUse and ufSpecials
  only shows the first subrange

-----------------------------------------------------------------------------}
// $Id: JvCharMap.pas,v 1.41 2005/02/18 14:17:23 ahuser Exp $

unit JvCharMap;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$IFDEF MSWINDOWS}
  Windows, Messages,
  {$ENDIF MSWINDOWS}
  {$IFDEF VisualCLX}
  Qt, Types, QWindows,
  {$ENDIF VisualCLX}
  Classes, Graphics, Controls, Grids,
  JvComponent, JvExControls, JvExGrids;

type
  TJvCharMapValidateEvent = procedure(Sender: TObject; AChar: WideChar;
    var Valid: Boolean) of object;
  TJvCharMapSelectedEvent = procedure(Sender: TObject;
    AChar: WideChar) of object;
  TJvCharMapUnicodeFilter =
   (
    ufUndefined,
    ufBasicLatin,
    ufLatin1Supplement,
    ufLatinExtendedA,
    ufLatinExtendedB,
    ufIPAExtensions,
    ufSpacingModifierLetters,
    ufCombiningDiacriticalMarks,
    ufGreek,
    ufCyrillic,
    ufArmenian,
    ufHebrew,
    ufArabic,
    ufSyriac,
    ufThaana,
    ufDevanagari,
    ufBengali,
    ufGurmukhi,
    ufGujarati,
    ufOriya,
    ufTamil,
    ufTelugu,
    ufKannada,
    ufMalayalam,
    ufSinhala,
    ufThai,
    ufLao,
    ufTibetan,
    ufMyanmar,
    ufGeorgian,
    ufHangulJamo,
    ufEthiopic,
    ufCherokee,
    ufUnifiedCanadianAboriginalSyllabics,
    ufOgham,
    ufRunic,
    ufKhmer,
    ufMongolian,
    ufLatinExtendedAdditional,
    ufGreekExtended,
    ufGeneralPunctuation,
    ufSuperscriptsAndSubscripts,
    ufCurrencySymbols,
    ufCombiningMarksForSymbols,
    ufLetterlikeSymbols,
    ufNumberForms,
    ufArrows,
    ufMathematicalOperators,
    ufMiscellaneousTechnical,
    ufControlPictures,
    ufOpticalCharacterRecognition,
    ufEnclosedAlphanumerics,
    ufBoxDrawing,
    ufBlockElements,
    ufGeometricShapes,
    ufMiscellaneousSymbols,
    ufDingbats,
    ufBraillePatterns,
    ufCJKRadicalsSupplement,
    ufKangxiRadicals,
    ufIdeographicDescriptionCharacters,
    ufCJKSymbolsAndPunctuation,
    ufHiragana,
    ufKatakana,
    ufBopomofo,
    ufHangulCompatibilityJamo,
    ufKanbun,
    ufBopomofoExtended,
    ufEnclosedCJKLettersAndMonths,
    ufCJKCompatibility,
    ufCJKUnifiedIdeographsExtensionA,
    ufCJKUnifiedIdeographs,
    ufYiSyllables,
    ufYiRadicals,
    ufHangulSyllables,
    ufHighSurrogates,
    ufHighPrivateUseSurrogates,
    ufLowSurrogates,
    ufPrivateUse,
    ufCJKCompatibilityIdeographs,
    ufAlphabeticPresentationForms,
    ufArabicPresentationFormsA,
    ufCombiningHalfMarks,
    ufCJKCompatibilityForms,
    ufSmallFormVariants,
    ufArabicPresentationFormsB,
    ufSpecials,
    ufHalfwidthAndFullwidthForms,
    ufOldItalic,
    ufGothic,
    ufDeseret,
    ufByzantineMusicalSymbols,
    ufMusicalSymbols,
    ufMathematicalAlphanumericSymbols,
    ufCJKUnifiedIdeographsExtensionB,
    ufCJKCompatibilityIdeographsSupplement,
    ufTags
   );

  TJvCharMapRange = class(TPersistent)
  private
    FFilterStart: Cardinal;
    FFilterEnd: Cardinal;
    FStartChar: Cardinal;
    FEndChar: Cardinal;
    FOnChange: TNotifyEvent;
    FFilter: TJvCharMapUnicodeFilter;
    procedure SetFilter(const Value: TJvCharMapUnicodeFilter);
    procedure SetEndChar(const Value: Cardinal);
    procedure SetStartChar(const Value: Cardinal);
    procedure Change;
    procedure SetRange(AStart, AEnd: Cardinal);
    function GetEndChar: Cardinal;
    function GetStartChar: Cardinal;
  public
    constructor Create;
  published
    // Setting Filter to ufUndefined, resets StartChar and EndChar to their previous values
    property Filter: TJvCharMapUnicodeFilter read FFilter write SetFilter default ufUndefined;
    property StartChar: Cardinal read GetStartChar write SetStartChar default 33;
    property EndChar: Cardinal read GetEndChar write SetEndChar default 255;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  {$IFDEF VisualCLX}
  TJvExCustomDrawGrid = TJvExDrawGrid;
  {$ENDIF VisualCLX}

  {$IFDEF COMPILER6_UP}
  TJvCustomCharMap = class(TJvExCustomDrawGrid)
  {$ELSE}
  TJvCustomCharMap = class(TJvExCustomGrid)
  {$ENDIF COMPILER6_UP}
  private
    FCharPanel: TCustomControl;
    FShowZoomPanel: Boolean;
    FMouseIsDown: Boolean;
    FCharRange: TJvCharMapRange;
    FAutoSizeHeight: Boolean;
    FAutoSizeWidth: Boolean;
    FDrawing: Boolean;
    {$IFDEF VCL}
    FLocale: LCID;
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    FAutoSize: Boolean;
    {$ENDIF VisualCLX}
    FOnValidateChar: TJvCharMapValidateEvent;
    FShowShadow: Boolean;
    FShadowSize: Integer;
    FOnSelectChar: TJvCharMapSelectedEvent;
    FHighlightInvalid: Boolean;
    procedure SetCharRange(const Value: TJvCharMapRange);
    procedure SetPanelVisible(Value: Boolean);
    function GetCharacter: WideChar;
    function GetColumns: Integer;
    procedure SetColumns(Value: Integer);
    procedure SetShowZoomPanel(Value: Boolean);
    function GetPanelVisible: Boolean;
    procedure SetAutoSizeHeight(Value: Boolean);
    procedure SetAutoSizeWidth(Value: Boolean);
    {$IFDEF VCL}
    procedure SetLocale(const Value: LCID);
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    procedure SetAutoSize(Value: Boolean);
    {$ENDIF VisualCLX}
    procedure SetShowShadow(Value: Boolean);
    procedure SetShadowSize(Value: Integer);
    procedure SetHighlightInvalid(Value: Boolean);
  protected
    {$IFDEF VCL}
    // The locale to use when looking up character info and translating codepages to Unicode.
    // Only effective on non-NT OS's (NT doesn't use codepages)
    property Locale: LCID read FLocale write SetLocale default LOCALE_USER_DEFAULT;
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    property AutoSize: Boolean read FAutoSize write SetAutoSize;
    {$ENDIF VisualCLX}
    // The currently selected character
    property Character: WideChar read GetCharacter;
    // Shows/Hides the zoom panel
    property PanelVisible: Boolean read GetPanelVisible write SetPanelVisible stored False;
    // Determines whether the zoom panel is automatically shown when the user clicks a cell in the grid
    // To actually show the zoom panel, set PanelVisible := True at run-time (or click a cell in the grid)
    property ShowZoomPanel: Boolean read FShowZoomPanel write SetShowZoomPanel default True;

    // Determines whether the zoom panel has a shadow or not
    property ShowShadow: Boolean read FShowShadow write SetShowShadow default True;
    // Determines the number of pixels the shadow is offset from the zoom panel.
    // On W2k/XP and with D6+, the shadow is alpha blended (semi-transparent)
    property ShadowSize: Integer read FShadowSize write SetShadowSize default 2;

    // The range of characters to dispay in the grid
    property CharRange: TJvCharMapRange read FCharRange write SetCharRange;
    // Determines whether the width of the grid is auto adjusted to it' s content
    property AutoSizeWidth: Boolean read FAutoSizeWidth write SetAutoSizeWidth default False;
    // Determines whether the height of the grid is auto adjusted to it' s content
    property AutoSizeHeight: Boolean read FAutoSizeHeight write SetAutoSizeHeight default False;
    // The number of columns in the grid. Rows are adjusted automatically. Min. value is 1
    property Columns: Integer read GetColumns write SetColumns default 20;
    property HighlightInvalid: Boolean read FHighlightInvalid write SetHighlightInvalid default True;
    // Event that is called every time the grid needs to check if a character is valid.
    // If the character is invalid, it won't be drawn
    property OnValidateChar: TJvCharMapValidateEvent read FOnValidateChar write FOnValidateChar;
    // Event that is called every time the selection has changed
    property OnSelectChar: TJvCharMapSelectedEvent read FOnSelectChar write FOnSelectChar;
  protected
    procedure ShowCharPanel(ACol, ARow: Integer); virtual;
    procedure RecalcCells; virtual;
    procedure AdjustSize; reintroduce;
    {$IFDEF VCL}
    procedure CreateHandle; override;
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    procedure CreateWidget; override;
    {$ENDIF VisualCLX}
    procedure DrawCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    function DoMouseWheelDown(Shift: TShiftState;
      {$IFDEF VisualCLX} const {$ENDIF} MousePos: TPoint): Boolean; override;
    function DoMouseWheelUp(Shift: TShiftState;
      {$IFDEF VisualCLX} const {$ENDIF} MousePos: TPoint): Boolean; override;
    function InCharRange(AChar: WideChar): Boolean; virtual;
    function InGridRange(ACol, ARow: Integer): Boolean; virtual;
    function SelectCell(ACol, ARow: Longint): Boolean; override;

    function GetChar(ACol, ARow: Integer): WideChar; virtual;
    function GetCharInfo(ACol, ARow: Integer; InfoType: Cardinal): Cardinal; overload; virtual;
    function GetCharInfo(AChar: WideChar; InfoType: Cardinal): Cardinal; overload; virtual;
    function IsValidChar(AChar: WideChar): Boolean; virtual;
    {$IFDEF VCL}
    procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
    procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
    {$ENDIF VCL}

    procedure FontChanged; override;
    procedure DoRangeChange(Sender: TObject);
    procedure DoSelectChar(AChar: WideChar); virtual;
    function DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function CellSize: TSize;
    {$IFNDEF COMPILER6_UP}
    procedure MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
    {$ENDIF !COMPILER6_UP}
    procedure SetBounds(ALeft: Integer; ATop: Integer;
      AWidth: Integer; AHeight: Integer); override;
  end;

  TJvCharMap = class(TJvCustomCharMap)
  public
    property Character;
    property PanelVisible;
    {$IFDEF VCL}
    property Locale;
    {$ENDIF VCL}
  published
    property AutoSizeWidth;
    property AutoSizeHeight;
    property CharRange;
    property Col;
    property Columns;
    property HighlightInvalid;
    property Row;
    property ShowZoomPanel;
    property ShowShadow;
    property ShadowSize;

    property Align;
    property Anchors;
    {$IFDEF VCL}
    property BiDiMode;
    property DragCursor;
    property DragKind;
    property DragMode;
    property ParentBiDiMode;
    property OnEndDock;
    property OnStartDock;
    {$ENDIF VCL}
    property BorderStyle;
    property DoubleBuffered default True;
    property Color;
    property Constraints;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ScrollBars;
    property ShowHint;
    property TabOrder;
    property Visible;

    property OnValidateChar;
    property OnSelectChar;

    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    {$IFDEF VCL}
    {$IFDEF COMPILER6_UP}
    property OnTopLeftChanged;
    {$ENDIF COMPILER6_UP}
    {$ENDIF VCL}
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnStartDrag;
    property OnResize;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvCharMap.pas,v $';
    Revision: '$Revision: 1.41 $';
    Date: '$Date: 2005/02/18 14:17:23 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  SysUtils, Math, Forms,
  JvConsts;

const
  cShadowAlpha = 100;

type
  TCanvasAccessProtected = class(TCanvas);

  {$IFDEF MSWINDOWS}
  TShadowWindow = class(TJvCustomControl)
  private
    {$IFDEF VCL}
    procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
    {$ENDIF VCL}
  protected
    {$IFDEF VCL}
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateHandle; override;
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    procedure InitWidget; override;
    function WidgetFlags: Integer; override;
    {$ENDIF VisualCLX}
    procedure VisibleChanged; override;
  public
    property Visible default False;
    property Color default clBlack;
    constructor Create(AOwner: TComponent); override;
  end;
  {$ENDIF MSWINDOWS}

  TCharZoomPanel = class(TJvCustomControl)
  private
    {$IFDEF MSWINDOWS}
    FShadow: TShadowWindow;
    {$ENDIF MSWINDOWS}
    FCharacter: WideChar;
    FEndChar: Cardinal;
    {$IFDEF VCL}
    FOldWndProc: TWndMethod;
    FWasVisible: Boolean;
    {$ENDIF VCL}
    FShowShadow: Boolean;
    FShadowSize: Integer;