Валентин Озеров - Советы по Delphi. Версия 1.0.6

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

{Рисуем рамку}

inherited Paint;

{Назначаем шрифт}

Canvas.Font.Assign(Font);

{Вычисляем вертикальную позицию}

wYPos:= (Height – Canvas.TextHeight(Caption)) div 2;

{Вычисляем горизонтальную позицию}

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.

Решить задачу помогут обработчики событий OnScroll (в данном примере два компонента ScrollBox (ScrollBar1 и ScrollBar2) расположены на форме TMainForm):

procedure TMainForm.ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);

begin

ScrollBar2.Position:= ScrollPos;

end;

procedure TMainForm.ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);

begin

ScrollBar1.Position:= ScrollPos;

end;

У меня есть форма с расположенными на ней компонентами TreeView и Memo. Значение свойства align обоих компонентов позволяет им занимать всю форму. Я хотел бы расположить между ними движок типа Splitter, пропорционально меняющий их размеры (один шире, другой меньше и наоборот), но к сожалению я обладаю лишь дистрибутивом Delphi2 ( Splitter вошел в палитру только в Delphi3). Какой компонент мог бы сымитировать поведение Splitter и как это реализовать?

Предположим, Ваш TreeView расположен в левой, а Memo в правой части формы. Вам нужно сделать следующее:

• Установите свойство Align компонента TreeView на alLeft.

• Вырежьте (Ctrl-X) компонент TMemo из вашей формы.

• Добавьте компонент Panel и присвойте его свойству Align значение alClient.

• Внутри панели разместите другой компонент Panel.

• Установите его ширину, равной 8 пикселам, свойству Align присвойте значение alLeft.

• Скопируйте вырезанный компонент TMemo в панель Panel1 и присвойте свойству Align значение alClient.

Panel2 – движок: теперь вам необходимо добавить процедуры, приведенные ниже. Ваш код будет выглядеть приблизительно так:

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;

procedure TForm1.Panel2MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

if Resizing then begin

TreeView1.Width:=TreeView1.Width+X;

// Предохранение от странных ошибок перерисовки при изменении размеров: