lcdscreen.pas.svn-base

LCDScreen is a couple of Delphi component which simulate a dot-LCD multilines screen. It is fully c

    FLineSpacing: Byte;                   { Space between text lines on the display   }
    //FNoOfLines: Byte;                     { Number of text lines on the LCD           }
    //FNoOfChars: Byte;                     { Number of characters on a single line     }
    FPixelHeight: Byte;                   { Pixel height                              }
    FPixelOffColor: TColor;               { LCD pixel OFF color                       }
    FPixelOnColor: TColor;                { LCD pixel ON color                        }
    FPixelSize: TPixelSize;               { Size of a LCD pixel (in screen pixels)    }
    FPixelShape: TPixelShape;             { Shape of a LCD pixel                      }
    FPixelSpacing: Byte;                  { Space between each pixel in the matrix    }
    FPixelWidth: Byte;                    { Pixel widht                               }
    FSpecialEffects: TSpecialEffects;     {Enable or disable special effects          }
    FWidth: Integer;                      { Label width in pixels                     }
    FFont: TFont;
    FirstPaint: Boolean;

    function  TrueDisplayHeight: Integer;
    function  TrueDisplayWidth: Integer;

    procedure SetPixelSize(Value: TPixelSize);
    //procedure SetDotMatrix(Value: TDotMatrix);
    procedure SetDotMatrixBorders(Value: TDotMatrixBorders);
    procedure SetPixelShape(Value: TPixelShape);
    procedure SetPixelSpacing(Value: Byte);
    procedure SetCharSpacing(Value: Byte);
    procedure SetLineSpacing(Value: Byte);
    procedure SetBorderSpace(Value: Byte);
    //procedure SetNoOfLines(Value: Byte);
    //procedure SetNoOfChars(Value: Byte);
    procedure SetColor(Value: TColor);
    procedure SetFont(Value: TFont);
    procedure SetPixelOnColor(Value: TColor);
    procedure SetPixelOffColor(Value: TColor);
    procedure SetBorderStyle(Value: TLCDBorder);
    procedure SetPixelWidth(Value: Byte);
    procedure SetPixelHeight(Value: Byte);
    function DrawOneCharacter(BitMap: TBitMap; xpos, ypos: Integer; Display: TOneChar): Integer;
    procedure DrawDisplayCharacters(BitMap: TBitMap);
    procedure UpdateInternalMatrixBitmap;
    procedure UpdateInternalCharBitmap;
    procedure UpdateTrueColors;
    procedure SetCorrectSize;
    function  GetAbout: string;
    procedure SetAbout(Value: string);
    procedure SetIntensity(Value: ShortInt);
    procedure SetAnimationEnabled(Value: Boolean);
    procedure SetAnimationRepeating(Value: Boolean);
    procedure SetAnimationDelay(Value: Cardinal);
    procedure SetLCDAnimator(Value: TLCDAnimator);
    procedure SetSpecialEffects(Value: TSpecialEffects);
    procedure SetAnimationUnits(Value: TAnimationUnit);

    procedure OnFontChange(Sender: TObject);

  protected
    procedure HorzScroll(Value: ShortInt);
    procedure LinesOnChange(Sender: TObject);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Paint; override;
    procedure SetLines(Value: TStringList);
    procedure TimerOnTimer(Sender: TObject);
    procedure VertScroll(Value: ShortInt);

    procedure Resize; override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;

    procedure Reset(Value: TResetMode);

  published
    property About: string read GetAbout write SetAbout stored False;
    property AnimationDelay: Cardinal read FAnimationDelay write SetAnimationDelay;
    property AnimationEnabled: Boolean read FAnimationEnabled write SetAnimationEnabled;
    property AnimationRepeating: Boolean read FAnimationRepeating write SetAnimationRepeating;
    property AnimationUnits: TAnimationUnit read FAnimationUnits write SetAnimationUnits;
    property BorderSpace: Byte read FBorderSpace write SetBorderSpace;
    property BorderStyle: TLCDBorder read FBorderStyle write SetBorderStyle;
    property CharSpacing: Byte read FCharSpacing write SetCharSpacing;
    property Color: TColor read FColor write SetColor;
    property Font: TFont read FFont write SetFont;
    //property DotMatrix: TDotMatrix read FDotMatrix write SetDotMatrix;
    property DotMatrixBorders: TDotMatrixBorders read FDotMatrixBorders write SetDotMatrixBorders;
    property Enabled;
    property Intensity: ShortInt read FIntensity write SetIntensity;
    property LCDAnimator: TLCDAnimator read FLCDAnimator write SetLCDAnimator;
    property Lines: TStringList read FLines write SetLines;
    property LineSpacing: Byte read FLineSpacing write SetLineSpacing;
    //property NoOfLines: Byte read FNoOfLines write SetNoOfLines;
    //property NoOfChars: Byte read FNoOfChars write SetNoOfChars;
    property PixelHeight: Byte read FPixelHeight write SetPixelHeight;
    property PixelOff: TColor read FPixelOffColor write SetPixelOffColor;
    property PixelOn: TColor read FPixelOnColor write SetPixelOnColor;
    property PixelShape: TPixelShape read FPixelShape write SetPixelShape;
    property PixelSize: TPixelSize read FPixelSize write SetPixelSize;
    property PixelSpacing: Byte read FPixelSpacing write SetPixelSpacing;
    property PixelWidth: Byte read FPixelWidth write SetPixelWidth;
    property ShowHint;
    property SpecialEffects: TSpecialEffects read FSpecialEffects write SetSpecialEffects;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property Align;
  end;


