Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 06.12.2017, 20:25   #1
Retboon
Новичок
Джуниор
 
Регистрация: 22.10.2017
Сообщений: 2
По умолчанию Сократить программный код

Помогите сократить программный код

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Panel1: TPanel;
BtnRectangle: TBitBtn;
BtnEllipse: TBitBtn;
BtnRoundRect: TBitBtn;
Panel2: TPanel;
editRed: TEdit;
editGreen: TEdit;
editBlue: TEdit;
RedUpDown: TUpDown;
GreenUpDown: TUpDown;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
sbRedScroll: TScrollBar;
sbGreenScroll: TScrollBar;
sbBlueScroll: TScrollBar;
shShape: TShape;
StatusBar1: TStatusBar;
blueUpDown: TUpDown;
XPManifest1: TXPManifest;
procedure FormCreate(Sender: TObject);
procedure FGK(n: TObject);
procedure sbScrollChange(Sender: TObject);
procedure BtnClick(Sender: TObject);
procedure editChange(Sender: TObject);
private
RedColor,GreenColor,BlueColor: TColor;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
RedColor:=127;
redUpDown.Position:=RedColor;
sbRedScroll.Position:=RedColor;
editRed.Text:=IntToStr(RedColor);

GreenColor:=127;
greenUpDown.Position:=GreenColor;
sbGreenScroll.Position:=GreenColor;
editGreen.Text:=IntToStr(GreenColor );

BlueColor:=127;
blueUpDown.Position:=BlueColor;
sbBlueScroll.Position:=BlueColor;
editBlue.Text:=IntToStr(BlueColor);

shShape.Brush.Color:=RGB(RedColor,G reenColor,BlueColor);
end;

procedure TForm1.BtnClick(Sender: TObject);
begin
case (sender as TBitBtn).tag of
0: shShape.Shape:=stRectangle;
1: shShape.Shape:=stEllipse;
2: shShape.Shape:=stRoundRect;
end;
end;

procedure TForm1.editChange(Sender: TObject);
var
S: String;
begin
if (sender as TEdit).Name='editred' then
begin
S:=(sender as TEdit).Text;
while Pos(' ',S)>0 do Delete(S,Pos(' ',S),1);
if S='' then Exit;
RedColor:=StrToInt(S);
if RedColor<0 then RedColor:=0;
if RedColor>255 then RedColor:=255;
sbRedScroll.Position:=RedColor;
RedUpDown.Position:=RedColor;
shShape.Brush.Color:=RGB(RedColor,G reenColor,BlueColor);
end;
if (sender as TEdit).Name='editgreen' then
begin
S:=editGreen.Text;
while Pos(' ',S)>0 do Delete(S,Pos(' ',S),1);
if S='' then Exit;
greenColor:=StrToInt(S);
if GreenColor<0 then GreenColor:=0;
if GreenColor>255 then GreenColor:=255;
sbGreenScroll.Position:=GreenColor;
GreenUpDown.Position:=GreenColor;
shShape.Brush.Color:=RGB(RedColor,G reenColor,BlueColor);
end;
if (sender as TEdit).Name='editblue' then
begin
S:=editBlue.Text;
while Pos(' ',S)>0 do Delete(S,Pos(' ',S),1);
if S='' then Exit;
blueColor:=StrToInt(S);
if BlueColor<0 then BlueColor:=0;
if BlueColor>255 then BlueColor:=255;
sbBlueScroll.Position:=BlueColor;
BlueUpDown.Position:=BlueColor;
shShape.Brush.Color:=RGB(RedColor,G reenColor,BlueColor);
end;
end;

