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;

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

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

ivan219

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

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

Загрузка ...

Эксперт

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

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

Romikgy, распиши эти сообщения smile

Код


     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; //????????

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

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

Romikgy

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

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

Загрузка ...

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

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

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

имхо все есть в мсдн

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

)

message WM_LBUTTONDBLCLK; //????????

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

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

)

WM_PAINT

вызывается когда кнопка отрисовывается изначально или после свертывания,
а при нажатии срабатывает другое сообщение, при отпускании третье, и рисование происходит по разным путям, хотя внизу вызывается одна и таже ф_ция, лень искать было ...

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

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

ivan219

Дата 6.2.2007, 09:51 (ссылка)

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

Загрузка ...

Эксперт

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

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

MCDN там всё по английски а есть с русским переводом smile

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

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

ivan219

Дата 6.2.2007, 17:16 (ссылка)

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

Загрузка ...

Эксперт

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

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

Вот что вышло:

Код


Unit Mb;
interface

uses
  Windows,SysUtils, Classes, Controls, StdCtrls, Messages, Graphics,Forms;

Type
 Tmb=class ( TButton )
   private
     hd: HDC;
     FCanvas: TCanvas;
     R: TRect;
   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 }
Type
    AArray=Array[0..2,0..20] of TColor;
const
    Col: AArray=((15591399,15722985,15854571,15986157,16117743,
                  16117743,16117743,16117743,15920364,15722985,
                  15525606,15328227,15130848,14933469,14736090,
                  14538711,14341332,14143953,13946574,13749195,
                  13551816),
                 (14736090,15065055,15394020,15657192,15920364,
                  16117743,16315122,16512501,16644087,16709880,
                  16775673,16709880,16644087,16512501,16315122,
                  16117743,15920364,15657192,15394020,15065055,
                  14736090),
                 (8946306,9143685,9341064,9538443,9735822,
                  9933201,10130580,10327959,10525338,10722717,
                  10920096,11117475,11314854,11512233,11512233,
                  11512233,11512233,11380647,11249061,11117475,
                  10985889));

implementation

uses Unit1;

procedure Tmb.dclk(var Message: TWMPaint);
var
   Y,C: Integer;
begin
 inherited;
 C:=0;
 for Y:=R.Top+1 to R.Bottom-2 do
  begin
   FCanvas := TCanvas.Create;
   FCanvas.Lock;
   FCanvas.Handle:=hd;
   FCanvas.Pen.Color:=Col[0,C];
   FCanvas.MoveTo(R.Left+1,Y);
   FCanvas.LineTo(R.Right-1,Y);
   Inc(C);
  end;
 FCanvas.Pen.Color:=$00CFCFCF;
 FCanvas.Brush.Style:=bsClear;
 FCanvas.RoundRect(R.Left,R.Top,R.Right,R.Bottom,5,5);
 FCanvas.TextOut(R.Left+18,R.Top+5,'Button1');
end;

procedure Tmb.mmoud(var Message: TWMPaint);
var
   Y,C: Integer;
begin
 inherited;
 C:=0;
 for Y:=R.Top+1 to R.Bottom-2 do
  begin
   FCanvas := TCanvas.Create;
   FCanvas.Lock;
   FCanvas.Handle:=hd;
   FCanvas.Pen.Color:=Col[2,C];
   FCanvas.MoveTo(R.Left+1,Y);
   FCanvas.LineTo(R.Right-1,Y);
   Inc(C);
  end;
 FCanvas.Pen.Color:=$00CFCFCF;
 FCanvas.Brush.Style:=bsClear;
 FCanvas.RoundRect(R.Left,R.Top,R.Right,R.Bottom,5,5);
 FCanvas.TextOut(R.Left+18,R.Top+5,'Button1');

end;

procedure Tmb.mmouu(var Message: TWMPaint);
var
   Y,C: Integer;
begin
 inherited;
 C:=0;
 for Y:=R.Top+1 to R.Bottom-2 do
  begin
   FCanvas := TCanvas.Create;
   FCanvas.Lock;
   FCanvas.Handle:=hd;
   FCanvas.Pen.Color:=Col[0,C];
   FCanvas.MoveTo(R.Left+1,Y);
   FCanvas.LineTo(R.Right-1,Y);
   Inc(C);
  end;
 FCanvas.Pen.Color:=$00CFCFCF;
 FCanvas.Brush.Style:=bsClear;
 FCanvas.RoundRect(R.Left,R.Top,R.Right,R.Bottom,5,5);
 FCanvas.TextOut(R.Left+18,R.Top+5,'Button1');
end;

procedure Tmb.WMPaint(var Message: TWMPaint);
var
  h: HWND;
  Y,C: Integer;

begin
 inherited;
 C:=0;
 R.Top:=0;
 R.Bottom:=23;
 R.Left:=0;
 R.Right:=73;
 hd:=GetDeviceContext(h);
 for Y:=R.Top+1 to R.Bottom-2 do
  begin
   FCanvas := TCanvas.Create;
   FCanvas.Lock;
   FCanvas.Handle:=hd;
   FCanvas.Pen.Color:=Col[0,C];
   FCanvas.MoveTo(R.Left+1,Y);
   FCanvas.LineTo(R.Right-1,Y);
   Inc(C);
  end;
 FCanvas.Pen.Color:=$00CFCFCF;
 FCanvas.Brush.Style:=bsClear;
 FCanvas.RoundRect(R.Left,R.Top,R.Right,R.Bottom,5,5);
 FCanvas.TextOut(R.Left+18,R.Top+5,'Button1');
end;
end.

Только есть некоторые минусы.
При наведении мышкой на кнопку рисунок исчезает наверное надо обрабатывать ещё одно сообщение, также видны уголки прямоугольно кнопки может можно её вообще стереть smile

и ещё когда первый раз нажимаешь на кнопку то маска не перерисовывается а последующие нажатия перерисовывает ещё когда быстро нажимаешь то тоже не успевает от рисовать.

Romikgy

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

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

Загрузка ...

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

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

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

Цитата(ivan219 @ 6.2.2007, 16:16

)

При наведении мышкой на кнопку рисунок исчезает наверное надо обрабатывать ещё одно сообщение,

WM_MOUSEMOVE

Цитата(ivan219 @ 6.2.2007, 16:16

)

также видны уголки прямоугольно кнопки может можно её вообще стереть

Цитата(ivan219 @ 6.2.2007, 16:16

)

for Y:=R.Top+1 to R.Bottom-2 do

зачем тогда эти плюсы и минусы?

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

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

ivan219

Дата 6.2.2007, 18:38 (ссылка)

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

Загрузка ...

Эксперт

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

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

А у меня там две рисовалки первая рисует прямоугольник по строчно от R.Top+1 до R.Bottom-2

Код


for Y:=R.Top+1 to R.Bottom-2 do

А вторая обводку вокруг него R.Left,R.Top,R.Right,R.Bottom получается красивая кнопка.

Код


 Canvas.Pen.Color:=$00CFCFCF;
 Canvas.Brush.Style:=bsClear;
 Canvas.RoundRect(R.Left,R.Top,R.Right,R.Bottom,5,5);

Углы выходят за пределы моей кнопки так как уменя там ничего не рисуется вот и остаётся старая кнопка.

Добавлено @ 18:47
По 3 пикселя на каждом углу попробую их зарисовать но может есть другая возможность.

Добавлено @ 18:51
Но попрежнему после первого ножатия на кнопку она не периресовывается только после второго это происходит.

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

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

ivan219

Дата 6.2.2007, 19:11 (ссылка)

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

Загрузка ...

Эксперт

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

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

Работает

Код


Unit Mb;
interface

uses
  Windows,SysUtils, Classes, Controls, StdCtrls, Messages, Graphics,Forms;

Type
 Tmb=class ( TButton )
   private
     H: HWND;
     HD: HDC;
     FCanvas: TCanvas;
     R: TRect;
   public
     procedure PAINT(var Message: TWMPaint); message WM_PAINT;
     procedure MOVE(var Message: TWMPaint); message WM_MOUSEMOVE;
     procedure DOWN(var Message: TWMPaint); message WM_LBUTTONDOWN;
     procedure DBLCLK(var Message: TWMPaint); message WM_LBUTTONDBLCLK;
     procedure UP(var Message: TWMPaint); message WM_LBUTTONUP;
     procedure DrawButton(A: Byte);
  end;

Type
    AArray=Array[0..2,0..20] of TColor;
const
    Col: AArray=((15591399,15722985,15854571,15986157,16117743,
                  16117743,16117743,16117743,15920364,15722985,
                  15525606,15328227,15130848,14933469,14736090,
                  14538711,14341332,14143953,13946574,13749195,
                  13551816),
                 (14736090,15065055,15394020,15657192,15920364,
                  16117743,16315122,16512501,16644087,16709880,
                  16775673,16709880,16644087,16512501,16315122,
                  16117743,15920364,15657192,15394020,15065055,
                  14736090),
                 (8946306,9143685,9341064,9538443,9735822,
                  9933201,10130580,10327959,10525338,10722717,
                  10920096,11117475,11314854,11512233,11512233,
                  11512233,11512233,11380647,11249061,11117475,
                  10985889));

implementation

procedure Tmb.PAINT(var Message: TWMPaint);
begin
 if HD=0 then  DrawButton(0);
end;

procedure Tmb.MOVE(var Message: TWMPaint);
begin
 DrawButton(1);
end;

procedure Tmb.DOWN(var Message: TWMPaint);
begin
 DrawButton(2);
end;

procedure Tmb.DBLCLK(var Message: TWMPaint);
begin
 DrawButton(2);
end;

procedure Tmb.UP(var Message: TWMPaint);
begin
 DrawButton(1);
end;

procedure Tmb.DrawButton(A: Byte);
var
  Y,C: Integer;
begin
 C:=0;
 R.Top:=0;
 R.Bottom:=25;
 R.Left:=0;
 R.Right:=75;
 HD:=GetDeviceContext(H);
 for Y:=R.Top+1 to R.Bottom-2 do
  begin
   FCanvas:=TCanvas.Create;
   FCanvas.Lock;
   FCanvas.Handle:=HD;
   case A of
        0: FCanvas.Pen.Color:=Col[0,C];
        1: FCanvas.Pen.Color:=Col[1,C];
        2: FCanvas.Pen.Color:=Col[2,C];
   end;
   FCanvas.MoveTo(R.Left+1,Y);
   FCanvas.LineTo(R.Right-1,Y);
   if C<20 then Inc(C);
  end;
 FCanvas.Pen.Color:=$00CFCFCF;
 FCanvas.Brush.Style:=bsClear;
 FCanvas.RoundRect(R.Left,R.Top,R.Right,R.Bottom,5,5);
 FCanvas.TextOut(R.Left+18,R.Top+5,'Button1');
end;
end.

Правда есть ещё один минус когда мышка на кнопке происходит

Код


procedure MOVE(var Message: TWMPaint); message WM_MOUSEMOVE;

А что делать если мыши нет на кнопке smile

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

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

Romikgy

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

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

Загрузка ...

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

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

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

Цитата(ivan219 @ 6.2.2007, 18:11

)

А что делать если мыши нет на кнопке

а если над компонентом ничего не происходит так он имхо и не перерисовывается,
или перефразируй вопрос?

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

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

ivan219

Дата 6.2.2007, 20:12 (ссылка)

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

Загрузка ...

Эксперт

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

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

Ну если сночало мышка была на кнопке WM_MOUSEMOVE; потом убрал с кнопки что произойдёт smile

Да и ещё пару багов нашол:
1: Когда форму скрываеш то кнопка исчезает виновата вот этот код

Код


procedure TMyButton.PAINT(var Message: TWMPaint);
begin
 //if HD=0 then
   DrawButton(0);
end;

но если делать просто

Код


procedure TMyButton.PAINT(var Message: TWMPaint);
begin
   DrawButton(0);
end;

то кнопка мирцает что посоветуете smile

2: Если на форме XPmanyfest то другие кнопки обычные TButton если их нажать остаются в токомже положении что делать smile

Добавлено @ 20:17
Если вот так то всё работает но видны уголки прямоугольной кнопки.

