jvqcharmap.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{-----------------------------------------------------------------------------
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: JvQCharMap.pas,v 1.18 2005/02/06 14:06:01 asnepvangers Exp $

unit JvQCharMap;

{$I jvcl.inc}

interface

uses
  {$IFDEF MSWINDOWS}
  Windows, Messages,
  {$ENDIF MSWINDOWS} 
  Qt, Types, QWindows, 
  Classes, QGraphics, QControls, QGrids,
  JvQComponent, JvQExControls, JvQExGrids;

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;
 
  TJvExCustomDrawGrid = TJvExDrawGrid; 
 
  TJvCustomCharMap = class(TJvExCustomDrawGrid) 
  private
    FCharPanel: TCustomControl;
    FShowZoomPanel: Boolean;
    FMouseIsDown: Boolean;
    FCharRange: TJvCharMapRange;
    FAutoSizeHeight: Boolean;
    FAutoSizeWidth: Boolean;
    FDrawing: Boolean;  
    FAutoSize: Boolean; 
    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);  
    procedure SetAutoSize(Value: Boolean); 
    procedure SetShowShadow(Value: Boolean);
    procedure SetShadowSize(Value: Integer);
    procedure SetHighlightInvalid(Value: Boolean);
  protected  
    property AutoSize: Boolean read FAutoSize write SetAutoSize; 
    // 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;  
    procedure CreateWidget; override; 
    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;  const  MousePos: TPoint): Boolean; override;
    function DoMouseWheelUp(Shift: TShiftState;  const  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; 

    procedure FontChanged; override;
    procedure DoRangeChange(Sender: TObject);
    procedure DoSelectChar(AChar: WideChar); virtual;
    function DoPaintBackground(Canvas: TCanvas; Param: Integer): Boolean; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function CellSize: TSize; 
    procedure SetBounds(ALeft: Integer; ATop: Integer;
      AWidth: Integer; AHeight: Integer); override;
  end;

  TJvCharMap = class(TJvCustomCharMap)
  public
    property Character;
    property PanelVisible; 
  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; 
    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; 
    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;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  SysUtils, Math, QForms,
  JvQConsts;

const
  cShadowAlpha = 100;

type
  TCanvasAccessProtected = class(TCanvas);

  {$IFDEF MSWINDOWS}
  TShadowWindow = class(TJvCustomControl)
  private 
  protected  
    procedure InitWidget; override;
    function WidgetFlags: Integer; override; 
    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; 
    FShowShadow: Boolean;
    FShadowSize: Integer;
    procedure SetCharacter(const Value: WideChar); 
    procedure UpdateShadow;
    procedure SetShowShadow(const Value: Boolean);
    procedure SetShadowSize(const Value: Integer);
  protected
    procedure Paint; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override; 
    procedure DoEnter; override;
    procedure VisibleChanged; override;
    procedure FontChanged; override;
  
    procedure BoundsChanged; override; 
    procedure SetParent( const  AParent: TWinControl); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Character: WideChar read FCharacter write SetCharacter;
    property ShowShadow: Boolean read FShowShadow write SetShowShadow default True;
    property ShadowSize: Integer read FShadowSize write SetShadowSize;
  end;

procedure WideDrawText(Canvas: TCanvas; const Text: WideString; ARect: TRect;
  uFormat: Cardinal);
begin
  // (p3) TCanvasAccessProtected bit stolen from Troy Wolbrink's TNT controls (not that it makes any difference AFAICS)
  with TCanvasAccessProtected(Canvas) do
  begin
    Changing;
    RequiredState([csHandleValid, csFontValid, csBrushValid]); 
    DrawTextW(Handle, PWideChar(Text), Length(Text), ARect, uFormat);
    Changed;
  end;
end;

{$IFDEF MSWINDOWS}

//=== { TShadowWindow } ======================================================

type
  TDynamicSetLayeredWindowAttributes = function(HWnd: THandle; crKey: COLORREF; bAlpha: Byte; dwFlags: DWORD): Boolean; stdcall;



constructor TShadowWindow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csFixedHeight, csFixedWidth, csNoDesignVisible, csNoStdEvents];
  Color := clBlack;
  Visible := False;
end;


{$DEFINE NeedSetLayer}





procedure TShadowWindow.InitWidget;

var
  {$IFDEF NeedSetLayer}
  Wnd: Windows.HWND;
  {$ENDIF NeedSetLayer}
  DynamicSetLayeredWindowAttributes: TDynamicSetLayeredWindowAttributes;

  procedure InitProcs;
  const
    sUser32 = 'User32.dll';
  var
    ModH: HMODULE;
  begin
    ModH := GetModuleHandle(sUser32);
    if ModH <> 0 then
       @DynamicSetLayeredWindowAttributes := GetProcAddress(ModH, 'SetLayeredWindowAttributes')
    else
      @DynamicSetLayeredWindowAttributes := nil;
  end;

begin  
  inherited InitWidget; 
  {$IFDEF NeedSetLayer}
  InitProcs;
  if HandleAllocated and Assigned(DynamicSetLayeredWindowAttributes) then
  begin  
    Wnd := QWidget_winId(Handle);
    //SetWindowLong(h, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
    //SetWindowLong(h, GWL_STYLE, WS_POPUP); 
    SetWindowLong(Wnd, GWL_EXSTYLE, GetWindowLong(Wnd, GWL_EXSTYLE) or WS_EX_LAYERED);
    DynamicSetLayeredWindowAttributes(Wnd, 0, cShadowAlpha, LWA_ALPHA);
  end;
  {$ENDIF NeedSetLayer}
end;




function TShadowWindow.WidgetFlags: Integer;
begin
  Result :=
    Integer(WidgetFlags_WType_Popup) or         // WS_POPUPWINDOW
    Integer(WidgetFlags_WStyle_NoBorder) or
    Integer(WidgetFlags_WStyle_Tool);           // WS_EX_TOOLWINDOW
end;


procedure TShadowWindow.VisibleChanged;
begin
  inherited VisibleChanged;
  // make sure shadow is beneath zoom panel
  if Visible and (Parent <> nil) then
    SetWindowPos(Handle, TWinControl(Owner).Handle, 0, 0, 0, 0,
      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOOWNERZORDER);
end;

{$ENDIF MSWINDOWS}