Download as
Browse Code »

Commit feb220c321bcffb76a06b79a4dc8a30560da3ba5

Authored by Carlos Picanco
1 parent 815c87c2
Exists in master

lacs-matrix prototype GUI

Showing 2 changed files with 682 additions and 126 deletions   Show diff stats
form_participant.lfm
  Diff comments   View file @feb220c
1 1 object Form1: TForm1
2   - Left = 111
3   - Height = 505
4   - Top = 149
5   - Width = 913
  2 + Left = 109
  3 + Height = 600
  4 + Top = 138
  5 + Width = 1095
6 6 Caption = 'Form1'
7   - ClientHeight = 505
8   - ClientWidth = 913
  7 + ClientHeight = 600
  8 + ClientWidth = 1095
  9 + Font.Name = 'Monospace'
9 10 LCLVersion = '1.6.0.4'
10   - object StringGrid1: TStringGrid
  11 + object StringGridMatrix: TStringGrid
11 12 AnchorSideLeft.Control = Owner
12 13 AnchorSideTop.Control = Owner
13 14 AnchorSideRight.Control = Owner
... ... @@ -18,76 +19,525 @@ object Form1: TForm1
18 19 Height = 344
19 20 Top = 0
20 21 Width = 715
  22 + AutoEdit = False
21 23 BorderSpacing.Right = 150
22 24 BorderSpacing.Bottom = 197
23 25 ColCount = 11
24 26 DefaultRowHeight = 30
25 27 FixedRows = 0
26 28 Flat = True
27   - Options = [goFixedHorzLine, goVertLine, goHorzLine, goDrawFocusSelected, goRowSelect, goSmoothScroll]
  29 + Options = [goFixedHorzLine, goHorzLine, goDrawFocusSelected, goRowSelect, goSmoothScroll]
28 30 RowCount = 10
29 31 TabOrder = 0
30   - OnDrawCell = StringGrid1DrawCell
31   - Cells = (
32   - 10
33   - 0
34   - 0
35   - '1'
36   - 0
37   - 1
38   - '2'
39   - 0
40   - 2
41   - '3'
42   - 0
43   - 3
44   - '4'
45   - 0
46   - 4
47   - '5'
48   - 0
49   - 5
50   - '6'
51   - 0
52   - 6
53   - '7'
54   - 0
55   - 7
56   - '8'
57   - 0
58   - 8
59   - '9'
60   - 0
61   - 9
62   - '10'
63   - )
  32 + TitleFont.Name = 'Monospace'
  33 + OnBeforeSelection = StringGridMatrixBeforeSelection
  34 + OnDrawCell = StringGridMatrixDrawCell
64 35 end
65 36 object CheckBoxDrawDots: TCheckBox
66 37 Left = 728
67   - Height = 24
68   - Top = 16
69   - Width = 93
  38 + Height = 21
  39 + Top = 248
  40 + Width = 87
70 41 Caption = 'DrawDots'
71 42 OnChange = CheckBoxDrawDotsChange
72 43 TabOrder = 1
73 44 end
74   - object DBGrid1: TDBGrid
75   - Left = 32
76   - Height = 100
77   - Top = 368
78   - Width = 200
79   - Color = clWindow
80   - Columns = <>
81   - DataSource = DataModule1.DataSource1
82   - TabOrder = 2
83   - end
84 45 object Button1: TButton
85   - Left = 736
  46 + Left = 728
86 47 Height = 25
87   - Top = 96
  48 + Top = 216
88 49 Width = 75
89 50 Caption = 'Button1'
90 51 OnClick = Button1Click
  52 + TabOrder = 2
  53 + end
  54 + object GBIndividualPoints: TGroupBox
  55 + Left = 720
  56 + Height = 122
  57 + Top = 0
  58 + Width = 170
  59 + AutoSize = True
  60 + Caption = 'Pontuação Individual'
  61 + ChildSizing.LeftRightSpacing = 10
  62 + ChildSizing.TopBottomSpacing = 30
  63 + ChildSizing.HorizontalSpacing = 20
  64 + ChildSizing.VerticalSpacing = 15
  65 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
  66 + ChildSizing.Layout = cclLeftToRightThenTopToBottom
  67 + ChildSizing.ControlsPerLine = 2
  68 + ClientHeight = 105
  69 + ClientWidth = 166
