jvqsegmentedleddisplay.pas

East make Tray Icon in delphi

begin
  Result := FActiveMapping[Chr];
end;

procedure TJvSegmentedLEDCharacterMapper.SetCharMapping(Chr: Char; Value: Int64);
begin
  FActiveMapping[Chr] := Value;
  Modified;
end;

function TJvSegmentedLEDCharacterMapper.MaxSegments: Integer;
begin
  Result := Display.DigitClass.SegmentCount;
end;

function TJvSegmentedLEDCharacterMapper.MapToSeparators: Boolean;
begin
  Result := True;
end;

procedure TJvSegmentedLEDCharacterMapper.PrimReadMapping(const HdrInfo: TSegCharMapHeader;
  Stream: TStream);
var
  Chr: Char;
  MapSize: Byte;
  OldMapping: Int64;
begin
  Clear; // clear the mapping table
  MapSize := HdrInfo.Flags and 7;
  for Chr := #0 to #255 do
    if Chr in HdrInfo.MappedChars then
      Stream.ReadBuffer(FActiveMapping[Chr], MapSize);
  if HdrInfo.Flags and 16 <> 0 then
  begin
    // Swap . for DecimalSeparator and , for ThousandSeparator
    if DecimalSeparator <> '.' then
    begin
      OldMapping := FActiveMapping[DecimalSeparator];
      FActiveMapping[DecimalSeparator] := FActiveMapping['.'];
      FActiveMapping[ThousandSeparator] := OldMapping;
    end;
  end;
end;

function TJvSegmentedLEDCharacterMapper.UpdateStates(var Segments: Int64;
  SegMask: Int64): Boolean;
var
  OldValue: Int64;
begin
  OldValue := Segments;
  if FSegMapRemoves then
    Segments := Segments and not SegMask
  else
    Segments := Segments or SegMask;
  Result := Segments <> OldValue;
end;

procedure TJvSegmentedLEDCharacterMapper.HandleDecimalSeparator(var Text: PChar;
  var Segments: Int64);
begin
  if (CurDigit is TJvBaseSegmentedLEDDigit) and TJvBaseSegmentedLEDDigit(CurDigit).UseDP then
  begin
    if UpdateStates(Segments, 1 shl CurDigit.GetSegmentIndex('DP')) then
      TextForDigit := TextForDigit + DecimalSeparator;
    while Text[0] = DecimalSeparator do
      Inc(Text);
  end;
end;

function TJvSegmentedLEDCharacterMapper.CharToSegments(Ch: Char; var Segments: Int64): Boolean;
begin
  Result := UpdateStates(Segments, FActiveMapping[Ch]) or (Ch = ' ');
end;

procedure TJvSegmentedLEDCharacterMapper.ControlItemToSegments(var ControlItem: PChar;
  var Segments: Int64);
var
  OrdValue: Byte;
begin
  case ControlItem^ of
    '+':
      begin
        if FSegMapRemoves then
          TextForDigit := TextForDigit + '+';
        FSegMapRemoves := False;
        Inc(ControlItem);
      end;
    '-':
      begin
        if not FSegMapRemoves then
          TextForDigit := TextForDigit + '-';
        FSegMapRemoves := True;
        Inc(ControlItem);
      end;
    '&':
      begin
        Inc(ControlItem);
        if CharToSegments(ControlItem^, Segments) then
          TextForDigit := TextForDigit + '&' + ControlItem[0];
        Inc(ControlItem);
      end;
    '#':
      begin
        Inc(ControlItem);
        OrdValue := 0;
        while ControlItem[0] in DigitSymbols do
        begin
          if OrdValue >= 100 then
            OrdValue := OrdValue mod 100;
          if OrdValue >= 26 then
            OrdValue := OrdValue mod 10;
          OrdValue := OrdValue * 10 + (Ord(ControlItem[0]) - Ord('0'));
          Inc(ControlItem);
        end;
        if CharToSegments(Chr(OrdValue), Segments) then
        begin
          if OrdValue in [32 .. 127] then
            TextForDigit := TextForDigit + '&' + Chr(OrdValue)
          else
            TextForDigit := TextForDigit + '#' + IntToStr(OrdValue);
        end;
      end;
    else
        MapSegNamesToSegments(ControlItem, Segments);
  end;
  while ControlItem[0] = ';' do
    Inc(ControlItem);
