Форум программистов, компьютерный форум, киберфорум
Наши страницы
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
 
Рейтинг 5.00/4: Рейтинг темы: голосов - 4, средняя оценка - 5.00
Ksen Ters
14 / 14 / 2
Регистрация: 22.01.2012
Сообщений: 80
Записей в блоге: 1
1

Проблемы при ручном создании компонента

14.10.2012, 17:00. Просмотров 801. Ответов 9
Метки нет (Все метки)

Делаю свой компонент-кнопку. Просто как компонент создается на ура, НО как только пытаюсь изменить шрифт
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
type
  TSkinedBtn = class(TCustomControl)
  private
    { Private declarations }
{...}
  FFont: TFont;
{...}
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner:TComponent);override;
    procedure Paint; override;
    destructor Destroy; override;
    procedure Repaint;override;
  published
    { Published declarations }
    property onClick;
    property Font:TFont read FFont write FFont;
{...}
  end;
хотя бы так
Delphi
1
2
3
4
5
6
7
8
procedure TForm1.FormCreate(Sender: TObject);
begin
sb:=tskinedbtn.Create(self);
sb.Top:=20;
sb.Left:=20;
sb.Parent:=self;
sb.Font.Assign(form1.Font);//вот тут вот ошибка
end;
Вылетает ошибка на указанном этапе EAccessViolation. Объясните, что я делаю не правильно.
0
Миниатюры
Проблемы при ручном создании компонента  
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
14.10.2012, 17:00
Ответы с готовыми решениями:

Глюк при создании компонента динамически
При формировании таблицы в двах столбцах (m и h) динамически создаются...

Размер компонента webbrowser при динамичном создании TabSheet
Опытные програмисты помогите новичку. Сделал в дельфи свой браузер, с...

access veolation - при создании на mdi form компонента
В мди приложении создаеться форма на которой в процесс е создания формы...

События для формы при создании нового компонента
Здравсвуйте. Создал новый компонент на основе Tbutton. TnewButton =...

Глюк при создании собственного компонента
Создал свой компонент, в нем создал поле типа TEdit, далее при работе с этим...

9
volvo
Супер-модератор
Эксперт Pascal/DelphiАвтор FAQ
26124 / 17519 / 6948
Регистрация: 22.10.2011
Сообщений: 30,856
Записей в блоге: 6
14.10.2012, 17:20 2
Где ты создаешь FFont? В предоставленном тобой коде FFont = TFont.Create не присутствует, а Assign нельзя делать неинициализированному объекту.
1
Alex_pac
1292 / 698 / 107
Регистрация: 25.05.2011
Сообщений: 2,158
Записей в блоге: 51
14.10.2012, 17:23 3
Ошибка памяти

выдели память для TFont

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
Constructor TSkinedBtn.Create(Aowner: TComponent);
begin
// bla bla
FFont := TFont.Create;
// bla bla
end;
 
Destructor TSkinedBtn.Destroy;
begin
FFont.Free;
inherited;
end;
1
angstrom
2470 / 1846 / 242
Регистрация: 14.09.2012
Сообщений: 5,981
Записей в блоге: 2
14.10.2012, 17:25 4
Непонятно, зачем переопределять фонт
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
type
  TSkinedBtn = class(TCustomControl)
  private
    { Private declarations }
{...}
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner:TComponent);override;
    procedure Paint; override;
    destructor Destroy; override;
    procedure Repaint;override;
  published
    { Published declarations }
    property onClick;
    property Font;
{...}
  end;
1
Ksen Ters
14 / 14 / 2
Регистрация: 22.01.2012
Сообщений: 80
Записей в блоге: 1
14.10.2012, 18:12  [ТС] 5
Цитата Сообщение от angstrom Посмотреть сообщение
Непонятно, зачем переопределять фонт
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
type
  TSkinedBtn = class(TCustomControl)
  private
    { Private declarations }
{...}
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner:TComponent);override;
    procedure Paint; override;
    destructor Destroy; override;
    procedure Repaint;override;
  published
    { Published declarations }
    property onClick;
    property Font;
{...}
  end;