Код


procedure TMyButton.PAINT(var Message: TWMPaint);
begin
 //if HD=0 then
 inherited;
  DrawButton(0);
end;

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

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

Romikgy

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

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

Загрузка ...

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

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

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

выложи проект я его посмотрю

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

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

ivan219

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

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

Загрузка ...

Эксперт

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

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

Код


Unit MyButton;
interface

uses
  Windows,SysUtils, Classes, Controls, StdCtrls, Messages, Graphics, Forms, Dialogs;

Type
 TMyButton=class (TButton)
   private
     H: HWND;
     HD: HDC;
     FCanvas: TCanvas;
   protected
   
   public
     procedure PAINT(var Message: TWMPaint); message WM_PAINT;
     procedure MOVE(var Message: TWMPaint); message WM_MOUSEMOVE;
     procedure DOWN(var Message: TWMPaint); message WM_LBUTTONDOWN;
     procedure DBLCLK(var Message: TWMPaint); message WM_LBUTTONDBLCLK;
     procedure UP(var Message: TWMPaint); message WM_LBUTTONUP;
     procedure DrawButton(A: Byte);
   published
  end;

Type
    AArray=Array[0..2,0..20] of TColor;
const
    Col: AArray=((15591399,15722985,15854571,15986157,16117743,
                  16117743,16117743,16117743,15920364,15722985,
                  15525606,15328227,15130848,14933469,14736090,
                  14538711,14341332,14143953,13946574,13749195,
                  13551816),
                 (14736090,15065055,15394020,15657192,15920364,
                  16117743,16315122,16512501,16644087,16709880,
                  16775673,16709880,16644087,16512501,16315122,
                  16117743,15920364,15657192,15394020,15065055,
                  14736090),
                 (8946306,9143685,9341064,9538443,9735822,
                  9933201,10130580,10327959,10525338,10722717,
                  10920096,11117475,11314854,11512233,11512233,
                  11512233,11512233,11380647,11249061,11117475,
                  10985889));

procedure Register;

implementation

uses Unit1;

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

procedure TMyButton.PAINT(var Message: TWMPaint);
begin
 inherited;
 DrawButton(0);
end;

procedure TMyButton.MOVE(var Message: TWMPaint);
begin
 DrawButton(1);
end;

procedure TMyButton.DOWN(var Message: TWMPaint);
begin
 DrawButton(2);
end;

procedure TMyButton.DBLCLK(var Message: TWMPaint);
begin
 DrawButton(2);
end;

procedure TMyButton.UP(var Message: TWMPaint);
begin
 DrawButton(1);
end;

procedure TMyButton.DrawButton(A: Byte);
var
  Y,C: Integer;
begin
 C:=0;
 HD:=GetDeviceContext(H);
 FCanvas:=TCanvas.Create;
 FCanvas.Handle:=HD;
 for Y:=1 to ClientHeight-2 do
  begin
   case A of
        0: FCanvas.Pen.Color:=Col[0,C];
        1: FCanvas.Pen.Color:=Col[1,C];
        2: FCanvas.Pen.Color:=Col[2,C];
   end;
   FCanvas.MoveTo(1,Y);
   FCanvas.LineTo(ClientWidth-1,Y);
   if C<20 then Inc(C);
  end;
 FCanvas.Pen.Color:=$00CFCFCF;
 FCanvas.Brush.Style:=bsClear;
 FCanvas.RoundRect(0,0,ClientWidth,ClientHeight,5,5);
 FCanvas.TextOut((ClientWidth-FCanvas.TextWidth(Text)) div 2,
                 (ClientHeight-FCanvas.TextHeight(Text)) div 2,Text);
 FCanvas.Free;
end;
end.

Вызов.

Код


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

Но всё равно при первом ножатии кнопка перерисовывается нетак как надо.

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

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

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

Romikgy

Дата 6.2.2007, 22:57 (ссылка)

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

Загрузка ...

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

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

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

немного поправил

Код


Unit MyButton;
interface
uses
  Windows,SysUtils, Classes, Controls, StdCtrls, Messages, Graphics, Forms, Dialogs;
Type
 TMyButton=class (TButton)
   private
     H: HWND;
     HD: HDC;
     FCanvas: TCanvas;
     R: TRect;
   protected
   
   public
     procedure PAINT(var Message: TWMPaint); message WM_PAINT;
     procedure MOVE(var Message: TMessage); message CM_MOUSEENTER;
     procedure MOVEl(var Message: TMessage); message CM_MOUSELEAVE;
     procedure DOWN(var Message: TMessage); message WM_LBUTTONDOWN;
     procedure DBLCLK(var Message: TMessage); message WM_LBUTTONDBLCLK;
     procedure UP(var Message: TMessage); message WM_LBUTTONUP;
     procedure DrawButton(A: Byte);
   published
  end;
Type
    AArray=Array[0..2,0..20] of TColor;
const
    Col: AArray=((15591399,15722985,15854571,15986157,16117743,
                  16117743,16117743,16117743,15920364,15722985,
                  15525606,15328227,15130848,14933469,14736090,
                  14538711,14341332,14143953,13946574,13749195,
                  13551816),
                 (14736090,15065055,15394020,15657192,15920364,
                  16117743,16315122,16512501,16644087,16709880,
                  16775673,16709880,16644087,16512501,16315122,
                  16117743,15920364,15657192,15394020,15065055,
                  14736090),
                 (8946306,9143685,9341064,9538443,9735822,
                  9933201,10130580,10327959,10525338,10722717,
                  10920096,11117475,11314854,11512233,11512233,
                  11512233,11512233,11380647,11249061,11117475,
                  10985889));
procedure Register;
implementation
uses Variants;
procedure Register;
begin
  RegisterComponents('Standard', [TMyButton]);
end;
procedure TMyButton.PAINT(var Message: TWMPaint);
begin
 inherited;

  DrawButton(0);
end;
procedure TMyButton.MOVE(var Message: TMessage);
begin

 DrawButton(1);
end;
procedure TMyButton.DOWN(var Message: TMessage);
begin
 DrawButton(2);
end;
procedure TMyButton.DBLCLK(var Message: TMessage);
begin
 DrawButton(2);
end;
procedure TMyButton.UP(var Message: TMessage);
begin
 DrawButton(1);
end;
procedure TMyButton.DrawButton(A: Byte);
var
  Y,C: Integer;
  CenterText: TRect;
begin
 C:=0;
 R.Top:=0;
 R.Bottom:=25;
 R.Left:=0;
 R.Right:=75;
 HD:=GetDeviceContext(H);
 for Y:=R.Top+1 to R.Bottom-2 do
  begin
   FCanvas:=TCanvas.Create;
 //  FCanvas.Lock;
   FCanvas.Handle:=HD;
   case A of
        0: FCanvas.Pen.Color:=Col[0,C];
        1: FCanvas.Pen.Color:=Col[1,C];
        2: FCanvas.Pen.Color:=Col[2,C];
   end;
   FCanvas.MoveTo(R.Left+1,Y);
   FCanvas.LineTo(R.Right-1,Y);
   if C<20 then Inc(C);
  end;
 FCanvas.Pen.Color:=$00CFCFCF;
 FCanvas.Brush.Style:=bsClear;
 FCanvas.RoundRect(R.Left,R.Top,R.Right,R.Bottom,5,5);
 CenterText.Left:=(R.Right-FCanvas.TextWidth(Text)) div 2;
 CenterText.Top:=(R.Bottom-FCanvas.TextHeight(Text)) div 2;
 FCanvas.TextOut(CenterText.Left,CenterText.Top,Text);
end;
procedure TMyButton.MOVEl(var Message: TMessage);
begin
  DrawButton(0);
end;

end.

Цитата(ivan219 @ 6.2.2007, 21:00

)

Но всё равно при первом ножатии кнопка перерисовывается нетак как надо.

на это смотрю,
там происходит вызоввм_паинта и он рисует первую картику smile

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

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

Romikgy

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

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

Загрузка ...

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

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

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

окончательный вариант

Код


Unit MyButton;
interface
uses
  Windows,SysUtils, Classes, Controls, StdCtrls, Messages, Graphics, Forms, Dialogs;
Type
 TMyButton=class (TButton)
   private
     H: HWND;
     HD: HDC;
     FCanvas: TCanvas;
     R: TRect;
     lbd, under: Boolean;
   protected
   
   public
     procedure PAINT(var Message: TWMPaint); message WM_PAINT;
     procedure MOVE(var Message: TMessage); message CM_MOUSEENTER;
     procedure MOVEl(var Message: TMessage); message CM_MOUSELEAVE;
     procedure DOWN(var Message: TMessage); message WM_LBUTTONDOWN;
     procedure DBLCLK(var Message: TMessage); message WM_LBUTTONDBLCLK;
     procedure UP(var Message: TMessage); message WM_LBUTTONUP;
     procedure DrawButton(A: Byte);
     constructor Create(AOwner: TComponent); override;
   published
  end;
Type
    AArray=Array[0..2,0..20] of TColor;
const
    Col: AArray=((15591399,15722985,15854571,15986157,16117743,
                  16117743,16117743,16117743,15920364,15722985,
                  15525606,15328227,15130848,14933469,14736090,
                  14538711,14341332,14143953,13946574,13749195,
                  13551816),
                 (14736090,15065055,15394020,15657192,15920364,
                  16117743,16315122,16512501,16644087,16709880,
                  16775673,16709880,16644087,16512501,16315122,
                  16117743,15920364,15657192,15394020,15065055,
                  14736090),
                 (8946306,9143685,9341064,9538443,9735822,
                  9933201,10130580,10327959,10525338,10722717,
                  10920096,11117475,11314854,11512233,11512233,
                  11512233,11512233,11380647,11249061,11117475,
                  10985889));
procedure Register;
implementation
uses Variants;
procedure Register;
begin
  RegisterComponents('Standard', [TMyButton]);
end;
procedure TMyButton.PAINT(var Message: TWMPaint);
begin
 inherited;
  if under then
  begin
   if lbd then
    DrawButton(2)
   else
   DrawButton(1);
  end
  else
  DrawButton(0);
end;
procedure TMyButton.MOVE(var Message: TMessage);
begin
 under:=True;
 DrawButton(1);
end;
procedure TMyButton.DOWN(var Message: TMessage);
begin
  lbd:=True;
 DrawButton(2);
end;
procedure TMyButton.DBLCLK(var Message: TMessage);
begin
 DrawButton(2);
end;
procedure TMyButton.UP(var Message: TMessage);
begin
  lbd:=False;
 DrawButton(1);
end;
procedure TMyButton.DrawButton(A: Byte);
var
  Y,C: Integer;
  CenterText: TRect;
begin
 C:=0;
 R.Top:=0;
 R.Bottom:=25;
 R.Left:=0;
 R.Right:=75;
 HD:=GetDeviceContext(H);
 for Y:=R.Top+1 to R.Bottom-2 do
  begin
   FCanvas:=TCanvas.Create;
 //  FCanvas.Lock;
   FCanvas.Handle:=HD;
   case A of
        0: FCanvas.Pen.Color:=Col[0,C];
        1: FCanvas.Pen.Color:=Col[1,C];
        2: FCanvas.Pen.Color:=Col[2,C];
   end;
   FCanvas.MoveTo(R.Left+1,Y);
   FCanvas.LineTo(R.Right-1,Y);
   if C<20 then Inc(C);
  end;
 FCanvas.Pen.Color:=$00CFCFCF;
 FCanvas.Brush.Style:=bsClear;
 FCanvas.RoundRect(R.Left,R.Top,R.Right,R.Bottom,5,5);
 CenterText.Left:=(R.Right-FCanvas.TextWidth(Text)) div 2;
 CenterText.Top:=(R.Bottom-FCanvas.TextHeight(Text)) div 2;
 FCanvas.TextOut(CenterText.Left,CenterText.Top,Text);
end;
procedure TMyButton.MOVEl(var Message: TMessage);
begin
  under:=False;
  DrawButton(0);
end;

constructor TMyButton.Create(AOwner: TComponent);
begin
  inherited;
  lbd:=False;
  under:=False;

end;

end.

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

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

ivan219

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

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

Загрузка ...

Эксперт

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

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

Romikgy, Спасибо smile

всё работает smile

Возник один вопрос от куда в переменной H взялось значение что потом я из него Hendl вытянул smile

Код


Type
 TMyButton=class(TButton)
   private
     H: HWND;
     HD: HDC;
.
.
HD:=GetDeviceContext(H);

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

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

Romikgy

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

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

Загрузка ...

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

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

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

Цитата(ivan219 @ 6.2.2007, 22:49

)

Возник один вопрос от куда в переменной H взялось значение что потом я из него Hendl вытянул

этого я сам не знаю smile

но так насколько помнится было в хелпе дельфей, я в этом коде ничего не менял smile

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

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

ivan219

Дата 7.2.2007, 00:05 (ссылка)

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

Загрузка ...

Эксперт

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

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

А всё таки интересно откуда ведь туда можно любую переменную назначить и всё равно в ней будет что-то даже если её за пределы Type вынести то тоже всё работает smile

а по идеи в ней 0 должен быть её тип HWND = type LongWord; smile

Это полтергейст smile

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

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

Sunvas

Дата 7.2.2007, 00:12 (ссылка)

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

Загрузка ...

Соль и сахар

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

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

Цитата(ivan219 @ 6.2.2007, 23:49

)

Возник один вопрос от куда в переменной H взялось значение что потом я из него Hendl вытянул

Дебаггером оттестить smile

Цитата(ivan219 @ 7.2.2007, 00:05

)

Это полтергейст

Возможно тут действует тот факт, что по умолчанию переменные "забиты" мусором.

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

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

Romikgy

Дата 7.2.2007, 00:14 (ссылка)

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

Загрузка ...

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

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

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

Цитата

Provides access to a device context for the control.

Delphi syntax:

function GetDeviceContext(var WindowHandle: HWnd): HDC; override;

это метод TWinControl , а батон потомок его
плюс сам метод выдает 2 параметра HDC ответ ф_ции
и HWnd хендл окна , т.к. мы находимся в этом классе то мы знаем (точнее компонент ) и хендл свой и хдц

Добавлено @ 00:15

Цитата(Sunvas @ 6.2.2007, 23:12

)

что по умолчанию переменные "забиты" мусором.

неа в дельфи по умолчанию данные забиты нулями (если дин массив не создавался средствами апи винды)

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

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

ivan219

Дата 7.2.2007, 09:47 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(Sunvas @ 7.2.2007, 00:12

)

Возможно тут действует тот факт, что по умолчанию переменные "забиты" мусором.

Это если локальная переменная то мусором.
Я её за пределы класса выносил значит там должны быть 0 но всё работает, скорей всего Romikgy прав.

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

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

ivan219

Дата 7.2.2007, 17:51 (ссылка)

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

Загрузка ...

Эксперт

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

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

Вопрос не решён так как исчезло событие OnClick т.е. оно еть но не действует, всё что в него вписать не выполняется smile

Код


Unit MyButton;
interface

uses
  Windows, Classes, Controls, Messages, Graphics, StdCtrls;

Type
 TMyButton=class(TButton)
   private
     H: HWND;
     Lbd, Under: Boolean;
   protected
     constructor Create(AOwner: TComponent); override;
     procedure PAINT(var Message: TWMPaint); message WM_PAINT;
     procedure MOVE(var Message: TMessage); message CM_MOUSEENTER;
     procedure MOVEl(var Message: TMessage); message CM_MOUSELEAVE;
     procedure DOWN(var Message: TMessage); message WM_LBUTTONDOWN;
     procedure DBLCLK(var Message: TMessage); message WM_LBUTTONDBLCLK;
     procedure UP(var Message: TMessage); message WM_LBUTTONUP;
     procedure DrawButton(A: Byte);
   published
  end;

Type
    AArray=Array[0..2,0..22] of TColor;
