From feb220c321bcffb76a06b79a4dc8a30560da3ba5 Mon Sep 17 00:00:00 2001 From: cpicanco Date: Sat, 12 Nov 2016 03:12:45 -0300 Subject: [PATCH] lacs-matrix prototype GUI --- form_participant.lfm | 564 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--------------------------------------------------------- form_participant.pas | 244 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--------------------------------------------------------------------- 2 files changed, 682 insertions(+), 126 deletions(-) diff --git a/form_participant.lfm b/form_participant.lfm index c3f0c95..0b7725e 100644 --- a/form_participant.lfm +++ b/form_participant.lfm @@ -1,13 +1,14 @@ object Form1: TForm1 - Left = 111 - Height = 505 - Top = 149 - Width = 913 + Left = 109 + Height = 600 + Top = 138 + Width = 1095 Caption = 'Form1' - ClientHeight = 505 - ClientWidth = 913 + ClientHeight = 600 + ClientWidth = 1095 + Font.Name = 'Monospace' LCLVersion = '1.6.0.4' - object StringGrid1: TStringGrid + object StringGridMatrix: TStringGrid AnchorSideLeft.Control = Owner AnchorSideTop.Control = Owner AnchorSideRight.Control = Owner @@ -18,76 +19,525 @@ object Form1: TForm1 Height = 344 Top = 0 Width = 715 + AutoEdit = False BorderSpacing.Right = 150 BorderSpacing.Bottom = 197 ColCount = 11 DefaultRowHeight = 30 FixedRows = 0 Flat = True - Options = [goFixedHorzLine, goVertLine, goHorzLine, goDrawFocusSelected, goRowSelect, goSmoothScroll] + Options = [goFixedHorzLine, goHorzLine, goDrawFocusSelected, goRowSelect, goSmoothScroll] RowCount = 10 TabOrder = 0 - OnDrawCell = StringGrid1DrawCell - Cells = ( - 10 - 0 - 0 - '1' - 0 - 1 - '2' - 0 - 2 - '3' - 0 - 3 - '4' - 0 - 4 - '5' - 0 - 5 - '6' - 0 - 6 - '7' - 0 - 7 - '8' - 0 - 8 - '9' - 0 - 9 - '10' - ) + TitleFont.Name = 'Monospace' + OnBeforeSelection = StringGridMatrixBeforeSelection + OnDrawCell = StringGridMatrixDrawCell end object CheckBoxDrawDots: TCheckBox Left = 728 - Height = 24 - Top = 16 - Width = 93 + Height = 21 + Top = 248 + Width = 87 Caption = 'DrawDots' OnChange = CheckBoxDrawDotsChange TabOrder = 1 end - object DBGrid1: TDBGrid - Left = 32 - Height = 100 - Top = 368 - Width = 200 - Color = clWindow - Columns = <> - DataSource = DataModule1.DataSource1 - TabOrder = 2 - end object Button1: TButton - Left = 736 + Left = 728 Height = 25 - Top = 96 + Top = 216 Width = 75 Caption = 'Button1' OnClick = Button1Click + TabOrder = 2 + end + object GBIndividualPoints: TGroupBox + Left = 720 + Height = 122 + Top = 0 + Width = 170 + AutoSize = True + Caption = 'Pontuação Individual' + ChildSizing.LeftRightSpacing = 10 + ChildSizing.TopBottomSpacing = 30 + ChildSizing.HorizontalSpacing = 20 + ChildSizing.VerticalSpacing = 15 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 105 + ClientWidth = 166 TabOrder = 3 + object LabelIndA: TLabel + Left = 10 + Height = 15 + Top = 30 + Width = 63 + Alignment = taCenter + AutoSize = False + Caption = 'A' + Color = clTeal + Font.Color = clBlack + Font.Name = 'Monospace' + Font.Style = [fsBold] + ParentColor = False + ParentFont = False + Transparent = False + end + object LabelIndB: TLabel + Left = 93 + Height = 15 + Top = 30 + Width = 63 + Alignment = taCenter + AutoSize = False + Caption = 'B' + Color = clTeal + Font.Color = clBlack + Font.Name = 'Monospace' + Font.Style = [fsBold] + ParentColor = False + ParentFont = False + Transparent = False + end + object LabelIndACount: TLabel + Left = 10 + Height = 15 + Top = 60 + Width = 63 + Alignment = taCenter + AutoSize = False + Caption = '0' + Color = clDefault + ParentColor = False + Transparent = False + end + object LabelIndBCount: TLabel + Left = 93 + Height = 15 + Top = 60 + Width = 63 + Alignment = taCenter + AutoSize = False + Caption = '0' + Color = clDefault + ParentColor = False + Transparent = False + end + end + object GBGrupo: TGroupBox + Left = 896 + Height = 122 + Top = 0 + Width = 170 + AutoSize = True + Caption = ' Pontuação do Grupo ' + ChildSizing.LeftRightSpacing = 35 + ChildSizing.TopBottomSpacing = 45 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 105 + ClientWidth = 166 + TabOrder = 4 + object LabelGroupCount: TLabel + Left = 35 + Height = 15 + Top = 45 + Width = 96 + Align = alClient + Alignment = taCenter + AutoSize = False + Caption = '0' + Color = clDefault + Layout = tlCenter + ParentColor = False + Transparent = False + end + end + object GBChoicesLastTurn: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 124 + Top = 476 + Width = 1095 + Anchors = [akLeft, akRight, akBottom] + AutoSize = True + Caption = 'Escolhas na jogada passada' + ChildSizing.LeftRightSpacing = 10 + ChildSizing.TopBottomSpacing = 5 + ChildSizing.HorizontalSpacing = 10 + ChildSizing.ControlsPerLine = 6 + ClientHeight = 107 + ClientWidth = 1091 + TabOrder = 5 + object IndLastResponse: TGroupBox + Left = 10 + Height = 97 + Top = 5 + Width = 138 + AutoSize = True + Caption = 'Você' + ChildSizing.LeftRightSpacing = 20 + ChildSizing.TopBottomSpacing = 20 + ChildSizing.HorizontalSpacing = 30 + ChildSizing.VerticalSpacing = 10 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 80 + ClientWidth = 134 + TabOrder = 0 + object LabelLastColor: TLabel + Left = 20 + Height = 15 + Top = 20 + Width = 48 + AutoSize = False + Caption = 'Cor:' + ParentColor = False + end + object PanelLastColor: TPanel + Left = 98 + Height = 15 + Top = 20 + Width = 16 + Color = clBlack + ParentColor = False + TabOrder = 0 + end + object LabelLastLine: TLabel + Left = 20 + Height = 15 + Top = 45 + Width = 48 + AutoSize = False + Caption = 'Linha:' + ParentColor = False + end + object LabelLastLineNumber: TLabel + Left = 98 + Height = 15 + Top = 45 + Width = 16 + Caption = 'NA' + ParentColor = False + end + end + object IndLastResponse1: TGroupBox + Left = 170 + Height = 97 + Top = 5 + Width = 138 + AutoSize = True + Caption = 'João' + ChildSizing.LeftRightSpacing = 20 + ChildSizing.TopBottomSpacing = 20 + ChildSizing.HorizontalSpacing = 30 + ChildSizing.VerticalSpacing = 10 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 80 + ClientWidth = 134 + TabOrder = 1 + object LabelYouLastChoiceColor1: TLabel + Left = 20 + Height = 15 + Top = 20 + Width = 48 + AutoSize = False + Caption = 'Cor:' + ParentColor = False + end + object Panel2: TPanel + Left = 98 + Height = 15 + Top = 20 + Width = 16 + Color = clBlack + ParentColor = False + TabOrder = 0 + end + object Label6: TLabel + Left = 20 + Height = 15 + Top = 45 + Width = 48 + AutoSize = False + Caption = 'Linha:' + ParentColor = False + end + object Label7: TLabel + Left = 98 + Height = 15 + Top = 45 + Width = 16 + Caption = 'NA' + ParentColor = False + end + end + object IndLastResponse2: TGroupBox + Left = 322 + Height = 97 + Top = 5 + Width = 138 + AutoSize = True + Caption = 'Maria' + ChildSizing.LeftRightSpacing = 20 + ChildSizing.TopBottomSpacing = 20 + ChildSizing.HorizontalSpacing = 30 + ChildSizing.VerticalSpacing = 10 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 80 + ClientWidth = 134 + TabOrder = 2 + object LabelYouLastChoiceColor2: TLabel + Left = 20 + Height = 15 + Top = 20 + Width = 48 + AutoSize = False + Caption = 'Cor:' + ParentColor = False + end + object Panel3: TPanel + Left = 98 + Height = 15 + Top = 20 + Width = 16 + Color = clBlack + ParentColor = False + TabOrder = 0 + end + object Label8: TLabel + Left = 20 + Height = 15 + Top = 45 + Width = 48 + AutoSize = False + Caption = 'Linha:' + ParentColor = False + end + object Label9: TLabel + Left = 98 + Height = 15 + Top = 45 + Width = 16 + Caption = 'NA' + ParentColor = False + end + end + end + object rgMatrixType: TRadioGroup + Left = 728 + Height = 59 + Top = 272 + Width = 119 + AutoFill = True + AutoSize = True + Caption = 'MatrixType' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 42 + ClientWidth = 115 + ItemIndex = 0 + Items.Strings = ( + 'Rows' + 'Rows & Cols' + ) + OnClick = rgMatrixTypeClick + TabOrder = 6 + end + object GBChoicesCurrentTurn: TGroupBox + AnchorSideLeft.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 124 + Top = 349 + Width = 1095 + Anchors = [akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Bottom = 127 + Caption = 'Escolhas nesta jogada' + ChildSizing.LeftRightSpacing = 10 + ChildSizing.TopBottomSpacing = 5 + ChildSizing.HorizontalSpacing = 10 + ChildSizing.ControlsPerLine = 6 + ClientHeight = 107 + ClientWidth = 1091 + TabOrder = 7 + object IndCurrentResponse1: TGroupBox + Left = 10 + Height = 97 + Top = 5 + Width = 138 + AutoSize = True + Caption = 'Você' + ChildSizing.LeftRightSpacing = 20 + ChildSizing.TopBottomSpacing = 20 + ChildSizing.HorizontalSpacing = 30 + ChildSizing.VerticalSpacing = 10 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 80 + ClientWidth = 134 + TabOrder = 0 + object LabelCurrentColor1: TLabel + Left = 20 + Height = 15 + Top = 20 + Width = 48 + AutoSize = False + Caption = 'Cor:' + ParentColor = False + end + object PanelCurrentColor1: TPanel + Left = 98 + Height = 15 + Top = 20 + Width = 16 + Color = clBlack + ParentColor = False + TabOrder = 0 + end + object LabelCurrentLine1: TLabel + Left = 20 + Height = 15 + Top = 45 + Width = 48 + AutoSize = False + Caption = 'Linha:' + ParentColor = False + end + object LabelCurrentLineNumber1: TLabel + Left = 98 + Height = 15 + Top = 45 + Width = 16 + Caption = 'NA' + ParentColor = False + end + end + object IndLastResponse4: TGroupBox + Left = 170 + Height = 97 + Top = 5 + Width = 138 + AutoSize = True + Caption = 'João' + ChildSizing.LeftRightSpacing = 20 + ChildSizing.TopBottomSpacing = 20 + ChildSizing.HorizontalSpacing = 30 + ChildSizing.VerticalSpacing = 10 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 80 + ClientWidth = 134 + TabOrder = 1 + object LabelYouLastChoiceColor3: TLabel + Left = 20 + Height = 15 + Top = 20 + Width = 48 + AutoSize = False + Caption = 'Cor:' + ParentColor = False + end + object Panel4: TPanel + Left = 98 + Height = 15 + Top = 20 + Width = 16 + Color = clBlack + ParentColor = False + TabOrder = 0 + end + object Label10: TLabel + Left = 20 + Height = 15 + Top = 45 + Width = 48 + AutoSize = False + Caption = 'Linha:' + ParentColor = False + end + object Label11: TLabel + Left = 98 + Height = 15 + Top = 45 + Width = 16 + Caption = 'NA' + ParentColor = False + end + end + object IndLastResponse5: TGroupBox + Left = 322 + Height = 97 + Top = 5 + Width = 138 + AutoSize = True + Caption = 'Maria' + ChildSizing.LeftRightSpacing = 20 + ChildSizing.TopBottomSpacing = 20 + ChildSizing.HorizontalSpacing = 30 + ChildSizing.VerticalSpacing = 10 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 80 + ClientWidth = 134 + TabOrder = 2 + object LabelYouLastChoiceColor4: TLabel + Left = 20 + Height = 15 + Top = 20 + Width = 48 + AutoSize = False + Caption = 'Cor:' + ParentColor = False + end + object Panel5: TPanel + Left = 98 + Height = 15 + Top = 20 + Width = 16 + Color = clBlack + ParentColor = False + TabOrder = 0 + end + object Label12: TLabel + Left = 20 + Height = 15 + Top = 45 + Width = 48 + AutoSize = False + Caption = 'Linha:' + ParentColor = False + end + object Label13: TLabel + Left = 98 + Height = 15 + Top = 45 + Width = 16 + Caption = 'NA' + ParentColor = False + end + end end end diff --git a/form_participant.pas b/form_participant.pas index c5f72d1..a131041 100644 --- a/form_participant.pas +++ b/form_participant.pas @@ -15,7 +15,7 @@ interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids, - StdCtrls, DBGrids; + StdCtrls, DBGrids, ExtCtrls; type @@ -24,11 +24,52 @@ type TForm1 = class(TForm) Button1: TButton; CheckBoxDrawDots: TCheckBox; - DBGrid1: TDBGrid; - StringGrid1: TStringGrid; + GBChoicesCurrentTurn: TGroupBox; + GBIndividualPoints: TGroupBox; + GBGrupo: TGroupBox; + GBChoicesLastTurn: TGroupBox; + IndLastResponse: TGroupBox; + IndLastResponse1: TGroupBox; + IndLastResponse2: TGroupBox; + IndCurrentResponse1: TGroupBox; + IndLastResponse4: TGroupBox; + IndLastResponse5: TGroupBox; + Label10: TLabel; + Label11: TLabel; + Label12: TLabel; + Label13: TLabel; + LabelIndACount: TLabel; + LabelIndBCount: TLabel; + LabelCurrentColor1: TLabel; + LabelLastLine: TLabel; + LabelCurrentLine1: TLabel; + LabelLastLineNumber: TLabel; + Label6: TLabel; + Label7: TLabel; + Label8: TLabel; + Label9: TLabel; + LabelIndA: TLabel; + LabelGroupCount: TLabel; + LabelIndB: TLabel; + LabelLastColor: TLabel; + LabelCurrentLineNumber1: TLabel; + LabelYouLastChoiceColor1: TLabel; + LabelYouLastChoiceColor2: TLabel; + LabelYouLastChoiceColor3: TLabel; + LabelYouLastChoiceColor4: TLabel; + Panel4: TPanel; + Panel5: TPanel; + PanelLastColor: TPanel; + Panel2: TPanel; + Panel3: TPanel; + PanelCurrentColor1: TPanel; + rgMatrixType: TRadioGroup; + StringGridMatrix: TStringGrid; procedure Button1Click(Sender: TObject); procedure CheckBoxDrawDotsChange(Sender: TObject); - procedure StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer; + procedure rgMatrixTypeClick(Sender: TObject); + procedure StringGridMatrixBeforeSelection(Sender: TObject; aCol, aRow: integer); + procedure StringGridMatrixDrawCell(Sender: TObject; aCol, aRow: integer; aRect: TRect; aState: TGridDrawState); private { private declarations } @@ -38,115 +79,180 @@ type var Form1: TForm1; + RowBase: integer = 0; + MustDrawSelection : Boolean; + +const + ccYellow = $00FFFF; + ccRed = $FF0018; + ccGreen = $006400; + ccBlue = $0000FF; + ccMagenta = $8B008B; implementation -uses datamodule; +// uses datamodule; {$R *.lfm} { TForm1 } -procedure TForm1.StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer; +procedure TForm1.StringGridMatrixDrawCell(Sender: TObject; aCol, aRow: integer; aRect: TRect; aState: TGridDrawState); var - OldCanvas : TCanvas; + OldCanvas: TCanvas; procedure SaveOldCanvas; begin - OldCanvas.Brush.Style := StringGrid1.Canvas.Brush.Style; - OldCanvas.Brush.Color := StringGrid1.Canvas.Brush.Color; - OldCanvas.Pen.Width := StringGrid1.Canvas.Pen.Width; - OldCanvas.Pen.Color := StringGrid1.Canvas.Pen.Color; - OldCanvas.Pen.Mode := StringGrid1.Canvas.Pen.Mode; + OldCanvas.Brush.Style := TStringGrid(Sender).Canvas.Brush.Style; + OldCanvas.Brush.Color := TStringGrid(Sender).Canvas.Brush.Color; + OldCanvas.Pen.Width := TStringGrid(Sender).Canvas.Pen.Width; + OldCanvas.Pen.Color := TStringGrid(Sender).Canvas.Pen.Color; + OldCanvas.Pen.Mode := TStringGrid(Sender).Canvas.Pen.Mode; end; procedure LoadOldCanvas; begin - StringGrid1.Canvas.Brush.Style := OldCanvas.Brush.Style; - StringGrid1.Canvas.Brush.Color := OldCanvas.Brush.Color; - StringGrid1.Canvas.Pen.Width := OldCanvas.Pen.Width; - StringGrid1.Canvas.Pen.Color := OldCanvas.Pen.Color; - StringGrid1.Canvas.Pen.Mode := OldCanvas.Pen.Mode; + TStringGrid(Sender).Canvas.Brush.Style := OldCanvas.Brush.Style; + TStringGrid(Sender).Canvas.Brush.Color := OldCanvas.Brush.Color; + TStringGrid(Sender).Canvas.Pen.Width := OldCanvas.Pen.Width; + TStringGrid(Sender).Canvas.Pen.Color := OldCanvas.Pen.Color; + TStringGrid(Sender).Canvas.Pen.Mode := OldCanvas.Pen.Mode; end; - procedure DrawLines(Color : TColor; Selected : Boolean = False); - var LColor : TColor; + procedure DrawLines(Color: TColor); + //function HalfDarker(Color : TColor) : TColor; + //begin + // Result := ((Blue(Color) and $7F) shl 16) or ((Green(Color) and $7F) shl 8 ) or (Red(Color) and $7F) + //end; - function HalfDarker(Color : TColor) : TColor; + procedure DrawDots; + var + LFix, LLeft, LRight, LHSize, LVSize: longint; begin - Result := ((Blue(Color) and $7F) shl 16) or ((Green(Color) and $7F) shl 8 ) or (Red(Color) and $7F) + LFix := 2; + LVSize := ((aRect.Bottom - aRect.Top) div 2); + LHSize := aRect.Left + (aRect.Right - aRect.Left) div 2; + LLeft := LHSize - LVSize; + LRight := LHSize + LVSize; + TStringGrid(Sender).Canvas.Brush.Style := bsClear; + TStringGrid(Sender).Canvas.Brush.Color := clBlack; + TStringGrid(Sender).Canvas.Pen.Color := clBlack; + TStringGrid(Sender).Canvas.Ellipse(LLeft + LFix, aRect.Top + LFix, + LRight - LFix, aRect.Bottom - LFix); end; begin - StringGrid1.Canvas.Brush.Style := bsSolid; - StringGrid1.Canvas.Pen.Width:= 1; - if Selected then LColor := HalfDarker(Color) else LColor := Color; - StringGrid1.Canvas.Brush.Color := LColor; - StringGrid1.Canvas.Pen.Color := LColor; - StringGrid1.Canvas.Rectangle(aRect); - end; - - procedure DrawDots; - var LColor : TColor; - LFix, - LLeft, - LRight, - LHSize, - LVSize : longint; - begin - LFix := 2; - LVSize := ((aRect.Bottom - aRect.Top) div 2); - LHSize := aRect.Left + (aRect.Right - aRect.Left) div 2; - LLeft := LHSize - LVSize; - LRight := LHSize + LVSize; - - if gdSelected in aState then - LColor := clGray - else - LColor := clBlack; - - StringGrid1.Canvas.Brush.Style := bsClear; - StringGrid1.Canvas.Brush.Color := LColor; - StringGrid1.Canvas.Pen.Width:= 1; - StringGrid1.Canvas.Pen.Color := LColor; - StringGrid1.Canvas.Ellipse(LLeft+LFix,aRect.Top+LFix,LRight-LFix,aRect.Bottom-LFix); + TStringGrid(Sender).Canvas.Brush.Style := bsSolid; + TStringGrid(Sender).Canvas.Pen.Width := 1; + TStringGrid(Sender).Canvas.Brush.Color := Color; + TStringGrid(Sender).Canvas.Pen.Color := Color; + TStringGrid(Sender).Canvas.Rectangle(aRect); + if CheckBoxDrawDots.Checked then + if (Odd(aRow + RowBase) and not Odd(aCol)) or + (not Odd(aRow + RowBase) and Odd(aCol)) then + DrawDots; end; begin OldCanvas := TCanvas.Create; SaveOldCanvas; try - if (aCol <> 0) and (aRow <> 0) then + if (aCol <> 0) then begin - if (aRow = 1) or (aRow = 8) then DrawLines(clYellow,gdSelected in aState); - if (aRow = 2) or (aRow = 7) then DrawLines($00FF00,gdSelected in aState); - if (aRow = 3) or (aRow = 6) then DrawLines(clRed,gdSelected in aState); - if (aRow = 4) or (aRow = 9) then DrawLines(clBlue,gdSelected in aState); - if (aRow = 5) or (aRow = 10) then DrawLines($FF00FF,gdSelected in aState); - - if CheckBoxDrawDots.Checked then - if (Odd(aRow) and Odd(aCol)) or - (not Odd(aRow) and not Odd(aCol)) then - DrawDots; - - LoadOldCanvas; + if (aRow = RowBase) or (aRow = (RowBase + 5)) then DrawLines(ccYellow); + if (aRow = RowBase + 1) or (aRow = (RowBase + 6)) then DrawLines(ccGreen); + if (aRow = RowBase + 2) or (aRow = (RowBase + 7)) then DrawLines(ccRed); + if (aRow = RowBase + 3) or (aRow = (RowBase + 8)) then DrawLines(ccBlue); + if (aRow = RowBase + 4) or (aRow = (RowBase + 9)) then DrawLines(ccMagenta); end; + + if (aCol <> 0) then + if (gdSelected in aState) and MustDrawSelection then + begin + TStringGrid(Sender).Canvas.Pen.Width := 10; + TStringGrid(Sender).Canvas.Pen.Color := clWhite; + if (aRow = TStringGrid(Sender).Selection.Top) and (aCol = TStringGrid(Sender).Selection.Left) then + begin + TStringGrid(Sender).Canvas.PenPos := aRect.TopLeft; + TStringGrid(Sender).Canvas.LineTo(Point(aRect.Left,aRect.Bottom)); + end; + TStringGrid(Sender).Canvas.PenPos := aRect.BottomRight; + TStringGrid(Sender).Canvas.LineTo(Point(aRect.Left,aRect.Bottom)); + TStringGrid(Sender).Canvas.PenPos := aRect.TopLeft; + TStringGrid(Sender).Canvas.LineTo(Point(aRect.Right,aRect.Top)); + + if (aRow = TStringGrid(Sender).Selection.Top) and (aCol = TStringGrid(Sender).Selection.Right) then + begin + TStringGrid(Sender).Canvas.PenPos := aRect.BottomRight; + TStringGrid(Sender).Canvas.LineTo(Point(aRect.Right,aRect.Top)); + end; + end; finally + LoadOldCanvas; OldCanvas.Free; end; end; + procedure TForm1.CheckBoxDrawDotsChange(Sender: TObject); begin - StringGrid1.Invalidate; + StringGridMatrix.Invalidate; +end; + +procedure TForm1.rgMatrixTypeClick(Sender: TObject); + + procedure WriteGridFixedNames(AStringGrid: TStringGrid; WriteCols: boolean); + var + i: integer; + begin + with AStringGrid do + for i := 0 to 9 do + begin + Cells[0, i + RowBase] := IntToStr(i + 1); + if WriteCols then + Cells[i + 1, 0] := chr(65 + i); + end; + end; + +begin + case rgMatrixType.ItemIndex of + // rows only + 0: + begin + StringGridMatrix.Clean; + StringGridMatrix.FixedRows := 0; + StringGridMatrix.RowCount := 10; + StringGridMatrix.Options := [goFixedHorzLine, goHorzLine, goDrawFocusSelected, goRowSelect]; + RowBase := 0; + WriteGridFixedNames(StringGridMatrix, False); + end; + // rows and cols + 1: + begin + StringGridMatrix.Clean; + StringGridMatrix.FixedRows := 1; + StringGridMatrix.RowCount := 11; + StringGridMatrix.Options := [goFixedHorzLine, goHorzLine, goDrawFocusSelected, goRowSelect, goVertLine]; + RowBase := 1; + WriteGridFixedNames(StringGridMatrix, True); + end; + end; + +end; + +procedure TForm1.StringGridMatrixBeforeSelection(Sender: TObject; aCol, aRow: integer); +begin + if MustDrawSelection then Exit; + MustDrawSelection := True; end; procedure TForm1.Button1Click(Sender: TObject); begin - ShowMessage('Hello world'); + StringGridMatrix.ClearSelections; + MustDrawSelection := False; + StringGridMatrix.Invalidate; end; end. - -- libgit2 0.21.2