[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 233
  • Last Modified:

Cursor is not showing

Dear Experts,

I have a little example on my site that works 100%. But I want to change the code to make a component out of it with anchor type: TCustomPanel.

My example is on my site: http://members.home.nl/peterkiers/
(underneath the Under Construction bar you see a floppy disk)

This is what I made myself, but the cursor is not
showing what do I do wrong? In the example a Timer
is used for the cursor, how can I declare the Timer in this code below with Enable = false, Interval =200 and
the name of the Timer is CursorFlashTimer.

unit MyDrawingPanel;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

const
  csrUnderLine = 0;
  csrEmptyBox = 1;
  cdDefault = $00;
  cdFieldAttr = $01;
  caDefault = $00;
  caProtect = $20;
  caNumeric = $10;
  caSelPen = $04;
  caIntens = $08;
  caNonDisp = $0C;
  caMDT = $01;
  ccDefault = $00;
  ccBlue = $F1;
  ccRed = $F2;
  ccPink = $F3;
  ccGreen = $F4;
  ccTurquoise = $F5;
  ccYellow = $F6;
  ccWhite = $F7;
  chDefault = $00;
  chBlink = $F1;
  chReverse = $F2;
  chUnderLine = $F4;
  csDefault = $00;
  csAPL = $F1;

type
  TScrCell = record
    Data: char;
    Attrib: char;
    Hilite: char;
    CharSet: char;
    Color: char;
    OldColor: char;
    IsOldColorSet: Boolean;
  end;

  TScrBuf = array[1..25, 1..80] of TScrCell;
  PScrBuf = ^TScrBuf;

  TCharSet = set of char;
  const ValidChars: TCharSet = ['A'..'Z', 'a'..'z', '0'..'9'];

type
  TMyDrawingPanel = class(TCustomPanel)
  private
    { Private declarations }
  Bounding: Boolean;
  fcursorVisible: boolean;
  AnchorX, AnchorY,
  CurX, CurY: Integer;
  SCRROWS: integer;
  SCRCOLS: integer;
  FontWidthPix: integer;
  FontHeightPix: integer;
  ScrBuf: TScrBuf;
  FontName: string;
  FontSize: integer;
  ColorRed: TColor;
  ColorGreen: TColor;
  ColorBlue: TColor;
  ColorYellow: TColor;
  ColorPink: TColor;
  ColorTurq: TColor;
  ColorWhite: TColor;
  ColorBlack: TColor;
  CsrCol: integer;
  CsrRow: integer;
  CsrShape: integer;
  CurCellColor: char;
  CurCellHilite: char;
  socOpen: boolean;
  LastcursorX, LastcursorY: integer;
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure ShowBuf;
    procedure DispCell(x: integer; y: integer; PaintBlanks: boolean);
    function ColorMapI2W(ic: char): TColor;
    procedure DrawCursor(x: integer; y: integer);

  published
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TMyDrawingPanel]);
end;

{ TMyDrawingPanel }

function TMyDrawingPanel.ColorMapI2W(ic: char): TColor;
begin
  if Byte(ic) = ccDefault then Result := ColorGreen
  else if Byte(ic) = ccBlue then Result := ColorBlue
  else if Byte(ic) = ccRed then Result := ColorRed
  else if Byte(ic) = ccPink then Result := ColorPink
  else if Byte(ic) = ccGreen then Result := ColorGreen
  else if Byte(ic) = ccYellow then Result := ColorYellow
  else if Byte(ic) = ccTurquoise then Result := ColorTurq
  else if Byte(ic) = ccWhite then Result := ColorWhite
  else Result := ColorGreen;
end;

constructor TMyDrawingPanel.Create(AOwner: TComponent);
var
  TxMetric: TTextMetric;
begin
  inherited Create (AOwner);
  SCRCOLS := 80;
  SCRROWS := 24;
  SocOpen := False;
  ColorRed := clRed;
  ColorGreen := clLime;
  ColorBlue := clBlue;
  ColorYellow := clYellow;
  ColorPink := clFuchsia;
  ColorTurq := clAqua;
  ColorWhite := clWhite;
  ColorBlack := clBlack;
  CurCellColor := Char(ccDefault);
  CurCellHilite := Char(chDefault);
  CsrShape := csrUnderLine;
  CsrRow := 1;
  CsrCol := 1;
  FontName := 'Terminal';
  FontSize := 9;
  Font.Size := FontSize;
  Font.Name := FontName;
end;

destructor TMyDrawingPanel.Destroy;
begin
  inherited;
//
end;

procedure TMyDrawingPanel.DispCell(x, y: integer; PaintBlanks: boolean);
var
  xpos, ypos: integer;
  r:TRect;