const
  space_char          = char(32);
  startinverse_char   = char(10);
  stopinverse_char    = char(11);
  startblinking_char  = char(12);
  stopblinking_char   = char(13);
  startunderline_char = char(14);
  stopunderline_char  = char(15);
  startstrike_char    = char(16);
  stopstrike_char     = char(17);



procedure Register;


implementation

////////////////////////////////////////////////////////////////////////////////
//
//  General Intrest Routines. Used for CodeEditor Synthax.
//
////////////////////////////////////////////////////////////////////////////////

function NbOfThings(tempcode: string; Thing: Char): Integer;
var i: Integer;
begin
  i := 0;
  while Pos(Thing, tempcode) <> 0
  do begin
       try Delete(tempcode, 1, Pos(Thing, tempcode)); except; end;
       Inc(i);
       end;
  NbOfThings := i;
end;


function ExtractWord(Value: String): String;
begin
  ExtractWord := Trim(Copy(Value, 1, Pos('(', Value) - 1));
end;


function ExtractParam(Value: String): Integer;
begin
  ExtractParam := StrtoInt(Copy(Value, Length(ExtractWord(Value)) + 2,
                           Pos(')', Value) - Length(ExtractWord(Value)) -2));
end;


procedure ExtractCode(tempcode: string; var CodeInstructions: array of TCodeInstruction;
                      NbOfElement: Byte);
var i,n: Integer;
    s,m: string;
begin
  tempcode := Trim(LowerCase(Copy(tempcode, 2, Length(tempcode) - 2)));
  for i := 0 to NbOfElement - 1
  do begin
       s := Trim(Copy(tempcode, 1, Pos(';', tempcode)));
       m := ExtractWord(s);
       n := ExtractParam(s);
       CodeInstructions[i].Word := m;
       CodeInstructions[i].Param := n;
       Delete(tempcode, 1, Length(s));
       tempcode := Trim(tempcode);
       end;
end;


////////////////////////////////////////////////////////////////////////////////
//
//  General Intrest Routines. Draw on pixel.
//
////////////////////////////////////////////////////////////////////////////////

procedure DrawOnePixel(var Bitmap: TBitmap; PixelSize: TPixelsize; PixelShape: TPixelShape;
                       Color: TColor; psx, psy: Byte; tx, ty: Integer);
begin
  with Bitmap.Canvas
  do begin
       Pen.Color := Color;
       Brush.Color := Color; 
       if PixelSize = pix1x1
       then Pixels[tx, ty] := Color
       else case PixelShape of
             psSquare:  Rectangle(tx, ty, tx + psx, ty + psy); { Standard square pixels}
             psRound:   Ellipse(tx, ty, tx + psx, ty + psy);   { Round pixels }
            end;
       end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Count LCDScreen's special characters (i.e. 10 <= Ord(x) <= 20)
// in a String.
//
////////////////////////////////////////////////////////////////////////////////

function CountSpecialCharString(temp: String): Byte;
var col, maxspecialchar: Byte;
begin
  maxspecialchar := 0;
  if Length(temp) <> 0
  then for col := 0 to Length(temp)
  do if (Ord(temp[col]) >= 10) and (Ord(temp[col]) <= 20)
     then Inc(maxspecialchar);

  CountSpecialCharString := maxspecialchar;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Create and initialize component TLCDScreen.
