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

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

Точно

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

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

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