lbleffct.pas

功能强大和形态多样的TLabel控件

        GetRGB(clrGrad, iToR, iToG, iToB);
        rAdjustR := (iToR - iFromR) / (iDepth - 1);
        rAdjustG := (iToG - iFromG) / (iDepth - 1);
        rAdjustB := (iToB - iFromB) / (iDepth - 1);
      end;
    end;

    { Set font }
    cnvWork.Font := Self.Font;
    if (Angle <> 0) and not KeepLettersVertical then
      SetTextAngle(cnvWork, Angle, Self.Font.Height);

    { Process for each copy of the highlight/shadow - several if extruding }
    for i := iDepth downto iLimit do
    begin
      if rsResize = rsNone then
      begin
        iAdjX := iOffsets[edDir, drX] * i - iAdj;
        iAdjY := iOffsets[edDir, drY] * i + iExtraY;
      end
      else  { Resize text and calculate offsets }
      begin
        SetResizeOffsets(rsResize, edDir, i, iAdjX, iAdjY);
        Dec(iAdjX, iAdj);
        Inc(iAdjY, iExtraY);
      end;
      { Set current colour }
      cnvWork.Font.Color := RGB(iFromR + Round(rAdjustR * (iDepth - i)),
        iFromG + Round(rAdjustG * (iDepth - i)), iFromB + Round(rAdjustB * (iDepth - i)));
      { And draw the text }
      if Angle = 0 then
      begin
        { Create a rect that is offset for the highlight/shadow/text }
        rctTemp:= Rect(
          Self.ClientRect.Left - iMinOffset + iAdjX, Self.ClientRect.Top - iMinOffset + iAdjY,
          Self.ClientRect.Right - iMinOffset + iAdjX, Self.ClientRect.Bottom - iMinOffset + iAdjY);
        { Draw highlight text with alignment }
        DrawText(cnvWork.Handle, sText, StrLen(sText), rctTemp,
            DT_EXPANDTABS or DT_WORDBREAK or wAlignments[Alignment]);
      end
      else if KeepLettersVertical then
        for iL := 1 to iLen do  { For each character }
        begin
          iW := 0; iH := 0;
          if iL > 1 then  { Position based on substring length and height }
          begin
            iH := Round((iTextHeight * (iL - 1) * dSinSquared) +
              (cnvWork.TextWidth(Copy(Caption, 1, iL - 1)) * dCosSquared));
            iW := Round(iH * dCosAngle);
            iH := Round(iH * dSinAngle);
          end;
          cnvWork.TextOut(iX - iMinOffset + iW + iOffsets[edDir, drX] * i,
            iY - iMinOffset - iH + iOffsets[edDir, drY] * i,
            Copy(Caption, iL, 1));
        end
      else
        { Draw angled highlight/shadow text without alignment }
        cnvWork.TextOut(iX - iMinOffset + iOffsets[edDir, drX] * i,
          iY - iMinOffset + iOffsets[edDir, drY] * i, Caption);
    end;

    if eoStyle = eoReal then    { Real/transparent highlight/shadow }
    begin
      for iU := 0 to Width do
        for iV := 0 to Height do
          if bmpTemp.Canvas.Pixels[iU, iV] = clBlack then
          begin    { Make halfway to white/black }
            GetRGB(bmpWork.Canvas.Pixels[iU, iV], iToR, iToG, iToB);
            bmpWork.Canvas.Pixels[iU, iV] :=
              RGB((iToReal + iToR) div 2, (iToReal + iToG) div 2, (iToReal + iToB) div 2);
          end;
    end;
  end;

