[DCC エラー] E2161 Error: RLINK32: Unsupported 16bit resource in fileエラー
お世話になります。
現在Delphiを勉強中で知り合いからもらったサンプルを見ながら勉強しています。
→知り合いもDelphiはあまり詳しくない為こちらでご質問させて頂きました
Delphi 2006でプロジェクトをコンパイルすると
[DCC エラー] E2161 Error: RLINK32: Unsupported 16bit resource in file
のエラーが発生します。
１．プロジェクトから該当dfmを開かずコンパイルするとコンパイルＯＫ
２．プロジェクトから該当dfmを開いてイメージを表示した状態でコンパイル
するとエラー発生
３．№１でコンパイル後実行し、該当画面を表示させようとすると
”モジュールtest.exeのアドレスXXXXXXXXでアドレスXXXXXXXXに対する書き込み違反がおきました"が表示されます。
ＷＥＢでも色々調べましたが初心者勉強中の為解決することができません
どなたかお力をお貸しください。
該当dfmを以下に貼り付けます（その他必要なものがあればおっしゃってください）
inherited frmAIR130: TfrmAIR130
Left = -4
Top = -4
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = #25903#25173#20104#23450#19968#35239#65288#26126#32048#65289
ClientHeight = 665
ClientWidth = 989
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
ExplicitLeft = -163
ExplicitWidth = 995
ExplicitHeight = 690
PixelsPerInch = 96
TextHeight = 15
object lblINSZ: TLabel [0]
Left = 8
Top = 638
Width = 17
Height = 15
Caption = #31246
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clRed
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = [fsBold]
ParentFont = False
end
object lblHVCG: TLabel [1]
Left = 327
Top = 627
Width = 90
Height = 15
Alignment = taRightJustify
Caption = '12,345,678'
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = [fsBold]
ParentFont = False
end
object lblSumHVCG: TLabel [2]
Left = 326
Top = 645
Width = 90
Height = 15
Alignment = taRightJustify
Caption = '12,345,678'
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = [fsBold]
ParentFont = False
end
object lblSKSZ: TLabel [3]
Left = 433
Top = 627
Width = 81
Height = 15
Alignment = taRightJustify
Caption = '1,234,567'
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = [fsBold]
ParentFont = False
end
object lblSumSKSZ: TLabel [4]
Left = 433
Top = 645
Width = 81
Height = 15
Alignment = taRightJustify
Caption = '1,234,567'
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = [fsBold]
ParentFont = False
end
object Label1: TLabel [5]
Left = 292
Top = 627
Width = 34
Height = 15
Caption = #36984#25246
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clMaroon
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = [fsBold]
ParentFont = False
end
object Label2: TLabel [6]
Left = 292
Top = 645
Width = 34
Height = 15
Caption = #21512#35336
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clMaroon
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = [fsBold]
ParentFont = False
end
object lblHVCG_KOMI: TLabel [7]
Left = 535
Top = 627
Width = 99
Height = 15
Alignment = taRightJustify
Caption = '123,456,789'
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = [fsBold]
ParentFont = False
end
object lblSumHVCG_KOMI: TLabel [8]
Left = 535
Top = 645
Width = 99
Height = 15
Alignment = taRightJustify
Caption = '123,456,789'
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = [fsBold]
ParentFont = False
end
object Label5: TLabel [9]
Left = 419
Top = 635
Width = 16
Height = 15
Caption = #65291
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
ParentFont = False
end
object Label6: TLabel [10]
Left = 516
Top = 637
Width = 16
Height = 15
Caption = #65309
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
ParentFont = False
end
inherited pnlApplicationTitle: TPanel
Caption = #25903#25173#20104#23450#19968#35239#65288#26126#32048#65289
end
object grdFetch: TNStringGrid
Left = 8
Top = 191
Width = 973
Height = 430
ColCount = 21
DefaultColWidth = 100
DefaultRowHeight = 16
DefaultDrawing = False
RowCount = 2
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing, goThumbTracking]
ParentFont = False
TabOrder = 3
OnClick = grdFetchClick
SortOptions = soNon
GridColumns = <
item
Alignment = taLeftJustify
CanEdit = True
Color = clWindow
DataType = dtString
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
FixCellFont.Charset = SHIFTJIS_CHARSET
FixCellFont.Color = clWindowText
FixCellFont.Height = -13
FixCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FixCellFont.Style = []
ImeMode = imDisable
end
item
Alignment = taRightJustify
CanEdit = True
Caption = #8470
Color = clWindow
DataType = dtInteger
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
FixCellFont.Charset = SHIFTJIS_CHARSET
FixCellFont.Color = clBlack
FixCellFont.Height = -13
FixCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FixCellFont.Style = []
ImeMode = imDisable
end
item
Alignment = taLeftJustify
CanEdit = True
Caption = #30003#35531
Color = clWindow
DataType = dtBoolean
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
FixCellFont.Charset = SHIFTJIS_CHARSET
FixCellFont.Color = clBlack
FixCellFont.Height = -13
FixCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FixCellFont.Style = []
ImeMode = imDisable
end
item
Alignment = taLeftJustify
CanEdit = True
Color = clWindow
DataType = dtBoolean
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
FixCellFont.Charset = SHIFTJIS_CHARSET
FixCellFont.Color = clBlack
FixCellFont.Height = -13
FixCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FixCellFont.Style = []
ImeMode = imDisable
end
item
Alignment = taLeftJustify
CanEdit = True
Caption = #30003#35531#32773
Color = clWindow
DataType = dtString
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
FixCellFont.Charset = SHIFTJIS_CHARSET
FixCellFont.Color = clBlack
FixCellFont.Height = -13
FixCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FixCellFont.Style = []
ImeMode = imDisable
end
item
Alignment = taLeftJustify
CanEdit = True
Caption = #25903#25173#20104#23450#26085
Color = clWindow
DataType = dtString
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
FixCellFont.Charset = SHIFTJIS_CHARSET
FixCellFont.Color = clBlack
FixCellFont.Height = -13
FixCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FixCellFont.Style = []
ImeMode = imDisable
end
item
Alignment = taLeftJustify
CanEdit = True
Caption = #35201#26395#26360#8470
Color = clWindow
DataType = dtString
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
FixCellFont.Charset = SHIFTJIS_CHARSET
FixCellFont.Color = clBlack
FixCellFont.Height = -13
FixCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FixCellFont.Style = []
ImeMode = imDisable
end
item
Alignment = taRightJustify
CanEdit = True
Caption = #25903#25173#20104#23450#37329#38989
Color = clWindow
DataType = dtInteger
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
FixCellFont.Charset = SHIFTJIS_CHARSET
FixCellFont.Color = clBlack
FixCellFont.Height = -13
FixCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FixCellFont.Style = []
ImeMode = imDisable
end
item
Alignment = taRightJustify
CanEdit = True
Caption = #28040#36027#31246
Color = clWindow
DataType = dtInteger
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
FixCellFont.Charset = SHIFTJIS_CHARSET
FixCellFont.Color = clBlack
FixCellFont.Height = -13
FixCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FixCellFont.Style = []
ImeMode = imDisable
end
item
Alignment = taRightJustify
CanEdit = True
Caption = #20837#21147#28040#36027#31246
Color = clWindow
DataType = dtInteger
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
FixCellFont.Charset = SHIFTJIS_CHARSET
FixCellFont.Color = clBlack
FixCellFont.Height = -13
FixCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FixCellFont.Style = []
ImeMode = imDisable
end
item
Alignment = taLeftJustify
CanEdit = True
Caption = #24471#24847#20808#21517
Color = clWindow
DataType = dtString
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
FixCellFont.Charset = SHIFTJIS_CHARSET
FixCellFont.Color = clBlack
FixCellFont.Height = -13
FixCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FixCellFont.Style = []
ImeMode = imDisable
end
item
Alignment = taLeftJustify
CanEdit = True
Caption = #26045#24037#26085
Color = clWindow
DataType = dtString
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
FixCellFont.Charset = SHIFTJIS_CHARSET
FixCellFont.Color = clBlack
FixCellFont.Height = -13
FixCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FixCellFont.Style = []
ImeMode = imDisable
end
item
Alignment = taLeftJustify
CanEdit = True
Caption = #29694#22580#21517
Color = clWindow
DataType = dtString
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
FixCellFont.Charset = SHIFTJIS_CHARSET
FixCellFont.Color = clBlack
FixCellFont.Height = -13
FixCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FixCellFont.Style = []
ImeMode = imDisable
end
item
Alignment = taRightJustify
CanEdit = True
Caption = #32047#35336#35531#27714#38989
Color = clWindow
DataType = dtInteger
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
FixCellFont.Charset = SHIFTJIS_CHARSET
FixCellFont.Color = clBlack
FixCellFont.Height = -13
FixCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FixCellFont.Style = []
ImeMode = imDisable
end
item
Alignment = taRightJustify
CanEdit = True
Caption = #32047#35336#20837#37329#38989
Color = clWindow
DataType = dtInteger
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
FixCellFont.Charset = SHIFTJIS_CHARSET
FixCellFont.Color = clBlack
FixCellFont.Height = -13
FixCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FixCellFont.Style = []
ImeMode = imDisable
end
item
Alignment = taRightJustify
CanEdit = True
Caption = #26410#20837#37329#38989
Color = clWindow
DataType = dtInteger
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
FixCellFont.Charset = SHIFTJIS_CHARSET
FixCellFont.Color = clBlack
FixCellFont.Height = -13
FixCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FixCellFont.Style = []
ImeMode = imDisable
end
item
Alignment = taRightJustify
CanEdit = True
Caption = #32047#35336#20181#20837#38989
Color = clWindow
DataType = dtInteger
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
FixCellFont.Charset = SHIFTJIS_CHARSET
FixCellFont.Color = clBlack
FixCellFont.Height = -13
FixCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FixCellFont.Style = []
ImeMode = imDisable
end
item
Alignment = taRightJustify
CanEdit = True
Caption = #32047#35336#25903#25173#38989
Color = clWindow
DataType = dtInteger
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
FixCellFont.Charset = SHIFTJIS_CHARSET
FixCellFont.Color = clBlack
FixCellFont.Height = -13
FixCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FixCellFont.Style = []
ImeMode = imDisable
end
item
Alignment = taRightJustify
CanEdit = True
Caption = #26410#25903#25173#38989
Color = clWindow
DataType = dtInteger
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
FixCellFont.Charset = SHIFTJIS_CHARSET
FixCellFont.Color = clBlack
FixCellFont.Height = -13
FixCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FixCellFont.Style = []
ImeMode = imDisable
end
item
Alignment = taLeftJustify
CanEdit = True
Caption = #29366#24907
Color = clWindow
DataType = dtString
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
FixCellFont.Charset = SHIFTJIS_CHARSET
FixCellFont.Color = clBlack
FixCellFont.Height = -13
FixCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FixCellFont.Style = []
ImeMode = imDisable
end
item
Alignment = taLeftJustify
CanEdit = True
Caption = #20181#20837#20808#21517
Color = clWindow
DataType = dtString
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
FixCellFont.Charset = SHIFTJIS_CHARSET
FixCellFont.Color = clBlack
FixCellFont.Height = -13
FixCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FixCellFont.Style = []
ImeMode = imDisable
end>
RowParams = <>
StripeColor = clWindow
StripeFont.Charset = SHIFTJIS_CHARSET
StripeFont.Color = clWindowText
StripeFont.Height = -13
StripeFont.Name = #65325#65331' '#12468#12471#12483#12463
StripeFont.Style = []
FocusCellColor = clHighlight
FocusCellFont.Charset = SHIFTJIS_CHARSET
FocusCellFont.Color = clHighlightText
FocusCellFont.Height = -13
FocusCellFont.Name = #65325#65331' '#12468#12471#12483#12463
FocusCellFont.Style = []
ColWidths = (
10
25
30
-1
100
75
65
100
80
80
100
75
100
100
100
100
100
100
100
60
100)
RowHeights = (
16
16)
end
object btnReference: TButton
Left = 653
Top = 636
Width = 77
Height = 21
Caption = #29031#20250
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clNavy
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = [fsBold]
ParentFont = False
TabOrder = 7
OnClick = btnReferenceClick
end
object btnOK: TButton
Left = 738
Top = 635
Width = 77
Height = 21
Caption = #30003#35531
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clNavy
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = [fsBold]
ParentFont = False
TabOrder = 8
OnClick = btnOKClick
end
object btnClose: TButton
Left = 909
Top = 635
Width = 77
Height = 21
Caption = #32066#20102
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clNavy
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = [fsBold]
ParentFont = False
TabOrder = 10
OnClick = btnCloseClick
end
object pnlCondition: TPanel
Left = 8
Top = 118
Width = 974
Height = 71
BorderStyle = bsSingle
TabOrder = 2
object lblEGCD: TLabel
Left = 8
Top = 12
Width = 48
Height = 15
Caption = #21942#26989#25152
end
object lblSRCD: TLabel
Left = 8
Top = 40
Width = 80
Height = 15
Caption = #20181#20837#20808#65402#65392#65412#65438
end
object lblSNCD: TLabel
Left = 286
Top = 12
Width = 48
Height = 15
Caption = #30003#35531#32773
end
object lblYBSY: TLabel
Left = 372
Top = 40
Width = 80
Height = 15
Caption = #35201#26395#26360#31278#39006
end
object lblSHYD: TLabel
Left = 530
Top = 12
Width = 80
Height = 15
Caption = #25903#25173#20104#23450#26085
end
object lblProcType: TLabel
Left = 653
Top = 40
Width = 64
Height = 15
Caption = #20966#29702#21306#20998
end
object btnEGCDselect: TButton
Left = 127
Top = 9
Width = 37
Height = 21
Caption = #26908#32034
TabOrder = 2
OnClick = btnEGCDselectClick
end
object btnSNCDselect: TButton
Left = 370
Top = 9
Width = 37
Height = 21
Caption = #26908#32034
TabOrder = 4
OnClick = btnSNCDselectClick
end
object btnSRCDselect: TButton
Left = 169
Top = 37
Width = 37
Height = 21
Caption = #26908#32034
TabOrder = 7
OnClick = btnSRCDselectClick
end
object btnNewDisplay: TButton
Left = 879
Top = 38
Width = 80
Height = 21
Caption = #26368#26032#34920#31034
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clBlack
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
ParentFont = False
TabOrder = 10
OnClick = btnNewDisplayClick
end
object edtEGCD: TNEdit
Left = 92
Top = 8
Width = 33
Height = 23
ImeMode = imClose
MaxLength = 3
TabOrder = 1
OnExit = edtEGCDExit
EnterColor = clWindow
ErrorColor = clRed
end
object edtSNCD: TNEdit
Left = 335
Top = 8
Width = 33
Height = 23
ImeMode = imClose
MaxLength = 3
TabOrder = 3
OnExit = edtSNCDExit
EnterColor = clWindow
ErrorColor = clRed
end
object edtSRCD: TNEdit
Left = 92
Top = 36
Width = 73
Height = 23
ImeMode = imClose
MaxLength = 8
TabOrder = 6
OnExit = edtSRCDExit
EnterColor = clWindow
ErrorColor = clRed
end
object stxEGME: TStaticText
Left = 166
Top = 9
Width = 117
Height = 20
AutoSize = False
BorderStyle = sbsSunken
Caption = ' '
TabOrder = 0
end
object stxSRME: TStaticText
Left = 209
Top = 37
Width = 155
Height = 20
AutoSize = False
BorderStyle = sbsSunken
Caption = ' '
TabOrder = 11
end
object stxSNME: TStaticText
Left = 409
Top = 9
Width = 114
Height = 20
AutoSize = False
BorderStyle = sbsSunken
Caption = ' '
TabOrder = 12
end
object cmbYBSY: TNComboBox
Left = 458
Top = 37
Width = 189
Height = 21
EnterColor = clWindow
ErrorColor = clRed
TargetCol = 1
Columns = <
item
Width = -1
ParentColor = True
ParentFont = True
end
item
Width = 189
ParentColor = True
ParentFont = True
end>
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
ItemHeight = 15
Items.Strings = (
'1,1:'#31038#22806#21697#36009#22770#12539#12522#12540#12473
'2,2:'#36890#24120#37096#26448
'9,9:'#20840#12390)
ParentFont = False
Style = csDropDownList
TabOrder = 8
end
object dtpSHYDTo: TDateTimePicker
Left = 611
Top = 8
Width = 106
Height = 23
Date = 37620.970225104200000000
Time = 37620.970225104200000000
ImeMode = imClose
TabOrder = 5
end
object cmbProcType: TNComboBox
Left = 723
Top = 37
Width = 82
Height = 21
EnterColor = clWindow
ErrorColor = clRed
TargetCol = 1
Columns = <
item
Width = -1
ParentColor = True
ParentFont = True
end
item
Width = 82
ParentColor = True
ParentFont = True
end>
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
ItemHeight = 15
Items.Strings = (
'1,1:'#30003#35531
'2,2:'#25215#35469)
ParentFont = False
Style = csDropDownList
TabOrder = 9
end
end
object btnTax: TButton
Left = 121
Top = 635
Width = 77
Height = 21
Caption = #30906#23450
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clNavy
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = [fsBold]
ParentFont = False
TabOrder = 5
OnClick = btnTaxClick
end
object btnPrint: TButton
Left = 822
Top = 635
Width = 77
Height = 21
Caption = #21360#21047
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clNavy
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = [fsBold]
ParentFont = False
TabOrder = 9
OnClick = btnPrintClick
end
object pnlApproval: TPanel
Left = 8
Top = 60
Width = 974
Height = 56
BorderStyle = bsSingle
TabOrder = 1
object lblSNkeiro: TLabel
Left = 8
Top = 28
Width = 88
Height = 15
Caption = #30003#35531#32076#36335#65406#65391#65412
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
ParentFont = False
end
object lblSNME: TLabel
Left = 120
Top = 8
Width = 48
Height = 15
Caption = #30003#35531#32773
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
ParentFont = False
end
object lblYajirushi0: TLabel
Left = 172
Top = 30
Width = 16
Height = 15
Caption = #8594
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
ParentFont = False
end
object lblYajirushi1: TLabel
Left = 258
Top = 30
Width = 16
Height = 15
Caption = #8594
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
ParentFont = False
end
object lblYajirushi2: TLabel
Left = 347
Top = 30
Width = 16
Height = 15
Caption = #8594
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
ParentFont = False
end
object lblYajirushi3: TLabel
Left = 435
Top = 30
Width = 16
Height = 15
Caption = #8594
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
ParentFont = False
end
object lblYajirushi4: TLabel
Left = 524
Top = 30
Width = 16
Height = 15
Caption = #8594
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
ParentFont = False
end
object lblYajirushi5: TLabel
Left = 612
Top = 30
Width = 16
Height = 15
Caption = #8594
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
ParentFont = False
end
object lblYajirushi6: TLabel
Left = 701
Top = 30
Width = 16
Height = 15
Caption = #8594
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
ParentFont = False
end
object lblYajirushi7: TLabel
Left = 789
Top = 30
Width = 16
Height = 15
Caption = #8594
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
ParentFont = False
end
object lblYajirushi8: TLabel
Left = 878
Top = 30
Width = 15
Height = 15
Caption = #8594
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = #65325#65331' '#65328#12468#12471#12483#12463
Font.Style = []
ParentFont = False
end
object stxSNME1: TStaticText
Left = 100
Top = 28
Width = 68
Height = 18
AutoSize = False
BorderStyle = sbsSunken
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = []
ParentFont = False
TabOrder = 0
end
inline fmApproval0: TfmApproval
Left = 188
Top = 8
Width = 70
Height = 40
TabOrder = 1
TabStop = True
ExplicitLeft = 188
ExplicitTop = 8
end
inline fmApproval1: TfmApproval
Left = 276
Top = 8
Width = 70
Height = 40
TabOrder = 2
TabStop = True
ExplicitLeft = 276
ExplicitTop = 8
end
inline fmApproval2: TfmApproval
Left = 364
Top = 8
Width = 70
Height = 40
TabOrder = 3
TabStop = True
ExplicitLeft = 364
ExplicitTop = 8
end
inline fmApproval3: TfmApproval
Left = 453
Top = 8
Width = 70
Height = 40
TabOrder = 4
TabStop = True
ExplicitLeft = 453
ExplicitTop = 8
end
inline fmApproval4: TfmApproval
Left = 541
Top = 8
Width = 70
Height = 40
TabOrder = 5
TabStop = True
ExplicitLeft = 541
ExplicitTop = 8
end
inline fmApproval5: TfmApproval
Left = 629
Top = 8
Width = 70
Height = 40
TabOrder = 6
TabStop = True
ExplicitLeft = 629
ExplicitTop = 8
end
inline fmApproval6: TfmApproval
Left = 718
Top = 8
Width = 70
Height = 40
TabOrder = 7
TabStop = True
ExplicitLeft = 718
ExplicitTop = 8
end
inline fmApproval7: TfmApproval
Left = 806
Top = 8
Width = 70
Height = 40
TabOrder = 8
TabStop = True
ExplicitLeft = 806
ExplicitTop = 8
end
inline fmApproval8: TfmApproval
Left = 895
Top = 8
Width = 70
Height = 40
TabOrder = 9
TabStop = True
ExplicitLeft = 895
ExplicitTop = 8
end
end
object ednINSZ: TNEditNum
Left = 31
Top = 634
Width = 85
Height = 23
ImeMode = imClose
TabOrder = 4
Text = '0'
Alignment = taRightJustify
EnterColor = clWindow
ErrorColor = clRed
IntegerLength = 9
DecimalLength = 0
InputMinus = False
Comma = False
end
object btnRecalc: TButton
Left = 205
Top = 635
Width = 77
Height = 21
Caption = #20877#35336#31639
Font.Charset = SHIFTJIS_CHARSET
Font.Color = clNavy
Font.Height = -15
Font.Name = #65325#65331' '#12468#12471#12483#12463
Font.Style = [fsBold]
ParentFont = False
TabOrder = 6
OnClick = btnRecalcClick
end
end
TNStringGridなどTN＊というコンポーネントが原因では？
TN＊というコンポーネントはずしてコンパイルしたらエラーが出ないかどうか確認してみてください。
TN＊コンポーネントは昔から使っているコンポーネントかなにかですか？
Atchoumさん
ありがとうございます。
TNStringGridですが、どうもコンポーネントを独自で作っているようです。
ソースをみましても到底理解できないレベルです。
コンポーネントをＵＰしますので、何かお分かりになることがありましたら
お教え頂ければ助かります
unit pppComponents;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Grids, Mask, ComCtrls;
type
{
----------------------------------------------------------
拡張Editコンポーネント : TNEdit
<継承> TEdit
----------------------------------------------------------
【追加プロパティ】
Alignment: TAlignment : 表示位置
taLeftJustify = 左寄せ
taRightJustify = 右寄せ
taCenter = 中央
EnterFocusMove: Boolean : EnterKeyでフォーカス移動
ColorChange: Boolean : カラー変更フラグ
※True の時にカラー変更処理を行う
NormalColor: TColor : 通常のカラー
※このプロパティを変更するとColorプロパティも
同じ色に変更されます。
EnterColor: TColor : フォーカス時のカラー
ErrorColor: TColor : エラー時のカラー
ErrorFlg: Boolean : エラー有無フラグ
【追加メソッド】
無し
----------------------------------------------------------
}
TNEdit = class(TEdit)
private
{ Private 宣言 }
// プロパティ
FAlignment : TAlignment; // 表示位置
FEnterFocusMove: Boolean; // EnterKeyでフォーカス移動
FColorChange : Boolean; // フォーカス時にカラーを変更
FNormalColor : TColor; // 通常のカラー
FEnterColor : TColor; // フォーカス時のカラー
FErrorColor : TColor; // エラー時のカラー
FErrorFlg : Boolean; // エラーフラグ
// プロパティ操作
procedure SetAlignment(AValue: TAlignment);
procedure SetEnterFocusMove(AValue: Boolean);
procedure SetColorChange(AValue: Boolean);
procedure SetErrorFlg(AValue: Boolean);
procedure SetNormalColor(AValue: TColor);
procedure SetEnterColor(AValue: TColor);
procedure SetErrorColor(AValue: TColor);
protected
{ Protected 宣言 }
// オーバーライド
procedure CreateParams(var Params: TCreateParams); override;
procedure DoEnter; override;
procedure DoExit; override;
procedure KeyPress(var Key:Char); override;
public
{ Public 宣言 }
constructor Create(AOwner: TComponent); override;
// 実行時プロパティ
property Color;
published
{ Published 宣言 }
// 設計時プロパティ
property Alignment : TAlignment read FAlignment write SetAlignment default taLeftJustify;
property NormalColor : TColor read FNormalColor write SetNormalColor;
property EnterColor : TColor read FEnterColor write SetEnterColor;
property ErrorColor : TColor read FErrorColor write SetErrorColor;
property EnterFocusMove: Boolean read FEnterFocusMove write SetEnterFocusMove default False;
property ColorChange : Boolean read FColorChange write SetColorChange default False;
property ErrorFlg : Boolean read FErrorFlg write SetErrorFlg default False;
end;
{
----------------------------------------------------------
拡張Editコンポーネント(数値用) : TNEditNum
<継承> TNEdit
----------------------------------------------------------
【追加プロパティ】
IntValue : Integer : Integer型の入力値
FloatValue : Double : Double型の入力値
IntegerLength: Integer : 整数部の桁数
DecimalLength: Integer : 少数部の桁数
DecimalLength > 0 の時、ドット入力可
InputMinus : Boolean : マイナス入力の許可
Comma : Boolean : ３桁毎のカンマ区切り
【追加メソッド】
無し
【追加仕様】
数字のみ入力可
----------------------------------------------------------
}
TNEditNum = class(TNEdit)
private
{ Private 宣言 }
// プロパティ
FIntValue : Integer; // Integer型のText(変換できない場合は'0')
FFloatValue : Double; // Double型のText(変換できない場合は'0')
FIntegerLength: Integer; // 整数部の桁数
FDecimalLength: Integer; // 小数部の桁数
FInputMinus : Boolean; // マイナス入力の許可
FComma : Boolean; // ３桁毎のカンマ区切り
// プロパティ操作
procedure SetIntValue(AValue: Integer);
procedure SetFloatValue(AValue: Double);
procedure SetIntegerLength(AValue: Integer);
procedure SetDecimalLength(AValue: Integer);
procedure SetInputMinus(AValue: Boolean);
procedure SetComma(AValue: Boolean);
function GetIntValue: Integer;
function GetFloatValue: Double;
// メソッド
procedure AddChar(var Key: Char );
procedure AddDot(var Key: Char );
procedure AddMinus(var Key: Char );
procedure ChkText;
function EditText: String;
function UnEditText: String;
protected
{ Protected 宣言 }
// オーバーライド
procedure KeyPress(var Key:Char); override;
procedure DoEnter ; override;
procedure DoExit ; override;
public
{ Public 宣言 }
constructor Create(AOwner: TComponent); override;
// 実行時プロパティ
property IntValue : Integer read GetIntValue write SetIntValue;
property FloatValue: Double read GetFloatValue write SetFloatValue;
published
{ Published 宣言 }
// 設計時プロパティ
property IntegerLength: Integer read FIntegerLength write SetIntegerLength;
property DecimalLength: Integer read FDecimalLength write SetDecimalLength;
property InputMinus : Boolean read FInputMinus write SetInputMinus;
property Comma : Boolean read FComma write SetComma;
end;
{
----------------------------------------------------------
拡張ComboBoxコンポーネント : TNComboBox
<継承> TCustomComboBox
----------------------------------------------------------
【追加プロパティ】
BoundaryLine : TBoundaryLine : 複数列時：境界線
Columns : TCBColumns : 各列の内容を保持する
TargetCol : Byte : ComboBox に表示する列
Indent : Integer : インデント
EnterFocusMove: Boolean : EnterKeyでフォーカス移動
ColorChange : Boolean : フォーカス時にカラーを変更
NormalColor : TColor : 通常のカラー
EnterColor : TColor : フォーカス時のカラー
ErrorColor : TColor : エラー時のカラー
ErrorOn : Boolean : エラーカラーへ
InputSupport : Boolean : 入力支援ON/OFF
SelectedText : string : 選択された項目を取得
取得されるのは TargetCol で指定された列の項目
【追加メソッド】
function ColIndexOf(const col: Integer; const s: string): Integer;
col で指定した列の文字列 s の最初の位置を取得する
function GetColText(col: Integer): string;
ComboBox で選択された項目から col で指定した列の
テキストを取得する
----------------------------------------------------------
}
// ComboBox で使用するクラスを仮宣言
TCBColumn = class;
TCBColumns = class;
TBoundaryLine = class;
TNComboBox = class(TCustomComboBox)
private
FEditDrawing : Boolean;
FItems : TStringList;
// プロパティ
FBoundaryLine : TBoundaryLine; // 複数列時：境界線
FColumns : TCBColumns; // 各列
FTargetCol : Byte; // 表示列
FIndent : Integer; // インデント
FEnterFocusMove: Boolean; // EnterKeyでフォーカス移動
FColorChange : Boolean; // フォーカス時にカラーを変更
FNormalColor : TColor; // 通常のカラー
FEnterColor : TColor; // フォーカス時のカラー
FErrorColor : TColor; // エラー時のカラー
FErrorOn : Boolean; // エラーカラーへ
FInputSupport : Boolean; // 入力支援ON/OFF
function GetColumnText(idx, col: Integer): string;
// プロパティ操作
procedure SetEnterFocusMove(AValue: Boolean);
procedure SetColorChange(AValue: Boolean);
procedure SetErrorOn(AValue: Boolean);
procedure SetNormalColor(AValue: TColor);
procedure SetEnterColor(AValue: TColor);
procedure SetErrorColor(AValue: TColor);
procedure SetInputSupport(AValue: Boolean);
procedure SetBoundaryLine(AValue: TBoundaryLine);
procedure SetColumns(columns: TCBColumns);
function GetSelectedText: string;
// メッセージ
procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure CBGetLBText(var Message: TMessage); message CB_GETLBTEXT;
procedure CBAddString(var Message: TMessage); message CB_ADDSTRING;
procedure CBInsertString(var Message: TMessage); message CB_INSERTSTRING;
procedure CBDeleteString(var Message: TMessage); message CB_DELETESTRING;
procedure CBResetContent(var Message: TMessage); message CB_RESETCONTENT;
procedure CBGetItemHeight(var Message: TMessage); message CB_GETITEMHEIGHT;
protected
// オーバーライド
procedure DoEnter; override;
procedure DoExit; override;
procedure KeyPress(var Key:Char); override;
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
procedure CreateParams(var Params: TCreateParams); override;
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
procedure DropDown; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetColText(col: Integer): string;
function ColIndexOf(const col: Integer; const s: string): Integer;
property Color;
property SelectedText : string read GetSelectedText;
published
// 設計時プロパティ
property NormalColor : TColor read FNormalColor write SetNormalColor;
property EnterColor : TColor read FEnterColor write SetEnterColor;
property ErrorColor : TColor read FErrorColor write SetErrorColor;
property EnterFocusMove: Boolean read FEnterFocusMove write SetEnterFocusMove default False;
property ColorChange : Boolean read FColorChange write SetColorChange default False;
property ErrorOn : Boolean read FErrorOn write SetErrorOn default False;
property InputSupport : Boolean read FInputSupport write SetInputSupport default False;
property BoundaryLine : TBoundaryLine read FBoundaryLine write SetBoundaryLine;
property TargetCol : Byte read FTargetCol write FTargetCol default 0;
property Columns : TCBColumns read FColumns write SetColumns;
property Indent : Integer read FIndent write FIndent default 2;
property Ctl3D;
property DragMode;
property DragCursor;
property DropDownCount;
property Enabled;
property Font;
property ItemHeight;
property Items;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Style;
property TabOrder;
property TabStop;
property Text;
property Visible;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
property OnDropDown;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
property OnStartDock;
property OnStartDrag;
end;
{ TBoundaryLine の宣言部 }
TBoundaryLine = class(TPersistent)
private
// プロパティ
FDrawing: Boolean;
FColor : TColor;
// プロパティ操作
procedure SetColor(col: TColor);
procedure SetDrawing(AValue: Boolean);
protected
constructor Create;
public
procedure Assign(Source: TPersistent); override;
published
// 設計時プロパティ
property Drawing: Boolean read FDrawing write SetDrawing Default True;
property Color: TColor read FColor write SetColor Default clBlack;
end;
{ TCBColumn の宣言部 }
TCBColumn = class(TCollectionItem)
private
// プロパティ
FWidth : Integer;
FColor : TColor;
FAlignment : TAlignment;
FFont : TFont;
FParentColor: Boolean;
FParentFont : Boolean;
procedure ParentColorChanged;
procedure ParentFontChanged;
procedure FontChanged(Sender: TObject);
// プロパティ操作
function IsStoredColor: Boolean;
function IsStoredFont: Boolean;
procedure SetColor(AValue: TColor);
procedure SetFont(AValue: TFont);
procedure SetParentColor(AValue: Boolean);
procedure SetParentFont(AValue: Boolean);
protected
procedure DrawColumn(Sender: TNComboBox; aRect: TRect; text: string; isSelected: Boolean);
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
published
// 設計時プロパティ
property Width: Integer read FWidth write FWidth;
property Color: TColor read FColor write SetColor stored IsStoredColor;
property Alignment: TAlignment read FAlignment write FAlignment default taLeftJustify;
property Font: TFont read FFont write SetFont stored IsStoredFont;
property ParentColor: Boolean read FParentColor write SetParentColor;
property ParentFont: Boolean read FParentFont write SetParentFont;
end;
{ TCBColumns の宣言部 }
TCBColumns = class(TCollection)
private
FOwner: TNComboBox;
procedure ColorChanged;
procedure FontChanged;
function GetItem(idx: Integer): TCBColumn;
// プロパティ操作
procedure SetItem(idx: Integer; item: TCBColumn);
protected
function GetOwner: TPersistent; override;
public
constructor Create(AOwner: TNComboBox);
property Items[idx: Integer]: TCBColumn read GetItem write SetItem; default;
end;
{
----------------------------------------------------------
拡張StringGridコンポーネント : TNStringGrid
<継承> TStringGrid
----------------------------------------------------------
【追加プロパティ】
SortOptions : TSortOptions
Spacing : Integer
GridColumns : TGridColumns
RowParams : TRowParams
GridStriped : Boolean
StripeColor : TColor
StripeFont : TFont
CellPadding : Integer
Layout : TTextLayout
FixedAlignment: TAlignment
FocusDraw : Boolean
FocusCellParam: Boolean
FocusCellColor: TColor
FocusCellFont : TFont
【追加メソッド】
----------------------------------------------------------
}
TSortOptions = (soBoth, soUpOnly, soDownOnly, soNon);
TSortState = (bsUp, bsDown, bbNon);
TSortUpKind = (bkUp, bkUpCustom);
TSortDownKind = (bkDown, bkDownCustom); // 種類
TInputDataType = (dtString, dtInteger);
TValidChars = set of char;
TNInplaceEdit = class;
TGridColumn = class;
TGridColumns = class;
TRowParam = class;
TRowParams = class;
TNStringGrid = class(TStringGrid)
private
FSetCol : Longint;
FGetFixS : String;
FSortFlg : Boolean;
FSortOptions : TSortOptions;
FSortUp : Boolean;
// FSortUpGlyps : TBitmap;
// FSortDownGlyps: TBitmap;
// FGlyph : Pointer;
FSpacing : Integer;
FMouseDown : Boolean;
FCursorSplit : Boolean;
FGridColumns : TGridColumns;
FRowParams : TRowParams;
FGridStriped : Boolean;
FStripeColor : TColor;
FStripeFont : TFont;
FCellPadding : Integer;
FLayout : TTextLayout;
FFixedAlignment: TAlignment;
FFocusDraw : boolean; // セルフォーカス表示有無
FFocusCellParam: boolean; // セルフォーカス表示有無
FFocusCellColor: TColor;
FFocusCellFont : TFont;
FSaveBrush : TBrush; // 標準のキャンバス情報の保持
FSavePen : TPen;
FSaveFont : TFont;
FNowSortedCol : Integer; // 現在のソートキーセル
procedure BubbleSortGrid(MotoGrid : TStringGrid; StartIdx, EndIdx, SortIdx : Integer);
procedure QsortGrid(MotoGrid : TStringGrid; StartIdx, EndIdx, SortIdx : Integer);
procedure QuickSortGrid(MotoGrid : TStringGrid; StartIdx, EndIdx, SortIdx : Integer);
procedure SetSpacing(Value: Integer);
procedure SetPropertyLayout(AValue: TTextLayout);
procedure SetGridStriped(AValue: Boolean);
procedure SetGridColumns(AValue: TGridColumns);
procedure SetStripeColor(AValue: TColor);
procedure SetStripeFont(AValue: TFont);
procedure SetCellPadding(AValue: Integer);
procedure SetFixedAlignment(AValue: TAlignment);
procedure SetFocusDraw(AValue: Boolean);
procedure SetFocusCellParam(AValue: Boolean);
procedure SetFocusCellColor(AValue: TColor);
procedure SetFocusCellFont(AValue: TFont);
function GetBrushColor(ACol, ARow: integer): TColor;
function GetDisplayText(AText, ADisplayMask: string): string;
procedure DrawFixedFrame(ARect: TRect);
procedure DrawFixedFramePushed(ARect: TRect);
protected
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUP(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
AState: TGridDrawState); override;
procedure KeyDown(var Key: Word; Shift:TShiftState); override;
procedure KeyPress(var Key:Char); override;
procedure SetEditText(ACol, ARow: Longint; const AValue: string); override;
procedure SizeChanged(OldColCount, OldRowCount: Longint); override;
function CanEditAcceptKey(Key: Char): Boolean; override;
function CanEditModify: Boolean; override;
function CreateEditor: TInplaceEdit; override;
function GetEditText(ACol, ARow: Longint): string; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure UpdateScrollBar(Target: TScrollStyle);
procedure GridToCsv(AFileName: String); overload;
procedure GridToCsv; overload;
procedure SelectionCellsToCsv(AFileName: String); overload;
procedure SelectionCellsToCsv; overload;
procedure SetColWidth(ACol: Integer);
procedure SetAllColWidth;
published
property SortOptions: TSortOptions
read FSortOptions write FSortOptions;
property Spacing: Integer
read FSpacing write SetSpacing default 10;
property GridColumns: TGridColumns
read FGridColumns write SetGridColumns;
property RowParams: TRowParams
read FRowParams write FRowParams;
property GridStriped: Boolean
read FGridStriped write SetGridStriped default False;
property StripeColor: TColor
read FStripeColor write SetStripeColor;
property StripeFont : TFont
read FStripeFont write SetStripeFont;
property CellPadding : Integer
read FCellPadding write SetCellPadding default 2;
property Layout: TTextLayout
read FLayout write SetPropertyLayout default tlTop;
property FixedAlignment: TAlignment
read FFixedAlignment write SetFixedAlignment default taLeftJustify;
property FocusDraw: Boolean
read FFocusDraw write SetFocusDraw default True;
property FocusCellParam: Boolean
read FFocusCellParam write SetFocusCellParam default False;
property FocusCellColor: TColor
read FFocusCellColor write SetFocusCellColor;
property FocusCellFont : TFont
read FFocusCellFont write SetFocusCellFont;
end;
{ TNInplaceEdit の宣言部 }
TNInplaceEdit = class(TInplaceEdit)
private
FMultiLine: boolean;
FWordwrap: boolean;
FImeMode : TImeMode;
procedure SetWordWrap(AValue: boolean);
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key:Char); override;
published
property ImeMode: TImeMode read FImeMode write FImeMode default imHira;
property MultiLine: boolean read FMultiLine write FMultiLine;
property WordWrap: boolean read FWordWrap write SetWordWrap;
end;
{ TGridColumn の宣言部 }
TGridColumn = class(TCollectionItem)
private
FAlignment : TAlignment;
FCanEdit : boolean;
FColor : TColor;
FColumnName : string;
FDataType : TInputDataType;
FDisplayMask: string;
FFixCellFont: TFont;
FFont : TFont;
FImeMode : TImeMode;
FMultiLine : boolean;
FWordwrap : boolean;
procedure SetColor(AValue: TColor);
procedure SetFixCellFont(AValue: TFont);
procedure SetFont(AValue: TFont);
procedure SetWordwrap(AValue: boolean);
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
procedure Assign(AValue: TPersistent); override;
procedure SetAlignment(AValue: TAlignment);
procedure SetColumnName(AValue: string);
published
property Alignment: TAlignment read FAlignment write SetAlignment;
property CanEdit: boolean read FCanEdit write FCanEdit;
property Caption: string read FColumnName write SetColumnName;
property Color: TColor read FColor write SetColor;
property DataType: TInputDataType read FDataType write FDataType;
property DisplayMask: string read FDisplayMask write FDisplayMask;
property Font: TFont read FFont write SetFont;
property FixCellFont: TFont read FFixCellFont write SetFixCellFont;
property ImeMode: TImeMode read FImeMode write FImeMode default imHira;
property Wordwrap: boolean read FWordwrap write SetWordwrap default false;
property MultiLine: boolean read FMultiLine write FMultiLine default false;
end;
{ TGridColums の宣言部 }
TGridColumns = class(TCollection)
private
FCanSizing: boolean;
FOwner: TNStringGrid;
procedure SetItems(Index: Integer; AValue: TGridColumn);
function GetItems(Index: Integer): TGridColumn;
protected
procedure Update(Item: TCollectionItem); override;
function GetOwner: TPersistent; override;
public
constructor Create(AOwner: TNStringGrid);
function Add: TGridColumn;
property Items[Index: Integer]: TGridColumn
read GetItems write SetItems; default;
end;
{ TRowParam の宣言部 }
TRowParam = class(TCollectionItem)
private
FColor : TColor;
FName : String;
FFont : TFont;
FRow : Integer;
FRowMax : Integer;
FEnabled: Boolean;
FTag : Integer;
procedure SetColor(AValue: TColor);
procedure SetFont(AValue: TFont);
procedure SetPropertyRow(ARow: integer);
procedure SetPropertyRowMax(ARowMax: integer);
procedure SetEnabled(AValue: Boolean);
public
constructor Create(ACollection: TCollection); override;
destructor Destroy; override;
procedure Assign(AValue: TPersistent); override;
published
property Color: TColor
read FColor write SetColor;
property Font: TFont
read FFont write SetFont;
property Name: String
read FName write FName;
property Row: integer
read FRow write SetPropertyRow;
property RowMax: integer
read FRowMax write SetPropertyRowMax;
property Enabled: Boolean
read FEnabled write SetEnabled default False;
property Tag: integer
read FTag write FTag;
end;
{ TRowParams の宣言部 }
TRowParams = class(TCollection)
private
FOwner: TNStringGrid;
procedure SetItems(AIndex: Integer; AValue: TRowParam);
function GetItems(AIndex: Integer): TRowParam;
protected
function GetOwner: TPersistent; override;
procedure Update(AItem: TCollectionItem); override;
public
constructor Create(AOwner: TNStringGrid);
function Add: TRowParam;
function ItemByName(AName: string): TRowParam;
property Items[Index: Integer]: TRowParam
read GetItems write SetItems; default;
end;
{
----------------------------------------------------------
拡張RichEditコンポーネント : TNRichEdit
<継承> TEdit
----------------------------------------------------------
【追加プロパティ】
Emphansis : Boolean : 構文強調する/しない
PtnFileName: Stirng : 構文強調文字列定義ファイル名
【追加メソッド】
無し
----------------------------------------------------------
}
TNRichEdit = class(TRichEdit)
private
{ Private 宣言 }
// プロパティ
FEmphansis : Boolean; // 構文強調する
FPtnFileName : String; // 構文強調定義ファイル名
FEmphansisForeColor: TColor;
FEmphansisStyle : TFontStyles;
procedure EmphansisSyntax;
protected
{ Protected 宣言 }
procedure Change; override;
public
{ Public 宣言 }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published 宣言 }
// 設計時プロパティ
property Emphansis: Boolean
read FEmphansis write FEmphansis;
property PtnFileName: String
read FPtnFileName write FPtnFileName;
property EmphansisForeColor: TColor
read FEmphansisForeColor write FEmphansisForeColor;
property EmphansisStyle: TFontStyles
read FEmphansisStyle write FEmphansisStyle;
end;
TSelectPos = Record
spStart : Integer;
spLength: Integer;
end;
procedure Register;
implementation
// TNStringGrid で DataType = dtInteger の時に入力可能な文字一覧
const VALID_CHARS: TValidChars = [#0..#32, '-', '+', '.', '0'..'9'];
//var
// SortResNamesUp : array[TSortUpKind] of PChar = ('BBUP', nil);
// SortResNamesDown: array[TSortDownKind] of PChar = ('BBDOWN', nil);
procedure Register;
begin
RegisterComponents('NBS', [TNEdit, TNEditNum, TNRichEdit, TNComboBox, TNStringGrid]);
end;
{ ------------------------------------------------------- }
{ TNEdit の実装部 }
{ ------------------------------------------------------- }
constructor TNEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FNormalColor := Color;
FEnterColor := Color;
FErrorColor := clRed;
end;
procedure TNEdit.DoEnter;
begin
if (not FErrorFlg) and (FColorChange) then
Color := FEnterColor;
inherited DoEnter;
end;
procedure TNEdit.DoExit;
begin
FErrorFlg := False;
if (FColorChange) then
Color := FNormalColor;
inherited DoExit;
end;
procedure TNEdit.KeyPress(var Key:Char);
var
ParentForm: TCustomForm;
begin
Case Key of
#13: // Enter
begin
if FEnterFocusMove then
begin
ParentForm := GetParentForm( Self );
// TFormが見つからない
if ParentForm = nil then Exit;
// 次コントロールへ移動
PostMessage( ParentForm.Handle, WM_NEXTDLGCTL, 0, 0 );
// キー無効
key := #0;
end
else
begin
// beep; // ビープ音を鳴らす。
end;
// key := #0; // キー無効
end;
end;
inherited KeyPress(Key);
end;
procedure TNEdit.CreateParams(var Params: TCreateParams);
const
Alignments: array [TAlignment] of Longword = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style or Alignments[FAlignment];
end;
end;
procedure TNEdit.SetNormalColor(AValue: TColor);
begin
if FNormalColor <> AValue then
begin
FNormalColor := AValue;
Color := FNormalColor;
Invalidate;
end;
end;
procedure TNEdit.SetEnterColor(AValue: TColor);
begin
if FEnterColor <> AValue then
begin
FEnterColor := AValue;
Invalidate;
end;
end;
procedure TNEdit.SetErrorColor(AValue: TColor);
begin
if FErrorColor <> AValue then
begin
FErrorColor := AValue;
Invalidate;
end;
end;
procedure TNEdit.SetAlignment(AValue: TAlignment);
begin
if FAlignment <> AValue then
begin
FAlignment := AValue;
RecreateWnd;
end;
end;
procedure TNEdit.SetEnterFocusMove(AValue: Boolean);
begin
if FEnterFocusMove <> AValue then
begin
FEnterFocusMove := AValue;
end;
end;
procedure TNEdit.SetColorChange(AValue: Boolean);
begin
if FColorChange <> AValue then
begin
FColorChange := AValue;
end;
end;
procedure TNEdit.SetErrorFlg(AValue: Boolean);
begin
if FErrorFlg <> AValue then
begin
FErrorFlg := AValue;
if FErrorFlg then
begin
Color := FErrorColor;
end
else
begin
Color := FNormalColor;
end;
end;
end;
{ ------------------------------------------------------- }
{ TNEditNum の実装部 }
{ ------------------------------------------------------- }
constructor TNEditNum.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIntegerLength := 9;
FDecimalLength := 0;
FInputMinus := False;
FComma := False;
Alignment := taRightJustify;
Text := '0';
end;
procedure TNEditNum.DoEnter;
begin
// テキスト非編集
Text := UnEditText;
// 全選択?
if AutoSelect then
SelectAll;
inherited DoEnter;
end;
procedure TNEditNum.DoExit;
begin
// テキストチェック
ChkText;
// テキスト編集
Text := EditText;
inherited DoExit;
end;
procedure TNEditNum.KeyPress(var Key:Char);
const
ValidChar = [Char(VK_DELETE), Char(VK_BACK), Char(VK_RETURN), Char(VK_ESCAPE)];
begin
// 数値のみ入力可能
if GetKeyState(VK_CONTROL) < 0 then Exit;
// '.' 入力時
case Key of
'.':
begin
AddDot( Key );
end;
'-':
begin
AddMinus( Key );
end;
'0'..'9':
begin
AddChar( Key );
end;
else
begin
// キーが有効な文字群に含まれていなかった場合
if not (Key in ValidChar) then
begin
key := #0; // キー無効
beep; // ビープ音を鳴らす。
end;
end;
end; // case
inherited KeyPress(Key);
end;
procedure TNEditNum.SetIntValue(AValue: Integer);
begin
if IntValue <> AValue then
begin
FIntValue := AValue;
Text := IntToStr(FIntValue);
// テキストチェック
ChkText;
// テキスト編集
Text := EditText;
end;
end;
procedure TNEditNum.SetFloatValue(AValue: Double);
begin
if FloatValue <> AValue then
begin
FFloatValue := AValue;
Text := FloatToStr(FFloatValue);
// テキストチェック
ChkText;
// テキスト編集
Text := EditText;
end;
end;
procedure TNEditNum.SetDecimalLength(AValue: Integer);
begin
if FDecimalLength <> AValue then
begin
FDecimalLength := AValue;
end;
end;
procedure TNEditNum.SetIntegerLength(AValue: Integer);
begin
if FIntegerLength <> AValue then
begin
FIntegerLength := AValue;
end;
end;
procedure TNEditNum.SetInputMinus(AValue: Boolean);
begin
if FInputMinus <> AValue then
begin
FInputMinus := AValue;
end;
end;
procedure TNEditNum.SetComma(AValue: Boolean);
begin
if FComma <> AValue then
begin
FComma := AValue;
end;
end;
function TNEditNum.GetIntValue: Integer;
var
iDotPos : Integer;
sTempText: String;
begin
sTempText := UnEditText;
iDotPos := AnsiPos('.', sTempText);
if (iDotPos <> 0) then
Delete(sTempText, iDotPos, Length(sTempText) - (iDotPos - 1));
FIntValue := StrToIntDef(sTempText, 0);
Result := FIntValue;
end;
function TNEditNum.GetFloatValue: Double;
begin
try
FFloatValue := StrToFloat(UnEditText);
except
FFloatValue := 0;
end;
Result := FFloatValue;
end;
// 数字 ------------------------------------------------------------------------
procedure TNEditNum.AddChar(var Key: Char);
var
iDotPos, iLen: Integer;
begin
// テキストが選択されている
if SelLength > 0 then
begin
exit;
end;
// チェック
iDotPos := AnsiPos('.', Text);
if (iDotPos <= SelStart) and (iDotPos <> 0) then
begin
// 小数部桁数チェック
if (FDecimalLength <= (Length(Text) - iDotPos)) then
begin
Beep;
Key := #0;
Exit; // 小数入力不可
end;
end
else
begin
// 整数部桁数チェック
// 整数部桁数算出
if iDotPos <> 0 then
iLen := iDotPos - 1
else
iLen := Length(Text);
if AnsiPos('-', Text) <> 0 then
Dec(iLen);
if FIntegerLength <= iLen then
begin
Beep;
Key := #0;
Exit; // 小数入力不可
end;
end;
end;
// '.' -------------------------------------------------------------------------
procedure TNEditNum.AddDot(var Key: Char);
begin
// 小数部桁数＝０
if FDecimalLength = 0 then
begin
Beep;
Key := #0;
Exit; // 小数入力不可
end;
// 全選択時 --> ブランクセット
if SelLength = Length(Text) then
begin
Text := '0';
// キャレット移動
SelStart := Length(Text);
Exit;
end;
// 既に'.'が入力されている
if AnsiPos('.', Text) <> 0 then
begin
Beep;
Key := #0;
Exit; // 小数入力済み
end;
// 何も入力されていない
if (Length(Text) = 0) or (SelLength = Length(Text)) then
begin
Text := '0';
// キャレット移動
SelStart := Length(Text);
end;
end;
// マイナス --------------------------------------------------------------------
procedure TNEditNum.AddMinus(var Key: Char);
var
sTempText: String;
iCaretPos: Integer;
begin
// マイナス許可？
if Not FInputMinus then
begin
Beep;
Key := #0;
Exit;
end;
// テキストが選択されている
if SelLength > 0 then
begin
exit;
end;
// キャレット位置保存
iCaretPos := SelStart;
// 既に'-'が入力されている
if AnsiPos('-', Text) <> 0 then
begin
sTempText := Text;
Delete(sTempText, 1, 1);
Text := sTempText;
Key := #0;
Dec(iCaretPos);
end
else
// '-'未入力
begin
Text := '-' + Text;
Key := #0;
Inc(iCaretPos);
end;
// キャレット移動
SelStart := iCaretPos;
end;
// テキストチェック ------------------------------------------------------------
procedure TNEditNum.ChkText;
var
i, iLen, iLen2: Integer;
sTemp,sTemp2 : String;
chrTemp : Char;
blDot : Boolean;
begin
iLen := Length(Text);
// ブランクチェック
if iLen = 0 then
begin
Text := '0';
exit;
end;
// 入力チェック
sTemp := '';
sTemp2 := Text;
blDot := False;
for i := 1 to iLen do
begin
chrTemp := sTemp2[i];
case chrTemp of
'0'..'9':
begin
iLen2 := Length(sTemp);
if AnsiPos('-', sTemp) <> 0 then
Dec(iLen2);
if blDot then
begin
iLen2 := iLen2 - AnsiPos('.', sTemp);
if FDecimalLength > iLen2 then
sTemp := sTemp + chrTemp;
end
else
if FIntegerLength > iLen2 then
sTemp := sTemp + chrTemp;
end;
'-':
if (i = 1) and (FInputMinus) then
sTemp := sTemp + chrTemp;
'.':
if not blDot then
begin
sTemp := sTemp + chrTemp;
blDot := True;
end;
end; // case
end; // for
Text := sTemp;
// '.' チェック
if (AnsiPos('.', Text) = iLen) then
begin
sTemp := Text;
Delete(sTemp, iLen, 1);
Text := sTemp;
end;
// '-' チェック
if (AnsiPos('-', Text) <> 0) then
case iLen of
1: Text := '0';
2: if Text = '-0' then Text := '0';
end;
end;
// テキスト編集 ----------------------------------------------------------------
function TNEditNum.EditText: String;
var
iDotPos : Integer;
sIntegerText: String;
sDecimalText: String;
begin
// 初期処理
Result := Text;
// カンマ編集有り
if FComma then
begin
iDotPos := AnsiPos('.', Text);
if (iDotPos <> 0) then
begin
sIntegerText := Copy(Text, 1, iDotPos - 1);
sDecimalText := Copy(Text, iDotPos, Length(Text) - (iDotPos - 1));
end
else
begin
sIntegerText := Text;
sDecimalText := '';
end;
Result := FormatFloat('#,##0', StrToFloat(sIntegerText)) + sDecimalText;
end;
end;
// テキスト編集解除 ------------------------------------------------------------
function TNEditNum.UnEditText: String;
var
sTemp: String;
begin
// 初期処理
Result := Text;
sTemp := Text;
// カンマ編集有り
if FComma then
begin
Result := StringReplace(sTemp, ',', '', [rfReplaceAll]);
end;
end;
{ ------------------------------------------------------- }
{ TNComboBox の実装部 }
{ ------------------------------------------------------- }
procedure TNComboBox.CBAddString(var Message: TMessage);
var
strs: TStringList;
str : string;
begin
strs := TStringList.Create;
str := '';
try
try
strs.CommaText := PChar(Message.lParam);
if FTargetCol < strs.Count then str := strs[FTargetCol];
finally
strs.Free;
end;
finally
FItems.Add(PChar(Message.lParam));
Message.lParam := LongInt(PChar(str));
inherited;
end;
end;
procedure TNComboBox.CBDeleteString(var Message: TMessage);
begin
FItems.Delete(Message.wParam);
inherited;
end;
procedure TNComboBox.CBGetItemHeight(var Message: TMessage);
var
item: TMeasureItemStruct;
begin
inherited;
Perform(CN_MEASUREITEM, 0, LongInt(@item));
Message.Result := item.itemHeight;
end;
procedure TNComboBox.CBGetLBText(var Message: TMessage);
begin
inherited;
if Message.Result <> CB_ERR then
begin
Message.Result := Length(FItems[Message.wParam]);
StrPLCopy(PChar(Message.lParam), FItems[Message.wParam], 4096);
end;
end;
procedure TNComboBox.CBInsertString(var Message: TMessage);
var
strs: TStringList;
str : string;
begin
strs := TStringList.Create;
str := '';
try
try
strs.CommaText := PChar(Message.lParam);
if FTargetCol < strs.Count then str := strs.Strings[FTargetCol];
finally
strs.Free;
end;
finally
FItems.Insert(Message.wParam, PChar(Message.lParam));
Message.lParam := LongInt(PChar(str));
inherited;
end;
end;
procedure TNComboBox.CBResetContent(var Message: TMessage);
begin
FItems.Clear;
inherited;
end;
procedure TNComboBox.CMColorChanged(var Message: TMessage);
begin
inherited;
FColumns.ColorChanged;
end;
procedure TNComboBox.CMFontChanged(var Message: TMessage);
begin
inherited;
FColumns.FontChanged;
end;
procedure TNComboBox.CNDrawItem(var Message: TWMDrawItem);
begin
FEditDrawing := (Message.DrawItemStruct^.itemState and ODS_COMBOBOXEDIT)<>0;
inherited;
end;
constructor TNComboBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FColumns := TCBColumns.Create(Self);
FColumns.Add;
FBoundaryLine := TBoundaryLine.Create;
FItems := TStringList.Create;
fTargetCol := 0;
FIndent := 2;
{
FCanEdit:= true;
}
ItemHeight := 15;
FNormalColor := Color;
FEnterColor := Color;
FErrorColor := clRed;
end;
procedure TNComboBox.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style or CBS_OWNERDRAWFIXED;
end;
destructor TNComboBox.Destroy;
begin
FItems.Free;
FBoundaryLine.Free;
FColumns.Free;
inherited;
end;
procedure TNComboBox.DoEnter;
begin
if (not FErrorOn) and (FColorChange) then
Color := FEnterColor;
inherited DoEnter;
end;
procedure TNComboBox.DoExit;
begin
FErrorOn := False;
if (FColorChange) then
Color := FNormalColor;
inherited DoExit;
end;
procedure TNComboBox.DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
var
i, offset: Integer;
rc : TRect;
col : TCBColumn;
strs : TStringList;
clTmp : TColor;
begin
if FEditDrawing then
begin
Canvas.FillRect(Rect);
Canvas.TextOut(Rect.Left + 2, Rect.Top + 2, GetSelectedText);
end
else
begin
Canvas.FillRect(Rect);
strs := TStringList.Create;
try
strs.CommaText := FItems[Index];
offset := Rect.Left;
for i := 0 to FColumns.Count - 1 do
begin
col := FColumns[i];
rc := Classes.Rect(offset, Rect.Top, offset + col.FWidth, Rect.Bottom);
if rc.Right > Rect.Right then rc.Right := Rect.Right;
// テキスト表示
if i >= strs.Count then
col.DrawColumn(Self, rc, '', odSelected in State)
else
col.DrawColumn(Self, rc, strs[i], odSelected in State);
// 境界線
if (i <> 0) and (FBoundaryLine.Drawing) then
begin
clTmp := Canvas.Pen.Color;
Canvas.Pen.Color := FBoundaryLine.Color;
Canvas.MoveTo(rc.Left, rc.Top);
Canvas.LineTo(rc.Left, rc.Bottom);
Canvas.Pen.Color := clTmp;
end;
//
Inc(offset, col.FWidth);
end;
rc := Classes.Rect(offset, Rect.Top, Rect.Right, Rect.Bottom);
Canvas.FillRect(rc);
finally
strs.Free;
end;
end;
end;
procedure TNComboBox.DropDown;
var
i, wid: Integer;
begin
inherited DropDown;
wid := 0;
for i := 0 to FColumns.Count - 1 do
Inc(wid, FColumns[i].Width);
SendMessage(Handle, CB_SETDROPPEDWIDTH, wid, 0);
end;
function TNComboBox.ColIndexOf(const col: Integer;
const s: string): Integer;
var
strs: TStringList;
rtn : Integer;
i : Integer;
begin
strs := TStringList.Create;
try
for i := 0 to FItems.Count - 1 do
strs.Add(GetColumnText(i, col));
rtn := strs.IndexOf(s);
finally
strs.Free;
end;
Result := rtn;
end;
function TNComboBox.GetColText(col: Integer): string;
var
i: Integer;
begin
for i := 0 to Items.Count - 1 do
//2003.12.24 修正開始
// if AnsiPos(Text, Items[i]) <> 0 then Break;
if AnsiPos(Text, FItems[i]) <> 0 then Break;
//2003.12.24 修正終了
Result := GetColumnText(i, col);
end;
function TNComboBox.GetColumnText(idx, col: Integer): string;
var
strs: TStringList;
begin
Result := '';
if (idx < 0) or (fItems.Count <= idx) then Exit;
strs := TStringList.Create;
try
strs.CommaText := fItems[idx];
if col < strs.Count then Result := strs.Strings[col];
finally
strs.Free;
end;
end;
function TNComboBox.GetSelectedText: string;
begin
// if CanEdit and LongBool(SendMessage(EditHandle, EM_GETMODIFY, 0, 0)) then
if LongBool(SendMessage(EditHandle, EM_GETMODIFY, 0, 0)) then
Result := Text
else
Result := GetColumnText(ItemIndex, FTargetCol);
end;
procedure TNComboBox.KeyPress(var Key: Char);
var
ParentForm: TCustomForm;
begin
Case Key of
#13: // Enter
begin
if FEnterFocusMove then
begin
ParentForm := GetParentForm( Self );
// TFormが見つからない
if ParentForm = nil then Exit;
// 次コントロールへ移動
PostMessage( ParentForm.Handle, WM_NEXTDLGCTL, 0, 0 );
// キー無効
key := #0;
end
else
begin
// beep; // ビープ音を鳴らす。
end;
// key := #0; // キー無効
end;
end;
inherited KeyPress(Key);
end;
procedure TNComboBox.KeyUp(var Key: Word; Shift: TShiftState);
var
TypedStr : String;
i, TempLength: Integer;
wkStr : String;
TargetItems : TStringList;
strs : TStringList;
begin
// スキップさせるキー
case Key of
VK_LEFT..VK_DOWN : Exit; // 矢印キー
VK_BACK..VK_CLEAR : Exit; // 削除キー
VK_SHIFT..VK_MENU : Exit; // Ctrl,Shift,Alt
end;
// 入力支援あり？
if (Not FInputSupport) then Exit;
// ＩＭＥ入力対応
if (SelLength > 0) and (Key <> VK_RETURN) then Exit;
TempLength := 0;
TypedStr := text;
TargetItems := TStringList.Create;
strs := TStringList.Create;
try
// 探索用リスト作成
for i := 0 to FItems.Count - 1 do
begin
strs.CommaText:= FItems[i];
if FTargetCol < strs.Count then
TargetItems.Add(strs[FTargetCol])
else
TargetItems.Add(strs[0]);
end;
// 自動入力
for i := 0 to FItems.Count - 1 do
begin
if AnsiPos(TypedStr, TargetItems[i]) = 1 then
begin
wkStr := TargetItems[i];
TempLength := Length(TypedStr);
Break;
end;
end;
// 自動入力対象がなかった時
if wkStr = '' then
exit;
Text := wkStr;
SelStart := TempLength;
SelLength := Length(Text) - TempLength;
finally
Change; // OnChangeイベント発生
TargetItems.Free;
strs.Free;
inherited KeyUp(Key,Shift);
end;
end;
procedure TNComboBox.SetBoundaryLine(AValue: TBoundaryLine);
begin
FBoundaryLine.Assign(AValue);
end;
procedure TNComboBox.SetColorChange(AValue: Boolean);
begin
if FColorChange <> AValue then
FColorChange := AValue;
end;
procedure TNComboBox.SetColumns(columns: TCBColumns);
begin
FColumns.Assign(columns);
end;
procedure TNComboBox.SetEnterColor(AValue: TColor);
begin
if FEnterColor <> AValue then
begin
FEnterColor := AValue;
if FNormalColor <> FEnterColor then
FColorChange := True;
end;
end;
procedure TNComboBox.SetEnterFocusMove(AValue: Boolean);
begin
if FEnterFocusMove <> AValue then
FEnterFocusMove := AValue;
end;
procedure TNComboBox.SetErrorColor(AValue: TColor);
begin
if FErrorColor <> AValue then
begin
FErrorColor := AValue;
Invalidate;
end;
end;
procedure TNComboBox.SetErrorOn(AValue: Boolean);
begin
if FErrorOn <> AValue then
begin
FErrorOn := AValue;
if FErrorOn then
Color := FErrorColor
else
Color := FNormalColor;
end;
end;
procedure TNComboBox.SetInputSupport(AValue: Boolean);
begin
if FInputSupport <> AValue then
FInputSupport := AValue;
end;
procedure TNComboBox.SetNormalColor(AValue: TColor);
begin
if FNormalColor <> AValue then
begin
FNormalColor := AValue;
Color := FNormalColor;
Invalidate;
end;
end;
{ ------------------------------------------------------- }
{ TBoundaryLine の実装部 }
{ ------------------------------------------------------- }
procedure TBoundaryLine.Assign(Source: TPersistent);
begin
if Source is TBoundaryLine then
begin
Drawing := TBoundaryLine(Source).Drawing;
Color := TBoundaryLine(Source).Color;
Exit;
end;
inherited Assign(Source);
end;
constructor TBoundaryLine.Create;
begin
inherited Create;
FColor := clBlack;
FDrawing := True;
end;
procedure TBoundaryLine.SetColor(col: TColor);
begin
if FColor <> col then
FColor := col;
end;
procedure TBoundaryLine.SetDrawing(AValue: Boolean);
begin
if FDrawing <> AValue then
FDrawing := AValue;
end;
{ ------------------------------------------------------- }
{ TCBColumn の実装部 }
{ ------------------------------------------------------- }
constructor TCBColumn.Create( Collection: TCollection);
begin
inherited Create( Collection);
FWidth := 60;
FFont := TFont.Create;
FFont.OnChange := FontChanged;
FParentColor := true;
FParentFont := true;
ParentColorChanged;
ParentFontChanged;
end;
destructor TCBColumn.Destroy;
begin
FFont.Free;
inherited;
end;
procedure TCBColumn.ParentColorChanged;
begin
if FParentColor then
FColor := TCBColumns(Collection).fOwner.Color;
end;
procedure TCBColumn.ParentFontChanged;
begin
if FParentFont then
FFont.Assign(TCBColumns(Collection).fOwner.Font);
end;
procedure TCBColumn.FontChanged( Sender: TObject);
begin
FParentFont := false;
end;
function TCBColumn.IsStoredColor: Boolean;
begin
Result := not FParentColor;
end;
function TCBColumn.IsStoredFont: Boolean;
begin
Result := not FParentFont;
end;
procedure TCBColumn.SetColor(AValue: TColor);
begin
if FColor <> AValue then
begin
FColor := AValue;
FParentColor := false;
end;
end;
procedure TCBColumn.SetFont(AValue: TFont);
begin
FFont.Assign(AValue);
FParentFont := false;
end;
procedure TCBColumn.SetParentColor(AValue: Boolean);
begin
if FParentColor <> AValue then
begin
FParentColor := AValue;
ParentColorChanged;
end;
end;
procedure TCBColumn.SetParentFont(AValue: Boolean);
begin
if FParentFont <> AValue then
begin
FParentFont := AValue;
ParentFontChanged;
FParentFont := AValue;
end;
end;
procedure TCBColumn.DrawColumn(Sender: TNComboBox; aRect: TRect; text: string; isSelected: Boolean);
const
alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
fontColor: TColor;
begin
with Sender.Canvas do
begin
if not isSelected then
begin
Brush.Color := FColor;
Font := FFont;
end else begin
fontColor := Font.Color;
Font := FFont;
Font.Color := fontColor;
end;
FillRect(aRect);
if FAlignment = taRightJustify then
aRect.Right := aRect.Right - Sender.FIndent
else
if FAlignment = taLeftJustify then
aRect.Left := aRect.Left + Sender.fIndent;
DrawText(Handle, PChar(text), Length(text), aRect, DT_SINGLELINE or DT_VCENTER or alignments[fAlignment]);
end;
end;
procedure TCBColumn.Assign(Source: TPersistent);
begin
if Source is TCBColumn then
with TCBColumn(Source) do
begin
Width := Self.Width;
Color := Self.Color;
Alignment := Self.Alignment;
Font := Self.Font;
ParentColor := Self.ParentColor;
ParentFont := Self.ParentFont;
Exit;
end;
inherited Assign(Source);
end;
{ ------------------------------------------------------- }
{ TCBColumns の実装部 }
{ ------------------------------------------------------- }
constructor TCBColumns.Create(AOwner: TNComboBox);
begin
inherited Create(TCBColumn);
FOwner := AOwner;
end;
procedure TCBColumns.ColorChanged;
var
i: Integer;
begin
for i := 0 to Count - 1 do Items[i].ParentColorChanged;
end;
procedure TCBColumns.FontChanged;
var
i: Integer;
begin
for i := 0 to Count - 1 do Items[i].ParentFontChanged;
end;
function TCBColumns.GetItem(idx: Integer): TCBColumn;
begin
Result := TCBColumn(inherited GetItem(idx));
end;
function TCBColumns.GetOwner: TPersistent;
begin
Result := FOwner;
end;
procedure TCBColumns.SetItem(idx: Integer; item: TCBColumn);
begin
inherited SetItem(idx, item);
end;
{ ------------------------------------------------------- }
{ TNStringGrid の実装部 }
{ ------------------------------------------------------- }
constructor TNStringGrid.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FSetCol := 0;
FGetFixS := '';
FSortFlg := false;
FSortUp := True;
FSpacing := 10;
DefaultRowHeight := 20;
FGridColumns := TGridColumns.Create(Self);
FRowParams := TRowParams.Create(Self);
FMouseDown := False;
FSaveBrush := TBrush.Create;
FSavePen := TPen.Create;
FSaveFont := TFont.Create;
FStripeColor := Color;
FStripeFont := TFont.Create;
FGridStriped := False;
FCellPadding := 2;
FLayout := tlTop;
FFixedAlignment := taLeftJustify;
FFocusDraw := True;
FFocusCellParam := False;
FFocusCellColor := clHighlight;
FFocusCellFont := TFont.Create;
FFocusCellFont.Color := clHighlightText;
FNowSortedCol := -1;
DefaultDrawing := False;
ColCount := 4;
end;
destructor TNStringGrid.Destroy;
begin
FGridColumns.Free;
FRowParams.Free;
FSaveBrush.Free;
FSavePen.Free;
FSaveFont.Free;
FStripeFont.Free;
FFocusCellFont.Free;
inherited Destroy;
end;
procedure TNStringGrid.GridToCsv(AFileName: String);
var
Col, Row: Integer;
tmpStr : String;
tmpList : TStringList;
begin
tmpList := TStringList.Create;
try
tmpList.Clear;
// ファイル名指定ありか
if AFileName <> '' then
begin
{ 外部 CSV ファイルへ保存 }
// 行の終わりまで
for Row := 0 to Self.RowCount - 1 do
if Self.RowHeights[Row] <> -1 then
tmpList.Add(Self.Rows[Row].CommaText);
// 指定ファイル名で保存
tmpList.SaveToFile(AFileName);
end
else
begin
{ ClipBoard へ保存 }
// 行の終わりまで
for Row := 0 to Self.RowCount - 1 do
begin
if Self.RowHeights[Row] <> -1 then
begin
tmpStr := '';
// 列の終わりまで
for Col := 0 to Self.ColCount - 1 do
begin
if tmpStr <> '' then
tmpStr := tmpStr + Char(VK_TAB) + Self.Cells[Col, Row]
else
tmpStr := Self.Cells[Col, Row];
end;
tmpList.Add(tmpStr);
end;
end;
// TMemo を介してクリップボードへ
with TMemo.Create(GetParentForm(Self)) do
begin
try
Name := 'tmpMemo1';
ParentWindow := Self.Handle;
Lines.Clear;
Lines.Assign(tmpList);
SelectAll;
CopyToClipboard;
finally
Free;
end;
end;
end;
finally
tmpList.Free;
end;
end;
procedure TNStringGrid.GridToCsv;
begin
GridToCsv('');
end;
procedure TNStringGrid.SelectionCellsToCsv(AFileName: String);
var
Col, Row: Integer;
x1, x2,
y1, y2 : Integer;
tmpStr : String;
tmpList : TStringList;
tmpList2: TStringList;
begin
// 選択範囲取得
with Self.Selection do
begin
x1 := Left;
x2 := Right;
y1 := Top;
y2 := Bottom;
end;
tmpList := TStringList.Create;
try
tmpList.Clear;
// ファイル名指定ありか
if AFileName <> '' then
begin
tmpList2 := TStringList.Create;
try
for Row := y1 to y2 do
begin
tmpList2.Clear;
for Col := x1 to x2 do
tmpList2.Add(Self.Cells[Col, Row]);
tmpList.Add(tmpList2.CommaText);
end;
finally
tmpList2.Free;
end;
tmpList.SaveToFile(AFileName);
end
else
begin
for Row := y1 to y2 do
begin
tmpStr := '';
for Col := x1 to x2 do
if tmpStr <> '' then
tmpStr := tmpStr + Char(VK_TAB) + Self.Cells[Col, Row]
else
tmpStr := Self.Cells[Col, Row];
tmpList.Add(tmpStr);
end;
with TMemo.Create(GetParentForm(Self)) do
begin
try
Name := 'tmpMemo1';
ParentWindow := Self.Handle;
Lines.Clear;
Lines.Assign(tmpList);
SelectAll;
CopyToClipboard;
finally
Free;
end;
end;
end;
finally
tmpList.Free;
end;
end;
procedure TNStringGrid.SelectionCellsToCsv;
begin
SelectionCellsToCsv('');
end;
procedure TNStringGrid.SetColWidth(ACol: Integer);
var
ARow : Integer;
wrkRow : Integer;
wrkLength: Integer;
maxLength: Integer;
begin
// 初期クリア
maxLength := 0;
wrkRow := 0;
for ARow := 0 to RowCount - 1 do
begin
wrkLength := Length(Cells[ACol, ARow]);
if wrkLength > maxLength then
begin
maxLength := wrkLength;
wrkRow := ARow;
end;
end;
// TCanvas を利用し必要ピクセル数算出
with Canvas do
begin
Font.Assign(Self.Font);
ColWidths[ACol] := TextWidth(TrimRight(Cells[ACol, wrkRow])) + 4;
end;
end;
procedure TNStringGrid.SetAllColWidth;
var
ACol: Integer;
begin
Rows[0].BeginUpdate;
try
for ACol := 0 to ColCount - 1 do
SetColWidth(ACol);
finally
Rows[0].EndUpdate;
end;
end;
procedure TNStringGrid.SetSpacing(Value: Integer);
begin
if FSpacing <> Value then FSpacing := Value;
end;
procedure TNStringGrid.UpdateScrollBar(Target: TScrollStyle);
const
DEFAULT_NMAX = 127;
var
SIOld,
SINew : TScrollInfo;
AColCount,
ARowCount : integer;
begin
{ スクロールバーのつまみの大きさの調整
本当は自動でやりたかったが、どうも無理そうなので手動に変更
グリッドのHeight,Widthが固定でない場合は不具合が出るので注意 }
if not HandleAllocated then
Exit;
SIOld.cbSize := sizeof(SIOld);
SIOld.fMask := SIF_ALL;
if (Target in [ssVertical, ssBoth]) then
begin
ARowCount := RowCount - FixedRows;
if (ScrollBars in [ssVertical, ssBoth]) and
(Self.VisibleRowCount < ARowCount) then
begin
GetScrollInfo(Self.Handle, SB_VERT, SIOld);
SINew := SIOld;
SINew.nPage := (VisibleRowCount * 127) div (ARowCount - VisibleRowCount);
SINew.nMax := DEFAULT_NMAX + SINew.nPage;
SetScrollInfo(Self.Handle, SB_VERT, SINew, True);
end;
end;
if (Target in [ssHorizontal, ssBoth]) then
begin
AColCount := ColCount - FixedCols;
if (ScrollBars in [ssHorizontal, ssBoth]) and
(Self.VisibleColCount < AColCount) then
begin
GetScrollInfo(Self.Handle, SB_HORZ, SIOld);
SINew := SIOld;
SINew.nPage := (VisibleColCount * 127) div (AColCount - VisibleColCount);
SINew.nMax := DEFAULT_NMAX + SINew.nPage;
SetScrollInfo(Self.Handle, SB_HORZ, SINew, True);
end;
end;
end;
procedure TNStringGrid.SetGridColumns(AValue: TGridColumns);
begin
Invalidate;
end;
function TNStringGrid.GetDisplayText(AText, ADisplayMask: string): string;
var
i : integer;
flg: boolean;
begin
flg := true;
for i := 1 to Length(AText) do
if not (AText[i] in ['0'..'9', '.', '-', '+']) then
flg := false;
if flg then
result := FormatFloat(ADisplayMask, StrToFloat(AText))
else
// result := FormatMaskText(ADisplayMask, AText);
end;
function TNStringGrid.GetBrushColor(ACol, ARow: integer): TColor;
var
i : Integer;
Param: TRowParam;
begin
// 行パラメータ優先
if FRowParams.Count > 0 then
for i := 0 to FRowParams.Count - 1 do
begin
Param := FRowParams.Items[i];
if (Param.Enabled) and
(((Param.RowMax = 0) and (ARow = Param.Row)) or
((Param.RowMax > 0) and (ARow >= Param.Row) and (ARow <= Param.RowMax)))
then
begin
result := FRowParams.Items[i].Color;
Exit;
end;
end;
if GridStriped then
if (ARow mod 2) <> 0 then
result := Color
else
result := StripeColor
else
if ACol < FGridColumns.Count then
result := FGridColumns.Items[ACol].Color
else
result := Color;
end;
procedure TNStringGrid.DrawFixedFrame(ARect: TRect);
begin
if Ctl3D then
begin
Canvas.Pen.Style := psSolid;
Canvas.Pen.Mode := pmCopy;
with ARect do
begin
Canvas.Pen.Color := clBtnHighlight;
Canvas.MoveTo(Right - 1, Top);
Canvas.LineTo(Left, Top);
Canvas.LineTo(Left, Bottom - 1);
Canvas.Pen.Color := clBtnShadow;
Canvas.LineTo(Right - 1, Bottom - 1);
Canvas.LineTo(Right - 1, Top);
end;
end;
end;
procedure TNStringGrid.DrawFixedFramePushed(ARect: TRect);
begin
if Ctl3D then
begin
Canvas.Pen.Style := psSolid;
Canvas.Pen.Mode := pmCopy;
with ARect do
begin
Canvas.Pen.Color := clBtnShadow;
Canvas.MoveTo(Right - 1, Top);
Canvas.LineTo(Left, Top);
Canvas.LineTo(Left, Bottom - 1);
Canvas.Pen.Color := clBtnHighlight;
Canvas.LineTo(Right - 1, Bottom - 1);
Canvas.LineTo(Right - 1, Top);
end;
end;
end;
procedure TNStringGrid.DrawCell(ACol, ARow: Longint; ARect: TRect;
AState: TGridDrawState);
var
GridColumn: TGridColumn;
Offset : integer;
procedure DrawCellTextEx;
//フォーカス枠描画 サブ手続き
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure Sub_DrawFocusRect( ACellRect: TRect; ADrawLeft, ADrawRight: boolean );
//指定位置フォーカス色設定 サブ手続き
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure Sub_Sub_SetFocusRectColor( ALeft, ATop: integer );
var
nowcolor, frcolor: TColor;
coldiff: longint;
begin
//フォーカス枠の色を反転して作成
nowcolor := Canvas.Pixels[ ALeft, ATop ];
frcolor := ( not nowcolor ) and $FFFFFF;
//反転した結果、あまりに近い色であれば、作りなおし
//（各色成分の違いの合計が 8*3=24 より少ない場合は近い色と判定）
coldiff :=
Abs( ( nowcolor and $FF ) - ( frcolor and $FF ) ) +
Abs( ( ( nowcolor shr 8 ) and $FF ) - ( ( frcolor shr 8 ) and $FF ) ) +
Abs( ( ( nowcolor shr 16 ) and $FF ) - ( ( frcolor shr 16 ) and $FF ) );
if coldiff < 24 then
begin
if nowcolor > clSilver then frcolor := clBlack
else frcolor := clWhite;
end;
Canvas.Pixels[ ALeft, ATop ] := frcolor;
end;
var
i: integer;
begin
// フォーカス描画の確認（固定列はどうあってもフォーカスできないのよ）
if ( FixedCols > ACol ) or ( FixedRows > ARow ) then exit;
// キャンバス初期化
Canvas.Pen.Style := psSolid;
Canvas.Brush.Style := bsSolid;
// 描画範囲設定
ACellRect.Right := ACellRect.Right - 1;
ACellRect.Bottom := ACellRect.Bottom - 1;
// フォーカス枠を描く（１ドットおきに点）
with ACellRect do
begin
// 横線
for i := 0 to ( Right - Left ) div 2 do
begin
Sub_Sub_SetFocusRectColor( Left + i * 2, Top );
Sub_Sub_SetFocusRectColor( Left + i * 2, Bottom );
end;
// 縦線
for i := 1 to ( Bottom - Top - 1 ) div 2 do
begin
if ADrawLeft then Sub_Sub_SetFocusRectColor( Left, Top + i * 2 );
if ADrawRight then Sub_Sub_SetFocusRectColor( Right, Top + i * 2 );
end;
end;
end;
var
S : string;
// t, drawT : string;
Flags : integer;
// i, j, x, y
いただいたソースをみてココです！ここが違いますっていえれば
かっこいいんですけど・・・コード長すぎる。
どのコントロールが原因か特定できませんか？
バージョンは違いますがこれと同じような気がします。
ttp://qc.embarcadero.com/wc/qcmain.aspx?d=81684
フォームを右クリックして「テキスト形式DFM」にチェックが付いてたらチェックを外すと回避出来るのかな？
根本的には、コンポーネントを配列化してるとこの問題が出るようなので配列化しないようにしたら良いかと思います。
Atchoumさん
ありがとうございます。
TNStringGridが原因のような気がします
auさんありがとうございます
教えて頂いたページを見てみます
auさん
教えて頂きました
>フォームを右クリックして「テキスト形式DFM」にチェックが付いてたらチ
>ェックを外すと
を行うとコンパイルは通りました。
しかしながら、実行させますと
モジュールtest.exeのアドレスXXXXXXXXでアドレスXXXXXXXXに対する書き込み違反がおきました"が表示されます
デバッグをとりますと、やはりコンポーネントのロジックで起こっているようなのですが、エラーのステップを特定するようなことはできるのでしょうか？
エラー発生時CPUのウインドウが表示されます
| ツイート |  |