jclconsole.pas

East make Tray Icon in delphi

  end;
end;

procedure TJclScreenBuffer.DoResize(const NewWidth, NewHeight: Smallint);
var
  NewSize: TCoord;
begin
  NewSize.X := NewWidth;
  NewSize.Y := NewHeight;
  DoResize(NewSize);
end;

function TJclScreenBuffer.GetMode: TJclConsoleOutputModes;
var
  OutputMode: DWORD;
  AMode: TJclConsoleOutputMode;
begin
  Result := [];
  Win32Check(GetConsoleMode(FHandle, OutputMode));
  for AMode := Low(TJclConsoleOutputMode) to High(TJclConsoleOutputMode) do
    if (OutputMode and OutputModeMapping[AMode]) = OutputModeMapping[AMode] then
      Include(Result, AMode);
end;

procedure TJclScreenBuffer.SetMode(const Value: TJclConsoleOutputModes);
var
  OutputMode: DWORD;
  AMode: TJclConsoleOutputMode;
begin
  OutputMode := 0;
  for AMode := Low(TJclConsoleOutputMode) to High(TJclConsoleOutputMode) do
    if AMode in Value then
      OutputMode := OutputMode or OutputModeMapping[AMode];
  Win32Check(SetConsoleMode(FHandle, OutputMode));
end;

function TJclScreenBuffer.Write(const Text: string;
  const ATextAttribute: IJclScreenTextAttribute): DWORD;
begin
  if Assigned(ATextAttribute) then
    Font.TextAttribute := ATextAttribute.TextAttribute;
  Win32Check(WriteConsole(Handle, PChar(Text), Length(Text), Result, nil));
end;

function TJclScreenBuffer.Writeln(const Text: string;
  const ATextAttribute: IJclScreenTextAttribute): DWORD;
begin
  Result := Write(Text, ATextAttribute);
  Cursor.MoveTo(Window.Left, Cursor.Position.Y + 1);
end;

function TJclScreenBuffer.Write(const Text: string; const X, Y: Smallint;
  const ATextAttribute: IJclScreenTextAttribute): DWORD;
var
  I: Integer;
  Pos: TCoord;
  Attrs: array of Word;
begin
  if Length(Text) > 0 then
  begin
    if (X = -1) or (Y = -1) then
    begin
      Pos := Cursor.Position;
    end
    else
    begin
      Pos.X := X;
      Pos.Y := Y;
    end;

    if Assigned(ATextAttribute) then
    begin
      SetLength(Attrs, Length(Text));
      for I:=0 to Length(Text)-1 do
        Attrs[I] := ATextAttribute.TextAttribute;
      Result := Write(Text, X, Y, @Attrs[0]);
    end
    else
      Win32Check(WriteConsoleOutputCharacter(Handle, PChar(Text), Length(Text), Pos, Result));
  end
  else
    Result := 0;
end;

function TJclScreenBuffer.Write(const Text: string; const X, Y: Smallint;
  pAttrs: PWORD): DWORD;
var
  Pos: TCoord;
begin
  if (X = -1) or (Y = -1) then
  begin
    Pos := Cursor.Position;
  end
  else
  begin
    Pos.X := X;
    Pos.Y := Y;
  end;
  if pAttrs <> nil then
    Win32Check(WriteConsoleOutputAttribute(Handle, pAttrs, Length(Text), Pos, Result));
  Win32Check(WriteConsoleOutputCharacter(Handle, PChar(Text), Length(Text), Pos, Result));
end;

function TJclScreenBuffer.Write(const Text: string;
  const HorizontalAlign: TJclScreenBufferTextHorizontalAlign;
  const VerticalAlign: TJclScreenBufferTextVerticalAlign;
  const ATextAttribute: IJclScreenTextAttribute): DWORD;
var
  X, Y: Smallint;
begin
  case HorizontalAlign of
    //thaCurrent: X := Cursor.Position.X;
    thaLeft:
      X := Window.Left;
    thaCenter:
      X := Window.Left + (Window.Width - Length(Text)) div 2;
    thaRight:
      X := Window.Right - Length(Text) + 1;
  else
    X := Cursor.Position.X;
  end;
  case VerticalAlign of
    //tvaCurrent: Y := Cursor.Position.Y;
    tvaTop:
      Y := Window.Top;
    tvaCenter:
      Y := Window.Top + Window.Height div 2;
    tvaBottom:
      Y := Window.Bottom;
  else
    Y := Cursor.Position.Y;
  end;
  Result := Write(Text, X, Y, ATextAttribute);
end;

function TJclScreenBuffer.Read(const Count: Integer): string;
var
  ReadCount: DWORD;
begin
  SetLength(Result, Count);
  Win32Check(ReadConsole(Handle, PChar(Result), Count, ReadCount, nil));
  SetLength(Result, Min(ReadCount, StrLen(PChar(Result))));
end;

function TJclScreenBuffer.Readln: string;
begin
  Result := Read(Window.Right - Cursor.Position.X + 1);
end;

function TJclScreenBuffer.Read(X, Y: Smallint; const Count: Integer): string;
var
  ReadPos: TCoord;
  ReadCount: DWORD;
begin
  ReadPos.X := X;
  ReadPos.Y := Y;
  SetLength(Result, Count);
  Win32Check(ReadConsoleOutputCharacter(Handle, PChar(Result), Count, ReadPos, ReadCount));
  SetLength(Result, Min(ReadCount, StrLen(PChar(Result))));
end;

function TJclScreenBuffer.Readln(X, Y: Smallint): string;
begin
  Result := Read(X, Y, Window.Right - X + 1);
end;

procedure TJclScreenBuffer.Fill(const ch: Char; const ATextAttribute: IJclScreenTextAttribute);
var
  WriteCount: DWORD;
begin
  Cursor.MoveTo(0, 0);
  Win32Check(FillConsoleOutputCharacter(Handle, ch, Width * Height, Cursor.Position, WriteCount));
  if Assigned(ATextAttribute) then
    Win32Check(FillConsoleOutputAttribute(Handle, ATextAttribute.TextAttribute, Width * Height, Cursor.Position, WriteCount))
  else
    Win32Check(FillConsoleOutputAttribute(Handle, Font.TextAttribute, Width * Height, Cursor.Position, WriteCount));
end;

procedure TJclScreenBuffer.Clear;
begin
  Fill(' ', TJclScreenTextAttribute.Create(fclWhite, bclBlack, False, False, []));
end;

//=== { TJclScreenCustomTextAttribute } ======================================

constructor TJclScreenCustomTextAttribute.Create(const Attr: TJclScreenCustomTextAttribute);
begin
  inherited Create;
  if Assigned(Attr) then
    SetTextAttribute(Attr.GetTextAttribute);
end;

function TJclScreenCustomTextAttribute.GetColor: TJclScreenFontColor;
var
  TA: Word;
begin
  TA := TextAttribute and FontColorMask;
  for Result := High(TJclScreenFontColor) downto Low(TJclScreenFontColor) do
    if (TA and FontColorMapping[Result]) = FontColorMapping[Result] then
      Break;
end;

function TJclScreenCustomTextAttribute.GetBgColor: TJclScreenBackColor;
var
  TA: Word;
begin
  TA := TextAttribute and BackColorMask;
  for Result := High(TJclScreenBackColor) downto Low(TJclScreenBackColor) do
    if (TA and BackColorMapping[Result]) = BackColorMapping[Result] then
      Break;
end;

function TJclScreenCustomTextAttribute.GetHighlight: Boolean;
begin
  Result := (TextAttribute and FOREGROUND_INTENSITY) = FOREGROUND_INTENSITY;
end;

function TJclScreenCustomTextAttribute.GetBgHighlight: Boolean;
begin
  Result := (TextAttribute and BACKGROUND_INTENSITY) = BACKGROUND_INTENSITY;
end;

procedure TJclScreenCustomTextAttribute.SetColor(const Value: TJclScreenFontColor);
begin
  TextAttribute := (TextAttribute and (not FontColorMask)) or FontColorMapping[Value];
end;

procedure TJclScreenCustomTextAttribute.SetBgColor(const Value: TJclScreenBackColor);
begin
  TextAttribute := (TextAttribute and (not BackColorMask)) or BackColorMapping[Value];
end;

procedure TJclScreenCustomTextAttribute.SetHighlight(const Value: Boolean);
begin
  if Value then
    TextAttribute := TextAttribute or FOREGROUND_INTENSITY
  else
    TextAttribute := TextAttribute and (not FOREGROUND_INTENSITY);
end;

procedure TJclScreenCustomTextAttribute.SetBgHighlight(const Value: Boolean);
begin
  if Value then
    TextAttribute := TextAttribute or BACKGROUND_INTENSITY
  else
    TextAttribute := TextAttribute and (not BACKGROUND_INTENSITY);
end;

function TJclScreenCustomTextAttribute.GetStyle: TJclScreenFontStyles;
var
  ta: Word;
  AStyle: TJclScreenFontStyle;
begin
  Result := [];
  ta := TextAttribute and FontStyleMask;
  for AStyle := Low(TJclScreenFontStyle) to High(TJclScreenFontStyle) do
    if (ta and FontStyleMapping[AStyle]) = FontStyleMapping[AStyle] then
      Include(Result, AStyle);
end;

procedure TJclScreenCustomTextAttribute.SetStyle(const Value: TJclScreenFontStyles);
var
  ta: Word;
  AStyle: TJclScreenFontStyle;
begin
  ta := 0;
  for AStyle := Low(TJclScreenFontStyle) to High(TJclScreenFontStyle) do
    if AStyle in Value then
      ta := ta or FontStyleMapping[AStyle];
  TextAttribute := (TextAttribute and (not FontStyleMask)) or ta;
end;

procedure TJclScreenCustomTextAttribute.Clear;
begin
  TextAttribute := FontColorMapping[fclWhite] or BackColorMapping[bclBlack];
end;

//=== { TJclScreenFont } =====================================================

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

function TJclScreenFont.GetTextAttribute: Word;
begin
  Result := ScreenBuffer.Info.wAttributes;
end;

procedure TJclScreenFont.SetTextAttribute(const Value: Word);
begin
  Win32Check(SetConsoleTextAttribute(ScreenBuffer.Handle, Value));
end;

//=== { TJclScreenTextAttribute 0 ============================================

constructor TJclScreenTextAttribute.Create(const Attribute: Word);
begin
  inherited Create;
  FAttribute := Attribute;
end;

constructor TJclScreenTextAttribute.Create(const AColor: TJclScreenFontColor;
  const ABgColor: TJclScreenBackColor; const AHighLight, ABgHighLight: Boolean;
  const AStyle: TJclScreenFontStyles);
begin
  inherited Create;
  Color := AColor;
  BgColor := ABgColor;
  Highlight := AHighLight;
  BgHighlight := ABgHighLight;
  Style := AStyle;
end;

function TJclScreenTextAttribute.GetTextAttribute: Word;
begin
  Result := FAttribute;
end;

procedure TJclScreenTextAttribute.SetTextAttribute(const Value: Word);
begin
  FAttribute := Value;
end;

//=== { TJclScreenCharacter } ================================================

constructor TJclScreenCharacter.Create(const CharInfo: TCharInfo);
begin
  inherited Create;
  FCharInfo := CharInfo;
end;

function TJclScreenCharacter.GetCharacter: Char;
begin
  Result := FCharInfo.AsciiChar;
end;

procedure TJclScreenCharacter.SetCharacter(const Value: Char);
begin
  FCharInfo.AsciiChar := Value;
end;

function TJclScreenCharacter.GetTextAttribute: Word;
begin
  Result := FCharInfo.Attributes;
end;

procedure TJclScreenCharacter.SetTextAttribute(const Value: Word);
begin
  FCharInfo.Attributes := Value;
end;

//=== { TJclScreenCursor } ===================================================

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

function TJclScreenCursor.GetInfo: TConsoleCursorInfo;
begin
  Win32Check(GetConsoleCursorInfo(ScreenBuffer.Handle, Result));
end;

procedure TJclScreenCursor.SetInfo(const Value: TConsoleCursorInfo);
begin
  Win32Check(SetConsoleCursorInfo(ScreenBuffer.Handle, Value));
end;

function TJclScreenCursor.GetPosition: TCoord;
begin
  Result := ScreenBuffer.Info.dwCursorPosition;