procedure TForm1.sbScrollChange(Sender: TObject);
begin
if (sender as TScrollBar).Name='sbRedScroll' then
begin
RedColor:=sbRedScroll.Position;
RedUpDown.Position:=RedColor;
editRed.Text:=IntToStr(RedColor);
shShape.Brush.Color:=RGB(RedColor,G reenColor,BlueColor);
FGK(sender);
end;
if (sender as TScrollBar).Name='sbGreenScroll' then
begin
GreenColor:=sbGreenScroll.Position;
GreenUpDown.Position:=GreenColor;
editGreen.Text:=IntToStr(GreenColor );
shShape.Brush.Color:=RGB(RedColor,G reenColor,BlueColor);
FGK(sender)
end;
if (sender as TScrollBar).Name='sbBlueScroll' then
begin
BlueColor:=sbBlueScroll.Position;
BlueUpDown.Position:=BlueColor;
editBlue.Text:=IntToStr(BlueColor);
shShape.Brush.Color:=RGB(RedColor,G reenColor,BlueColor);
FGK(sender)
end;

end;

procedure TForm1.FGK(n: TObject);
begin
case (n as TScrollBar).Position of
1..50: StatusBar1.Panels[(n as TScrollBar).tag].Text:= 'Насыщенние цвета отсутсвует';
51..100: StatusBar1.Panels[(n as TScrollBar).tag].Text:= 'Слабо насыщенный';
101..150: StatusBar1.Panels[(n as TScrollBar).tag].Text:= 'Слабо насыщенный';
151..200: StatusBar1.Panels[(n as TScrollBar).tag].Text:= 'Сильно насыщенный';
201..255: StatusBar1.Panels[(n as TScrollBar).tag].Text:= 'Насыщеннеее максимальное';
end;
end;

end.
Retboon вне форума Ответить с цитированием
Старый 06.12.2017, 21:28   #2
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,515
По умолчанию

аналогично этим объектам
Код:
BtnRectangle: TBitBtn;
BtnEllipse: TBitBtn;
BtnRoundRect: TBitBtn;
НАЗНАЧАЕМ свойства tag и для прочих объектов (TEdit и остальное)

Код:
begin
if (sender as TEdit).Name='editred' then
  case (sender as Tedit).tag of
  0: begin
      Redcolor:=DecodeText((sender as Tedit).Text);
      sbRedScroll.Position:=RedColor;
      RedUpDown.Position:=RedColor; 
     end;
  ....
  end;
  shShape.Brush.Color:=RGB(RedColor,G reenColor,BlueColor);
и добавляем такую функцию
Код:
function DecodeText(textcolor: string): integer;
begin
  S:=editBlue.Text;
  while Pos(' ',S)>0 do Delete(S,Pos(' ',S),1);
  if S='' then Exit;
  blueColor:=StrToInt(S);
  if BlueColor<0 then BlueColor:=0;
  if BlueColor>255 then BlueColor:=255;
end;
конечно с ИЗМЕНЕНИЯМИ обеспечивающими нормальную работу оной
программа — запись алгоритма на языке понятном транслятору

Последний раз редактировалось evg_m; 06.12.2017 в 21:47.
evg_m вне форума Ответить с цитированием
Старый 06.12.2017, 21:48   #3
Retboon
Новичок
Джуниор
 
Регистрация: 22.10.2017
Сообщений: 2
По умолчанию

Спасибо за помощь, но у меня остался один вопрос, а можно ли как нибудь сократить процедуры в которых используются RedColor,GreenColor,BlueColor. Просто они повторяются, а как сократить я не знаю.
Цитата:
Сообщение от evg_m Посмотреть сообщение
аналогично этим объектам
Код:
BtnRectangle: TBitBtn;
BtnEllipse: TBitBtn;
BtnRoundRect: TBitBtn;
НАЗНАЧАЕМ свойства tag и для прочих объектов (TEdit и остальное)

Код:
begin
if (sender as TEdit).Name='editred' then
  case (sender as Tedit).tag of
  0: begin
      Redcolor:=DecodeText((sender as Tedit).Text);
      sbRedScroll.Position:=RedColor;
      RedUpDown.Position:=RedColor; 
     end;
  ....
  end;
  shShape.Brush.Color:=RGB(RedColor,G reenColor,BlueColor);
