Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue27/lcd12/LCD12.ZIP/Source/Lcd_lab.pas

Pascal/Delphi Source File | 1997-06-22 | 20.1 KB | 587 lines

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);
  TPixelSize  = (pix2x2, pix3x3, pix4x4, pix5x5, pix6x6, pix7x7, pix8x8, pix9x9, pix10x10, pix11x11, pix12x12);
  TPixelShape = (Square, Shaped, Round);
  TMyBorder   = (Raised, Lowered, Single, None);

  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                  }
    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, ps : integer;     { Temp. storage of character sizes         }
    pix_x, pix_y : integer;
    charbuf : Array[0..256] of Char;
    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 CalcSize;
    procedure CalcCharSize;
    procedure SetBkgColor(bcolor : TColor);
    procedure SetPixOnColor(ocolor : TColor);
    procedure SetPixOffColor(ocolor : TColor);
    procedure SetBorderStyle(bstyle : TMyBorder);
    procedure SetBorderColor(bcolor : TColor);
    procedure DrawMatrix(BitMap : TBitMap; xpos, ypos : integer; charindex : integer);
    procedure DrawCharacters(BitMap : TBitMap);
    function  GetCaption : TCaption;
    procedure SetCaption(const Value : TCaption);
    procedure CalcHalfColor;
  protected

  published
  { 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 default pix2x2;
    property PixelSpacing: integer read FPixelSpacing write SetPixelSpacing;
    property PixelShape: TPixelShape read FPixelShape write SetPixelShape default Square;
  { 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 Lowered;
    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;
  { 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
//  WinProcs, SysUtils;

{ Create component }
constructor TLCDLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FWidth := 0;
  FHeight := 0;
  FCharSpacing := 2;
  FLineSpacing := 2;
  FPixelSpacing := 1;
  FBorderSpace := 5;
  FTextLines := 1;
  FNoOfChars := 8;
  FBorderStyle := Lowered;
  FBorderColor := clBlack;
  FBackGround := clSilver;
  FPixOnColor := clBlack;
  FPixOffColor := $00AAAAAA;
  CalcHalfColor;             { Halftone On color          }
  CalcSize;                  { Get correct sizes at start }
end;

{ Remove component }
destructor TLCDLabel.Destroy;
begin
  inherited Destroy;
end;

{******************************************************************************}
procedure TLCDLabel.DrawMatrix(BitMap : TBitMap; xpos, ypos : integer; charindex : integer);
var
  i, j : integer;
  tx, ty : integer;
  CColor : TColor;
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 <= 161) 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 - 162][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;
      end;
    // Paint pixels in selected shape
      case FPixelShape of
        Square: begin  // Standard square pixels
                  BitMap.Canvas.Pen.Color := CColor;
                  BitMap.Canvas.Brush.Color := CColor;
                  BitMap.Canvas.rectangle(tx, ty, tx + ps, ty + ps);
                end;
        Shaped: 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 + ps, ty + ps);
                    BitMap.Canvas.Pen.Color := CColor;
                    BitMap.Canvas.Brush.Color := CColor;
                    BitMap.Canvas.ellipse(tx, ty, tx + ps, ty + ps);
                  end else begin
                    BitMap.Canvas.Pen.Color := CColor;
                    BitMap.Canvas.Brush.Color := CColor;
                    BitMap.Canvas.rectangle(tx, ty, tx + ps, ty + ps);
                  end;
                end;
        Round : begin  // Round pixels
                  BitMap.Canvas.Pen.Color := CColor;
                  BitMap.Canvas.Brush.Color := CColor;
                  BitMap.Canvas.ellipse(tx, ty, tx + ps, ty + ps);
                end;
      end;
      tx := tx + ps + FPixelSpacing;
    end;
    tx := xpos;
    ty := ty + ps + 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]) - 32;
      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;
  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;
  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;
      BitMap.Width := Width;
// Border drawing
      BitMap.Canvas.Pen.Style   := psSolid;
      BitMap.Canvas.Brush.Style := bsSolid;
      BitMap.Canvas.Brush.Color := FBackGround;
      case FBorderStyle of
        None  : begin
                  BitMap.Canvas.Pen.Color := clBtnFace;
                end;
        Single: BitMap.Canvas.Pen.Color := FBorderColor;
        Lowered, Raised:
                BitMap.Canvas.Pen.Color := clBtnHighlight;
      end;
      BitMap.Canvas.Rectangle(0, 0, Width, Height);
      BitMap.Canvas.Pen.Color := clBtnShadow;
      case FBorderStyle of
        Lowered: BitMap.Canvas.PolyLine([Point(Width - 1, 0), Point(0, 0), Point(0, Height - 1)]);
        Raised:  BitMap.Canvas.PolyLine([Point(0, Height - 1), Point(Width-1, Height-1), Point(Width-1, 0)]);
      end;
// Character drawing
      DrawCharacters(BitMap);
// Copy drawn characters to Window bitmap
      BitBlt(Canvas.Handle, 0, 0, Width, Height, BitMap.Canvas.Handle, 0, 0, srcCopy);
    finally
      BitMap.Free;
    end;
  end;
end;

{ Calculate half color intensity }
procedure TLCDLabel.CalcHalfColor;
var
  red, green, blue, control : byte;
begin
  blue := byte(FPixOnColor) div 2;
  green:= byte(FPixOnColor shr 8) div 2;
  red  := byte(FPixOnColor shr 16) div 2;
  control := byte(FPixOnColor shr 24);
  FPixHalfColor := blue + (green * $100) + (red * $10000) + (control * $1000000);
end;

{ Calculate no of characters and lines from width and heigth }
procedure TLCDLabel.CalcCharSize;
begin
  ps := Ord(FPixelSize) + 2;
  case FDotMatrix of         { Calculate the space taken by the character matrix }
    mat5x7, Hitachi : begin
               pix_x := 5; pix_y := 7;
               charw := (5 * ps) + (4 * FPixelSpacing);
               charh := (7 * ps) + (6 * FPixelSpacing);
             end;
    Hitachi2:begin
               pix_x := 5; pix_y := 10;
               charw := (5 * ps)  + (4 * FPixelSpacing);
               charh := (10 * ps) + (9 * FPixelSpacing);
             end;
    mat5x8 : begin
               pix_x := 5; pix_y := 8;
               charw := (5 * ps) + (4 * FPixelSpacing);
               charh := (8 * ps) + (7 * FPixelSpacing);
             end;
    mat7x9 : begin
               pix_x := 7; pix_y := 9;
               charw := (7 * ps) + (6 * FPixelSpacing);
               charh := (9 * ps) + (8 * FPixelSpacing);
             end;
    mat9x12: begin
               pix_x := 9; pix_y := 12;
               charw := (9 * ps) + (8 * FPixelSpacing);
               charh := (12 * ps) + (11 * FPixelSpacing);
             end;
  end;
  FNoOfChars := (Width - (2 * FBorderSpace) + FCharSpacing) div (charw + FCharSpacing);
  FTextLines := (Height- (2 * FBorderSpace) + FLineSpacing) div (charh + FLineSpacing);
  if FNoOfChars < 1 then FNoOfChars := 1;
  if FTextLines < 1 then FTextLines := 1;
  Width := (FBorderSpace * 2) +                { Distance to sides (there are two) }
           (FCharSpacing * (FNoOfChars - 1)) + { Spaces between charactes          }
           (charw * FNoOfChars) +              { The characters itself             }
           2;                                  { For the border                    }
  Height:= (FBorderSpace * 2) +                { Distance to top and bottom        }
           (FLineSpacing * (FTextLines - 1)) + { Spacing between lines             }
           (charh * FTextLines) +              { The lines                         }
           2;                                  { For the border                    }
  FWidth := Width;
  FHeight := Height;
end;

{ Calculations for width and height }
procedure TLCDLabel.CalcSize;
begin
  ps := Ord(FPixelSize) + 2;
  case FDotMatrix of         { Calculate the space taken by the character matrix }
    mat5x7, Hitachi : begin
               pix_x := 5; pix_y := 7;
               charw := (5 * ps) + (4 * FPixelSpacing);
               charh := (7 * ps) + (6 * FPixelSpacing);
             end;
    Hitachi2:begin
               pix_x := 5; pix_y := 10;
               charw := (5 * ps) + (4 * FPixelSpacing);
               charh := (10 * ps) + (9 * FPixelSpacing);
             end;
    mat5x8 : begin
               pix_x := 5; pix_y := 8;
               charw := (5 * ps) + (4 * FPixelSpacing);
               charh := (8 * ps) + (7 * FPixelSpacing);
             end;
    mat7x9 : begin
               pix_x := 7; pix_y := 9;
               charw := (7 * ps) + (6 * FPixelSpacing);
               charh := (9 * ps) + (8 * FPixelSpacing);
             end;
    mat9x12: begin
               pix_x := 9; pix_y := 12;
               charw := (9 * ps) + (8 * FPixelSpacing);
               charh := (12 * ps) + (11 * FPixelSpacing);
             end;
  end;
  Width := (FBorderSpace * 2) +                { Distance to sides (there are two) }
           (FCharSpacing * (FNoOfChars - 1)) + { Spaces between charactes          }
           (charw * FNoOfChars) +              { The characters itself             }
           2;                                  { Border outside character area     }
  Height:= (FBorderSpace * 2) +                { Distance to top and bottom        }
           (FLineSpacing * (FTextLines - 1)) + { Spacing between lines             }
           (charh * FTextLines) +              { The lines                         }
           2;                                  { The Border                        }
  FWidth := Width;
  FHeight := Height;
end;

{ Get caption string }
function TLCDLabel.GetCaption : TCaption;
var
  Buf: Array[0..256] of Char;