91 70 TabOrder = 3
  71 + object LabelIndA: TLabel
  72 + Left = 10
  73 + Height = 15
  74 + Top = 30
  75 + Width = 63
  76 + Alignment = taCenter
  77 + AutoSize = False
  78 + Caption = 'A'
  79 + Color = clTeal
  80 + Font.Color = clBlack
  81 + Font.Name = 'Monospace'
  82 + Font.Style = [fsBold]
  83 + ParentColor = False
  84 + ParentFont = False
  85 + Transparent = False
  86 + end
  87 + object LabelIndB: TLabel
  88 + Left = 93
  89 + Height = 15
  90 + Top = 30
  91 + Width = 63
  92 + Alignment = taCenter
  93 + AutoSize = False
  94 + Caption = 'B'
  95 + Color = clTeal
  96 + Font.Color = clBlack
  97 + Font.Name = 'Monospace'
  98 + Font.Style = [fsBold]
  99 + ParentColor = False
  100 + ParentFont = False
  101 + Transparent = False
  102 + end
  103 + object LabelIndACount: TLabel
  104 + Left = 10
  105 + Height = 15
  106 + Top = 60
  107 + Width = 63
  108 + Alignment = taCenter
  109 + AutoSize = False
  110 + Caption = '0'
  111 + Color = clDefault
  112 + ParentColor = False
  113 + Transparent = False
  114 + end
  115 + object LabelIndBCount: TLabel
  116 + Left = 93
  117 + Height = 15
  118 + Top = 60
  119 + Width = 63
  120 + Alignment = taCenter
  121 + AutoSize = False
  122 + Caption = '0'
  123 + Color = clDefault
  124 + ParentColor = False
  125 + Transparent = False
  126 + end
  127 + end
  128 + object GBGrupo: TGroupBox
  129 + Left = 896
  130 + Height = 122
  131 + Top = 0
  132 + Width = 170
  133 + AutoSize = True
  134 + Caption = ' Pontuação do Grupo '
  135 + ChildSizing.LeftRightSpacing = 35
  136 + ChildSizing.TopBottomSpacing = 45
  137 + ChildSizing.Layout = cclLeftToRightThenTopToBottom
  138 + ChildSizing.ControlsPerLine = 1
  139 + ClientHeight = 105
  140 + ClientWidth = 166
  141 + TabOrder = 4
  142 + object LabelGroupCount: TLabel
  143 + Left = 35
  144 + Height = 15
  145 + Top = 45
  146 + Width = 96
  147 + Align = alClient
  148 + Alignment = taCenter
  149 + AutoSize = False
  150 + Caption = '0'
  151 + Color = clDefault
  152 + Layout = tlCenter
  153 + ParentColor = False
  154 + Transparent = False
  155 + end
  156 + end
  157 + object GBChoicesLastTurn: TGroupBox
  158 + AnchorSideLeft.Control = Owner
  159 + AnchorSideRight.Control = Owner
  160 + AnchorSideRight.Side = asrBottom
  161 + AnchorSideBottom.Control = Owner
  162 + AnchorSideBottom.Side = asrBottom
  163 + Left = 0
  164 + Height = 124
  165 + Top = 476
  166 + Width = 1095
  167 + Anchors = [akLeft, akRight, akBottom]
  168 + AutoSize = True
  169 + Caption = 'Escolhas na jogada passada'
  170 + ChildSizing.LeftRightSpacing = 10
  171 + ChildSizing.TopBottomSpacing = 5
  172 + ChildSizing.HorizontalSpacing = 10
  173 + ChildSizing.ControlsPerLine = 6
  174 + ClientHeight = 107
  175 + ClientWidth = 1091
  176 + TabOrder = 5
  177 + object IndLastResponse: TGroupBox
  178 + Left = 10
  179 + Height = 97
  180 + Top = 5
  181 + Width = 138
  182 + AutoSize = True
  183 + Caption = 'Você'
  184 + ChildSizing.LeftRightSpacing = 20
  185 + ChildSizing.TopBottomSpacing = 20
  186 + ChildSizing.HorizontalSpacing = 30
  187 + ChildSizing.VerticalSpacing = 10
  188 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
  189 + ChildSizing.Layout = cclLeftToRightThenTopToBottom
  190 + ChildSizing.ControlsPerLine = 2
  191 + ClientHeight = 80
  192 + ClientWidth = 134
  193 + TabOrder = 0
  194 + object LabelLastColor: TLabel
  195 + Left = 20
  196 + Height = 15
  197 + Top = 20
  198 + Width = 48
  199 + AutoSize = False
  200 + Caption = 'Cor:'
  201 + ParentColor = False
  202 + end
  203 + object PanelLastColor: TPanel
  204 + Left = 98
  205 + Height = 15
  206 + Top = 20
  207 + Width = 16
  208 + Color = clBlack
  209 + ParentColor = False
  210 + TabOrder = 0
  211 + end
  212 + object LabelLastLine: TLabel
  213 + Left = 20
  214 + Height = 15
  215 + Top = 45
  216 + Width = 48
  217 + AutoSize = False
  218 + Caption = 'Linha:'
  219 + ParentColor = False
  220 + end
  221 + object LabelLastLineNumber: TLabel
  222 + Left = 98
  223 + Height = 15
  224 + Top = 45
  225 + Width = 16
  226 + Caption = 'NA'
  227 + ParentColor = False
  228 + end
  229 + end
  230 + object IndLastResponse1: TGroupBox
  231 + Left = 170
  232 + Height = 97
  233 + Top = 5
  234 + Width = 138
  235 + AutoSize = True
  236 + Caption = 'João'
  237 + ChildSizing.LeftRightSpacing = 20
  238 + ChildSizing.TopBottomSpacing = 20
  239 + ChildSizing.HorizontalSpacing = 30
  240 + ChildSizing.VerticalSpacing = 10
  241 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
  242 + ChildSizing.Layout = cclLeftToRightThenTopToBottom
  243 + ChildSizing.ControlsPerLine = 2
  244 + ClientHeight = 80
  245 + ClientWidth = 134
  246 + TabOrder = 1
  247 + object LabelYouLastChoiceColor1: TLabel
  248 + Left = 20
  249 + Height = 15
  250 + Top = 20
  251 + Width = 48
  252 + AutoSize = False
  253 + Caption = 'Cor:'
  254 + ParentColor = False
  255 + end
  256 + object Panel2: TPanel
  257 + Left = 98
  258 + Height = 15
  259 + Top = 20
  260 + Width = 16
  261 + Color = clBlack
  262 + ParentColor = False
  263 + TabOrder = 0
  264 + end
  265 + object Label6: TLabel
  266 + Left = 20
  267 + Height = 15
  268 + Top = 45
  269 + Width = 48
  270 + AutoSize = False
  271 + Caption = 'Linha:'
  272 + ParentColor = False
  273 + end
  274 + object Label7: TLabel
  275 + Left = 98
  276 + Height = 15
  277 + Top = 45
  278 + Width = 16
  279 + Caption = 'NA'
  280 + ParentColor = False
  281 + end
  282 + end
  283 + object IndLastResponse2: TGroupBox
  284 + Left = 322
  285 + Height = 97
  286 + Top = 5
  287 + Width = 138
  288 + AutoSize = True
  289 + Caption = 'Maria'
  290 + ChildSizing.LeftRightSpacing = 20
  291 + ChildSizing.TopBottomSpacing = 20
  292 + ChildSizing.HorizontalSpacing = 30
  293 + ChildSizing.VerticalSpacing = 10
  294 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
  295 + ChildSizing.Layout = cclLeftToRightThenTopToBottom
  296 + ChildSizing.ControlsPerLine = 2
  297 + ClientHeight = 80
  298 + ClientWidth = 134
  299 + TabOrder = 2
  300 + object LabelYouLastChoiceColor2: TLabel
  301 + Left = 20
  302 + Height = 15
  303 + Top = 20
  304 + Width = 48
  305 + AutoSize = False
  306 + Caption = 'Cor:'
  307 + ParentColor = False
  308 + end
  309 + object Panel3: TPanel
  310 + Left = 98
  311 + Height = 15
  312 + Top = 20
  313 + Width = 16
  314 + Color = clBlack
  315 + ParentColor = False
  316 + TabOrder = 0
  317 + end
  318 + object Label8: TLabel
  319 + Left = 20
  320 + Height = 15
  321 + Top = 45
  322 + Width = 48
  323 + AutoSize = False
  324 + Caption = 'Linha:'
  325 + ParentColor = False
  326 + end
  327 + object Label9: TLabel
  328 + Left = 98
  329 + Height = 15
  330 + Top = 45
  331 + Width = 16
  332 + Caption = 'NA'
  333 + ParentColor = False
  334 + end
  335 + end
  336 + end
  337 + object rgMatrixType: TRadioGroup
  338 + Left = 728
  339 + Height = 59
  340 + Top = 272
  341 + Width = 119
  342 + AutoFill = True
  343 + AutoSize = True
  344 + Caption = 'MatrixType'
  345 + ChildSizing.LeftRightSpacing = 6
  346 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
  347 + ChildSizing.EnlargeVertical = crsHomogenousChildResize
  348 + ChildSizing.ShrinkHorizontal = crsScaleChilds
  349 + ChildSizing.ShrinkVertical = crsScaleChilds
  350 + ChildSizing.Layout = cclLeftToRightThenTopToBottom
  351 + ChildSizing.ControlsPerLine = 1
  352 + ClientHeight = 42
  353 + ClientWidth = 115
  354 + ItemIndex = 0
  355 + Items.Strings = (
  356 + 'Rows'
  357 + 'Rows & Cols'
  358 + )
  359 + OnClick = rgMatrixTypeClick
  360 + TabOrder = 6
  361 + end
  362 + object GBChoicesCurrentTurn: TGroupBox
  363 + AnchorSideLeft.Control = Owner
  364 + AnchorSideRight.Control = Owner
  365 + AnchorSideRight.Side = asrBottom
  366 + AnchorSideBottom.Control = Owner
  367 + AnchorSideBottom.Side = asrBottom
  368 + Left = 0
  369 + Height = 124
  370 + Top = 349
  371 + Width = 1095
  372 + Anchors = [akLeft, akRight, akBottom]
  373 + AutoSize = True
  374 + BorderSpacing.Bottom = 127
  375 + Caption = 'Escolhas nesta jogada'
  376 + ChildSizing.LeftRightSpacing = 10
  377 + ChildSizing.TopBottomSpacing = 5
  378 + ChildSizing.HorizontalSpacing = 10
  379 + ChildSizing.ControlsPerLine = 6
  380 + ClientHeight = 107
  381 + ClientWidth = 1091
  382 + TabOrder = 7
  383 + object IndCurrentResponse1: TGroupBox
  384 + Left = 10
  385 + Height = 97
  386 + Top = 5
  387 + Width = 138
  388 + AutoSize = True
  389 + Caption = 'Você'
  390 + ChildSizing.LeftRightSpacing = 20
  391 + ChildSizing.TopBottomSpacing = 20
  392 + ChildSizing.HorizontalSpacing = 30
  393 + ChildSizing.VerticalSpacing = 10
  394 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
  395 + ChildSizing.Layout = cclLeftToRightThenTopToBottom
  396 + ChildSizing.ControlsPerLine = 2
  397 + ClientHeight = 80
  398 + ClientWidth = 134
  399 + TabOrder = 0
  400 + object LabelCurrentColor1: TLabel
  401 + Left = 20
  402 + Height = 15
  403 + Top = 20
  404 + Width = 48
  405 + AutoSize = False
  406 + Caption = 'Cor:'
  407 + ParentColor = False
  408 + end
  409 + object PanelCurrentColor1: TPanel
  410 + Left = 98
  411 + Height = 15
  412 + Top = 20
  413 + Width = 16
  414 + Color = clBlack
  415 + ParentColor = False
  416 + TabOrder = 0
  417 + end
  418 + object LabelCurrentLine1: TLabel
  419 + Left = 20
  420 + Height = 15
  421 + Top = 45
  422 + Width = 48
  423 + AutoSize = False
  424 + Caption = 'Linha:'
  425 + ParentColor = False
  426 + end
  427 + object LabelCurrentLineNumber1: TLabel
  428 + Left = 98
  429 + Height = 15
  430 + Top = 45
  431 + Width = 16
  432 + Caption = 'NA'
  433 + ParentColor = False
  434 + end
  435 + end
  436 + object IndLastResponse4: TGroupBox
  437 + Left = 170
  438 + Height = 97
  439 + Top = 5
  440 + Width = 138
  441 + AutoSize = True
  442 + Caption = 'João'
  443 + ChildSizing.LeftRightSpacing = 20
  444 + ChildSizing.TopBottomSpacing = 20
  445 + ChildSizing.HorizontalSpacing = 30
  446 + ChildSizing.VerticalSpacing = 10
  447 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
  448 + ChildSizing.Layout = cclLeftToRightThenTopToBottom
  449 + ChildSizing.ControlsPerLine = 2
  450 + ClientHeight = 80
  451 + ClientWidth = 134
  452 + TabOrder = 1
  453 + object LabelYouLastChoiceColor3: TLabel
  454 + Left = 20
  455 + Height = 15
  456 + Top = 20
  457 + Width = 48
  458 + AutoSize = False
  459 + Caption = 'Cor:'
  460 + ParentColor = False
  461 + end
  462 + object Panel4: TPanel
  463 + Left = 98
  464 + Height = 15
  465 + Top = 20
  466 + Width = 16
  467 + Color = clBlack
  468 + ParentColor = False
  469 + TabOrder = 0
  470 + end
  471 + object Label10: TLabel
  472 + Left = 20
  473 + Height = 15
  474 + Top = 45
  475 + Width = 48
  476 + AutoSize = False
  477 + Caption = 'Linha:'
  478 + ParentColor = False
  479 + end
  480 + object Label11: TLabel
  481 + Left = 98
  482 + Height = 15
  483 + Top = 45
  484 + Width = 16
  485 + Caption = 'NA'
  486 + ParentColor = False
  487 + end
  488 + end
  489 + object IndLastResponse5: TGroupBox
  490 + Left = 322
  491 + Height = 97
  492 + Top = 5
  493 + Width = 138
  494 + AutoSize = True
  495 + Caption = 'Maria'
  496 + ChildSizing.LeftRightSpacing = 20
  497 + ChildSizing.TopBottomSpacing = 20
  498 + ChildSizing.HorizontalSpacing = 30
  499 + ChildSizing.VerticalSpacing = 10
  500 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
  501 + ChildSizing.Layout = cclLeftToRightThenTopToBottom
  502 + ChildSizing.ControlsPerLine = 2
  503 + ClientHeight = 80
  504 + ClientWidth = 134
  505 + TabOrder = 2
  506 + object LabelYouLastChoiceColor4: TLabel
  507 + Left = 20
  508 + Height = 15
  509 + Top = 20
  510 + Width = 48
  511 + AutoSize = False
  512 + Caption = 'Cor:'
  513 + ParentColor = False
  514 + end
  515 + object Panel5: TPanel
  516 + Left = 98
  517 + Height = 15
  518 + Top = 20
  519 + Width = 16
  520 + Color = clBlack
  521 + ParentColor = False
  522 + TabOrder = 0
  523 + end
  524 + object Label12: TLabel
  525 + Left = 20
  526 + Height = 15
  527 + Top = 45
  528 + Width = 48
  529 + AutoSize = False
  530 + Caption = 'Linha:'
  531 + ParentColor = False
  532 + end
  533 + object Label13: TLabel
  534 + Left = 98
  535 + Height = 15
  536 + Top = 45
  537 + Width = 16
  538 + Caption = 'NA'
  539 + ParentColor = False
  540 + end
  541 + end
