unawinclasses.pas

Voice Commnucation Components for Delphi

function unaWinWindow.onGetText(buf: pChar; maxSize: unsigned): int;
begin
  result := -1;//length(strCopy(buf, f_caption, maxSize));
end;

// --  --
function unaWinWindow.onKeyDown(vkCode: unsigned; keyData: int): bool;
begin
  result := true;
end;

// --  --
function unaWinWindow.onMove(x, y: int): bool;
begin
  getWindowRect(wnd, f_rect);
  screenToClient(getParent(), f_rect.TopLeft);
  screenToClient(getParent(), f_rect.BottomRight);
  //
  result := false;
end;

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

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

// --  --
function unaWinWindow.onShow(isShow: bool; reason: unsigned): bool;
begin
  result := false;	// pass control to defProc
end;

// --  --
function unaWinWindow.onSize(action, height, width: unsigned): bool;
var
  i: unsigned;
  rect: TRECT;
  dh, dw: int;
begin
  case (action) of

    //
    SIZE_MINIMIZED: begin
      f_rect.Left := 0;
      f_rect.Top := 0;
      f_rect.Right := minWidth;
      f_rect.Bottom := minHeight;
      result := false;
    end;

    //
    SIZE_MAXIMIZED,
    SIZE_RESTORED: begin
      //
      GetWindowRect(wnd, rect);
      i := 0;
      dh := (rect.Bottom - rect.Top) - (f_sizeRect.Bottom - f_sizeRect.Top);
      dw := (rect.Right - rect.Left) - (f_sizeRect.Right - f_sizeRect.Left);
      while (i < f_children.count) do begin
	unaWinWindow(f_children.get(i)).parentResize(dw, dh);
	inc(i);
      end;
      //
      ScreenToClient(getParent(), rect.TopLeft);
      ScreenToClient(getParent(), rect.BottomRight);
      f_rect := rect;
      f_sizeRect := rect;
      update();
      result := false;
    end

    else
      result := false;

  end;
end;

// --  --
function unaWinWindow.parentResize(dw, dh: int): unaWinWindow;
var
  rect: TRECT;
  x, y, h, w: int;
begin
  if ((0 <> getParent()) and ((0 <> dw) or (0 <> dh))) then begin
    //
    GetWindowRect(wnd, rect);
    ScreenToClient(getParent(), rect.TopLeft);
    ScreenToClient(getParent(), rect.BottomRight);

    x := rect.Left;	// left anchor by default
    y := rect.Top;	// top anchor by default

    // BOTTOM:
    if (0 <> f_anchors and unaWinAnchor_BOTTOM) then
      if (0 = f_anchors and unaWinAnchor_TOP) then begin
	h := rect.Bottom - rect.Top;
	inc(y, dh);
      end
      else
	h := rect.Bottom - rect.Top + dh
    else
      h := rect.Bottom - rect.Top;

    // RIGTH:
    if (0 <> f_anchors and unaWinAnchor_RIGHT) then
      if (0 = f_anchors and unaWinAnchor_LEFT) then begin
	w := rect.Right - rect.Left;
	inc(x, dw);
      end
      else
	w := rect.Right - rect.Left + dw
    else
      w := rect.Right - rect.Left;

    //
    MoveWindow(wnd, x, y, w, h, true);
  end;
  result := self;
end;

// --  --
function unaWinWindow.postMessage(message: unsigned; wParam, lParam: int): bool;
begin
  result := Windows.PostMessage(wnd, message, wParam, lParam);
end;

// --  --
function unaWinWindow.processMessages(): unaWinWindow;
var
  msg: tagMSG;
begin
  repeat
    if (PeekMessage(msg, wnd, 0, 0, PM_REMOVE)) then

      if (not IsDialogMessage(wnd, msg)) then begin
	//
	TranslateMessage(msg);
	DispatchMessage(msg);
      end
      else

    else
      break;
  until (false);
  //
  result := self;
end;

// --  --
function unaWinWindow.redraw(): unaWinWindow;
begin
  RedrawWindow(wnd, nil, 0, RDW_ERASE + RDW_INVALIDATE);
  //
  result := self;
end;

// --  --
function unaWinWindow.releaseDC(dc: hDC): int;
var
  rdc: hDC;
begin
  if (not isCommonDC) then
    result := 1
  else begin
    if (0 = dc) then
      rdc := f_lastDC
    else
      rdc := dc;
    //
    result := Windows.ReleaseDC(wnd, rdc);
  end;
end;

// --  --
procedure unaWinWindow.removeChild(child: unaWinWindow);
begin
  f_children.removeItem(child);
end;

// --  --
function unaWinWindow.selectFont(dc: hDC): unsigned;
begin
  if (nil <> f_createParams.r_font) then
    result := SelectObject(dc, f_createParams.r_font.font)
  else
    result := 0;
end;

// --  --
function unaWinWindow.sendMessage(message: unsigned; wParam, lParam: int): int;
begin
  result := Windows.SendMessage(wnd, message, wParam, lParam);
end;

// --  --
function unaWinWindow.setAnchors(anchors: unsigned): unaWinWindow;
begin
  setFAnchors(anchors);
  result := self;
end;

// --  --
procedure unaWinWindow.setFAnchors(value: unsigned);
begin
  f_anchors := value;
end;

// --  --
procedure unaWinWindow.setFFont(value: unaWinFont);
begin
  f_createParams.r_font := value;
  //
  if ((nil <> value) and not isCommonDC) then
    postMessage(WM_SETFONT, int(value.font));
end;

// --  --
function unaWinWindow.setFocus(firstChild: bool): unaWinWindow;
begin
  if (firstChild) then
    if (0 < f_children.count) then
      result := f_children.get(0)
    else
      result := nil
  else
    result := self;
  //
  if (nil <> result) then
    Windows.SetFocus(result.wnd);
