Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Компоненты Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 28.05.2007, 19:41   #1
Mickle
Пользователь
 
Регистрация: 27.03.2007
Сообщений: 37
По умолчанию Помогите дописать компонент

Привет всем!
Ребята професионалы помогите дописать компонент дело в том

что метод прямоугольника есть а вот методов:RectPaint;
RoundRectPaint, EllipsePaint- нет.Это кнопка разной формы,

выручите кто может пожалуйста время мало осталось самому

разобраться 2 дня дали не успею сам разобрать вот и

обращаюсь к вам професионалам пожалуйсто здать надо выручите

Зарание огромное спасибо.
Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, 

Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  

TButtonShape=(bsRect,bsRoundRect,bsCircle,bsEllipse,bsPolygo

n);
  

TPolyShape=(psTrialLeft,psTrialUp,psTrialRight,psTrialDown,p

sParalLeft,psParalRight,psTrapezeDown,psStar5,psStar6);
  TPolyPoints=array[1..12,1..2] of Real;

  TKMVBtn=class(TPaintBox)
  private
    Rgn1,  //Область верхней кромки
    Rgn2,  //Область нижней кромки
    Rgn:cardinal; //Оснавная область
    FButtonShape:TButtonShape;
    FCtrl3d:Boolean;
    FRoundX:Integer;
    FRoundY:Integer;
    FCaption:String;
    FPolyPoints:TPolyPoints;
    FPolyCount:Byte;
    FPolyShape:TPolyShape;
    procedure 

PaintBoxMouseMove(Sender:TObject;Shift:TShiftState; 

X,Y:Integer);
    Procedure SetButtonShape(const Value:TButtonShape);
    Procedure SetCtrl3d(Const Value:Boolean);
    Procedure SetRoundX(const Value:Integer);
  //Прячем события OnPaint и OnMouseMove
    Property OnPaint;
    Property OnMouseMove;
  protected
    procedure RectPaint;
    Procedure RoundRectPaint;
    Procedure EllipsePaint;
    Procedure PolygonPaint;
  public
    constructor Create(AOwner:TComponent); override;
    procedure Paint; override;
  published
    property ButtonShape:TButtonShape read FButtonShape 

write SetButtonShape default bsRoundRect;
    property Ctrl3d:Boolean read FCtrl3d write SetCtrl3d 

default True;
    property RoundX:Integer read FRoundX write SetRoundX 

Default 20;
    property RoundY:Integer read FRoundY write SetRoundY 

default 20;
    property Caption:String read FCaption write SetCaption;
    property PolyShape:TPolyShape read FPolyShape write 

SetPolyShape;
end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
procedure 

TKMVBtn.PaintBoxMouseMove(Sender:TObject;Shift:TShiftState; 

X,Y:Integer);
{При перемещении указателя мыши над кнопкой его форма 

зависит
  от того, определен ли для кнопки обработчик OnClick}
begin
  if PtInRegion(Rgn,x,y)and Assigned(OnClick) then
    Cursor:=crHandPoint
  else
    Cursor:=crDefault
end;

procedure TKMVBtn.Paint;
//Прорисовка кнопки
Var
  x,y:INteger;
Begin
//Вначале уничтожаем все ранее созданые области
  if Rgn1<>0 then
    deleteObject(Rgn1);
  if Rgn2<>0 then
    DeleteObject(Rgn2);
  if Rgn<>0 then
    DeleteObject(Rgn);
  Rgn1:=0;
  Rgn2:=0;
  Rgn:=0;
{Создаем и прорисовывам новые области в зависимости
  от фигуры кнопки и ее свойства Ctrl3d}
  Case FButtonShape of
    bsRect:RectPaint;
    bsRoundRect:RoundRectPaint;
    bsCircle:
      Begin
        if Width>Height then
          Width:=Height
        else
          Height:=Width ;
          EllipsePaint
      end;
    bsEllipse:EllipsePaint;
    bsPolygon:PolygonPaint;
  end;
  with canvas do
  Begin
    //Прорисовываем оснавную область
    Brush.Color:=Self.Color;
    FillRgn(Handle, Rgn, Brush.Handle);
    if caption='' then
    FCaption:=Name;
  //Шрифт канвы b шрифт компонента-разные Объекты!
    Font.Assign(Self.Font);
  //Wtynhbhetv b выводим надпись
    X:=(Width-TextWidth(Caption)) div 2;
    Y:=(Height-TextHeight('1')) div 2;
    SetBkMode(Handle,TransParent);
    TextOut(x,y,Caption);
  end
end;

Procedure TKMVBtn.PolygonPaint;
//Прорисовка прямоугольника
type
  TPolyPointsI=array[1..12,1..2] of Integer;
Var
  PolyPoints:TPolyPointsI;
  k:Integer;
Procedure OffSetPolyPoints(dx,dy:Integer);
//Смещение точек излома
Var
  K:Integer;
Begin
  for k:=1 to FPolyCount do
  Begin
    PolyPoints[k,1]:=PolyPoints[k,1]+dx;
    PolyPoints[k,2]:=PolyPoints[k,2]+dy
  end
end;

Begin
  for k:=1 to FPolyCount do
  Begin
    PolyPoints[k,1]:=Trunc((Width-2)*FPolyPoints[k,1]);
    PolyPoints[k,2]:=Trunc((Height-2)*FPolyPoints[k,2]);
  end;
  if FCtrl3d then
   With canvas do
   Begin
     OffsetPolyPoints(-1,-1);
     Rgn1:=CreatePolygonRgn(PolyPoints,FPolyCount,Opaque);
     Brush.Color:=clBtnHight;
     FillRgn(Handle,Rgn1,Brush.Handle);
     OffSetPolyPoints(2,2);
     Rgn1:=CreatePolygonRgn(PolyPoints,FPolyCount,Opaque);
     Brush.Color:=clBtnShadow;
     FillRgn(Handle,Rgn1, Brush.Handle);
     OffsetPolyPoints(-1,-1);
   end;
   Rgn:=CreatePolygonRgn(PolyPoints,FPolyCount,Opaque);
end;

end.
Mickle вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
помогите дописать программу starry_night Помощь студентам 0 04.06.2008 19:24
Помогите дописать ShnapS Паскаль, Turbo Pascal, PascalABC.NET 4 28.05.2008 21:08
Помогите дописать мои код поиска! AlexII Общие вопросы Delphi 5 17.05.2008 20:07
Помогите дописать программу ALIZE Помощь студентам 2 09.12.2007 18:45
Помогите дописать Klyan Общие вопросы C/C++ 8 22.06.2007 01:55