92 542 end
93 543 end
... ...
form_participant.pas
  Diff comments   View file @feb220c
... ... @@ -15,7 +15,7 @@ interface
15 15  
16 16 uses
17 17 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids,
18   - StdCtrls, DBGrids;
  18 + StdCtrls, DBGrids, ExtCtrls;
19 19  
20 20 type
21 21  
... ... @@ -24,11 +24,52 @@ type
24 24 TForm1 = class(TForm)
25 25 Button1: TButton;
26 26 CheckBoxDrawDots: TCheckBox;
27   - DBGrid1: TDBGrid;
28   - StringGrid1: TStringGrid;
  27 + GBChoicesCurrentTurn: TGroupBox;
  28 + GBIndividualPoints: TGroupBox;
  29 + GBGrupo: TGroupBox;
  30 + GBChoicesLastTurn: TGroupBox;
  31 + IndLastResponse: TGroupBox;
  32 + IndLastResponse1: TGroupBox;
  33 + IndLastResponse2: TGroupBox;
  34 + IndCurrentResponse1: TGroupBox;
  35 + IndLastResponse4: TGroupBox;
  36 + IndLastResponse5: TGroupBox;
  37 + Label10: TLabel;
  38 + Label11: TLabel;
  39 + Label12: TLabel;
  40 + Label13: TLabel;
  41 + LabelIndACount: TLabel;
  42 + LabelIndBCount: TLabel;
  43 + LabelCurrentColor1: TLabel;
  44 + LabelLastLine: TLabel;
  45 + LabelCurrentLine1: TLabel;
  46 + LabelLastLineNumber: TLabel;
  47 + Label6: TLabel;
  48 + Label7: TLabel;
  49 + Label8: TLabel;
  50 + Label9: TLabel;
  51 + LabelIndA: TLabel;
  52 + LabelGroupCount: TLabel;
  53 + LabelIndB: TLabel;
  54 + LabelLastColor: TLabel;
  55 + LabelCurrentLineNumber1: TLabel;
  56 + LabelYouLastChoiceColor1: TLabel;
  57 + LabelYouLastChoiceColor2: TLabel;
  58 + LabelYouLastChoiceColor3: TLabel;
  59 + LabelYouLastChoiceColor4: TLabel;
  60 + Panel4: TPanel;
  61 + Panel5: TPanel;
  62 + PanelLastColor: TPanel;
  63 + Panel2: TPanel;
  64 + Panel3: TPanel;
  65 + PanelCurrentColor1: TPanel;
  66 + rgMatrixType: TRadioGroup;
  67 + StringGridMatrix: TStringGrid;
