:: MVP ::
|
|
:: RSS ::
|
|
|
Как изменить Z-порядок контрола вверх или вниз на единицу?
procedure ChangeControlZOrder( Sender: TObject; MoveUp: Boolean = True );
var
i, Curr: Integer;
Control: TControl;
List: TList;
begin
if Sender is TControl then
begin
// Only components of type TControl and descendends work
Control := Sender as TControl;
// Has no parent, cannot move ;-)
if Control.Parent = nil then
Exit;
// Determine position in z-order
Curr := -1;
for i := 0 to Pred(Control.Parent.ControlCount) do
if Control.Parent.Controls[i] = Sender then
begin
Curr := i;
Break;
end;
// Position not found, quit
if Curr < 0 then
Exit;
List := TList.Create;
try
if MoveUp then
begin
for i := Curr+2 to Pred(Control.Parent.ControlCount) do
// Load other controls in group
List.Add(Control.Parent.Controls[i]);
Control.BringToFront;
for i := 0 to Pred(List.Count) do
// Move other controls to front, too
TControl(List[i]).BringToFront;
end
else
begin
for i := 0 to Curr-2 do
// Load other controls in group
List.Add(Control.Parent.Controls[i]);
Control.SendToBack;
for i := Pred(List.Count) downto 0 do
// Move other controls to back, too
TControl(List[i]).SendToBack;
end;
finally
List.Free;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// На 1 позицию вверх
ChangeControlZOrder(Panel1{, True});
// На 1 позицию вниз
ChangeControlZOrder(Panel1, False);
end;
|
Как нарисовать рамку фокуса вокруг активного компонента?
uses
{...,} ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
procedure ActiveControlChange(Sender: TObject);
end;
var
Form1: TForm1;
FocusRect: TShape;
implementation
procedure TForm1.ActiveControlChange(Sender: TObject);
begin
with FocusRect do
begin
Parent := Screen.ActiveControl.Parent;
Top := Screen.ActiveControl.Top - 2;
Height := Screen.ActiveControl.Height + 4;
Left := Screen.ActiveControl.Left - 2;
Width := Screen.ActiveControl.Width + 4;
Visible := True;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FocusRect := TShape.Create(Self);
FocusRect.Shape := stRectangle;
FocusRect.Visible := False;
FocusRect.Brush.Style := bsClear;
FocusRect.Pen.Style := psDot;
FocusRect.Pen.Color := clRed;
FocusRect.Pen.Width := 1;
Screen.OnActiveControlChange := ActiveControlChange;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Screen.OnActiveControlChange := nil;
FocusRect.Free;
end;
|
Как скрыть свойства объекта из Object Inspector'а?
// Спрсоб первый
// Для того, чтобы скрыть свойства, объявленые в published-области,
// но при этом оставить возможность доступа к ним во время работы
// программы, нужно объявить эти свойства "по новой" в public-области.
// В примере скрытым будет свойство Height у объекта TMyControl.
interface
type
TMyControl = class(TWinControl)
protected
procedure SetHeight(Value: Integer);
function GetHeight: Integer;
public
property Height: Integer read GetHeight write SetHeight;
end;
implementation
procedure TMyControl.SetHeight(Value: Integer);
begin
inherited Height := Value;
end;
function TMyControl.GetHeight;
begin
Result := inherited Height;
end;
// Спрсоб второй
// Для того, чтобы скрыть свойства, объявленые в published-области,
// но при этом оставить возможность доступа к ним во время работы
// программы, можно вомпользоваться процедурой RegisterPropertyEditor,
// объявленной в ToolsAPI.pas. Компилятор должен знать путь к этому
// файлу (а находится он в $(BDS)\source\ToolsAPI\).
interface
type
TMyPanel = class(TPanel)
private
protected
public
published
end;
procedure Register;
implementation
uses
DesignIntf;
procedure Register;
begin
RegisterComponents('Decoding', [TMyPanel]);
RegisterPropertyEditor(TypeInfo(Integer), TMyPanel, 'Width', nil);
RegisterPropertyEditor(TypeInfo(Integer), TMyPanel, 'Height', nil);
end;
|
Как рисовать поверх TWinControl?
// Суть примера сводится к перекрытию оконной процедуры, в которой
// вывод графики производится уже непосредственно на канве контрола.
// Попробуйте изменить размеры формы и понаблюдать за поведением линии.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
ButtonsData: array [0..19] of TButton;
procedure GenerateButtons;
procedure ReleaseButtons;
procedure ButtonClick(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function ButtonSubclassProc( hWnd: HWND; Msg: Integer;
wParam: WPARAM; lParam: LPARAM ): LRESULT; stdcall;
var
OldWndProc, LeftOffset, TopOffset: Integer;
WndRect, ParentRect, ParentClientRect: TRect;
TmpCanvas: TCanvas;
X1, Y1, X2, Y2: Integer;
begin
OldWndProc := GetWindowLong(hWnd, GWL_USERDATA);
Result := CallWindowProc(Pointer(OldWndProc), hWnd, Msg, wParam, lParam);
if Msg = WM_PAINT then
begin
GetWindowRect(hWnd, WndRect);
GetWindowRect(GetParent(hWnd ), ParentRect);
GetClientRect(GetParent(hWnd ), ParentClientRect);
TopOffset := (ParentRect.Bottom - ParentRect.Top) -
(ParentClientRect.Bottom - ParentClientRect.Top);
LeftOffset := (ParentRect.Right - ParentRect.Left) -
(ParentClientRect.Right - ParentClientRect.Left);
X1 := ParentClientRect.Left + LeftOffset div 2 -
(WndRect.Left - ParentRect.Left);
Y1 := ParentClientRect.Top + TopOffset -
(WndRect.Top - ParentRect.Top) - LeftOffset div 2;
X2 := X1 + (ParentClientRect.Right - ParentClientRect.Left);
Y2 := Y1 + (ParentClientRect.Bottom - ParentClientRect.Top);
TmpCanvas := TCanvas.Create;
try
TmpCanvas.Handle := GetDC(hWnd);
TmpCanvas.Pen.Color := clRed;
TmpCanvas.Pen.Width := 4;
TmpCanvas.MoveTo(X1, Y1);
TmpCanvas.LineTo(X2, Y2);
finally
ReleaseDC(hWnd, TmpCanvas.Handle);
TmpCanvas.Free;
end;
end;
end;
procedure TForm1.ButtonClick(Sender: TObject);
begin
ReleaseButtons;
GenerateButtons;
Invalidate;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DoubleBuffered := True;
GenerateButtons;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ReleaseButtons;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Pen.Color := clRed;
Canvas.Pen.Width := 4;
Canvas.MoveTo(0, 0);
Canvas.LineTo(ClientWidth, ClientHeight);
end;
procedure TForm1.FormResize(Sender: TObject);
var
i: Integer;
begin
for i := 0 to 19 do
ButtonsData[i].Invalidate;
Invalidate;
end;
procedure TForm1.GenerateButtons;
var
i: Integer;
begin
Randomize;
for i := 0 to 19 do
begin
ButtonsData[i] := TButton.Create(Self);
ButtonsData[i].Parent := Self;
ButtonsData[i].Left := Random(ClientWidth - ButtonsData[i].Width);
ButtonsData[i].Top := Random(ClientHeight - ButtonsData[i].Height);
ButtonsData[i].Caption := 'Button' + IntToStr(i+1);
ButtonsData[i].OnClick := ButtonClick;
SetWindowLong(ButtonsData[i].Handle, GWL_USERDATA,
GetWindowLong(ButtonsData[i].Handle, GWL_WNDPROC));
SetWindowLong(ButtonsData[i].Handle, GWL_WNDPROC,
Integer(@ButtonSubclassProc));
end;
end;
procedure TForm1.ReleaseButtons;
var
i: Integer;
begin
for i := 0 to 19 do
ButtonsData[i].Free;
end;
end.
|
Как построить дерево контролов/компонентов формы?
type
TForm1 = class(TForm)
Button1: TButton;
TreeView1: TTreeView;
Panel1: TPanel;
Image1: TImage;
ActionList1: TActionList;
FlowPanel1: TFlowPanel;
TrayIcon1: TTrayIcon;
BalloonHint1: TBalloonHint;
BitBtn1: TBitBtn;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
private
procedure Scan(RootControl: TWinControl; RootNode: TTreeNode);
{...}
end;
implementation
procedure TForm1.Button1Click(Sender: TObject);
begin
Scan(Self, nil);
end;
procedure TForm1.Scan(RootControl: TWinControl; RootNode: TTreeNode);
var
i: Integer;
Node: TTreeNode;
begin
Node := TreeView1.Items.AddChild(RootNode,
RootControl.Name + ' [' +
RootControl.ClassName + ']'
);
for i := 0 to RootControl.ControlCount-1 do
begin
if RootControl.Controls[i] is TWinControl then
begin
Scan(RootControl.Controls[i] as TWinControl, Node);
Continue;
end;
TreeView1.Items.AddChild(Node,
RootControl.Controls[i].Name + ' [' +
RootControl.Controls[i].ClassName + ']'
);
end;
for i := 0 to RootControl.ComponentCount-1 do
begin
if not (RootControl.Components[i] is TControl) then
if RootControl.Components[i].Name <> '' then
TreeView1.Items.AddChild(Node,
RootControl.Components[i].Name + ' [' +
RootControl.Components[i].ClassName + ']'
);
end;
end;
procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
begin
Node.AlphaSort;
end;
|
При использовании материала - ссылка на сайт обязательна
|
|