Это помогло, создавать font не понадобилось, я еще в самом компоненте забыл это свойство использовать, теперь все нормально работает, всем спасибо

Добавлено через 4 минуты
А еще вопрос немного не по теме: какую процедуру лучше использовать для отображения на канве кнопки картинки, загружаемой в переменную из файла ресурсов
Кликните здесь для просмотра всего текста
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
type
  TSkinedBtn = class(TCustomControl)
  private
    { Private declarations }
  skinset,
  skinu,
  skinm,
  skind,
  skine:TBitmap;
{...}
constructor TSkinedBtn.Create(AOWner: TComponent);
var
bmp : TBitmap;
w, h : Integer;
left : Integer;
i : Integer;
begin
skinset:=tbitmap.Create;
skinu:=tbitmap.Create;
skinm:=tbitmap.Create;
skind:=tbitmap.Create;
skine:=tbitmap.Create;
 
caption:='Skinned Button';
 
skinset.LoadFromResourceName(hinstance, 'skin.bmp');
 
w:=skinset.Width div 4;
h:=skinset.Height;
 
skinu.Width := w;
skinm.Width := w;
skind.Width := w;
skine.Width := w;
skinu.Height := h;
skinm.Height := h;
skind.Height := h;
skine.Height := h;
 
bmp := TBitmap.Create;
bmp.Height := h;
bmp.Width := w;
 
left := 0;
 
for i := 0 to 3 do
begin
  BitBlt(bmp.Canvas.Handle, 0, 0,
  w,h,skinset.Canvas.Handle,left, 0, SRCCOPY);
  case i of
  0:skinu.Assign(bmp);
  1:skinm.Assign(bmp);
  2:skind.Assign(bmp);
  3:skine.Assign(bmp);
  end;
left := left + w;
end;
procedure TSkinedBtn.Paint;
begin
 
inherited;
canvas.Font.Assign(font);
if FEnabled then
begin
Canvas.draw(0,0,skinu);
 
Canvas.Brush.Style:=bsClear;
Canvas.TextOut((Width div 2)-(canvas.TextWidth(ftext) div 2),(height div 2)-(canvas.textheight(ftext) div 2),ftext);
end
else begin
Canvas.draw(0,0,skine);//возможно из за этого тормозит компонент
 
Canvas.Brush.Style:=bsClear;
Canvas.TextOut((Width div 2)-(canvas.TextWidth(ftext) div 2),(height div 2)-(canvas.textheight(ftext) div 2),ftext);
end;
end;

чтобы быстрее работал компонент?
0
Alex_pac
1292 / 698 / 107
Регистрация: 25.05.2011
Сообщений: 2,158
Записей в блоге: 51
14.10.2012, 18:15 6
через ImageList

вот пример

- Кнопка с рисунком из TImageList
- Картинка основная, при наведении, при нажатии, при отключении

ImageList: TImageList
ImageIndex: Integer // Картинка основная
ImgIndHover: Integer // Картинка при наведении
ImgIndDown: Integer // Картинка при нажатии
ImgIndDisabled: Integer // Картинка при отключении

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
unit ImgListBtnUnit;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, ImgList;
 
type
  TImageListBtn = class(TGraphicControl)
  private
    { Private declarations }
    FImageIndex: Integer;
    FImageList: TImageList;
    FImgIndHover: Integer;
    FImgIndDown: Integer;
    FImgIndDisabled: Integer;
    procedure SetImageIndex(const Value: Integer);
    procedure SetImageList(const Value: TImageList);
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure EvMouseEnter(var Msg: TMessage); message CM_MouseEnter; // мышь в зоне
    procedure EvMouseLeave(var Msg: TMessage); message CM_MouseLeave; // мышь вне зоны
    procedure SetImgIndDisabled(const Value: Integer); 
  protected
    { Protected declarations }
    down: boolean;
    hover: boolean;
    procedure Paint; override;
    procedure EvMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
    procedure EvMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
  published
     property Align;
     property Color;
     property Enabled;
     property ParentColor;
     property Visible;
     property OnClick;
      //property OnContextPopup;
     property OnDblClick;
      //property OnMouseActivate;
      //property OnMouseDown;
      //property OnMouseEnter;
      //property OnMouseLeave;
      //property OnMouseMove;
      //property OnMouseUp;
 
    { Published declarations }
    property ImageList: TImageList read FImageList write SetImageList;
    property ImageIndex: Integer read FImageIndex write SetImageIndex Default -1;
    property ImgIndHover: Integer read FImgIndHover write FImgIndHover Default -1;
    property ImgIndDown: Integer read FImgIndDown write FImgIndDown Default -1;
    property ImgIndDisabled: Integer read FImgIndDisabled write SetImgIndDisabled Default -1;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Samples', [TImageListBtn]);
end;
 
{ TGlyph }
constructor TImageListBtn.Create(AOwner: TComponent);
begin
  inherited;
  FImageIndex := -1;
  FImgIndHover:= -1;
  FImgIndDown:= -1;
  FImgIndDisabled:= -1;
  hover:=false;
  down:=false;
  self.OnMouseDown:=self.EvMouseDown;
  self.OnMouseUp:=self.EvMouseUp;
  Color:=clBlack;
end;
 
procedure TImageListBtn.EvMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if csDesigning in ComponentState then exit;
  if Button<>mbLeft then exit;
  down:=true;
  Repaint;
end;
 
procedure TImageListBtn.EvMouseEnter(var Msg: TMessage);
begin
  if csDesigning in ComponentState then exit;
  hover:=true;
  Repaint;
end;
 
procedure TImageListBtn.EvMouseLeave(var Msg: TMessage);
begin
  if csDesigning in ComponentState then exit;
  hover:=false;
  down:=false;
  Repaint;
end;
 
procedure TImageListBtn.EvMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if csDesigning in ComponentState then exit;
  if Button<>mbLeft then exit;
  down:=false;
  Repaint;
end;
 
procedure TImageListBtn.Paint;
begin
  if Assigned(FImageList) and (FImageIndex>=0) then begin
    with FImageList do
      if Enabled then begin
         if down and (FImgIndDown>=0) then Draw(Self.Canvas, 0, 0, FImgIndDown)
         else
         if hover and (FImgIndHover>=0) then Draw(Self.Canvas, 0, 0, FImgIndHover)
         else
         if FImageIndex>=0 then Draw(Self.Canvas, 0, 0, FImageIndex);
      end else
         if FImgIndDisabled>=0 then Draw(Self.Canvas, 0, 0, FImgIndDisabled)
         else
         if FImageIndex>=0 then Draw(Self.Canvas, 0, 0, FImageIndex);
  end else // компонент в режиме Desing
    if csDesigning in ComponentState then begin
      Canvas.Brush.Style:=bsClear;
      Canvas.Pen.Style:=psDot;
      Canvas.Pen.Width:=1;
      // color Reverse
      Canvas.Pen.Color:=Color;
      Canvas.Rectangle(0,0,Width,Height);
    end else inherited;
end;
 
procedure TImageListBtn.SetImageIndex(const Value: Integer);
begin
  FImageIndex := Value;
  Repaint;
end;
 
procedure TImageListBtn.SetImageList(const Value: TImageList);
begin
  FImageList := Value;
  if Assigned(FImageList) then
  begin
    Self.Width := FImageList.Width;
    Self.Height := FImageList.Height;
  end;
end;
 
procedure TImageListBtn.SetImgIndDisabled(const Value: Integer);
begin
  FImgIndDisabled := Value;
  Repaint;
end;
 
procedure TImageListBtn.WMSize(var Message: TWMSize);
begin
  if Assigned(FImageList) then
  begin
    if Message.Width > FImageList.Width then
      Message.Width := FImageList.Width;
    if Message.Height > FImageList.Height then
      Message.Height := FImageList.Height;
  end;
  inherited;
end;
 
end.
1
Миниатюры
Проблемы при ручном создании компонента  
Вложения
Тип файла: zip ImageListButton.zip (328.8 Кб, 6 просмотров)
Ksen Ters
14 / 14 / 2
Регистрация: 22.01.2012
Сообщений: 80
Записей в блоге: 1
14.10.2012, 18:18  [ТС] 7
Цитата Сообщение от Alex_pac Посмотреть сообщение
через ImageList

вот пример

- Кнопка с рисунком из TImageList
- Картинка основная, при наведении, при нажатии, при отключении

ImageList: TImageList
ImageIndex: Integer // Картинка основная
ImgIndHover: Integer // Картинка при наведении
ImgIndDown: Integer // Картинка при нажатии
ImgIndDisabled: Integer // Картинка при отключении

Кликните здесь для просмотра всего текста
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
unit ImgListBtnUnit;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, ImgList;
 
type
  TImageListBtn = class(TGraphicControl)
  private
    { Private declarations }
    FImageIndex: Integer;
    FImageList: TImageList;
    FImgIndHover: Integer;
    FImgIndDown: Integer;
    FImgIndDisabled: Integer;
    procedure SetImageIndex(const Value: Integer);
    procedure SetImageList(const Value: TImageList);
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure EvMouseEnter(var Msg: TMessage); message CM_MouseEnter; // мышь в зоне
    procedure EvMouseLeave(var Msg: TMessage); message CM_MouseLeave; // мышь вне зоны
    procedure SetImgIndDisabled(const Value: Integer); 
  protected
    { Protected declarations }
    down: boolean;
    hover: boolean;
    procedure Paint; override;
    procedure EvMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
    procedure EvMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
  published
     property Align;
     property Color;
     property Enabled;
     property ParentColor;
     property Visible;
     property OnClick;
      //property OnContextPopup;
     property OnDblClick;
      //property OnMouseActivate;
      //property OnMouseDown;
      //property OnMouseEnter;
      //property OnMouseLeave;
      //property OnMouseMove;
      //property OnMouseUp;
 
    { Published declarations }
    property ImageList: TImageList read FImageList write SetImageList;
    property ImageIndex: Integer read FImageIndex write SetImageIndex Default -1;
    property ImgIndHover: Integer read FImgIndHover write FImgIndHover Default -1;
    property ImgIndDown: Integer read FImgIndDown write FImgIndDown Default -1;
    property ImgIndDisabled: Integer read FImgIndDisabled write SetImgIndDisabled Default -1;
  end;
 
//function ColorOptimal(AColor: TColor): TColor;
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Samples', [TImageListBtn]);
end;
 
function ColorOptimal(AColor: TColor): TColor;
var
R, G, B: Word;
begin
R := GetRValue(AColor);
G := GetGValue(AColor);
B := GetBValue(AColor);
if 0.222*R + 0.707*G + 0.071*B <= 127 then
  Result := clWhite
else
  Result := clBlack;
end;
 
{ TGlyph }
constructor TImageListBtn.Create(AOwner: TComponent);
begin
  inherited;
  FImageIndex := -1;
  FImgIndHover:= -1;
  FImgIndDown:= -1;
  FImgIndDisabled:= -1;
  hover:=false;
  down:=false;
  self.OnMouseDown:=self.EvMouseDown;
  self.OnMouseUp:=self.EvMouseUp;
  Color:=clBlack;
end;
 
procedure TImageListBtn.EvMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if csDesigning in ComponentState then exit;
  if Button<>mbLeft then exit;
  down:=true;
  Repaint;
end;
 
procedure TImageListBtn.EvMouseEnter(var Msg: TMessage);
begin
  if csDesigning in ComponentState then exit;
  hover:=true;
  Repaint;
end;
 
procedure TImageListBtn.EvMouseLeave(var Msg: TMessage);
begin
  if csDesigning in ComponentState then exit;
  hover:=false;
  down:=false;
  Repaint;
end;
 
procedure TImageListBtn.EvMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if csDesigning in ComponentState then exit;
  if Button<>mbLeft then exit;
  down:=false;
  Repaint;
end;
 
procedure TImageListBtn.Paint;
begin
  if Assigned(FImageList) and (FImageIndex>=0) then begin
    with FImageList do
      if Enabled then begin
         if down and (FImgIndDown>=0) then Draw(Self.Canvas, 0, 0, FImgIndDown)
         else
         if hover and (FImgIndHover>=0) then Draw(Self.Canvas, 0, 0, FImgIndHover)
         else
         if FImageIndex>=0 then Draw(Self.Canvas, 0, 0, FImageIndex);
      end else
         if FImgIndDisabled>=0 then Draw(Self.Canvas, 0, 0, FImgIndDisabled)
         else
         if FImageIndex>=0 then Draw(Self.Canvas, 0, 0, FImageIndex);
  end else // компонент в режиме Desing
    if csDesigning in ComponentState then begin
      Canvas.Brush.Style:=bsClear;
      Canvas.Pen.Style:=psDot;
      Canvas.Pen.Width:=1;
      // color Reverse
      Canvas.Pen.Color:=Color;
      Canvas.Rectangle(0,0,Width,Height);
    end else inherited;
end;
 
procedure TImageListBtn.SetImageIndex(const Value: Integer);
begin
  FImageIndex := Value;
  Repaint;
end;
 
procedure TImageListBtn.SetImageList(const Value: TImageList);
begin
  FImageList := Value;
  if Assigned(FImageList) then
  begin
    Self.Width := FImageList.Width;
    Self.Height := FImageList.Height;
  end;
end;
 
procedure TImageListBtn.SetImgIndDisabled(const Value: Integer);
begin
  FImgIndDisabled := Value;
  Repaint;
end;
 
procedure TImageListBtn.WMSize(var Message: TWMSize);
begin
  if Assigned(FImageList) then
  begin
    if Message.Width > FImageList.Width then
      Message.Width := FImageList.Width;
    if Message.Height > FImageList.Height then
      Message.Height := FImageList.Height;
  end;
  inherited;
end;
 
end.
Я имел ввиду возможность использовать что-либо более быстрое чем Canvas.Draw() а у вас то же самое используется.
0
Alex_pac
1292 / 698 / 107
Регистрация: 25.05.2011
Сообщений: 2,158
Записей в блоге: 51
14.10.2012, 18:20 8
Я имел ввиду возможность использовать что-либо более быстрое чем Canvas.Draw() а у вас то же самое используется.
Form1.DoubleBuffered:=true;
1
angstrom
2470 / 1846 / 242
Регистрация: 14.09.2012
Сообщений: 5,981
Записей в блоге: 2
14.10.2012, 21:22 9
Canvas.Draw, использует BitBlt - достаточно быстрая функция, у Alex_pac используется ImageList.Draw - также не медленный способ отрисовки. Хотите ещё быстрее, используйте GDI+.
1
Ksen Ters
14 / 14 / 2
Регистрация: 22.01.2012
Сообщений: 80
Записей в блоге: 1
19.10.2012, 11:30  [ТС] 10
И еще немного о компонентах
добавил в свой компонент поддержку скинов
Кликните здесь для просмотра всего текста
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
type
TSkinedBtn = class(TCustomControl)
  private
  {...}
  skinset,
  skinu,
  skinm,
  skind,
  skine:TBitmap;
  FSkin:TBitmap;
  procedure SetText(Value: String);
  procedure ChangeSkin(Value:TBitmap);
  procedure zapil(Value:TBitmap);
  {...}
  public
  {...}
  constructor Create(AOwner:TComponent);override;
  {...}
  published
  {...}
  property Caption: String read FText write SetText;
  property Skin:TBitmap read FSkin write ChangeSkin;
{...}
procedure TSkinedBtn.ChangeSkin(Value:TBitmap);
begin
showmessage('bbb');
//skinset.Assign(value); не знаю как быть
zapil(value);
Repaint;
end;
 