29 68 procedure Button1Click(Sender: TObject);
30 69 procedure CheckBoxDrawDotsChange(Sender: TObject);
31   - procedure StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
  70 + procedure rgMatrixTypeClick(Sender: TObject);
  71 + procedure StringGridMatrixBeforeSelection(Sender: TObject; aCol, aRow: integer);
  72 + procedure StringGridMatrixDrawCell(Sender: TObject; aCol, aRow: integer;
32 73 aRect: TRect; aState: TGridDrawState);
33 74 private
34 75 { private declarations }
... ... @@ -38,115 +79,180 @@ type
38 79  
39 80 var
40 81 Form1: TForm1;
  82 + RowBase: integer = 0;
  83 + MustDrawSelection : Boolean;
  84 +
  85 +const
  86 + ccYellow = $00FFFF;
  87 + ccRed = $FF0018;
  88 + ccGreen = $006400;
  89 + ccBlue = $0000FF;
  90 + ccMagenta = $8B008B;
41 91  
42 92 implementation
43 93  
44   -uses datamodule;
  94 +// uses datamodule;
45 95  
46 96 {$R *.lfm}
47 97  
48 98 { TForm1 }
49 99  
50   -procedure TForm1.StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
  100 +procedure TForm1.StringGridMatrixDrawCell(Sender: TObject; aCol, aRow: integer;
51 101 aRect: TRect; aState: TGridDrawState);
52 102 var
53   - OldCanvas : TCanvas;
  103 + OldCanvas: TCanvas;
54 104  
55 105 procedure SaveOldCanvas;
56 106 begin
57   - OldCanvas.Brush.Style := StringGrid1.Canvas.Brush.Style;
58   - OldCanvas.Brush.Color := StringGrid1.Canvas.Brush.Color;
59   - OldCanvas.Pen.Width := StringGrid1.Canvas.Pen.Width;
60   - OldCanvas.Pen.Color := StringGrid1.Canvas.Pen.Color;
61   - OldCanvas.Pen.Mode := StringGrid1.Canvas.Pen.Mode;
  107 + OldCanvas.Brush.Style := TStringGrid(Sender).Canvas.Brush.Style;
  108 + OldCanvas.Brush.Color := TStringGrid(Sender).Canvas.Brush.Color;
  109 + OldCanvas.Pen.Width := TStringGrid(Sender).Canvas.Pen.Width;
  110 + OldCanvas.Pen.Color := TStringGrid(Sender).Canvas.Pen.Color;
  111 + OldCanvas.Pen.Mode := TStringGrid(Sender).Canvas.Pen.Mode;
62 112  
63 113 end;
64 114  
65 115 procedure LoadOldCanvas;
66 116 begin
67   - StringGrid1.Canvas.Brush.Style := OldCanvas.Brush.Style;
68   - StringGrid1.Canvas.Brush.Color := OldCanvas.Brush.Color;
69   - StringGrid1.Canvas.Pen.Width := OldCanvas.Pen.Width;
70   - StringGrid1.Canvas.Pen.Color := OldCanvas.Pen.Color;
71   - StringGrid1.Canvas.Pen.Mode := OldCanvas.Pen.Mode;
  117 + TStringGrid(Sender).Canvas.Brush.Style := OldCanvas.Brush.Style;
  118 + TStringGrid(Sender).Canvas.Brush.Color := OldCanvas.Brush.Color;
  119 + TStringGrid(Sender).Canvas.Pen.Width := OldCanvas.Pen.Width;
  120 + TStringGrid(Sender).Canvas.Pen.Color := OldCanvas.Pen.Color;
  121 + TStringGrid(Sender).Canvas.Pen.Mode := OldCanvas.Pen.Mode;
