type
TForm1 = class(TForm)
...
public
{ Public declarations }
procedure pr_CheckListBox_OnDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
procedure pr_CheckListBox_Exit(Sender: TObject);
procedure pr_Set_Highlight_For_CheckListBox(AOwner:TWinControl);
end;
TForm1 = class(TForm)
...
public
{ Public declarations }
procedure pr_CheckListBox_OnDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
procedure pr_CheckListBox_Exit(Sender: TObject);
procedure pr_Set_Highlight_For_CheckListBox(AOwner:TWinControl);
end;
CheckListBox.Style := lbOwnerDrawFixed;
//用來覆寫CheckListBox.OnDrawItem事件,對已勾選的項目做文件上的變化
procedure TForm1.pr_CheckListBox_OnDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var sStr:String;
begin
TCheckListBox(Control).Canvas.Font.Color := TCheckListBox(Control).Font.Color;
TCheckListBox(Control).Canvas.Font.Style := TCheckListBox(Control).Font.Style;
if (odSelected in State) then
begin
TCheckListBox(Control).Canvas.Font.Color := clWhite;
end;
if TCheckListBox(Control).Checked[Index] then
begin
TCheckListBox(Control).Canvas.Font.Color := clRed;
TCheckListBox(Control).Canvas.Font.Style := [fsBold];
end;
TCheckListBox(Control).Canvas.FillRect(Rect);
sStr := TCheckListBox(Control).Items[Index];
TCheckListBox(Control).Canvas.TextRect(Rect, sStr);
end;
//用來覆寫CheckListBox.OnExit事件,選焦點被移開時,取消停佇項目的反色選取
procedure TForm1.pr_CheckListBox_Exit(Sender: TObject);
begin
TCheckListBox(Sender).ClearSelection;
end;
//執行此函式將畫面上所有的CheckListBox做處理
procedure TForm1.pr_Set_Highlight_For_CheckListBox(AOwner:TWinControl);
var i:Integer;
begin
for i := 0 to Self.ComponentCount-1 do
begin
if Self.Components[i] is TCheckListBox then
begin
TCheckListBox(Self.Components[i]).Style := lbOwnerDrawFixed;
TCheckListBox(Self.Components[i]).OnDrawItem := pr_CheckListBox_OnDrawItem;
TCheckListBox(Self.Components[i]).OnExit := pr_CheckListBox_Exit;
end;
end;
end;
沒有留言:
張貼留言