jvqmarkuplabel.pas

East make Tray Icon in delphi

      PushTag;
      FStyle := FStyle + [fsUnderline];
    end
    else
    if ATag = '/u' then
    begin // cancel underline
      FStyle := FStyle - [fsUnderline];
      PopTag;
    end
    else
    if ATag = 'font' then
      PushTag
    else
    if ATag = '/font' then
      PopTag;
    if HaveParams then
    begin
      repeat
        PP := Pos('="', SS);
        if PP > 0 then
        begin
          APar := LowerCase(Trim(Copy(SS, 1, PP - 1)));
          Delete(SS, 1, PP + 1);
          PP := Pos('"', SS);
          if PP > 0 then
          begin
            AVal := Copy(SS, 1, PP - 1);
            Delete(SS, 1, PP);
            if APar = 'face' then
              FName := AVal
            else
            if APar = 'size' then
              try
                FSize := StrToInt(AVal);
              except
              end
            else
            if APar = 'color' then
              try
                if HTMLStringToColor(AVal, AColor) then
                  FColor := AColor;
              except
              end;
          end;
        end;
      until PP = 0;
    end;
  end;

begin
  FElementStack.Clear;
  FTagStack.Clear;
  FStyle := Font.Style;
  FName := Font.Name;
  FSize := Font.Size;
  FColor := Font.Color;
  FBreakLine := False;
  repeat
    P := Pos('<', S);
    if P = 0 then
    begin
      FText := S;
      PushElement;
    end
    else
    begin
      if P > 1 then
      begin
        SE := Copy(S, 1, P - 1);
        FText := SE;
        PushElement;
        Delete(S, 1, P - 1);
      end;
      P := Pos('>', S);
      if P > 0 then
      begin
        ST := Copy(S, 2, P - 2);
        Delete(S, 1, P);
        ParseTag(ST);
      end;
    end;
  until P = 0;
end;

procedure TJvMarkupLabel.RenderHTML;
var
  R: TRect;
  I, C, X, Y: Integer;
  ATotalWidth, AClientWidth, ATextWidth, BaseLine: Integer;
  iSol, iEol, PendingCount, MaxHeight, MaxAscent: Integer;
  El: TJvHTMLElement;
  Eol: Boolean;
  PendingBreak: Boolean;
  lSolText: string;
  MaxWidth: Integer;

  procedure SetFont(EE: TJvHTMLElement);
  begin
    with Canvas do
    begin
      Font.Name := EE.FontName;
      Font.Size := EE.FontSize;
      Font.Style := EE.FontStyle;
      Font.Color := EE.FontColor;
    end;
  end;

  procedure RenderString(EE: TJvHTMLElement; Test: Boolean);
  var
    SS: string;
    WW: Integer;
  begin
    SetFont(EE);
    if EE.SolText <> '' then
    begin
      SS := TrimLeft(EE.SolText);
      WW := Canvas.TextWidth(SS);
      if not Test then
        Canvas.TextOut(X, Y + BaseLine - EE.Ascent, SS);
      X := X + WW;
    end;
  end;