и добавляем такую функцию
Код:
function DecodeText(textcolor: string): integer;
begin
  S:=editBlue.Text;
  while Pos(' ',S)>0 do Delete(S,Pos(' ',S),1);
  if S='' then Exit;
  blueColor:=StrToInt(S);
  if BlueColor<0 then BlueColor:=0;
  if BlueColor>255 then BlueColor:=255;
end;
конечно с ИЗМЕНЕНИЯМИ обеспечивающими нормальную работу оной

Последний раз редактировалось Retboon; 06.12.2017 в 21:57. Причина: Не отметил пользователя
Retboon вне форума Ответить с цитированием
Старый 06.12.2017, 22:55   #4
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,515
По умолчанию

в принципе другой способ сокращения кода для нескольких однотипных групп контролов

делаем Frame
на него добавляем Edit, UpDown, ScrollBar (нашу группу взаимосвязанных конторолов)

добавляем ДВА свойства
Код:
  public
    { public declarations }
    property colorFrame: integer read FcolorFrame write SetcolorFrame; // управление ВНУТРЕННИМИ объектами и хранение значения (это будет аналог RedColor и подобного)
    property OnChangeColor: TNotifyEvent read FOnChangeColor write SetOnChangeColor; // КАК мы можем сообщить другим объектам что наше значение изменилось
настраиваем(пишем) события изменения(OnChange) внутренних объектов(Edit,UpDown,...) на вычисление и ГЛАВНОЕ установку значения
Код:
procedure TFrame1.Edit1Change(Sender: TObject);
begin
  colorFrame:=strtoint(self.Edit1.Text);
end;

//  аналогично(или ПОЧТИ аналогично) для других контролов
Код:
//в процедуре установки значения SetColorFrame делаем
procedure TFrame1.SetcolorFrame(AValue: integer);
begin
  // сохраняем новое значение
  if FcolorFrame=AValue then Exit;
  // если надо проверяем
  if AValue>255 then exit;
  if Avalue<0 then Exit;
  FcolorFrame:=AValue;

  //деаем установку правильных позиций(по вновь сохраненному) для наших объектов.
  self.Edit1.text:=inttostr(FcolorFrame);
  self.ScrollBar1.Position:=FcolorFrame;
  self.UpDown1.Position:=FcolorFrame;
  //И делаем ВЫЗОВ события внешнего оповещения
  if assigned(FOnChangeColor) then self.FOnChangeColor(self);
end;

теперь немножко о самой форме
на ФОРМУ добавляем наш Frame три раза и как-то называем иx
...Red ...Green ... Blue
пишем новый метод (процедуру) реакции на изменения в наших контролах(в их группах!!!)
Код:
  private
    { private declarations }
    procedure DoShare(sender: Tobject); 
...

procedure TForm1.DoShare(sender: Tobject);
begin
//при этом вовсю пользуемся их сохраненными значениями
  shareX.color:=RGB(self.Frame1_Red.colorFrame, self.Frame1_Green.colorFrame, self.Frame1_Blue.colorFrame);
end;
при создании формы
Код:
procedure TForm1.FormCreate(Sender: TObject);
begin
  // задаем реакцию на изменения во фреймах
  self.Frame1_Red.OnChangeColor:=self.DoShare;
  self.Frame1_green.OnChangeColor:=self.doshare;
  self.Frame1_Blue.OnChangeColor:=self.DoShare;

  // задаем начальные значения цветов
  self.Frame1_Red.colorFrame:=127;
  self.Frame1_green.colorFrame:=127;
  self.Frame1_Blue.colorFrame:=127;
end;
программа — запись алгоритма на языке понятном транслятору

Последний раз редактировалось evg_m; 06.12.2017 в 23:05.
evg_m вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Помогите сократить код. Hadson Помощь студентам 1 30.01.2017 20:34
сократить код kostan3 Visual C++ 0 15.03.2013 14:08
сократить код Kirja23 Microsoft Office Excel 1 20.02.2013 22:34
сократить код kostan3 Паскаль, Turbo Pascal, PascalABC.NET 2 17.02.2013 17:24
Сократить код shapiro Помощь студентам 0 14.04.2010 17:38