Модераторы: Snowy, MetalFan, bems, Poseidon
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Создание компонента, создание scrolbar из готовых процедур 
:(
    Опции темы
microo10
  Дата 15.2.2012, 17:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 62
Регистрация: 21.1.2012

Репутация: нет
Всего: нет
У меня есть процедура из которой можно слепить компонент ScrolBar. Но т.к я не силен в компонентостроении у меня не получается переделать процедуру.
Вот что у меня получилось:
Код

unit EScrol;

interface

uses
  System.SysUtils, System.Classes, Vcl.Controls,ExtCtrls,Dialogs,StdCtrls,
  Forms,Windows,Messages,Graphics,Variants,Controls;

type
  TEscrol = class(TCustomControl)
  private
  FScrol: TImage;
  FMaxpos: Integer;
  FMinpos: Integer;
  FPos: Integer;
  procedure SetMaxpos(Value: Integer);
  procedure SetMinpos(Value: Integer);
  procedure SetPos(Value: Integer);
  procedure scrolMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  procedure Draw;
  protected

  public
  procedure Paint; override;
  constructor Create(AOWner: TComponent); override;
  published
  property onMouseDown;
  property Maxpos: Integer read FMaxpos write SetMaxpos;
  property Minpos: Integer read FMinpos write SetMinpos;
  property Pos: Integer read FPos write SetPos;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('EComp', [TEscrol]);
end;
 procedure TEscrol.SetMaxpos(Value: Integer);
begin
if Value <0 then Value:= 100;
FMaxpos:= Value;
end;
procedure TEscrol.SetMinpos(Value: Integer);
begin
if Value <0 then Value:= 0;
FMinpos:= Value;
end;
procedure TEscrol.Setpos(Value: Integer);
begin
if Value <0 then Value:= 0;
FPos:= Value;
end;
constructor TEscrol.Create(AOWner: TComponent);
begin
inherited;
FMaxPos:= 100;
FMinPos:= 0;
Parent.DoubleBuffered:= True;
FPos:= 0;
end;
procedure TEscrol.Draw;
begin
 // Фон
    Canvas.Pen.Color := RGB(81,81,81);   // этот цвет должен выбираться в свойствах(не RGB,потому что RGB нельзя указывать через свойства,вроде бы)
    Canvas.Brush.Color := RGB(81,81,81); //это тот же цвет
    Canvas.Rectangle(0, 0, Width, Height);
    // Позиция
    Canvas.Pen.Color := clBlue;                //этот цвет тоже должен выбираться в свойствах 
    Canvas.Brush.Color := clBlue;            // тот же цвет
    Canvas.Rectangle(0, 0, Pos, Height);
end;
procedure scrolMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
begin
 Pos:=X;
 TEscrol.Draw;
end;
end.

А свою процедуру я прикрепил в архиве. Собственно что я хочу сделать и что не получается:
  • В свойствах добавить пункты MaxPos,MinPos,Pos(вроде бы получилось)
  • При создании задать начальные параметры переменным MaxPos,MinPos,Pos (тоже вроде получилось)
  • Добавить пункт в свойствах colors,fontcolors - там можно выбрать цвет выделения и заднего фона scrol'а (не получается,даже со стандартными цветами)
  • MaxPos и MinPos взять как границы -начало, предел (не получилось,нужно MaxPos брать как 100% Scrol.Widht , что собственно затруднительно)
  • Добавить событие нажатие на scrol (не получилось,почему то rad ругает)
  • Самое главное забыл,охота узнать,как для MaxPos,MinPos,Pos,Colors добавить параметры,то есть что бы можно было через код программы задавать им значения(Scrol1.maxpos := 200 например),а для colors,fontcolors задавать цвета RGB (colors:= RGB(81,81,81) например)
В общем у меня не получается переделать процедуру,а там всего лишь надо заменить готовые данные на данные которые можно выбрать в свойствах...
Помогите советом,как можно все это реализовать  smile 

Это сообщение отредактировал(а) microo10 - 15.2.2012, 17:11

Присоединённый файл ( Кол-во скачиваний: 3 )
Присоединённый файл  Escrol.rar 436,61 Kb
PM MAIL   Вверх
microo10
Дата 15.2.2012, 18:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 62
Регистрация: 21.1.2012

Репутация: нет
Всего: нет
Ну что, вообще не каких идей?  smile 
PM MAIL   Вверх
microo10
Дата 16.2.2012, 09:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 62
Регистрация: 21.1.2012

Репутация: нет
Всего: нет
Люди,но предложите хоть какую нибудь идею!!! smile 
PM MAIL   Вверх
Frees
Дата 16.2.2012, 11:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2233
Регистрация: 2.12.2005
Где: Екатеринбург

Репутация: 16
Всего: 54
Юнит с твоим компонентом
Код

unit EScrol;

interface

uses
  SysUtils, Classes, Controls, ExtCtrls, Dialogs, StdCtrls,
  Forms, Windows, Messages, Graphics, Variants;

type
  TEscrol = class(TGraphicControl)
  private
    FMaxpos: Integer;
    FMinpos: Integer;
    FPos: Integer;
    FColorBrush: TColor;
    FColorPen: TColor;
    procedure SetMaxpos(Value: Integer);
    procedure SetMinpos(Value: Integer);
    procedure SetPos(Value: Integer);
    procedure SetColorBrush(const Value: TColor);
    procedure SetColorPen(const Value: TColor);
  protected
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);  override;
  public
    constructor Create(AOWner: TComponent); override;
  published
    property Maxpos: Integer read FMaxpos write SetMaxpos;
    property Minpos: Integer read FMinpos write SetMinpos;
    property Pos: Integer read FPos write SetPos;
    property ColorPen: TColor read FColorPen write SetColorPen;
    property ColorBrush: TColor read FColorBrush write SetColorBrush;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('EComp', [TEscrol]);
end;

procedure TEscrol.SetColorBrush(const Value: TColor);
begin
  FColorBrush := Value;
  Invalidate;
end;

procedure TEscrol.SetColorPen(const Value: TColor);
begin
  FColorPen := Value;
  Invalidate;
end;

procedure TEscrol.SetMaxpos(Value: Integer);
begin
  if Value < 0 then
    Value := 100;
  FMaxpos := Value;
end;

procedure TEscrol.SetMinpos(Value: Integer);
begin
  if Value < 0 then
    Value := 0;
  FMinpos := Value;
end;

procedure TEscrol.SetPos(Value: Integer);
begin
  if Value < 0 then
    Value := 0;
  FPos := Value;
  Invalidate;
end;

constructor TEscrol.Create(AOWner: TComponent);
begin
  inherited;
  FMaxpos := 100;
  FMinpos := 0;
  FColorPen := RGB(81, 81, 81);
  FColorBrush := RGB(81, 81, 81);
  FPos := 0;
end;

procedure TEscrol.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  Pos := X;
  Invalidate;
end;

procedure TEscrol.Paint;
begin
  inherited Paint;
  // Фон
  Canvas.Pen.Color := FColorPen; // этот цвет должен выбираться в свойствах(не RGB,потому что RGB нельзя указывать через свойства,вроде бы)
  Canvas.Brush.Color := FColorBrush; // это тот же цвет
  Canvas.Rectangle(0, 0, Width, Height);
  // Позиция
  Canvas.Pen.Color := clBlue; // этот цвет тоже должен выбираться в свойствах
  Canvas.Brush.Color := clBlue; // тот же цвет
  Canvas.Rectangle(0, 0, Pos, Height);
end;

end.




Код в форме (использование)
Код

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Image1: TImage;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    FEscrol: TEscrol;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
//*****************************************************************************
// Создание формы
procedure TForm1.FormCreate(Sender: TObject);
begin
  FEscrol := TEscrol.Create(self);
  with FEscrol do
  begin
    Parent := self;
    Top := 2;
    Left := 10;
    width := Self.Width - 20;
    Height := 15;
  end;
end;
//*****************************************************************************
// Кнопка установить
procedure TForm1.Button1Click(Sender: TObject);
begin
  FEscrol.Pos := StrToInt(Edit1.Text);
end;


ps похоже что ты занят изобретением велосипеда, задача то какая


Это сообщение отредактировал(а) Frees - 16.2.2012, 11:11


--------------------
Кольцов Виктор Владимирович
PM MAIL ICQ   Вверх
microo10
Дата 16.2.2012, 14:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 62
Регистрация: 21.1.2012

Репутация: нет
Всего: нет
Цитата(Frees @ 16.2.2012,  11:09)
Юнит с твоим компонентом
Код

unit EScrol;

interface

uses
  SysUtils, Classes, Controls, ExtCtrls, Dialogs, StdCtrls,
  Forms, Windows, Messages, Graphics, Variants;

type
  TEscrol = class(TGraphicControl)
  private
    FMaxpos: Integer;
    FMinpos: Integer;
    FPos: Integer;
    FColorBrush: TColor;
    FColorPen: TColor;
    procedure SetMaxpos(Value: Integer);
    procedure SetMinpos(Value: Integer);
    procedure SetPos(Value: Integer);
    procedure SetColorBrush(const Value: TColor);
    procedure SetColorPen(const Value: TColor);
  protected
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);  override;
  public
    constructor Create(AOWner: TComponent); override;
  published
    property Maxpos: Integer read FMaxpos write SetMaxpos;
    property Minpos: Integer read FMinpos write SetMinpos;
    property Pos: Integer read FPos write SetPos;
    property ColorPen: TColor read FColorPen write SetColorPen;
    property ColorBrush: TColor read FColorBrush write SetColorBrush;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('EComp', [TEscrol]);
end;

procedure TEscrol.SetColorBrush(const Value: TColor);
begin
  FColorBrush := Value;
  Invalidate;
end;

procedure TEscrol.SetColorPen(const Value: TColor);
begin
  FColorPen := Value;
  Invalidate;
end;

procedure TEscrol.SetMaxpos(Value: Integer);
begin
  if Value < 0 then
    Value := 100;
  FMaxpos := Value;
end;

procedure TEscrol.SetMinpos(Value: Integer);
begin
  if Value < 0 then
    Value := 0;
  FMinpos := Value;
end;

procedure TEscrol.SetPos(Value: Integer);
begin
  if Value < 0 then
    Value := 0;
  FPos := Value;
  Invalidate;
end;

constructor TEscrol.Create(AOWner: TComponent);
begin
  inherited;
  FMaxpos := 100;
  FMinpos := 0;
  FColorPen := RGB(81, 81, 81);
  FColorBrush := RGB(81, 81, 81);
  FPos := 0;
end;

procedure TEscrol.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  Pos := X;
  Invalidate;
end;

procedure TEscrol.Paint;
begin
  inherited Paint;
  // Фон
  Canvas.Pen.Color := FColorPen; // этот цвет должен выбираться в свойствах(не RGB,потому что RGB нельзя указывать через свойства,вроде бы)
  Canvas.Brush.Color := FColorBrush; // это тот же цвет
  Canvas.Rectangle(0, 0, Width, Height);
  // Позиция
  Canvas.Pen.Color := clBlue; // этот цвет тоже должен выбираться в свойствах
  Canvas.Brush.Color := clBlue; // тот же цвет
  Canvas.Rectangle(0, 0, Pos, Height);
end;

end.




Код в форме (использование)
Код

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Image1: TImage;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    FEscrol: TEscrol;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
//*****************************************************************************
// Создание формы
procedure TForm1.FormCreate(Sender: TObject);
begin
  FEscrol := TEscrol.Create(self);
  with FEscrol do
  begin
    Parent := self;
    Top := 2;
    Left := 10;
    width := Self.Width - 20;
    Height := 15;
  end;
