⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 sxskinlabel.pas

📁 skin components for design of your applicastions
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  AddFontData(LState.FD,T.FD);
 end;

begin
 ClearFontData(LState.FD);
 if (SkinLibrary<>nil) and SkinLibrary.CanBeUsed then
  begin
   A:=SkinLibrary.Styles.GetIndexByName(SkinStyle);
   if (A>=0) and (SkinLibrary.Styles[A] is TSXSkinLabelStyle) then
    begin
     Style:=TSXSkinLabelStyle(SkinLibrary.Styles[A]);
     if not Enabled then
      begin
       SetLStateFrom(Style.RState);
       SetLStateFrom(Style.NState);
      end else
     if FMouseOver then
      begin
       SetLStateFrom(Style.HState);
       SetLStateFrom(Style.NState);
      end else SetLStateFrom(Style.NState);
    end;
  end;
 if FUseCustomFont then
  begin
   LState.FD.SetFontName:=False;
   LState.FD.SetFontSize:=False;
   LState.FD.SetFontStyle:=False;
   LState.FD.SetHasShadow:=False;
   LState.FD.SetSmoothLevel:=False;
   LState.FD.SmoothLevel:=0;
  end;
 if FUseCustomFontColor then
  LState.FD.SetFontColor:=False;  
 SetDefaultFontData(LState.FD,Font);
end;

procedure TSXSkinCustomLabel.PaintRectToBitmap(DestCanvasHandle:HDC;
           DestCanvasRect:TRect;Rect:TRect;Rgn:HRGN;Bitmap:TBitmap32;X,Y:Integer;
           WithSubItems:Boolean);
var   LState:TSXSkinLabelStateParam;
       A,W,H:Integer;
       Flags:Cardinal;
 TextRect,RR:TRect;

 procedure DrawTextToBitmap(Bitmap:TBitmap32);
 begin
  Bitmap.Font:=Canvas.Font;
  if LState.FD.HasShadow then
   begin
    OffsetRect(TextRect,1,1);
    if LState.FD.SmoothLevel=0 then
     DrawAlphaText(Bitmap,Caption,TextRect,Flags,LState.FD.ShadowColor) else
      DrawSmoothText(Bitmap,Caption,TextRect,Flags,LState.FD.SmoothLevel,LState.FD.ShadowColor);
    OffsetRect(TextRect,-1,-1);
   end;
  if LState.FD.SmoothLevel=0 then
   DrawAlphaText(Bitmap,Caption,TextRect,Flags,LState.FD.FontColor) else
    DrawSmoothText(Bitmap,Caption,TextRect,Flags,LState.FD.SmoothLevel,LState.FD.FontColor);
 end;

begin
 if (SkinLibrary<>nil) and SkinLibrary.CanBeUsed then
  begin
   A:=SkinLibrary.Styles.GetIndexByName(SkinStyle);
   if (A>=0) and (SkinLibrary.Styles[A] is TSXSkinLabelStyle) then
    begin
     GetCurrentLState(LState);
     if (Caption<>'') and RectInRegion(Rgn,FTextRect) then
      begin
       Flags:=DT_NOPREFIX or DT_NOCLIP or DT_TOP;
       case Alignment of
        taLeftJustify:  Flags:=Flags or DT_LEFT;
        taRightJustify: Flags:=Flags or DT_RIGHT;
        taCenter:       Flags:=Flags or DT_CENTER;
       end;
       if FWordWrap then Flags:=Flags or DT_WORDBREAK;
       TextRect:=FTextRect;
       if LState.FD.DoPrepaint and (LState.FD.SmoothLevel>0) and (FTextBitmap=nil) then
        begin
         FTextBitmap:=TBitmap32.Create;
         FTextBitmap.DrawMode:=dmBlend;
         FTextBitmap.CombineMode:=cmMerge;
         W:=TextRect.Right-TextRect.Left;
         H:=TextRect.Bottom-TextRect.Top;
         if LState.FD.HasShadow then
          begin
           Inc(W); Inc(H);
          end;
         FTextBitmap.SetSize(W,H);
         FTextBitmap.Clear(0);
         RR:=TextRect;
         OffsetRect(TextRect,-TextRect.Left,-TextRect.Top);
         DrawTextToBitmap(FTextBitmap);
         TextRect:=RR;
        end;
       OffsetRect(TextRect,X-Rect.Left,Y-Rect.Top);
       if LState.FD.DoPrepaint and (LState.FD.SmoothLevel>0) then
        FTextBitmap.DrawTo(Bitmap,TextRect.Left,TextRect.Top) else
         DrawTextToBitmap(Bitmap);
      end;
    end;
  end;
 inherited;
