VPF::Рисуем Button - Форум программистов

ivan219

Дата 5.2.2007, 14:09 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

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

Помогите нарисовать свою кнопку я в это деле мало разбираюсь так что даже не знаю с чего начать smile

Код


unit TMyButton;

interface

uses
  SysUtils, Classes, Controls, StdCtrls;

type
  TMyButton = class(TButton)
  private
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
  published
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Standard', [TMyButton]);
end;
end.

Создал новый класс.
А вот код отрисовки моих кнопок

Код


const
    Col: Array[0..20] of TColor= (16249329,16380915,16512501,16644087,16775673,16775673,16775673,16775673,16578294,16380915,16183536,15986157,15788778,15591399,15394020,15196641,14999262,14801883,14604504,14407125,14209746);
    ColF: Array[0..20] of TColor=(14736090,15065055,15394020,15657192,15920364,16117743,16315122,16512501,16644087,16709880,16775673,16709880,16644087,16512501,16315122,16117743,15920364,15657192,15394020,15065055,14736090);
    CloE: Array[0..20] of TColor=(14209746,14407125,14604504,14801883,14999262,15196641,15394020,15591399,15788778,15986157,16183536,16380915,16578294,16775673,16775673,16775673,16775673,16644087,16512501,16380915,16249329);
.
.
.
procedure TMyForm.Button1Click(Sender: TObject);
var
   Y,C: Integer;
   R: TRect;
begin
 C:=0;
 R.Top:=10;
 R.Bottom:=33;
 R.Left:=10;
 R.Right:=83;
   for Y:=R.Top+1 to R.Bottom-2 do
    begin
     Canvas.Pen.Color:=Col[C];
     Canvas.MoveTo(R.Left+1,Y);
     Canvas.LineTo(R.Right-1,Y);
     Inc(C);
    end;
   Canvas.Pen.Color:=$00CFCFCF;
   Canvas.Brush.Style:=bsClear;
   Canvas.RoundRect(R.Left,R.Top,R.Right,R.Bottom,5,5);
   Canvas.TextOut(R.Left+18,R.Top+5,'Button1');

 C:=0;
 R.Left:=85;
 R.Right:=158;
   for Y:=R.Top+1 to R.Bottom-2 do
    begin
     Canvas.Pen.Color:=ColF[C];
     Canvas.MoveTo(R.Left+1,Y);
     Canvas.LineTo(R.Right-1,Y);
     Inc(C);
    end;
   Canvas.Pen.Color:=$00CFCFCF;
   Canvas.Brush.Style:=bsClear;
   Canvas.RoundRect(R.Left,R.Top,R.Right,R.Bottom,5,5);
   Canvas.TextOut(R.Left+18,R.Top+5,'Button1');

 C:=0;
 R.Left:=160;
 R.Right:=233;
   for Y:=R.Top+1 to R.Bottom-2 do
    begin
     Canvas.Pen.Color:=CloE[C];
     Canvas.MoveTo(R.Left+1,Y);
     Canvas.LineTo(R.Right-1,Y);
     Inc(C);
    end;
   Canvas.Pen.Color:=$00CFCFCF;
   Canvas.Brush.Style:=bsClear;
   Canvas.RoundRect(R.Left,R.Top,R.Right,R.Bottom,5,5);
   Canvas.TextOut(R.Left+18,R.Top+5,'Button1');

 R.Left:=10;
 R.Top:=35;
 R.Bottom:=58;
 R.Right:=83;
   Canvas.Pen.Color:=$00BEBEBE;
   Canvas.Brush.Style:=bsSolid;
   canvas.Brush.Color:=$00F0F0F0;
   Canvas.RoundRect(R.Left,R.Top,R.Right,R.Bottom,5,5);
   Canvas.Font.Color:=$00BEBEBE;
   Canvas.TextOut(R.Left+18,R.Top+5,'Button1');
   Canvas.Font.Color:=clBlack;
end;

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

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

Мой первый сайт и моя первая программа!!!!!

Sunvas

Дата 5.2.2007, 18:23 (ссылка)

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

Загрузка ...

Соль и сахар

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

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

Цитата(ivan219 @ 5.2.2007, 14:09

)

Помогите нарисовать свою кнопку я в это деле мало разбираюсь так что даже не знаю с чего начать

Тебе нужно просто создать свою процедуру отрисовки кнопки. Все остальное можешь оставить как есть.

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

Воспитывая детей по своему образу и подобию, родители почему-то надеются, что они будут лучше их.

ivan219

Дата 5.2.2007, 21:16 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

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

Ну хоть намекните откуда плесать smile

Это правильно smile

Код


  protected
    { Protected declarations }
    procedure Paint; override;
  public

procedure TMyButton.Paint;
begin
 DrawButton;
 inherited Paint;
end;

procedure TMyButton.DrawButton;
begin
 //
end;

Нет тут нету Paint тут чемто другим рисуется smile

Это сообщение отредактировал(а) ivan219 - 5.2.2007, 22:09

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

Мой первый сайт и моя первая программа!!!!!

ivan219

Дата 5.2.2007, 22:20 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

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

Sunvas, А какую процедуру надо переопределять.

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

Мой первый сайт и моя первая программа!!!!!

Sunvas

Дата 5.2.2007, 22:25 (ссылка)

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

Загрузка ...

Соль и сахар

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

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

Цитата(ivan219 @ 5.2.2007, 22:20

)

Sunvas, А какую процедуру надо переопределять.

В свое время я переписывал процедуру DrawButton таким образом:

Код


  TsytttButton = class(TButton)
  protected
    procedure DrawButton(Rect: TRect; State: UINT);

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

Воспитывая детей по своему образу и подобию, родители почему-то надеются, что они будут лучше их.

ivan219

Дата 5.2.2007, 22:33 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

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

Её не в TButton TButtonControl TWinControl да и надо её делать перегрузку overload; или нет smile

И ещё чем ты её вызывал smile

Это сообщение отредактировал(а) ivan219 - 5.2.2007, 22:49

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

Мой первый сайт и моя первая программа!!!!!

ivan219

Дата 5.2.2007, 22:50 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

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

Можеш пример дать smile

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

Мой первый сайт и моя первая программа!!!!!

Sunvas

Дата 5.2.2007, 23:03 (ссылка)

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

Загрузка ...

Соль и сахар

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

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

Я тебе дал пример. Я не вызывал оверлоад и все работал. А что это вообще такое?
В "теле" программы писал:

Код


procedure TsytttButton.DrawButton(Rect: TRect; State: UINT);
begin
//тут код отрисовки и большее нечего
end;

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

Воспитывая детей по своему образу и подобию, родители почему-то надеются, что они будут лучше их.

ivan219

Дата 5.2.2007, 23:18 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

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

Так не вызывается эта процедура.
Так я её создаю кнопку.

Код


procedure TForm1.Button1Click(Sender: TObject);
begin
 with TMyButton.Create(Self) do
  begin
   Top:=10;
   Left:=10;
   Caption:='Button';
   Parent:=Self;
  end;
end;

и кнопка создаётся обычная.
Но вот только в этой процедуре ни чего не происходить я это определит так:

Код


procedure TMyButton.DrawButton(Rect: TRect; State: UINT);
begin
 Form1.Label1.Caption:='f';
end;

Label неменяется и кнопка осталась такойже как и была!

А если тоже самое проделать через

Код


procedure WMPaint(var Message: TWMPaint); message WM_PAINT;

То и Label меняется и кнопки нет smile

Так что процедура DrawButton невызывается при создании кнопки.

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

Мой первый сайт и моя первая программа!!!!!

Sunvas

Дата 5.2.2007, 23:23 (ссылка)

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

Загрузка ...

Соль и сахар

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

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

ivan219, там действительно есть пару ньюансов. Вот брошу тебе мой пример (когда-то пытался нарисовать кнопки управления окном). Хотя он и недописан, но ты, я думаю разберешься.

Код


unit sytttformcaptionbutton;

interface
uses
  Windows, Messages, Classes, Graphics, Controls,  Forms,
  StdCtrls, ExtCtrls;
  type
