compon.htm

来自「对于学习很有帮助」· HTM 代码 · 共 1,261 行 · 第 1/3 页

end;

procedure THETreeView.SetSortType(Value: TSortType);
begin
  if SortType <> Value then
  begin
    FSortType := Value;
    if ((SortType in [stData, stBoth]) and Assigned(OnCompare)) or
      (SortType in [stText, stBoth]) then
      AlphaSort;
  end;
end;

procedure THETreeView.LoadFromFile(const AFileName: string);
var
  AList: TStringList;
begin
  AList := TStringList.Create;
  Items.BeginUpdate;
  try
    AList.LoadFromFile(AFileName);
    SetItemList(AList);
  finally
    Items.EndUpdate;
    AList.Free;
  end;
end;

procedure THETreeView.SaveToFile(const AFileName: string);
var
  AList: TStringList;
begin
  AList := TStringList.Create;
  try
    GetItemList(AList);
    AList.SaveToFile(AFileName);
  finally
    AList.Free;
  end;
end;

procedure THETreeView.SetItemList(AList: TStrings);
var
  ALevel, AOldLevel, i, Cnt: Integer;
  S: string;
  ANewStr: string;
  AParentNode: TTreeNode;
  TmpSort: TSortType;

  function GetBufStart(Buffer: PChar; var ALevel: Integer): PChar;
  begin
    ALevel := 0;
    while Buffer^ in [' ', #9] do
    begin
      Inc(Buffer);
      Inc(ALevel);
    end;
    Result := Buffer;
  end;

begin
  //Delete all items - could have used Items.Clear (almost as fast)
  SendMessage(handle, TVM_DELETEITEM, 0, Longint(TVI_ROOT));
  AOldLevel := 0;
  AParentNode := nil;

  //Switch sorting off
  TmpSort := SortType;
  SortType := stNone;
  try
    for Cnt := 0 to AList.Count-1 do
    begin
      S := AList[Cnt];
      if (Length(S) = 1) and (S[1] = Chr($1A)) then Break;

      ANewStr := GetBufStart(PChar(S), ALevel);
      if (ALevel &gt; AOldLevel) or (AParentNode = nil) then
      begin
        if ALevel - AOldLevel &gt; 1 then raise Exception.Create('Invalid TreeNode Level');
      end
      else begin
        for i := AOldLevel downto ALevel do
        begin
          AParentNode := AParentNode.Parent;
          if (AParentNode = nil) and (i - ALevel &gt; 0) then
            raise Exception.Create('Invalid TreeNode Level');
        end;
      end;
      AParentNode := Items.AddChild(AParentNode, ANewStr);
      AOldLevel := ALevel;
    end;
  finally
    //Switch sorting back to whatever it was...
    SortType := TmpSort;
  end;
end;

procedure THETreeView.GetItemList(AList: TStrings);
var
  i, Cnt: integer;
  ANode: TTreeNode;
begin
  AList.Clear;
  Cnt := Items.Count -1;
  ANode := Items.GetFirstNode;
  for i := 0 to Cnt do
  begin
    AList.Add(GetItemText(ANode));
    ANode := ANode.GetNext;
  end;
end;

function THETreeView.GetItemText(ANode: TTreeNode): string;
begin
  Result := StringOfChar(' ', ANode.Level) + ANode.Text;
end;

function THETreeView.AlphaSort: Boolean;
var
  I: Integer;
begin
  if HandleAllocated then
  begin
    Result := CustomSort(nil, 0);
  end
  else Result := False;
end;

function THETreeView.CustomSort(SortProc: TTVCompare; Data: Longint): Boolean;
var
  SortCB: TTVSortCB;
  I: Integer;
  Node: TTreeNode;
begin
  Result := False;
  if HandleAllocated then
  begin
    with SortCB do
    begin
      if not Assigned(SortProc) then lpfnCompare := @DefaultTreeViewSort
      else lpfnCompare := SortProc;
      hParent := TVI_ROOT;
      lParam := Data;
      Result := TreeView_SortChildrenCB(Handle, SortCB, 0);
    end;

    if Items.Count &gt; 0 then
    begin
      Node := Items.GetFirstNode;
      while Node <> nil do
      begin
        if Node.HasChildren then Node.CustomSort(SortProc, Data);
        Node := Node.GetNext;
      end;
    end;
  end;
end;

//Component Registration
procedure Register;
begin
  RegisterComponents('Win95', [THETreeView]);
end;


end.

</PRE><HR>


<P><H1><A NAME="compon9">TBitBtn control class question (change bitmap at runtime)</P></A></H1>
<P><I>&quot;David Zajac&quot; &lt;[e-mail]&gt;</I></P>

Keep in mind that when a property is an object, it has memory associated
with it.When you are changing the value of a bitmap property, somehow the memory
associated with the old value has to be freed, and new memory allocated.
By convention in Delphi, that's what an &quot;Assign&quot; method does.  The code below
works.  <p>

<HR><PRE>implementation

{$R *.DFM}

var n: integer;  // It'll be zero when the program starts

procedure TForm1.Button1Click(Sender: TObject);
var Image: TBitmap;
begin // Changes the bitmap in BitBtn1
  Image:= TBitmap.Create;
  if n &lt; ImageList1.Count then
    ImageList1.GetBitmap(n, Image);
  {end if}

  BitBtn1.Glyph.Assign(Image)   // NOTE: Assign is used to change an object
property

  inc(n,2); // Button Bitmaps hold two images!
  if n &gt; ImageList1.Count then
    n:= 0;
  {end if}
  Image.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin // adds a new button bitmap to ImageList1
  if OpenDialog1.Execute then
    ImageList1.FileLoad(rtBitMap,OpenDialog1.FileName,clBtnFace);
  label1.Caption:= 'ImageCount = ' + IntToStr(ImageList1.Count);
end;
</PRE><HR>


<P><H1><A NAME="compon10">OwnerDraw in TStatusBar</P></A></H1>
<P><I>From: Chris Jobson &lt;[e-mail]&gt;</I></P>

Just write an OnDrawPanel handler for the  StatusBar something like <p>

<HR><PRE>
procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
   Panel: TStatusPanel; const Rect: TRect);