const
    Col: AArray=((15591399,15591399,15722985,15854571,15986157,16117743,
                  16117743,16117743,16117743,16117743,15920364,15722985,
                  15525606,15328227,15130848,14933469,14736090,14538711,
                  14341332,14143953,13946574,13749195,13551816),
                 (14736090,14736090,15065055,15394020,15657192,15920364,
                  16117743,16315122,16512501,16644087,16709880,16775673,
                  16775673,16709880,16644087,16512501,16315122,16117743,
                  15920364,15657192,15394020,15065055,14736090),
                 (8946306,8946306,9143685,9341064,9538443,9735822,9933201,
                  10130580,10327959,10525338,10722717,10920096,11117475,
                  11314854,11512233,11512233,11512233,11512233,11512233,
                  11380647,11249061,11117475,10985889));


procedure Register;

implementation

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

constructor TMyButton.Create(AOwner: TComponent);
begin
 inherited;
 Lbd:=False;
 Under:=False;
end;

procedure TMyButton.PAINT(var Message: TWMPaint);
begin
 inherited;
  if Under then
   begin
    if Lbd then DrawButton(2)
    else DrawButton(1);
   end
  else DrawButton(0);
end;

procedure TMyButton.MOVE(var Message: TMessage);
begin
 Under:=True;
 DrawButton(1);
end;

procedure TMyButton.DOWN(var Message: TMessage);
begin
 Lbd:=True;
 DrawButton(2);
end;

procedure TMyButton.DBLCLK(var Message: TMessage);
begin
 DrawButton(2);
end;

procedure TMyButton.UP(var Message: TMessage);
begin
 Lbd:=False;
 DrawButton(1);
end;

procedure TMyButton.MOVEl(var Message: TMessage);
begin
 Under:=False;
 DrawButton(0);
end;

procedure TMyButton.DrawButton(A: Byte);
var
  Y,C: Integer;
  R: hRGN;
  HD: HDC;
  FCanvas: TCanvas;
  Rect: TRect;
begin
 C:=0;
 HD:=GetDeviceContext(H);
 FCanvas:=TCanvas.Create;
 FCanvas.Handle:=HD;
 for Y:=1 to ClientHeight-2 do
  begin
   case A of
        0: FCanvas.Pen.Color:=Col[0,C];
        1: FCanvas.Pen.Color:=Col[1,C];
        2: FCanvas.Pen.Color:=Col[2,C];
   end;
   FCanvas.MoveTo(1,Y);
   FCanvas.LineTo(ClientWidth-1,Y);
   if C<22 then Inc(C);
  end;
 case A of
      0,2: begin
            Rect.Left:=(ClientWidth-FCanvas.TextWidth(Text)) div 2;
            Rect.Top:=(ClientHeight-FCanvas.TextHeight(Text)) div 2;
           end;
      1: begin
          Rect.Left:=(ClientWidth-FCanvas.TextWidth(Text)) div 2-1;
          Rect.Top:=(ClientHeight-FCanvas.TextHeight(Text)) div 2-1;
         end;
 end;
 FCanvas.Pen.Color:=$00CFCFCF;
 FCanvas.Brush.Style:=bsClear;
 FCanvas.RoundRect(0,0,ClientWidth,ClientHeight,5,5); 
 FCanvas.TextOut(Rect.Left,Rect.Top,Text);
 R:=CreateRoundRectRgn(0,0,ClientWidth+1,ClientHeight,5,5);
 try
   SetWindowRgn(H,R,True);
 finally
   DeleteObject(R);
 end;
 FCanvas.Free;
end;
end.

Добавлено @ 17:54

Код


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

procedure TForm1.OC(Sender: TObject);
begin
 Button1.Caption:='f';
end;

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

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

CatATonik

Дата 7.2.2007, 17:56 (ссылка)

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

Загрузка ...

Шустрый

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

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

Добавь inherited

Код


procedure TMyButton.UP(var Message: TMessage);
begin
 inherited;
 Lbd:=False;
 DrawButton(1);
end;

и так во все обработчики сообщений

Это сообщение отредактировал(а) CatATonik - 7.2.2007, 17:57

ivan219

Дата 7.2.2007, 18:14 (ссылка)

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

Загрузка ...

Эксперт

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

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

Точно

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

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

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