TDrawButtonEvent = procedure(Control: TWinControl;Rect: TRect; State: TOwnerDrawState) of object;
  Tbvid=(vnone,vclose,vmin,vres,vmax,vhelp,vcltool);
  TsytttformcaptionButton = class(TButton)
  private
    fenabled,fownevents:boolean;
    fleft,fwidth:integer;
    FCanvas: TCanvas;
    bvid:tbvid;
    youdraw:timage;
    FOnDrawButton: TDrawButtonEvent;
    fparent:tform;
    procedure setleft(l:integer);
    procedure setwidth(w:integer);
    procedure setvid(v:tbvid);
    procedure setenabl(v:boolean);
    Procedure CMDialogKey(Var Msg:TWMKey); message CM_DIALOGKEY; //Убираем нажатие Ентера
    procedure KeyDown(var Mesg: TWMKeyDown); message WM_KEYDOWN; //Убираем нажатие пробела
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure SetButtonStyle(ADefault: Boolean); override;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure DrawButton(Rect: TRect; State: UINT);
  public
    constructor Create(AOwner: Tform);
    destructor Destroy; override;
    procedure click;override;
  published
    property Canvas: TCanvas read fcanvas write fcanvas;
    property OnDrawButton: TDrawButtonEvent read FOnDrawButton write FOnDrawButton;
    property draw:timage read youdraw write youdraw;
    property Color;
    property Enabled:boolean read fenabled write setenabl default true;
    property vid:tbvid read bvid write setvid default vclose;
    property ownevents:boolean read fownevents write fownevents;
    property left:integer read fleft write setleft;
    //property width:integer read fwidth write setwidth;
  end;
implementation
uses sytttform;
procedure TsytttformcaptionButton.setleft;
begin
boundsrect:=rect(l,top,width+l,top+height);
end;
procedure TsytttformcaptionButton.setwidth;
begin
boundsrect:=rect(left,top,left+w,top+height);
end;
Procedure TsytttformcaptionButton.CMDialogKey(Var Msg: TWMKey);
begin   ////////
end;
procedure TsytttformcaptionButton.KeyDown;
begin ///////
end;
procedure TsytttformcaptionButton.setenabl(v:boolean);
begin
showhint:=v;
fenabled:=v;
refresh;
end;
procedure TsytttformcaptionButton.click;
begin
if bvid=vnone then ownevents:=true;
if enabled then
if not fownevents then case bvid of
vclose: fparent.close;
vcltool: fparent.close;
vmin: if fparent=application.MainForm then application.minimize else ShowWindow(fparent.Handle,SW_MINIMIZE);
vmax: begin vid:=vres;
ShowWindow(fparent.Handle,SW_MAXIMIZE);
end;
vres:
begin vid:=vmax;
ShowWindow(fparent.Handle,SW_restore);
end;
end else
inherited click;
end;
procedure TsytttformcaptionButton.setvid;
begin
bvid:=v;
hint:='';
case bvid of
vclose: hint:='Закрыть';
vcltool: hint:='Закрыть';
vmin: hint:='Свернуть';
vmax: hint:='Развернуть';
vres: hint:='Восстановить';
end;
refresh;
end;
constructor TsytttformcaptionButton.Create(AOwner: Tform);
begin
  inherited Create(AOwner);
  SetBounds(0, 0, 16, 14);
  FCanvas := TCanvas.Create;
  fcanvas.Handle:=getdc(0);
  youdraw:=timage.Create(self);
  color:=rgb(br,bg,bb);
  ownevents:=false;
  bvid:=vnone;
  fenabled:=true;
  showhint:=true;
  fparent:=aowner;
end;
destructor TsytttformcaptionButton.Destroy;
begin
  inherited Destroy;
  FCanvas.Free;
end;
procedure TsytttformcaptionButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do Style := Style or BS_OWNERDRAW;
end;
procedure TsytttformcaptionButton.SetButtonStyle(ADefault: Boolean);
begin
    Refresh;
end;
procedure TsytttformcaptionButton.CNDrawItem(var Message: TWMDrawItem);
var
  SaveIndex: Integer;