begin
  with statusbar1.Canvas do begin
    Brush.Color := clRed;
    FillRect(Rect);
    TextOut(Rect.Left, Rect.Top, 'Panel '+IntToStr(Panel.Index));
  end;
end;
</PRE><HR>


<P><H1><A NAME="compon11">Duplicating components and their children at runtime</P></A></H1>
<P><I>Gary McGhee &lt;[e-mail]&gt;</I></P>

The following code provides a function called DuplicateComponents that
duplicates any given component and its child components at run time. It
tries to emulate copying and pasting a component at design time. The new
component is created with the same parentage and owner as the original
and all new component names are similar (but different) to their
original. This is provided as is and may have bugs that I haven't found
yet. It is provided because it contains techniques that are not commonly
known and may be of use to people struggling with similar problems.<p>

This procedure is very useful when you want to design a section of an
interface once that will appear n times at run time. You just design it
once visually all on a TPanel or other component as a parent, and then
do &quot;newpanel := DuplicateComponents(designedpanel)&quot;.<p>


<HR><PRE>uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, StdCtrls, IniFiles, TypInfo, Debug;

type
        TUniqueReader = Class(TReader)
                LastRead: TComponent;
                procedure ComponentRead(Component: TComponent);
                procedure       SetNameUnique(
                        Reader: TReader;
                        Component: TComponent;
                        var Name: string
                );
        end;

implementation

procedure TUniqueReader.ComponentRead(
        Component: TComponent
);
begin
        LastRead := Component;
end;

procedure TUniqueReader.SetNameUnique(  // sets the name of the read
component to something like &quot;Panel2&quot; if &quot;Panel1&quot; already exists
        Reader: TReader;
        Component: TComponent;          // component being read
        var Name: string                // Name to use and modify
);
var
        i: Integer;
        tempname: string;
