jclconsole.pas

East make Tray Icon in delphi

end;

procedure TJclScreenCursor.SetPosition(const Value: TCoord);
begin
  Win32Check(SetConsoleCursorPosition(ScreenBuffer.Handle, Value));
end;

function TJclScreenCursor.GetSize: TJclScreenCursorSize;
begin
  Result := Info.dwSize;
end;

procedure TJclScreenCursor.SetSize(const Value: TJclScreenCursorSize);
var
  NewInfo: TConsoleCursorInfo;
begin
  NewInfo := Info;
  NewInfo.dwSize := Value;
  Info := NewInfo;
end;

function TJclScreenCursor.GetVisible: Boolean;
begin
  Result := Info.bVisible;
end;

procedure TJclScreenCursor.SetVisible(const Value: Boolean);
var
  NewInfo: TConsoleCursorInfo;
begin
  NewInfo := Info;
  NewInfo.bVisible := Value;
  Info := NewInfo;
end;

procedure TJclScreenCursor.MoveTo(const DestPos: TCoord);
begin
  Position := DestPos;
end;

procedure TJclScreenCursor.MoveTo(const x, y: Smallint);
var
  DestPos: TCoord;
begin
  DestPos.X := x;
  DestPos.Y := y;
  MoveTo(DestPos);
end;

procedure TJclScreenCursor.MoveBy(const Delta: TCoord);
var
  DestPos: TCoord;
begin
  DestPos := Position;
  Inc(DestPos.X, Delta.X);
  Inc(DestPos.Y, Delta.Y);
  MoveTo(DestPos);
end;

procedure TJclScreenCursor.MoveBy(const cx, cy: Smallint);
var
  DestPos: TCoord;
begin
  DestPos := Position;
  Inc(DestPos.X, cx);
  Inc(DestPos.Y, cy);
  MoveTo(DestPos);
end;

//=== { TJclScreenWindow } ===================================================

constructor TJclScreenWindow.Create(const AScrBuf: TJclScreenBuffer);
begin
  inherited Create;
  FScreenBuffer := AScrBuf;
end;

function TJclScreenWindow.GetMaxConsoleWindowSize: TCoord;
begin
  Result := GetLargestConsoleWindowSize(ScreenBuffer.Handle);
end;

function TJclScreenWindow.GetMaxWindow: TCoord;
begin
  Result := ScreenBuffer.Info.dwMaximumWindowSize;
end;

procedure TJclScreenWindow.InternalSetPosition(const X, Y: SmallInt);
var
  NewRect: TSmallRect;
begin
  if (GetLeft <> X) or (GetTop <> Y) then
  begin
    NewRect.Left := X;
    NewRect.Top := Y;
    NewRect.Right:= NewRect.Left + Width - 1;
    NewRect.Bottom := NewRect.Top + Height - 1;
    DoResize(NewRect);
  end;
end;

procedure TJclScreenWindow.InternalSetSize(const X, Y: SmallInt);
var
  NewRect: TSmallRect;
begin
  if (Width <> X) or (Height <> Y) then
  begin
    NewRect.Left := Left;
    NewRect.Top := Top;
    NewRect.Right := NewRect.Left + X - 1;
    NewRect.Bottom := NewRect.Top + Y - 1;
    DoResize(NewRect);
  end;
end;

function TJclScreenWindow.GetLeft: Smallint;
begin
  Result := ScreenBuffer.Info.srWindow.Left;
end;

function TJclScreenWindow.GetRight: Smallint;
begin
  Result := ScreenBuffer.Info.srWindow.Right;
end;

function TJclScreenWindow.GetTop: Smallint;
begin
  Result := ScreenBuffer.Info.srWindow.Top;
end;

function TJclScreenWindow.GetBottom: Smallint;
begin
  Result := ScreenBuffer.Info.srWindow.Bottom;
end;

function TJclScreenWindow.GetWidth: Smallint;
begin
  Result := ScreenBuffer.Info.srWindow.Right - ScreenBuffer.Info.srWindow.Left + 1;