72 122 end;
73 123  
74   - procedure DrawLines(Color : TColor; Selected : Boolean = False);
75   - var LColor : TColor;
  124 + procedure DrawLines(Color: TColor);
  125 + //function HalfDarker(Color : TColor) : TColor;
  126 + //begin
  127 + // Result := ((Blue(Color) and $7F) shl 16) or ((Green(Color) and $7F) shl 8 ) or (Red(Color) and $7F)
  128 + //end;
76 129  
77   - function HalfDarker(Color : TColor) : TColor;
  130 + procedure DrawDots;
  131 + var
  132 + LFix, LLeft, LRight, LHSize, LVSize: longint;
78 133 begin
79   - Result := ((Blue(Color) and $7F) shl 16) or ((Green(Color) and $7F) shl 8 ) or (Red(Color) and $7F)
  134 + LFix := 2;
  135 + LVSize := ((aRect.Bottom - aRect.Top) div 2);
  136 + LHSize := aRect.Left + (aRect.Right - aRect.Left) div 2;
  137 + LLeft := LHSize - LVSize;
  138 + LRight := LHSize + LVSize;
  139 + TStringGrid(Sender).Canvas.Brush.Style := bsClear;
  140 + TStringGrid(Sender).Canvas.Brush.Color := clBlack;
  141 + TStringGrid(Sender).Canvas.Pen.Color := clBlack;
  142 + TStringGrid(Sender).Canvas.Ellipse(LLeft + LFix, aRect.Top + LFix,
  143 + LRight - LFix, aRect.Bottom - LFix);
