KOMPONENT KODU
KULLANIMI
unit thsStringGrid; interface uses System.SysUtils , System.Classes , System.Types , System.Generics.Collections , Vcl.Graphics , Vcl.Controls , Vcl.Grids , Winapi.Messages // , DesignIntf // , DesignEditors ; type TThsStringGrid = class; TStyleValue = (svFont, svColor, svTextAlign, svBorder); TStyleValues = set of TStyleValue; TThsCellDataType = (ctString, ctInteger, ctDouble, ctDate, ctTime, ctDateTime, ctBcd); TThsRowType = (rtHeader, rtFooter, rtRow, rtTitle, rtSubTitle); TThsBorder = class(TPersistent) private FEnable: Boolean; FColor: TColor; FWidth: Integer; function GetColor: TColor; function GetEnable: Boolean; function GetWidth: Integer; procedure SetColor(const Value: TColor); procedure SetEnable(const Value: Boolean); procedure SetWidth(const Value: Integer); published property Enable: Boolean read GetEnable write SetEnable; property Color: TColor read GetColor write SetColor; property Width: Integer read GetWidth write SetWidth; end; TThsCellBorder = class(TPersistent) private FLeft: TThsBorder; FRight: TThsBorder; FTop: TThsBorder; FBottom: TThsBorder; function GetBottom: TThsBorder; function GetLeft: TThsBorder; function GetRight: TThsBorder; function GetTop: TThsBorder; procedure SetBottom(const Value: TThsBorder); procedure SetLeft(const Value: TThsBorder); procedure SetRight(const Value: TThsBorder); procedure SetTop(const Value: TThsBorder); public constructor Create; destructor Destroy; override; published property Left: TThsBorder read GetLeft write SetLeft; property Right: TThsBorder read GetRight write SetRight; property Top: TThsBorder read GetTop write SetTop; property Bottom: TThsBorder read GetBottom write SetBottom; end; TThsStyle = class(TPersistent) private FFont: TFont; FColor: TColor; FTextAlign: TAlignment; FBorder: TThsCellBorder; FBorderActive: Boolean; FStyleName: string; published public constructor Create; destructor Destroy; override; procedure Assign(Source: TPersistent); override; published property Font: TFont read FFont write FFont; property Color: TColor read FColor write FColor; property TextAlign: TAlignment read FTextAlign write FTextAlign; property Border: TThsCellBorder read FBorder write FBorder; property BorderActive: Boolean read FBorderActive write FBorderActive; property StyleName: string read FStyleName write FStyleName; end; TThsStyledCell = class(TPersistent) private FRowNo: Integer; FColNo: Integer; FStyle: TThsStyle; function GetColNo: Integer; function GetRowNo: Integer; function GetStyle: TThsStyle; procedure SetColNo(const Value: Integer); procedure SetRowNo(const Value: Integer); procedure SetStyle(const Value: TThsStyle); public destructor Destroy; override; published property RowNo: Integer read GetRowNo write SetRowNo; property ColNo: Integer read GetColNo write SetColNo; property Style: TThsStyle read GetStyle write SetStyle; end; TThsStyledRow = class(TPersistent) private FRowStartNo: Integer; FRowEndNo: Integer; FStyle: TThsStyle; FRowType: TThsRowType; function GetRowStartNo: Integer; function GetRowEndNo: Integer; function GetStyle: TThsStyle; procedure SetRowStartNo(const Value: Integer); procedure SetRowEndNo(const Value: Integer); procedure SetStyle(const Value: TThsStyle); function GetRowType: TThsRowType; procedure SetRowType(const Value: TThsRowType); public constructor Create(); destructor Destroy; override; published property RowStartNo: Integer read GetRowStartNo write SetRowStartNo; property RowEndNo: Integer read GetRowEndNo write SetRowEndNo; property Style: TThsStyle read GetStyle write SetStyle; property RowType: TThsRowType read GetRowType write SetRowType; end; TThsStyledCol = class(TPersistent) private FColNo: Integer; FStyle: TThsStyle; function GetColNo: Integer; function GetStyle: TThsStyle; procedure SetColNo(const Value: Integer); procedure SetStyle(const Value: TThsStyle); public constructor Create(); destructor Destroy; override; published property ColNo: Integer read GetColNo write SetColNo; property Style: TThsStyle read GetStyle write SetStyle; end; TThsStringGrid = class(TStringGrid) private FStyledCellItems: TObjectList<TThsStyledCell>; FStyledRowItems: TObjectList<TThsStyledRow>; FStyledColItems: TObjectList<TThsStyledCol>; function GetStyledCellItems: TObjectList<TThsStyledCell>; procedure SetStyledCellItems(const Value: TObjectList<TThsStyledCell>); function GetStyledRowItems: TObjectList<TThsStyledRow>; procedure SetStyledRowItems(const Value: TObjectList<TThsStyledRow>); function GetStyledColItems: TObjectList<TThsStyledCol>; procedure SetStyledColItems(const Value: TObjectList<TThsStyledCol>); protected procedure DrawCell(ACol: Integer; ARow: Integer; ARect: TRect; AState: TGridDrawState); override; procedure ColumnMoved(FromIndex: Integer; ToIndex: Integer); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure ClearAllStyle(); procedure ClearCellStyle(); procedure ClearRowStyle(); procedure ClearColStyle(); function GetStyledCellItem(Index: Integer): TThsStyledCell; function GetStyleFromStyledCells(Index: Integer): TThsStyle; function ExistsStyledCellItem(ARow, ACol: Integer): Integer; property StyledCellItems: TObjectList<TThsStyledCell> read GetStyledCellItems write SetStyledCellItems; function AddStyledCell: TThsStyledCell; function GetStyledRowItem(Index: Integer): TThsStyledRow; function GetStyleFromStyledRows(Index: Integer): TThsStyle; function ExistsStyledRowItem(ARow: Integer): Integer; property StyledRowItems: TObjectList<TThsStyledRow> read GetStyledRowItems write SetStyledRowItems; function AddStyledRow: TThsStyledRow; function GetStyledColItem(Index: Integer): TThsStyledCol; function GetStyleFromStyledCols(Index: Integer): TThsStyle; function ExistsStyledColItem(ACol: Integer): Integer; property StyledColItems: TObjectList<TThsStyledCol> read GetStyledColItems write SetStyledColItems; function AddStyledCol: TThsStyledCol; end; { type TThsStringGridMenu = class(TComponentEditor) function GetVerbCount: Integer; override; function GetVerb(index: Integer): String; override; procedure ExecuteVerb(Index: Integer); override; end; } procedure Register; implementation uses Vcl.Dialogs; procedure Register; begin RegisterComponents('Ths Component Set', [TThsStringGrid]); // RegisterComponentEditor(TThsStringGrid, TThsStringGridMenu) end; { TThsBorder } function TThsBorder.GetColor: TColor; begin Result := FColor; end; function TThsBorder.GetEnable: Boolean; begin Result := FEnable; end; function TThsBorder.GetWidth: Integer; begin Result := FWidth; end; procedure TThsBorder.SetColor(const Value: TColor); begin FColor := Value; end; procedure TThsBorder.SetEnable(const Value: Boolean); begin FEnable := Value; end; procedure TThsBorder.SetWidth(const Value: Integer); begin FWidth := Value; end; { TThsCellBorder } constructor TThsCellBorder.Create(); begin inherited; FLeft := TThsBorder.Create; FRight := TThsBorder.Create; FTop := TThsBorder.Create; FBottom := TThsBorder.Create; end; destructor TThsCellBorder.Destroy; begin if FLeft <> nil then FreeAndNil(FLeft); if FRight <> nil then FreeAndNil(FRight); if FTop <> nil then FreeAndNil(FTop); if FBottom <> nil then FreeAndNil(FBottom); inherited; end; function TThsCellBorder.GetBottom: TThsBorder; begin Result := FBottom; end; function TThsCellBorder.GetLeft: TThsBorder; begin Result := FLeft; end; function TThsCellBorder.GetRight: TThsBorder; begin Result := FRight; end; function TThsCellBorder.GetTop: TThsBorder; begin Result := FTop; end; procedure TThsCellBorder.SetBottom(const Value: TThsBorder); begin FBottom.Assign(Value); end; procedure TThsCellBorder.SetLeft(const Value: TThsBorder); begin FLeft.Assign(Value); end; procedure TThsCellBorder.SetRight(const Value: TThsBorder); begin FRight.AssignTo(Value); end; procedure TThsCellBorder.SetTop(const Value: TThsBorder); begin FTop.Assign(Value); end; { TThsStyle } procedure TThsStyle.Assign(Source: TPersistent); begin if Source is TThsStyle then begin Self.FFont.Color := TThsStyle(Source).Font.Color; Self.FFont.Name := TThsStyle(Source).Font.Name; Self.FFont.Size := TThsStyle(Source).Font.Size; Self.FFont.Style := TThsStyle(Source).Font.Style; Self.FColor := TThsStyle(Source).Color; Self.FTextAlign := TThsStyle(Source).TextAlign; Self.FBorderActive := TThsStyle(Source).BorderActive; Self.FBorder.Left.Enable := TThsStyle(Source).Border.Left.Enable; Self.FBorder.Left.Color := TThsStyle(Source).Border.Left.Color; Self.FBorder.Left.Width := TThsStyle(Source).Border.Left.Width; Self.FBorder.Right.Enable := TThsStyle(Source).Border.Right.Enable; Self.FBorder.Right.Color := TThsStyle(Source).Border.Right.Color; Self.FBorder.Right.Width := TThsStyle(Source).Border.Right.Width; Self.FBorder.Top.Enable := TThsStyle(Source).Border.Top.Enable; Self.FBorder.Top.Color := TThsStyle(Source).Border.Top.Color; Self.FBorder.Top.Width := TThsStyle(Source).Border.Top.Width; Self.FBorder.Bottom.Enable := TThsStyle(Source).Border.Bottom.Enable; Self.FBorder.Bottom.Color := TThsStyle(Source).Border.Bottom.Color; Self.FBorder.Bottom.Width := TThsStyle(Source).Border.Bottom.Width; end else inherited; end; constructor TThsStyle.Create(); begin FFont := TFont.Create; FColor := clWhite; FTextAlign := taLeftJustify; FBorder := TThsCellBorder.Create; FBorderActive := False; end; destructor TThsStyle.Destroy; begin if FFont <> nil then FreeAndNil(FFont); if FBorder <> nil then FreeAndNil(FBorder); inherited; end; { TThsStyledCell } destructor TThsStyledCell.Destroy; begin if FStyle <> nil then FreeAndNil(FStyle); inherited; end; function TThsStyledCell.GetColNo: Integer; begin Result := FColNo; end; function TThsStyledCell.GetRowNo: Integer; begin Result := FRowNo; end; function TThsStyledCell.GetStyle: TThsStyle; begin Result := FStyle; end; procedure TThsStyledCell.SetColNo(const Value: Integer); begin FColNo := Value; end; procedure TThsStyledCell.SetRowNo(const Value: Integer); begin FRowNo := Value; end; procedure TThsStyledCell.SetStyle(const Value: TThsStyle); begin FStyle := Value; end; { TThsStyledCol } constructor TThsStyledCol.Create(); begin inherited; end; destructor TThsStyledCol.Destroy; begin if FStyle <> nil then FreeAndNil(FStyle); inherited; end; function TThsStyledCol.GetColNo: Integer; begin Result := FColNo; end; function TThsStyledCol.GetStyle: TThsStyle; begin Result := FStyle; end; procedure TThsStyledCol.SetColNo(const Value: Integer); begin FColNo := Value; end; procedure TThsStyledCol.SetStyle(const Value: TThsStyle); begin FStyle := Value; end; { TThsStyledRow } constructor TThsStyledRow.Create(); begin inherited; FRowType := rtRow; end; function TThsStyledRow.GetRowStartNo: Integer; begin Result := FRowStartNo; end; destructor TThsStyledRow.Destroy; begin if FStyle <> nil then FreeAndNil(FStyle); inherited; end; function TThsStyledRow.GetRowEndNo: Integer; begin Result := FRowEndNo; end; function TThsStyledRow.GetStyle: TThsStyle; begin Result := FStyle; end; function TThsStyledRow.GetRowType: TThsRowType; begin Result := FRowType; end; procedure TThsStyledRow.SetRowStartNo(const Value: Integer); begin FRowStartNo := Value; end; procedure TThsStyledRow.SetRowEndNo(const Value: Integer); begin FRowEndNo := Value; end; procedure TThsStyledRow.SetStyle(const Value: TThsStyle); begin FStyle := Value; end; procedure TThsStyledRow.SetRowType(const Value: TThsRowType); begin FRowType := Value; end; { TThsStringGrid } function TThsStringGrid.AddStyledCell: TThsStyledCell; begin Result := TThsStyledCell.Create; FStyledCellItems.Add(Result); end; function TThsStringGrid.AddStyledCol: TThsStyledCol; begin Result := TThsStyledCol.Create; FStyledColItems.Add(Result); end; function TThsStringGrid.AddStyledRow: TThsStyledRow; begin Result := TThsStyledRow.Create; FStyledRowItems.Add(Result); end; procedure TThsStringGrid.ClearAllStyle; var n1: Integer; begin Perform(WM_SETREDRAW, 0, 0); try for n1 := StyledCellItems.Count-1 downto 0 do StyledCellItems.Delete(n1); for n1 := StyledRowItems.Count-1 downto 0 do StyledRowItems.Delete(n1); for n1 := StyledColItems.Count-1 downto 0 do StyledColItems.Delete(n1); finally Perform(WM_SETREDRAW, 1, 0); Invalidate; end; end; procedure TThsStringGrid.ClearCellStyle; var n1: Integer; begin Perform(WM_SETREDRAW, 0, 0); try for n1 := StyledCellItems.Count-1 downto 0 do StyledCellItems.Delete(n1); finally Perform(WM_SETREDRAW, 1, 0); Invalidate; end; end; procedure TThsStringGrid.ClearColStyle; var n1: Integer; begin Perform(WM_SETREDRAW, 0, 0); try for n1 := StyledColItems.Count-1 downto 0 do StyledColItems.Delete(n1); finally Perform(WM_SETREDRAW, 1, 0); Invalidate; end; end; procedure TThsStringGrid.ClearRowStyle; var n1: Integer; begin Perform(WM_SETREDRAW, 0, 0); try for n1 := StyledRowItems.Count-1 downto 0 do StyledRowItems.Delete(n1); finally Perform(WM_SETREDRAW, 1, 0); Invalidate; end; end; procedure TThsStringGrid.ColumnMoved(FromIndex, ToIndex: Integer); var n1, Len: Integer; IsFromStyled, IsToStyled: Boolean; LFromStyleIdx, LToStyleIdx, LFromCol, LToCol: Integer; begin inherited; LFromStyleIdx := -1; LToStyleIdx := -1; Len := FStyledColItems.Count-1; for n1 := 0 to Len do if (FStyledColItems.Items[n1].ColNo = FromIndex) then begin LFromStyleIdx := n1; IsFromStyled := True; end; for n1 := 0 to Len do if (FStyledColItems.Items[n1].ColNo = ToIndex) then begin LToStyleIdx := n1; IsToStyled := True; end; if IsFromStyled and not IsToStyled then FStyledColItems.Items[LFromStyleIdx].ColNo := ToIndex; if not IsFromStyled and IsToStyled then FStyledColItems.Items[LToStyleIdx].ColNo := FromIndex; if IsFromStyled and IsToStyled then begin FStyledColItems.Items[LFromStyleIdx].ColNo := ToIndex; FStyledColItems.Items[LToStyleIdx].ColNo := FromIndex; end; Self.Invalidate; end; constructor TThsStringGrid.Create(AOwner: TComponent); begin inherited Create(AOwner); Self.DoubleBuffered := True; FStyledCellItems := TObjectList<TThsStyledCell>.Create; FStyledRowItems := TObjectList<TThsStyledRow>.Create; FStyledColItems := TObjectList<TThsStyledCol>.Create; end; destructor TThsStringGrid.Destroy; begin FStyledCellItems.Free; FStyledRowItems.Free; FStyledColItems.Free; inherited; end; procedure TThsStringGrid.DrawCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); var vTextWidth, vTextHeight, vTop, vLeft: Integer; vValue: string; AStyle: TThsStyle; LStyleIdx: Integer; LLineL, LLineR, LLineT, LLineB: Integer; begin inherited; if not (csDesigning in Self.ComponentState) then begin Rows[ARow].BeginUpdate; Cols[ACol].BeginUpdate; try vLeft := ARect.Left; //col style LStyleIdx := ExistsStyledColItem(ACol); if LStyleIdx > -1 then begin LLineL := 0; LLineR := 0; LLineT := 0; LLineB := 0; AStyle := GetStyleFromStyledCols(LStyleIdx); if AStyle <> nil then begin if AStyle.BorderActive then begin if AStyle.Border.Left.Enable then LLineL := AStyle.FBorder.FLeft.Width; if AStyle.Border.Right.Enable then LLineR := AStyle.Border.Right.Width; if AStyle.Border.Top.Enable then LLineT := AStyle.Border.Top.Width; if AStyle.Border.Bottom.Enable then LLineB := AStyle.Border.Bottom.Width; end; Canvas.Font := AStyle.Font; Canvas.Brush.Color := AStyle.Color; ARect.Left := ARect.Left + LLineL; ARect.Right := ARect.Right - LLineR; ARect.Top := ARect.Top + LLineT; ARect.Bottom := ARect.Bottom - LLineB; if gdSelected in AState then begin Canvas.Brush.Color := clHighlight; end; Canvas.FillRect(ARect); vValue := Cells[ACol, ARow]; vTextWidth := Canvas.TextWidth(vValue); vTextHeight := Canvas.TextHeight(vValue); vTop := (ARect.Height - vTextHeight) div 2; vTop := ARect.Top + vTop; if AStyle.TextAlign = taLeftJustify then vLeft := ARect.Left else if AStyle.TextAlign = taRightJustify then vLeft := ARect.Left + ColWidths[ACol] - vTextWidth - 6 else if AStyle.TextAlign = taCenter then vLeft := ARect.Left + (ARect.Width - vTextWidth) div 2; Canvas.TextRect(ARect, vLeft, vTop, vValue); if AStyle.BorderActive and not (gdSelected in AState) then begin if AStyle.Border.Left.Enable then begin Canvas.Pen.Width := AStyle.Border.FLeft.Width; Canvas.Pen.Color := AStyle.Border.FLeft.Color; Canvas.MoveTo(ARect.Left, ARect.Top); Canvas.LineTo(ARect.Left, ARect.Bottom); end; if AStyle.Border.Right.Enable then begin Canvas.Pen.Width := AStyle.Border.Right.Width; Canvas.Pen.Color := AStyle.Border.Right.Color; Canvas.MoveTo(ARect.Right, ARect.Top); Canvas.LineTo(ARect.Right, ARect.Bottom); end; if AStyle.Border.Top.Enable then begin Canvas.Pen.Width := AStyle.Border.Top.Width; Canvas.Pen.Color := AStyle.Border.Top.Color; Canvas.MoveTo(ARect.Left, ARect.Top); Canvas.LineTo(ARect.Right, ARect.Top); end; if AStyle.Border.Bottom.Enable then begin Canvas.Pen.Width := AStyle.Border.Bottom.Width; Canvas.Pen.Color := AStyle.Border.Bottom.Color; Canvas.MoveTo(ARect.Left, ARect.Bottom); Canvas.LineTo(ARect.Right, ARect.Bottom); end; end; if ColWidths[ACol] < vTextWidth then ColWidths[ACol] := vTextWidth + LLineL + LLineR; end; end; //row style LStyleIdx := ExistsStyledRowItem(ARow); if LStyleIdx > -1 then begin LLineL := 0; LLineR := 0; LLineT := 0; LLineB := 0; AStyle := GetStyleFromStyledRows(LStyleIdx); if AStyle <> nil then begin if AStyle.BorderActive then begin if AStyle.Border.Left.Enable then LLineL := AStyle.Border.Left.Width; if AStyle.Border.Right.Enable then LLineR := AStyle.Border.Right.Width; if AStyle.Border.Top.Enable then LLineT := AStyle.Border.Top.Width; if AStyle.Border.Bottom.Enable then LLineB := AStyle.Border.Bottom.Width; end; Canvas.Font := AStyle.Font; Canvas.Brush.Color := AStyle.Color; ARect.Left := ARect.Left + LLineL; ARect.Right := ARect.Right - LLineR; ARect.Top := ARect.Top + LLineT; ARect.Bottom := ARect.Bottom - LLineB; if gdSelected in AState then begin Canvas.Brush.Color := clHighlight; end; Canvas.FillRect(ARect); vValue := Cells[ACol, ARow]; vTextWidth := Canvas.TextWidth(vValue); vTextHeight := Canvas.TextHeight(vValue); vTop := (ARect.Height - vTextHeight) div 2; vTop := ARect.Top + vTop; if AStyle.TextAlign = taLeftJustify then vLeft := ARect.Left else if AStyle.TextAlign = taRightJustify then vLeft := ARect.Left + ColWidths[ACol] - vTextWidth - 6 else if AStyle.TextAlign = taCenter then vLeft := ARect.Left + (ARect.Width - vTextWidth) div 2; Canvas.TextRect(ARect, vLeft, vTop, vValue); if AStyle.BorderActive and not (gdSelected in AState) then begin if AStyle.Border.Left.Enable then begin Canvas.Pen.Width := AStyle.Border.FLeft.Width; Canvas.Pen.Color := AStyle.Border.FLeft.Color; Canvas.MoveTo(ARect.Left, ARect.Top); Canvas.LineTo(ARect.Left, ARect.Bottom); end; if AStyle.Border.Right.Enable then begin Canvas.Pen.Width := AStyle.Border.Right.Width; Canvas.Pen.Color := AStyle.Border.Right.Color; Canvas.MoveTo(ARect.Right, ARect.Top); Canvas.LineTo(ARect.Right, ARect.Bottom); end; if AStyle.Border.Top.Enable then begin Canvas.Pen.Width := AStyle.Border.Top.Width; Canvas.Pen.Color := AStyle.Border.Top.Color; Canvas.MoveTo(ARect.Left, ARect.Top); Canvas.LineTo(ARect.Right, ARect.Top); end; if AStyle.Border.Bottom.Enable then begin Canvas.Pen.Width := AStyle.Border.Bottom.Width; Canvas.Pen.Color := AStyle.Border.Bottom.Color; Canvas.MoveTo(ARect.Left, ARect.Bottom); Canvas.LineTo(ARect.Right, ARect.Bottom); end; end; if RowHeights[ARow] < vTextHeight then RowHeights[ARow] := vTextHeight + LLineT + LLineB; end; end; //cell style LStyleIdx := ExistsStyledCellItem(ARow, ACol); if LStyleIdx > -1 then begin LLineL := 0; LLineR := 0; LLineT := 0; LLineB := 0; AStyle := GetStyleFromStyledCells(LStyleIdx); if AStyle <> nil then begin if AStyle.BorderActive then begin if AStyle.Border.Left.Enable then LLineL := AStyle.Border.Left.Width; if AStyle.Border.Right.Enable then LLineR := AStyle.Border.Right.Width; if AStyle.Border.Top.Enable then LLineT := AStyle.Border.Top.Width; if AStyle.Border.Bottom.Enable then LLineB := AStyle.Border.Bottom.Width; end; Canvas.Font := AStyle.Font; Canvas.Brush.Color := AStyle.Color; ARect.Left := ARect.Left + LLineL; ARect.Right := ARect.Right - LLineR; ARect.Top := ARect.Top + LLineT; ARect.Bottom := ARect.Bottom - LLineB; if gdSelected in AState then begin Canvas.Brush.Color := clHighlight; end; Canvas.FillRect(ARect); vValue := Cells[ACol, ARow]; vTextWidth := Canvas.TextWidth(vValue); vTextHeight := Canvas.TextHeight(vValue); vTop := (ARect.Height - vTextHeight) div 2; vTop := ARect.Top + vTop; if AStyle.TextAlign = taLeftJustify then vLeft := ARect.Left else if AStyle.TextAlign = taRightJustify then vLeft := ARect.Left + ColWidths[ACol] - vTextWidth - 6 else if AStyle.TextAlign = taCenter then vLeft := ARect.Left + (ARect.Width - vTextWidth) div 2; Canvas.TextRect(ARect, vLeft, vTop, vValue); if AStyle.BorderActive and not (gdSelected in AState) then begin if AStyle.Border.Left.Enable then begin Canvas.Pen.Width := AStyle.Border.FLeft.Width; Canvas.Pen.Color := AStyle.Border.FLeft.Color; Canvas.MoveTo(ARect.Left, ARect.Top); Canvas.LineTo(ARect.Left, ARect.Bottom); end; if AStyle.Border.Right.Enable then begin Canvas.Pen.Width := AStyle.Border.Right.Width; Canvas.Pen.Color := AStyle.Border.Right.Color; Canvas.MoveTo(ARect.Right, ARect.Top); Canvas.LineTo(ARect.Right, ARect.Bottom); end; if AStyle.Border.Top.Enable then begin Canvas.Pen.Width := AStyle.Border.Top.Width; Canvas.Pen.Color := AStyle.Border.Top.Color; Canvas.MoveTo(ARect.Left, ARect.Top); Canvas.LineTo(ARect.Right, ARect.Top); end; if AStyle.Border.Bottom.Enable then begin Canvas.Pen.Width := AStyle.Border.Bottom.Width; Canvas.Pen.Color := AStyle.Border.Bottom.Color; Canvas.MoveTo(ARect.Left, ARect.Bottom); Canvas.LineTo(ARect.Right, ARect.Bottom); end; end; if RowHeights[ARow] < vTextHeight then RowHeights[ARow] := vTextHeight + LLineT + LLineB; end; end; finally Rows[ARow].EndUpdate; Cols[ACol].EndUpdate; end; end; end; function TThsStringGrid.ExistsStyledCellItem(ARow, ACol: Integer): Integer; var n1, Len: Integer; begin Result := -1; Len := FStyledCellItems.Count-1; for n1 := 0 to Len do begin if (FStyledCellItems.Items[n1].RowNo = ARow) and (FStyledCellItems.Items[n1].ColNo = ACol) then begin Result := n1; Break; end; end; end; function TThsStringGrid.GetStyledCellItem(Index: Integer): TThsStyledCell; begin Result := nil; if Assigned(FStyledCellItems.Items[Index]) then Result := FStyledCellItems.Items[Index]; end; function TThsStringGrid.GetStyledCellItems: TObjectList<TThsStyledCell>; begin Result := FStyledCellItems; end; function TThsStringGrid.GetStyleFromStyledCells(Index: Integer): TThsStyle; begin Result := nil; if Assigned(FStyledCellItems.Items[Index]) then Result := FStyledCellItems.Items[Index].Style; end; procedure TThsStringGrid.SetStyledCellItems(const Value: TObjectList<TThsStyledCell>); begin FStyledCellItems := Value; end; function TThsStringGrid.ExistsStyledColItem(ACol: Integer): Integer; var n1, Len: Integer; begin Result := -1; Len := FStyledColItems.Count-1; for n1 := 0 to Len do if (FStyledColItems.Items[n1].ColNo = ACol) then Result := n1; end; function TThsStringGrid.GetStyledColItem(Index: Integer): TThsStyledCol; begin Result := nil; if Assigned(FStyledColItems.Items[Index]) then Result := FStyledColItems.Items[Index]; end; function TThsStringGrid.GetStyledColItems: TObjectList<TThsStyledCol>; begin Result := FStyledColItems; end; function TThsStringGrid.GetStyleFromStyledCols(Index: Integer): TThsStyle; begin Result := nil; if Assigned(FStyledColItems.Items[Index]) then Result := FStyledColItems.Items[Index].Style; end; procedure TThsStringGrid.SetStyledColItems(const Value: TObjectList<TThsStyledCol>); begin FStyledColItems := Value; end; function TThsStringGrid.ExistsStyledRowItem(ARow: Integer): Integer; var n1, Len: Integer; begin Result := -1; Len := FStyledRowItems.Count-1; for n1 := 0 to Len do if (FStyledRowItems.Items[n1].RowStartNo <= ARow) and (FStyledRowItems.Items[n1].RowEndNo >= ARow) then Result := n1; end; function TThsStringGrid.GetStyledRowItem(Index: Integer): TThsStyledRow; begin Result := nil; if Assigned(FStyledRowItems.Items[Index]) then Result := FStyledRowItems.Items[Index]; end; function TThsStringGrid.GetStyledRowItems: TObjectList<TThsStyledRow>; begin Result := FStyledRowItems; end; function TThsStringGrid.GetStyleFromStyledRows(Index: Integer): TThsStyle; begin Result := nil; if Assigned(FStyledRowItems.Items[Index]) then Result := FStyledRowItems.Items[Index].Style; end; procedure TThsStringGrid.SetStyledRowItems(const Value: TObjectList<TThsStyledRow>); begin FStyledRowItems := Value; end; { TThsStringGridMenu procedure TThsStringGridMenu.Executeverb(index: Integer); begin case index of 0: MessageDlg('TThsStringGrid © 2020 by Ferhat YILDIRIM | 3ddark', mtInformation, [mbOk], 0); end; Designer.Modified; end; function TThsStringGridMenu.GetVerb(index: Integer): String; begin case index of 0: GetVerb := '&About'; end; end; function TThsStringGridMenu.GetVerbCount: Integer; begin GetVerbCount := 1 end; } end.
KULLANIMI
unit Main; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, thsEdit, thsStringGrid, Vcl.ExtCtrls; type TFormMain = class(TForm) thsGrid1: TThsStringGrid; Splitter1: TSplitter; Panel1: TPanel; btnResetGrid: TButton; btnFillGrid: TButton; procedure btnResetGridClick(Sender: TObject); procedure btnFillGridClick(Sender: TObject); procedure thsGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); private { Private declarations } public { Public declarations } end; var FormMain: TFormMain; const COL_SIRA = 0; COL_KOD = 1; COL_ACIKLAMA = 2; COL_MIKTAR = 3; COL_BIRIM = 4; COL_FIYAT = 5; COL_TUTAR = 6; implementation {$R *.dfm} procedure TFormMain.btnFillGridClick(Sender: TObject); var nr: Integer; nc: Integer; LStyleCell, LStyleRow, LStyleCol: TThsStyle; LStyledCell: TThsStyledCell; LStyledRow: TThsStyledRow; LStyledCol: TThsStyledCol; begin //Cell LStyleCell := TThsStyle.Create; with LStyleCell do begin Font.Style := [fsBold, fsStrikeOut]; Font.Color := clBlack; Font.Size := 24; Color := $00A9E2C7; TextAlign := taLeftJustify; BorderActive := False; Border.Left.Enable := True; Border.Left.Width := 1; Border.Left.Color := $00DBBF75; Border.Right.Enable := True; Border.Right.Width := 1; Border.Right.Color := $00DBBF75; Border.Top.Enable := True; Border.Top.Width := 1; Border.Top.Color := $00DBBF75; Border.Bottom.Enable := True; Border.Bottom.Width := 1; Border.Bottom.Color := $00DBBF75; end; LStyledCell := TThsStyledCell.Create; LStyledCell.RowNo := 3; LStyledCell.ColNo := 4; LStyledCell.Style := LStyleCell; thsGrid1.StyledCellItems.Add(LStyledCell); //Row LStyleRow := TThsStyle.Create; LStyleRow.Assign(LStyleCell); LStyleRow.Color := clCream; LStyleRow.Font.Color := clBlue; LStyleRow.Font.Style := []; LStyleRow.Font.Size := 12; LStyleRow.Font.Name := 'Comic Sans MS'; LStyleRow.TextAlign := taRightJustify; LStyledRow := TThsStyledRow.Create; LStyledRow.RowStartNo := 1; LStyledRow.RowEndNo := 4; LStyledRow.Style := LStyleRow; thsGrid1.StyledRowItems.Add(LStyledRow); //Col LStyleCol := TThsStyle.Create; LStyleCol.Assign(LStyleCell); LStyleCol.Color := clNavy; LStyleCol.Font.Color := clWhite; LStyleCol.Font.Style := []; LStyleCol.Font.Size := 12; LStyleCol.Font.Name := 'Comic Sans MS'; LStyleCol.TextAlign := taRightJustify; LStyledCol := TThsStyledCol.Create; LStyledCol.ColNo := 4; LStyledCol.Style := LStyleCol; thsGrid1.StyledColItems.Add(LStyledCol); LStyleCol := TThsStyle.Create; LStyleCol.Assign(LStyleCell); LStyleCol.Color := clRed; LStyleCol.Font.Size := 10; LStyleCol.Font.Style := [fsBold]; LStyleCol.Font.Color := clWhite; LStyledCol := TThsStyledCol.Create; LStyledCol.ColNo := 5; LStyledCol.Style := LStyleCol; thsGrid1.StyledColItems.Add(LStyledCol); thsGrid1.RowCount := 10000; thsGrid1.ColCount := 10; thsGrid1.Cells[COL_SIRA, 0] := 'SIRA'; thsGrid1.Cells[COL_KOD, 0] := 'KOD'; thsGrid1.Cells[COL_ACIKLAMA, 0] := 'AÇIKLAMA'; thsGrid1.Cells[COL_MIKTAR, 0] := 'MİKTAR'; thsGrid1.Cells[COL_BIRIM, 0] := 'BİRİM'; thsGrid1.Cells[COL_FIYAT, 0] := 'FİYAT'; thsGrid1.Cells[COL_TUTAR, 0] := 'TUTAR'; for nr := 1 to thsGrid1.RowCount-1 do for nc := 0 to thsGrid1.ColCount-1 do thsGrid1.Cells[nc, nr] := ((nr * nc)).ToString; end; procedure TFormMain.btnResetGridClick(Sender: TObject); var n1: Integer; begin thsGrid1.ClearAllStyle; thsGrid1.RowCount := 2; thsGrid1.ColCount := 1; thsGrid1.Rows[0].Clear; for n1 := 0 to thsGrid1.ColCount-1 do thsGrid1.Cols[n1].Clear; end; end.
PostgreSQL - Linux - Delphi, Poliüretan