Delphi Can
Ö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
  • Font Özelliği(Font Size, Font Name, Font Color)
  • Hücre Arka Plan rengi
  • Border (Kenarlık Özelliği - Aktif & Pasif, Kalınlık ve Renk)
  • Alignment Yazı Hizalama (sağ, sol, orta)
  • Alt Toplam(istenilen sütuna ait satır başlama ve bitiş numaralarının sayısal olarak toplam değeri. Excel sum gibi).
  • Sütun veri tipi belki ileride DBGrid gibi kullanılabilir.
  • Satır Özelliği(Header, Footer, DataRow) ileride kullanışlı olabilir. Hangi satırın ne işe yaradığını belirtmek.
Başka fikri önerisi olan varsa alabilirim.

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;
  • sütun bazlı filtreleme
  • sütun bazında görünebilirlik
  • Koşul/kural bazlı filtreleme
  • hücre bazlı Koşullu renklendirme
  • hücre bazlı Koşullu görünebilirlik
  • hücre bazlı jumping
  • sütun bazlı sıralama
  • satır bazlı işaretleme / seçme
  • aranan kelimeyi vurgulama/renklendirme
  • CSV import/export



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.

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
  • Font Özelliği(Font Size, Font Name, Font Color)
  • Hücre Arka Plan rengi
  • Border (Kenarlık Özelliği - Aktif & Pasif, Kalınlık ve Renk)
  • Alignment Yazı Hizalama (sağ, sol, orta)
  • Alt Toplam(istenilen sütuna ait satır başlama ve bitiş numaralarının sayısal olarak toplam değeri. Excel sum gibi).
  • Sütun veri tipi belki ileride DBGrid gibi kullanılabilir.
  • Satır Özelliği(Header, Footer, DataRow) ileride kullanışlı olabilir. Hangi satırın ne işe yaradığını belirtmek.
Başka fikri önerisi olan varsa alabilirim.

     Satır ve sütun  başlıklarını özelleştirme
  • Font Özelliği(Font Size, Font Name, Font Color)
  • Hücre Arka Plan rengi
  • Border (Kenarlık Özelliği - Aktif & Pasif, Kalınlık ve Renk)
  • Alignment Yazı Hizalama (sağ, sol, orta)



Özel StringGrid Bileşen Yazmak İstiyorum - Hayati - 02-08-2020

Open source olmasi  Shy


Ö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.

l7d7Eb.jpg


Ö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  Big Grin  )

Gelelim yaptığım tasarıma ;  Bir gün gerçek olur mu acaba  Angel

[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 ;

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  Big Grin  )

Gelelim yaptığım tasarıma ;  Bir gün gerçek olur mu acaba  Angel






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.