end;
//*****************************************************************************
// Кнопка установить
procedure TForm1.Button1Click(Sender: TObject);
begin
  FEscrol.Pos := StrToInt(Edit1.Text);
end;


ps похоже что ты занят изобретением велосипеда, задача то какая

Спасибо большое,проект у меня -  медиа проигрыватель,1 скрол бы я сделал,ну 2 еще можно...но у меня их 15 шт...поэтому я решил попытаться сделать свой компонент из данной процедуры)
PM MAIL   Вверх
Frees
Дата 16.2.2012, 14:29 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2233
Регистрация: 2.12.2005
Где: Екатеринбург

Репутация: 16
Всего: 54
Не проще взять компонент TProgressBar


--------------------
Кольцов Виктор Владимирович
PM MAIL ICQ   Вверх
microo10
Дата 16.2.2012, 14:43 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 62
Регистрация: 21.1.2012

Репутация: нет
Всего: нет
Цитата(Frees @ 16.2.2012,  14:29)
Не проще взять компонент TProgressBar

Ну а как через прогресс перематывать песни и громкость менять?)
_________________________________________________________
P.S а че мне ощибку кидает [DCC Fatal Error] Unit1.pas(7): F1026 File not found: 'EScrol.dcu'?
Откуда dcu то брать?)

Это сообщение отредактировал(а) microo10 - 16.2.2012, 14:45
PM MAIL   Вверх
Frees
Дата 16.2.2012, 14:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2233
Регистрация: 2.12.2005
Где: Екатеринбург

Репутация: 16
Всего: 54
Цитата(microo10 @  16.2.2012,  17:43 Найти цитируемый пост)
Ну а как через прогресс перематывать песни и громкость менять?)

а как ты это делал в своем классе TEscrol?


--------------------
Кольцов Виктор Владимирович
PM MAIL ICQ   Вверх
microo10
Дата 16.2.2012, 14:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 62
Регистрация: 21.1.2012

Репутация: нет
Всего: нет
Цитата(Frees @ 16.2.2012,  14:47)
Цитата(microo10 @  16.2.2012,  17:43 Найти цитируемый пост)
Ну а как через прогресс перематывать песни и громкость менять?)

а как ты это делал в своем классе TEscrol?

На paint'е прорисовывал позиции)
Ты имел введу взять прогресс как предка или просто компонентом пользоваться?
PM MAIL   Вверх
Frees
Дата 16.2.2012, 14:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2233
Регистрация: 2.12.2005
Где: Екатеринбург

Репутация: 16
Всего: 54
Цитата(microo10 @  16.2.2012,  17:43 Найти цитируемый пост)
P.S а че мне ощибку кидает [DCC Fatal Error] Unit1.pas(7): F1026 File not found: 'EScrol.dcu'?Откуда dcu то брать?)

юнит с классом TEscrol должен назоваться Escrol.pas


Цитата(microo10 @  16.2.2012,  17:50 Найти цитируемый пост)
Ты имел введу взять прогресс как предка или просто компонентом пользоваться?

просто пользоваться


--------------------
Кольцов Виктор Владимирович
PM MAIL ICQ   Вверх
microo10
Дата 16.2.2012, 15:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 62
Регистрация: 21.1.2012

Репутация: нет
Всего: нет
Цитата

юнит с классом TEscrol должен назоваться Escrol.pas

Да,название такое...не робит что то я в пакет его завернул и установил...или его не так юзать?
Цитата

просто пользоваться


А разве можно его довести до подобного вида??
________
Даже не знал,что подобное можно сделать,в Gauge получилось все,но как сделать с прогрессом?

Это сообщение отредактировал(а) microo10 - 16.2.2012, 16:36
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Для новичков"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Для новичков | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0527 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.