?? lcdscreen.pas.svn-base
字號:
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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -