当前位置：主页>仓库管理软件> 列表

我写了个画表格线的组件，不是很好，在ide中使用会使del 找速达软件

进销存软件版1楼: 包含三个组件：

TGridLine：负责画表格线，TComponent继承
LeftTopControl、RithtBottomControl记录了表格框的范围，这两个属性只接受TMyLabel、TMyDBEdit组件，以这两个组件为左上角、右下角画外框
ILLeftOffset。。。等？？？Offset属性是对表格线的位置的描述
Draw: boolean属性，是否画线
？？？Color属性是对线的颜色的描述

TMyLabel：TLabel继承，辅助画线。
GridCellLine: TGridCellLines属性，是TGridCellLine集合，描述组件四边是否画表格线
GridConctrler: TGridLine属性，记录所属的画线组件

TMyDBEdit：TDBEdit继承，辅助画线。
GridCellLine: TGridCellLines属性，是TGridCellLine集合，描述组件四边是否画表格线
GridConctrler: TGridLine属性，记录所属的画线组件

其他是属性不用多关注，改过一版，还有些没什么用的属性没去掉。

组件是这样工作的：
TGridLine记录下左上、右下角的组件，这样，表格的外框范围就定了，然后所有需要在这个范围内画线的组件（TMyLabel、TMyDBEdit）设置好GridConctrler属性，然后设置GridCellLine属性，TGridLine负责把这些组件四周的线条画出来。



这个组件主要是为了方便在设计时直接在ide中看到画线的效果，用TBevel虽也可画线条，但是TBevel一多，界面调整起来就很麻烦。

这个组件是项目里面临时起意写的，之前没写过多少组件，经验不足，写得很糟糕，这是改进了的，主要有以下几个问题：
1、不知如何获得TMyLabel、TMyDBEdit在ide中移动的事件。不知道怎样才能在ide中直观的看到效果，就把重画动作放在wm_paint消息中，外框有变量记录，可以在重画前把原来位置的线条给清楚，但是GridCellLine所描述的线条，似乎无法用重载Left等属性的方法来获得变化前的位置，所以，在移动这些组件时，界面上就留下了没有清除的残像了，how？

2、也是最严重的问题，我的同事用了我的组件画界面，用了段时间后，delphi就越来越慢（运行态没有这个问题，似乎只是对ide环境有影响），最后到无法忍受，不知道是哪里出了问题，内存似乎并没有消耗太多，这几个组件本身并没有额外申请内存，cpu占用率也没有100%，到底是哪些代码让delphi出了问题？这时只要关闭工程（不用关闭delphi），再打开工程，又好了，可用一段时间后，delphi有变慢了，真是头痛。

我对编写组件不熟，以前虽说写过几个组件，但感觉还是不够深入，比如写这样直接在设计时界面上可以看到效果的组件怎么调试之类的问题都不了解，希望对组件编程比较熟的朋友帮忙指导一下。

又：抱歉一下，时间原因，代码写的很匆忙，没写注释，感觉思路、结构还比较简单清楚，凑活着看看吧[:D]

unit MyDBCtrl;

interface

uses
Windows, Messages, Classes, SysUtils, Graphics, Forms, Controls, StdCtrls, DBCtrls;

type
TGridCellLine = (gclLeft, gclTop, gclRight, gclBottom);
TGridCellLines = set of TGridCellLine;
TVerifyType = (vtIdentityCard, vtDate);

TGridLine = class(TComponent )
private
FInnerConctrl: array of TControl ;
FBorderSeted: Boolean;
FBorderRect: TRect ;
FCanvas: TCanvas ;

FDrawed: boolean;
FClearColor: TColor ;

FDraw: boolean;
FILBottomOffset: integer;
FILRightOffset: integer;
FILTopOffset: integer;
FILLeftOffset: integer;
FInnerLineColor: TColor;
FBorderColor: TColor;
FRithtBottomControl: TControl;
FLeftTopControl: TControl;
FOLRightOffset: integer;
FOLLeftOffset: integer;
FOLTopOffset: integer;
FOLBottomOffset: integer;



procedure ClearDraw;
procedure DelAControl(const Value: TControl);

procedure SetBorderColor(const Value: TColor);
procedure SetDraw(const Value: boolean);
procedure SetILBottomOffset(const Value: integer);
procedure SetILLeftOffset(const Value: integer);
procedure SetILRightOffset(const Value: integer);
procedure SetILTopOffset(const Value: integer);
procedure SetInnerLineColor(const Value: TColor);
procedure SetLeftTopControl(const Value: TControl);
procedure SetRithtBottomControl(const Value: TControl);
procedure SetOLBottomOffset(const Value: integer);
procedure SetOLLeftOffset(const Value: integer);
procedure SetOLRightOffset(const Value: integer);
procedure SetOLTopOffset(const Value: integer);

protected
procedure DoDraw;virtual ;

public
constructor Create(AWOner: TComponent); override;
destructor Destroy; override;
procedure AddAControl(Value: TControl );

procedure ReDraw;

published
property LeftTopControl:TControl read FLeftTopControl write SetLeftTopControl;
property RithtBottomControl:TControl read FRithtBottomControl write SetRithtBottomControl;

property ILLeftOffset: integer read FILLeftOffset write SetILLeftOffset default 10;
property ILTopOffset: integer read FILTopOffset write SetILTopOffset default 10;
property ILRightOffset: integer read FILRightOffset write SetILRightOffset default 10;
property ILBottomOffset: integer read FILBottomOffset write SetILBottomOffset default 0;

property OLLeftOffset: integer read FOLLeftOffset write SetOLLeftOffset default 10;
property OLTopOffset: integer read FOLTopOffset write SetOLTopOffset default 10;
property OLRightOffset: integer read FOLRightOffset write SetOLRightOffset default 10;
property OLBottomOffset: integer read FOLBottomOffset write SetOLBottomOffset default 10;

property Draw: boolean read FDraw write SetDraw;


property BorderColor: TColor read FBorderColor write SetBorderColor default clBlack;
property InnerLineColor: TColor read FInnerLineColor write SetInnerLineColor default clGray;
end;

TMyLabel = class(TLabel)
private
FTGridCellLines: TGridCellLines;
FIsLeftTop: boolean;
FIsRightBottom: boolean;
FParentForm: TWinControl; //TCustomForm;
FBorderColor: TColor;
FGridCellLineColor: TColor;
FGridConctrler: TGridLine;
procedure SetTGridCellLines(const Value: TGridCellLines);
procedure SetGridCellLineColor(const Value: TColor);
procedure SeTGridLine(const Value: TGridLine);
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
function GetHeight: integer;
function GetLeft: integer;
function GetTop: integer;
function GetWidth: integer;
procedure SetHeight(const Value: integer);
procedure SetLeft(const Value: integer);
procedure SetTop(const Value: integer);
procedure SetWidth(const Value: integer);
protected
procedure SetParent(AParent: TWinControl); override;
public
constructor Create(AWOner: TComponent); override;
published
property GridCellLine: TGridCellLines read FTGridCellLines write SetTGridCellLines default [];
property GridCellLineColor: TColor read FGridCellLineColor write SetGridCellLineColor default clBlack;
property GridConctrler: TGridLine read FGridConctrler write SeTGridLine;
property Left: integer read GetLeft write SetLeft;
property Top: integer read GetTop write SetTop;
property Width: integer read GetWidth write SetWidth;
property Height: integer read GetHeight write SetHeight;
end;

TMyDBEdit = class(TDBEdit)
private
FPropertyCode: string;
FUnderLine: Boolean;
FUnderLineColor: TColor;
FParentForm: TWinControl; // TCustomForm;
FTGridCellLines: TGridCellLines;
FIsLeftTop: boolean;
FIsRightBottom: boolean;
FBorderColor: TColor;
FGridCellLineColor: TColor;

FNotNull: boolean;
FVerifyType: TVerifyType;
FGridConctrler: TGridLine;

procedure SetPropertyCode(const Value: string);
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure SetUnderLine(const Value: Boolean);
procedure SetUnderLineColor(const Value: TColor);
procedure SetTGridCellLines(const Value: TGridCellLines);
procedure SetGridCellLineColor(const Value: TColor);
procedure SetNotNull(const Value: boolean);
procedure SetVerifyType(const Value: TVerifyType);
procedure SeTGridLine(const Value: TGridLine);
function GetHeight: integer;
function GetLeft: integer;
function GetTop: integer;
function GetWidth: integer;
procedure SetHeight(const Value: integer);
procedure SetLeft(const Value: integer);
procedure SetTop(const Value: integer);
procedure SetWidth(const Value: integer);
protected
procedure DrawUnderLine;
procedure SetParent(AParent: TWinControl); override;
published
property PropertyCode: string read FPropertyCode write SetPropertyCode;
property UnderLine: Boolean read FUnderLine write SetUnderLine default False;
property UnderLineColor: TColor read FUnderLineColor write SetUnderLineColor default clBlack;
property GridCellLine: TGridCellLines read FTGridCellLines write SetTGridCellLines default [];
property GridCellLineColor: TColor read FGridCellLineColor write SetGridCellLineColor default clBlack;
property NotNull: boolean read FNotNull write SetNotNull default false;
property VerifyType:TVerifyType read FVerifyType write SetVerifyType;
property GridConctrler: TGridLine read FGridConctrler write SeTGridLine;
property Left: integer read GetLeft write SetLeft;
property Top: integer read GetTop write SetTop;
property Width: integer read GetWidth write SetWidth;
property Height: integer read GetHeight write SetHeight;

property Text;
public
constructor Create(AWOner: TComponent); override;
end;

procedure Register;
procedure DrawAll(Value: TControl );

const
cNotNullUC: TColor = clRed; //必须输入项的下划线颜色
cReadOnlyUC: TColor = clBlue; //只读输入项的下划线颜色

implementation

procedure Register;
begin
RegisterComponents(＇＇Samples＇＇, [TMyDBEdit, TMyLabel,TGridLine]);
end;

{ TMyDBEdit }

procedure DrawAll(Value: TControl );
var
i: integer;
begin
for i := 0 to Value.ComponentCount - 1 do
begin
if Value.Components[i] is TGridLine then
TGridLine(Value.Components[i]).ReDraw ;
end;
end;

constructor TMyDBEdit.Create(AWOner: TComponent);
begin
inherited;
FPropertyCode := ＇＇＇＇;
FTGridCellLines := [];
FParentForm := nil;
FUnderLine := false;
FUnderLineColor := clBlack;
FIsLeftTop := False;
FIsRightBottom := False;
FBorderColor := clBlack;
FGridCellLineColor := clBlack;
FNotNull := false;
FGridConctrler := nil;
end;

procedure TMyDBEdit.DrawUnderLine;
const
cUOffset = 15;
var
c: TCanvas;
begin
c := TCanvas.Create;
try
c.Handle := GetDC(Handle);
c.MoveTo(0, cUOffset);
if FUnderLine then
begin
if FNotNull then
c.Pen.Color := cNotNullUC
else
if ReadOnly then
c.Pen.Color := cReadOnlyUC
else
c.Pen.Color := FUnderLineColor;
end
else
c.Pen.Color := Color;
c.LineTo(Width, cUOffset);
finally
c.Free;
end;
end;

function TMyDBEdit.GetHeight: integer;
begin
Result := inherited Height;
end;

function TMyDBEdit.GetLeft: integer;
begin
Result := inherited Left;
end;

function TMyDBEdit.GetTop: integer;
begin
Result := inherited Top;
end;

function TMyDBEdit.GetWidth: integer;
begin
Result := inherited Width;
end;

procedure TMyDBEdit.SetGridCellLineColor(const Value: TColor);
begin
FGridCellLineColor := Value;
end;

procedure TMyDBEdit.SeTGridLine(const Value: TGridLine);
begin
if Value = nil then
begin
if FGridConctrler.FDrawed then
FGridConctrler.ClearDraw ;
FGridConctrler.DelAControl(self);
FGridConctrler.ReDraw ;
FGridConctrler := Value;
end
else begin
FGridConctrler := Value;
FGridConctrler.AddAControl(Self);
FGridConctrler.ReDraw ;
end;
end;

procedure TMyDBEdit.SetHeight(const Value: integer);
begin
if FGridConctrler <> nil then
if FGridConctrler.FDrawed then
FGridConctrler.ClearDraw ;
inherited Height := Value ;
end;

procedure TMyDBEdit.SetLeft(const Value: integer);
begin
if FGridConctrler <> nil then
if FGridConctrler.FDrawed then
FGridConctrler.ClearDraw ;
inherited Left := Value ;
end;

procedure TMyDBEdit.SetNotNull(const Value: boolean);
begin
FNotNull := Value;
end;

procedure TMyDBEdit.SetParent(AParent: TWinControl);


begin
inherited;
FParentForm := Parent; // GetParentForm(Self);
end;

procedure TMyDBEdit.SetPropertyCode(const Value: string);
begin
FPropertyCode := Value;
end;

procedure TMyDBEdit.SetTGridCellLines(const Value: TGridCellLines);
begin
if FGridConctrler <> nil then
FGridConctrler.ReDraw ;
FTGridCellLines := Value;
end;

procedure TMyDBEdit.SetTop(const Value: integer);
begin
if FGridConctrler <> nil then
if FGridConctrler.FDrawed then
FGridConctrler.ClearDraw ;
inherited Top := Value ;
end;

procedure TMyDBEdit.SetUnderLine(const Value: Boolean);
begin
FUnderLine := Value;
if FUnderLine then
begin
ParentColor := true;
BorderStyle := bsNone;
BevelEdges := [];
BevelKind := bkNone;
Ctl3D := false;
end;
DrawUnderLine
end;

procedure TMyDBEdit.SetUnderLineColor(const Value: TColor);
begin
FUnderLineColor := Value;
if FUnderLine then

DrawUnderLine;
end;

procedure TMyDBEdit.SetVerifyType(const Value: TVerifyType);
begin
FVerifyType := Value;
end;

procedure TMyDBEdit.SetWidth(const Value: integer);
begin
if FGridConctrler <> nil then
if FGridConctrler.FDrawed then
FGridConctrler.ClearDraw ;
inherited Width := Value ;
end;

procedure TMyDBEdit.WMPaint(var Message: TWMPaint);
begin
inherited;
if FUnderLine then
DrawUnderLine;
if (FGridConctrler <> nil) and FGridConctrler.FDraw then
FGridConctrler.ReDraw ;
end;

{ TMyLabel }

constructor TMyLabel.Create(AWOner: TComponent);
begin
inherited;
FTGridCellLines := [];
FParentForm := nil;
FIsLeftTop := False;
FIsRightBottom := False;
FBorderColor := clBlack;
FGridCellLineColor := clBlack;
FGridConctrler := nil;
end;

function TMyLabel.GetHeight: integer;
begin
Result := inherited Height;
end;

function TMyLabel.GetLeft: integer;
begin
Result := inherited Left;
end;

function TMyLabel.GetTop: integer;
begin
Result := inherited Top;
end;

function TMyLabel.GetWidth: integer;
begin
Result := inherited Width;
end;

procedure TMyLabel.SetGridCellLineColor(const Value: TColor);
begin
FGridCellLineColor := Value;
end;

procedure TMyLabel.SeTGridLine(const Value: TGridLine);
begin
if Value = nil then
begin
if FGridConctrler.FDrawed then
FGridConctrler.ClearDraw ;
FGridConctrler.DelAControl(self);
FGridConctrler.ReDraw ;
FGridConctrler := Value;
end
else begin
FGridConctrler := Value;
FGridConctrler.AddAControl(Self);
FGridConctrler.ReDraw ;
end;
end;

procedure TMyLabel.SetHeight(const Value: integer);
begin
if FGridConctrler <> nil then
if FGridConctrler.FDrawed then
FGridConctrler.ClearDraw ;
inherited Height := Value ;
end;

procedure TMyLabel.SetLeft(const Value: integer);


begin
if FGridConctrler <> nil then
begin
// if FGridConctrler.FDrawed then
FGridConctrler.ClearDraw ;
Parent.Invalidate ;
end;
inherited Left := Value ;
end;

procedure TMyLabel.SetParent(AParent: TWinControl);
begin
inherited;
FParentForm := Parent; //GetParentForm(Self);
end;

procedure TMyLabel.SetTGridCellLines(const Value: TGridCellLines);
begin
if FGridConctrler <> nil then
FGridConctrler.ReDraw ;
FTGridCellLines := Value;
end;

{ TGridLine }

procedure TGridLine.AddAControl(Value: TControl);
var
i: integer;
begin
if Value = nil then exit;
if (Value is TMyDBEdit) or (Value is TMyLabel) then
begin
i := Length(FInnerConctrl);
if i = 0 then
begin
i := Length(FInnerConctrl);
SetLength(FInnerConctrl, i + 1);
FInnerConctrl[i] := Value ;
end
else begin
if Value.Parent <> FInnerConctrl[0].Parent then


raise Exception.Create(＇＇加入的组件: ＇＇+Value.Name + ＇＇ 与其他组件不在同一容器＇＇)
else begin
for i := 0 to i do
if FInnerConctrl[i] = Value then exit;

i := Length(FInnerConctrl);
SetLength(FInnerConctrl, i + 1);
FInnerConctrl[i] := Value ;
end;
end;

if Value is TMyDBEdit then
TMyDBEdit(Value).FGridConctrler := Self
else
TMyLabel(Value).FGridConctrler := Self;
end;
end;

procedure TGridLine.ClearDraw;
var
i: integer;
Edit: TMyDBEdit ;
Lbl: TMyLabel ;
begin
FCanvas.Pen.Color := FClearColor ;
FCanvas.Handle := GetDC(FInnerConctrl[0].Parent.Handle);
FCanvas.MoveTo(FBorderRect.Left ,FBorderRect.Top );
FCanvas.LineTo(FBorderRect.Right ,FBorderRect.Top );
FCanvas.LineTo(FBorderRect.Right ,FBorderRect.Bottom );
FCanvas.LineTo(FBorderRect.Left ,FBorderRect.Bottom );
FCanvas.LineTo(FBorderRect.Left ,FBorderRect.Top );
for i := 0 to High(FInnerConctrl) do
begin
if FInnerConctrl[i] is TMyDBEdit then
begin
Edit := TMyDBEdit(FInnerConctrl[i]);
if gclLeft in Edit.GridCellLine then
begin
FCanvas.MoveTo(Edit.Left - FILLeftOffset , FBorderRect.Top);
FCanvas.LineTo(Edit.Left - FILLeftOffset, FBorderRect.Bottom);
end;
if gclTop in Edit.GridCellLine then
begin
FCanvas.MoveTo(FBorderRect.Left, Edit.Top - FILTopOffset );
FCanvas.LineTo(FBorderRect.Right, Edit.Top - FILTopOffset);
end;
if gclRight in Edit.GridCellLine then
begin
FCanvas.MoveTo(Edit.Left + Edit.Width + FILRightOffset , FBorderRect.Top);
FCanvas.LineTo(Edit.Left + Edit.Width + FILRightOffset, FBorderRect.Bottom);
end;
if gclBottom in Edit.GridCellLine then
begin
FCanvas.MoveTo(FBorderRect.Left, Edit.Top + Edit.Height + FILBottomOffset );
FCanvas.LineTo(FBorderRect.Right, Edit.Top + Edit.Height + FILBottomOffset);
end;
end;

if FInnerConctrl[i] is TMyLabel then
begin
Lbl := TMyLabel(FInnerConctrl[i]);
if gclLeft in Lbl.GridCellLine then
begin
FCanvas.MoveTo(Lbl.Left - FILLeftOffset , FBorderRect.Top);
FCanvas.LineTo(Lbl.Left - FILLeftOffset, FBorderRect.Bottom);
end;
if gclTop in Lbl.GridCellLine then
begin
FCanvas.MoveTo(FBorderRect.Left, Lbl.Top - FILTopOffset );
FCanvas.LineTo(FBorderRect.Right, Lbl.Top - FILTopOffset);
end;
if gclRight in Lbl.GridCellLine then
begin
FCanvas.MoveTo(Lbl.Left + Lbl.Width + FILRightOffset , FBorderRect.Top);
FCanvas.LineTo(Lbl.Left + Lbl.Width + FILRightOffset, FBorderRect.Bottom);
end;
if gclBottom in Lbl.GridCellLine then
begin
FCanvas.MoveTo(FBorderRect.Left, Lbl.Top + Lbl.Height + FILBottomOffset );
FCanvas.LineTo(FBorderRect.Right, Lbl.Top + Lbl.Height + FILBottomOffset);


end;
end;
end;

end;

constructor TGridLine.Create(AWOner: TComponent);
begin
inherited Create(AWOner);
FLeftTopControl := nil;
FRithtBottomControl := nil;
SetLength(FInnerConctrl ,0);
FDraw := False;
FBorderSeted := false;
FCanvas := TCanvas.Create ;

FILLeftOffset := 10;
FILTopOffset := 10;
FILRightOffset := 10;
FILBottomOffset := 0;

FOLLeftOffset := 10;
FOLTopOffset := 10;
FOLRightOffset := 10;
FOLBottomOffset := 10;
FBorderColor := clBlack;
FInnerLineColor := clGray;

FDrawed := false;
FClearColor := -1;
end;

procedure TGridLine.DelAControl(const Value: TControl);
var
i, j: integer;
begin
j := -1;
for i := 0 to High(FInnerConctrl ) do
begin
if FInnerConctrl[i] = Value then
begin
FInnerConctrl[i] := nil;
j := i;
Break ;
end;
end;
if j <> -1 then
begin
for i := j to High(FInnerConctrl ) - 1 do
FInnerConctrl[i] := FInnerConctrl[i + 1];
SetLength(FInnerConctrl ,Length(FInnerConctrl) -1);
end;
end;

destructor TGridLine.Destroy;
begin
FCanvas.Free ;
inherited;
end;

procedure TGridLine.DoDraw;
var
i: integer;
Edit: TMyDBEdit ;
Lbl: TMyLabel ;
begin
if not (FDraw or FDrawed) then exit;

if FDrawed then
ClearDraw ;
if FDraw then
begin
if (FLeftTopControl <> nil) and (FRithtBottomControl <> nil) then
begin
FBorderRect.Left := FLeftTopControl.Left - FOLLeftOffset ;
FBorderRect.Top := FLeftTopControl.Top - FOLTopOffset ;
FBorderRect.Right := FRithtBottomControl.Left + FRithtBottomControl.Width + FOLRightOffset ;
FBorderRect.Bottom := FRithtBottomControl.Top + FRithtBottomControl.Height + FOLBottomOffset ;
FBorderSeted := true;
end
else begin
FBorderSeted := false;
if not (csLoading in ComponentState) then
FDraw := false;

end;
if FBorderSeted then
begin
FClearColor := TEdit(FLeftTopControl.Parent).Color ;
FDrawed := true;
FCanvas.Handle := GetDC(FLeftTopControl.Parent.Handle);
FCanvas.Pen.Color := FBorderColor ;
FCanvas.MoveTo(FBorderRect.Left ,FBorderRect.Top );
FCanvas.LineTo(FBorderRect.Right ,FBorderRect.Top );
FCanvas.LineTo(FBorderRect.Right ,FBorderRect.Bottom );
FCanvas.LineTo(FBorderRect.Left ,FBorderRect.Bottom );
FCanvas.LineTo(FBorderRect.Left ,FBorderRect.Top );

FCanvas.Pen.Color := FInnerLineColor ;
for i := 0 to High(FInnerConctrl) do
begin
if FInnerConctrl[i] is TMyDBEdit then
begin
Edit := TMyDBEdit(FInnerConctrl[i]);
if gclLeft in Edit.GridCellLine then
begin
FCanvas.MoveTo(Edit.Left - FILLeftOffset , FBorderRect.Top);
FCanvas.LineTo(Edit.Left - FILLeftOffset, FBorderRect.Bottom);
end;

if gclTop in Edit.GridCellLine then
begin
FCanvas.MoveTo(FBorderRect.Left, Edit.Top - FILTopOffset );
FCanvas.LineTo(FBorderRect.Right, Edit.Top - FILTopOffset);
end;
if gclRight in Edit.GridCellLine then
begin
FCanvas.MoveTo(Edit.Left + Edit.Width + FILRightOffset , FBorderRect.Top);
FCanvas.LineTo(Edit.Left + Edit.Width + FILRightOffset, FBorderRect.Bottom);
end;
if gclBottom in Edit.GridCellLine then
begin
FCanvas.MoveTo(FBorderRect.Left, Edit.Top + Edit.Height + FILBottomOffset );
FCanvas.LineTo(FBorderRect.Right, Edit.Top + Edit.Height + FILBottomOffset);
end;
end;

if FInnerConctrl[i] is TMyLabel then
begin
Lbl := TMyLabel(FInnerConctrl[i]);
if gclLeft in Lbl.GridCellLine then
begin
FCanvas.MoveTo(Lbl.Left - FILLeftOffset , FBorderRect.Top);


FCanvas.LineTo(Lbl.Left - FILLeftOffset, FBorderRect.Bottom);
end;
if gclTop in Lbl.GridCellLine then
begin
FCanvas.MoveTo(FBorderRect.Left, Lbl.Top - FILTopOffset );
FCanvas.LineTo(FBorderRect.Right, Lbl.Top - FILTopOffset);
end;
if gclRight in Lbl.GridCellLine then
begin
FCanvas.MoveTo(Lbl.Left + Lbl.Width + FILRightOffset , FBorderRect.Top);
FCanvas.LineTo(Lbl.Left + Lbl.Width + FILRightOffset, FBorderRect.Bottom);
end;
if gclBottom in Lbl.GridCellLine then
begin
FCanvas.MoveTo(FBorderRect.Left, Lbl.Top + Lbl.Height + FILBottomOffset );
FCanvas.LineTo(FBorderRect.Right, Lbl.Top + Lbl.Height + FILBottomOffset);
end;
end;
end;
end;
end;
end;

procedure TGridLine.ReDraw;
begin
DoDraw ;
end;

procedure TGridLine.SetBorderColor(const Value: TColor);
begin
FBorderColor := Value;
DoDraw ;
end;

procedure TGridLine.SetDraw(const Value: boolean);
begin
FDraw := Value;
DoDraw ;
end;

procedure TGridLine.SetILBottomOffset(const Value: integer);
begin
if FDrawed then ClearDraw;
FILBottomOffset := Value;
DoDraw;
end;

procedure TGridLine.SetILLeftOffset(const Value: integer);
begin
if FDrawed then ClearDraw;
FILLeftOffset := Value;
DoDraw;
end;

procedure TGridLine.SetILRightOffset(const Value: integer);
begin
if FDrawed then ClearDraw;
FILRightOffset := Value;
DoDraw;
end;

procedure TGridLine.SetILTopOffset(const Value: integer);
begin
if FDrawed then ClearDraw;
FILTopOffset := Value;
DoDraw;
end;

procedure TGridLine.SetInnerLineColor(const Value: TColor);
begin
FInnerLineColor := Value;
DoDraw;
end;

procedure TGridLine.SetLeftTopControl(const Value: TControl);
begin
if Value = nil then
begin
FLeftTopControl := nil;
DoDraw;
end
else begin
if (Value is TMyDBEdit) or (Value is TMyLabel) then
begin
if Value <> FLeftTopControl then
begin
if ((FRithtBottomControl <> nil) and (FRithtBottomControl.Parent <> Value.Parent )) or
((Length(FInnerConctrl ) > 0) and (FInnerConctrl[0].Parent <> Value.Parent)) then
raise Exception.Create(＇＇加入的组件: ＇＇+Value.Name + ＇＇ 与其他组件不在同一容器＇＇);
AddAControl(Value );
FLeftTopControl := Value;
DoDraw;
end;
end;
end;
DoDraw;
end;

procedure TGridLine.SetOLBottomOffset(const Value: integer);
begin
FOLBottomOffset := Value;
DoDraw;
end;

procedure TGridLine.SetOLLeftOffset(const Value: integer);
begin
FOLLeftOffset := Value;
DoDraw;
end;

procedure TGridLine.SetOLRightOffset(const Value: integer);
begin
FOLRightOffset := Value;
DoDraw;
end;

procedure TGridLine.SetOLTopOffset(const Value: integer);
begin
FOLTopOffset := Value;
DoDraw;
end;

procedure TGridLine.SetRithtBottomControl(const Value: TControl);
begin
if Value = nil then
begin
FRithtBottomControl := nil;
DoDraw;
end
else begin
if (Value is TMyDBEdit) or (Value is TMyLabel) then
begin
if Value <> FRithtBottomControl then
begin
if ((FLeftTopControl <> nil) and (FLeftTopControl.Parent <> Value.Parent )) or
((Length(FInnerConctrl ) > 0) and (FInnerConctrl[0].Parent <> Value.Parent)) then
raise Exception.Create(＇＇加入的组件: ＇＇+Value.Name + ＇＇ 与其他组件不在同一容器＇＇);
AddAControl(Value );
FRithtBottomControl := Value;
DoDraw;
end;
end;
end;
end;

procedure TMyLabel.SetTop(const Value: integer);
begin
if FGridConctrler <> nil then
if FGridConctrler.FDrawed then
FGridConctrler.ClearDraw ;


inherited Top := Value ;
end;

procedure TMyLabel.SetWidth(const Value: integer);
begin
if FGridConctrler <> nil then
if FGridConctrler.FDrawed then
FGridConctrler.ClearDraw ;
inherited Width := Value ;
end;

procedure TMyLabel.WMPaint(var Message: TWMPaint);
begin
inherited;
if (FGridConctrler <> nil) and FGridConctrler.FDraw then
FGridConctrler.ReDraw ;
end;

end.

2楼: 这个是在设计控件时的属性
TComponent.ComponentState

Describes the current state of the component, indicating when a component needs to avoid certain actions.

type TComponentState = set of (csLoading, csReading, csWriting, csDestroying, csDesigning, csAncestor, csUpdating, csFixups, csFreeNotification, csInline, csDesignInstance);

property ComponentState: TComponentState;

Description

Components use the ComponentState property to detect states in which certain kinds of actions are allowed or disallowed. For example, if a component needs to avoid certain behaviors at design time that it performs at runtime, it can check for the csDesigning flag. ComponentState is read-only and its flags are set automatically when appropriate.

The TComponentState type defines the set of possible state flags for the ComponentState property. The following table lists the possible values for the TComponentState type and the meaning corresponding to each flag:

Flag Component state

csAncestor The component was introduced in an ancestor form. Only set if csDesigning is also set.
csDesigning The component is in a form being manipulated by the form designer.
csDestroying The component is about to be destroyed.
csFixups The component is linked to a component in another form that has not yet been loaded. This flag is cleared when all pending fixups are resolved.
csFreeNotification One or more other components have requested that this component notify them when it is destroyed. This flag is set when another component calls this component抯 FreeNotification method.

csInline The component is a top-level component that can be modified at design time and also embedded in a form. This flag is used to identify nested frames while loading and saving.


csLoading A filer object is currently loading the component. This flag is set when the component is first created and not cleared until the component and all its children are fully loaded (when the Loaded method is called).
csReading The component is reading its property values from a stream. Note that the csLoading flag is always set as well when csReading is set. That is, csReading is set for the subinterval of the time when a component is loading that covers reading in property values.

csUpdating The component is being updated to reflect changes in an ancestor form. Only set if csAncestor is also set.
csWriting The component is writing its property values to a stream.
csDesignInstance The component is the root object in a designer. For example, it is set for a frame when you are designing it, but not on a frame that acts like a component. This flag always appears with csDesigning.
csDesigning 是表示设计期间

在设计期间不需要画出来的
用
if not (csDesigning in ComponentState) then //判断不在设计期间

begin
//这里是你需要在运行期间写的代码
end; 如会计

3楼: //这个是AAFont里的一小段代码
//设置自动更新
procedure TAAGraphicControl.SetAutoUpdate(const Value: Boolean);
begin
if FAutoUpdate <> Value then
begin
FAutoUpdate := Value;
// 在设计期间 更新标志为真时, 更新
if FAutoUpdate and (csDesigning in ComponentState) then
Changed;
end;
end;

4楼: 我现在是要在设计期间更新，我的组件的目的就是要在设计时，把组件周围的线条画在parent上，现在的问题是，不知为什么delphi会变的越来越慢。

不防安装一下组件，在delphi中查问题比较方便，在form上设计一个表格看看，组件放的多了，delphi会变慢。

5楼: 你哪个组件可能画线太频繁了
所以最好是在设计期间，只画一次，或局部更新
不要全部更新画线，

6楼: 你用winxp的任务管理器查看的选择列，把GDI对象勾上，就知道，你哪个程序
GDI对象一拖控件,delphi哪个进程就增加一点GDI对像,肯定是没有释放

进销存软件版7楼: 你用GetDC这个函数没有释放
用完了要用ReleseDC释放
不然GDI资源会用尽的

8楼: // 修改建议
// 对分配的资源要记得释放哈，养成习惯
// 你哪个画线函数的效率的确有点差
{
1、我取消你程序里面的全局FCanvas
直接在每个要画线的段里重新新建一个FCanvas
2、在你每一个GetDC申请后 直到用完，我都用ReleaseDC释放了句柄

//＋＋＋＋＋＋＋＋＋
FCanvas: TCanvas;

begin
FCanvas := TCanvas.Create;
FCanvas.Handle := GetDC(FInnerConctrl[0].Parent.Handle);


ReleaseDC(FInnerConctrl[0].Parent.Handle, FCanvas.Handle);
FCanvas.Handle := 0;
FCanvas.Free;



经过释放了资源的修改后，用了一段时间，没有你说的哪些问题了，
}


unit MyDBCtrl;

interface

uses
Windows, Messages, Classes, SysUtils, Graphics, Forms, Controls, StdCtrls, DBCtrls;

type
TGridCellLine = (gclLeft, gclTop, gclRight, gclBottom);
TGridCellLines = set of TGridCellLine;
TVerifyType = (vtIdentityCard, vtDate);

TGridLine = class(TComponent )


private
FInnerConctrl: array of TControl ;
FBorderSeted: Boolean;
FBorderRect: TRect ;

FDrawed: boolean;
FClearColor: TColor ;

FDraw: boolean;
FILBottomOffset: integer;
FILRightOffset: integer;
FILTopOffset: integer;
FILLeftOffset: integer;
FInnerLineColor: TColor;
FBorderColor: TColor;
FRithtBottomControl: TControl;
FLeftTopControl: TControl;
FOLRightOffset: integer;
FOLLeftOffset: integer;
FOLTopOffset: integer;
FOLBottomOffset: integer;

procedure ClearDraw;
procedure DelAControl(const Value: TControl);

procedure SetBorderColor(const Value: TColor);
procedure SetDraw(const Value: boolean);
procedure SetILBottomOffset(const Value: integer);
procedure SetILLeftOffset(const Value: integer);
procedure SetILRightOffset(const Value: integer);
procedure SetILTopOffset(const Value: integer);
procedure SetInnerLineColor(const Value: TColor);


procedure SetLeftTopControl(const Value: TControl);
procedure SetRithtBottomControl(const Value: TControl);
procedure SetOLBottomOffset(const Value: integer);
procedure SetOLLeftOffset(const Value: integer);
procedure SetOLRightOffset(const Value: integer);
procedure SetOLTopOffset(const Value: integer);

protected
procedure DoDraw;virtual ;

public
constructor Create(AWOner: TComponent); override;
destructor Destroy; override;
procedure AddAControl(Value: TControl );
procedure ReDraw;

published
property LeftTopControl:TControl read FLeftTopControl write SetLeftTopControl;
property RithtBottomControl:TControl read FRithtBottomControl write SetRithtBottomControl;

property ILLeftOffset: integer read FILLeftOffset write SetILLeftOffset default 10;
property ILTopOffset: integer read FILTopOffset write SetILTopOffset default 10;
property ILRightOffset: integer read FILRightOffset write SetILRightOffset default 10;


property ILBottomOffset: integer read FILBottomOffset write SetILBottomOffset default 0;

property OLLeftOffset: integer read FOLLeftOffset write SetOLLeftOffset default 10;
property OLTopOffset: integer read FOLTopOffset write SetOLTopOffset default 10;
property OLRightOffset: integer read FOLRightOffset write SetOLRightOffset default 10;
property OLBottomOffset: integer read FOLBottomOffset write SetOLBottomOffset default 10;

property Draw: boolean read FDraw write SetDraw;
property BorderColor: TColor read FBorderColor write SetBorderColor default clBlack;
property InnerLineColor: TColor read FInnerLineColor write SetInnerLineColor default clGray;
end;

TMyLabel = class(TLabel)
private
FTGridCellLines: TGridCellLines;
FIsLeftTop: boolean;
FIsRightBottom: boolean;
FParentForm: TWinControl; //TCustomForm;
FBorderColor: TColor;
FGridCellLineColor: TColor;
FGridConctrler: TGridLine;
procedure SetTGridCellLines(const Value: TGridCellLines);
procedure SetGridCellLineColor(const Value: TColor);
procedure SeTGridLine(const Value: TGridLine);
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
function GetHeight: integer;
function GetLeft: integer;
function GetTop: integer;
function GetWidth: integer;
procedure SetHeight(const Value: integer);
procedure SetLeft(const Value: integer);
procedure SetTop(const Value: integer);
procedure SetWidth(const Value: integer);
protected
procedure SetParent(AParent: TWinControl); override;
public
constructor Create(AWOner: TComponent); override;
published
property GridCellLine: TGridCellLines read FTGridCellLines write SetTGridCellLines default [];
property GridCellLineColor: TColor read FGridCellLineColor write SetGridCellLineColor default clBlack;
property GridConctrler: TGridLine read FGridConctrler write SeTGridLine;

property Left: integer read GetLeft write SetLeft;
property Top: integer read GetTop write SetTop;
property Width: integer read GetWidth write SetWidth;
property Height: integer read GetHeight write SetHeight;
end;

TMyDBEdit = class(TDBEdit)
private
FPropertyCode: string;
FUnderLine: Boolean;
FUnderLineColor: TColor;
FParentForm: TWinControl; // TCustomForm;
FTGridCellLines: TGridCellLines;
FIsLeftTop: boolean;
FIsRightBottom: boolean;
FBorderColor: TColor;
FGridCellLineColor: TColor;
FNotNull: boolean;
FVerifyType: TVerifyType;
FGridConctrler: TGridLine;

procedure SetPropertyCode(const Value: string);
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure SetUnderLine(const Value: Boolean);
procedure SetUnderLineColor(const Value: TColor);
procedure SetTGridCellLines(const Value: TGridCellLines);
procedure SetGridCellLineColor(const Value: TColor);
procedure SetNotNull(const Value: boolean);
procedure SetVerifyType(const Value: TVerifyType);
procedure SeTGridLine(const Value: TGridLine);
function GetHeight: integer;
function GetLeft: integer;
function GetTop: integer;
function GetWidth: integer;
procedure SetHeight(const Value: integer);
procedure SetLeft(const Value: integer);
procedure SetTop(const Value: integer);
procedure SetWidth(const Value: integer);
protected
procedure DrawUnderLine;
procedure SetParent(AParent: TWinControl); override;
published
property PropertyCode: string read FPropertyCode write SetPropertyCode;
property UnderLine: Boolean read FUnderLine write SetUnderLine default False;
property UnderLineColor: TColor read FUnderLineColor write SetUnderLineColor default clBlack;
property GridCellLine: TGridCellLines read FTGridCellLines write SetTGridCellLines default [];
property GridCellLineColor: TColor read FGridCellLineColor write SetGridCellLineColor default clBlack;

property NotNull: boolean read FNotNull write SetNotNull default false;
property VerifyType:TVerifyType read FVerifyType write SetVerifyType;
property GridConctrler: TGridLine read FGridConctrler write SeTGridLine;
property Left: integer read GetLeft write SetLeft;
property Top: integer read GetTop write SetTop;
property Width: integer read GetWidth write SetWidth;
property Height: integer read GetHeight write SetHeight;

