sf_utils.pas

smartflash ,delphi vcl组件 ,可以实现透明flash窗体

  B.SetSize(RectWidth(ARect), RectHeight(ARect));

  CColor := sfColor(Color, $FF);

  DrawFrameControl(B.DC, Rect(0, 0, B.Width, B.Height), AType, AStyle);

  for i := 0 to B.Width - 1 do
    for j := 0 to B.Height - 1 do
    begin
      Pixel := B.PixelPtr[i, j];

      if Pixel^ = 0 then
        Pixel^ := CColor
      else
        Pixel^ := sfTransparent;
    end; 

  B.Transparent := true;
  B.Draw(Canvas.Handle, ARect.Left, ARect.Top);

  B.Free;
end;

function DrawText(ACanvas: TCanvas; AText: WideString; var Bounds: TRect; Flag: cardinal): integer;
var
  AnsiText: string;
begin
  SetBkMode(ACanvas.Handle, TRANSPARENT);

  if IsWinNT then
    Result := Windows.DrawTextW(ACanvas.Handle, PWideChar(AText), Length(AText), Bounds, Flag)
  else
  begin
    AnsiText := WideCharToString(PWideChar(AText));
    Result := Windows.DrawText(ACanvas.Handle, PChar(AnsiText), Length(AnsiText), Bounds, Flag);
  end;
end;

function DrawText(ACanvas: TCanvas; AText: WideString; X, Y: integer): integer;
var
  R: TRect;
begin
  R := Rect(X, Y, X + TextWidth(ACanvas, AText), Y + TextHeight(ACanvas, AText));
  Result := DrawText(ACanvas, AText, R, 0);
end;

function DrawVerticalText(Canvas: TCanvas; AText: WideString; Bounds: TRect; Flag: cardinal; FromTop: boolean): integer;
var
  R, R1: TRect;
  VertBuf, HorzBuf: TsfBitmap;
  i, j: integer;
  HorzPixel: PsfColor;
  TempCanvas: TCanvas;
  SaveFont: HFont;
begin
  R := Bounds;

  VertBuf := TsfBitmap.Create;
  HorzBuf := TsfBitmap.Create;
  SaveFont := SelectObject(HorzBuf.DC, Canvas.Font.Handle);
  try
    HorzBuf.SetSize(RectHeight(R), RectWidth(R));
    VertBuf.SetSize(RectWidth(R), RectHeight(R));

    VertBuf.FillRect(Rect(0, 0, VertBuf.Width, VertBuf.Height), sfTransparent);
    HorzBuf.FillRect(Rect(0, 0, HorzBuf.Width, HorzBuf.Height), sfTransparent);

    { Draw Horizontaly }
    R1 := Rect(0, 0, HorzBuf.Width, HorzBuf.Height);
    TempCanvas := TCanvas.Create;
    TempCanvas.Handle := HorzBuf.DC;
    Result := DrawText(TempCanvas, AText, R1, Flag);
    TempCanvas.Handle := 0;
    TempCanvas.Free;

    { Rotate }
    for i := 0 to HorzBuf.Width - 1 do
      for j := 0 to HorzBuf.Height - 1 do
      begin
        HorzPixel := HorzBuf.PixelPtr[i, j];
        if HorzPixel^ = sfTransparent then Continue;

        if not FromTop then
          VertBuf.Pixels[j, (VertBuf.Height - i)] := HorzPixel^
        else
          VertBuf.Pixels[(VertBuf.Width - j), i] := HorzPixel^;
      end;

    VertBuf.Transparent := true;
    VertBuf.Draw(Canvas, Bounds.Left, Bounds.Top);
  finally
    SelectObject(HorzBuf.DC, SaveFont);
    VertBuf.Free;
    HorzBuf.Free;
  end;
end;

function TextWidth(Canvas: TCanvas; AText: WideString; Flags: Integer = 0): integer;
var
  R: TRect;
  Size: TSize;
  AnsiText: string;