begin
  GetTextBuf(Buf, 256);
  StrCopy(charbuf, Buf);
  Result := StrPas(Buf);
end;

{ Set caption string }
procedure TLCDLabel.SetCaption(const Value : TCaption);
var
  Buffer: Array[0..255] of Char;
begin
  if GetCaption <> Value then begin
    SetTextBuf(StrPCopy(Buffer, Value));
    StrCopy(charbuf, Buffer);
    Paint;  // Force a direct re-paint of label without any flicker
  end;
end;

{ Change type of dot matrix }
procedure TLCDLabel.SetDotMatrix(matrix : TDotMatrix);
begin
  if matrix <> FDotMatrix then begin
    FDotMatrix := matrix;
    Invalidate;
  end;
end;

{ Change border style }
procedure TLCDLabel.SetBorderStyle(bstyle : TMyBorder);
begin
  if bstyle <> FBorderStyle then begin
    FBorderStyle := bstyle;
    Invalidate;
  end;
end;

{ Change border color }
procedure TLCDLabel.SetBorderColor(bcolor : TColor);
begin
  if bcolor <> FBorderColor then begin
    FBorderColor := bcolor;
    Invalidate;
  end;
end;

{ Change shape of LCD pixels }
procedure TLCDLabel.SetPixelShape(pshape : TPixelShape);
begin
  if pshape <> FPixelShape then begin
    FPixelShape := pshape;
    Invalidate;
  end;
end;

{ Change pixel spacing (distance between the pixels in the LCD) }
procedure TLCDLabel.SetPixelSpacing(pspacing : integer);
begin
  if pspacing < 0 then
    MessageDlg('Pixel spacing can''t be less than zero!', mtError, [mbOK], 0)
  else begin
    if pspacing <> FPixelSpacing then begin
      FPixelSpacing := pspacing;
      Invalidate;
    end;
  end;
end;

{ Change character spacing (Distance between characters in the LCD) }
procedure TLCDLabel.SetCharSpacing(cspacing : integer);
begin
  if cspacing < 0 then
    MessageDlg('Character spacing can''t be less than zero!', mtError, [mbOK], 0)
  else begin
    if cspacing <> FCharSpacing then begin
      FCharSpacing := cspacing;
      Invalidate;
    end;
  end;
end;

{ Change space between lines in a multi-line LCD }
procedure TLCDLabel.SetLineSpacing(lspacing : integer);
begin
  if lspacing < 0 then
    MessageDlg('Line spacing can''t be less than zero!', mtError, [mbOK], 0)
  else begin
    if lspacing <> FLineSpacing then begin
      FLineSpacing := lspacing;
      Invalidate;
    end;
  end;
end;

{ Change LCD pixel size }
procedure TLCDLabel.SetPixelSize(psize : TPixelSize);
begin
  if psize <> FPixelSize then begin
    FPixelSize := psize;
    Invalidate;
  end;
end;

{ Set space between the border and character array }
procedure TLCDLabel.SetBorderSpace(bspace : integer);
begin
  if bspace < 0 then
    MessageDlg('Border spacing can''t be less than zero!', mtError, [mbOK], 0)
  else begin
    if bspace <> FBorderSpace then begin
      FBorderSpace := bspace;
      Invalidate;
    end;
  end;
end;

{ Set number of text lines on the LCD }
procedure TLCDLabel.SetTextLines(tlines : integer);
begin
  if tlines < 1 then
    MessageDlg('Display needs at least on line!', mtError, [mbOK], 0)
  else begin
    if tlines <> FTextLines then begin
      FTextLines := tlines;
      Invalidate;
    end;
  end;
end;

{ Set number of characters on one line (all lines are of same length) }
procedure TLCDLabel.SetNoOfChars(nchars : integer);
begin
  if nchars < 1 then
    MessageDlg('Display needs at least one character!', mtError, [mbOK], 0)
  else begin
    if nchars <> FNoOfChars then begin
      FNoOfChars := nchars;
      Invalidate;
    end;
  end;
end;

{ Set background color }
procedure TLCDLabel.SetBkgColor(bcolor : TColor);
begin
  if bcolor <> FBackGround then begin
    FBackGround := bcolor;
    Invalidate;
  end;
end;

{ Set pixel ON color }
procedure TLCDLabel.SetPixOnColor(ocolor : TColor);
begin
  if ocolor <> FPixOnColor then begin
    FPixOnColor := ocolor;
    CalcHalfColor;
    Invalidate;
  end;
end;

{ Set pixel OFF color }
procedure TLCDLabel.SetPixOffColor(ocolor : TColor);
begin
  if ocolor <> FPixOffColor then begin
    FPixOffColor := ocolor;
    Invalidate;
  end;
end;

{ Component registration }
procedure register;
begin
  RegisterComponents('Samples', [TLCDLabel]);
end;

end.