end;

function TJclScreenWindow.GetHeight: Smallint;
begin
  Result := ScreenBuffer.Info.srWindow.Bottom - ScreenBuffer.Info.srWindow.Top + 1;
end;

procedure TJclScreenWindow.SetLeft(const Value: Smallint);
begin
  InternalSetPosition(Value, Top);
end;

procedure TJclScreenWindow.SetRight(const Value: Smallint);
begin
  InternalSetSize(Value - Left + 1, Height);
end;

procedure TJclScreenWindow.SetTop(const Value: Smallint);
begin
  InternalSetPosition(Left, Value);
end;

procedure TJclScreenWindow.SetBottom(const Value: Smallint);
begin
  InternalSetSize(Width, Value - Top + 1);
end;

procedure TJclScreenWindow.SetWidth(const Value: Smallint);
begin
  InternalSetSize(Value, Height);
end;

procedure TJclScreenWindow.SetHeight(const Value: Smallint);
begin
  InternalSetSize(Width, Value);
end;

function TJclScreenWindow.GetPosition: TCoord;
begin
  Result.X := Left;
  Result.Y := Top;
end;

function TJclScreenWindow.GetSize: TCoord;
begin
  Result.X := Width;
  Result.Y := Height;
end;

procedure TJclScreenWindow.SetPosition(const Value: TCoord);
begin
  InternalSetPosition(Value.X, Value.Y);
end;

procedure TJclScreenWindow.SetSize(const Value: TCoord);
begin
  InternalSetSize(Value.X, Value.Y);
end;

procedure TJclScreenWindow.DoResize(const NewRect: TSmallRect; bAbsolute: Boolean);
begin
  Win32Check(SetConsoleWindowInfo(ScreenBuffer.Handle, bAbsolute, NewRect));
end;

procedure TJclScreenWindow.Scroll(const cx, cy: Smallint);
var
  Delta: TSmallRect;
begin
  Delta.Left := cx;
  Delta.Top := cy;
  Delta.Right := cx;
  Delta.Bottom := cy;
  DoResize(Delta, False);
end;

//=== { TJclInputBuffer } ====================================================

constructor TJclInputBuffer.Create(const AConsole: TJclConsole);
begin
  inherited Create;
  FConsole := AConsole;
  FHandle := CreateFile('CONIN$', GENERIC_READ or GENERIC_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
  Win32Check(INVALID_HANDLE_VALUE <> FHandle);
end;

destructor TJclInputBuffer.Destroy;
begin
  CloseHandle(FHandle);
  inherited Destroy;
end;

procedure TJclInputBuffer.Clear;
begin
  Win32Check(FlushConsoleInputBuffer(Handle));
end;

function TJclInputBuffer.GetMode: TJclConsoleInputModes;
var
  InputMode: DWORD;
  AMode: TJclConsoleInputMode;
begin
  Result := [];
  Win32Check(GetConsoleMode(Handle, InputMode));
  for AMode := Low(TJclConsoleInputMode) to High(TJclConsoleInputMode) do
    if (InputMode and InputModeMapping[AMode]) = InputModeMapping[AMode] then
      Include(Result, AMode);
end;

procedure TJclInputBuffer.SetMode(const Value: TJclConsoleInputModes);
var
  InputMode: DWORD;
  AMode: TJclConsoleInputMode;
begin
  InputMode := 0;
  for AMode := Low(TJclConsoleInputMode) to High(TJclConsoleInputMode) do
    if AMode in Value then
      InputMode := InputMode or InputModeMapping[AMode];
  Win32Check(SetConsoleMode(Handle, InputMode));
end;

procedure TJclInputBuffer.RaiseCtrlEvent(const AEvent: TJclInputCtrlEvent;
  const ProcessGroupId: DWORD);
const
  CtrlEventMapping: array [TJclInputCtrlEvent] of DWORD =
    (CTRL_C_EVENT, CTRL_BREAK_EVENT, CTRL_CLOSE_EVENT, CTRL_LOGOFF_EVENT, CTRL_SHUTDOWN_EVENT);
begin
  if AEvent in [ceCtrlC, ceCtrlBreak] then
    Win32Check(GenerateConsoleCtrlEvent(CtrlEventMapping[AEvent], ProcessGroupId))
  else
    raise EJclError.CreateResFmt(@RsCannotRaiseSignal,
      [GetEnumName(TypeInfo(TJclInputCtrlEvent), Integer(AEvent))]);
end;

function TJclInputBuffer.GetEventCount: DWORD;
begin
  Win32Check(GetNumberOfConsoleInputEvents(Handle, Result));
end;

function TJclInputBuffer.WaitEvent(const TimeOut: DWORD): Boolean;
begin
  Result := WaitForSingleObject(Handle, TimeOut) = WAIT_OBJECT_0;
end;

function TJclInputBuffer.GetEvents(var Events: TJclInputRecordArray): DWORD;
begin
  Win32Check(ReadConsoleInput(Handle, Events[0], Length(Events), Result));
end;

function TJclInputBuffer.PeekEvents(var Events: TJclInputRecordArray): DWORD;
begin
  if EventCount = 0 then
    Result := 0
  else
    Win32Check(PeekConsoleInput(Handle, Events[0], Length(Events), Result));
end;

function TJclInputBuffer.PutEvents(const Events: TJclInputRecordArray): DWORD;
begin
  Win32Check(WriteConsoleInput(Handle, Events[0], Length(Events), Result));
end;

function TJclInputBuffer.GetEvents(const Count: Integer): TJclInputRecordArray;
begin
  SetLength(Result, Count);
  SetLength(Result, GetEvents(Result));
end;

function TJclInputBuffer.PeekEvents(const Count: Integer): TJclInputRecordArray;
begin
  SetLength(Result, Count);
  SetLength(Result, PeekEvents(Result));
end;

function TJclInputBuffer.GetEvent: TInputRecord;
begin
  Result := GetEvents(1)[0];
end;

function TJclInputBuffer.PeekEvent: TInputRecord;
begin
  Result := PeekEvents(1)[0];
end;

function TJclInputBuffer.PutEvent(const Event: TInputRecord): Boolean;
var
  Evts: TJclInputRecordArray;
begin
  SetLength(Evts, 1);
  Evts[0] := Event;
  Result := PutEvents(Evts) = 1;
end;

// History:

// $Log: JclConsole.pas,v $
// Revision 1.16  2005/03/08 08:33:22  marquardt
// overhaul of exceptions and resourcestrings, minor style cleaning
//
// Revision 1.15  2005/03/04 06:40:26  marquardt
// changed overloaded constructors to constructor with default parameter (BCB friendly)
//
// Revision 1.14  2005/02/25 07:20:15  marquardt
// add section lines
//
// Revision 1.13  2005/02/24 16:34:52  marquardt
// remove divider lines, add section lines (unfinished)
//
// Revision 1.12  2004/10/17 21:00:14  mthoma
// cleaning
//
// Revision 1.11  2004/08/01 11:40:23  marquardt
// move constructors/destructors
//
// Revision 1.10  2004/07/29 07:58:21  marquardt
// inc files updated
//
// Revision 1.9  2004/05/13 04:23:21  rrossmair
// fixed TJclScreenWindow.InternalSetPosition; FPC-related changes
//
// Revision 1.8  2004/05/06 22:37:09  rrossmair
// contributor list updated
//
// Revision 1.7  2004/05/06 05:09:55  rrossmair
// Changes for FPC v1.9.4 compatibility
//
// Revision 1.6  2004/05/05 07:33:49  rrossmair
// header updated according to new policy: initial developers & contributors listed
//
// Revision 1.5  2004/04/06 04:55:17
// adapt compiler conditions, add log entry
//

end.