begin
  R := Rect(0, 0, 0, 0);

  if IsWinNT and false then
  begin
    Windows.DrawTextW(Canvas.Handle, PWideChar(AText), Length(AText), R, DT_CALCRECT or Flags);
    Result := R.Right;
  end
  else
  begin
    if Flags = 0 then
    begin
      GetTextExtentPoint32W(Canvas.Handle, PWideChar(AText), Length(AText), Size);
      Result := Size.cx;
    end
    else
    begin
      SetLength(AnsiText, Length(AText));
      WideCharToMultiByte(CP_ACP, WC_COMPOSITECHECK, PWideChar(AText), Length(AText), PChar(AnsiText), Length(AText), nil, nil);
      Windows.DrawText(Canvas.Handle, PChar(AnsiText), Length(AnsiText), R, DT_CALCRECT or Flags);
      Result := R.Right;
    end;
  end;
end;

function TextHeight(Canvas: TCanvas; AText: WideString): integer;
var
  Size: TSize;
begin
  GetTextExtentPoint32W(Canvas.Handle, PWideChar(AText), Length(AText), Size);
  Result := Size.cy;
end;

procedure MoveTo(Canvas: TCanvas; X, Y: integer);
begin
  Canvas.MoveTo(X, Y);
end;

procedure LineTo(Canvas: TCanvas; X, Y: integer; Color: TColor);
begin
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := Color;
  Canvas.LineTo(X, Y);
end;

procedure DrawEdge(Canvas: TCanvas; Rect: TRect; RaisedColor, SunkenColor: TColor);
begin
  Canvas.Brush.Style := bsClear;
  Canvas.Pen.Style := psSolid;

  Canvas.Pen.Color := RaisedColor;
  Canvas.MoveTo(Rect.Left, Rect.Bottom - 2);
  Canvas.LineTo(Rect.Left, Rect.Top);
  Canvas.LineTo(Rect.Right - 1, Rect.Top);

  Canvas.Pen.Color := SunkenColor;
  Canvas.MoveTo(Rect.Right - 1, Rect.Top);
  Canvas.LineTo(Rect.Right - 1, Rect.Bottom - 1);
  Canvas.LineTo(Rect.Left - 1, Rect.Bottom - 1);
end;

procedure DrawEdge(Canvas: TCanvas; ALeft, ATop, ARight, ABottom: integer; RaisedColor, SunkenColor: TColor);
begin
  DrawEdge(Canvas, Rect(ALeft, ATop, ARight, ABottom), RaisedColor, SunkenColor);
end;

procedure DrawRect(Canvas: TCanvas; Rect: TRect; Color: TColor);
begin
  Canvas.Brush.Style := bsClear;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := Color;
  with Rect do
    Canvas.Rectangle(Left, Top, Right, Bottom);
end;

procedure DrawRect(Canvas: TCanvas; ALeft, ATop, ARight, ABottom: integer; Color: TColor); overload;
begin
  DrawRect(Canvas, Rect(ALeft, ATop, ARight, ABottom), Color);
end;

procedure DrawFocusRect(Canvas: TCanvas; Rect: TRect; Color: TColor);
begin
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := Color;
  Canvas.DrawFocusRect(Rect);
end;

procedure FillRect(Canvas: TCanvas; Rect: TRect; Color: TColor);
begin
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := Color;
  Canvas.FillRect(Rect);
end;

procedure FillRect(Canvas: TCanvas; ALeft, ATop, ARight, ABottom: integer; Color: TColor); overload;
begin
  FillRect(Canvas, Rect(ALeft, ATop, ARight, ABottom), Color);
end;

procedure FillRect(DC: HDC; ALeft, ATop, ARight, ABottom: integer; Color: TColor);
var
  C: TCanvas;
begin
  C := TCanvas.Create;
  C.Handle := DC;
  FillRect(C, Rect(ALeft, ATop, ARight, ABottom), Color);
  C.Handle := 0;
  C.Free;
end;

procedure FillEllipse(Canvas: TCanvas; Rect: TRect; Color: TColor);
begin
  Canvas.Pen.Style := psClear;
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := Color;
  Canvas.Ellipse(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
end;

procedure FillEllipse(Canvas: TCanvas; ALeft, ATop, ARight, ABottom: integer; Color: TColor);
begin
  FillEllipse(Canvas, Rect(ALeft, ATop, ARight, ABottom), Color);
end;

procedure DrawRoundRect(Canvas: TCanvas; ARect: TRect; Radius: integer; Color: TColor);
begin
  Canvas.Brush.Style := bsClear;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := Color;
  Canvas.RoundRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, Radius, Radius);
