?? aactrls.pas
字號:
//繪制畫布
procedure TAALinkLabel.PaintCanvas;
begin
if FMouseIn or (FadeStyle <> fsNone) then
Bitblt(Canvas.Handle, 0, 0, Width, Height, BlendBmp.Canvas.Handle, 0, 0,
SRCCOPY)
else
inherited;
end;
//淡入淡出
procedure TAALinkLabel.OnFadeTimer(Sender: TObject);
begin
if Abs(NewProg - Progress) > 1 then
NewProg := Progress;
case FadeStyle of
fsIn: begin //淡入
NewProg := NewProg + csMaxProgress * FadeTimer.Interval div HotLink.FadeDelay;
if NewProg > csMaxProgress then
begin
NewProg := csMaxProgress;
FadeStyle := fsNone;
end;
Progress := Round(NewProg);
end;
fsOut: begin //淡出
NewProg := NewProg - csMaxProgress * FadeTimer.Interval div HotLink.FadeDelay;
if NewProg < 0 then
begin
NewProg := 0;
FadeStyle := fsNone;
end;
Progress := Round(NewProg);
end;
fsNone: begin //無
FadeTimer.Enabled := False;
end;
end;
end;
//繪制熱點畫布
procedure TAALinkLabel.DrawHot;
var
OffPoint: TPoint;
th, tw: Integer;
AAEffect: TAAEffect;
begin
BeginUpdate;
try
AAEffect := TAAEffect.Create(nil);
AAEffect.Assign(AAFont.Effect);
AAFont.Canvas := HotBmp.Canvas;
AAFont.Effect.Assign(HotLink.FontEffect);
HotBmp.Canvas.Font.Assign(Font); //字體
HotBmp.Canvas.Font.Color := HotLink.Color;
if HotLink.UnderLine then
HotBmp.Canvas.Font.Style := HotBmp.Canvas.Font.Style + [fsUnderline];
th := AAFont.TextHeight(Caption); //文本高度
tw := AAFont.TextWidth(Caption); //文本寬度
if AutoSize and (Align = alNone) then //自動設定大小
begin
OffPoint := Point(Border, Border);
end else begin
case Effect.Alignment of //水平對齊方式
taLeftJustify: OffPoint.x := Border;
taCenter: OffPoint.x := (ClientWidth - tw) div 2;
taRightJustify: OffPoint.x := ClientWidth - Border - tw;
end;
case Effect.Layout of //垂直對齊方式
tlTop: OffPoint.y := Border;
tlCenter: OffPoint.y := (ClientHeight - th) div 2;
tlBottom: OffPoint.y := ClientHeight - Border - th;
end;
end;
HotBmp.Height := ClientHeight;
HotBmp.Width := ClientWidth;
HotBmp.Canvas.Brush.Color := HotLink.BackColor;
HotBmp.Canvas.Brush.Style := bsSolid;
if HotLink.Transparent then
begin
CopyParentImage(HotBmp.Canvas);
end else if not HotLink.IsBackEmpty then
begin
DrawBackGround(HotBmp.Canvas, Rect(0, 0, HotBmp.Width, HotBmp.Height),
HotLink.BackGround.Graphic, HotLink.BackGroundMode);
end else
begin
HotBmp.Canvas.FillRect(ClientRect);
end;
HotBmp.Canvas.Brush.Style := bsClear;
AAFont.TextOut(OffPoint.x, OffPoint.y, Caption); //平滑字體輸出
AAFont.Effect.Assign(AAEffect);
AAEffect.Free;
finally
EndUpdate;
end;
end;
//鼠標移入開始淡入
procedure TAALinkLabel.CMMouseEnter(var Message: TMessage);
begin
if Enabled then
begin
FMouseIn := True;
DrawMem;
DrawHot;
if HotLink.Fade then
begin
FadeStyle := fsIn;
end else
Progress := csMaxProgress;
end;
inherited;
end;
//鼠標稱出開始淡出
procedure TAALinkLabel.CMMouseLeave(var Message: TMessage);
begin
if Enabled then
begin
if HotLink.Fade then
begin
FadeStyle := fsOut;
end else
Progress := 0;
FMouseIn := False;
end;
inherited;
end;
//點擊控件
procedure TAALinkLabel.Click;
var
Wnd: THandle;
begin
if HotLink.URL <> EmptyStr then
begin
if Parent is TForm then
Wnd := Parent.Handle
else
Wnd := 0; //NULL;
ShellExecute(Wnd, nil, PChar(HotLink.URL), nil, nil, SW_SHOWNORMAL);
end;
inherited;
end;
//屬性已裝載
procedure TAALinkLabel.LoadedEx;
begin
inherited;
Reset;
end;
//設置淡入淡出進度
procedure TAALinkLabel.SetProgress(const Value: TProgress);
begin
if FProgress <> Value then
begin
FProgress := Value;
Blend(BlendBmp, MemBmp, HotBmp, Progress);
Paint;
end;
end;
//設置啟用
procedure TAALinkLabel.SetEnabled(Value: Boolean);
begin
inherited;
if not Value then
begin
FadeStyle := fsNone;
Progress := 0;
end;
end;
//設置淡入淡出
procedure TAALinkLabel.SetFadeStyle(const Value: TFadeStyle);
begin
if FFadeStyle <> Value then
begin
FFadeStyle := Value;
FadeTimer.Enabled := FFadeStyle <> fsNone;
end;
end;
//設置鏈接參數
procedure TAALinkLabel.SetHotLink(const Value: THotLink);
begin
FHotLink.Assign(Value);
end;
{ TAAText }
//--------------------------------------------------------//
//平滑特效超鏈接標簽 //
//--------------------------------------------------------//
//調整尺寸
procedure TAAText.CalcSize;
var
i, j: Integer;
DispLines: TStrings;
WrapLines: TStrings;
CurrText: string;
CurrAlign: TAlignment;
TextWidth: Integer;
TextHeight: Integer;
AWidth, AHeight: Integer;
xFree, yFree: Boolean;
MaxCol: Integer;
begin
BeginUpdate;
DispLines := nil;
WrapLines := nil;
try
DispLines := TStringList.Create; //臨時文本
WrapLines := TStringList.Create;
with FText do
begin
xFree := not WordWrap and AutoSize and (Align in [alNone, alLeft, alRight]);
yFree := AutoSize and (Align in [alNone, alTop, alBottom]);
if xFree then AWidth := 0
else AWidth := ClientWidth;
if yFree then AHeight := 0
else AHeight := ClientHeight;
if xFree or yFree then
begin
DispLines.Clear;
DispLines.AddStrings(Lines);
AAFont.Canvas := Canvas;
AAFont.Effect.Assign(FText.FontEffect);
Canvas.Font.Assign(Font);
for i := 0 to DispLines.Count - 1 do
begin
CurrText := DispLines[i]; //當前處理字符串
if LabelEffect = leOnlyALine then
begin
Canvas.Font.Assign(Font);
AAFont.Effect.Assign(FText.FontEffect);
end;
Fonts.Check(CurrText, Canvas.Font, AAFont.Effect); //檢查字體標簽
Labels.Check(CurrText, CurrAlign); //檢查用戶標簽
TextWidth := AAFont.TextWidth(CurrText);
if WordWrap and (TextWidth > AWidth) then //自動換行
begin
MaxCol := AWidth * Length(CurrText) div TextWidth;
while AAFont.TextWidth(Copy(CurrText, 1, MaxCol)) > AWidth do
Dec(MaxCol);
WrapText(CurrText, WrapLines, MaxCol);
end else if CurrText <> '' then
WrapLines.Text := CurrText
else
WrapLines.Text := ' ';
if xFree and (TextWidth > AWidth) then //確定寬度
begin
AWidth := TextWidth;
end;
if yFree then //確定高度
begin
for j := 0 to WrapLines.Count - 1 do
begin
CurrText := WrapLines[j];
TextHeight := AAFont.TextHeight(CurrText + ' ');
Inc(AHeight, TextHeight);
if (i < DispLines.Count - 1) or (j < WrapLines.Count - 1) then
Inc(AHeight, Round(TextHeight * RowPitch / 100));
end;
end;
end;
if xFree then ClientWidth := AWidth + 2 * Border;
if yFree then ClientHeight := AHeight + 2 * Border;
end;
end;
finally
DispLines.Free;
WrapLines.Free;
EndUpdate;
end;
end;
//創建
constructor TAAText.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := ControlStyle + [csReplicatable];
FText := TTextParam.Create(Self, OnLabelChanged);
TextBmp := TBitmap.Create;
TextBmp.PixelFormat := pf24bit;
Width := 46;
Height := 12;
end;
//創建顯示文本
procedure TAAText.CreateText;
begin
CalcSize;
TextBmp.Canvas.Brush.Color := Color;
TextBmp.Canvas.Brush.Style := bsSolid;
TextBmp.Width := ClientWidth;
TextBmp.Height := ClientHeight;
if FText.Transparent then //透明
begin
CopyParentImage(TextBmp.Canvas); //復制父控件畫布
end else if not FText.IsBackEmpty then
begin //繪制背景圖
DrawBackGround(TextBmp.Canvas, Rect(0, 0, TextBmp.Width, TextBmp.Height),
FText.BackGround.Graphic, FText.BackGroundMode);
end else
begin //填充背景色
TextBmp.Canvas.FillRect(ClientRect);
end;
TextBmp.Canvas.Brush.Style := bsClear;
DrawCanvas(TextBmp.Canvas);
end;
//釋放
destructor TAAText.Destroy;
begin
TextBmp.Free;
FText.Free;
inherited;
end;
//繪制
procedure TAAText.DrawCanvas(ACanvas: TCanvas);
var
i, j: Integer;
DispLines: TStrings;
WrapLines: TStrings;
CurrText: string;
CurrAlign: TAlignment;
x, y: Integer;
TextWidth: Integer;
TextHeight: Integer;
MaxCol: Integer;
begin
BeginUpdate;
DispLines := nil;
WrapLines := nil;
try
DispLines := TStringList.Create; //臨時文本
WrapLines := TStringList.Create;
with FText do
begin
DispLines.AddStrings(Lines);
ACanvas.Brush.Color := Color;
ACanvas.Brush.Style := bsClear;
ACanvas.Font.Assign(Font);
AAFont.Canvas := ACanvas;
AAFont.Effect.Assign(FText.FontEffect);
CurrAlign := Alignment; //默認對齊方式
y := Border;
for i := 0 to DispLines.Count - 1 do
begin
if y > ClientHeight - Border then
Break;
CurrText := DispLines[i]; //當前處理字符串
if LabelEffect = leOnlyALine then
begin
ACanvas.Font.Assign(Font);
AAFont.Effect.Assign(FText.FontEffect);
CurrAlign := Alignment;
end;
Fonts.Check(CurrText, ACanvas.Font, AAFont.Effect); //檢查字體標簽
Labels.Check(CurrText, CurrAlign); //檢查用戶標簽
TextWidth := AAFont.TextWidth(CurrText);
if WordWrap and (TextWidth > ClientWidth - 2 * Border) then //自動換行
begin
MaxCol := (ClientWidth - 2 * Border) * Length(CurrText) div TextWidth;
while AAFont.TextWidth(Copy(CurrText, 1, MaxCol)) > ClientWidth - 2
* Border do
Dec(MaxCol);
WrapText(CurrText, WrapLines, MaxCol);
end else if CurrText <> '' then
WrapLines.Text := CurrText
else
WrapLines.Text := ' ';
for j := 0 to WrapLines.Count - 1 do
begin
CurrText := WrapLines[j];
TextHeight := AAFont.TextHeight(CurrText + ' ');
TextWidth := AAFont.TextWidth(CurrText);
case CurrAlign of //對齊方式
taLeftJustify: x := Border;
taCenter: x := (ClientWidth - TextWidth) div 2;
taRightJustify: x := ClientWidth - Border - TextWidth;
else x := 0;
end;
AAFont.TextOut(x, y, CurrText);
y := y + Round(TextHeight * (1 + RowPitch / 100));
end;
end;
AAFont.Effect.Assign(FText.FontEffect);
end;
finally
DispLines.Free;
WrapLines.Free;
EndUpdate;
end;
end;
//控件屬性已裝載
procedure TAAText.LoadedEx;
begin
inherited;
Reset;
end;
//繪制畫布
procedure TAAText.PaintCanvas;
begin
if Text.Transparent then
TransparentPaint //透明
else
Bitblt(Canvas.Handle, 0, 0, Width, Height, TextBmp.Canvas.Handle, 0, 0,
SRCCOPY);
end;
//復位
procedure TAAText.Reset;
begin
if not Text.Transparent then
CreateText;
inherited;
end;
//設置文本
procedure TAAText.SetText(const Value: TTextParam);
begin
Text.Assign(Value);
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -