| Новости | Поиск | 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-17 15:41:00) [1]

> i-am-vladko ©   (17.01.07 15:33) [30]

Вот уже сделал ))

---

i-am-vladko   (2007-01-17 15:33:00) [2]

> Сергей М. ©   (17.01.07 14:42) [29]

Спасибо за замечание - сделаю обработчик message

---

Сергей М.   (2007-01-17 14:42:00) [3]

> интерфейс которого невозможно изменить из другого приложения

Ничто не мешает мне из своего приложения послать окну твоего чекбокса сообщение BM_SETCHECK. Твой компонент успешно получит его и успешно обработает, несмотря на все потуги с UnSaved.

---

i-am-vladko   (2007-01-17 14:36:00) [4]

YPA!!!
получилось ))
Спасибо, _RusLAN - именно там и нужно было копать [24]
Спасибо всем кто помогал в обсуждении. Код работает.
Кому нужно стучитесь в личку - с радость поделюсь - ICQ 292-306-407

---

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

> Сергей М. ©   (17.01.07 13:55) [25]

в private секции действительно не нужны overload, а в protected & public [19]

---

_ruslan   (2007-01-17 14:05:00) [6]

>[24] _RusLAN(c) 17-Jan-2007, 13:48
>Зацикливается функция:
>
>function TSavedCheckBox.IsCheckedStored: Boolean;
>begin
>Result := (self as TButtonControl).IsCheckedStored;
>end;

TButtonControl = class(TWinControl)
  private
   FClicksDisabled: Boolean;
   FWordWrap: Boolean;
   function IsCheckedStored: Boolean;

Я так понимаю что строка

(self as TButtonControl).IsCheckedStored

вызывает метод IsCheckedStored не у TButtonControl, а у
TSavedCheckBox, что и приводит к бесконечному рекурсивному вызову.

---

Сергей М.   (2007-01-17 13:55:00) [7]

> i-am-vladko ©   (17.01.07 12:44) [23]


Self, reintroduce, overload - зачем все это ?

---

_RusLAN   (2007-01-17 13:48:00) [8]

Зацикливается функция:

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

---

i-am-vladko   (2007-01-17 12:44:00) [9]

Run-time работает отлично.

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, uSavedCheckBox, Stdctrls;

type
 TForm1 = class(TForm)
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var SCB : TSavedCheckBox;
begin
 SCB := TSavedCheckBox.Create(self);
 with SCB do
   begin
//      UnSaved := TRUE;  {если убрать // - должна быть реакция на нажатие и т.д. (см Source)}
     Parent := self;
     State := cbUnchecked;
     Checked := not Checked;
     OnClick := nil;
   end;
end;

end.

а как компонент - ну никак
привожу полный код

unit uSavedCheckBox;

interface

uses Classes, StdCtrls, Controls;

type
 TSavedCheckBox = class(TCheckBox)
 private
   FState: TCheckBoxState;
   FOnClick: TNotifyEvent;
   FUnSaved : boolean;
   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);
 protected
   procedure SetChecked(Value: Boolean); reintroduce; override;
   function GetChecked: Boolean; reintroduce; override;
   procedure Click; reintroduce; override;
 public
   property UnSaved: boolean read GetUnSaved write SetUnSaved;
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; 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;
     SetChecked(not GetChecked);
     FUnSaved := FALSE;
    end;
end;

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

destructor TSavedCheckBox.Destroy;
begin
 inherited Destroy;
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 SetChecked(Value);
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.

помогите пожалуйста

---

_RusLAN   (2007-01-17 11:26:00) [10]

>[15] i-am-vladko(c) 16-Jan-2007, 18:52
>бросаю компонент на форму - Stack Overlow и выбрасывает
>Delphi

А вы попробуйте создать его в рантайме, поставте точку остановки в конструкторе, а дальше Ф7, Ф8.

---

vidiv   (2007-01-16 21:33:00) [11]

> trust   (16.01.07 21:29) [20]
> и что ты этим буржуйским выражением хочешь сказать?

если ты в своем классе в разделе private хочешь перекрыть метод родительского объекта из раздела public или protected, то желательно, дополнительно к override, указать директиву reintroduce, и подлый компилятор не будет тебя беспокоить своими бестолковыми варнингами по этому поводу. Вставляя эту директиву, ты ему, какбы, объясняешь, что понимаешь что делаешь =)

---

trust   (2007-01-16 21:29:00) [12]

и что ты этим буржуйским выражением хочешь сказать?

---

vidiv   (2007-01-16 21:23:00) [13]

> насколько мне кажется что в разделе Private вроде нельзя
> переопределять родительские методы

можно...

The reintroducedirective suppresses compiler warnings about hiding previously declared virtual methods

---

trust   (2007-01-16 20:28:00) [14]

Ты много пишешь!? но не разу не написал, что именно выдает в качестве ошибки компилятор..?

---

Virgo_Style   (2007-01-16 20:18:00) [15]

Отладчиком пользоваться религия не велит?

---

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

это в 7
в Delphi 5 про стек ничего не говорит.
точно также выбрасывает при компиляции

---

i-am-vladko   (2007-01-16 18:52:00) [17]

бросаю компонент на форму - Stack Overlow и выбрасывает Delphi
есть только 3 Warnings что :

  procedure SetChecked(Value: Boolean); override;
  function GetChecked: Boolean; override;
  procedure Click; override;

hides virtual methods in base class

---

trust   (2007-01-16 18:46:00) [18]

А, что за ошибку пишет то?

---

i-am-vladko   (2007-01-16 18:39:00) [19]

ya perenes ih v razdel protected - snova tozhe...

---

trust   (2007-01-16 18:39:00) [20]

насколько мне кажется что в разделе Private вроде нельзя переопределять родительские методы..(   procedure SetChecked(Value: Boolean); override;
  function GetChecked: Boolean; override;) если они есть у предка то они должны быть переопределены в разделе protected или я не прав..

---

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

Наверх