begin
        i := 0;
        tempname := Name;
        while Component.Owner.FindComponent(Name) &lt;&gt; nil do begin
                Inc(i);
                Name := Format('%s%d', [tempname, i]);
        end;
end;


function DuplicateComponents(
        AComponent: TComponent  // original component
): TComponent;                  // returns created new component
        procedure RegisterComponentClasses(
                AComponent: TComponent
        );
        var
                i : integer;
        begin
                RegisterClass(TPersistentClass(AComponent.ClassType));
                if AComponent is TWinControl then
                        if TWinControl(AComponent).ControlCount &gt; 0 then
                                for i := 0 to
(TWinControl(AComponent).ControlCount-1) do

RegisterComponentClasses(TWinControl(AComponent).Controls[i]);
        end;

var
        Stream: TMemoryStream;
        UniqueReader: TUniqueReader;
        Writer: TWriter;
begin
        result := nil;
        UniqueReader := nil;
        Writer := nil;

        try
                Stream := TMemoryStream.Create;
                RegisterComponentClasses(AComponent);

                try
                        Writer := TWriter.Create(Stream, 4096);
                        Writer.Root := AComponent.Owner;
                        Writer.WriteSignature;
                        Writer.WriteComponent(AComponent);
                        Writer.WriteListEnd;
                finally
                        Writer.Free;
                end;

                Stream.Position := 0;
                try
                        UniqueReader := TUniqueReader.Create(Stream, 4096);     // create reader
                        // should probably move these routines into theconstructor
                        UniqueReader.OnSetName := UniqueReader.SetNameUnique;
                        UniqueReader.LastRead := nil;

                        if AComponent is TWinControl then

UniqueReader.ReadComponents(
// read in components and sub-components
                                        TWinControl(AComponent).Owner,
                                        TWinControl(AComponent).Parent,
                                        UniqueReader.ComponentRead
                                )
                        else

UniqueReader.ReadComponents(
// read in components
                                        AComponent.Owner,
                                        nil,
                                        UniqueReader.ComponentRead
                                );
                        result := UniqueReader.LastRead;
                finally
                        UniqueReader.Free;
                end;
        finally
                Stream.Free;
        end;
end;
</PRE><HR>

<P><H1><A NAME="compon12">Splitter Bar </P></A></H1>
<P><I>From: [e-mail] (Adam Redgewell)</I></P>

<PRE>
Bart Mertens &lt;[e-mail]&gt; wrote:
Hi,
I've got a form with a treeview and a memo component on it. They are
both aligned to take up the entire client area. I'd like to put a
splitter bar between them so I can make one wider and the other smaller
or vice versa. Which control can do this or how can I do this?
</PRE>

Assuming your treeview is meant to be on the left and the memo on the
right, you need to do the following: <p>

<UL>
	<LI>Set the Align property for the TreeView to alLeft.
	<LI>Cut (Ctrl-X) the memo component from your form.
	<LI>Add a Panel component and set its Align property to alClient.
	<LI>Click inside the panel and add another Panel component.
	<LI>Set its width to about 8, and its Align property to alLeft.
	<LI>Paste your memo component back into Panel1 and set its Align property to alClient.
</UL>

Panel2 is the divider strip: you now need to add the procedures shown
below. Your code will look something like the following: <p>

<HR><PRE>type
  TForm1 = class(TForm)
    TreeView1: TTreeview;
    Panel1: TPanel;
    Panel2: TPanel;
    Memo1: TMemo;
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseMove(Sender: TObject; Shift:TShiftState;
        X, Y: Integer);
  private
    Resizing: Boolean;
  public
    ...
end;

procedure TForm1.Panel2MouseDown(Sender: TObject; Button:
        TMouseButton;  Shift: TShiftState; X, Y: Integer);
begin
   Resizing:=true;
end;

procedure TForm1.Panel2MouseUp(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
begin
   Resizing:=false;
end;