質問編集履歴

3

Paintメソッドの中身を記載

2019/10/29 14:05

投稿

dem0nmichik0
dem0nmichik0

スコア37

test CHANGED
File without changes
test CHANGED
@@ -168,10 +168,394 @@
168
168
 
169
169
 
170
170
 
171
+ // WM_PAINTメッセージで起動
172
+
173
+ // クライアントエリアに更新領域が存在するときにコール
174
+
175
+ procedure TDoor.Paint;
176
+
177
+ var
178
+
179
+ x1, y1: Integer;
180
+
181
+ x2, y2: Integer;
182
+
183
+ x_space, y_space: Integer;
184
+
185
+
186
+
187
+ begin
188
+
189
+ // 四角形の場合
190
+
191
+ if FShape = stRectangle then
192
+
193
+ begin
194
+
195
+ with Canvas do begin
196
+
197
+ // FSahpeColor色で塗りつぶし
198
+
199
+ Brush.Color:= FShapeColor;
200
+
201
+ Brush.Style:= bsSolid;
202
+
203
+ FillRect(Rect(Left, Top, (Left+Width), (Top+Height)));
204
+
205
+ // 黒色で太さ1で枠線描画
206
+
207
+ Pen.Color:= clBlack;
208
+
209
+ Pen.Style:= psSolid;
210
+
211
+ Pen.Width:= 1;
212
+
213
+ Rectangle(Rect(Left, Top, (Left+Width), (Top+Height)));
214
+
215
+
216
+
217
+ // 文字列の描画
218
+
219
+ TextOut(FWidth_C, FHeight_C, FCaption);
220
+
221
+ end;
222
+
223
+ end
224
+
225
+ // 円の場合
226
+
227
+ else if FShape = stCircle then
228
+
229
+ begin
230
+
231
+ with Canvas do begin
232
+
233
+ // Color色で塗りつぶし
234
+
235
+ Brush.Color:= Color;
236
+
237
+ Brush.Style:= bsSolid;
238
+
239
+ FillRect(Rect(Left, Top, (Left+Width), (Top+Height)));
240
+
241
+
242
+
243
+ if Width > Height then
244
+
245
+ begin
246
+
247
+ x_space:= Width - Height;
248
+
249
+ x1:= Left + (x_space div 2);
250
+
251
+ y1:= Top;
252
+
253
+ x2:= x1 + Height;
254
+
255
+ y2:= y1 + Height;
256
+
257
+ end
258
+
259
+ else
260
+
261
+ begin
262
+
263
+ y_space:= Height - Width;
264
+
265
+ x1:= Left;
266
+
267
+ y1:= Top + (y_space div 2);
268
+
269
+ x2:= x1 + Width;
270
+
271
+ y2:= y1 + Width;
272
+
273
+ end;
274
+
275
+
276
+
277
+ // FSahpeColor色で塗りつぶし
278
+
279
+ Brush.Color:= FShapeColor;
280
+
281
+ Brush.Style:= bsSolid;
282
+
283
+ // 黒色で太さ1で枠線描画
284
+
285
+ Pen.Color:= clBlack;
286
+
287
+ Pen.Style:= psSolid;
288
+
289
+ Pen.Width:= 1;
290
+
291
+ Ellipse(x1, y1, x2, y2);
292
+
293
+
294
+
295
+ // 文字列の描画
296
+
297
+ TextOut(FWidth_C, FHeight_C, FCaption);
298
+
299
+ end;
300
+
301
+ end
302
+
303
+ // 楕円の場合
304
+
305
+ else if FShape = stEllipse then
306
+
307
+ begin
308
+
309
+ with Canvas do begin
310
+
311
+ // Color色で塗りつぶし
312
+
313
+ Brush.Color:= Color;
314
+
315
+ Brush.Style:= bsSolid;
316
+
317
+ FillRect(Rect(Left, Top, (Left+Width), (Top+Height)));
318
+
319
+ // FSahpeColor色で塗りつぶし
320
+
321
+ Brush.Color:= FShapeColor;
322
+
323
+ Brush.Style:= bsSolid;
324
+
325
+ // 黒色で太さ1で枠線描画
326
+
327
+ Pen.Color:= clBlack;
328
+
329
+ Pen.Style:= psSolid;
330
+
331
+ Pen.Width:= 1;
332
+
333
+ Ellipse(Left, Top, (Left+Width), (Top+Height));
334
+
335
+
336
+
337
+ // 文字列の描画
338
+
339
+ TextOut(FWidth_C, FHeight_C, FCaption);
340
+
341
+ end;
342
+
343
+ end
344
+
345
+ // 角の丸い四角形の場合
346
+
347
+ else if FShape = stRoundRect then
348
+
349
+ begin
350
+
351
+ with Canvas do begin
352
+
353
+ // Color色で塗りつぶし
354
+
355
+ Brush.Color:= Color;
356
+
357
+ Brush.Style:= bsSolid;
358
+
359
+ FillRect(Rect(Left, Top, (Left+Width), (Top+Height)));
360
+
361
+ // FSahpeColor色で塗りつぶし
362
+
363
+ Brush.Color:= FShapeColor;
364
+
365
+ Brush.Style:= bsSolid;
366
+
367
+ // 黒色で太さ1で枠線描画
368
+
369
+ Pen.Color:= clBlack;
370
+
371
+ Pen.Style:= psSolid;
372
+
373
+ Pen.Width:= 1;
374
+
375
+ RoundRect(Left, Top, Width, Height, 10, 10);
376
+
377
+
378
+
379
+ // 文字列の描画
380
+
381
+ TextOut(FWidth_C, FHeight_C, FCaption);
382
+
383
+ end;
384
+
385
+ end
386
+
387
+ // 角の丸い正方形の場合
388
+
389
+ else if FShape = stRoundSquare then
390
+
391
+ begin
392
+
393
+ with Canvas do begin
394
+
395
+ if Width > Height then
396
+
397
+ begin
398
+
399
+ x_space:= Width - Height;
400
+
401
+ x1:= Left + (x_space div 2);
402
+
403
+ y1:= Top;
404
+
405
+ x2:= x1 + Height;
406
+
407
+ y2:= y1 + Height;
408
+
409
+ end
410
+
411
+ else
412
+
413
+ begin
414
+
415
+ y_space:= Height - Width;
416
+
417
+ x1:= Left;
418
+
419
+ y1:= Top + (y_space div 2);
420
+
421
+ x2:= x1 + Width;
422
+
423
+ y2:= y1 + Width;
424
+
425
+ end;
426
+
427
+
428
+
429
+ // Color色で塗りつぶし
430
+
431
+ Brush.Color:= Color;
432
+
433
+ Brush.Style:= bsSolid;
434
+
435
+ FillRect(Rect(Left, Top, (Left+Width), (Top+Height)));
436
+
437
+ // FSahpeColor色で塗りつぶし
438
+
439
+ Brush.Color:= FShapeColor;
440
+
441
+ Brush.Style:= bsSolid;
442
+
443
+ // 黒色で太さ1で枠線描画
444
+
445
+ Pen.Color:= clBlack;
446
+
447
+ Pen.Style:= psSolid;
448
+
449
+ Pen.Width:= 1;
450
+
451
+ RoundRect(x1, y1, x2, y2, 10, 10);
452
+
453
+
454
+
455
+ // 文字列の描画
456
+
457
+ TextOut(FWidth_C, FHeight_C, FCaption);
458
+
459
+ end;
460
+
461
+ end
462
+
463
+ // 正方形の場合
464
+
465
+ else if FShape = stSquare then
466
+
467
+ begin
468
+
469
+ with Canvas do begin
470
+
471
+ // Color色で塗りつぶし
472
+
473
+ Brush.Color:= Color;
474
+
475
+ Brush.Style:= bsSolid;
476
+
477
+ FillRect(Rect(Left, Top, (Left+Width), (Top+Height)));
478
+
479
+
480
+
481
+ if Width > Height then
482
+
483
+ begin
484
+
485
+ x_space:= Width - Height;
486
+
487
+ x1:= Left + (x_space div 2);
488
+
489
+ y1:= Top;
490
+
491
+ x2:= x1 + Height;
492
+
493
+ y2:= y1 + Height;
494
+
495
+ end
496
+
497
+ else
498
+
499
+ begin
500
+
501
+ y_space:= Height - Width;
502
+
503
+ x1:= Left;
504
+
505
+ y1:= Top + (y_space div 2);
506
+
507
+ x2:= x1 + Width;
508
+
509
+ y2:= y1 + Width;
510
+
511
+ end;
512
+
513
+
514
+
515
+ // FSahpeColor色で塗りつぶし
516
+
517
+ Brush.Color:= FShapeColor;
518
+
519
+ Brush.Style:= bsSolid;
520
+
521
+ // 黒色で太さ1で枠線描画
522
+
523
+ Pen.Color:= clBlack;
524
+
525
+ Pen.Style:= psSolid;
526
+
527
+ Pen.Width:= 1;
528
+
529
+ Rectangle(Rect(x1, y1, x2, y2));
530
+
531
+
532
+
533
+ // ためしにやってみたが,フォントサイズが変更しなかった.
534
+
535
+ Font.Assign(Font);
536
+
537
+ // 文字列の描画
538
+
539
+ TextOut(FWidth_C, FHeight_C, FCaption);
540
+
541
+ end;
542
+
543
+ end;
544
+
545
+
546
+
547
+ // FCaption.
548
+
549
+ // Font.Size
550
+
551
+ end;
552
+
553
+
554
+
555
+
556
+
171
557
  //Createメソッド省略
172
558
 
173
- //Paintメソッド省略
174
-
175
559
  //SetShapeメソッド省略
176
560
 
177
561
  //SetShapeColorメソッド省略

2

ソースコードの記載

2019/10/29 14:05

投稿

dem0nmichik0
dem0nmichik0

スコア37

test CHANGED
File without changes
test CHANGED
@@ -22,12 +22,168 @@
22
22
 
23
23
 
24
24
 
25
- ソースコードを載せようとしましたが,文字数が10,000文字以上になり,載せられませんでした.申し訳ありません.
25
+ ###実現方法
26
26
 
27
- ([最新ではあせんが,前回質問した時ソースコード記載されています](https://teratail.com/questions/199005))
27
+ 文字列のサイズを変更する方法ウィンドウメッセージのWM_SETFONTイベントを発生させる必要がるだろうと思っていす.ですが,WM_SETFONTイベント発生させ方分からず困っています.どなたがご教授お願いいたします.
28
28
 
29
29
 
30
30
 
31
- ###実現方法
31
+ ###ソースコード
32
32
 
33
+ 文字数が10,000文字以上になるため,各種メソッド部分をわざと消しています.
34
+
35
+ ```Delphi
36
+
37
+ unit Door;
38
+
39
+ // Delphi
40
+
41
+ interface
42
+
43
+
44
+
45
+ uses
46
+
47
+ Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
48
+
49
+ Vcl.Controls, Vcl.Graphics, Vcl.Forms, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Dialogs;
50
+
51
+
52
+
53
+ type
54
+
55
+ TDoor = class(TCustomControl)
56
+
57
+ private
58
+
59
+ { Private 宣言 }
60
+
61
+ FCaption: UnicodeString;
62
+
63
+ FShape: TShapeType;
64
+
65
+ FShapeColor: TColor;
66
+
67
+ FWidth_C: Integer;
68
+
69
+ FHeight_C: Integer;
70
+
71
+
72
+
73
+ procedure SetShape(Value: TShapeType);
74
+
75
+ procedure SetShapeColor(Value: TColor);
76
+
77
+ procedure SetCaption(Value: UnicodeString);
78
+
79
+ procedure SetWidth_C(Value: Integer);
80
+
81
+ procedure SetHeight_C(Value: Integer);
82
+
83
+ protected
84
+
85
+ { Protected 宣言 }
86
+
87
+ public
88
+
89
+ { Public 宣言 }
90
+
91
+ left: Integer;
92
+
93
+ top: Integer;
94
+
95
+
96
+
97
+ // コンストラクタ(オーバーライド)
98
+
99
+ constructor Create( AOwner: TComponent ); override;
100
+
101
+ procedure Paint; override;
102
+
103
+ published
104
+
105
+ { Published 宣言 }
106
+
107
+ // プロパティにdefaultを付けるとデフォルト値にできる
108
+
109
+ property Shape: TShapeType read FShape write SetShape default stRectangle;
110
+
111
+ property ShapeColor: TColor read FShapeColor write SetShapeColor;
112
+
113
+ property Caption: UnicodeString read FCaption write SetCaption;
114
+
115
+ property Width_C: Integer read FWidth_C write SetWidth_C;
116
+
117
+ property Height_C: Integer read FHeight_C write SetHeight_C;
118
+
119
+ // 継承プロパティ(再宣言するとオブジェクトインスペクタに表示できるようになる)
120
+
121
+ property Anchors;
122
+
123
+ property Color;
124
+
125
+ property Enabled;
126
+
127
+ property Font;
128
+
129
+ property Name;
130
+
131
+ property ParentColor;
132
+
133
+ property Visible;
134
+
135
+ property OnClick;
136
+
137
+ property OnDblClick;
138
+
139
+ end;
140
+
141
+
142
+
143
+ procedure Register;
144
+
145
+
146
+
33
- 文字列のサイズを変更する方法はウィンドウメッセージのWM_SETFONTイベントを発生させる必要があるだろうと思っています.ですが,WM_SETFONTイベントの発生させ方が分からず困っています.どなたがご教授お願いいたします.
147
+ //---------------------------------------------------------------------------
148
+
149
+ implementation
150
+
151
+
152
+
153
+ const
154
+
155
+ DelphiWindows: array [1 .. 1] of PWideChar = ('TAppBuilder');
156
+
157
+
158
+
159
+ procedure Register;
160
+
161
+ begin
162
+
163
+ // 「Samples」パレットにドアを登録
164
+
165
+ RegisterComponents('Samples', [TDoor]);
166
+
167
+ end;
168
+
169
+
170
+
171
+ //Createメソッド省略
172
+
173
+ //Paintメソッド省略
174
+
175
+ //SetShapeメソッド省略
176
+
177
+ //SetShapeColorメソッド省略
178
+
179
+ //SetCaptionメソッド省略
180
+
181
+ //SetWidth_Cメソッド省略
182
+
183
+ //SetHeight_Cメソッド省略
184
+
185
+
186
+
187
+ end.
188
+
189
+ ```

1

実現方法の追加

2019/10/24 15:10

投稿

dem0nmichik0
dem0nmichik0

スコア37

test CHANGED
File without changes
test CHANGED
@@ -6,7 +6,7 @@
6
6
 
7
7
  ###困っていること
8
8
 
9
- CustomControlクラスを継承したクラスを作成し,CustomControlのプロパティであるFontを継承しました.ですが,テストアプリでFontのSizeプロパティを変更しても文字列のサイズが変更せずに困っています.どなたかご教授お願いいたします.
9
+ CustomControlクラスを継承したクラスを作成し,CustomControlのプロパティであるFontを継承しました.ですが,テストアプリでFontのSizeプロパティを変更しても文字列のサイズが変更せずに困っています.
10
10
 
11
11
 
12
12
 
@@ -25,3 +25,9 @@
25
25
  ソースコードを載せようとしましたが,文字数が10,000文字以上になり,載せられませんでした.申し訳ありません.
26
26
 
27
27
  ([最新ではありませんが,前回質問した時のソースコードが記載されています](https://teratail.com/questions/199005))
28
+
29
+
30
+
31
+ ###実現方法
32
+
33
+ 文字列のサイズを変更する方法はウィンドウメッセージのWM_SETFONTイベントを発生させる必要があるだろうと思っています.ですが,WM_SETFONTイベントの発生させ方が分からず困っています.どなたがご教授お願いいたします.