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

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

Вернуться   Форум программистов > Delphi программирование > Lazarus, Free Pascal, CodeTyphon
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 01.09.2017, 06:36   #1
Ariel Weid
Новичок
Джуниор
 
Регистрация: 27.08.2017
Сообщений: 2
Восклицание Упростить код

Здравствуйте. Посмотрите пожалуйста код и подскажите, можно ли его оптимизировать. Прилагаю также скриншот формы, для наглядности.

Описание:
В ComboBox будет с десяток ItemIndex'ов. При выборе каждого из них, происходит очистка Screen'ов 1-6, с последующей загрузкой новых изображений, и дополнительно очистка Portrait.
Когда ComboBox выбран, при нажатии на один из трёх лейблов (L1..L3), происходит очистка Portrait, с последующей загрузкой нового изображения.
Процедуры очистки Screen'ов (CI) и Portrait (CP) прописаны отдельно.

Код:
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    CB: TComboBox;
    Screen1: TImage;
    Screen2: TImage;
    Screen3: TImage;
    Screen4: TImage;
    Screen5: TImage;
    Screen6: TImage;
    Portrait: TImage;
    L1: TLabel;
    L2: TLabel;
    L3: TLabel;
    procedure CBChange(Sender: TObject);
    procedure L1Click(Sender: TObject);
    procedure L2Click(Sender: TObject);
    procedure L3Click(Sender: TObject);
  private { private declarations }
    procedure CI;
    procedure CP;
  public { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.CBChange(Sender: TObject);
begin
   if CB.ItemIndex =0 then
   begin
      CI;
      CP;
      L1.Caption := 'Name1';
      L2.Caption := 'Name2';
      L3.Caption := 'Name3';
      Screen1.Picture.LoadFromFile('Images/Image1.jpg');
      Screen2.Picture.LoadFromFile('Images/Image2.jpg');
      Screen3.Picture.LoadFromFile('Images/Image3.jpg');
      Screen4.Picture.LoadFromFile('Images/Image4.jpg');
      Screen5.Picture.LoadFromFile('Images/Image5.jpg');
      Screen6.Picture.LoadFromFile('Images/Image6.jpg');
   end;
   if CB.ItemIndex =1 then
   begin
      CI;
      CP;
      L1.Caption := 'Name4';
      L2.Caption := 'Name5';
      L3.Caption := 'Name6';
      Screen1.Picture.LoadFromFile('Images/Image7.jpg');
      Screen2.Picture.LoadFromFile('Images/Image8.jpg');
      Screen3.Picture.LoadFromFile('Images/Image9.jpg');
      Screen4.Picture.LoadFromFile('Images/Image10.jpg');
      Screen5.Picture.LoadFromFile('Images/Image11.jpg');
      Screen6.Picture.LoadFromFile('Images/Image12.jpg');
   end;
end;

procedure TForm1.L1Click(Sender: TObject);
begin
   if CB.ItemIndex =0 then
   begin
      CP;
      Portrait.Picture.LoadFromFile('Images/Photo1.jpg');
   end;
   if CB.ItemIndex =1 then
   begin
      CP;
      Portrait.Picture.LoadFromFile('Images/Photo4.jpg');
   end;
end;

procedure TForm1.L2Click(Sender: TObject);
begin
   if CB.ItemIndex =0 then
   begin
      CP;
      Portrait.Picture.LoadFromFile('Images/Photo2.jpg');
   end;
   if CB.ItemIndex =1 then
   begin
      CP;
      Portrait.Picture.LoadFromFile('Images/Photo5.jpg');
   end;
end;

procedure TForm1.L3Click(Sender: TObject);
begin
   if CB.ItemIndex =0 then
   begin
      CP;
      Portrait.Picture.LoadFromFile('Images/Photo3.jpg');
   end;
   if CB.ItemIndex =1 then
   begin
      CP;
      Portrait.Picture.LoadFromFile('Images/Photo6.jpg');
   end;
end;

procedure TForm1.CI;
begin
   Screen1.Picture.Clear;
   Screen2.Picture.Clear;
   Screen3.Picture.Clear;
   Screen4.Picture.Clear;
   Screen5.Picture.Clear;
   Screen6.Picture.Clear;
end;

procedure TForm1.CP;
begin
   Portrait.Picture.Clear;
end;

end.
Изображения
Тип файла: png Безымянный.png (68.1 Кб, 131 просмотров)
Ariel Weid вне форума Ответить с цитированием
Старый 01.09.2017, 10:23   #2
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

я бы вынес в INI файл данные о именах картинок/фоток и названия для лейбов.
всё это я бы грузил в память, динамический массив, используя ItemIndex как индекс массива.

тогда программа уже не менялась бы, сколько бы Items вы не добавляли в комбобокс.

ну, грубо говоря, так:

Код:
type
  TMyStruc = record
    LabelName : array[1..3] Of string;
    ImageName : array[1..6] Of string;
    PhotoName : array[1..3] Of string;
  end;


type

  { TForm1 }

  TForm1 = class(TForm)
    CB: TComboBox;
    Screen1: TImage;
    Screen2: TImage;
    Screen3: TImage;
    Screen4: TImage;
    Screen5: TImage;
    Screen6: TImage;
    Portrait: TImage;
    L1: TLabel;
    L2: TLabel;
    L3: TLabel;
    procedure CBChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure LabelClick(Sender: TObject);
  private { private declarations }
    procedure CI;
    procedure CP;
  public { public declarations }
  end;

var
  Form1: TForm1;

var
  MyArr : array of  TMyStruc;


implementation

{$R *.lfm}

{ TForm1 }


procedure TForm1.FormCreate(Sender: TObject);
var
  AppIniFile: TIniFile;
  i,j, Count : integer;
  sectionName : string;
begin
  // чтение настроек из INI файла
  AppIniFile := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));

  Count := AppIniFile.ReadInteger('Main','CountItems',0);

  if Count=0 Then  Begin
    Application.MessageBox('Нет данных в INI файле',   'Ошибка', MB_OK or MB_ICONERROR);
    Exit
  end;

  SetLength(MyArr , Count);

  for i:=0 to Count-1 do begin
    sectionName := 'ItemIndex'+IntToStr(i+1);
    for j:=1 to 3 do
      MyArr[i].LabelName[j] := AppIniFile.ReadString(sectionName,'Label'+IntToStr(j),'');
    for j:=1 to 6 do
      MyArr[i].ImageName[j] := AppIniFile.ReadString(sectionName,'Image'+IntToStr(j),'');
    for j:=1 to 3 do
      MyArr[i].PhotoName[j] := AppIniFile.ReadString(sectionName,'Photo'+IntToStr(j),'');
  end;

  // пропишем нумерацию TAG в L1, L2, L3 чтобы можно было назначить один обработчик на все три лейбла
  L1.Tag := 1;   L2.Tag := 2;   L3.Tag := 3;

  L1.OnClick :=  LabelClick;



end;


procedure TForm1.CBChange(Sender: TObject);
begin
   if (CB.ItemIndex<0) or (CB.ItemIndex>=Length(MyArr)) then Exit;
   CI;
   CP;
   L1.Caption := MyArr[CB.ItemIndex].LabelName[1];
   L2.Caption := MyArr[CB.ItemIndex].LabelName[2];
   L3.Caption := MyArr[CB.ItemIndex].LabelName[3];
   Screen1.Picture.LoadFromFile(MyArr[CB.ItemIndex].ImageName[1]);
   Screen2.Picture.LoadFromFile(MyArr[CB.ItemIndex].ImageName[2]);
   Screen3.Picture.LoadFromFile(MyArr[CB.ItemIndex].ImageName[3]);
   Screen4.Picture.LoadFromFile(MyArr[CB.ItemIndex].ImageName[4]);
   Screen5.Picture.LoadFromFile(MyArr[CB.ItemIndex].ImageName[5]);
   Screen6.Picture.LoadFromFile(MyArr[CB.ItemIndex].ImageName[6]);
end;


procedure TForm1.LabelClick(Sender: TObject);
begin
   if (CB.ItemIndex<0) or (CB.ItemIndex>=Length(MyArr)) then Exit;
   CP;
   Portrait.Picture.LoadFromFile(MyArr[CB.ItemIndex].PhotoName[(Sender as TLabel).Tag]);
end;


procedure TForm1.CI;
begin
   Screen1.Picture.Clear;
   Screen2.Picture.Clear;
   Screen3.Picture.Clear;
   Screen4.Picture.Clear;
   Screen5.Picture.Clear;
   Screen6.Picture.Clear;
end;

procedure TForm1.CP;
begin
   Portrait.Picture.Clear;
end;

end.

p.s. писал в блокноте, поэтому возможны ошибки и опечатки.
но, надеюсь, идея понятна?
Serge_Bliznykov вне форума Ответить с цитированием
Старый 07.09.2017, 17:27   #3
JUDAS
фонатик DELPHI
Форумчанин
 
Аватар для JUDAS
 
Регистрация: 14.01.2008
Сообщений: 714
По умолчанию

Код:
procedure TForm1.CBChange(Sender: TObject);
begin
   if (CB.ItemIndex<0) or (CB.ItemIndex>=Length(MyArr)) then Exit;
   CI;
   CP;
   L1.Caption := MyArr[CB.ItemIndex].LabelName[1];
   L2.Caption := MyArr[CB.ItemIndex].LabelName[2];
   L3.Caption := MyArr[CB.ItemIndex].LabelName[3];
   Screen1.Picture.LoadFromFile(MyArr[CB.ItemIndex].ImageName[1]);
   Screen2.Picture.LoadFromFile(MyArr[CB.ItemIndex].ImageName[2]);
   Screen3.Picture.LoadFromFile(MyArr[CB.ItemIndex].ImageName[3]);
   Screen4.Picture.LoadFromFile(MyArr[CB.ItemIndex].ImageName[4]);
   Screen5.Picture.LoadFromFile(MyArr[CB.ItemIndex].ImageName[5]);
   Screen6.Picture.LoadFromFile(MyArr[CB.ItemIndex].ImageName[6]);
end;
===>
Код:
procedure TForm1.CBChange(Sender: TObject);
var i : integer;
     cmp : TComponent;
begin
   if (CB.ItemIndex<0) or (CB.ItemIndex>=Length(MyArr)) then Exit;
   CI;
   CP;
   for i:=1 to 3 do
   begin
      cmp := FindComponent('L'+IntToStr(i));
      if Assigned(cmp) and (cmp is TLabel) then
         TLabel(cmp).Caption := MyArr[CB.ItemIndex].LabelName[ш];
   end;

   for i:=1 to 6 do
   begin
      cmp := FindComponent('Screen'+IntToStr(i));
      if Assigned(cmp) and (cmp is TImage) then
         TImage(cmp).Picture.LoadFromFile(MyArr[CB.ItemIndex].ImageName[i]);
   end;
end;
МЕТОД "СИ"

Код:
procedure TForm1.CI;
begin
   Screen1.Picture.Clear;
   Screen2.Picture.Clear;
   Screen3.Picture.Clear;
   Screen4.Picture.Clear;
   Screen5.Picture.Clear;
   Screen6.Picture.Clear;
end;
Код:
procedure TForm1.CI;
var i : integer;
     cmp : TComponent;
begin
   for i:=1 to 6 do
   begin
      cmp := FindComponent('Screen'+IntToStr(i));
      if Assigned(cmp) and (cmp is TImage) then
         TImage(cmp).Picture.Clear;
   end;
end;
как то так =))
95% сбоев и ошибок приложений, находится в полу метрах от монитора
JUDAS вне форума Ответить с цитированием
Старый 07.09.2017, 17:35   #4
JUDAS
фонатик DELPHI
Форумчанин
 
Аватар для JUDAS
 
Регистрация: 14.01.2008
Сообщений: 714
По умолчанию

Код:
procedure TForm1.CBChange(Sender: TObject);
begin
   if CB.ItemIndex =0 then
   begin
      CI;
      CP;
      L1.Caption := 'Name1';
      L2.Caption := 'Name2';
      L3.Caption := 'Name3';
      Screen1.Picture.LoadFromFile('Images/Image1.jpg');
      Screen2.Picture.LoadFromFile('Images/Image2.jpg');
      Screen3.Picture.LoadFromFile('Images/Image3.jpg');
      Screen4.Picture.LoadFromFile('Images/Image4.jpg');
      Screen5.Picture.LoadFromFile('Images/Image5.jpg');
      Screen6.Picture.LoadFromFile('Images/Image6.jpg');
   end;
   if CB.ItemIndex =1 then
   begin
      CI;
      CP;
      L1.Caption := 'Name4';
      L2.Caption := 'Name5';
      L3.Caption := 'Name6';
      Screen1.Picture.LoadFromFile('Images/Image7.jpg');
      Screen2.Picture.LoadFromFile('Images/Image8.jpg');
      Screen3.Picture.LoadFromFile('Images/Image9.jpg');
      Screen4.Picture.LoadFromFile('Images/Image10.jpg');
      Screen5.Picture.LoadFromFile('Images/Image11.jpg');
      Screen6.Picture.LoadFromFile('Images/Image12.jpg');
   end;
end;

Код:
procedure TForm1.CBChange(Sender: TObject);
var i,j : integer;
     scr,lbl : TComponent;
begin
   Portrait.Picture.Clear; // это типа СР()
   for i:=1 to 6 do
   begin
      lbl := FindComponent('L'+IntToStr(i));
      if Assigned(lbl) and (lbl is TLabel) then  
         TLabel(lbl).Caption := 'Name'+inttostr(i+CB.ItemIndex*3);
      scr := FindComponent('Screen'+IntToStr(i));
      if Assigned(scr) and (scris TImage) then  
      begin
         TImage(scr).Picture.Clear;  // это типа (CI)     
         TImage(scr).Picture.LoadFromFile('Images/Image'+IntToStr(CB.ItemIndex*6+i) +'.jpg'); 
      end;
   end;
end;
95% сбоев и ошибок приложений, находится в полу метрах от монитора

Последний раз редактировалось JUDAS; 08.09.2017 в 10:12.
JUDAS вне форума Ответить с цитированием
Старый 11.10.2017, 12:06   #5
dummy_user
Форумчанин
 
Аватар для dummy_user
 
Регистрация: 02.03.2013
Сообщений: 109
По умолчанию

Я бы все картинки загрузил в память в TBitmap'ы, а уж потом рисовал где нужно.
По-моему самый толковый вариант.

Не знаю, но может ещё проблема с путями при загрузке картинок.
dummy_user вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Упростить код Gefo PHP 1 23.03.2013 14:20
Упростить код and150382 Microsoft Office Excel 15 15.02.2013 17:21
Упростить код Gefo PHP 1 14.02.2013 16:36
Упростить код slus Microsoft Office Excel 1 11.02.2013 21:10
упростить код на С++ forses2901 Помощь студентам 4 26.09.2011 17:20