//
////////////////////////////////////////////////////////////////////////////////

constructor TLCDScreen.Create(AOwner: TComponent);
begin
  FFont := TFont.Create;
  FFont.Name := 'Arial';
  FFont.Size := 11;

  FFont.OnChange := OnFontChange;
  inherited Create(AOwner);

  FLines := TStringList.Create;

  FPixelSize := pix1x1;
  FCharSpacing := 1;
  FLineSpacing := 1;
  FPixelSpacing := 1;
  FBorderSpace := 5;
  //FNoOfLines := 1;
  //FNoOfChars := 10;
  FBorderStyle := bsLowered;
  FColor := clInactiveBorder;
  FPixelOnColor := clBlack;
  FPixelOffColor := $00AAAAAA;
  FIntensity := 127;
  UpdateTrueColors;
  PixVRef := 0;
  PixHRef :=0;
  CharHRef := 0;
  CharVRef := 0;
  FAnimationUnits := auChar;
  FTimer := TTimer.Create(Self);
  FTimer.Interval := 250;
  FTimer.OnTimer := TimerOnTimer;
  FTimer.Enabled := False;

  FAnimationDelay := 250;
  FAnimationEnabled := False;
  FAnimationRepeating := False;
  FirstPaint := true;

  FLines.OnChange := LinesOnChange;

  FVirginMatrixDC := CreateCompatibleDC(0);
  FVirginMatrixBitmap := nil;

  FBlackMatrixDC := CreateCompatibleDC(0);
  FBlackMatrixBitmap := nil;

  FCharDC := CreateCompatibleDC(0);
  FCharBitmap := 0;

  SetTextColor(FCharDC, RGB(0,0,0));
  SetBkColor(FCharDC, RGB(255,255,255));

end;


////////////////////////////////////////////////////////////////////////////////
//
// Remove component TLCDScreen.
//
////////////////////////////////////////////////////////////////////////////////

destructor TLCDScreen.Destroy;
begin
  FTimer.Destroy;
  FLines.Destroy;

  if Assigned(FFont) then FFont.Free;
  if FCharBitmap<>0 then DeleteObject(FCharBitmap);

  DeleteDC(FVirginMatrixDC); FVirginMatrixBitmap.Free;
  DeleteDC(FBlackMatrixDC); FBlackMatrixBitmap.Free;
  DeleteDC(FCharDC);

  inherited Destroy;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Calculate "active" Display region needed to be displayed.
//
//
////////////////////////////////////////////////////////////////////////////////

function TLCDScreen.TrueDisplayHeight: Integer;
begin
  TrueDisplayHeight := Max(Flines.Count, 0);
end;


////////////////////////////////////////////////////////////////////////////////
//
// Calculate "active" Display region needed to be displayed.
//
//
////////////////////////////////////////////////////////////////////////////////

function TLCDScreen.TrueDisplayWidth: Integer;
var i,temp: integer;
begin
  temp := 0;
  for i := 0 to Flines.Count - 1
  do temp := Max(Length(Flines[i]) - CountSpecialCharString(Flines[i]) + 1, temp);

  TrueDisplayWidth :=temp;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Set Width and Height correct.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetCorrectSize;
begin
  if PixelSize = pixCustom
  then begin  { Custom size }
        if (psx<>PixelWidth) or (psy<>PixelHeight) then UpdateInternalMatrixBitmap;

        psx := PixelWidth;
        psy := PixelHeight;
        end
  else begin  { Predefined width selected - make square pixels }
        if (psx<>Ord(FPixelSize)) or (psy<>Ord(FPixelSize)) then UpdateInternalMatrixBitmap;

         psx := Ord(FPixelSize);
         psy := psx;
         FPixelWidth := psx;
         FPixelHeight := psy;
         end;

  if FCharBitmap=0 then UpdateInternalCharBitmap;

  if FirstPaint then begin UpdateInternalMatrixBitmap; FirstPaint := false; end;
end;

procedure TLCDScreen.UpdateInternalCharBitmap;
begin
  if Assigned(FFont) then
  begin
    FontWidth := FFont.Size+1;
    FontHeight := Abs(FFont.Height)+1;
  end
  else