| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

SavedCheckBox [D5, D7, WinXP]

Страницы:   < 1 2 >

i-am-vladko ©   (2007-01-12 13:30:00) 

Хочу создать CheckBox, некоторый интерфейс которого невозможно изменить из другого приложения, если флаг UnSaved = FALSE - вот что есть...
unit uSavedCheckBox;

interface

uses Classes, StdCtrls, Controls;

type
 TSavedCheckBox = class(TCheckBox)
 private
   FState: TCheckBoxState;
   FTabOrder: Integer;
   FOnClick: TNotifyEvent;
   FUnSaved : boolean;
   procedure SetChecked(Value: Boolean); override;
   function GetChecked: Boolean; override;
   procedure Click; override;
   function IsCaptionStored: Boolean; overload;
   function IsCheckedStored: Boolean; overload;
   function IsOnClickStored: Boolean; overload;
   procedure SetState(const Value: TCheckBoxState); overload;
   function GetUnSaved: boolean;
   procedure SetUnSaved(const Value: boolean);
   function GetOnClick: TNotifyEvent;
   procedure SetOnClick(const Value: TNotifyEvent);
 public
   property UnSaved: boolean read GetUnSaved write SetUnSaved;
   constructor Create(AOwner: TComponent); override;
 published
   property Checked: Boolean read GetChecked write SetChecked stored IsCheckedStored default False;
   property State: TCheckBoxState read FState write SetState default cbUnchecked;
   property OnClick: TNotifyEvent read GetOnClick write SetOnClick stored IsOnClickStored;
   property TabOrder;
   property Action;
   property Alignment;
   property AllowGrayed;
   property Anchors;
   property BiDiMode;
   property Caption;
   property Color;
   property Constraints;
   property Ctl3D;
   property DragCursor;
   property DragKind;
   property DragMode;
   property Enabled;
   property Font;
   property ParentBiDiMode;
   property ParentColor;
   property ParentCtl3D;
   property ParentFont;
   property ParentShowHint;
   property PopupMenu;
   property ShowHint;
   property TabStop;
   property Visible;
   property OnContextPopup;
   property OnDragDrop;
   property OnDragOver;
   property OnEndDock;
   property OnEndDrag;
   property OnEnter;
   property OnExit;
   property OnKeyDown;
   property OnKeyPress;
   property OnKeyUp;
   property OnMouseDown;
   property OnMouseMove;
   property OnMouseUp;
   property OnStartDock;
   property OnStartDrag;
 end;

procedure Register;

implementation

procedure Register;
begin
 RegisterComponents('alpha', [TSavedCheckBox]);
end;

{ TSavedCheckBox }

procedure TSavedCheckBox.Click;
begin
 if GetUnSaved
   then inherited Click
   else
    begin
     FUnSaved := TRUE;
     Checked := not Checked;
     FUnSaved := FALSE;
    end;
end;

constructor TSavedCheckBox.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 SetUnSaved(FALSE);
end;

function TSavedCheckBox.GetChecked: Boolean;
begin
 Result := inherited GetChecked;
end;

function TSavedCheckBox.GetOnClick: TNotifyEvent;
begin
 Result := FOnClick;
end;

function TSavedCheckBox.GetUnSaved: boolean;
begin
 Result := (csDesigning in ComponentState) or
           (csWriting in ComponentState) or
           (csLoading in ComponentState) or
            FUnSaved;
end;

function TSavedCheckBox.IsCaptionStored: Boolean;
begin
 Result := (self as TControl).IsCaptionStored;
end;

function TSavedCheckBox.IsCheckedStored: Boolean;
begin
 Result := (self as TButtonControl).IsCheckedStored;
end;

function TSavedCheckBox.IsOnClickStored: Boolean;
begin
 Result := TRUE;
end;

procedure TSavedCheckBox.SetChecked(Value: Boolean);
begin
 if GetUnSaved then inherited;
end;

procedure TSavedCheckBox.SetOnClick(const Value: TNotifyEvent);
begin
 if GetUnSaved then FOnClick := Value;
end;

procedure TSavedCheckBox.SetState(const Value: TCheckBoxState);
begin
 if GetUnSaved then inherited;
end;

procedure TSavedCheckBox.SetUnSaved(const Value: boolean);
begin
 if (csDesigning in ComponentState)
   then FUnSaved := TRUE
   else FUnSaved := Value;
end;

end.


Проблема - Delphi выбрасывает при попытке компиляции. Уважаемые Мастера, подскажите из-за чего.

---

i-am-vladko   (2007-01-16 18:37:00) [21]

tak vse-taki, v 4em delo?

---

i-am-vladko   (2007-01-16 10:44:00) [22]

одну рекурсию увидел -
    Checked := not Checked;
изменил на    
    SetChecked(not GetChecked);
и опять 25...

---

icWasya   (2007-01-15 17:21:00) [23]

Вот я этот текст скомпилировал [D5]- 3 варнинга и один хинт, и никаких ShackOverflow :)

---

Плохиш   (2007-01-15 16:40:00) [24]

> i-am-vladko ©   (12.01.07 13:30)  
> Проблема - Delphi выбрасывает при попытке компиляции.


> i-am-vladko ©   (15.01.07 16:30) [6]
> Stack overlow - и из-за чего...

Не люблю врунов...

---

Сергей М.   (2007-01-15 16:39:00) [25]

Переполнение стека.

В ран-таймвозникает, как правило, при бесконечной рекурсии.

При компиляции возникнуть может лишь теоретически при наличии ошибок в самом компиляторе, что к твоему случаю никоим образом не относится.

---

i-am-vladko   (2007-01-15 16:30:00) [26]

Stack overlow - и из-за чего...

---

Сергей М.   (2007-01-15 14:44:00) [27]

> в какой хоть стороне искать?


Просто разуй глаза, почитай внимательно сообщение компилятора и вникни в то о чем он тебе говорит

---

Amoeba   (2007-01-15 14:42:00) [28]

> Проблема - Delphi выбрасывает при попытке компиляции.

Неужели при этом ничего при этом не сообщает и не показывает некомпилируемую строку в тексте программы?

---

i-am-vladko   (2007-01-15 14:29:00) [29]

в какой хоть стороне искать?

---

i-am-vladko   (2007-01-13 16:16:00) [30]

> Сергей М. ©   (12.01.07 16:15) [1]


> Какой конкретно - это военная тайна.

mda...

---

Сергей М.   (2007-01-12 16:15:00) [31]

> подскажите из-за чего


Из-за ошибки в тексте программы.

Какой конкретно - это военная тайна.

---

Страницы:   < 1 2 >

Наверх