begin
  iEol := 0; // Not Needed but removes warning.
  R := ClientRect;
  Canvas.Brush.Color := Color;
  DrawThemedBackground(Self, Canvas, R);
  C := FElementStack.Count;
  if C = 0 then
    Exit;
  HTMLClearBreaks;
  if AutoSize then
    AClientWidth := 10000
  else
    AClientWidth := ClientWidth - MarginLeft - MarginRight;

  Canvas.Brush.Style := bsClear;
  Y := MarginTop;
  iSol := 0;
  PendingBreak := False;
  PendingCount := -1;
  MaxWidth := 0;
  repeat
    I := iSol;
    ATotalWidth := AClientWidth;
    ATextWidth := 0;
    MaxHeight := 0;
    MaxAscent := 0;
    Eol := False;
    repeat // scan line
      El := TJvHTMLElement(FElementStack.Items[I]);
      if El.BreakLine then
      begin
        if not PendingBreak and (PendingCount <> I) then
        begin
          PendingBreak := True;
          PendingCount := I;
          iEol := I;
          Break;
        end
        else
          PendingBreak := False;
      end;
      if El.Height > MaxHeight then
        MaxHeight := El.Height;
      if El.Ascent > MaxAscent then
        MaxAscent := El.Ascent;
      if El.Text <> '' then
      begin
        lSolText := El.SolText;
        // (Lionel) If Breakup can do something, I increase a bit the space until
        // it can do the break ...
        repeat
          El.Breakup(Canvas, ATotalWidth);
          Inc(ATotalWidth, 5);
        until lSolText <> El.SolText;
      end;
      if El.SolText <> '' then
      begin
        ATotalWidth := ATotalWidth - Canvas.TextWidth(El.SolText) - 5;
        ATextWidth := ATextWidth + Canvas.TextWidth(El.SolText);
        if El.EolText = '' then
        begin
          if I >= C - 1 then
          begin
            Eol := True;
            iEol := I;
          end
          else
            Inc(I);
        end
        else
        begin
          Eol := True;
          iEol := I;
        end;
      end
      else
      begin // Eol
        Eol := True;
        iEol := I;
      end;
    until Eol;

    // render line
    BaseLine := MaxAscent;

    if AutoSize then
    begin
      X := MarginLeft;
      if (ATextWidth + MarginLeft + MarginRight) > MaxWidth then
        MaxWidth := (ATextWidth + MarginLeft + MarginRight);
    end
    else
      case Alignment of
        taLeftJustify:
          X := MarginLeft;
        taRightJustify:
          X := Width - MarginRight - ATextWidth;
        taCenter:
          X := MarginLeft + (Width - MarginLeft - MarginRight - ATextWidth) div 2;
      end;

    for I := iSol to iEol do
    begin
      El := TJvHTMLElement(FElementStack.Items[I]);
      RenderString(El, False);
    end;

    Y := Y + MaxHeight;
    iSol := iEol;
  until (iEol >= C - 1) and (El.EolText = '');
  if AutoSize then
  begin
    Width := MaxWidth;
    Height := Y + 5;
  end;
end;

procedure TJvMarkupLabel.SetAlignment(const Value: TAlignment);
begin
  if Value <> FAlignment then
  begin
    FAlignment := Value;
    Invalidate;
  end;
end;

procedure TJvMarkupLabel.SetAutoSize(Value: Boolean);
begin  
  FAutoSize := Value; 
  Invalidate;
end;

procedure TJvMarkupLabel.SetMarginLeft(const Value: Integer);
begin
  FMarginLeft := Value;
  Invalidate;
end;

procedure TJvMarkupLabel.SetMarginRight(const Value: Integer);
begin
  FMarginRight := Value;
  Invalidate;
end;

procedure TJvMarkupLabel.SetMarginTop(const Value: Integer);
begin
  FMarginTop := Value;
  Invalidate;
end;

procedure TJvMarkupLabel.SetText(const Value: TCaption);
var
  S: string;
begin
  if Value = FText then
    Exit;
  S := Value;
  S := StringReplace(S, SLineBreak, ' ', [rfReplaceAll]);
  S := TrimRight(S);
  FText := S; 
  inherited SetText(FText); 
  Refresh;
end;

{function TJvMarkupLabel.GetBackColor: TColor;
begin
  Result := Color;
end;

procedure TJvMarkupLabel.SetBackColor(const Value: TColor);
begin
  Color := Value;
end;}

procedure TJvMarkupLabel.DoReadBackColor(Reader: TReader);
begin
  if Reader.NextValue = vaIdent then
    Color := StringToColor(Reader.ReadIdent)
  else
    Color := Reader.ReadInteger;
end;

procedure TJvMarkupLabel.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('BackColor', DoReadBackColor, nil, False);
end;

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

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.