unawinclasses.pas

Voice Commnucation Components for Delphi

(*
	----------------------------------------------

	  unaWinClasses.pas
	  Windows classes

	----------------------------------------------
	  This source code cannot be used without
	  proper license granted to you as a private
	  person or an entity by the Lake of Soft, Ltd

	  Visit http://lakeofsoft.com/ for more information.

	  Copyright (c) 2001, 2005 Lake of Soft, Ltd
		     All rights reserved
	----------------------------------------------

	  created by:
		Lake, 19 Mar 2002

	  modified by:
		Lake, Mar 2002
		Lake, Jun-Dec 2002
		Lake, Jan-Dec 2003
		Lake, Jan-Mar 2004
		Lake, Oct 2005

	----------------------------------------------
*)

{$I unaDef.inc}

unit
  unaWinClasses;

interface

{DP:UNIT
  Contains classes used to build Windows GUI applications.
}

uses
  Windows, unaTypes, Messages, unaClasses
{$IFDEF __SYSUTILS_H_ }
  , Math
{$ENDIF}
  ;

resourcestring
  //
  rstr_caption_exit	= 'E&xit';
  rstr_caption_start	= '&Start';
  rstr_caption_stop	= 'S&top';

type

  //
  // -- unaWinClass --
  //
  {DP:CLASS
    This class encapsulates the Windows class object.
  }
  unaWinClass = class
  private
    f_classOwner: bool;
    f_wndClass: TWNDCLASSEX;
    f_name: pChar;
    f_atom: ATOM;
    f_isCommon: bool;
    // subclassing
    f_wasSubclassed: bool;
    f_subClassWnd: hWnd;
    f_oldClassWndProc: int;
  public
    {DP:METHOD
      Creates and registers new Windows class.
    }
    constructor create(const name: string = ''; style: unsigned = 0; icon: hIcon = 0; smallIcon: hIcon = 0; cursor: hCursor = 0; brBrush: hBrush = COLOR_WINDOW + 1; menuName: int = 0; instance: hModule = 0; force: bool = true);
    {DP:METHOD
      Creates and registers new "standard" Windows class, such as BUTTON, EDIT and so on.
    }
    constructor createStdClass(const name: string; instance: hModule = 0);
    destructor Destroy(); override;
    //
    {DP:METHOD
      Registers Windows class.
    }
    function registerClass(force: bool = true): ATOM;
    {DP:METHOD
      Unregisters Windows class.
    }
    procedure unregister();
    {DP:METHOD
      Returns atom received after registering of class. Registers class if necessary.
    }
    function getAtom(): ATOM;	// registers class if necessary
    {DP:METHOD
      Returns pointer on WNDCLASSEX structure corresponding to this class.
    }
    function getWndClass(): pWNDCLASSEX;
    {DP:METHOD
      Returns true if class is already registered.
    }
    class function classIsRegistered(const className: string; instance: hModule = 0): bool;
    // subclassing
    {DP:METHOD
      Subclasses the Windows class.
    }
    function createSubclass(mainWnd: hWnd; newWndProc: pointer): bool;
    {DP:METHOD
      Removes subclassing from the class.
    }
    procedure removeSubclass();
    {DP:METHOD
      Calls subclassed WndProc.
    }
    function callSubClassedWndProc(window: hWnd; message, wParam, lParam: int): int;
    {DP:METHOD
      Returns atom received after registering of class.
    }
    property atom: ATOM read f_atom;
    {DP:METHOD
      Returns true if this Windows class was subclassed. 
    }
    property subClassed: bool read f_wasSubclassed;
    {DP:METHOD
      Returns true if this Windows class is common or "standard" class (such as BUTTON, EDIT and so on).  
    }
    property isCommon: bool read f_isCommon;
    //
    property wndClass: TWNDCLASSEX read f_wndClass;
  end;

// for some reason this stuff is not included in Windows.pas

  PChooseFontA = ^TChooseFontA;
  PChooseFontW = ^TChooseFontW;
  PChooseFont = PChooseFontA;
  {$EXTERNALSYM tagCHOOSEFONTA}
  tagCHOOSEFONTA = packed record
    lStructSize: DWORD;
    hWndOwner: HWnd;            { caller's window handle }
    hDC: HDC;                   { printer DC/IC or nil }
    lpLogFont: PLogFontA;     { pointer to a LOGFONT struct }
    iPointSize: Integer;        { 10 * size in points of selected font }
    Flags: DWORD;               { dialog flags }
    rgbColors: COLORREF;        { returned text color }
    lCustData: LPARAM;          { data passed to hook function }
    lpfnHook: function(Wnd: HWND; Message: UINT; wParam: WPARAM; lParam: LPARAM): UINT stdcall;
				{ pointer to hook function }
    lpTemplateName: PAnsiChar;    { custom template name }
    hInstance: HINST;       { instance handle of EXE that contains
				  custom dialog template }
    lpszStyle: PAnsiChar;         { return the style field here
				  must be lf_FaceSize or bigger }
    nFontType: Word;            { same value reported to the EnumFonts
				  call back with the extra fonttype_
				  bits added }
    wReserved: Word;
    nSizeMin: Integer;          { minimum point size allowed and }
    nSizeMax: Integer;          { maximum point size allowed if
				  cf_LimitSize is used }
  end;
  {$EXTERNALSYM tagCHOOSEFONTW}
  tagCHOOSEFONTW = packed record
    lStructSize: DWORD;
    hWndOwner: HWnd;            { caller's window handle }
    hDC: HDC;                   { printer DC/IC or nil }
    lpLogFont: PLogFontW;     { pointer to a LOGFONT struct }
    iPointSize: Integer;        { 10 * size in points of selected font }
    Flags: DWORD;               { dialog flags }
    rgbColors: COLORREF;        { returned text color }
    lCustData: LPARAM;          { data passed to hook function }
    lpfnHook: function(Wnd: HWND; Message: UINT; wParam: WPARAM; lParam: LPARAM): UINT stdcall;
				{ pointer to hook function }
    lpTemplateName: PWideChar;    { custom template name }
    hInstance: HINST;       { instance handle of EXE that contains
				  custom dialog template }
    lpszStyle: PWideChar;         { return the style field here
				  must be lf_FaceSize or bigger }
    nFontType: Word;            { same value reported to the EnumFonts
				  call back with the extra fonttype_
				  bits added }
    wReserved: Word;
    nSizeMin: Integer;          { minimum point size allowed and }
    nSizeMax: Integer;          { maximum point size allowed if
				  cf_LimitSize is used }
  end;
  {$EXTERNALSYM tagCHOOSEFONT}
  tagCHOOSEFONT = tagCHOOSEFONTA;
  TChooseFontA = tagCHOOSEFONTA;
  TChooseFontW = tagCHOOSEFONTW;
  TChooseFont = TChooseFontA;

{$EXTERNALSYM ChooseFont}
function ChooseFont(var ChooseFont: TChooseFont): Bool; stdcall;
{$EXTERNALSYM ChooseFontA}
function ChooseFontA(var ChooseFont: TChooseFontA): Bool; stdcall;
{$EXTERNALSYM ChooseFontW}
function ChooseFontW(var ChooseFont: TChooseFontW): Bool; stdcall;

const
  {$EXTERNALSYM CF_SCREENFONTS}
  CF_SCREENFONTS = $00000001;
  {$EXTERNALSYM CF_PRINTERFONTS}
  CF_PRINTERFONTS = $00000002;
  {$EXTERNALSYM CF_BOTH}
  CF_BOTH = CF_SCREENFONTS OR CF_PRINTERFONTS;
  {$EXTERNALSYM CF_SHOWHELP}
  CF_SHOWHELP = $00000004;
  {$EXTERNALSYM CF_ENABLEHOOK}
  CF_ENABLEHOOK = $00000008;
  {$EXTERNALSYM CF_ENABLETEMPLATE}
  CF_ENABLETEMPLATE = $00000010;
  {$EXTERNALSYM CF_ENABLETEMPLATEHANDLE}
  CF_ENABLETEMPLATEHANDLE = $00000020;
  {$EXTERNALSYM CF_INITTOLOGFONTSTRUCT}
  CF_INITTOLOGFONTSTRUCT = $00000040;
  {$EXTERNALSYM CF_USESTYLE}
  CF_USESTYLE = $00000080;
  {$EXTERNALSYM CF_EFFECTS}
  CF_EFFECTS = $00000100;
  {$EXTERNALSYM CF_APPLY}
  CF_APPLY = $00000200;
  {$EXTERNALSYM CF_ANSIONLY}
  CF_ANSIONLY = $00000400;
  {$EXTERNALSYM CF_SCRIPTSONLY}
  CF_SCRIPTSONLY = CF_ANSIONLY;
  {$EXTERNALSYM CF_NOVECTORFONTS}
  CF_NOVECTORFONTS = $00000800;
  {$EXTERNALSYM CF_NOOEMFONTS}
  CF_NOOEMFONTS = CF_NOVECTORFONTS;
  {$EXTERNALSYM CF_NOSIMULATIONS}
  CF_NOSIMULATIONS = $00001000;
  {$EXTERNALSYM CF_LIMITSIZE}
  CF_LIMITSIZE = $00002000;
  {$EXTERNALSYM CF_FIXEDPITCHONLY}
  CF_FIXEDPITCHONLY = $00004000;
  {$EXTERNALSYM CF_WYSIWYG}
  CF_WYSIWYG = $00008000; { must also have CF_SCREENFONTS & CF_PRINTERFONTS }
  {$EXTERNALSYM CF_FORCEFONTEXIST}
  CF_FORCEFONTEXIST = $00010000;
  {$EXTERNALSYM CF_SCALABLEONLY}
  CF_SCALABLEONLY = $00020000;
  {$EXTERNALSYM CF_TTONLY}
  CF_TTONLY = $00040000;
  {$EXTERNALSYM CF_NOFACESEL}
  CF_NOFACESEL = $00080000;
  {$EXTERNALSYM CF_NOSTYLESEL}
  CF_NOSTYLESEL = $00100000;
  {$EXTERNALSYM CF_NOSIZESEL}
  CF_NOSIZESEL = $00200000;
  {$EXTERNALSYM CF_SELECTSCRIPT}
  CF_SELECTSCRIPT = $00400000;
  {$EXTERNALSYM CF_NOSCRIPTSEL}
  CF_NOSCRIPTSEL = $00800000;
  {$EXTERNALSYM CF_NOVERTFONTS}
  CF_NOVERTFONTS = $01000000;

{ these are extra nFontType bits that are added to what is returned to the
  EnumFonts callback routine }

  {$EXTERNALSYM SIMULATED_FONTTYPE}
  SIMULATED_FONTTYPE = $8000;
  {$EXTERNALSYM PRINTER_FONTTYPE}
  PRINTER_FONTTYPE = $4000;
  {$EXTERNALSYM SCREEN_FONTTYPE}
  SCREEN_FONTTYPE = $2000;
  {$EXTERNALSYM BOLD_FONTTYPE}
  BOLD_FONTTYPE = $0100;
  {$EXTERNALSYM ITALIC_FONTTYPE}
  ITALIC_FONTTYPE = $0200;
  {$EXTERNALSYM REGULAR_FONTTYPE}
  REGULAR_FONTTYPE = $0400;

  {$EXTERNALSYM OPENTYPE_FONTTYPE}
  OPENTYPE_FONTTYPE = $10000;
  {$EXTERNALSYM TYPE1_FONTTYPE}
  TYPE1_FONTTYPE = $20000;
  {$EXTERNALSYM DSIG_FONTTYPE}
  DSIG_FONTTYPE = $40000;

  {$EXTERNALSYM WM_CHOOSEFONT_GETLOGFONT}
  WM_CHOOSEFONT_GETLOGFONT = WM_USER + 1;
  {$EXTERNALSYM WM_CHOOSEFONT_SETLOGFONT}
  WM_CHOOSEFONT_SETLOGFONT = WM_USER + 101; { removed in 4.0 SDK }
  {$EXTERNALSYM WM_CHOOSEFONT_SETFLAGS}
  WM_CHOOSEFONT_SETFLAGS   = WM_USER + 102; { removed in 4.0 SDK }

// back to our business

type

  //
  // -- unaWinFont --
  //
  {DP:CLASS
    This class encapsulates the Windows font object.
  }
  unaWinFont = class
  private
    f_font: hFont;
  public
    {DP:METHOD
      Creates new Windows font. Usually you should not care about removing the font, this will be done automatically when program exits.
    }
    constructor create(const face: string = ''; h: int = 16; w: int = 6; escapement: int = 0; orientation: int = 0; weight: int = FW_LIGHT; italic: bool = false; underline: bool = false; strikeout: bool = false; charset: unsigned = DEFAULT_CHARSET; precision: unsigned = OUT_DEFAULT_PRECIS; clipPrecision: unsigned = CLIP_DEFAULT_PRECIS; quality: unsigned = DEFAULT_QUALITY; pitchAndFamily: unsigned = VARIABLE_PITCH or FF_SWISS);
    {DP:METHOD
      Creates new Windows font. Usually you should not care about removing the font, this will be done automatically when program exits.
    }
    constructor createIndirect(const font: LOGFONT);
    {DP:METHOD
      Removes all resources used by this font object.
    }
    destructor Destroy(); override;
    {DP:METHOD
      Chooses a font. Displays font choose dialog. Returns true if used had successfully selected a font, or false otherwise.
    }
    class function chooseScreenFont(var font: LOGFONT; owner: hWnd = 0; dc: hDC = 0; flags: unsigned = CF_SCREENFONTS; sizeMin: unsigned = 0; sizeMax: unsigned = 0): bool;
    {DP:METHOD
      Windows font handle.
    }
    property font: hFont read f_font;
  end;

  //
  // -- unaWinWindow --
  //

const
  // child window position anchors
  // default is LEFT + TOP
  unawinAnchor_LEFT	= $0008;
  unaWinAnchor_RIGHT	= $0004;
  unaWinAnchor_TOP	= $0002;
  unaWinAnchor_BOTTOM	= $0001;

type
  punaWinCreateParams = ^unaWinCreateParams;
  unaWinCreateParams = record
    //
    r_class: unaWinClass;
    r_font: unaWinFont;
    r_caption: string;
    r_style: unsigned;
    r_exStyle: unsigned;
    r_x: int;
    r_y: int;
    r_width: int;
    r_height: int;
    r_menu: hMenu;
    r_icon: hIcon;
    case r_parentIsHandle: bool of
      true: (r_winParent: hWnd);
      false: (r_unaParent: tObject);
  end;

  tmessageEvent = function (sender: tObject; wParam, lParam: int): int of object;

  {DP:CLASS
    This class encapsulates Windows window object.
  }
  unaWinWindow = class
  private
    f_createParams: unaWinCreateParams;
    f_notifyParent: unaWinWindow;
    f_winListIndex: int;
    f_handle: hWnd;
    f_dc: hDC;
    f_lastDC: hDC;
    f_anchors: unsigned;
    f_rect: TRECT;
    f_sizeRect: TRECT;
    f_minWidth: int;
    f_minHeight: int;
    f_modalResult: int;
    //
    f_gate: unaInProcessGate;
    f_children: unaList;
    f_wmCommand: tmessageEvent;
    //
    procedure removeChild(child: unaWinWindow);
    function getWndClass(): unaWinClass;
    function getParent(): hWnd;
    procedure setWinHandle(h: hWnd);
    procedure setWinListIndex(i: int);
    function selectFont(dc: hDC): unsigned;
    function getFont(): unaWinFont;
    procedure setFFont(value: unaWinFont);
    procedure setFAnchors(value: unsigned);
    function getHeight(): int;
    function getLeft(): int;
    function getTop(): int;
    function getWidth(): int;
    procedure setHeight(value: int);
    procedure setLeft(value: int);
    procedure setTop(value: int);
    procedure setWidth(value: int);
    procedure setMinHeight(value: int);
    procedure setMinWidth(value: int);
    //
    function hasStyle(index: int): bool;
    function getUnaParent: unaWinWindow;
  protected
    f_isCommonDC: bool;
    //
    function initWindow(): bool; virtual;
    {DP:METHOD
      This is Windows WndProc routine.
    }
    function wndProc(message, wParam, lParam: int): int; virtual;
    {DP:METHOD
      WM_NCACTIVATE message handler.
    }
    function notifyActivate(isActivate: bool): bool; virtual;
    {DP:METHOD
      WM_NCCREATE message handler.
    }
    function notifyCreate(cs: pCREATESTRUCT): bool; virtual;
    {DP:METHOD
      WM_NCDESTROY message handler.
    }
    function notifyDestroy(): bool; virtual;
    {DP:METHOD
      WM_ACTIVATE message handler.
    }
    function onActivate(wayOfActivate: unsigned; window: hWnd): bool; virtual;
    {DP:METHOD
      WM_ACTIVATEAPP message handler.
    }
    function onActivateApp(isActivate: bool; activeThreadId: unsigned): bool; virtual;
    {DP:METHOD
      WM_COMMAND message handler.
    }
    function onCommand(cmd: int; wnd: int): bool; virtual;
    {DP:METHOD
      WM_CREATE message handler.
    }
    function onCreate(cs: pCREATESTRUCT): int; virtual;	// return 0 - OK, -1 - fail
    {DP:METHOD
      WM_DESTROY message handler.
    }
    function onDestroy(): bool; virtual;
    {DP:METHOD
      WM_ENTERSIZEMOVE message handler.
    }
    function onEnterSizeMove(): bool; virtual;
    {DP:METHOD
      WM_GETMINMAXINFO message handler.
    }
    function onGetMinMaxInfo(infO: pMINMAXINFO): bool;
    {DP:METHOD
      WM_GETTEXT message handler.
    }
    function onGetText(buf: pChar; maxSize: unsigned): int; virtual;	// return number of characted copied, or -1 to pass contol to defProc
    {DP:METHOD
      WM_MOVE message handler.
    }
    function onMove(x, y: int): bool; virtual;
    {
    }
    function onClick(button: Word; x, y: word): bool; virtual;
    {
    }
    function onKeyDown(vkCode: unsigned; keyData: int): bool; virtual;
    {DP:METHOD
      WM_PAINT message handler.
    }
    function onPaint(param: int): bool; virtual;
    {DP:METHOD
      WM_WINDOWPOSCHANGING message handler.
    }
    function onPosChange(pos: pWINDOWPOS): bool; virtual;
    {DP:METHOD
      WM_CLOSE message handler.
      Returns true, if window should be closed and destroyed.
      Our handler simply hides the window, not destroying it.
    }
    function onClose(): bool; virtual;
    {DP:METHOD
      WM_SHOW message handler.
    }
    function onShow(isShow: bool; reason: unsigned): bool; virtual;
    {DP:METHOD
      WM_SIZE message handler.
    }
    function onSize(action: unsigned; height, width: unsigned): bool; virtual;
    {