80 144 end;
81 145  
82 146 begin
83   - StringGrid1.Canvas.Brush.Style := bsSolid;
84   - StringGrid1.Canvas.Pen.Width:= 1;
85   - if Selected then LColor := HalfDarker(Color) else LColor := Color;
86   - StringGrid1.Canvas.Brush.Color := LColor;
87   - StringGrid1.Canvas.Pen.Color := LColor;
88   - StringGrid1.Canvas.Rectangle(aRect);
89   - end;
90   -
91   - procedure DrawDots;
92   - var LColor : TColor;
93   - LFix,
94   - LLeft,
95   - LRight,
96   - LHSize,
97   - LVSize : longint;
98   - begin
99   - LFix := 2;
100   - LVSize := ((aRect.Bottom - aRect.Top) div 2);
101   - LHSize := aRect.Left + (aRect.Right - aRect.Left) div 2;
102   - LLeft := LHSize - LVSize;
103   - LRight := LHSize + LVSize;
104   -
105   - if gdSelected in aState then
106   - LColor := clGray
107   - else
108   - LColor := clBlack;
109   -
110   - StringGrid1.Canvas.Brush.Style := bsClear;
111   - StringGrid1.Canvas.Brush.Color := LColor;
112   - StringGrid1.Canvas.Pen.Width:= 1;
113   - StringGrid1.Canvas.Pen.Color := LColor;
114   - StringGrid1.Canvas.Ellipse(LLeft+LFix,aRect.Top+LFix,LRight-LFix,aRect.Bottom-LFix);
  147 + TStringGrid(Sender).Canvas.Brush.Style := bsSolid;
  148 + TStringGrid(Sender).Canvas.Pen.Width := 1;
  149 + TStringGrid(Sender).Canvas.Brush.Color := Color;
  150 + TStringGrid(Sender).Canvas.Pen.Color := Color;
  151 + TStringGrid(Sender).Canvas.Rectangle(aRect);
  152 + if CheckBoxDrawDots.Checked then
  153 + if (Odd(aRow + RowBase) and not Odd(aCol)) or
  154 + (not Odd(aRow + RowBase) and Odd(aCol)) then
  155 + DrawDots;
115 156 end;
116 157  
117 158 begin
118 159 OldCanvas := TCanvas.Create;
119 160 SaveOldCanvas;
120 161 try
121   - if (aCol <> 0) and (aRow <> 0) then
  162 + if (aCol <> 0) then
122 163 begin
123   - if (aRow = 1) or (aRow = 8) then DrawLines(clYellow,gdSelected in aState);
124   - if (aRow = 2) or (aRow = 7) then DrawLines($00FF00,gdSelected in aState);
125   - if (aRow = 3) or (aRow = 6) then DrawLines(clRed,gdSelected in aState);
126   - if (aRow = 4) or (aRow = 9) then DrawLines(clBlue,gdSelected in aState);
127   - if (aRow = 5) or (aRow = 10) then DrawLines($FF00FF,gdSelected in aState);
128   -
129   - if CheckBoxDrawDots.Checked then
130   - if (Odd(aRow) and Odd(aCol)) or
131   - (not Odd(aRow) and not Odd(aCol)) then
132   - DrawDots;
133   -
134   - LoadOldCanvas;
  164 + if (aRow = RowBase) or (aRow = (RowBase + 5)) then DrawLines(ccYellow);
  165 + if (aRow = RowBase + 1) or (aRow = (RowBase + 6)) then DrawLines(ccGreen);
  166 + if (aRow = RowBase + 2) or (aRow = (RowBase + 7)) then DrawLines(ccRed);
  167 + if (aRow = RowBase + 3) or (aRow = (RowBase + 8)) then DrawLines(ccBlue);
  168 + if (aRow = RowBase + 4) or (aRow = (RowBase + 9)) then DrawLines(ccMagenta);
