Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001
Денежное поле редактирования
Delphi 1
unit CurrEdit;
interface
uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Menus, Forms, Dialogs, StdCtrls;
type TCurrencyEdit = class(TCustomMemo)
private
DispFormat: string;
FieldValue: Extended;
procedure SetFormat(A: string);
procedure SetFieldValue(A: Extended);
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure FormatText;
procedure UnFormatText;
protected
procedure KeyPress(var Key: Char); override;
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
published
property Alignment default taRightJustify;
property AutoSize default True;
property BorderStyle;
property Color;
property Ctl3D;
property DisplayFormat: string read DispFormat write SetFormat;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property MaxLength;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property Value: Extended read FieldValue write SetFieldValue;
property Visible;
property OnChange;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Additional', [TCurrencyEdit]);
end;
constructor TCurrencyEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
AutoSize := True;
Alignment := taRightJustify;
Width := 121;
Height := 25;
DispFormat := '$,0.00;($,0.00)';
FieldValue := 0.0;
AutoSelect := False;
WantReturns := False;
WordWrap := False;
FormatText;
end;
procedure TCurrencyEdit.SetFormat(A: String);
begin
if DispFormat <> A then begin
DispFormat:= A;
FormatText;
end;
end;
procedure TCurrencyEdit.SetFieldValue(A: Extended);
begin
if FieldValue <> A then begin
FieldValue := A;
FormatText;
end;
end;
procedure TCurrencyEdit.UnFormatText;
var
TmpText : String;
Tmp : Byte;
IsNeg : Boolean;
begin
IsNeg := (Pos('-',Text) > 0) or (Pos('(',Text) > 0);
TmpText := '';
For Tmp := 1 to Length(Text) do
if Text[Tmp] in ['0'..'9','.'] then
TmpText := TmpText + Text[Tmp];
try
FieldValue := StrToFloat(TmpText);
if IsNeg then FieldValue := -FieldValue;
except
MessageBeep(mb_IconAsterisk);
end;
end;
procedure TCurrencyEdit.FormatText;
begin
Text := FormatFloat(DispFormat,FieldValue);
end;
procedure TCurrencyEdit.CMEnter(var Message: TCMEnter);
begin
SelectAll;
inherited;
end;
procedure TCurrencyEdit.CMExit(var Message: TCMExit);
begin
UnformatText;
FormatText;
Inherited;
end;
procedure TCurrencyEdit.KeyPress(var Key: Char);
begin
if Not (Key in ['0'..'9','.','-']) Then Key := #0;
inherited KeyPress(Key);
end;
procedure TCurrencyEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
case Alignment of
taLeftJustify : Params.Style := Params.Style or ES_LEFT and Not ES_MULTILINE;
taRightJustify: Params.Style := Params.Style or ES_RIGHT and Not ES_MULTILINE;
taCenter : Params.Style := Params.Style or ES_CENTER and Not ES_MULTILINE;
end;
end;
end.
Отслеживаем позицию курсора в EditBox
Совет от читателя
The_Sprite советует:
В форму добавляются TEditBox и TLabel, при этом TLabel постоянно показывает позицию курсора в элементе редактирования.
Совместимость: Все версии Delphi
Пример:
procedure TForm1.Edit1Change(Sender: TObject);
begin
CurPos := Edit1.SelStart;
Label1.Caption := IntToStr(CurPos);
end;
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
If Key = VK_LEFT then dec(CurPos);
if Key = VK_RIGHT then inc(CurPos);
Label1.Caption:= IntToStr(CurPos);
end;
GroupBox
Рисование на GroupBox
Я хочу рисовать на холсте (Canvas) моего компонента GroupBox. Но когда я пробую рисовать на Component.Parent.Canvas, рисование происходит на форме, а не на моем компоненте GroupBox. Что я делаю неправильно?
Canvas – защищенное свойство TGroupBox и, поэтому, недоступное. Вы можете сделать его доступным следующим образом:
type TMyGroupBox = class(TGroupBox)
public
property Canvas;
end;
procedure SomeProcedure;
begin
…
with TMyGroupBox(GroupBox1).Canvas do
CopyRect(ClipRect, Image1.Canvas, ClipRect);
…
end;
– Ralph Friedman
Доступ к компонентам GroupBox
Delphi 1
Одно из свойств всех элементов управления – указатель на другие элементы, которые он содержит. Это свойство – свойство Controls, которое индексируется наподобие массива. Количество элементов управления содержится в свойстве ControlCount. Если вы хотите получить доступ к свойству или методу, которого нет у TControl, вам неоходимо осуществить приведение типа элемента списка.
procedure DoSomethingWithAGroupBox;
var i: integer;
begin
with AGroupBox do
for i := 0 to ControlCount - 1 do
if controls[i] is TEdit then
TEdit(controls[i]).text := 'Как насчет этого?';
end;
end;
Приведенный выше пример будет работать, если элементом управления является TEdit или его наследник, например, TDBEdit или TMaskEdit. Все объекты могут быть приведены к типу одного из объектов, являющегося наследником базового типа (или им самим). Но не спешите приводить все к родительскому классу, родитель в данном случае здесь не подходит, поскольку он означает объект, который содержит сам себя.
Label
Как сделать бегущую строку?
Письмо читателя
The_Sprite отвечает:
с помощью TLabel и TTimer. Пример:
procedure TForm1.Timer1Timer(Sender: TObject);
Const
LengthGoString = 10;
GoString = 'В конце строку желательно повторить,'+
' чтоб получить эффект кольцевого движения! В конце ст';
Const i: Integer = 1;
