lcd_lab.pas

讓 label 用 LCD 形式 表現出來

        if Visible then begin     { Draw only real graphics if display is marked visible }
          T_Rect := Rect(0, 0, Width, Height);
          Brush.Color := FBackGround;
          FillRect(T_Rect);          { Background fill }
          if (FBorderStyle <> frNone) then begin
            case FBorderStyle of
              frSingle: Brush.Color := FBorderColor;
              frRaised: Brush.Color := clBtnShadow;
              frLowered:Brush.Color := clBtnHighlight;
            end;
            FrameRect(T_Rect);
            if (FBorderStyle <> frSingle) then begin
              case FBorderStyle of
                frLowered: Pen.Color := clBtnShadow;
                frRaised:  Pen.Color := clBtnHighlight;
              end;
              PolyLine([Point(Width, 0), Point(0, 0), Point(0, Height)]);
            end;
          end;
{ Character drawing }
          if Enabled then
            DrawCharacters(BitMap);
        end else begin  { Invisible - draw a square in background color }
          Brush.Color := clBtnFace;
          FillRect(ClipRect);
        end;
      end;
{ 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;

{ Get interval for ASCII values }
procedure TLCDLabel.GetAsciiInterval;
begin
  case FDotMatrix of
    mat5x7, Hitachi : begin
               first_c := HITACHI_FIRST;
               last_c  := HITACHI_LAST;
             end;
    Hitachi2:begin
               first_c := HITACHI2_FIRST;
               last_c  := HITACHI2_LAST;
             end;
    mat5x8 : begin
               first_c := MAT5X8_FIRST;
               last_c  := MAT5X8_LAST;
             end;
    mat7x9 : begin
               first_c := MAT7X9_FIRST;
               last_c  := MAT7X9_LAST;
             end;
    mat9x12: begin
               first_c := MAT9X12_FIRST;
               last_c  := MAT9X12_LAST;
             end;
    dos5x7 : begin
               first_c := DOS5X7_FIRST;
               last_c  := DOS5X7_LAST;
             end;
  end;
end;

{ Calculate no of characters and lines from width and heigth }
procedure TLCDLabel.CalcCharSize;
begin
  if (Ord(pixCustom) = Ord(FPixelSize)) then begin  { Custom size }
    psx := FPixWidth;
    psy := FPixHeight;
  end else begin             { Predefined width selected - make square pixels }
    psx := Ord(FPixelSize) + 1;
    psy := psx;
    FPixWidth := psx;
    FPixHeight := psy;
  end;
  case FDotMatrix of         { Calculate the space taken by the character matrix }
    mat5x7, Hitachi : begin
               pix_x := HITACHI_WIDTH;
               pix_y := HITACHI_HEIGHT;
             end;
    Hitachi2:begin
               pix_x := HITACHI2_WIDTH;
               pix_y := HITACHI2_HEIGHT;
             end;
    mat5x8 : begin
               pix_x := MAT5X8_WIDTH;
               pix_y := MAT5X8_HEIGHT;
             end;
    mat7x9 : begin
               pix_x := MAT7X9_WIDTH;
               pix_y := MAT7X9_HEIGHT;
             end;
    mat9x12: begin
               pix_x := MAT9X12_WIDTH;
               pix_y := MAT9X12_HEIGHT;
             end;
    dos5x7 : begin
               pix_x := DOS5X7_WIDTH;
               pix_y := DOS5X7_HEIGHT;
             end;
  end;
  charw := (pix_x * psx) + ((pix_x - 1) * FPixelSpacing);
  charh := (pix_y * psy) + ((pix_y -1) * FPixelSpacing);
  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
  if (Ord(pixCustom) = Ord(FPixelSize)) then begin  { Custom size }
    psx := FPixWidth;
    psy := FPixHeight;
  end else begin             { Predefined width selected - make square pixels }
    psx := Ord(FPixelSize) + 1;
    psy := psx;
    FPixWidth := psx;
    FPixHeight := psy;
  end;
  case FDotMatrix of         { Calculate the space taken by the character matrix }
    mat5x7, Hitachi : begin
               pix_x := HITACHI_WIDTH;
               pix_y := HITACHI_HEIGHT;
             end;
    Hitachi2:begin
               pix_x := HITACHI2_WIDTH;
               pix_y := HITACHI2_HEIGHT;
             end;
    mat5x8 : begin
               pix_x := MAT5X8_WIDTH;
               pix_y := MAT5X8_HEIGHT;
             end;
    mat7x9 : begin
               pix_x := MAT7X9_WIDTH;
               pix_y := MAT7X9_HEIGHT;
             end;
    mat9x12: begin
               pix_x := MAT9X12_WIDTH;
               pix_y := MAT9X12_HEIGHT;
             end;
    dos5x7 : begin
               pix_x := DOS5X7_WIDTH;
               pix_y := DOS5X7_HEIGHT;
             end;    
  end;
  charw := (pix_x * psx) + ((pix_x - 1) * FPixelSpacing);
  charh := (pix_y * psy) + ((pix_y - 1) * FPixelSpacing);
  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);
var
  OldMatrix : TDotMatrix;
begin
  OldMatrix  := FDotMatrix;
  FDotMatrix := matrix;
  if (OldMatrix = CustomFont) then      { Can't use a custom as old - all data are erased }
    OldMatrix := mat5x7;
  if (matrix = CustomFont) then begin   { Custom font - load it from file }
    if (filename <> '') then begin
      FreeFontList(FontList);
      if not ReadCustomFont(filename) then
        FDotMatrix := OldMatrix;
    end else
      FDotMatrix := OldMatrix;
  end;
  Paint;
end;

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

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

{ Change shape of LCD pixels }
procedure TLCDLabel.SetPixelShape(pshape : TPixelShape);
begin
  if pshape <> FPixelShape then begin
    FPixelShape := pshape;
    Paint;
  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;
      Paint;
    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;
      Paint;
    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;
      Paint;
    end;
  end;
end;

{ Change LCD pixel size }
procedure TLCDLabel.SetPixelSize(psize : TPixelSize);
begin
  if psize <> FPixelSize then begin
    FPixelSize := psize;
    Paint;
  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;
      Paint;
    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;
      Paint;
    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;
      Paint;
    end;
  end;
end;

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

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

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

{ Set pixel width }
procedure TLCDLabel.SetPixelWidth(pwidth : integer);
begin
  if (FPixelSize = pixCustom) then begin
    if (pwidth <> FPixWidth) then begin
      if (pwidth < 1) then
        MessageDlg('Display pixel width must be 1 or greater!', mtError, [mbOk], 0)
      else begin
        FPixWidth := pwidth;
        Paint;
      end;
    end;
  end;
end;

{ Set pixel height }
procedure TLCDLabel.SetPixelHeight(pheight : integer);
begin
  if (FPixelSize = pixCustom) then begin
    if (pheight <> FPixHeight) then begin
      if (pheight < 1) then
        MessageDlg('Display pixel height must be 1 or greate!', mtError, [mbOk], 0)
      else begin
        FPixHeight := pheight;
        Paint;
      end;
    end;
  end;
end;

{ Set custom font file name property }
procedure TLCDLabel.SetFileName(fname : T_FileName);
begin
  FFilename := fname;
  DotMatrix := CustomFont;
  Paint;
end;

{ Component registration }
procedure Register;
begin
  RegisterComponents('Illuwatar', [TLCDLabel]);
  RegisterPropertyEditor(TypeInfo(T_FileName), TLCDLabel, 'filename', TFileNameProperty);
end;

end.