procedure TSkinedBtn.SetText(Value: String);
begin
FText:= Value;
Repaint;
end;
 
procedure TSkinedBtn.zapil(Value:TBitmap);
var
bmp : TBitmap;
w, h : Integer;
left : Integer;
i : Integer;
begin
 
w:=value.Width div 4;
h:=value.Height;
skinu.Width := w;
skinm.Width := w;
skind.Width := w;
skine.Width := w;
skinu.Height := h;
skinm.Height := h;
skind.Height := h;
skine.Height := h;
 
bmp := TBitmap.Create;
bmp.Height := h;
bmp.Width := w;
 
left := 0;
 
for i := 0 to 3 do
begin
  BitBlt(bmp.Canvas.Handle, 0, 0,
  w,h,value.Canvas.Handle,left, 0, SRCCOPY);
  case i of
  0:skinu.Assign(bmp);
  1:skinm.Assign(bmp);
  2:skind.Assign(bmp);
  3:skine.Assign(bmp);
  end;
left := left + w;
end;
 
bmp.Free;
 
Height:=value.Height;
Width:=value.Width div 4;
 
end;
 
constructor TSkinedBtn.Create(AOWner: TComponent);
begin
skinset:=tbitmap.Create;
skinu:=tbitmap.Create;
skinm:=tbitmap.Create;
skind:=tbitmap.Create;
skine:=tbitmap.Create;
 
caption:='Skinned Button';
 
skinset.LoadFromResourceName(hinstance, 'skin.bmp');
 
zapil(skinset);
FEnabled:=true;
MouseDown:=false;
inherited;
end;
 
procedure TSkinedBtn.Paint;
begin
inherited;
canvas.Font.Assign(font);
if FEnabled then
begin
Canvas.draw(0,0,skinu);
Canvas.Brush.Style:=bsClear;
Canvas.TextOut((Width div 2)-(canvas.TextWidth(ftext) div 2),(height div 2)-(canvas.textheight(ftext) div 2),ftext);
end
else begin
Canvas.draw(0,0,skine);
Canvas.Brush.Style:=bsClear;
Canvas.TextOut((Width div 2)-(canvas.TextWidth(ftext) div 2),(height div 2)-(canvas.textheight(ftext) div 2),ftext);
end;
 
procedure TSkinedBtn.RePaint;
begin
inherited;
Paint;
end;

А проблема вот какая: кидаю компонент на форму, меняю скин на меньшего размера(вдвое), при запуске приложения размеры кнопки остаются уменьшенными, а скин широкий, т.е. половину обрезает, подскажите, как и где это исправить?

Добавлено через 15 часов 52 минуты
Цитата Сообщение от Ksen Ters Посмотреть сообщение
И еще немного о компонентах
добавил в свой компонент поддержку скинов
Кликните здесь для просмотра всего текста
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
type
TSkinedBtn = class(TCustomControl)
  private
  {...}
  skinset,
  skinu,
  skinm,
  skind,
  skine:TBitmap;
  FSkin:TBitmap;
  procedure SetText(Value: String);
  procedure ChangeSkin(Value:TBitmap);
  procedure zapil(Value:TBitmap);
  {...}
  public
  {...}
  constructor Create(AOwner:TComponent);override;
  {...}
  published
  {...}
  property Caption: String read FText write SetText;
  property Skin:TBitmap read FSkin write ChangeSkin;
{...}
procedure TSkinedBtn.ChangeSkin(Value:TBitmap);
begin
showmessage('bbb');
//skinset.Assign(value); не знаю как быть
zapil(value);
Repaint;
end;
 
procedure TSkinedBtn.SetText(Value: String);
begin
FText:= Value;
Repaint;
end;
 
procedure TSkinedBtn.zapil(Value:TBitmap);
var
bmp : TBitmap;
w, h : Integer;
left : Integer;
i : Integer;
begin
 
w:=value.Width div 4;
h:=value.Height;
skinu.Width := w;
skinm.Width := w;
skind.Width := w;
skine.Width := w;
skinu.Height := h;
skinm.Height := h;
skind.Height := h;
skine.Height := h;
 
bmp := TBitmap.Create;
bmp.Height := h;
bmp.Width := w;
 
left := 0;
 
for i := 0 to 3 do
begin
  BitBlt(bmp.Canvas.Handle, 0, 0,
  w,h,value.Canvas.Handle,left, 0, SRCCOPY);
  case i of
  0:skinu.Assign(bmp);
  1:skinm.Assign(bmp);
  2:skind.Assign(bmp);
  3:skine.Assign(bmp);
  end;
left := left + w;
end;
 
bmp.Free;
 
Height:=value.Height;
Width:=value.Width div 4;
 
end;
 
constructor TSkinedBtn.Create(AOWner: TComponent);
begin
skinset:=tbitmap.Create;
skinu:=tbitmap.Create;
skinm:=tbitmap.Create;
skind:=tbitmap.Create;
skine:=tbitmap.Create;
 
caption:='Skinned Button';
 
skinset.LoadFromResourceName(hinstance, 'skin.bmp');
 
zapil(skinset);
FEnabled:=true;
MouseDown:=false;
inherited;
end;
 
procedure TSkinedBtn.Paint;
begin
inherited;
canvas.Font.Assign(font);
if FEnabled then
begin
Canvas.draw(0,0,skinu);
Canvas.Brush.Style:=bsClear;
Canvas.TextOut((Width div 2)-(canvas.TextWidth(ftext) div 2),(height div 2)-(canvas.textheight(ftext) div 2),ftext);
end
else begin
Canvas.draw(0,0,skine);
Canvas.Brush.Style:=bsClear;
Canvas.TextOut((Width div 2)-(canvas.TextWidth(ftext) div 2),(height div 2)-(canvas.textheight(ftext) div 2),ftext);
end;
 
procedure TSkinedBtn.RePaint;
begin
inherited;
Paint;
end;

А проблема вот какая: кидаю компонент на форму, меняю скин на меньшего размера(вдвое), при запуске приложения размеры кнопки остаются уменьшенными, а скин широкий, т.е. половину обрезает, подскажите, как и где это исправить?
ап ап, кто-нибудь знает какой кусок кода переделать и как?

Добавлено через 20 часов 12 минут
ап ап нид хэлп

Добавлено через 23 часа 53 минуты
В общем случае хотелось бы полноценную поддержку скинов, но в моем случае хватало 2-х видов, поэтому помогла загрузка этих скинов в разные переменные при создании и процедура обработки изображений в зависимости от типа скина, вынесенного в свойства. Всем спасибо за внимание)
0
19.10.2012, 11:30
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
19.10.2012, 11:30

Создание компонента, при добавлении автоматически получить Parent фокусированного компонента
Привет всем, вот ни разу не писал еще компоненты, начал разбираться, все...

Проблемы написания хорошего компонента
Всем доброго времени суток. У меня такая проблема я создаю компонент с большим...

При описании интерфейса, как параметр метода сделать типа на пример TImage (при создании com-сервера)
При описании интерфейса, как параметр метода сделать типа на пример TImage, или...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
10
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru