lcdscreen.pas.svn-base

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

procedure TLCDScreen.SetLines(Value: TStringList);
begin
  FLines.Assign(Value);
end;


////////////////////////////////////////////////////////////////////////////////
//
// Update Display with new FLines right values.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.LinesOnChange(Sender: TObject);       
var i, j, offset: ShortInt;
    tempstr: WideString;


  function ExtractSpEff(str: String; k: ShortInt; startspecial_char, stopspecial_char: WideChar;
                        nb: ShortInt): ShortInt;
  var flag: ShortInt;
  begin
    flag := 1;
    repeat
      if tempstr[k] = stopspecial_char then k:= 1
      else if tempstr[k] = startspecial_char then begin flag:= nb; k := 1; end;
      dec(k)
      until k <= 0;
    ExtractSpEff := flag;
    end;


begin
  Fillchar(Display, sizeof(Display),0);

  for i := 0 to FLines.Count - 1
  do begin
       tempstr := FLines[i];
       offset := 0;

       for j := 1 to Length(tempstr)
       do begin
            if CountSpecialCharString(tempstr[j]) = 0 then
            begin
                        Display[i,j-offset-1].TheChar := tempstr[j];
                        Display[i,j-offset-1].SpEff := ExtractSpEff(tempstr[j], j-1, startinverse_char,   stopinverse_char,   2) *
                                                     ExtractSpEff(tempstr[j], j-1, startblinking_char,  stopblinking_char,  3) *
                                                     ExtractSpEff(tempstr[j], j-1, startunderline_char, stopunderline_char, 5) *
                                                     ExtractSpEff(tempstr[j], j-1, startstrike_char,    stopstrike_char,    7);
                        if Display[i,j-offset-1].SpEff = 1 then Dec(Display[i,j-offset-1].SpEff);

            end
            else
              inc(offset);
        end;
  end;
  Paint;
end;



////////////////////////////////////////////////////////////////////////////////
//
// Set LCDAnimator.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetLCDAnimator(Value: TLCDAnimator);
var tmr: TModalResult;
begin
  if Value <> FLCDAnimator
  then begin
         if Value <> nil
         then begin
                tmr := mrIgnore;

                if Value.CodeErrorFound and (csDesigning in ComponentState)
                then tmr := MessageDlg('Code synthax error(s) detected in this TLCDAnimator.' +
                                       #13 +#10 + #13 + #10 + 'Continue anyway?',
                                       mtWarning, [mbAbort, mbIgnore], 0);
                if tmr = mrIgnore
                then FTimer.OnTimer := TimerOnTimer;
                end;
         FLCDAnimator := Value;
         end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Notification routine when a TLCDAnimator is removed and was linked to a TLCDScreen.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and Assigned(FLCDAnimator) and (AComponent = FLCDAnimator)
  then FLCDAnimator := nil;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Set Animation Speed.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetAnimationDelay(Value: Cardinal);
begin
  if Value <> FAnimationDelay
  then begin
         FAnimationDelay := Value;
         FTimer.Interval := Value;
         end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Set Animation Active.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetAnimationEnabled(Value: Boolean);
begin
  if Value <> FAnimationEnabled
  then begin
         FAnimationEnabled := Value;
         FTimer.Enabled := Value;
         end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Set Cycling Animation.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.SetAnimationRepeating(Value: Boolean);
begin
  if Value <> FAnimationRepeating
  then FAnimationRepeating := Value;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Reset Method.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.Reset(Value: TResetMode);
begin
  case Value of
    rmDisplay: begin
                 PixVRef  := 0;
                 PixHRef  := 0;
                 CharVRef := 0;
                 CharHRef := 0;
                 LinesOnChange(Self);
                 end;

    rmCode   : FLCDAnimator.CurrentLine := 0;
    
    else begin {rmDisplayAndCode}
           PixVRef  := 0;
           PixHRef  := 0;
           CharVRef := 0;
           CharHRef := 0;
           LinesOnChange(Self);
           FLCDAnimator.CurrentLine := 0;
           end;
    end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// General Animation routine.
// Recalc FtempLines strings. Decode CurrentLine and execute it.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.TimerOnTimer(Sender: TObject);
var tempcode: string;
    i: Integer;
begin
  if FLCDAnimator <> nil
  then begin
         FBlinkingStatus := not FBlinkingStatus;
         if FLCDAnimator.Code.Count <> 0 then tempcode  :=  FLCDAnimator.Code[FLCDAnimator.CurrentLine];
         P := AllocMem(NbOfThings(tempcode, ';') * SizeOf(TCodeInstruction)); //Removing dynamic Arrays...
         ExtractCode(tempcode, P^, NbOfThings(tempcode, ';'));

         for i := 1 to NbOfThings(tempcode, ';')
         do begin
              if P^[i].Word = 'horzscroll' then HorzScroll(P^[i].Param);
              if P^[i].Word = 'vertscroll' then VertScroll(P^[i].Param);
              if P^[i].Word = 'setintensity' then SetIntensity(P^[i].Param);
              if P^[i].Word = 'animationdelay' then SetAnimationDelay(P^[i].Param);
              if P^[i].Word = 'gotoline' then FLCDAnimator.CurrentLine := Min(P^[i].Param, FLCDAnimator.Code.Count);
              if P^[i].Word = 'resetdisplay' then Reset(rmDisplay);
              end;
         if Assigned(FLCDAnimator.FOnLineExecuted) then FLCDAnimator.FOnLineExecuted(FLCDAnimator, FLCDAnimator.CurrentLine);

         if FLCDAnimator.CurrentLine = FLCDAnimator.Code.Count - 1
         then begin
                FLCDAnimator.CurrentLine := 0;
                if not FAnimationRepeating then SetAnimationEnabled(False);
                if Assigned(FLCDAnimator.FOnEndCode) then FLCDAnimator.FOnEndCode(FLCDAnimator);
                end
         else FLCDAnimator.CurrentLine := FLCDAnimator.CurrentLine + 1;
         FreeMem(P); //Removing dynamic Arrays...

         Paint;
         end;
  end;


////////////////////////////////////////////////////////////////////////////////
//
// HorzScroll Routine.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.HorzScroll(Value: ShortInt);
var
  i: ShortInt;
begin
  if FAnimationUnits = auChar
  then CharHRef := (CharHref - Value) mod TrueDisplayWidth
  else begin
         i := PixHRef + Value;
         PixHRef := i mod (FontWidth);
         i := i div (FontWidth);

         if i <> 0
         then CharHRef := (CharHref - i) mod TrueDisplayWidth;
         end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// VertScroll Routine.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDScreen.VertScroll(Value: ShortInt);
var
  i: ShortInt;
begin
  if FAnimationUnits = auChar
  then CharVRef := (CharVref - Value) mod TrueDisplayHeight
  else begin
         i := PixVRef + Value;
         PixVRef := i mod (FontHeight);
         i := i div (FontHeight);

         if i <> 0
         then CharVRef := (CharVref - i) mod TrueDisplayHeight;
         end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// TLCDScreen About routines.
//
////////////////////////////////////////////////////////////////////////////////

function TLCDScreen.GetAbout: string;
begin
  GetAbout := 'About LCDAnimator';
end;


procedure TLCDScreen.SetAbout(Value: string);
begin
  // just for syntax
end;


////////////////////////////////////////////////////////////////////////////////
//
// Create and initialize component TLCDAnimator.
//
////////////////////////////////////////////////////////////////////////////////

constructor TLCDAnimator.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCode := TStringList.Create;
  FCodeErrorFound := False;
  FCurrentLine := 0;
end;


///////////////////////////////////////////////////////////////////////////////
//
// Remove component TLCDAnimator.
//
////////////////////////////////////////////////////////////////////////////////

destructor TLCDAnimator.Destroy;
begin
  FCode.Destroy;
  inherited Destroy;
end;


////////////////////////////////////////////////////////////////////////////////
//
// Set FCode strings.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDAnimator.SetCode(Value: TStrings);
begin
  FCode.Assign(Value);
end;


////////////////////////////////////////////////////////////////////////////////
//
// Set FCurrentLine.
//
////////////////////////////////////////////////////////////////////////////////

procedure TLCDAnimator.SetCurrentLine(Value: SmallInt);
begin
  if Value <> FCurrentLine
  then begin
         if Value > Code.Count
         then Value := Max(0, Code.Count - 1);
         FCurrentLine := Value;
         end;
end;


////////////////////////////////////////////////////////////////////////////////
//
// TLCDAnimator About routines.
//
////////////////////////////////////////////////////////////////////////////////

function TLCDAnimator.GetAbout: string;
begin
  GetAbout := 'About LCDAnimator';
end;


procedure TLCDAnimator.SetAbout(Value: string);
begin
  // just for syntax
end;


////////////////////////////////////////////////////////////////////////////////
//
// TLCDScreen and TLCDAnimator registration.
//
////////////////////////////////////////////////////////////////////////////////

procedure Register;
begin
  RegisterComponents('LCDScreen', [TLCDScreen, TLCDAnimator]);
end;


end.