VPF::TBevel c градиентом - Форум программистов

rocky7

Дата 30.5.2009, 20:35 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 148
Регистрация: 20.1.2009

Репутация: нет
Всего: нет

Нужен исходник компонента TBevel c возможностью градиентной заливки.
Если у кого есть, скиньте пожалуйста.

Rrader

Дата 31.5.2009, 07:49 (ссылка)

(нет голосов)

Загрузка ...

Inspired =)

Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005

Репутация: 18
Всего: 191

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TBevel = class(ExtCtrls.TBevel)
  protected
    procedure Paint; override;
  end;

  TForm1 = class(TForm)
    Bevel1: TBevel;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  { Для старых версий Delphi }
  COLOR16 = Word;

  _TRIVERTEX = packed record
    x: Longint;
    y: Longint;
    Red: COLOR16;
    Green: COLOR16;
    Blue: COLOR16;
    Alpha: COLOR16;
  end;
  TTriVertex = _TRIVERTEX;
  PTriVertex = ^TTriVertex;

var
  Form1: TForm1;

function GradientFill(DC: HDC; Vertex: PTriVertex; NumVertex: ULONG;
  Mesh: Pointer; NumMesh, Mode: ULONG): BOOL; stdcall; external 'msimg32.dll';

implementation

{$R *.dfm}

{ TBevel }

procedure TBevel.Paint;
var
  R: TRect;
  Vertex: array [0..1] of TTriVertex;
  GR: TGradientRect;
  ClrTopLeft, ClrBottomRight: TColor;
begin
  inherited;
  with Canvas do
  begin
    R := ClientRect;
    InflateRect(R, -1, -1);
    { Colors }
    ClrTopLeft := ColorToRGB(clSilver);
    ClrBottomRight := ColorToRGB(clGray);
    with Vertex[0] do
    begin
      x := R.Left;
      y := R.Top;
      Red := ClrTopLeft shl 8 and $FF00;
      Green := ClrTopLeft and $FF00;
      Blue := ClrTopLeft shr 8 and $FF00;
      Alpha := 0;
    end;
    with Vertex[1] do
    begin
      x := R.Right;
      y := R.Bottom;
      Red := ClrBottomRight shl 8 and $FF00;
      Green := ClrBottomRight and $FF00;
      Blue := ClrBottomRight shr 8 and $FF00;
      Alpha := 0;
    end;
    GR.UpperLeft := 0;
    GR.LowerRight := 1;
    { Horizontal }
    GradientFill(Handle, @Vertex, 2, @GR, 1, GRADIENT_FILL_RECT_H);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  with Bevel1 do
  begin
    Width := 200;
    Height := 100;
    Shape := bsBox;
  end;
end;

end.

Это сообщение отредактировал(а) Rrader - 31.5.2009, 08:05

--------------------

Let's do this quickly!
Rest in peace, Vit!

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »