unawinclasses.pas

Voice Commnucation Components for Delphi

  cf.lpTemplateName := nil;
  cf.hInstance := 0;
  cf.lpszStyle := nil;
  cf.nFontType := SCREEN_FONTTYPE;
  cf.nSizeMin := sizeMin;
  cf.nSizeMin := sizeMax;
  result := unaWinClasses.ChooseFont(cf);
end;

// --  --
constructor unaWinFont.create(const face: string; h, w, escapement,
  orientation, weight: int; italic, underline, strikeout: bool; charset,
  precision, clipPrecision, quality, pitchAndFamily: unsigned);
begin
  inherited create();
  //
  f_font := CreateFont(h, w, escapement, orientation, weight, unsigned(italic), unsigned(underline), unsigned(strikeout), charset, precision, clipPrecision, quality, pitchAndFamily, pChar(face));
  if (nil <> g_winFonts) then
    g_winFonts.add(self);
end;

// --  --
constructor unaWinFont.createIndirect(const font: LOGFONT);
begin
  inherited create();
  //
  f_font := CreateFontIndirect(font);
  //
  if (nil <> g_winFonts) then
    g_winFonts.add(self);
end;

// --  --
destructor unaWinFont.destroy();
begin
  if (nil <> g_winFonts) then
    g_winFonts.removeItem(self);
  //
  inherited;
  //
  DeleteObject(f_font);
end;

{ unaWinWindow }

// --  --
procedure unaWinWindow.addChild(child: unaWinWindow);
begin
  if (enter(1000)) then begin
    try
      if (0 > f_children.locate(child)) then
	f_children.add(child);
	child.f_notifyParent := self;
    finally
      leave();
    end;
  end;
end;

// --  --
constructor unaWinWindow.create(const params: unaWinCreateParams);
begin
  inherited create();
  //
  f_gate := unaInProcessGate.create({$IFDEF DEBUG}className + '(f_gate)'{$ENDIF});
  f_children := unaList.create(false, {$IFDEF DEBUG}className + '(f_children)'{$ENDIF});
  //
  f_createParams := params;
  // create the window
  if (initWindow()) then
    getHandle();
end;

// --  --
constructor unaWinWindow.create(wndClass: unaWinClass; font: unaWinFont; const caption: string; parent: hWnd; style, exStyle: unsigned; x, y, w, h: int; menu: hMenu; instance: hModule; icon: hIcon);
var
  params: unaWinCreateParams;
begin
  if (nil = wndClass) then
    wndClass := getClass('', false, 0, 0, 0, 0, COLOR_WINDOW + 1, 0, instance);
  //
  params.r_class := wndClass;
  if (nil = font) then
    //if (nil <> parent) then
      //params.r_font := parent.font
    //else
      params.r_font := unaWinFont.create()
  else
    params.r_font := font;
  //
  params.r_caption := caption;
  params.r_style := style;
  params.r_exStyle := exStyle;
  params.r_x := x;
  params.r_y := y;
  params.r_width := w;
  params.r_height := h;
  params.r_menu := menu;
  params.r_icon := icon;
  //
  params.r_parentIsHandle := true;
  params.r_winParent := parent;
  //
  create(params);
end;

// --  --
constructor unaWinWindow.createStdWnd(const className, caption: string; parent: unaWinWindow; style, exStyle: unsigned; x, y, w, h: int; id: unsigned);
var
  params: unaWinCreateParams;
begin
  params.r_class := getClass(className, true);
  //
  params.r_font := parent.font;
  params.r_caption := caption;
  params.r_style := style;
  params.r_exStyle := exStyle;
  params.r_x := x;
  params.r_y := y;
  params.r_width := w;
  params.r_height := h;
  params.r_menu := id;
  params.r_icon := 0;
  params.r_parentIsHandle := false;
  params.r_unaParent := parent;
  //
  create(params);
end;

// --  --
function unaWinWindow.createWindow(): hWnd;
begin
  result := doCreateWindow();
end;

// --  --
destructor unaWinWindow.destroy();
begin
  inherited;
  //
  if (nil <> f_notifyParent) then
    f_notifyParent.removeChild(self);
  //
  while (f_children.count > 0) do
    unaWinWindow(f_children[0]).free();
  //
  destroyWindow();
  //
  freeAndNil(f_gate);
end;

// --  --
procedure unaWinWindow.destroyWindow();
begin
  if (0 <> f_handle) then begin
    //
    if (Windows.DestroyWindow(f_handle)) then
      f_handle := 0;
  end;    
end;

// --  --
function unaWinWindow.doCreateWindow(): hWnd;
var
  style: unsigned;
  vis: bool;
begin
  if (0 = f_handle) then begin
    //
    style := f_createParams.r_style;
    vis := (0 <> (WS_VISIBLE and style));
    f_createParams.r_style := style and not WS_VISIBLE;
    f_handle := unaCreateWindow(self);
    //
    if (0 <> f_handle) then begin
      result := f_handle;
      //
      style := f_createParams.r_class.f_wndClass.style;
      f_isCommonDC := ((0 = (CS_CLASSDC and style)) and
		       (0 = (CS_OWNDC and style)) and
		       (0 = (CS_PARENTDC and style)));
      if (not isCommonDC) then
	Self.f_dc := getDC();
      //
      setAnchors();
      //
      if (not f_createParams.r_class.isCommon) then
	setText(pChar(f_createParams.r_caption));
      //
      setFont(f_createParams.r_font);
      //
      if (0 <> f_createParams.r_icon) then
	sendMessage(WM_SETICON, ICON_BIG, int(f_createParams.r_icon));
      //
      if (nil <> unaParent) then begin
	//
	unaParent.addChild(self);
	//
	SetClassLong(wnd, GCL_HBRBACKGROUND, unaParent.winClass.f_wndClass.hbrBackground);
      end;
      //
      if (vis) then begin
	//
	if (0 = f_winListIndex) then	// if main window
	  show(SW_SHOWDEFAULT)
	else
	  show(SW_SHOWNORMAL);
	//  
      end;
      //
      GetWindowRect(wnd, f_sizeRect);
      ScreenToClient(getParent(), f_sizeRect.topLeft);
      ScreenToClient(getParent(), f_sizeRect.bottomRight);
      //
      f_rect := f_sizeRect;
    end
    else
      result := 0;
  end
  else
    result := f_handle;
end;

// --  --
function unaWinWindow.enable(doEnable: bool): unaWinWindow;
begin
  EnableWindow(wnd, doEnable);
  result := self;
end;

// --  --
function unaWinWindow.endModal(modalResult: int): unaWinWindow;
begin
  f_modalResult := modalResult;
  result := self;
end;

// --  --
function unaWinWindow.enter(timeout: unsigned): bool;
begin
  result := f_gate.enter(timeout{$IFDEF DEBUG}, className{$ENDIF});
end;

// --  --
function unaWinWindow.getCreateParams(): punaWinCreateParams;
begin
  result := @f_createParams;
end;

// --  --
function unaWinWindow.getDC(clipRgn: hRGN; flags: unsigned; wnd: int): hDC;
var
  rwnd: hWnd;
begin
  result := 0;
  //
  if (-1 = wnd) then begin
    //
    if (not isCommonDC) then
      result := deviceContext;
    //
    rwnd := getHandle();
  end
  else
    rwnd := unsigned(wnd);
  //
  if (0 = result) then begin
    //
    if (0 = clipRgn) then
      result := Windows.GetDC(rwnd)	// do not remove Windows. here !!
    else
      result := Windows.GetDCEx(rwnd, clipRgn, flags);
  end;    
  //
  f_lastDC := result;
end;

// --  --
function unaWinWindow.getFont(): unaWinFont;
begin
  result := f_createParams.r_font;
end;

// --  --
function unaWinWindow.getHandle(): hWnd;
begin
  result := createWindow();
end;

// --  --
function unaWinWindow.getHeight(): int;
begin
  result := f_rect.Bottom - f_rect.Top;
end;

// --  --
function unaWinWindow.getLeft(): int;
begin
  result := f_rect.Left;
end;