end;

procedure TSXSkinCustomLabel.CMMouseEnter(var Msg:TMessage);
begin
 FMouseOver:=True;
 if Enabled and NeedRepaintOnStateChange then
  begin
   InvalidateText;
   ResetTextParams;
   InvalidateText;
  end;
 if Assigned(FOnMouseEnter) then
  FOnMouseEnter(Self);
end;

procedure TSXSkinCustomLabel.CMMouseLeave(var Msg:TMessage);
begin
 FMouseOver:=False;
 if Enabled and NeedRepaintOnStateChange then
  begin
   InvalidateText;
   ResetTextParams;
   InvalidateText;
  end;
 if Assigned(FOnMouseLeave) then
  FOnMouseLeave(Self);
end;

procedure TSXSkinCustomLabel.SkinChanged;
begin
 if not (csLoading in ComponentState) then
  ResetTextParams;
 inherited;
end;

function TSXSkinCustomLabel.NeedRepaintOnStateChange:Boolean;
var LState:TSXSkinLabelStateParam;
begin
 GetCurrentLState(LState);
 Result:=not SameFontData(LState.FD,FLastFontData);
end;

procedure TSXSkinCustomLabel.ResetTextParams;
var LState:TSXSkinLabelStateParam;
     Flags:Cardinal;
  NewBRect:TRect;
         A:Integer;
   OldRect:TRect;
begin
 if Parent=nil then exit;
 if FTextBitmap<>nil then
  begin
   FTextBitmap.Free;
   FTextBitmap:=nil;
  end;
 if (SkinLibrary<>nil) and SkinLibrary.CanBeUsed then
  begin
   GetCurrentLState(LState);
   FLastFontData:=LState.FD;
   Canvas.Font.Name:=LState.FD.FontName;
   Canvas.Font.Size:=LState.FD.FontSize;
   Canvas.Font.Style:=LState.FD.FontStyle;
   FTextRect:=Rect(FTextLeftOffset,FTextTopOffset,Width-FTextRightOffset,Height-FTextBottomOffset);
   Flags:=DT_CALCRECT or DT_NOPREFIX or DT_TOP;
   if FWordWrap then Flags:=Flags or DT_WORDBREAK;
   case Alignment of
    taLeftJustify:  Flags:=Flags or DT_LEFT;
    taRightJustify: Flags:=Flags or DT_RIGHT;
    taCenter:       Flags:=Flags or DT_CENTER;
   end;
   OldRect:=FTextRect;
   if LState.FD.SmoothLevel=0 then
    DrawText(Canvas.Handle,PChar(Caption),-1,FTextRect,Flags) else
     DrawSmoothText(Canvas,Caption,FTextRect,Flags,LState.FD.SmoothLevel);
   if FAutoSizeWidth or FAutoSizeHeight then
    begin
     if (Alignment=taRightJustify) and (FTextRect.Right<OldRect.Right) then
      begin
       FTextRect.Left:=OldRect.Right-FTextRect.Right+FTextRect.Left;
       FTextRect.Right:=OldRect.Right;
      end;
     if (Alignment=taCenter) and (FTextRect.Right<OldRect.Right) then
      begin
       A:=(OldRect.Right-FTextRect.Right) div 2;
       Inc(FTextRect.Left,A);
       Inc(FTextRect.Right,A);
      end;
     if (VerticalAlignment=taVerticalCenter) and (FTextRect.Bottom<OldRect.Bottom) then
      begin
       A:=(OldRect.Bottom-FTextRect.Bottom) div 2;
       Inc(FTextRect.Top,A);
       Inc(FTextRect.Bottom,A);
      end else
     if (VerticalAlignment=taAlignBottom) and (FTextRect.Bottom<OldRect.Bottom) then
      begin
       FTextRect.Top:=OldRect.Bottom-FTextRect.Bottom+FTextRect.Top;
       FTextRect.Bottom:=OldRect.Bottom;
      end;
     NewBRect:=BoundsRect;
     if FAutoSizeWidth then
      begin
       NewBRect.Right:=NewBRect.Left+FTextLeftOffset+FTextRect.Right-
                       FTextRect.Left+FTextRightOffset;
      end;
     if FAutoSizeHeight then
      begin
       NewBRect.Bottom:=NewBRect.Top+FTextTopOffset+FTextRect.Bottom-
                       FTextRect.Top+FTextBottomOffset;
      end;
     if not EqualRect(BoundsRect,NewBRect) then
      begin
       InternalSetBounds(NewBRect.Left,NewBRect.Top,NewBRect.Right-NewBRect.Left,
                         NewBRect.Bottom-NewBRect.Top);
       ResetTextParams;
      end;
    end;
  end;  
end;

function TSXSkinCustomLabel.GetCaption:TCaption;
begin
 Result:=inherited Caption;
end;

procedure TSXSkinCustomLabel.SetCaption(const Value:TCaption);
begin
 if csLoading in ComponentState then
  begin
   inherited Caption:=Value;
   exit;
  end;
 if Caption<>Value then
  begin
   inherited Caption:=Value;
   InvalidateText;
   ResetTextParams;
   InvalidateText;
  end;
end;

procedure TSXSkinCustomLabel.SetBounds(ALeft,ATop,AWidth,AHeight:Integer);
var DoReset:Boolean;
begin
 if not (csLoading in ComponentState) then
  begin
   if FAutoSizeWidth then AWidth:=Width;
   if FAutoSizeHeight then AHeight:=Height;
  end;
 if (ALeft=Left) and (ATop=Top) and (AWidth=Width) and (AHeight=Height) then exit;
 DoReset:=(Width<>AWidth) or (Height<>AHeight);
 inherited SetBounds(ALeft,ATop,AWidth,AHeight);
 if not (csLoading in ComponentState) then
  begin
   if DoReset then
    ResetTextParams;
   Invalidate;
  end;
end;

procedure TSXSkinCustomLabel.InternalSetBounds(ALeft,ATop,AWidth,AHeight:Integer);
begin
 inherited SetBounds(ALeft,ATop,AWidth,AHeight);
end;

procedure TSXSkinCustomLabel.CMFontChanged(var Message:TMessage);
begin
 inherited;
 if not (csLoading in ComponentState) then
  begin
   if NeedRepaintOnStateChange then
    begin
     InvalidateText;
     ResetTextParams;
     InvalidateText;
    end;
  end;
end;

procedure TSXSkinCustomLabel.CMEnabledChanged(var Message:TMessage);
begin
 inherited;
 if not (csLoading in ComponentState) then
  begin
   if not Enabled then
    FMouseOver:=False;
   if NeedRepaintOnStateChange then
    begin
     InvalidateText;
     ResetTextParams;
     InvalidateText;
    end;
  end;
end;

procedure TSXSkinCustomLabel.InvalidateText;
begin
 InvalidateRect(Handle,@FTextRect,False);
end;

procedure TSXSkinCustomLabel.Loaded;
begin
 inherited;
 ResetTextParams;
end;

constructor TSXSkinCustomLabel.Create(AOwner:TComponent);
begin
 inherited Create(AOwner);
 ControlStyle:=ControlStyle+[csSetCaption];
 FAutoSizeWidth:=True;
 FAutoSizeHeight:=True;
 SkinStyle:='_Label';
end;

destructor TSXSkinCustomLabel.Destroy;
begin
 FTextBitmap.Free;
 inherited;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -