如何从字符串中设置单个字符颜色并在TLabel中显示？

Question

I am having one Delphi XE2 project. My objective is to separate individual character from a string then change the Font Color after that all the characters will be displayed in Scrolling TLabel .
Basically my project is to display Scrolling Tex with each characters having different color from prevoius character. Character color will vary according to Color Slider .
So I have implemented the following logic:

1. Using Timer1 the LeftMostCharacter will be separated and the color will be changed and then it will be added to Label1 . Label1 will scroll from right to left.
2. Using Timer2 the RightMostCharacter will be separated and the color will be changed and then it will be added to Label1 . Label1 will scroll from left to right.

So I have written the following codes:
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TMainForm = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Timer1: TTimer;
    Timer2: TTimer;
    Button1: TButton;
    Button2: TButton;
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.Button1Click(Sender: TObject);
begin
  Timer1.Enabled := true;
  Timer2.Enabled := true;
end;

procedure TMainForm.Button2Click(Sender: TObject);
begin
  Timer1.Enabled := false;
  Timer2.Enabled := false;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  MainForm.Color := RGB(41, 41, 41);
  Timer1.Interval := 100;
  Label1.Font.Color := RGB(000, 255, 000);
  Label1.Caption := ' Koushik Halder''s Left Scrolling Text Effect Example 001 Koushik Halder''s Left Scrolling Text Effect Example 001 ';
  Timer2.Interval := 100;
  Label2.Font.Color := RGB(000, 000, 255);
  Label2.Caption := ' Koushik Halder''s Right Scrolling Text Effect Example 001 Koushik Halder''s Right Scrolling Text Effect Example 001 ';
end;

procedure TMainForm.Timer1Timer(Sender: TObject);
var
  StringLength01: integer;
  LeftScrollingText: string;
  LeftMostCharacter: string;

  R1, G1, B1: Integer;
  IncrementalFactor, DecrementalFactor: Integer;
begin
  IncrementalFactor := 15;  //  May Be '01', '05', '15'
  DecrementalFactor := 15;  //  May Be '01', '05', '15'

  // Get The Leftmost Character From Label1.Caption
  StringLength01 := Length(Label1.Caption);
  LeftMostCharacter  := Label1.Caption[1];

  R1 := GetRValue(ColorToRGB(Label1.Font.Color));
  G1 := GetGValue(ColorToRGB(Label1.Font.Color));
  B1 := GetBValue(ColorToRGB(Label1.Font.Color));
  if (R1 = 255) and (G1 = 000) and (B1 < 255) then
    begin
      B1 := B1 + IncrementalFactor;
    end
  else if (R1 > 000) and (G1 = 000) and (B1 = 255) then
    begin
      R1 := R1 - DecrementalFactor;
    end
  else if (R1 = 000) and (G1 < 255) and (B1 = 255) then
    begin
      G1 := G1 + IncrementalFactor;
    end
  else if (R1 = 000) and (G1 = 255) and (B1 > 000) then
    begin
      B1 := B1 - DecrementalFactor;
    end
  else if (R1 < 255) and (G1 = 255) and (B1 = 000) then
    begin
      R1 := R1 + IncrementalFactor;
    end
  else if (R1 = 255) and (G1 > 000) and (B1 = 000) then
    begin
      G1 := G1 - DecrementalFactor;
    end
  else
    begin
      Timer1.Enabled := false;
    end;
  Label1.Font.Color := RGB(R1, G1, B1);

  // Trim The Strings
  Label1.Caption := Copy(Label1.Caption, 2, StringLength01 -1);
  LeftScrollingText := Label1.Caption + LeftMostCharacter;
  Label1.Caption := LeftScrollingText;
end;

procedure TMainForm.Timer2Timer(Sender: TObject);
var
  StringLength02: integer;
  RightScrollingText: string;
  RightMostCharacter: string;

  R2, G2, B2: Integer;
  IncrementalFactor, DecrementalFactor: Integer;
begin
  IncrementalFactor := 15;  //  May Be '01', '05', '15'
  DecrementalFactor := 15;  //  May Be '01', '05', '15'

  // Get The Rightmost Character From Label2.Caption
  StringLength02 := Length(Label2.Caption);
  RightMostCharacter  := Label2.Caption[StringLength02];

  R2 := GetRValue(ColorToRGB(Label2.Font.Color));
  G2 := GetGValue(ColorToRGB(Label2.Font.Color));
  B2 := GetBValue(ColorToRGB(Label2.Font.Color));
  if (R2 = 255) and (G2 = 000) and (B2 < 255) then
    begin
      B2 := B2 + IncrementalFactor;
    end
  else if (R2 > 000) and (G2 = 000) and (B2 = 255) then
    begin
      R2 := R2 - DecrementalFactor;
    end
  else if (R2 = 000) and (G2 < 255) and (B2 = 255) then
    begin
      G2 := G2 + IncrementalFactor;
    end
  else if (R2 = 000) and (G2 = 255) and (B2 > 000) then
    begin
      B2 := B2 - DecrementalFactor;
    end
  else if (R2 < 255) and (G2 = 255) and (B2 = 000) then
    begin
      R2 := R2 + IncrementalFactor;
    end
  else if (R2 = 255) and (G2 > 000) and (B2 = 000) then
    begin
      G2 := G2 - DecrementalFactor;
    end
  else
    begin
      Timer2.Enabled := false;
    end;
  Label2.Font.Color := RGB(R2, G2, B2);

  //Trim The Strings
  Label2.Caption := Copy(Label2.Caption, 1, StringLength02 -1);
  RightScrollingText := RightMostCharacter + Label2.Caption;
  Label2.Caption := RightScrollingText;
end;

end.    

But my problem is that the Font Color varies according to the Color Slider for the whole String (ie Label1 and Label2 ) instead of individual character.

Answer 1

The TLabel control does not give you character by character styling. You cannot hope to achieve your goal using TLabel . Some options:

• Paint the text yourself, perhaps with a TPaintBox control. Paint the text character by character.
• Use a windowless rich edit control and apply distinct styling to each character.
• Use an extant library that offers such capabilities. For example graphics32 with GR32_Text .