compon.htm
来自「对于学习很有帮助」· HTM 代码 · 共 1,261 行 · 第 1/3 页
HTM
1,261 行
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<HTML>
<HEAD>
<TITLE>UDDF - Component</TITLE>
<META NAME="Description" CONTENT="Components section of the Delphi Developers FAQ" >
<META NAME="KeyWords" CONTENT="" >
</HEAD>
<BODY LINK="#0000ff" VLINK="#800080" BGCOLOR="#ffffff">
<CENTER>
<IMG SRC="../images/uddf.jpg"> </CENTER>
<P><HR SIZE=6 color="#00FF00"></P>
<FONT FACE="Arial Black" SIZE=7 COLOR="#ff0000"><P ALIGN="CENTER">Components</FONT> </P>
<H1><A NAME="compon0">Array of components...</A></H1>
<I><P>From: Lode Deleu <101612.1454@compuserve.com></P>
</I><CODE><P>> Is it possible to create an array of components?
I'm using a LED component for a status display, and I'd like to be able to access it via: </P>
</CODE><P>First of all, you'l need to declare the array:</P>
<PRE> LED : array[1..10] of TLed; (TLed being your led component type)</PRE>
<P>if you would create the LED components dynamically, you could do this during a loop like this :</P>
<PRE> for counter := 1 to 10 do
begin
LED[counter]:= TLED.Create;
LED[counter].top := ...
LED[counter].Left := ...
LED[counter].Parent := Mainform; {or something alike}
end;</PRE>
<P>If the components already exist on your form (visually designed), you could simply assign
them to the array like this:</P>
<PRE> leds := 0;
for counter := 0 to Form.Componentcount do
begin
if (components[counter] is TLED) then
begin
inc(leds);
LED[leds] := TLED(components[counter]);
end
end;</PRE>
<P>This however leaves you with a random array of LED's, I suggest you give each LED a tag in
the order they should be in the array, and then fill the array using the tag :</P>
<PRE> for counter := 0 to Form.Componentcount do
begin
if (components[counter] is TLED) then
begin
LED[Component[counter].tag] := TLED(components[counter]);
end
end;</PRE>
<P>if you need a two dimensional array, you'll need to find another trick to store the index,
I've used the hint property a number of times to store additional information.</P>
<H1><A NAME="compon1">how do i getting the component index at runtime</A></H1>
<I><P>From: baisa@tor.hookup.net (Brad Aisa)</P>
</I>
<CODE><P>In article <4uevrf$331@duke.telepac.pt>, delphinidae@mail.telepac.pt (Claudio Tereso) wrote:
>i need to find the component index in the parent's order.
>i tried to modify prjexp.dll but with success?
>does any one have an idea? </P>
</CODE>
<P>Here is a function that does this. It gets the parent control, and then iterates through its children,
looking for a match. This has been tested and works.</P>
<P><HR></P>
<PRE>{ function to return index order of a component in its parent's
component collection; returns -1 if not found or no parent }
function IndexInParent(vControl: TControl): integer;
var
ParentControl: TWinControl;
begin
{we "cousin" cast to get at the protected Parent property in base class }
ParentControl := TForm(vControl.Parent);
if (ParentControl <> nil) then
begin
for Result := 0 to ParentControl.ControlCount - 1 do
begin
if (ParentControl.Controls[Result] = vControl) then Exit;
end;
end;
{ if we make it here, then wasn't found, or didn't have parent}
Result := -1;
end;</PRE>
<P><HR></P>
<H1><A NAME="compon2">How do I create a component at run-time?</A></H1>
<I><P>From: m.a.vaughan@larc.nasa.gov (Mark Vaughan)</P>
</I><P><HR></P>
<PRE>Var
MyButton : TButton;
MyButton := TButton.Create(MyForm); // MyForm now "owns" MyButton
with MyButton do
BEGIN
Parent := MyForm; // here MyForm is also the parent of MyButton
height := 32;
width := 128;
caption := 'Here I Am!';
left := (MyForm.ClientWidth - width) div 2;
top := (MyForm.ClientHeight - height) div 2;
END;</PRE>
<P><HR></P>
<P>Borland also publishes one of their TechInfo sheets on this subject.</P>
<P>Look for</P>
<EM><P>ti2938.asc Creating Dynamic Components at Runtime</EM> </P>
<P>which you can get from Borland's web site or ftp site.</P>
<H1><A NAME="compon3">Create an event during Runtime?</A></H1>
<I><P>From: "Hustin Olivier" <ohu@eortc.be></P>
</I><P>Definition of memo's properties</P>
<P><HR></P>
<PRE>memo.onchange:=memo1Change;
procedure TForm1.Memo1Change(Sender: TObject);
begin
panel1.caption:='Content has been changed';
end;</PRE>
<P><HR></P>
<H1><A NAME="compon4">3D border for label component?</A></H1>
<I><P>From: Mark Pritchard <pritchma@ozemail.com.au></P>
</I><P>Here is a free one (took around half an hour to put together, it doesn't grab the parent
font correctly, but I couldn't be bothered putting any more time into it) -</P>
<P><HR></P>
<PRE>unit IDSLabel;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
ExtCtrls;
type
TIDSLabel = class(TBevel)
private
{ Private declarations }
FAlignment : TAlignment;
FCaption : String;
FFont : TFont;
FOffset : Byte;
FOnChange : TNotifyEvent;
procedure SetAlignment( taIn : TAlignment );
procedure SetCaption( const strIn : String);
procedure SetFont( fntNew : TFont );
procedure SetOffset( bOffNew : Byte );
protected
{ Protected declarations }
constructor Create( compOwn : TComponent ); override;
destructor Destroy; override;
procedure Paint; override;
public
{ Public declarations }
published
{ Published declarations }
property Alignment : TAlignment read FAlignment write SetAlignment default taLeftJustify;
property Caption : String read FCaption write SetCaption;
property Font : TFont read FFont write SetFont;
property Offset : Byte read FOffset write SetOffset;
property OnChange : TNotifyEvent read FOnChange write FOnChange;
end;
implementation
constructor TIDSLabel.Create;
begin
inherited Create(compOwn);
FFont := TFont.Create;
with compOwn as TForm do
FFont.Assign(Font);
Offset := 4;
Height := 15;
end;
destructor TIDSLabel.Destroy;
begin
FFont.Free;
inherited Destroy;
end;
procedure TIDSLabel.Paint;
var
wXPos, wYPos : Word;
begin
{Draw the bevel}
inherited Paint;
{Retreive the font}
Canvas.Font.Assign(Font);
{Calculate the y position}
wYPos := (Height - Canvas.TextHeight(Caption)) div 2;
{Calculate the x position}
wXPos := Offset;
case Alignment of
taRightJustify: wXPos := Width - Canvas.TextWidth(Caption) - Offset;
taCenter: wXPos := (Width - Canvas.TextWidth(Caption)) div 2;
end;
Canvas.Brush := Parent.Brush;
Canvas.TextOut(wXPos,wYPos,Caption);
end;
procedure TIDSLabel.SetAlignment;
begin
FAlignment := taIn;
Invalidate;
end;
procedure TIDSLabel.SetCaption;
begin
FCaption := strIn;
if Assigned(FOnChange) then
FOnChange(Self);
Invalidate;
end;
procedure TIDSLabel.SetFont;
begin
FFont.Assign(fntNew);
Invalidate;
end;
procedure TIDSLabel.SetOffset;
begin
FOffset := bOffNew;
Invalidate;
end;
end.</PRE>
<P><HR></P>
<H1><A NAME="compon5">Setting read-only columns in StringGrid</A></H1>
<I><P>From: Mark Pritchard <pritchma@ozemail.com.au></P>
</I><P>In the OnSelectCell event, this works fine (every even column is editable) -</P>
<P><HR></P>
<PRE> if Col mod 2 = 0 then
grd.Options := grd.Options + [goEditing]
else
grd.Options := grd.Options - [goEditing];</PRE>
<P><HR></P>
<H1><A NAME="compon6">?? Scrolling a Memo ??</A></H1>
<I><P>From: Eddie Shipman <eshipman@slip.net></P>
</I><P>Found the answer on my own on Delphi WWW Forum.</P>
<P><HR></P>
<PRE>Var
ScrollMessage:TWMVScroll;
ScrollMessage.Msg:=WM_VScroll;
for i := Memo1.Lines.Count DownTo 0 do
begin
ScrollMessage.ScrollCode:=sb_LineUp;
ScrollMessage.Pos:=0;
Memo1.Dispatch(ScrollMessage);
end;</PRE>
<P><HR></P>
<H1><A NAME="compon7">BMPs in a StringGrid</A></H1>
<I><P>From: "James D. Rofkar" <jim_rofkar%lotusnotes1@instinet.com></P>
</I><PRE>Darren Clements wrote:
> How can I put a Bitmap in a StringGrid cell?</PRE>
<P>In your StringGrid's OnDrawCell event handler, place some code that resembles:</P>
<P><HR></P>
<PRE> with StringGrid1.Canvas do
begin
{...}
Draw(Rect.Left, Rect.Top, Image1.Picture.Graphic);
{...}
end;</PRE>
<P><HR></P>
<P>Using the Draw() or StretchDraw() method of TCanvas should do the trick.
BTW, Image1 above is a TImage with a bitmap already loaded into it.</P>
<P><H1><A NAME="compon8">TTreeview-speedup</P></A></H1>
<P><I>Haakon Eines <haakon.eines@finale.no></I></P>
Here's a little TreeView-component that might be a little bit faster
than the default TTreeView from Borland. You also have the ability to
set the items text to bold (It's implemented as methods of the treeview,
but should have been a TTreeNode's property. Since I can't release VCL
source code - methods it is). <p>
<PRE>Some timings:
TTreeView:
128 sec. to load 1000 items (no sorting)*
270 sec. to save 1000 items (4.5 minutes!!!)
THETreeView:
1.5 sec. to load 1000 items - about 850% faster!!! (2.3 seconds
with sorting = stText)*
0.7 sec. to save 1000 items - about 3850% faster!!!
</PRE>
NOTES:
<UL>
<LI>All timings performed on a slow 486SX 33 MhZ, 20 Mb RAM.
<LI>If the treeview is empty, loading takes 1.5 seconds,
else add 1.5 seconds to clear 1000 items
(a total loading time of 3 seconds).
This is also the case for the TTreeView component
(a total of 129.5 seconds).
The process of clearing the items, is a call to
SendMessage(hwnd, TVM_DELETEITEM, 0, Longint(TVI_ROOT)).
</UL>
Have fun playing with the component.
<HR><PRE>
unit HETreeView;
{$R-}
// Made by: Håkon Eines
// EMail: haakon.eines@finale.no
// Date: 21.01.1997
// Description: A Speedy TreeView?
(*
TTREEVIEW:
128 sec. to load 1000 items (no sorting)*
270 sec. to save 1000 items (4.5 minutes!!!)
THETREEVIEW:
1.5 sec. to load 1000 items - about 850% faster!!! (2.3 seconds with sorting = stText)*
0.7 sec. to save 1000 items - about 3850% faster!!!
NOTES:
- All timings performed on a slow 486SX 33 MhZ, 20 Mb RAM.
- * If the treeview is empty, loading takes 1.5 seconds,
else add 1.5 seconds to clear 1000 items (a total loading time of 3 seconds).
This is also the case for the TTreeView component (a total of 129.5 seconds).
The process of clearing the items, is a call to
SendMessage(hwnd, TVM_DELETEITEM, 0, Longint(TVI_ROOT)).
*)
interface
uses
SysUtils, Windows, Messages, Classes, Graphics,
Controls, Forms, Dialogs, ComCtrls, CommCtrl, tree2vw;
type
THETreeView = class(TTreeView)
private
FSortType: TSortType;
procedure SetSortType(Value: TSortType);
protected
function GetItemText(ANode: TTreeNode): string;
public
constructor Create(AOwner: TComponent); override;
function AlphaSort: Boolean;
function CustomSort(SortProc: TTVCompare; Data: Longint): Boolean;
procedure LoadFromFile(const AFileName: string);
procedure SaveToFile(const AFileName: string);
procedure GetItemList(AList: TStrings);
procedure SetItemList(AList: TStrings);
//'Bold' should have been a property of TTreeNode, but...
function IsItemBold(ANode: TTreeNode): Boolean;
procedure SetItemBold(ANode: TTreeNode; Value: Boolean);
published
property SortType: TSortType read FSortType write SetSortType default stNone;
end;
procedure Register;
implementation
function DefaultTreeViewSort(Node1, Node2: TTreeNode; lParam: Integer): Integer; stdcall;
begin
{with Node1 do
if Assigned(TreeView.OnCompare) then
TreeView.OnCompare(Node1.TreeView, Node1, Node2, lParam, Result)
else}
Result := lstrcmp(PChar(Node1.Text), PChar(Node2.Text));
end;
constructor THETreeView.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FSortType := stNone;
end;
procedure THETreeView.SetItemBold(ANode: TTreeNode; Value: Boolean);
var
Item: TTVItem;
Template: Integer;
begin
if ANode = nil then Exit;
if Value then Template := -1
else Template := 0;
with Item do
begin
mask := TVIF_STATE;
hItem := ANode.ItemId;
stateMask := TVIS_BOLD;
state := stateMask and Template;
end;
TreeView_SetItem(Handle, Item);
end;
function THETreeView.IsItemBold(ANode: TTreeNode): Boolean;
var
Item: TTVItem;
begin
Result := False;
if ANode = nil then Exit;
with Item do
begin
mask := TVIF_STATE;
hItem := ANode.ItemId;
if TreeView_GetItem(Handle, Item) then
Result := (state and TVIS_BOLD) <> 0;
end;
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?