lcd_lab.pas

讓 label 用 LCD 形式 表現出來

{******************************************************************************}
{                                                                              }
{  TLCDLabel v1.5 - The one and only LCD label that work like the real thing!  }
{  (c) 1999 - Peter Czidlina                                                   }
{  Now with editable fonts!                                                    }
{******************************************************************************}

unit LCD_Lab;

interface

uses
  SysUtils, Windows, WinProcs, WinTypes, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Menus, StdCtrls, Buttons, ExtCtrls, Matrix;

type
  TDotMatrix  = (mat5x7, mat5x8, mat7x9, mat9x12, Hitachi, Hitachi2, dos5x7, CustomFont);
  TPixelSize  = (pix1x1, pix2x2, pix3x3, pix4x4, pix5x5, pix6x6, pix7x7, pix8x8, pix9x9, pix10x10, pix11x11, pix12x12, pix13x13, pix14x14, pix15x15, pix16x16, pixCustom);
  TPixelShape = (spSquare, spShaped, spRound);
  TMyBorder   = (frRaised, frLowered, frSingle, frNone);
  TPixelState = (pixOn, pixOff);
  TPixelPtr   = ^TPixelState;
  T_FileName  = type string;

  TLCDLabel = class(TGraphicControl)
  private
    FPixelSize : TPixelSize;        { Size of a LCD pixel (in screen pixels    }
    FPixelShape: TPixelShape;       { Shape of a LCD pixel                     }
    FDotMatrix : TDotMatrix;        { Type of character matrix on the LCD      }
    FPixelSpacing : integer;        { Space between each pixel in the matrix   }
    FCharSpacing : integer;         { Space between the characters on the LCD  }
    FLineSpacing : integer;         { Space between text lines on the display  }
    FBorderSpace : integer;         { Distance from the LCD border             }
    FTextLines   : integer;         { Number of text lines on the LCD          }
    FNoOfChars   : integer;         { Number of characters on a single line    }
    FBackGround  : TColor;          { LCD background color                     }
    FPixOnColor  : TColor;          { LCD pixel ON color                       }
    FPixOffColor : TColor;          { LCD pixel OFF color                      }
    FPixHalfColor: TColor;          { Half intensity ON color                  }
    FPixWidth    : integer;         { Pixel widht                              }
    FPixHeight   : integer;         { Pixel height                             }
    FBorderStyle : TMyBorder;       { Border around the the component          }
    FBorderColor : TColor;          { Color of component border                }
    FWidth       : integer;         { Label width in pixels                    }
    FHeight      : integer;         { Label height in pixels                   }
    charw, charh : integer;         { Temp. storage of character sizes         }
    psx, psy     : integer;         { Internal pixel width variables           }
    pix_x, pix_y     : integer;     { Font size                                }
    first_c, last_c  : integer;     { First and last character to draw         }
    FFilename : T_FileName;         { Filename of custom font file             }
    charbuf  : Array[0..256] of Char;
    FontList : Array[0..255] of TPixelPtr;
    procedure SetPixelSize(psize : TPixelSize);
    procedure SetDotMatrix(matrix : TDotMatrix);
    procedure SetPixelShape(pshape : TPixelShape);
    procedure SetPixelSpacing(pspacing : integer);
    procedure SetCharSpacing(cspacing : integer);
    procedure SetLineSpacing(lspacing : integer);
    procedure SetBorderSpace(bspace : integer);
    procedure SetTextLines(tlines : integer);
    procedure SetNoOfChars(nchars : integer);
    procedure GetAsciiInterval;
    procedure CalcSize;
    procedure CalcCharSize;
    procedure SetBkgColor(bcolor : TColor);
    procedure SetPixOnColor(ocolor : TColor);
    procedure SetPixOffColor(ocolor : TColor);
    procedure SetBorderStyle(bstyle : TMyBorder);
    procedure SetBorderColor(bcolor : TColor);
    procedure SetFileName(fname : T_FileName);
    procedure SetPixelWidth(pwidth : integer);
    procedure SetPixelHeight(pheight : integer);
    function  ReadCustomFont(fname : string) : boolean;
    function  BuildFontList(var FontList : Array of TPixelPtr; font_w, font_h : integer) : boolean;
    procedure FreeFontList(var FontList : Array of TPixelPtr);
    procedure DrawMatrix(BitMap : TBitMap; xpos, ypos : integer; charindex : integer);
    procedure DrawCharacters(BitMap : TBitMap);
    function  GetCaption : TCaption;
    procedure SetCaption(const Value : TCaption);
    procedure CalcHalfColor;
  protected  { Internal properties }

  public     { Non-published but avaiable read-only properties }
    property FontWidth : integer read pix_x;
    property FontHeight : integer read pix_y;
  published  { Normal properties (avaiable in Inspector) }
  { Text setting - make the text on the LCD }
    property Caption: TCaption read GetCaption write SetCaption;
  { LCD character parameters }
    property DotMatrix: TDotMatrix read FDotMatrix write SetDotMatrix default mat5x7;
    property PixelSize: TPixelSize read FPixelSize write SetPixelSize;
    property PixelSpacing: integer read FPixelSpacing write SetPixelSpacing;
    property PixelShape: TPixelShape read FPixelShape write SetPixelShape default spSquare;
    property PixelWidth: integer read FPixWidth write SetPixelWidth;
    property PixelHeight: integer read FPixHeight write SetPixelHeight;
  { LCD display parameters }
    property CharSpacing: integer read FCharSpacing write SetCharSpacing;
    property LineSpacing: integer read FLineSpacing write SetLineSpacing;
    property BorderSpace: integer read FBorderSpace write SetBorderSpace;
    property TextLines : integer read FTextLines write SetTextLines;
    property NoOfChars : integer read FNoOfChars write SetNoOfChars;
  { LCD color parameters }
    property BackGround : TColor read FBackGround write SetBkgColor default clSilver;
    property BorderStyle : TMyBorder read FBorderStyle write SetBorderStyle default frLowered;
    property BorderColor : TColor read FBorderColor write SetBorderColor default clBlack;
    property PixelOn : TColor read FPixOnColor write SetPixOnColor default clBlack;
    property PixelOff : TColor read FPixOffColor write SetPixOffColor default clGray;
  { Custom font properties }
    property filename : T_FileName read FFilename write SetFileName;
  { TGraphicControl properties }
    property Hint;
    property ShowHint;
    property Enabled;
    property Visible;
  { Events }
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  end;

  procedure Register;

implementation

uses
  DsgnIntf, LCD_Ped;
  
{ Create component }
constructor TLCDLabel.Create(AOwner: TComponent);
var
  i : integer;
begin
  inherited Create(AOwner);
  for i := 0 to 255 do
    FontList[i] := NIL;
  FWidth       := 0;
  FHeight      := 0;
  FCharSpacing := 2;
  FLineSpacing := 2;
  FPixelSpacing:= 1;
  FBorderSpace := 3;
  FTextLines   := 1;
  FNoOfChars   := 10;
  FBorderStyle := frLowered;
  FBorderColor := clBlack;
  FBackGround  := clSilver;
  FPixOnColor  := clBlack;
  FPixOffColor := $00AAAAAA;
  FPixelSize   := pix2x2;
  CalcHalfColor;             { Halftone On color          }
  CalcSize;                  { Get correct sizes at start }
end;

{ Remove component }
destructor TLCDLabel.Destroy;
begin
  FreeFontList(FontList);
  inherited Destroy;
end;

{******************************************************************************}
{*  Custom font file loading                                                  *}
function TLCDLabel.ReadCustomFont(fname : string) : boolean;
var
  FontFile : File;
  i        : integer;
begin
  result := True;
  {$I-}
  AssignFile(FontFile, fname);
  Reset(FontFile, 1);
  {$I+}
  if (IOResult <> 0) then   { Check if file open failed }
    result := False
  else begin                { Everything OK - read file }
    try
      BlockRead(FontFile, pix_x, sizeof(integer));
      BlockRead(FontFile, pix_y, sizeof(integer));
      BlockRead(FontFile, first_c, sizeof(integer));
      BlockRead(FontFile, last_c, sizeof(integer));
      if BuildFontList(FontList, pix_x, pix_y) then begin
        for i := first_c to last_c do begin
          BlockRead(FontFile, FontList[i]^, (pix_x * pix_y) * sizeof(TPixelState));
        end;
      end else
        result := False;
    finally
      CloseFile(FontFile);
    end;
  end;
end;

// Build font list in memory
function TLCDLabel.BuildFontList(var FontList : Array of TPixelPtr; font_w, font_h : integer) : boolean;
var
  i, j : integer;
  TPtr : TPixelPtr;
begin
  result := True;
// Set all pointers to NIL
  for i := 0 to 255 do
    FontList[i] := NIL;
// Allocate memory for each font
  for i := 0 to 255 do begin
    try
      GetMem(FontList[i], font_w * font_h * sizeof(TPixelState));
      TPtr := FontList[i];
    // Set the new font to blank
      for j := 0 to ((font_w * font_h) - 1) do begin
        TPtr^ := pixOff;
        Inc(TPtr);
      end;
    except
      result := False;
      break;
    end;
  end;
end;

// Free the entire font list
procedure TLCDLabel.FreeFontList(var FontList : Array of TPixelPtr);
var
  i : integer;
begin
  for i := 0 to 255 do begin
    if (FontList[i] <> NIL) then begin
      try
        FreeMem(FontList[i]);
        FontList[i] := NIL;
      except
      end;
    end;
  end;
end;

{******************************************************************************}
procedure TLCDLabel.DrawMatrix(BitMap : TBitMap; xpos, ypos : integer; charindex : integer);
var
  i, j : integer;
  tx, ty : integer;
  CColor : TColor;
  TPtr   : TPixelPtr;
begin
  tx := xpos;
  ty := ypos;
  for i := 1 to pix_y do begin
    for j := 1 to pix_x do begin
      case FDotMatrix of
        mat5x7 : begin
                   if Char5x7[charindex][i][j] = 1 then
                     CColor := FPixOnColor
                   else
                     CColor := FPixOffColor;
                 end;
        mat5x8 : begin
                   if Char5x8[charindex][i][j] = 1 then
                     CColor := FPixOnColor
                   else
                     CColor := FPixOffColor;
                 end;
        Hitachi: begin
                   if CharHitachi[charindex][i][j] = 1 then
                     CColor := FPixOnColor
                   else
                     CColor := FPixOffColor;
                 end;
        Hitachi2:begin  // Use full height for character 194 - 223
                   if (charindex <= 193) then begin  // Normal Hitachi
                     if (i <= 7) then begin
                       if CharHitachi[charindex][i][j] = 1 then
                         CColor := FPixOnColor
                       else
                         CColor := FPixOffColor;
                     end else
                       CColor := FPixOffColor;
                   end else begin  // Extended height
                     if CharHitachiExt[charindex][i][j] = 1 then
                       CColor := FPixOnColor
                     else
                       CColor := FPixOffColor;
                   end;
                 end;
        mat7x9 : begin
                   if Char7x9[charindex][i][j] = 1 then
                     CColor := FPixOnColor
                   else
                     CColor := FPixOffColor;
                 end;
        mat9x12: begin
                   if Char9x12[charindex][i][j] = 1 then
                     CColor := FPixOnColor
                   else
                     CColor := FPixOffColor;
                 end;
        dos5x7 : begin
                   if CharDOS5x7[charindex][i][j] = 1 then
                     CColor := FPixOnColor
                   else
                     CColor := FPixOffColor;
                 end;
        CustomFont : begin  { Custom font - an other counting are needed }
                   TPtr := FontList[charindex];
                   Inc(TPtr, ((j - 1) + ((i - 1) * pix_x)) * sizeof(TPixelState));
                   case TPtr^ of
                     pixOn : CColor := FPixOnColor;
                     pixOff: CColor := FPixOffColor;
                   end;
                 end;
      end;
    // Paint pixels in selected shape
      case FPixelShape of
        spSquare: begin  // Standard square pixels
                  BitMap.Canvas.Pen.Color := CColor;
                  BitMap.Canvas.Brush.Color := CColor;
                  BitMap.Canvas.rectangle(tx, ty, tx + psx, ty + psy);
                end;
        spShaped: begin  // Pixels with shaped corners
                  if CColor = FPixOnColor then begin
                    BitMap.Canvas.Pen.Color := FPixHalfColor;
                    BitMap.Canvas.Brush.Color := FpixHalfColor;
                    BitMap.Canvas.rectangle(tx, ty, tx + psx, ty + psy);
                    BitMap.Canvas.Pen.Color := CColor;
                    BitMap.Canvas.Brush.Color := CColor;
                    BitMap.Canvas.ellipse(tx, ty, tx + psx, ty + psy);
                  end else begin
                    BitMap.Canvas.Pen.Color := CColor;
                    BitMap.Canvas.Brush.Color := CColor;
                    BitMap.Canvas.rectangle(tx, ty, tx + psx, ty + psy);
                  end;
                end;
        spRound : begin  // Round pixels
                  BitMap.Canvas.Pen.Color := CColor;
                  BitMap.Canvas.Brush.Color := CColor;
                  BitMap.Canvas.ellipse(tx, ty, tx + psx, ty + psy);
                end;
      end;
      tx := tx + psx + FPixelSpacing;
    end;
    tx := xpos;
    ty := ty + psy + FPixelSpacing;
  end;
end;

procedure TLCDLabel.DrawCharacters(BitMap : TBitMap);
var
  row ,col : integer;
  xpos, ypos : integer;
  charindex : integer;
  cc : integer;
  textend : Boolean;
begin
  xpos := FBorderSpace + 1;
  ypos := FBorderSpace + 1;
  cc := 0;
  textend := False;
  for row := 1 to FTextLines do begin      { Line counter             }
    for col := 1 to FNoOfChars do begin    { Character counter        }
      if textend = False then              { Check for string end     }
        if charbuf[cc] = #0 then
          textend := True;
      if textend then
        charindex := 0
      else
        charindex := Ord(charbuf[cc]);
      if (charindex < first_c) then        { Limit charactes inside interval }
        charindex := first_c;
      if (charindex > last_c) then
        charindex := last_c;
      DrawMatrix(BitMap, xpos, ypos, charindex);
      xpos := xpos + charw + FCharSpacing;
      Inc(cc);
    end;
    ypos := ypos + charh + FLineSpacing;
    xpos := FBorderSpace + 1;
  end;
end;

{******************************************************************************}
{ Repaint the component }
procedure TLCDLabel.Paint;
var
  BitMap : TBitMap;
  T_Rect : TRect;
  flag : boolean;
begin
  flag := False;
  if Width <> FWidth then begin
    flag := True;
    FWidth := Width;
  end;
  if Height <> FHeight then begin
    flag := True;
    FHeight := Height;
  end;
  GetAsciiInterval;          { Calculate interval for ASCII values }
  if flag then
    CalcCharSize
  else
    CalcSize;                { Get Width and Height correct }
  with Canvas do begin
    BitMap := TBitMap.Create;
    try                         { Draw image off-screen }
      BitMap.Height := Height + 2;
      BitMap.Width := Width + 2;
{ Border drawing }
      with BitMap.Canvas do begin
        Pen.Style   := psSolid;
        Brush.Style := bsSolid;