lcdscreen.pas.svn-base

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

         for x := 0  to dx
         do begin
              DrawOnePixel(Bitmap, FPixelSize, FPixelShape, pixcol, psx, psy, tx, ty);
              tx := tx + psx + FPixelSpacing;
              end;
        end;

  if  ((Display.SpEff mod 7) = 0) and (spStrike in FSpecialEffects) and (Display.SpEff <> 0)
  then begin
         tx := xpos;
         ty := ypos + Trunc(FontHeight / 2) * (psy + FPixelSpacing);
         for x := 0  to dx
         do begin
              DrawOnePixel(Bitmap, FPixelSize, FPixelShape, pixcol, psx, psy, tx, ty);
              tx := tx + psx + FPixelSpacing;
              end;

        end;

  Result := dx;

end;


////////////////////////////////////////////////////////////////////////////////
//
// Change type of dot matrix.
//
////////////////////////////////////////////////////////////////////////////////
{
procedure TLCDScreen.SetDotMatrix(Value: TDotMatrix);
begin
  if Value <> FDotMatrix
  then begin
         FDotMatrix := Value;
         UpdateInternalMatrixBitmap;
         end;
end;
}

////////////////////////////////////////////////////////////////////////////////
//
// Set a PixelOff border around a character.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetDotMatrixBorders(Value: TDotMatrixBorders);
begin
  if Value <> FDotMatrixBorders
  then begin
         FDotMatrixBorders := Value;
         SetCorrectSize;
         UpdateInternalMatrixBitmap;
         end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Change border style.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetBorderStyle(Value: TLCDBorder);
begin
  if Value <> FBorderStyle
  then begin
         FBorderStyle := Value;
         //Paint;
         end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Change shape of LCD pixels.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetPixelShape(Value: TPixelShape);
begin
  if Value <> FPixelShape
  then begin
         FPixelShape := Value;
         SetCorrectSize;
         UpdateInternalMatrixBitmap;
         //Paint;
         end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Change pixel spacing (distance between the pixels in the LCD).
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetPixelSpacing(Value: Byte);
begin
  if Value <> FPixelSpacing
  then begin
         FPixelSpacing := Value;
         SetCorrectSize;
         UpdateInternalMatrixBitmap;
         end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Change character spacing (Distance between characters in the LCD).
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetCharSpacing(Value: Byte);
begin
  if Value <> FCharSpacing
  then begin
         FCharSpacing := Value;
         //Paint;
         end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Change space between lines in a multi-line LCD.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetLineSpacing(Value: Byte);
begin
  if Value <> FLineSpacing
  then begin
         FLineSpacing := Value;
         //Paint;
         end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Change LCD pixel size.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetPixelSize(Value: TPixelSize);
begin
  if Value <> FPixelSize
  then begin
         FPixelSize := Value;
         SetCorrectSize;
         UpdateInternalMatrixBitmap;
         end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Set space between the border and character array.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetBorderSpace(Value: Byte);
begin
  if Value <> FBorderSpace
  then begin
         FBorderSpace := Value;
         //Paint;
         end;
end;

////////////////////////////////////////////////////////////////////////////////
//
// Set component color.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetColor(Value: TColor);
begin
  if Value <> FColor
  then begin
         FColor := Value;
         UpdateInternalMatrixBitmap;
         //if not FAnimationEnabled then Paint;
         end;
end;

////////////////////////////////////////////////////////////////////////////////
//
// Set component font.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetFont(Value: TFont);
begin
  if Value <> FFont
  then begin
         FFont := Value;
         SetCorrectSize;
         UpdateInternalCharBitmap;
         //if not FAnimationEnabled then Paint;
         end;
end;

procedure TLCDScreen.OnFontChange(Sender: TObject);
begin
  SetCorrectSize;
  UpdateInternalCharBitmap;
  //if not FAnimationEnabled then Paint;
end;

////////////////////////////////////////////////////////////////////////////////
//
// Set pixel ON color.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetPixelOnColor(Value: TColor);
begin
  if Value <> FPixelOnColor
  then begin
         FPixelOnColor := Value;
         UpdateTrueColors;
         //if not FAnimationEnabled then Paint;
         end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Set pixel OFF color.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetPixelOffColor(Value: TColor);
begin
  if Value <> FPixelOffColor
  then begin
         FPixelOffColor := Value;
         UpdateTrueColors;
         //if not FAnimationEnabled then Paint;
         end;
end;


///////////////////////////////////////////////////////////////////////////////
//
// Set pixel ON color's intensity.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetIntensity(Value: ShortInt);
begin
  if Value <> FIntensity
  then begin
         FIntensity := Value;
         UpdateTrueColors;
         //if not FAnimationEnabled then Paint;
         end;
end;


///////////////////////////////////////////////////////////////////////////////
//
// Calculate TrueOnColor.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.UpdateTrueColors;
var
  DeltaRed, DeltaGreen, DeltaBlue: Integer;
  R, G, B: Byte;
begin
  DeltaRed := GetRValue(ColorToRGB(FPixelOffColor)) - GetRValue(ColorToRGB(FPixelOnColor));
  DeltaGreen := GetGValue(ColorToRGB(FPixelOffColor)) - GetGValue(ColorToRGB(FPixelOnColor));
  DeltaBlue := GetBValue(ColorToRGB(FPixelOffColor)) - GetBValue(ColorToRGB(FPixelOnColor));
  R := MulDiv(129 - Abs(FIntensity), DeltaRed, 128);
  G := MulDiv(129 - Abs(FIntensity), DeltaGreen, 128);
  B := MulDiv(129 - Abs(FIntensity), DeltaBlue, 128);

  if FIntensity >= 0
  then begin
         FTrueOnColor := RGB(R, G, B);
         FTrueOffColor := FPixelOffColor;
         end
  else begin
         FTrueOnColor := FPixelOffColor;
         FTrueOffColor := RGB(R, G, B);
         end;

  UpdateInternalMatrixBitmap;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Set the animation unit.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetSpecialEffects(Value: TSpecialEffects);
begin
  if Value <> FSpecialEffects
  then begin
         FSpecialEffects := Value;
         UpdateInternalMatrixBitmap;
         //if not FAnimationEnabled then Paint;
         end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Set the animation unit.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetAnimationUnits(Value: TAnimationUnit);
begin
  if Value <> FAnimationUnits
  then begin
         FAnimationUnits := Value;
         if FAnimationUnits = auChar then begin
                                            PixVRef := 0;
                                            PixHRef := 0;
                                            end;
         //if not FAnimationEnabled then Paint;
         end;
end;

////////////////////////////////////////////////////////////////////////////////
//
// Set pixel width.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetPixelWidth(Value: Byte);
begin
  if FPixelSize = pixCustom
  then if Value <> FPixelWidth
       then if Value < 1
            then MessageDlg('Display pixel width must be 1 or more!', mtError, [mbOk], 0)
            else begin
                   FPixelWidth := Value;
                   SetCorrectSize;
                   UpdateInternalMatrixBitmap;
                   end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Set pixel height.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetPixelHeight(Value: Byte);
begin
  if FPixelSize = pixCustom
  then if Value <> FPixelHeight
       then if Value < 1
            then MessageDlg('Display pixel height must be 1 or more!', mtError, [mbOk], 0)
            else begin
                   FPixelHeight := Value;
                   SetCorrectSize;
                   UpdateInternalMatrixBitmap;
                   end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Set FLines strings.
//
////////////////////////////////////////////////////////////////////////////////