end;

// --  --
function unaWinWindow.setFont(font: unaWinFont): unaWinWindow;
begin
  setFFont(font);
  result := self;
end;

// --  --
procedure unaWinWindow.setHeight(value: int);
begin
  f_rect.Bottom := f_rect.Top + value;
  MoveWindow(wnd, f_rect.Left, f_rect.Top, getWidth(), getHeight(), true);
end;

// --  --
procedure unaWinWindow.setLeft(value: int);
var
  d: int;
begin
  d := value - f_rect.Left;
  f_rect.Left := value;
  inc(f_rect.Right, d);
  //
  MoveWindow(wnd, value, f_rect.Top, getWidth(), getHeight(), true);
end;

// --  --
procedure unaWinWindow.setMinHeight(value: int);
begin
  if (f_minHeight <> value) then begin
    //
    f_minHeight := value;
    if (height < value) then
      height := value;
  end;
end;

// --  --
procedure unaWinWindow.setMinWidth(value: int);
begin
  if (f_minWidth <> value) then begin
    //
    f_minWidth := value;
    if (width < value) then
      width := value;
  end;
end;

// --  --
function unaWinWindow.setText(const text: string): unaWinWindow;
begin
  SetWindowText(f_handle, pChar(text));
  result := self;
end;

// --  --
procedure unaWinWindow.setTop(value: int);
var
  d: int;
begin
  d := (value - f_rect.Top);
  f_rect.Top := value;
  inc(f_rect.Bottom, d);
  //
  MoveWindow(wnd, f_rect.Left, f_rect.Top, getWidth(), getHeight(), true);
end;

// --  --
procedure unaWinWindow.setWidth(value: int);
begin
  f_rect.Right := f_rect.Left + value;
  MoveWindow(wnd, f_rect.Left, f_rect.Top, getWidth(), getHeight(), true);
end;

// --  --
procedure unaWinWindow.setWinHandle(h: hWnd);
begin
  if (f_handle <> h) then begin
    //
    f_handle := h;
  end;
end;

// --  --
procedure unaWinWindow.setWinListIndex(i: int);
begin
  f_winListIndex := i;
  //
  if (not f_createParams.r_class.isCommon and (0 < f_handle)) then
    SetWindowLong(f_handle, 0, $19730000 + i);
end;

// --  --
function unaWinWindow.show(cmd: unsigned): unaWinWindow;
begin
  ShowWindow(wnd, cmd);
  result := self;
end;

// --  --
function unaWinWindow.showModal(cmd: unsigned = SW_SHOW): int;
var
  msg: tagMSG;
begin
  f_modalResult := 0;
  show(cmd).redraw().setFocus(true);
  //
  repeat
    if (PeekMessage(msg, wnd, 0, 0, PM_REMOVE)) then
      //
      case (msg.message) of

	WM_QUIT: begin
	  f_modalResult := -1;
	  break;	// WM_QUIT
	end;  

	else begin
	  if (not IsDialogMessage(wnd, msg)) then begin
	    //
	    TranslateMessage(msg);
	    DispatchMessage(msg);
	  end;
	end;
      end

    else begin
      idle();
      Sleep(10);
    end;
    //
  until (0 <> f_modalResult);
  //
  result := f_modalResult;
end;

// --  --
function unaWinWindow.textOut(const text: string; x, y: int; dc: hDC): bool;
var
  rdc: hDC;
begin
  if (0 < length(text)) then
    if (not isCommonDC) then begin
      if (0 = dc) then
	rdc := deviceContext
      else
	rdc := dc;
      //
      result := Windows.TextOut(rdc, x, y, pChar(text), length(text))
    end
    else begin
      if (0 = dc) then
	rdc := getDC()
      else
	rdc := dc;
      selectFont(rdc);
      result := Windows.TextOut(rdc, x, y, pChar(text), length(text));
      //
      if (0 = dc) then
	releaseDC();
    end
  else
    result := true;
end;

// --  --
function unaWinWindow.update(): unaWinWindow;
begin
  UpdateWindow(wnd);
  processMessages();
  //
  result := self;
end;

// --  --
function unaWinWindow.wndProc(message, wParam, lParam: int): int;
var
  dp: bool;
  i: int;
begin
  result := 0;
  //
  case (message) of

    WM_NCCREATE: begin
      //
      result := choice(notifyCreate(pointer(lParam)), unsigned(1), 0);
      dp := false;
    end;


    WM_NCDESTROY: begin
      //
      dp := not notifyDestroy();
      if (lockNonEmptyList(g_winList)) then begin
	//
	try
	  // need to update indexes of other windows
	  i := f_winListIndex + 1;
	  while (i < int(g_winList.count)) do begin
	    //
	    with (unaWinWindow(g_winList[i])) do begin
	      //
	      // NOTE: wnd here is NOT our wnd
	      setWinListIndex(i - 1);
	    end;
	    //
	    inc(i);
	  end;
	  //
	  g_winList.removeById(f_handle);
	  //
	finally
	  //
	  g_winList.unlock();
	end;
      end;
      //
      f_handle := 0;	// regardless of return value - remove the handle
    end;


    WM_NCACTIVATE: begin
      //
      result := choice(notifyActivate(0 <> wParam), int(1), 0);
      dp := (1 = result);
    end;


    WM_CREATE: begin
      //
      result := onCreate(pointer(lParam));
      dp := (0 = result);
    end;


    WM_DESTROY:
      dp := not onDestroy();


    WM_CLOSE:
      dp := onClose();


    WM_ACTIVATE:
      dp := not onActivate(wParam, lParam);


    WM