Özel StringGrid Bileşen Yazmak İstiyorum [İlk Adım Kısmen Yapıldı] - Baskı Önizleme +- Delphi Can (https://www.delphican.com) +-- Forum: Forum Hakkında & İnsan Kaynakları (https://www.delphican.com/forumdisplay.php?fid=115) +--- Forum: Görüş & Öneri ve Yorum (https://www.delphican.com/forumdisplay.php?fid=116) +--- Konu Başlığı: Özel StringGrid Bileşen Yazmak İstiyorum [İlk Adım Kısmen Yapıldı] (/showthread.php?tid=5140) Sayfalar:
1
2
|
Özel StringGrid Bileşen Yazmak İstiyorum [İlk Adım Kısmen Yapıldı] - 3ddark - 01-08-2020 Kendime özel ana TStringgrid sınıfından üretilmiş bir sınıf yazmak istiyorum. Genel olarak bir Stringgrid için Hangi özellikler olmalı. Görüş ve önerileriniz nelerdir. Basit olacak kompleks bir yapı düşünmüyorum. Özelliğim çizim ve görsellik sadece toplam için ek bir özellik düşünüyorum. Aklımdaki özellikler her hücre için ayrı olacak ayar özelliği
KOMPONENT KODU 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.[attachment=1290] Özel StringGrid Bileşen Yazmak İstiyorum - uparlayan - 01-08-2020 Aklıma gelenler;
Cvp: Özel StringGrid Bileşen Yazmak İstiyorum - cinarbil - 02-08-2020 (01-08-2020, Saat: 15:48)3ddark Adlı Kullanıcıdan Alıntı: Kendime özel ana TStringgrid sınıfından üretilmiş bir sınıf yazmak istiyorum. Satır ve sütun başlıklarını özelleştirme
Özel StringGrid Bileşen Yazmak İstiyorum - Hayati - 02-08-2020 Open source olmasi Özel StringGrid Bileşen Yazmak İstiyorum - mrmarman - 02-08-2020 Merhaba birkaç inci de benden Çift satır başlık faydalı olur, Başlıklarda seçili sütunlar birleşerek ana ve alt başlık mantığı oluşturulabilmeli. Özel StringGrid Bileşen Yazmak İstiyorum - narkotik - 04-08-2020 Çoğu özelliği yazmışlar birkaç tane de benden, Datasource bağlantısı olmadan bir SQL özelliği ile sorgunun yazılması Open ile açılması Otomatik kolon genişliği Checkbox ile multiselect işlemi Satır numarası Özel StringGrid Bileşen Yazmak İstiyorum - 3ddark - 04-08-2020 Öneriler için çok teşekkür ederim. Fakat tam zamanlı olarak çalışıyorum ve kadar özelliğin bir arada kullanıma sunulması oldukça zor ve meşakkatli olacaktır. Destek verecek arkadaşlar olursa tabi ki yapılabilir. Fakat ben vaktim çerçevesinde elimden geldiği kadar bir şeyler yapmaya çalışacağım. Ortaya elle tutulur bir şeyler çıktında projeyi GitHub üzerinde yayınlayacağım. İhtiyacı olan arkadaşlar veya daha ileri taşımak isteyenler GitHub üzerinden erişebilecek. Bu işin ilk aklıma gelme noktası, özellikle boyama işlemlerini sürekli bir sürü kod yazarak yapmak yerine bir bileşene çevirerek daha basit bir şekilde yapılmasıydı. Bir StyleContainer listesi düşünün. Kullanıcının tanımladığı Stiler burada olacak. Bu stilleri hangi hücrelere/sütunlara uygulamak istediğini belirtecek ve hızlı bir şekilde kod içinde boğulmadan bileşen kendi başına boyama işlemini yapacak. İsterse OnDrawCell ile mevcut stili ezerek kendi özel boyama kodunu ekleyecek. Aklımda yapının bitiminde eklenmiş olan özelliklerde basitten(kısa sürede bitecek olandan) zora doğru ilerlemeye çalışacağım. Cvp: Özel StringGrid Bileşen Yazmak İstiyorum - Mr.Developer - 04-08-2020 Bende kullanıcı gözünden bakıp tasarımsal öneri de bulunmak isterim ; Sonuç olarak ne kadar muazzam bir iş başarsanız bile kullanıcı, gözünün gördüğünü yorumlar. Kullanıcı için yazdığınız kodların eklediğiniz hayat kurtarıcı özelliklerin çabanızın ve azminizin neredeyse hiçbir anlamı yoktur. Bu yüzden şahsım adına ilk öncelik hep tasarım oldu çünkü uygulama içeriğiniz boş bile olsa tasarım sayesinde dolu gösterme imkanına sahipsiniz. Sadece bir butonla bir uygulamayı vazgeçilmez yapabilirsiniz yeter ki etkileyici bir tasarımı olsun : El feneri uygulamaları gibi... ( O uygulamaların indirme ve yorumlarını düşündükçe ve gördükçe sinir damarlarım hareketleniyor ) Gelelim yaptığım tasarıma ; Bir gün gerçek olur mu acaba [attachment=1254] Cvp: Özel StringGrid Bileşen Yazmak İstiyorum - nguzeller - 04-08-2020 (04-08-2020, Saat: 16:10)Mr.Developer Adlı Kullanıcıdan Alıntı: Bende kullanıcı gözünden bakıp tasarımsal öneri de bulunmak isterim ; OrangeUI kullara bu tip sistemleri çok rahat yapabilirsin çokta kullanışlı oluyor. öğrememe sürece zahmetli oluyor. Cvp: Özel StringGrid Bileşen Yazmak İstiyorum - Mr.Developer - 04-08-2020 @nguzeller OrangeUI kullanma taraftarı değilim hocam. öneri ve bilgi için teşekkür ederim. |