Текущий архив: 2006.07.16;
Скачать: CL | DM;

Вниз

SetXXXXValue и class   Найти похожие ветки 

← →
sco ©   (2005-12-24 13:43) [0]

Усть типы:
unit TypesForIconButton;
interface
uses Graphics, Classes;
type
 TIconButtonPosition = (normal,pressed,light,none);
 TIco = record
  image: TIcon;
  width,heigth: integer;
 end;
 TIBData = class(TPersistent)
 public
  normal: TIco;
  pressed: TIco;
  light: TIco;
  none: TIco;
 published
  constructor create(AOwner: TComponent);
  destructor destroy; override;
 end;
implementation
constructor TIBData.Create(AOwner: TComponent);
begin
 normal.image:=TIcon.Create;
 pressed.image:=TIcon.Create;
 light.image:=TIcon.Create;
 none.image:=TIcon.Create;
end;
destructor TIBData.destroy;
begin
 normal.image.Destroy;
 pressed.image.Destroy;
 light.image.Destroy;
 none.image.Destroy;
end;
end.
И есть свойство с этим типом(TIBData), я написал ему редактор зарегистрил, но что-то не могу писвоить этому свойству значение! Там всякие SetOrdValue,SetVarValue,..., но мне не один не подходит(даже var)! Так как присвоить значение? Иначе ведь в чём смысл редактора?

---

← →
Sco ©   (2005-12-24 13:45) [1]

И ещё, это нормально что при составлении редактора свойства Делфи катапултируется через каждые пол минуты по поводу и без повода?
Просто уже запарился грузить по 100 раз за час!

---

← →
sco ©   (2005-12-24 14:13) [2]

unit IconButton;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Dialogs, Controls, Forms, ExtCtrls, StdCtrls,
 DesignIntf, DesignEditors, TypesForIconButton;

type
 TIcoProperty = class(TPropertyEditor)
 public
  function GetAttributes: TPropertyAttributes; override;
  procedure GetProperties(Proc: TGetPropProc); override;
  procedure Edit; override;
  function GetValue: string; override;
 end;

 TIconButton = class(TImage)
 private
   FPosition: TIconButtonPosition;
   FIData: TIBData;
   FCheck: boolean;
   procedure SetPosition(value: TIconButtonPosition);
   procedure SetIconData(value: TIBData);
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   procedure Click; override;
 published
   procedure RefreshIcon;
   property position: TIconButtonPosition read FPosition write SetPosition;
   property IconData: TIBData read FIData write SetIconData;
   property Check: boolean read FCheck write FCheck;
   property Align;
   property Anchors;
   property AutoSize;
   property Center;
   property Constraints;
   property DragCursor;
   property DragKind;
   property DragMode;
   property Enabled;
   property IncrementalDisplay;
   property ParentShowHint;
   property PopupMenu;
   property Proportional;
   property ShowHint;
   property Stretch;
   property Transparent;
   property Visible;
   property OnClick;
   property OnContextPopup;
   property OnDblClick;
   property OnDragDrop;
   property OnDragOver;
   property OnEndDock;
   property OnEndDrag;
   property OnMouseDown;
   property OnMouseMove;
   property OnMouseUp;
   property OnProgress;
   property OnStartDock;
   property OnStartDrag;
 end;

procedure Register;

implementation

uses IcoLoad;

procedure TIcoProperty.GetProperties(Proc: TGetPropProc);
var
 I: Integer;
begin
end;

procedure Register;
begin
 RegisterComponents("Standard", [TIconButton]);
 RegisterPropertyEditor(TypeInfo(TIBData),TIconButton,"",TIcoProperty);
end;

function TIcoProperty.GetValue: string;
begin
result:="Иконки";
end;

procedure TIcoProperty.Edit;
var
text: string;
EditForm: TLoadIcoForm;
temp: variant;
b: TIBdata;
begin
ShowMessage("beginEdit");
Application.CreateForm(TLoadIcoForm, EditForm);
// EditForm.execute;
b:=EditForm.Execute;

EditForm.Destroy;
end;

function TIcoProperty.GetAttributes: TPropertyAttributes;
begin
// ShowMessage("beginGetAttributes");
Result:=[paDialog]+[paSubProperties];
// ShowMessage("endGetAttributes");
end;

procedure TIconButton.SetPosition(value: TIconButtonPosition);
begin
ShowMessage("beginSetPosition");
FPosition:=value;
if enabled then RefreshIcon;
ShowMessage("endSetPosiotion");
end;

constructor TIconButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
// ControlStyle := ControlStyle + [csReplicatable];
FIData:=TIBData.create(AOwner);
Width := 48;
Height := 48;
visible:=true;
end;

procedure TIconButton.SetIconData(value: TIBData);
begin
ShowMessage("begsetIconData");
FIData.normal.image.Assign(value.normal.image);
FIData.pressed.image.Assign(value.pressed.image);
FIData.light.image.Assign(value.light.image);
FIData.none.image.Assign(value.none.image);
ShowMessage("endsetIconData");
end;

procedure TIconButton.Click;
var
a: TIcoProperty;
begin
a.Edit;
if position<>none then
begin
 if Check then
 begin

 end else
 begin

 end;
 inherited Click;
end;
end;

destructor TIconButton.Destroy;
begin
inherited Destroy;
end;

procedure TIconButton.RefreshIcon;
begin
if icondata.normal.image.Empty then ShowMessage("Лажа") else
ShowMessage("не лажа");
case Fposition of
 normal: Self.Picture.Icon.Assign(Self.IconData.normal.image);
 pressed: Self.Picture.Icon.Assign(Self.IconData.pressed.image);
 light: Self.Picture.Icon.Assign(Self.IconData.light.image);
 none: Self.Picture.Icon.Assign(Self.IconData.none.image);
end;

end;

end.

Это мой код! Что в нём не так? Делфи вылетает с ошибкой через каждые 2 минуты! Невозможно кодить!

---

Страницы: 1 вся ветка

Текущий архив: 2006.07.16;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.025 c