135 169 end;
  170 +
  171 + if (aCol <> 0) then
  172 + if (gdSelected in aState) and MustDrawSelection then
  173 + begin
  174 + TStringGrid(Sender).Canvas.Pen.Width := 10;
  175 + TStringGrid(Sender).Canvas.Pen.Color := clWhite;
  176 + if (aRow = TStringGrid(Sender).Selection.Top) and (aCol = TStringGrid(Sender).Selection.Left) then
  177 + begin
  178 + TStringGrid(Sender).Canvas.PenPos := aRect.TopLeft;
  179 + TStringGrid(Sender).Canvas.LineTo(Point(aRect.Left,aRect.Bottom));
  180 + end;
  181 + TStringGrid(Sender).Canvas.PenPos := aRect.BottomRight;
  182 + TStringGrid(Sender).Canvas.LineTo(Point(aRect.Left,aRect.Bottom));
  183 + TStringGrid(Sender).Canvas.PenPos := aRect.TopLeft;
  184 + TStringGrid(Sender).Canvas.LineTo(Point(aRect.Right,aRect.Top));
  185 +
  186 + if (aRow = TStringGrid(Sender).Selection.Top) and (aCol = TStringGrid(Sender).Selection.Right) then
  187 + begin
  188 + TStringGrid(Sender).Canvas.PenPos := aRect.BottomRight;
  189 + TStringGrid(Sender).Canvas.LineTo(Point(aRect.Right,aRect.Top));
  190 + end;
  191 + end;
136 192 finally
  193 + LoadOldCanvas;
137 194 OldCanvas.Free;
138 195 end;
139 196 end;
140 197  
  198 +
141 199 procedure TForm1.CheckBoxDrawDotsChange(Sender: TObject);
142 200 begin
143   - StringGrid1.Invalidate;
  201 + StringGridMatrix.Invalidate;
  202 +end;
  203 +
  204 +procedure TForm1.rgMatrixTypeClick(Sender: TObject);
  205 +
  206 + procedure WriteGridFixedNames(AStringGrid: TStringGrid; WriteCols: boolean);
  207 + var
  208 + i: integer;
  209 + begin
  210 + with AStringGrid do
  211 + for i := 0 to 9 do
  212 + begin
  213 + Cells[0, i + RowBase] := IntToStr(i + 1);
  214 + if WriteCols then
  215 + Cells[i + 1, 0] := chr(65 + i);
  216 + end;
  217 + end;
  218 +
  219 +begin
  220 + case rgMatrixType.ItemIndex of
  221 + // rows only
  222 + 0:
  223 + begin
  224 + StringGridMatrix.Clean;
  225 + StringGridMatrix.FixedRows := 0;
  226 + StringGridMatrix.RowCount := 10;
  227 + StringGridMatrix.Options := [goFixedHorzLine, goHorzLine, goDrawFocusSelected, goRowSelect];
  228 + RowBase := 0;
  229 + WriteGridFixedNames(StringGridMatrix, False);
  230 + end;
  231 + // rows and cols
  232 + 1:
  233 + begin
  234 + StringGridMatrix.Clean;
  235 + StringGridMatrix.FixedRows := 1;
  236 + StringGridMatrix.RowCount := 11;
  237 + StringGridMatrix.Options := [goFixedHorzLine, goHorzLine, goDrawFocusSelected, goRowSelect, goVertLine];
  238 + RowBase := 1;
  239 + WriteGridFixedNames(StringGridMatrix, True);
  240 + end;
  241 + end;
  242 +
  243 +end;
  244 +
  245 +procedure TForm1.StringGridMatrixBeforeSelection(Sender: TObject; aCol, aRow: integer);
  246 +begin
  247 + if MustDrawSelection then Exit;
  248 + MustDrawSelection := True;
144 249 end;
145 250  
146 251 procedure TForm1.Button1Click(Sender: TObject);
147 252 begin
148   - ShowMessage('Hello world');
  253 + StringGridMatrix.ClearSelections;
  254 + MustDrawSelection := False;
  255 + StringGridMatrix.Invalidate;
149 256 end;
150 257  
151 258 end.
152   -
... ...