property Text;
public
constructor Create(AWOner: TComponent); override;
end;

procedure Register;
procedure DrawAll(Value: TControl );

const
cNotNullUC: TColor = clRed; //必须输入项的下划线颜色
cReadOnlyUC: TColor = clBlue; //只读输入项的下划线颜色

implementation

procedure Register;
begin
RegisterComponents(＇＇Samples＇＇, [TMyDBEdit, TMyLabel,TGridLine]);
end;

{ TMyDBEdit }

procedure DrawAll(Value: TControl );
var
i: integer;
begin
for i := 0 to Value.ComponentCount - 1 do


begin
if Value.Components[i] is TGridLine then
TGridLine(Value.Components[i]).ReDraw ;
end;
end;

constructor TMyDBEdit.Create(AWOner: TComponent);
begin
inherited;
FPropertyCode := ＇＇＇＇;
FTGridCellLines := [];
FParentForm := nil;
FUnderLine := false;
FUnderLineColor := clBlack;
FIsLeftTop := False;
FIsRightBottom := False;
FBorderColor := clBlack;
FGridCellLineColor := clBlack;
FNotNull := false;
FGridConctrler := nil;
end;

procedure TMyDBEdit.DrawUnderLine;
const
cUOffset = 15;
var
c: TCanvas;

begin
c := TCanvas.Create;
try
c.Handle := GetDC(Handle);
c.MoveTo(0, cUOffset);
if FUnderLine then
begin
if FNotNull then
c.Pen.Color := cNotNullUC
else
if ReadOnly then
c.Pen.Color := cReadOnlyUC
else
c.Pen.Color := FUnderLineColor;
end
else
c.Pen.Color := Color;
c.LineTo(Width, cUOffset);
finally
ReleaseDC(Handle, c.Handle);
c.Handle := 0;
c.Free;
end;
end;

function TMyDBEdit.GetHeight: integer;
begin
Result := inherited Height;
end;

function TMyDBEdit.GetLeft: integer;
begin
Result := inherited Left;
end;

function TMyDBEdit.GetTop: integer;
begin
Result := inherited Top;
end;

function TMyDBEdit.GetWidth: integer;
begin
Result := inherited Width;
end;

procedure TMyDBEdit.SetGridCellLineColor(const Value: TColor);
begin
FGridCellLineColor := Value;
end;

procedure TMyDBEdit.SeTGridLine(const Value: TGridLine);
begin
if Value = nil then
begin
if FGridConctrler.FDrawed then
FGridConctrler.ClearDraw ;
FGridConctrler.DelAControl(self);
FGridConctrler.ReDraw ;
FGridConctrler := Value;
end
else begin
FGridConctrler := Value;
FGridConctrler.AddAControl(Self);
FGridConctrler.ReDraw ;


end;
end;

procedure TMyDBEdit.SetHeight(const Value: integer);
begin
if FGridConctrler <> nil then
if FGridConctrler.FDrawed then
FGridConctrler.ClearDraw ;
inherited Height := Value ;
end;

procedure TMyDBEdit.SetLeft(const Value: integer);
begin
if FGridConctrler <> nil then
if FGridConctrler.FDrawed then
FGridConctrler.ClearDraw ;
inherited Left := Value ;
end;

procedure TMyDBEdit.SetNotNull(const Value: boolean);
begin
FNotNull := Value;
end;

procedure TMyDBEdit.SetParent(AParent: TWinControl);
begin
inherited;
FParentForm := Parent; // GetParentForm(Self);
end;

procedure TMyDBEdit.SetPropertyCode(const Value: string);
begin
FPropertyCode := Value;
end;

procedure TMyDBEdit.SetTGridCellLines(const Value: TGridCellLines);
begin
if FGridConctrler <> nil then
FGridConctrler.ReDraw ;
FTGridCellLines := Value;
end;

procedure TMyDBEdit.SetTop(const Value: integer);
begin
if FGridConctrler <> nil then
if FGridConctrler.FDrawed then
FGridConctrler.ClearDraw ;
inherited Top := Value ;
end;

procedure TMyDBEdit.SetUnderLine(const Value: Boolean);
begin
FUnderLine := Value;
if FUnderLine then
begin
ParentColor := true;
BorderStyle := bsNone;
BevelEdges := [];
BevelKind := bkNone;
Ctl3D := false;
end;
DrawUnderLine
end;

procedure TMyDBEdit.SetUnderLineColor(const Value: TColor);
begin
FUnderLineColor := Value;
if FUnderLine then
DrawUnderLine;
end;

procedure TMyDBEdit.SetVerifyType(const Value: TVerifyType);
begin
FVerifyType := Value;
end;

procedure TMyDBEdit.SetWidth(const Value: integer);
begin
if FGridConctrler <> nil then
if FGridConctrler.FDrawed then
FGridConctrler.ClearDraw ;
inherited Width := Value ;
end;

procedure TMyDBEdit.WMPaint(var Message: TWMPaint);
begin
inherited;

if FUnderLine then
DrawUnderLine;
if (FGridConctrler <> nil) and FGridConctrler.FDraw then
FGridConctrler.ReDraw ;
end;

{ TMyLabel }

constructor TMyLabel.Create(AWOner: TComponent);
begin
inherited;
FTGridCellLines := [];
FParentForm := nil;
FIsLeftTop := False;
FIsRightBottom := False;
FBorderColor := clBlack;
FGridCellLineColor := clBlack;
FGridConctrler := nil;
end;

function TMyLabel.GetHeight: integer;
begin
Result := inherited Height;
end;

function TMyLabel.GetLeft: integer;
begin
Result := inherited Left;
end;

function TMyLabel.GetTop: integer;
begin
Result := inherited Top;
end;

function TMyLabel.GetWidth: integer;
begin
Result := inherited Width;
end;

procedure TMyLabel.SetGridCellLineColor(const Value: TColor);
begin
FGridCellLineColor := Value;
end;

procedure TMyLabel.SeTGridLine(const Value: TGridLine);
begin
if Value = nil then
begin
if FGridConctrler.FDrawed then
FGridConctrler.ClearDraw ;
FGridConctrler.DelAControl(self);
FGridConctrler.ReDraw ;
FGridConctrler := Value;
end
else begin
FGridConctrler := Value;
FGridConctrler.AddAControl(Self);
FGridConctrler.ReDraw ;
end;
end;

procedure TMyLabel.SetHeight(const Value: integer);
begin
if FGridConctrler <> nil then
if FGridConctrler.FDrawed then
FGridConctrler.ClearDraw ;
inherited Height := Value ;
end;

procedure TMyLabel.SetLeft(const Value: integer);
begin
if FGridConctrler <> nil then
begin
// if FGridConctrler.FDrawed then
FGridConctrler.ClearDraw ;
Parent.Invalidate ;
end;
inherited Left := Value ;
end;

procedure TMyLabel.SetParent(AParent: TWinControl);
begin
inherited;
FParentForm := Parent; //GetParentForm(Self);
end;

procedure TMyLabel.SetTGridCellLines(const Value: TGridCellLines);

begin
if FGridConctrler <> nil then
FGridConctrler.ReDraw ;
FTGridCellLines := Value;
end;

{ TGridLine }

procedure TGridLine.AddAControl(Value: TControl);
var
i: integer;
begin
if Value = nil then exit;
if (Value is TMyDBEdit) or (Value is TMyLabel) then
begin
i := Length(FInnerConctrl);
if i = 0 then
begin
i := Length(FInnerConctrl);
SetLength(FInnerConctrl, i + 1);
FInnerConctrl[i] := Value ;
end
else begin
if Value.Parent <> FInnerConctrl[0].Parent then
raise Exception.Create(＇＇加入的组件: ＇＇+Value.Name + ＇＇ 与其他组件不在同一容器＇＇)
else begin
for i := 0 to i do
if FInnerConctrl[i] = Value then exit;

i := Length(FInnerConctrl);
SetLength(FInnerConctrl, i + 1);
FInnerConctrl[i] := Value ;
end;
end;

