Советы по 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;