end;

procedure FillRoundRect(Canvas: TCanvas; ARect: TRect; Radius: integer; Color: TColor);
begin
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := Color;
  Canvas.Pen.Color := Canvas.Brush.Color;
  Canvas.RoundRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, Radius, Radius);
end;

procedure FillGradientRect(Canvas: TCanvas; ARect: TRect; BeginColor, EndColor: TColor; Vertical: boolean);
var
  RGBFrom: array[0..2] of integer;
  RGBDiff: array[0..2] of integer;
  ColorBand : TRect;
  Colors: integer;
  I: Integer;
  R,G,B: Byte;
begin
  if RectWidth(ARect) <= 0 then Exit;
  if RectHeight(ARect) <= 0 then Exit;

  Colors := 255;
  if not Vertical and (Colors > RectWidth(ARect)) then
    Colors := RectWidth(ARect);
  if Vertical and (Colors > RectHeight(ARect)) then
    Colors := RectHeight(ARect);

  BeginColor := ColorToRGB(BeginColor);
  EndColor := ColorToRGB(EndColor);

  { extract from RGB values }
  RGBFrom[0] := TsfColorRecBor(BeginColor).R * $FF;
  RGBFrom[1] := TsfColorRecBor(BeginColor).G * $FF;
  RGBFrom[2] := TsfColorRecBor(BeginColor).B * $FF;
  { calculate difference of from and to RGB values }
  RGBDiff[0] := TsfColorRecBor(EndColor).R * $FF - RGBFrom[0];
  RGBDiff[1] := TsfColorRecBor(EndColor).G * $FF - RGBFrom[1];
  RGBDiff[2] := TsfColorRecBor(EndColor).B * $FF - RGBFrom[2];

  Canvas.Brush.Style := bsSolid;

  ColorBand := ARect;
  for I := 0 to Colors do
  begin
    { calculate color band's top and bottom coordinates }
    if not Vertical then
    begin
      ColorBand.Left := MulDiv(I, RectWidth(ARect), Colors);
      ColorBand.Right := MulDiv(Succ(I), RectWidth(ARect), Colors);

      ColorBand.Left := ColorBand.Left + ARect.Left;
      ColorBand.Right := ColorBand.Right + ARect.Left;
    end else
    begin
      ColorBand.Top := MulDiv (I, RectHeight(ARect), Colors);
      ColorBand.Bottom := MulDiv (Succ(I), RectHeight(ARect), Colors);

      ColorBand.Top := ColorBand.Top + ARect.Top;
      ColorBand.Bottom := ColorBand.Bottom + ARect.Top;
    end;

    { calculate color band color }
    R := Round((RGBFrom[0] + ((I * RGBDiff[0]) /  Colors)) / $FF);
    G := Round((RGBFrom[1] + ((I * RGBDiff[1]) /  Colors)) / $FF);
    B := Round((RGBFrom[2] + ((I * RGBDiff[2]) /  Colors)) / $FF);

    if (i = 0) or (i = Colors) then
      IntersectRect(ColorBand, ARect, ColorBand);

    Canvas.Brush.Color := RGB(R, G, B);
    Canvas.FillRect(ColorBand);
  end;
end;

procedure FillRadialGradientRect(Canvas: TCanvas; Rect: TRect; BeginColor,
  EndColor: TColor; Pos: TPoint);
var
  RGBFrom: array[0..3] of integer;
  RGBDiff: array[0..4] of integer;
  Colors: integer;

  ColorBand: TRect;
  Len: integer;
  I: Integer;
  R,G,B: Byte;
  ClipRgn: HRgn;
begin
  if RectWidth(Rect) <= 0 then Exit;
  if RectHeight(Rect) <= 0 then Exit;

  Colors := 50;

  { extract from RGB values }
  RGBFrom[0] := TsfColorRecBor(BeginColor).R * $FF;
  RGBFrom[1] := TsfColorRecBor(BeginColor).G * $FF;
  RGBFrom[2] := TsfColorRecBor(BeginColor).B * $FF;
  RGBFrom[3] := TsfColorRecBor(BeginColor).A * $FF;
  { calculate difference of from and to RGB values }
  RGBDiff[0] := TsfColorRecBor(EndColor).R * $FF - RGBFrom[0];
  RGBDiff[1] := TsfColorRecBor(EndColor).G * $FF - RGBFrom[1];
  RGBDiff[2] := TsfColorRecBor(EndColor).B * $FF - RGBFrom[2];
  RGBDiff[3] := TsfColorRecBor(EndColor).A * $FF - RGBFrom[3];

  { set clip region }
  ClipRgn := CreateRectRgn(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
  SelectClipRgn(Canvas.Handle, ClipRgn);

  try
    { calc length }
    if RectWidth(Rect) > RectHeight(Rect) then
      Len := RectWidth(Rect)
    else
      Len := RectHeight(Rect);

    for I := Colors downto 0 do
    begin
      { calculate color band color }
      R := Round((RGBFrom[0] + ((I * RGBDiff[0]) /  Colors)) / $FF);
      G := Round((RGBFrom[1] + ((I * RGBDiff[1]) /  Colors)) / $FF);
      B := Round((RGBFrom[2] + ((I * RGBDiff[2]) /  Colors)) / $FF);

      ColorBand.TopLeft := Rect.TopLeft;
      ColorBand.Right := ColorBand.Left + MulDiv(Succ(I), Len, Colors) * 2;
      ColorBand.Bottom := ColorBand.Top + MulDiv(Succ(I), Len, Colors) * 2;

      OffsetRect(ColorBand, -RectWidth(ColorBand) div 2, -RectHeight(ColorBand) div 2);

      OffsetRect(ColorBand, Round((Pos.X / 100) * RectWidth(Rect)),
        Round((Pos.X / 100) * RectHeight(Rect)));

      { paint ellipse  }
      FillEllipse(Canvas, ColorBand, RGB(R, G, B));
    end;
  finally
    SelectClipRgn(Canvas.Handle, 0);
    DeleteObject(ClipRgn);
  end;
end;

procedure FillHalftoneRect(Canvas: TCanvas; ARect: TRect; Color, HalfColor: TColor);
var
  i, j: integer;
  HalfBrush: TBrush;
  HalfBitmap: TBitmap;
begin
  if ARect.Left < 0 then ARect.Left := 0;
  if ARect.Top < 0 then ARect.Top := 0;
  if RectWidth(ARect) <= 0 then Exit;
  if RectHeight(ARect) <= 0 then Exit;

  HalfBrush := TBrush.Create;
  HalfBitmap := TBitmap.Create;
  HalfBitmap.Width := 8;
  HalfBitmap.Height := 8;

  { Create halftone bitmap }
  HalfBitmap.Canvas.Brush.Style := bsSolid;
  HalfBitmap.Canvas.Brush.Color := Color;
  HalfBitmap.Canvas.FillRect(Rect(0, 0, 8, 8));

  for i := 0 to HalfBitmap.Width - 1 do
    for j := 0 to HalfBitmap.Height - 1 do
    begin
      if Odd(i) and Odd(j) then
        HalfBitmap.Canvas.Pixels[i, j] := HalfColor;
      if not Odd(i) and not Odd(j) then
        HalfBitmap.Canvas.Pixels[i, j] := HalfColor;
    end;

  HalfBrush.Bitmap := HalfBitmap;

  Canvas.Brush := HalfBrush;
  Canvas.FillRect(ARect);

  HalfBitmap.Free;
  HalfBrush.Free;
end;

procedure FillAlphaRect(Canvas: TCanvas; ARect: TRect; Color: TColor; Alpha: integer);
var
  B: TsfBitmap;
begin
  B := TsfBitmap.Create;
  B.SetSize(RectWidth(ARect), RectHeight(ARect));
  B.Clear(sfColor(Color, Alpha));

  B.AlphaBlend := true;
  B.Draw(Canvas, ARect.Left, ARect.Top);

  B.Free;
end;

procedure DrawPolygon(Canvas: TCanvas; Points: array of TPoint; Color: TColor);
begin
  { Draw Polygon }
  Canvas.Brush.Style := bsClear;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := Color;
  Canvas.Polygon(Points);
end;

procedure FillPolygon(Canvas: TCanvas; Points: array of TPoint; Color: TColor);
begin
  { Fill Polygon }
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := Color;
  Canvas.Pen.Style := psSolid;