if Value is TMyDBEdit then
TMyDBEdit(Value).FGridConctrler := Self

else
TMyLabel(Value).FGridConctrler := Self;
end;
end;

procedure TGridLine.ClearDraw;
var
i: integer;
Edit: TMyDBEdit ;
Lbl: TMyLabel ;

//＋＋＋＋＋＋＋＋＋
FCanvas: TCanvas;

begin
FCanvas := TCanvas.Create;
FCanvas.Handle := GetDC(FInnerConctrl[0].Parent.Handle);

FCanvas.Pen.Color := FClearColor ;

FCanvas.MoveTo(FBorderRect.Left ,FBorderRect.Top );
FCanvas.LineTo(FBorderRect.Right ,FBorderRect.Top );
FCanvas.LineTo(FBorderRect.Right ,FBorderRect.Bottom );
FCanvas.LineTo(FBorderRect.Left ,FBorderRect.Bottom );
FCanvas.LineTo(FBorderRect.Left ,FBorderRect.Top );
for i := 0 to High(FInnerConctrl) do
begin
if FInnerConctrl[i] is TMyDBEdit then
begin
Edit := TMyDBEdit(FInnerConctrl[i]);
if gclLeft in Edit.GridCellLine then
begin
FCanvas.MoveTo(Edit.Left - FILLeftOffset , FBorderRect.Top);
FCanvas.LineTo(Edit.Left - FILLeftOffset, FBorderRect.Bottom);
end;
if gclTop in Edit.GridCellLine then
begin
FCanvas.MoveTo(FBorderRect.Left, Edit.Top - FILTopOffset );
FCanvas.LineTo(FBorderRect.Right, Edit.Top - FILTopOffset);
end;
if gclRight in Edit.GridCellLine then
begin
FCanvas.MoveTo(Edit.Left + Edit.Width + FILRightOffset , FBorderRect.Top);
FCanvas.LineTo(Edit.Left + Edit.Width + FILRightOffset, FBorderRect.Bottom);
end;
if gclBottom in Edit.GridCellLine then
begin
FCanvas.MoveTo(FBorderRect.Left, Edit.Top + Edit.Height + FILBottomOffset );
FCanvas.LineTo(FBorderRect.Right, Edit.Top + Edit.Height + FILBottomOffset);
end;
end;

if FInnerConctrl[i] is TMyLabel then
begin
Lbl := TMyLabel(FInnerConctrl[i]);
if gclLeft in Lbl.GridCellLine then
begin
FCanvas.MoveTo(Lbl.Left - FILLeftOffset , FBorderRect.Top);
FCanvas.LineTo(Lbl.Left - FILLeftOffset, FBorderRect.Bottom);


end;
if gclTop in Lbl.GridCellLine then
begin
FCanvas.MoveTo(FBorderRect.Left, Lbl.Top - FILTopOffset );
FCanvas.LineTo(FBorderRect.Right, Lbl.Top - FILTopOffset);
end;
if gclRight in Lbl.GridCellLine then
begin
FCanvas.MoveTo(Lbl.Left + Lbl.Width + FILRightOffset , FBorderRect.Top);
FCanvas.LineTo(Lbl.Left + Lbl.Width + FILRightOffset, FBorderRect.Bottom);
end;
if gclBottom in Lbl.GridCellLine then
begin
FCanvas.MoveTo(FBorderRect.Left, Lbl.Top + Lbl.Height + FILBottomOffset );
FCanvas.LineTo(FBorderRect.Right, Lbl.Top + Lbl.Height + FILBottomOffset);
end;
end;
end;

ReleaseDC(FInnerConctrl[0].Parent.Handle, FCanvas.Handle);
FCanvas.Handle := 0;
FCanvas.Free;


end;

constructor TGridLine.Create(AWOner: TComponent);
begin
inherited Create(AWOner);
FLeftTopControl := nil;
FRithtBottomControl := nil;


SetLength(FInnerConctrl ,0);
FDraw := False;
FBorderSeted := false;

FILLeftOffset := 10;
FILTopOffset := 10;
FILRightOffset := 10;
FILBottomOffset := 0;

FOLLeftOffset := 10;
FOLTopOffset := 10;
FOLRightOffset := 10;
FOLBottomOffset := 10;
FBorderColor := clBlack;
FInnerLineColor := clGray;

FDrawed := false;
FClearColor := -1;
end;

procedure TGridLine.DelAControl(const Value: TControl);
var
i, j: integer;
begin
j := -1;
for i := 0 to High(FInnerConctrl ) do
begin
if FInnerConctrl[i] = Value then
begin
FInnerConctrl[i] := nil;
j := i;
Break ;
end;
end;
if j <> -1 then
begin
for i := j to High(FInnerConctrl ) - 1 do
FInnerConctrl[i] := FInnerConctrl[i + 1];
SetLength(FInnerConctrl ,Length(FInnerConctrl) -1);
end;
end;

destructor TGridLine.Destroy;
begin
inherited;
end;

procedure TGridLine.DoDraw;
var
i: integer;
Edit: TMyDBEdit ;
Lbl: TMyLabel ;
//
FCanvas: TCanvas;
begin
if not (FDraw or FDrawed) then exit;

if FDrawed then
ClearDraw ;
if FDraw then
begin
if (FLeftTopControl <> nil) and (FRithtBottomControl <> nil) then
begin
FBorderRect.Left := FLeftTopControl.Left - FOLLeftOffset ;
FBorderRect.Top := FLeftTopControl.Top - FOLTopOffset ;
FBorderRect.Right := FRithtBottomControl.Left + FRithtBottomControl.Width + FOLRightOffset ;
FBorderRect.Bottom := FRithtBottomControl.Top + FRithtBottomControl.Height + FOLBottomOffset ;
FBorderSeted := true;
end
else begin
FBorderSeted := false;
if not (csLoading in ComponentState) then
FDraw := false;
end;

if FBorderSeted then
begin
FClearColor := TEdit(FLeftTopControl.Parent).Color ;
FDrawed := true;

FCanvas := TCanvas.Create;
FCanvas.Handle := GetDC(FLeftTopControl.Parent.Handle);



FCanvas.Pen.Color := FBorderColor ;
FCanvas.MoveTo(FBorderRect.Left ,FBorderRect.Top );
FCanvas.LineTo(FBorderRect.Right ,FBorderRect.Top );
FCanvas.LineTo(FBorderRect.Right ,FBorderRect.Bottom );
FCanvas.LineTo(FBorderRect.Left ,FBorderRect.Bottom );
FCanvas.LineTo(FBorderRect.Left ,FBorderRect.Top );

FCanvas.Pen.Color := FInnerLineColor ;
for i := 0 to High(FInnerConctrl) do
begin

if FInnerConctrl[i] is TMyDBEdit then
begin
Edit := TMyDBEdit(FInnerConctrl[i]);
if gclLeft in Edit.GridCellLine then
begin
FCanvas.MoveTo(Edit.Left - FILLeftOffset , FBorderRect.Top);
FCanvas.LineTo(Edit.Left - FILLeftOffset, FBorderRect.Bottom);
end;
if gclTop in Edit.GridCellLine then
begin
FCanvas.MoveTo(FBorderRect.Left, Edit.Top - FILTopOffset );
FCanvas.LineTo(FBorderRect.Right, Edit.Top - FILTopOffset);

end;
if gclRight in Edit.GridCellLine then
begin
FCanvas.MoveTo(Edit.Left + Edit.Width + FILRightOffset , FBorderRect.Top);
FCanvas.LineTo(Edit.Left + Edit.Width + FILRightOffset, FBorderRect.Bottom);
end;
if gclBottom in Edit.GridCellLine then
begin
FCanvas.MoveTo(FBorderRect.Left, Edit.Top + Edit.Height + FILBottomOffset );
FCanvas.LineTo(FBorderRect.Right, Edit.Top + Edit.Height + FILBottomOffset);
end;
end;

