|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Сократить программный код
Помогите сократить программный код
Код:
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. Последний раз редактировалось Admin, 06.12.2017 в 21:04. |
#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); procedure SetCntrls(AUpDown : TUpDown; AScrollBar : TScrollBar; AEdit : TEdit; AValue : TColor); begin AupDown.Position := AValue; AScrollBar.Position := AValue; AEdit.Text := IntToStr(AValue); end; begin RedColor := 127; SetCntrls(redUpDown, sbRedScroll, editRed, RedColor); GreenColor := 127; SetCntrls(greenUpDown, sbGreenScroll, editGreen, GreenColor); BlueColor := 127; SetCntrls(blueUpDown, sbBlueScroll, editBlue, 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); procedure UpdEditCntrls(AEdit : TEdit; AUpDown : TUpDown; AScrollBar : TScrollBar; var AValue : TColor); var S: String; begin S:=AEdit.Text; S := StringReplace(S,' ','',[rfReplaceAll]) if S = '' then Exit; AValue := StrToInt(S); if AValue < 0 then AValue := 0; if AValue > 255 then AValue := 255; AUpDown.Position:=AValue; AScrollBar.Position:=AValue; end; begin if (sender as TEdit).Name='editred' then UpdEditCntrls((sender as TEdit).Text, RedUpDown, sbRedScroll, RedColor); if (sender as TEdit).Name='editgreen' then UpdEditCntrls((sender as TEdit).Text, GreenUpDown, sbGreenScroll, GreenColor); if (sender as TEdit).Name='editblue' then UpdEditCntrls((sender as TEdit).Text, BlueUpDown, sbBlueScroll, BlueColor); shShape.Brush.Color:=RGB(RedColor,GreenColor,BlueColor); end; procedure TForm1.sbScrollChange(Sender: TObject); procedure UpdScrollCntrls(AScrollBar : TScrollBar; AUpDown : TUpDown; AEdit : TEdit; var AValue : TColor); begin AValue := AScrollBar.Position; AUpDown.Position := AValue; AEdit.Text := IntToStr(AValue); FGK(AScrollBar); end; begin if (sender as TScrollBar).Name='sbRedScroll' then UpdScrollCntrls(sbRedScroll, RedUpDown, editRed, RedColor); if (sender as TScrollBar).Name='sbGreenScroll' then UpdScrollCntrls(sbGreenScroll, GreenUpDown, editGreen, GreenColor); if (sender as TScrollBar).Name='sbBlueScroll' then UpdScrollCntrls(sbBlueScroll, BlueUpDown, editBlue, BlueColor); shShape.Brush.Color:=RGB(RedColor,G reenColor,BlueColor); 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. Там особо сокращать нечего, только общие части вытащить в отдельные процедурки. Последний раз редактировалось lmikle, 06.12.2017 в 23:38. |