begin
  { Create temporary drawing surfaces }
  bmpTemp := TBitmap.Create;
  bmpWork := TBitmap.Create;

  try
    { Same sizes as original }
    bmpTemp.Height := Self.Height;
    bmpTemp.Width := Self.Width;
    bmpWork.Height := Self.Height;
    bmpWork.Width := Self.Width;

    with bmpWork.Canvas do
    begin
      { Initialise work bitmap with current screen image }
      CopyRect(Self.ClientRect, Self.Canvas, Self.ClientRect);
      { Set font }
      Font := Self.Font;
      if (Angle <> 0) and not KeepLettersVertical then
        SetTextAngle(bmpWork.Canvas, Angle, Self.Font.Height);
      iTextHeight := TextHeight(Caption);
      iTextWidth := TextWidth(Caption);
      iLen := Length(Caption);

      { Find minimum and maximum of all offsets (including font itself) }
      iMinOffset := Min([iOffsets[DirectionHighlight, drX] * DepthHighlight,
                    iOffsets[DirectionShadow, drX] * DepthShadow,
                    iOffsets[DirectionHighlight, drY] * DepthHighlight,
                    iOffsets[DirectionShadow, drY] * DepthShadow, 0]);
      iMaxOffset := Max([iOffsets[DirectionHighlight, drX] * DepthHighlight,
                    iOffsets[DirectionShadow, drX] * DepthShadow,
                    iOffsets[DirectionHighlight, drY] * DepthHighlight,
                    iOffsets[DirectionShadow, drY] * DepthShadow, 0]);
      case Alignment of
        taLeftJustify:  iAdj := 0;
        taCenter:       iAdj := (iMaxOffset - iMinOffset) div 2;
        taRightJustify: iAdj := iMaxOffset - iMinOffset;
      end;

      { Adjust offsets for resizing }
      cnvWork := bmpWork.Canvas;
      if ResizeHighlight <> rsNone then
      begin
        SetResizeOffsets(ResizeHighlight, DirectionHighlight, DepthHighlight, iAdjX, iAdjY);
        iMinOffset := Min([iAdjX, iAdjY, iMinOffset]);
        iMaxOffset := Max([iAdjX, iAdjY, iMaxOffset]);
      end;
      if ResizeShadow <> rsNone then
      begin
        SetResizeOffsets(ResizeShadow, DirectionShadow, DepthShadow, iAdjX, iAdjY);
        iMinOffset := Min([iAdjX, iAdjY, iMinOffset]);
        iMaxOffset := Max([iAdjX, iAdjY, iMaxOffset]);
      end;

      { Set starting point for text - iX, iY }
      if Angle = 0 then
      begin
        iX := 0; iY := 0;
      end
      else if KeepLettersVertical then
      begin
        iH := Round((iTextHeight * (iLen - 1) * dSinSquared) +
          (TextWidth(Copy(Caption, 1, iLen - 1)) * dCosSquared));
        iX := Max([0, - Round(iH * dCosAngle)]) + 10;
        iY := Max([0, Round(iH * dSinAngle)]) + 10;
        iL := iMaxOffset - iMinOffset + 4;
        { Find rectangles surrounding first and last characters }
        rctFirst := Bounds(iX - 2, iY - 2,
          TextWidth(Copy(Caption, 1, 1)) + iL, iTextHeight + iL);
        rctLast := Bounds(iX - 2 + Round(iH * dCosAngle), iY - 2 - Round(iH * dSinAngle),
          TextWidth(Copy(Caption, iLen, 1)) + iL, iTextHeight + iL);
      end
      else  { Offset from centre of rotation for text }
      begin
        iW := iTextWidth;
        iH := iTextHeight;
        iMid := TextWidth(Caption + '   ') div 2;
        iX := iMid - Trunc(iW / 2 * dCosAngle) - Trunc(iH / 2 * dSinAngle);
        iY := iMid + Trunc(iW / 2 * dSinAngle) - Trunc(iH / 2 * dCosAngle);

        iMid := iMid + (iMaxOffset - iMinOffset + 4) div 2;
        iW := iW + iMaxOffset + iMinOffset + 4;
        iH := iH + iMaxOffset + iMinOffset + 4;
        i1 := Trunc(iW / 2 * dCosAngle);
        i2 := Trunc(iH / 2 * dSinAngle);
        i3 := Trunc(iW / 2 * dSinAngle);
        i4 := Trunc(iH / 2 * dCosAngle);
        p1 := Point(iMid - i1 - i2 + 2, iMid + i3 - i4 + 2);
        p2 := Point(iMid + i1 - i2 + 2, iMid - i3 - i4 + 2);
        p3 := Point(iMid + i1 + i2 + 2, iMid - i3 + i4 + 2);
        p4 := Point(iMid - i1 + i2 + 2, iMid + i3 + i4 + 2);
      end;

      if not Transparent then  { Fill in background on offscreen copy canvas }
      begin
        Brush.Color := Self.Color;
        Brush.Style := bsSolid;
        if Angle = 0 then
          FillRect(ClientRect)
        else if KeepLettersVertical then
        begin                  { Calculate enclosing polygon }
          p1 := Point(rctFirst.Left, rctFirst.Top);
          p2 := Point(rctFirst.Left, rctFirst.Bottom);
          p3 := Point(rctFirst.Right, rctFirst.Top);
          p4 := Point(rctFirst.Right, rctFirst.Bottom);
          p5 := Point(rctLast.Left, rctLast.Top);
          p6 := Point(rctLast.Left, rctLast.Bottom);
          p7 := Point(rctLast.Right, rctLast.Top);
          p8 := Point(rctLast.Right, rctLast.Bottom);
          case Angle of
          1..90    : Polygon([p1, p5, p7, p8, p4, p2]);
          91..180  : Polygon([p3, p7, p5, p6, p2, p4]);
          181..270 : Polygon([p1, p5, p6, p8, p4, p3]);
          271..360 : Polygon([p3, p7, p8, p6, p2, p1]);
          end;
        end
        else
          Polygon([p1, p2, p3, p4]);
      end;
      Brush.Style := bsClear;         { Don't overwrite background above }
    end;

    GetTextBuf(sText, SizeOf(sText));  { Get label's caption }

    { Paint shadow }
    if StyleShadow = eoReal then  { Work on copy then transfer }
      cnvWork := bmpTemp.Canvas
    else                          { Work directly on offscreen canvas }
      cnvWork := bmpWork.Canvas;
    PaintEffect(ColourShadow, GraduateShadow, DirectionShadow,
      DepthShadow, StyleShadow, ResizeShadow, 0, False, 0);

    { Paint highlight }
    if StyleHighlight = eoReal then  { Work on copy then transfer }
    begin
      bmpTemp.Canvas.FillRect(ClientRect);
      cnvWork := bmpTemp.Canvas;
    end
    else                             { Work directly on offscreen canvas }
      cnvWork := bmpWork.Canvas;
    PaintEffect(ColourHighlight, GraduateHighlight, DirectionHighlight,
      DepthHighlight, StyleHighlight, ResizeHighlight, 255, False, 0);

    { Paint original text }
    if (FBitmap.Width <> 0) or (GraduateFace <> goNone) then  { Work on copy then transfer }
    begin
      bmpTemp.Canvas.FillRect(ClientRect);
      cnvWork := bmpTemp.Canvas;
    end
    else                                                      { Work directly on offscreen canvas }
      cnvWork := bmpWork.Canvas;
    PaintEffect(ColourFace, ColourFace, edNone, 0, eoNormal, rsNone, 0,
      (FBitmap.Width <> 0) or (GraduateFace <> goNone), 0);

    if (FBitmap.Width <> 0) or (GraduateFace <> goNone) then  { Create extra bitmaps }
    begin
      bmpForeground := TBitmap.Create;
      bmpForeground.Assign(bmpWork);
      bmpBackground := TBitmap.Create;
      bmpBackground.Assign(bmpWork);
    end;

    { Prepare for applying effects to the original text face }
    if FBitmap.Width <> 0 then  { Copy bitmap to foreground bitmap }
    begin
      iU := 0;
      while iU < bmpForeground.Width do
      begin
        iV := 0;
        while iV < bmpForeground.Height do
        begin
          bmpForeground.Canvas.Draw(iU, iV, FBitmap);
          Inc(iV, FBitmap.Height);
        end;
        Inc(iU, FBitmap.Width);
      end;
    end
    else if GraduateFace <> goNone then  { Set up graduated bitmap }
    begin                                { Calculate start point and extent }
      if Angle = 0 then
      begin
        iV := iY - iMinOffset;
        case Alignment of
          taLeftJustify:  iU := iX - iMinOffset;
          taCenter:       iU := (Self.Width - iTextWidth) div 2 - iMinOffset - iAdj;
          taRightJustify: iU := Self.Width - iMaxOffset - iTextWidth;
        end;
        iW := iTextWidth;
        iH := iTextHeight;
      end
      else if KeepLettersVertical then
      begin
        iU := Min([rctFirst.Left, rctLast.Left]);
        iV := Min([rctFirst.Top, rctLast.Top]);
        iW := Max([rctFirst.Right, rctLast.Right]) - iU;
        iH := Max([rctFirst.Bottom, rctLast.Bottom]) - iV;
      end
      else
      begin
        iU := Min([p1.X, p2.X, p3.X, p4.X]);
        iV := Min([p1.Y, p2.Y, p3.Y, p4.Y]);
        iW := Max([p1.X, p2.X, p3.X, p4.X]) - iU;
        iH := Max([p1.Y, p2.Y, p3.Y, p4.Y]) - iV;
      end;
      case GraduateFace of
        goVertical:                      iLimit := iH;
        goHorizontal:                    iLimit := iW;
        goFDiagonal, goBDiagonal:        iLimit := iW + iH;
        goBoxed:                         iLimit := iH div 2;
        goRIndented, goLIndented: iLimit := 4;
      end;

      { Calculate change in colour at each step }
      GetRGB(GraduateFrom, iFromR, iFromG, iFromB);
      GetRGB(ColourFace, iToR, iToG, iToB);
      rAdjustR := (iFromR - iToR) / iLimit;
      rAdjustG := (iFromG - iToG) / iLimit;
      rAdjustB := (iFromB - iToB) / iLimit;

      { And draw it onto the foreground canvas }
      bmpForeground.Canvas.Brush.Style := bsSolid;
      if GraduateFace in [goRIndented, goLIndented] then
      begin
        bmpBackground.Assign(bmpTemp);
        bmpTemp.Canvas.FillRect(ClientRect);
        bmpTemp.Canvas.Brush.Style := bsClear;
        cnvWork := bmpTemp.Canvas;
        if GraduateFace = goRIndented then
        begin
          Dec(iMinOffset);
          i2 := 0;
        end
        else
        begin
          Inc(iMinOffset);
          i2 := 2;
        end;
      end;
      for i := 0 to iLimit do
      begin
        bmpForeground.Canvas.Brush.Color := RGB(iFromR - Round(rAdjustR * i),
          iFromG - Round(rAdjustG * i), iFromB - Round(rAdjustB * i));
        bmpForeground.Canvas.Pen.Color := bmpForeground.Canvas.Brush.Color;
        case GraduateFace of
          goVertical:
            bmpForeground.Canvas.FillRect(Rect(iU, iV + i, iU + iW, iV + i + 1));
          goHorizontal:
            bmpForeground.Canvas.FillRect(Rect(iU + i, iV, iU + i + 1, iV + iH));
          goFDiagonal:
            bmpForeground.Canvas.Polygon([Point(iU + i, iV), Point(iU + i - iH, iV + iH),
              Point(iU + i - iH + 2, iV + iH), Point(iU + i + 2, iV)]);
          goBDiagonal:
            bmpForeground.Canvas.Polygon([Point(iU + i - iH, iV), Point(iU + i, iV + iH),
              Point(iU + i + 2, iV + iH), Point(iU + i - iH + 2, iV)]);
          goBoxed:
            bmpForeground.Canvas.FillRect(Rect(iU + i, iV + i, iU + iW - i, iV + iH - i));
          goRIndented, goLIndented:
            for i1 := iIndents[i] to iIndents[i + 1] - 1 do
              PaintEffect(bmpForeground.Canvas.Brush.Color, bmpForeground.Canvas.Brush.Color,
                edIndents[i1, GraduateFace], 1, eoNormal, rsNone, 0, False, i2);
        end;
      end;
      if GraduateFace in [goRIndented, goLIndented] then
      begin
        bmpForeground.Assign(bmpTemp);
        bmpTemp.Assign(bmpBackground);
        if GraduateFace = goRIndented then
          Inc(iMinOffset)
        else
          Dec(iMinOffset);
      end;
    end;

    { Apply bitmap to font image }
    if (FBitmap.Width <> 0) or (GraduateFace <> goNone) then
    begin
      { Mask out background }
      bmpBackground.Canvas.CopyMode := cmSrcCopy;
      bmpBackground.Canvas.CopyRect(ClientRect, bmpWork.Canvas, ClientRect);
      bmpBackground.Canvas.CopyMode := cmSrcAnd;
      bmpBackground.Canvas.CopyRect(ClientRect, bmpTemp.Canvas, ClientRect);
      { Mask out foreground }
      bmpWork.Canvas.CopyMode := cmSrcCopy;
      bmpWork.Canvas.CopyRect(ClientRect, bmpTemp.Canvas, ClientRect);
      bmpWork.Canvas.CopyMode := cmSrcErase;
      bmpWork.Canvas.CopyRect(ClientRect, bmpForeground.Canvas, ClientRect);
      { And combine the two }
      bmpWork.Canvas.CopyMode := cmSrcPaint;
      bmpWork.Canvas.CopyRect(ClientRect, bmpBackground.Canvas, ClientRect);
      bmpForeground.Free;
      bmpBackground.Free;
    end;

    { Copy final result back to the screen }
    Self.Canvas.CopyRect(Self.ClientRect, bmpWork.Canvas, Self.ClientRect);
  finally
    bmpTemp.Free;
    bmpWork.Free;
  end;
end;

procedure TLabelEffect.MouseDown(mbBtn: TMouseButton; ssShift: TShiftState;
    x, y: Integer);
begin
  if AsButton then
  begin    { If left button and label isn't sunken }
    if (mbBtn = mbLeft) and (EffectStyle <> esSunken) and Enabled then
      SetEffectStyle(esSunken);
  end
  else
    inherited MouseDown(mbBtn, ssShift, x, y);
end;

procedure TLabelEffect.MouseMove(ssShift: TShiftState; x, y: Integer);
begin
  if AsButton then
  begin
    if ssShift = [ssLeft] then  { Left mouse button down }
    begin                       { If within label's client area }
      if  (x >= 0) and (x <= ClientWidth) and (y >= 0) and (y <= ClientHeight) then
        SetEffectStyle(esSunken)
      else
        SetEffectStyle(esRaised);
    end;
  end
  else
    inherited MouseMove(ssShift, x, y);
end;

procedure TLabelEffect.MouseUp(mbBtn: TMouseButton; ssShift: TShiftState;
    x, y: Integer);
begin
  if AsButton then
  begin    { If within label's client area }
    if (x >= 0) and (x <= ClientWidth) and (y >= 0) and (y <= ClientHeight) then
      SetEffectStyle(esRaised);
  end
  else
    inherited MouseUp(mbBtn, ssShift, x, y);
end;

end.