slabel.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

    FBlurCount := Value;
    ParentControl.Invalidate
  end;
end;

procedure TsShadow.SetDistance(const Value: Integer);
begin
  if FDistance <> Value then begin
    FDistance := Value;
    ParentControl.Invalidate;
  end;
end;

procedure TsShadow.SetColor(const Value: TColor);
var
  rgb : Integer;
begin
  if FColor <> Value then begin
    FColor := Value;
    rgb := ColorToRGB(Value);
    sr := rgb and 255;
    sg := (rgb shr 8) and 255;
    sb := (rgb shr 16) and 255;
    ParentControl.Invalidate;
  end;
end;

procedure TsShadow.SetMode(const Value: TsShadowMode);
begin
  if FMode <> Value then begin
    FMode := Value;
    ParentControl.Invalidate
  end;
end;

{ TsLabelFX }

constructor TsLabelFX.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FShadow := TsShadow.Create(AOwner, Self);
  FKind := TsKind.Create(Self);       
  FMask := CreateBmp32(0, 0);
  FMaskBits := nil;
  FNeedInvalidate := True;
end;

destructor TsLabelFX.Destroy;
begin
  FreeAndNil(FShadow);
  FreeAndNil(FMask);
  FreeAndNil(FKind);
  if FMaskBits <> nil then FreeMem(FMaskBits);
  inherited;
end;

procedure TsLabelFX.DoDrawText(var Rect: TRect; Flags: Integer);
const
  LB_BORDER = 3;
var
{$IFDEF TNTUNICODE}
  Text: WideString;
{$ELSE}
  Text: string;
{$ENDIF}
  x, y :Integer;
  i : Integer;
  oRect : TRect;
  MaskOffs, pb : PByte;
  W, H : Integer;
  offs_North, offs_South, offs_West, offs_East : PByte;
  invert : byte;
  cr, cg, cb : Integer;
  ShColor, ShOffset, ShBlur : integer;
  rgb : Integer;
  procedure AddMask;
  var
    y, x : Integer;
    MaskOffs, pb : PByte;
  begin // Fill mask
    Integer(MaskOffs) := Integer(FMaskBits) + W + 1;
    for y := 0 to FMask.Height - 1 do begin
      pb := FMask.ScanLine[y];
      for x := 0 to FMask.Width - 1 do begin
        if pb^ <> 0 then MaskOffs^ := 255;
        Integer(pb) := Integer(pb) + 4;
        Integer(MaskOffs) := Integer(MaskOffs) + 1;
      end;
      Integer(MaskOffs) := Integer(MaskOffs) + 2;
    end;             
  end;
begin
  if FShadow.Mode <> smNone then begin // If not standard kind
    ShBlur := 0;
    ShColor := 0;
    ShOffset := 0;
    case FShadow.Mode of
      smCustom : begin
        ShColor := FShadow.Color;
        ShBlur := FShadow.BlurCount;
        ShOffset := FShadow.FDistance;
      end;
      smSkin1 : begin
        if Assigned(DefaultManager) and DefaultManager.SkinData.Active and (DefaultManager.SkinData.Shadow1Blur <> -1) then begin
          ShColor := DefaultManager.SkinData.Shadow1Color;
          ShBlur := DefaultManager.SkinData.Shadow1Blur;
          ShOffset := DefaultManager.SkinData.Shadow1Offset;
        end
        else begin
          ShColor := FShadow.Color;
          ShBlur := FShadow.BlurCount;
          ShOffset := FShadow.FDistance;
        end;
        rgb := ColorToRGB(ShColor);
        Shadow.sr := rgb and 255;
        Shadow.sg := (rgb shr 8) and 255;
        Shadow.sb := (rgb shr 16) and 255;
      end;
    end;
    Text := GetLabelText;
    if (Flags and DT_CALCRECT <> 0) and ((Text = '') or ShowAccelChar and (Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' ';
    if not ShowAccelChar then Flags := Flags or DT_NOPREFIX;
    Flags := DrawTextBiDiModeFlags(Flags);
    Canvas.Font.Assign(Font);
    if not Enabled then begin
      OffsetRect(Rect, 1, 1);
      Canvas.Font.Color := clBtnHighlight;
{$IFDEF TNTUNICODE}
      Tnt_DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), Rect, Flags);
      OffsetRect(Rect, -1, -1);
      Canvas.Font.Color := clBtnShadow;
      Tnt_DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), Rect, Flags);
{$ELSE}
      DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
      OffsetRect(Rect, -1, -1);
      Canvas.Font.Color := clBtnShadow;
      DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
{$ENDIF}
    end
    else begin
      case FKind.KindType of
        ktStandard : Canvas.Font.Color := ColorToRGB(Color);
        ktCustom : Canvas.Font.Color := ColorToRGB(Kind.Color);
        ktSkin : begin
          if Assigned(DefaultManager) and DefaultManager.SkinData.Active then begin
            if (DefaultManager.ConstData.IndexGlobalInfo > -1) and
                 (DefaultManager.ConstData.IndexGlobalInfo <= Length(DefaultManager.gd) - 1) and
                   (DefaultManager.gd[DefaultManager.ConstData.IndexGlobalInfo].FontColor[2] <> -1)
              then Canvas.Font.Color := ColorToRGB(DefaultManager.gd[DefaultManager.ConstData.IndexGlobalInfo].FontColor[2])
              else Canvas.Font.Color := ColorToRGB(Kind.Color)
          end
          else Canvas.Font.Color := ColorToRGB(Kind.Color);
        end;
      end;

      if (Flags and DT_CALCRECT <> DT_CALCRECT) and (ShColor <> clNone) and (ShBlur <> 0) then begin
        if (FNeedInvalidate) or (not FShadow.FBuffered) then begin
          FMask.Width := WidthOf(Rect);
          FMask.Height := HeightOf(Rect);
          FMask.Canvas.Brush.Color := 0;
          FMask.Canvas.FillRect(Classes.Rect(0, 0, FMask.Width, FMask.Height));
          FMask.Canvas.Font := Canvas.Font;
          FMask.Canvas.Font.Color := clWhite;
          //draw text
(*!!!*)
          oRect := Rect;
          dec(Rect.Left, OffsTopLeft);
          dec(Rect.Top, OffsTopLeft);
          dec(Rect.Right, OffsRightBottom);
          dec(Rect.Bottom, OffsRightBottom);

          OffsetRect(Rect, ShOffset, ShOffset);
{$IFDEF TNTUNICODE}
          Tnt_DrawTextW(FMask.Canvas.Handle, PWideChar(Text), Length(Text), Rect, Flags);
{$ELSE}
          DrawText(FMask.Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
{$ENDIF}
          Rect := oRect;

          W := FMask.Width + 2;
          H := FMask.Height + 2;
          if FMaskBitsSize < W * H * 2 then begin
            FMaskBitsSize := W * H * 2;
            ReallocMem(FMaskBits, FMaskBitsSize);
          end;
          FillChar(PChar(FMaskBits)^, W * H * 2, 0);

          //Blur Mask
          for i := 1 to ShBlur do begin
            Integer(MaskOffs) := Integer(FMaskBits) + W + 1;

            AddMask;
            Integer(offs_North) := Integer(MaskOffs) - W;
            Integer(offs_South) := Integer(MaskOffs) + W;
            Integer(offs_West) := Integer(MaskOffs) - 1;
            Integer(offs_East) := Integer(MaskOffs) + 1;

            for y := 0 to H - 3 do begin
              for x := 0 to W - 3 do begin
                MaskOffs^ := (offs_North^ + offs_South^ + offs_West^ + offs_East^)shr 2;
                Integer(MaskOffs) := Integer(MaskOffs) + 1;
                Integer(offs_North) := Integer(offs_North) + 1;
                Integer(offs_South) := Integer(offs_South) + 1;
                Integer(offs_West) := Integer(offs_West) + 1;
                Integer(offs_East) := Integer(offs_East) + 1;
              end;
              Integer(MaskOffs) := Integer(MaskOffs) + 2;
              Integer(offs_North) := Integer(offs_North) + 2;
              Integer(offs_South) := Integer(offs_South) + 2;
              Integer(offs_West) := Integer(offs_West) + 2;
              Integer(offs_East) := Integer(offs_East) + 2;
            end;       
          end;

          Integer(MaskOffs) := Integer(FMaskBits) + FMask.Width + 3;

          if Transparent then begin
            // GetBackground
            BitBlt(FMask.Canvas.Handle, 0, 0, FMask.Width, FMask.Height, Canvas.Handle, 0, 0, SRCCOPY);
//            BitBlt(FMask.Canvas.Handle, Rect.Left, Rect.Top, FMask.Width, FMask.Height, Canvas.Handle, Rect.Left, Rect.Top, SRCCOPY);
            // setAlpha
            for y := 0 to FMask.Height - 1  do begin
              pb := FMask.ScanLine[y];
              for x := 0 to FMask.Width - 1 do begin
                invert := not MaskOffs^; // 255 - MaskOffs^
                pb^ := (pb^ * invert + FShadow.sb * MaskOffs^) shr 8;
                Integer(pb) := Integer(pb) + 1;
                pb^ := (pb^ * invert + FShadow.sg * MaskOffs^) shr 8;
                Integer(pb) := Integer(pb) + 1;
                pb^ := (pb^ * invert + FShadow.sr * MaskOffs^) shr 8;
                Integer(pb) := Integer(pb) + 2;
                Integer(MaskOffs) := Integer(MaskOffs) + 1;
              end;
              Integer(MaskOffs) := Integer(MaskOffs) + 2;
            end;
          end
          else begin
            // setAlpha
            i := ColorToRGB(Color);

            cr := i and 255;
            cg := (i shr 8) and 255;
            cb := (i shr 16) and 255;

            for y := 0 to FMask.Height - 1  do begin
              pb := FMask.ScanLine[y];
              for x := 0 to FMask.Width - 1 do begin
                invert := not MaskOffs^; // 255 - MaskOffs^
                pb^ := (cb * invert + FShadow.sb * MaskOffs^) shr 8;
                Integer(pb) := Integer(pb) + 1;
                pb^ := (cg * invert + FShadow.sg * MaskOffs^) shr 8;
                Integer(pb) := Integer(pb) + 1;
                pb^ := (cr * invert + FShadow.sr * MaskOffs^) shr 8;
                Integer(pb) := Integer(pb) + 2;
                Integer(MaskOffs) := Integer(MaskOffs) + 1;
              end;
              Integer(MaskOffs) := Integer(MaskOffs) + 2;
            end;
          end;//*)
          FNeedInvalidate := False;
        end; // Need Invalidate

        BitBlt(Canvas.Handle, 0{Rect.Left}, 0{Rect.Top v5.11}, FMask.Width, FMask.Height, FMask.Canvas.Handle, 0, 0, SRCCOPY);
        oRect := Rect;
        dec(Rect.Left, OffsTopLeft);
        dec(Rect.Top, OffsTopLeft);
        dec(Rect.Right, OffsRightBottom);
        dec(Rect.Bottom, OffsRightBottom);

{$IFDEF TNTUNICODE}
        Tnt_DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), Rect, Flags);
{$ELSE}
        DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
{$ENDIF}

        Rect := oRect;
      end
      else begin
{$IFDEF TNTUNICODE}
        Rect := Classes.Rect(0, 0, WideCanvasTextWidth(Canvas, Text), WideCanvasTextHeight(Canvas, Text));
        Tnt_DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), Rect, Flags);
{$ELSE}
        DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
{$ENDIF}
      end;

      if (Flags and DT_CALCRECT = DT_CALCRECT) and (ShColor <> clNone) and (ShBlur <> 0) then begin
        OffsTopLeft := Min(0, ShOffset - ShBlur);
        OffsRightBottom := Max(0, ShOffset + ShBlur);
        inc(Rect.Right, OffsRightBottom - OffsTopLeft);
        inc(Rect.Bottom, OffsRightBottom - OffsTopLeft);
      end;
    end;
  end
  else inherited;