// --  --
function unaWinWindow.getParent(): hWnd;
begin
  if (f_createParams.r_parentIsHandle) then begin
    result := f_createParams.r_winParent;
  end
  else
    if (nil <> f_createParams.r_unaParent) then
      result := unaWinWindow(f_createParams.r_unaParent).wnd
    else
      result := 0;
  //
  if (0 = result) then
    result := getDesktopWindow();
end;

// --  --
function unaWinWindow.getText(): string;
var
  len: unsigned;
begin
  len := getTextLength();
  setLength(result, len);
  //
  if (0 < len) then
    GetWindowText(wnd, @result[1], len + 1);
end;

// --  --
function unaWinWindow.getTextLength(): int;
begin
  result := GetWindowTextLength(wnd);
  //
  if (0 > result) then
    result := 0;
end;

// --  --
function unaWinWindow.getTop(): int;
begin
  result := f_rect.Top;
end;

// --  --
function unaWinWindow.getUnaParent(): unaWinWindow;
begin
  if (not f_createParams.r_parentIsHandle) then
    result := f_createParams.r_unaParent as unaWinWindow
  else
    result := nil;
end;

// --  --
function unaWinWindow.getWidth(): int;
begin
  result := f_rect.Right - f_rect.Left;
end;

// --  --
function unaWinWindow.getWndClass(): unaWinClass;
begin
  result := f_createParams.r_class;
end;

// --  --
function unaWinWindow.hasStyle(index: int): bool;
begin
  result := (0 <> (index and GetWindowLong(wnd, GWL_STYLE)));
end;

// --  --
procedure unaWinWindow.idle();
begin
  // nothing here
end;

// --  --
function unaWinWindow.initWindow(): bool;
begin
  result := true;
end;

// --  --
procedure unaWinWindow.leave();
begin
  f_gate.leave();
end;

// --  --
function unaWinWindow.messageBox(const text, caption: string; flags: unsigned): unsigned;
begin
  result := guiMessageBox(text, caption, flags or MB_ICONINFORMATION, wnd);
end;

// --  --
function unaWinWindow.notifyActivate(isActivate: bool): bool;
begin
  result := true;	// allow default processing
end;

// --  --
function unaWinWindow.notifyCreate(cs: pCREATESTRUCT): bool;
begin
  result := true;	// accept window creation
end;

// --  --
function unaWinWindow.notifyDestroy(): bool;
begin
  result := false;	// pass control to defProc
end;

// --  --
function unaWinWindow.onActivate(wayOfActivate: unsigned; window: hWnd): bool;
begin
  result := false;	// pass control to defProc
end;

// --  --
function unaWinWindow.onActivateApp(isActivate: bool; activeThreadId: unsigned): bool;
begin
  result := false;	// pass control to defProc
end;

// --  --
function unaWinWindow.onClick(button, x, y: word): bool;
begin
  result := false;	// pass control to defProc
end;

// --  --
function unaWinWindow.onClose(): bool;
begin
  show(SW_HIDE);
  //
  result := false;
end;

// --  --
function unaWinWindow.onCommand(cmd, wnd: int): bool;
begin
  if (assigned(f_wmCommand)) then
    result := (0 = f_wmCommand(self, cmd, wnd))
  else
    result := false;	// pass control to defProc
  //
  if (not result) then
    //
    f_modalResult := cmd and $FFFF;
end;

// --  --
function unaWinWindow.onCreate(cs: pCREATESTRUCT): int;
begin
  result := 0;	// indicate OK
end;

// --  --
function unaWinWindow.onDestroy(): bool;
begin
  f_modalResult := -1;
  result := false;	// pass control to defProc
end;

// --  --
function unaWinWindow.onEnterSizeMove(): bool;
begin
  result := false;	// pass control to defProc
end;

// --  --
function unaWinWindow.onGetDlgCode(): LRESULT;
begin
  result := 0;	// no special Dlg behavior
end;

// --  --
function unaWinWindow.onGetMinMaxInfo(infO: pMINMAXINFO): bool;
begin
  if (0 < f_minWidth) then
    info.ptMinTrackSize.X := f_minWidth;
  if (0 < f_minHeight) then
    info.ptMinTrackSize.Y := f_minHeight;
  //
  result := true;
end;

// --  --