end;

procedure TJvSegmentedLEDCharacterMapper.MapControlItems(var Text: PChar; var Segments: Int64);
begin
  Inc(Text);
  TextForDigit := TextForDigit + '[';
  while not (Text^ in [#0, ']']) do
    ControlItemToSegments(Text, Segments);
  if Text^ = ']' then
  begin
    Inc(Text);
    TextForDigit := TextForDigit + ']';
  end;
  if Text[0] = DecimalSeparator then
    HandleDecimalSeparator(Text, Segments);
end;

procedure TJvSegmentedLEDCharacterMapper.MapSimpleText(var Text: PChar; var Segments: Int64);
begin
  if CharToSegments(Text^, Segments) then
    TextForDigit := TextForDigit + Text^;
  Inc(Text);
  if Text[0] = DecimalSeparator then
    HandleDecimalSeparator(Text, Segments);
end;

procedure TJvSegmentedLEDCharacterMapper.MapSegNamesToSegments(var Text: PChar;
  var Segments: Int64);
var
  SortedSegNames: TStringList;
  I: Integer;
begin
  SortedSegNames := TStringList.Create;
  try
    for I := 0 to CurDigit.SegmentCount - 1 do
      SortedSegNames.Add(CurDigit.GetSegmentName(I));
    SortedSegNames.Sort;

    while not (Text[0] in [#0, ']', ';']) do
    begin
      I := SortedSegNames.Count - 1;
      while I >= 0 do
      begin
        if AnsiStrLIComp(Text, PChar(SortedSegNames[I]), Length(SortedSegNames[I])) = 0 then
        begin
          if UpdateStates(Segments, 1 shl CurDigit.GetSegmentIndex(SortedSegNames[I])) then
            TextForDigit := TextForDigit + SortedSegNames[I];
          Inc(Text, Length(SortedSegNames[I]));
          Break; // End the for loop
        end;
        Dec(I);
      end;
      if I < 0 then
        Inc(Text);
      if Text[0] = ',' then
        Inc(Text);
    end;
   finally
     FreeAndNil(SortedSegNames);
   end;
end;

procedure TJvSegmentedLEDCharacterMapper.PrimMapText(var Text: PChar; var Segments: Int64);
begin
  case Text^ of
    #0:
      Exit;
    '[':
      MapControlItems(Text, Segments);
    else
      MapSimpleText(Text, Segments);
  end;
end;

procedure TJvSegmentedLEDCharacterMapper.Modified;
begin
  FMappingChanged := True;
  Display.RemapText;
end;

procedure TJvSegmentedLEDCharacterMapper.MapText(var Text: PChar;
  ADigit: TJvCustomSegmentedLEDDigit);
var
  States: Int64;
begin
  FCurDigit := ADigit;
  FTextForDigit := '';
  States := 0;
  FSegMapRemoves := False;
  PrimMapText(Text, States);
  CurDigit.SetSegmentStates(States);
  if FTextForDigit = '' then // assume a space was used
    FTextForDigit := ' ';
  CurDigit.UpdateText(FTextForDigit);
end;

procedure TJvSegmentedLEDCharacterMapper.Clear;
begin
  FillChar(FActiveMapping[#0], SizeOf(FActiveMapping), 0);
end;

procedure TJvSegmentedLEDCharacterMapper.LoadDefaultMapping;
var
  Stream: TStream;
begin
  Stream := TResourceStream.Create(HInstance, Display.DigitClass.MapperFileID + '_DEFAULT', RT_RCDATA);
  try
    LoadFromStream(Stream);
    FMappingChanged := False;
  finally
    FreeAndNil(Stream);
  end;
end;

procedure TJvSegmentedLEDCharacterMapper.LoadFromFile(const FileName: string);
var
  FS: TFileStream;
begin
  FS := TFileStream.Create(FileName, fmOpenRead + fmShareDenyWrite);
   try
     LoadFromStream(FS);
   finally
     FS.Free;
   end;
end;

procedure TJvSegmentedLEDCharacterMapper.LoadFromStream(Stream: TStream);
var
  OrgPos: Integer;
  Hdr: TSegCharMapHeader;
begin
  OrgPos := Stream.Position;
  try
    Stream.ReadBuffer(Hdr, SizeOf(Hdr));
    if StrLIComp(Hdr.ID, PChar(Display.DigitClass.MapperFileID), Length(Display.DigitClass.MapperFileID)) = 0 then
      PrimReadMapping(Hdr, Stream)
    else
      raise EJVCLSegmentedLEDException.CreateRes(@RsEInvalidMappingFile);
  except
    Stream.Position := OrgPos;
    raise;
  end;
end;

procedure TJvSegmentedLEDCharacterMapper.SaveToFile(const FileName: string);
var
  FS: TFileStream;
begin
  FS := TFileStream.Create(FileName, fmCreate);
   try
     SaveToStream(FS);
   finally
     FS.Free;
   end;
end;

procedure TJvSegmentedLEDCharacterMapper.SaveToStream(Stream: TStream);
var
  Hdr: TSegCharMapHeader;
  TmpID: string;
  MapSize: Byte;
  Chr: Char;
  TmpDot: Int64;
  TmpComma: Int64;
begin
  FillChar(Hdr, SizeOf(Hdr), 0);
  TmpID := Display.DigitClass.MapperFileID;
  Move(TmpID[1], Hdr.ID, Length(TmpID));
  Hdr.Flags := MaxSegments;
  MapSize := (Hdr.Flags div 8) + Ord((Hdr.Flags mod 8) <> 0);
  Hdr.Flags := MapSize;
  Hdr.Flags := Hdr.Flags or (16 * Ord(MapToSeparators));
  Hdr.MappedChars := [];
  TmpDot := FActiveMapping['.'];
  TmpComma := FActiveMapping[','];
  if DecimalSeparator <> '.' then
  begin
    FActiveMapping['.'] := TmpComma;
    FActiveMapping[','] := TmpDot;
  end;
  try
    for Chr := #0 to #255 do
      if FActiveMapping[Chr] <> 0 then
        Include(Hdr.MappedChars, Chr);
    Stream.WriteBuffer(Hdr, SizeOf(Hdr));
    for Chr := #0 to #255 do
      if FActiveMapping[Chr] <> 0 then
        Stream.WriteBuffer(FActiveMapping[Chr], MapSize);
  finally
    if DecimalSeparator <> '.' then
    begin
      FActiveMapping['.'] := TmpDot;
      FActiveMapping[','] := TmpComma;
    end;
  end;
end;

//=== { TJv7SegmentedLEDDigit } ==============================================

procedure TJv7SegmentedLEDDigit.EnableAllSegs;
begin
  inherited EnableAllSegs;
  UseColon := scuFull;
end;

function TJv7SegmentedLEDDigit.GetUseColon: T7SegColonUsage;
begin
  Result := FUseColon;
end;

procedure TJv7SegmentedLEDDigit.SetUseColon(Value: T7SegColonUsage);
begin
  if Value <> UseColon then
  begin
    FUseColon := Value;
    InvalidateRefPoints;
  end;
end;

class function TJv7SegmentedLEDDigit.SegmentCount: Integer;
begin
  Result := 10;
end;

class function TJv7SegmentedLEDDigit.GetSegmentName(Index: Integer): string;
begin
  if Index <= 7 then
    Result := inherited GetSegmentName(Index)
  else
  if Index = 8 then
    Result := 'CL'
  else
  if Index = 9 then
    Result := 'CH'
  else
    Result := '';
end;

class function TJv7SegmentedLEDDigit.GetSegmentIndex(Name: string): Integer;
begin
  Result := inherited GetSegmentIndex(Name);
  if Result = -1 then
  begin
    Name := UpperCase(Name);
    if Name = 'CL' then
      Result := 8
    else
    if Name = 'CH' then
      Result := 9;
  end;
end;

procedure TJv7SegmentedLEDDigit.RecalcSegments;
begin
  if UseColon <> scuColonOnly then
    inherited RecalcSegments;
  if UseColon in [scuLowOnly, scuFull, scuColonOnly] then
    CalcCLSeg(8);
  if UseColon in [scuFull, scuColonOnly] then
    CalcCHSeg(9);
end;

class function TJv7SegmentedLEDDigit.MapperFileID: string;
begin
  Result := 'SLDCM_7SEG';
end;

procedure TJv7SegmentedLEDDigit.CalcCHSeg(Index: Integer);
var
  UpperLeftPoint: TPoint;
begin
  UpperLeftPoint := AngleAdjustPoint(FRefCenterX - DotSize div 2,
    (FRefCenterY - FRefTop) div 2 + FRefTop, SlantAngle);
  SetSegmentRenderInfo(Index, srtCircle,
    [UpperLeftPoint, Point(UpperLeftPoint.X + DotSize, UpperLeftPoint.Y + DotSize)]);
end;

procedure TJv7SegmentedLEDDigit.CalcCLSeg(Index: Integer);
var
  UpperLeftPoint: TPoint;
begin
  UpperLeftPoint := AngleAdjustPoint(FRefCenterX - DotSize div 2,
    (FRefBottom - FRefCenterY) div 2 + FRefCenterY - DotSize div 2, SlantAngle);
  SetSegmentRenderInfo(Index, srtCircle,
    [UpperLeftPoint, Point(UpperLeftPoint.X + DotSize, UpperLeftPoint.Y + DotSize)]);
end;

procedure ModuleUnload(Instance: Longint);
begin
  UnregisterModuleSegmentedLEDDigitClasses(HMODULE(Instance));
end;

function TextIndex(S: string; const Strings: array of string): Integer;
begin
  Result := High(Strings);
  while (Result > -1) and not AnsiSameText(S, Strings[Result]) do
    Dec(Result);
end;

function IdentToUnlitColor(const Ident: string; var Int: Longint): Boolean;
begin
  Int := TextIndex(Ident, ['clDefaultBackground', 'clDefaultLitColor']);
  Result := Int > -1;
  if Result then
    Inc(Int, clDefaultBackground)
  else
    Result := IdentToColor(Ident, Int);
end;

function UnlitColorToIdent(Int: Longint; var Ident: string): Boolean;
begin
  Result := True;
  case Int of
    clDefaultBackground:
      Ident := 'clDefaultBackground';
    clDefaultLitColor:
      Ident := 'clDefaultLitColor';
    else
      Result := ColorToIdent(Int, Ident);
  end;
end;

function StringToUnlitColor(const S: string): TUnlitColor;
begin
  if not IdentToUnlitColor(S, Longint(Result)) then
    Result := StrToInt(S);
end;

function UnlitColorToString(const Color: TUnlitColor): string;
begin
  if not ColorToIdent(Color, Result) then
    Result := Format('%s%.8x', [HexDisplayPrefix, Color]);
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQSegmentedLEDDisplay.pas,v $';
    Revision: '$Revision: 1.18 $';
    Date: '$Date: 2004/12/01 22:53:20 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

initialization
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}
 
  GroupDescendentsWith(TJvCustomSegmentedLEDDigit, TControl); 
  AddModuleUnloadProc(ModuleUnload);
  RegisterSegmentedLEDDigitClasses([TJv7SegmentedLEDDigit]);
  RegisterIntegerConsts(TypeInfo(TUnlitColor), IdentToUnlitColor, UnlitColorToIdent);

finalization
  {$IFDEF UNITVERSIONING}
  UnregisterUnitVersion(HInstance);
  {$ENDIF UNITVERSIONING} 
  UnregisterIntegerConsts(TypeInfo(TUnlitColor), IdentToUnlitColor, UnlitColorToIdent); 
  UnregisterModuleSegmentedLEDDigitClasses(HInstance);
  FreeAndNil(GDigitClassList);
  RemoveModuleUnloadProc(ModuleUnload);

end.