end;

{ TsKind }

constructor TsKind.Create(AOwner: TControl);
begin
  FKindType := ktSkin;
  FColor := clWhite;
  FOwner := AOwner
end;

destructor TsKind.Destroy;
begin
  inherited;
end;

procedure TsKind.SetColor(const Value: TColor);
begin
  if FColor <> Value then begin
    FColor := Value;
    FOwner.Invalidate
  end
end;

procedure TsKind.SetKindType(const Value: TsKindType);
begin
  if FKindType <> Value then begin
    FKindType := Value;
    FOwner.Invalidate
  end
end;

{ TsLabel }

constructor TsLabel.Create(AOwner: TComponent);
begin
  inherited;
  FUseSkinColor := True;
end;

function TsLabel.GetCurrentFont: TFont;
var
  c : TColor;
begin
  Result := inherited Font;
  if Assigned(DefaultManager) and DefaultManager.SkinData.Active and UseSkinColor then begin
    c := DefaultManager.GetGlobalFontColor;
    if (c <> clFuchsia) and (Result.Color <> c) then Result.Color := c;
  end;
end;

procedure TsLabel.WndProc(var Message: TMessage);
begin
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
    AC_REMOVESKIN : begin
      if (Message.LParam = LongInt(DefaultManager)) and UseSkinColor and (Font.Color <> clWindowText) then Font.Color := clWindowText;
      Exit;
    end;
  end;
  inherited;
end;

end.