begin
  xpos := (x * FontWidthPix) - FontWidthPix;
  ypos := (y * FontHeightPix) - FontHeightPix;
  with Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := ColorBlack;
    if (ScrBuf[y, x].data = Char(cdDefault)) or
      (ScrBuf[y, x].data = Char(cdFieldAttr)) then
    begin
      if PaintBlanks then
      begin
        Font.Style := [];
        TextOut(xpos, ypos, ' ');
      end;
    end
    else
    begin
      if (Byte(ScrBuf[y, x].attrib) and caNonDisp) <> caNonDisp then
      begin
        Pen.Mode := pmCopy;
        Font.Color := ColorMapI2W(ScrBuf[y, x].color);
        if ScrBuf[y, x].hilite = Char(chDefault) then
          Font.Style := []
        else if ScrBuf[y, x].hilite = Char(chReverse) then
        begin
          Font.Style := [];
          Pen.Mode := pmXor;
          Brush.Color := ColorMapI2W(ScrBuf[y, x].color);
          Font.Color := ColorBlack;
        end
        else if ScrBuf[y, x].hilite = Char(chUnderLine) then
          Font.Style := [fsUnderline]
        else if ScrBuf[y, x].hilite = Char(chBlink) then
          Font.Style := [fsStrikeout]
        else
          Font.Style := [];
        if (Byte(ScrBuf[y, x].attrib) and caIntens) = caIntens then
          Font.Style := Font.Style + [fsBold];
         r := Rect(xpos,ypos,xpos+(FontWidthPix ),ypos+(FontHeightPix ));
         canvas.FillRect(r);
         TextOut(xpos, ypos, ScrBuf[y, x].data);
      end
      else
        TextOut(xpos, ypos, ' ');
    end;
  end;
end;

procedure TMyDrawingPanel.DrawCursor(x, y: integer);
var
  xpos, ypos: integer;
begin
  xpos := (CsrCol * FontWidthPix) - FontWidthPix;
  ypos := (CsrRow * FontHeightPix) - 1;
  with Canvas do
  begin
    if csrShape = csrUnderLine then
    begin
      Pen.Mode := pmWhite;
      Pen.Color := ColorWhite;
      Brush.Style := bsSolid;
      Brush.Color := ColorWhite;
      MoveTo(xpos, ypos);
      LineTo(xpos + FontWidthPix, ypos);
    end
    else
    begin
      Pen.Mode := pmXor;
      Pen.Color := ColorMapI2W(ScrBuf[CsrRow, CsrCol].color);
      Brush.Style := bsSolid;
      Brush.Color := ColorMapI2W(ScrBuf[CsrRow, CsrCol].color);
      Rectangle(xpos, ypos - FontHeightPix + 1, xpos + FontWidthPix, ypos);
    end;
  end;
  LastcursorX := CsrCol;
  LastcursorY := CsrRow;
end;

procedure TMyDrawingPanel.Paint;
begin
  Showbuf;
end;

procedure TMyDrawingPanel.ShowBuf;
var
  i, j: integer;
begin
  Canvas.Lock;
  try
    with Canvas do
    begin
      Brush.Style := bsSolid;
      Brush.Color := ColorBlack;
      FillRect(ClientRect);
    end;
    for i := 1 to SCRROWS do
      for j := 1 to SCRCOLS do
        DispCell(j, i, false);
      DrawCursor(CsrCol, CsrRow);
 // ShowStatus ;
  finally
    Canvas.Unlock;
  end;
end;

end.


Greetings,
Peter
0
peterkiers
Asked:
peterkiers
  • 2
1 Solution
 
peterkiersAuthor Commented:
And...
 in the OnCreate-event of the example this is
 declared:

  FontName := 'Terminal';
  FontSize := 9;
  Font.Size := FontSize;
  Font.Name := FontName;
  GetTextMetrics(Canvas.Handle, TxMetric);
  FontWidthPix := TxMetric.tmMaxCharWidth;
  FontHeightPix := TxMetric.tmHeight;

Where can I put these line in the component-unit?
0
 
TheRealLokiSenior DeveloperCommented:
type
  TMyDrawingPanel = class(TCustomPanel)
  private
    { Private declarations }
  CursorFlashTimer: TTImer;
  procedure CursorFlashTimer_OnTImer(sender: TObject); // this is the event
...
...



constructor TMyDrawingPanel.Create(AOwner: TComponent);
var
  TxMetric: TTextMetric;
begin
  inherited Create (AOwner);
  CursorFlashTimer := TTimer.Create(self);
  with  CursorFlashTimer do
  begin
    Enabled := False;
    Interval := 200;
    OnTimer := CursorFlashTimer_OnTImer;
  end;


destructor TMyDrawingPanel.Destroy;
begin
  CursorFlashTimer.Enabled := False;
  CursorFlashTimer.Free;
  inherited;
//
end;...
0
 
peterkiersAuthor Commented:
Thanks TheRealLoki

Peter
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now