zoukankan      html  css  js  c++  java
  • delphi VCL组件同名继承

    当我们在扩展一个 vcl 组件功能的时候,既想保留IDE中能拖动大小与直接设置属性的功能,又想减少写创建与释放代码和安装扩展后新组件的麻烦,那么本文中的方法,就非常实用了。

    以给TStringGrid的单元格加上颜色功能为例,先看如何调用:

    unit Unit1;
    
    interface
    
    uses
      Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
      System.Classes, Vcl.Graphics,
      Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, uColorGrid;
    
    type
    
      TStringGrid = class(uColorGrid.TStringGrid); // 此句必备!
    
      TForm1 = class(TForm)
        StringGrid1: TStringGrid;
        Button1: TButton;
        Button2: TButton;
        procedure Button1Click(Sender: TObject);
        procedure Button2Click(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    { TStringGrid }
    
    procedure TForm1.Button1Click(Sender: TObject);
    var
      c: TCellColor;
    begin
    
      // 设置颜色要在改变表格的行列数之后
    
      c.TextColor := clblue;
      c.BackGroundColor := clyellow;
    
      StringGrid1.cells[2, 1] := 'blue';
      StringGrid1.CellsColor[2, 1] := c;
    
      c.TextColor := clred;
      c.BackGroundColor := clgreen;
      StringGrid1.cells[3, 1] := 'red';
      StringGrid1.CellsColor[3, 1] := c;
    
      c.TextColor := clgray;
      c.BackGroundColor := clnavy;
    
      StringGrid1.cells[4, 1] := 'yellow';
      StringGrid1.CellsColor[4, 1] := c;
    
    end;
    
    procedure TForm1.Button2Click(Sender: TObject);
    var
      c: TCellColor;
    begin
    
      c.TextColor := clred;
      c.BackGroundColor := clolive;
    
      StringGrid1.cells[2, 1] := 'blue';
      StringGrid1.CellsColor[2, 1] := c;
    
      c.TextColor := clblue;
    
      c.BackGroundColor := clMaroon;
      StringGrid1.cells[3, 1] := 'red';
      StringGrid1.CellsColor[3, 1] := c;
    
      c.TextColor := clgray;
      c.BackGroundColor := clLime;
      StringGrid1.cells[4, 1] := 'yellow';
      StringGrid1.CellsColor[4, 1] := c;
    
    end;
    
    end.
    unit1.pas

    以下为TStringGrid扩展功能的代码

    unit uColorGrid;
    
    interface
    
    uses
      Winapi.Windows, System.SysUtils, System.Classes, Vcl.Graphics,
      Vcl.Controls, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids;
    
    type
    
      TCellColor = record
        TextColor: TColor; // 格子文字的颜色
        BackGroundColor: TColor; // 格子背景的颜色
        ColorChanged: boolean;
      end;
    
      TCellColorArr = array of array of TCellColor;
    
      TStringGrid = class(Vcl.Grids.TStringGrid)
      private
        FCellColorArr: TCellColorArr; // 记录单元格颜色
        function GetCellsColor(ACol, ARow: integer): TCellColor;
        procedure SetCellsColor(ACol, ARow: integer; const Value: TCellColor);
        procedure InitCellsColor(ACol, ARow: integer);
      protected
        procedure SizeChanged(OldColCount, OldRowCount: Longint); override; // 在此过程中调整颜色记录数组的大小
        procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
      public
        constructor Create(AOwner: TComponent); override;
        property CellsColor[ACol, ARow: integer]: TCellColor read GetCellsColor write SetCellsColor;
      end;
    
    implementation
    
    constructor TStringGrid.Create(AOwner: TComponent);
    begin
      inherited;
      InitCellsColor(ColCount, RowCount);
    end;
    
    procedure TStringGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
    var
      CC: TCellColor;
      oldBrush: Tbrush;
      oldPen: tpen;
      oldFont: tfont;
    begin
      CC := FCellColorArr[ARow, ACol];
      if CC.ColorChanged then
      begin
        oldBrush := self.Canvas.Brush;
        oldPen := self.Canvas.Pen;
        oldFont := self.Canvas.Font;
        Canvas.Font.Color := CC.TextColor; // 文字颜色
        Canvas.Brush.Color := CC.BackGroundColor; // 背景色
        inherited;
        Canvas.Brush := oldBrush;
        Canvas.Pen := oldPen;
        Canvas.Font := oldFont;
      end
      else
        inherited;
    end;
    
    function TStringGrid.GetCellsColor(ACol, ARow: integer): TCellColor;
    begin
      result := FCellColorArr[ARow, ACol];
    end;
    
    procedure TStringGrid.InitCellsColor(ACol, ARow: integer);
    var
      i, j: integer;
    begin
      setlength(FCellColorArr, ARow);
      for i := 0 to ARow - 1 do
      begin
        setlength(FCellColorArr[i], ACol);
        for j := 0 to ACol - 1 do
        begin
          FCellColorArr[i, j].ColorChanged := false; //初始化
        end;
      end;
    
    end;
    
    procedure TStringGrid.SetCellsColor(ACol, ARow: integer; const Value: TCellColor);
    begin
      FCellColorArr[ARow, ACol] := Value;
      FCellColorArr[ARow, ACol].ColorChanged := true;
    end;
    
    procedure TStringGrid.SizeChanged(OldColCount, OldRowCount: Longint);
    begin
      inherited;
      InitCellsColor(ColCount, RowCount);
    end;
    
    end.
    uColorGrid.pas

    本文示例代码下载

    效果图

    参考文章:https://www.cnblogs.com/delphi7456/p/5349619.html

  • 相关阅读:
    一些常用的表单验证的代码
    JQuery 在线参考手册
    jQuery ajax
    DIV+CSS专题:十天学会DIV+CSS
    wordpress调用函数大全
    WordPress 主题教程:从零开始制作 WordPress 主题
    全面提升WordPress前台和后台的 打开速度的方案
    详细的图文介绍如何利用XAMPP本地建站的环境配置教程
    2014年,daliu_it 年末文章汇总清单
    再见,2014;您好,2015!
  • 原文地址:https://www.cnblogs.com/lackey/p/9780105.html
Copyright © 2011-2022 走看看