if FInnerConctrl[i] is TMyLabel then
begin
Lbl := TMyLabel(FInnerConctrl[i]);
if gclLeft in Lbl.GridCellLine then
begin
FCanvas.MoveTo(Lbl.Left - FILLeftOffset , FBorderRect.Top);
FCanvas.LineTo(Lbl.Left - FILLeftOffset, FBorderRect.Bottom);
end;
if gclTop in Lbl.GridCellLine then
begin
FCanvas.MoveTo(FBorderRect.Left, Lbl.Top - FILTopOffset );


FCanvas.LineTo(FBorderRect.Right, Lbl.Top - FILTopOffset);
end;
if gclRight in Lbl.GridCellLine then
begin
FCanvas.MoveTo(Lbl.Left + Lbl.Width + FILRightOffset , FBorderRect.Top);
FCanvas.LineTo(Lbl.Left + Lbl.Width + FILRightOffset, FBorderRect.Bottom);
end;
if gclBottom in Lbl.GridCellLine then
begin
FCanvas.MoveTo(FBorderRect.Left, Lbl.Top + Lbl.Height + FILBottomOffset );
FCanvas.LineTo(FBorderRect.Right, Lbl.Top + Lbl.Height + FILBottomOffset);
end;
end;

end;

ReleaseDC(FLeftTopControl.Parent.Handle, FCanvas.Handle);
FCanvas.Handle := 0;
FCanvas.Free;


end;
end;
end;

procedure TGridLine.ReDraw;
begin
DoDraw ;
end;

procedure TGridLine.SetBorderColor(const Value: TColor);
begin
FBorderColor := Value;
DoDraw ;
end;

procedure TGridLine.SetDraw(const Value: boolean);

begin
FDraw := Value;
DoDraw ;
end;

procedure TGridLine.SetILBottomOffset(const Value: integer);
begin
if FDrawed then ClearDraw;
FILBottomOffset := Value;
DoDraw;
end;

procedure TGridLine.SetILLeftOffset(const Value: integer);
begin
if FDrawed then ClearDraw;
FILLeftOffset := Value;
DoDraw;
end;

procedure TGridLine.SetILRightOffset(const Value: integer);
begin
if FDrawed then ClearDraw;
FILRightOffset := Value;
DoDraw;
end;

procedure TGridLine.SetILTopOffset(const Value: integer);
begin
if FDrawed then ClearDraw;
FILTopOffset := Value;
DoDraw;
end;

procedure TGridLine.SetInnerLineColor(const Value: TColor);
begin
FInnerLineColor := Value;
DoDraw;
end;

procedure TGridLine.SetLeftTopControl(const Value: TControl);
begin
if Value = nil then
begin
FLeftTopControl := nil;
DoDraw;
end
else begin
if (Value is TMyDBEdit) or (Value is TMyLabel) then


begin
if Value <> FLeftTopControl then
begin
if ((FRithtBottomControl <> nil) and (FRithtBottomControl.Parent <> Value.Parent )) or
((Length(FInnerConctrl ) > 0) and (FInnerConctrl[0].Parent <> Value.Parent)) then
raise Exception.Create(＇＇加入的组件: ＇＇+Value.Name + ＇＇ 与其他组件不在同一容器＇＇);
AddAControl(Value );
FLeftTopControl := Value;
DoDraw;
end;
end;
end;
DoDraw;
end;

procedure TGridLine.SetOLBottomOffset(const Value: integer);
begin
FOLBottomOffset := Value;
DoDraw;
end;

procedure TGridLine.SetOLLeftOffset(const Value: integer);
begin
FOLLeftOffset := Value;
DoDraw;
end;

procedure TGridLine.SetOLRightOffset(const Value: integer);
begin
FOLRightOffset := Value;
DoDraw;
end;

procedure TGridLine.SetOLTopOffset(const Value: integer);
begin
FOLTopOffset := Value;
DoDraw;
end;

procedure TGridLine.SetRithtBottomControl(const Value: TControl);
begin
if Value = nil then
begin
FRithtBottomControl := nil;
DoDraw;
end
else begin
if (Value is TMyDBEdit) or (Value is TMyLabel) then
begin
if Value <> FRithtBottomControl then
begin
if ((FLeftTopControl <> nil) and (FLeftTopControl.Parent <> Value.Parent )) or
((Length(FInnerConctrl ) > 0) and (FInnerConctrl[0].Parent <> Value.Parent)) then
raise Exception.Create(＇＇加入的组件: ＇＇+Value.Name + ＇＇ 与其他组件不在同一容器＇＇);
AddAControl(Value );
FRithtBottomControl := Value;
DoDraw;
end;
end;
end;
end;

procedure TMyLabel.SetTop(const Value: integer);
begin
if FGridConctrler <> nil then
if FGridConctrler.FDrawed then
FGridConctrler.ClearDraw ;
inherited Top := Value ;
end;

procedure TMyLabel.SetWidth(const Value: integer);
begin
if FGridConctrler <> nil then
if FGridConctrler.FDrawed then
FGridConctrler.ClearDraw ;
inherited Width := Value ;
end;

procedure TMyLabel.WMPaint(var Message: TWMPaint);
begin
inherited;
if (FGridConctrler <> nil) and FGridConctrler.FDraw then
FGridConctrler.ReDraw ;
end;

end.

9楼: 我觉得既然要实现表格控件，还不如从新写一个
用TCustomControl为基类，从新实现一个，
这样，在设计期间就不需要清除残像了哈
而且TCustomControl本身又带有Canvas属性
直接在上面画出就可以了三

10楼: 明白了，对dc不熟，以为getdc不用删除，看了api帮助，知道问题所在了。

我觉得FCanvas还是定义为全局比较好，这个并不占多少资源，每个TGridLine才创建一个，而如果每次用的时候再创建，如果频繁刷新界面，估计用在创建、删除Canvas上的开销也不小，所以我还是保留。

另外，不知你对问题一有什么看法，
procedure TMyLabel.SetLeft(const Value: integer);
begin
if FGridConctrler <> nil then
FGridConctrler.ClearDraw ;
inherited Left := Value ;
end;
我想通过重载设置控件位置的方法，在移动前清除原来的线条，这个在运行时可以用，但是在ide中没有反应，不知在ide中怎么获得这些消息？

11楼: // 你哪个画线函数的效率的确有点差



是指DoDraw？应该不太差吧？只是要循环TGridLine下属组件，以重画周围的线条，如果要提高，大概只有把确实需要画线条的组件收集到数组中才行，这样麻烦点，而一般界面上需要画线条的组件并不会太多的。

12楼: 可不可以用SetROP2(Canvas.Handle,R2_XORPEN);
在清除前面画的线时在画一次就可以清除了

绘图模式常数表
常数 DrawMode 像素值
R2_BLACK vbBlackness 黑色
R2_WHITE vbWhitness 白色
R2_NOP vbNop 不变
R2_NOT vbInvert 当前显示颜色的反色
R2_COPYPEN vbCopyPen 画笔颜色
R2_NOTCOPYPEN vbNotCopyPen R2_COPYPEN的反色
R2_MERGEPENNOT vbMergePenNot 显示颜色的反色与画笔颜色进行OR运算
R2_MASKPENNOT vbMaskPenNot 显示颜色的反色与画笔颜色进行AND运算
R2_MERGENOTPEN vbMergeNotPen 画笔颜色的反色与显示颜色进行OR运算
R2_MASKNOTPEN vbMaskNotPen 画笔颜色的反色与显示颜色进行AND运算
R2_MERGEPEN vbMergePen 画笔颜色与显示颜色进行OR运算
R2_NOTMERGEPEN vbNotMergePen R2_MERGEPEN的反色
R2_MASKPEN vbMaskPen 显示颜色与画笔颜色进行AND运算
R2_NOTMASKPEN vbNotMaskPen R2_MASKPEN的反色
R2_XORPEN vbXorPen 显示颜色与画笔颜色进行异或运算
R2_NOTXORPEN vbNotXorPen R2_XORPEN的反色


对于重载设置控件，对于TLabel应該可以吧,因为他本身就是从TGraphicControl重载过来的
你可以直接设置他的大小什么的，
对于TEdit,就有点难度了，你去网上找一找 TFlatEdit的实现方法，他也是重載TEdit
然后在上面平面化TEdit,应该有参考吧 如速达软件

13楼: ok，这个问题我自己继续摸索吧，谢谢。