begin
  with Message.DrawItemStruct^ do
  begin
    SaveIndex := SaveDC(hDC);
    FCanvas.Lock;
    try
      FCanvas.Handle := hDC;
      FCanvas.Font := Font;
      FCanvas.Brush := Brush;
      DrawButton(rcItem, itemState);
    finally
      FCanvas.Handle := 0;
      FCanvas.Unlock;
      RestoreDC(hDC, SaveIndex);
    end;
  end;
  Message.Result := 1;
end;
procedure TsytttformcaptionButton.DrawButton(Rect: TRect; State: UINT);
var
  IsDown: Boolean;
begin
//fparent.Caption:=inttostr(left);
  TabStop:=false;
  height:=14;
  if (bvid<>vnone)and(bvid<>vcltool) then width:=16;
  if bvid=vcltool then width:=10;
  IsDown := State and ODS_SELECTED <> 0;
  fcanvas.Brush.Color:=color;
  if not enabled then isdown:=false;
  if not isdown then
  begin
  fcanvas.Pen.Color:=rgb(sdr,sdg,sdb);
  fcanvas.Rectangle(rect);
  fcanvas.Pen.Color:=clwhite;
  fcanvas.MoveTo(rect.Left,rect.Top);
  fcanvas.LineTo(rect.Left,rect.Bottom-1);
  fcanvas.MoveTo(rect.Left,rect.Top);
  fcanvas.LineTo(rect.Right-1,rect.Top);
  fcanvas.Pen.Color:=rgb(ssr,ssg,ssb);
  fcanvas.MoveTo(rect.Left+1,rect.Bottom-2);
  fcanvas.LineTo(rect.Right-2,rect.Bottom-2);
  fcanvas.MoveTo(rect.Right-2,rect.Bottom-2);
  fcanvas.LineTo(rect.Right-2,rect.Top);
  end
  else
  begin
  fcanvas.Pen.Color:=clwhite;
  fcanvas.Rectangle(rect);
  fcanvas.Pen.Color:=rgb(sdr,sdg,sdb);
  fcanvas.MoveTo(rect.Left,rect.Top);
  fcanvas.LineTo(rect.Left,rect.Bottom-1);
  fcanvas.MoveTo(rect.Left,rect.Top);
  fcanvas.LineTo(rect.Right-1,rect.Top);
  fcanvas.Pen.Color:=rgb(ssr,ssg,ssb);
  fcanvas.MoveTo(rect.Left+1,rect.Top+1);
  fcanvas.LineTo(rect.Left+1,rect.Bottom-2);
  fcanvas.MoveTo(rect.Left+1,rect.Top+1);
  fcanvas.LineTo(rect.Right-2,rect.Top+1);
  end;
  if bvid=vnone then fcanvas.Draw(0,0,youdraw.Picture.Icon);
if not enabled then isdown:=false else fcanvas.Pen.Color:=font.Color;
 if not IsDown then
  case bvid of
   vclose:
   begin
    fcanvas.MoveTo(4,3);
    fcanvas.LineTo(11,10);
    fcanvas.MoveTo(5,3);
    fcanvas.LineTo(12,10);
    fcanvas.MoveTo(10,3);
    fcanvas.LineTo(3,10);
    fcanvas.MoveTo(11,3);
    fcanvas.LineTo(4,10);
   end;
   vmax:
   begin
    fcanvas.rectangle(3,2,12,11);
    fcanvas.MoveTo(4,3);
    fcanvas.LineTo(11,3);
   end;
   vmin:fcanvas.rectangle(4,9,10,11);
   vres:
   begin
    fcanvas.rectangle(5,2,11,8);
    fcanvas.MoveTo(6,3);
    fcanvas.LineTo(10,3);
    fcanvas.rectangle(3,5,9,11);
    fcanvas.MoveTo(4,6);
    fcanvas.LineTo(8,6);
   end;
   end
  else
  case bvid of
   vclose:
   begin
    fcanvas.MoveTo(5,4);
    fcanvas.LineTo(12,11);
    fcanvas.MoveTo(6,4);
    fcanvas.LineTo(13,11);
    fcanvas.MoveTo(11,4);
    fcanvas.LineTo(4,11);
    fcanvas.MoveTo(12,4);
    fcanvas.LineTo(5,11);
   end;
   vmax:
   begin
    fcanvas.rectangle(4,3,13,12);
    fcanvas.MoveTo(5,4);
    fcanvas.LineTo(12,4);
   end;
   vmin:fcanvas.rectangle(5,10,11,12);
    vres:
   begin
    fcanvas.rectangle(6,3,12,9);
    fcanvas.MoveTo(7,4);
    fcanvas.LineTo(11,4);
    fcanvas.rectangle(4,6,10,12);
    fcanvas.MoveTo(5,7);
    fcanvas.LineTo(9,7);
  end;
  end;
end;
end.

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

Воспитывая детей по своему образу и подобию, родители почему-то надеются, что они будут лучше их.

ivan219

Дата 5.2.2007, 23:25 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

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

Цитата(Sunvas @ 5.2.2007, 23:03

)

А что это вообще такое?

Это ты проверяеш smile

или незнаеш smile

Это перегрузка процедуры которые могут имень разные порамеры но с одинаковыми именами.

Код


procedure f(A: Integer); overload;
procedure f(A: String); overload;

Просто пример есть как из TLabel делают Label с тенью так там был это

Код


procedure Paint; override;

Это сообщение отредактировал(а) ivan219 - 5.2.2007, 23:35

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

Мой первый сайт и моя первая программа!!!!!

Sunvas

Дата 5.2.2007, 23:28 (ссылка)

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

Загрузка ...

Соль и сахар

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

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

Цитата(ivan219 @ 5.2.2007, 23:25

)

Это ты проверяеш или незнаеш

Честно говоря не поню. Я с этим работал давненько. Забывается все со временем.

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

Воспитывая детей по своему образу и подобию, родители почему-то надеются, что они будут лучше их.

ivan219

Дата 5.2.2007, 23:53 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

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

Sunvas, утебя процедура DrawButton вызывается от сообщения

Код


procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;

но я зделал так

Код


procedure TMyButton.CNDrawItem(var Message: TWMDrawItem);
begin
 Form1.Label1.Caption:='f';
end;

и Label не изменился т.е сообщение небыло вызванно smile

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

Мой первый сайт и моя первая программа!!!!!

Sunvas

Дата 6.2.2007, 00:01 (ссылка)

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

Загрузка ...

Соль и сахар

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

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

ivan219, Хм.. Давай до завтра. Я подумаю. Просто еще раз говорю, что этот исходник страшной старый 2-3 года. Забыл я что в нем писал.

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

Воспитывая детей по своему образу и подобию, родители почему-то надеются, что они будут лучше их.

Romikgy

Дата 6.2.2007, 00:13 (ссылка)

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

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

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

и я влезу

Код


Tmb=class ( TButton )
   public
     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
     procedure mmoud(var Message: TWMPaint); message WM_LBUTTONDOWN;
     procedure mmouu(var Message: TWMPaint); message WM_LBUTTONUP;
     procedure dclk(var Message: TWMPaint); message WM_LBUTTONDBLCLK;

  end;
{ Tmb }

procedure Tmb.dclk(var Message: TWMPaint);
var
  h: HWND;
begin
  inherited;
 TextOut(GetDeviceContext(h),1,1,'+',1);

end;

procedure Tmb.mmoud(var Message: TWMPaint);
var
  h: HWND;
begin
  inherited;
 //hd:=GetDeviceContext(0);

 TextOut(GetDeviceContext(h),1,1,'+',1);
end;

procedure Tmb.mmouu(var Message: TWMPaint);
var
  h: HWND;
begin
  inherited;
 TextOut(GetDeviceContext(h),1,1,'+',1);
end;

procedure Tmb.WMPaint(var Message: TWMPaint);
var
  hd: HDC;
  h: HWND;
  //rect: TRect;
begin

 inherited;
 hd:=GetDeviceContext(h);

 TextOut(hd,1,1,'+',1);
end;

Код


 mmbt: Tmb;

procedure TForm1.Button1Click(Sender: TObject);
begin
  mmbt:=Tmb.Create(Self);
  with mmbt do
  begin
   Top:=10;
   Left:=10;
   Caption:='Button';
   Parent:=Self;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
FreeAndNil(mmbt);
end;

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

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

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