unit Unit1; {Drainmaker preliminary version, 31/12/01 modified from original code by dTrog by John August } {$mode objfpc} {$H+} interface {$ASSERTIONS ON} uses classes, forms, buttons, StdCtrls, controls, menus, ExtCtrls, CListBox, ComCtrls, SysUtils, Graphics, Dialogs, Inifiles, Spin, clipbrd, lclLinux, registry, lresources; type TForm1 = class(TForm) Form2: TForm; Form3: TForm; Form4: TForm; buttond : TBitBtn; btnScumColorSelect: TBitBtn; btnDrainColorSelect: TBitBtn; Label1 : TLabel; lblColorInt : TLabel; Edit1 : TEdit; Edit2 : TEdit; Edit3 : TEdit; Edit4 : TEdit; WEdit : TEdit; rdbOk,rdbOkCancel,rdbAbortRetryIgnore,rdbYesNoCancel,rdbYesNo,rdbRetryCancel : TRadioButton; procedure ShowMessage1(Sender : TObject); procedure SetEdits(Hn:string; LV,RV,TV,BV,Rn:integer; SS:boolean); procedure CreateMainMenu; procedure CreateComponents; procedure buttondMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure SelectedColor(Sender : TObject); procedure DecIfGtZero(var N,P:integer; V,O:integer); Bevel1 : TBevel; BitBtn1 : TBitBtn; FontDialog1 : TFontDialog; FinalImage: TForm; LogoImage: TForm; ColorDialog1: TColorDialog; ColourPanel: TForm; MainMenu1: TMainMenu; FileMenu: TMenuItem; FileExit: TMenuItem; EditMenu: TMenuItem; EditCopyFinalImage: TMenuItem; MakeDrainPanel: TForm; ViewMenu: TMenuItem; ViewFinalImage: TMenuItem; AboutMenu: TMenuItem; MaxPreviewPanel: TForm; PreviewPanel: TForm; PreviewImage: TForm; ScreenSizeLabel: TLabel; EditSetwallpaper: TMenuItem; SavePictureDialog: TForm; FileSaveAs: TMenuItem; TitleSheet: TMenuItem; RectSheet: TMenuItem; PipeSheet: TMenuItem; OvalSheet: TMenuItem; BlendSheet: TMenuItem; TitleImage: TForm; RectLabel1: TLabel; RectPresetCombo: TComboBox; RectLabel2: TLabel; RectHint: TLabel; RectGroupBox: TGroupBox; RectLabel3: TLabel; RectLabel4: TLabel; RectLabel5: TLabel; RectLabel6: TLabel; RectLeftEdit: TEdit; RectRightEdit: TEdit; RectTopEdit: TEdit; RectBottomEdit: TEdit; PipeLabel1: TLabel; ScumPanel: TForm; RectRoundedCheck: TCheckBox; RectScumCheck: TCheckBox; EditCopyImageName: TMenuItem; JunctLabel1: TLabel; SettingsMenu: TMenuItem; HelpMenu: TMenuItem; HelpInfo: TMenuItem; N1: TMenuItem; SetFinalImageSize1: TMenuItem; SettingsInvertImage: TMenuItem; EditMirrorImage: TMenuItem; SettingsPsychedelicize: TMenuItem; WhirlSheet: TMenuItem; LogoSheet: TMenuItem; SettingsWatermark: TMenuItem; LogoColourGroup: TRadioGroup; // procedure FormCreate(Sender: TObject); procedure RectPresetComboChange(Sender: TObject); // procedure FormShow(Sender: TObject); procedure ColourPanelClick(Sender: TObject); procedure FileExitClick(Sender: TObject); procedure MakeDrainPanelClick(Sender: TObject); // procedure ViewFinalImageClick(Sender: TObject); procedure MakeRectangularDrain; { procedure MakePipeDrain; } { procedure MakeOvalDrain; } { procedure MakeBlend; } procedure ScumPanelClick(Sender: TObject); procedure HelpInfoClick(Sender: TObject); procedure AddRectPreset(Desc,Fx,Hn:string; L,R,T,B,C,X,Y:integer; SS:boolean); private { Private declarations } public {function ColourAdjust(Z,R,G,B:integer):integer; function ColourSwap(C,M:integer):integer; } FBoxStyle : Integer; IniFile1 : TIniFile; ListBox1, ListBox2 : TListBox; LabelA : Array[0..10] of TLabel; BenchForm : Array[1..59] of TForm; Button1 : Array[0..15] of TButton; File1, New1, Open1, Save1, Sep1, Quit1, Settings1, Comps1, Help1, About1 : TMenuItem; EditM, Event2, Prop2, Sep3 : TMenuItem; View1, Prop1, Event1 : TMenuItem; TTabN, TTabC, TThre, TTim, TTog, TToo, TTrac, TRectDrain, TUpD : TMenuItem; ComboBox1 : TComboBox; CListBox1 : TClistBox; ClipBoard1 : TClipBoard; CheckBox1 : Array[1..35] of TCheckBox; Constructor Create(AOwner: TComponent); override; { Public declarations } end; var Form1: TForm1; EName :string; WatermarkDia :integer; SaveWaterColour: Integer; implementation {uses Clipbrd, FileCtrl, Math, Unit2, Unit3, Unit4;} uses FileCtrl, Math; type AnimType= record aX,aY:integer; CD:boolean; end; ByteSet=set of byte; RectPresetDataType= record pFx,pHint:string; pLeft,pRight,pTop,pBottom,pRound,pMinX,pMinY:integer; pScum:boolean; end; JunctStepType= record jLeft,jRight,jTop,jBottom:integer; end; JunctPresetDataType= record pType :integer; pSeg :array[0..3] of JunctStepType; end; RcpDataType= record Colour,X1,Y1,X2,Y2:integer; end; ScreenDataType= record sWidth,sHeight:integer; sWmult,sHmult,sDiff:extended; end; const WatermarkRatio=150/800; var BottomNow, BottomStart, BY, CurrColour, Dummy1, Dummy2, FinalHeight, FinalWidth, LastJunctSeg, LastJunctType, LeftNow, LeftStart, LogoSize, LM, LX, MDX, MDY, MUX, MUY, OldScreenIndex, PipeNow, PipeStart, PsychedelicizeMode, RcpCnt, RightNow, RightStart, RX, SaveCurrColour, SaveScumColour, ScumColour, ScreenHeight, ScreenIndex, ScreenWidth, SumNow, SumStart, TM, TopNow, TopStart, TY, WatermarkX, WatermarkY, XDiaNow, XDiaStart, YDiaNow, YDiaStart :integer; ImageName, WallDir, WinDir :string; AllowDataSwap, AllowProgMenu, DoDraw, ControlledWatermark, FormClosing, FormLoaded :boolean; HeightAspect:single; RectD,RectS, RectWrkSpc :TRect; RCPData :array[1..500] of RcpDataType; RectPresetData: array[0..20] of RectPresetDataType; JunctPresetData: array[0..20] of JunctPresetDataType; JunctBuffer :array[0..6,0..3] of JunctStepType; AnimBuffer :array[1..2,1..1200] of AnimType; ScreenData:array[0..9] of ScreenDataType; {--- borrowed from tools ---} procedure TForm1.ShowMessage1(Sender : TObject); begin If Sender=TRectDrain then begin BenchForm[3].Show; end; end; procedure TForm1.SetEdits(Hn:string; LV,RV,TV,BV,Rn:integer; SS:boolean); begin with BenchForm[3] do begin { RectHint.Caption:=Hn;} RectLeftEdit.Text:=IntToStr(LV); RectTopEdit.Text:=IntToStr(TV); RectRightEdit.Text:=IntToStr(RV); RectBottomEdit.Text:=IntToStr(BV); RectRoundedCheck.Checked:=Boolean(Rn); RectScumCheck.Checked:=SS; end; end; constructor TForm1.Create(AOwner: TComponent); begin inherited Create(AOwner); SetBounds(0 ,0,200,200); Height := 300; Align := alNone; AutoSize := False; BorderStyle := bsDialog; BorderWidth := 0; Caption := 'Drainmaker !'; Color := clBtnFace; DragKind := dkDrag; DragMode := dmManual; Font.Color := clBlack; Font.Height := -11; Font.Name := 'avantgarde'; Font.Pitch := fpDefault; Font.Size := 10; KeyPreview := True; Left := 50; Name := 'Form1'; ParentFont := True; Tag := 9; Top := 50; Width := 403; WindowState := wsNormal; Randomize; CreateMainMenu; CreateComponents; End; procedure TForm1.CreateMainMenu; begin MainMenu1 := TMainMenu.Create(Self); MainMenu1.Name := 'MainMenu1'; Menu := MainMenu1; File1 := TMenuItem.Create(Self); File1.Caption := '&File'; MainMenu1.Items.Add(File1); New1 := TMenuItem.Create(Self); New1.Caption := '&New'; { New1.OnClick := @NewMemo;} File1.Add(New1); Open1 := TMenuItem.Create(Self); Open1.Caption := '&Open'; { Open1.OnClick := @OpenMemo; } File1.Add(Open1); Save1 := TMenuItem.Create(Self); Save1.Caption := '&Save as...'; { Save1.OnClick := @SaveMemoAs;} File1.Add(Save1); Sep1 := TMenuItem.Create(Self); Sep1.Caption := '-'; File1.Add(Sep1); Quit1 := TMenuItem.Create(Self); Quit1.Caption := '&Quit'; { Quit1.OnClick := @QuitClick;} File1.Add(Quit1); EditM := TMenuItem.Create(Self); EditM.Caption := '&Edit'; MainMenu1.Items.Add(EditM); { Copy1 := TMenuItem.Create(Self); Copy1.Caption := 'C&opy Ctrl+C'; Paste1 := TMenuItem.Create(Self); Paste1.Caption := '&Paste Ctrl+V'; Cut1 := TMenuItem.Create(Self); Cut1.Caption := 'C&ut Ctrl+X'; Sep2 := TMenuItem.Create(Self); Sep2.Caption := '-'; Find1 := TMenuItem.Create(Self); Find1.Caption := '&Find'; Replace1 := TMenuItem.Create(Self); Replace1.Caption := '&Replace'; EditM.Add(Copy1); EditM.Add(Paste1); EditM.Add(Cut1); EditM.Add(Sep2); EditM.Add(Find1); EditM.Add(Replace1);} View1 := TMenuItem.Create(Self); View1.Caption := '&View'; MainMenu1.Items.Add(View1); Prop1 := TMenuItem.Create(Self); Prop1.Caption := '&Properties'; Event1 := TMenuItem.Create(Self); Event1.Caption := '&EventSnoop'; { Event1.OnClick := @EventFormShow;} View1.Add(Prop1); View1.Add(Event1); Settings1 := TMenuItem.Create(Self); Settings1.Caption := '&Settings'; MainMenu1.Items.Add(Settings1); Event2 := TMenuItem.Create(Self); Event2.Caption := 'E&ventSnoop'; Prop2 := TMenuItem.Create(Self); Prop2.Caption := 'P&roperties'; Sep3 := TMenuItem.Create(Self); Sep3.Caption := '-'; { Color1 := TMenuItem.Create(Self); Color1.Caption := '&Color'; Font1 := TMenuItem.Create(Self); Font1.Caption := 'F&ont'; Print1 := TMenuItem.Create(Self); Print1.Caption := '&Print'; PrintS1 := TMenuItem.Create(Self); PrintS1.Caption := 'Printer &Setup'; Settings1.Add(Event2); Settings1.Add(Prop2); Settings1.Add(Sep3); Settings1.Add(Color1); Settings1.Add(Font1); Settings1.Add(Print1); Settings1.Add(PrintS1);} Comps1 := TMenuItem.Create(Self); Comps1.Caption := '&Drains'; MainMenu1.Items.Add(Comps1); TRectDrain := TMenuItem.Create(Self); TRectDrain.Caption := 'TRectDrain'; TRectDrain.OnClick := @ShowMessage1; Comps1.Add(TRectDrain); Help1 := TMenuItem.Create(Self); Help1.Caption := '&Help'; MainMenu1.Items.Add(Help1); About1 := TMenuItem.Create(Self); About1.Caption := '&About...'; { About1.OnClick := @ShowTestForm;} Help1.Add(About1); end; procedure TForm1.CreateComponents;//++ CREATE COMPONENTS ++++++++++++++++++++++++++++ var i : Integer; begin For i:=1 to 30 do begin BenchForm[i] := TForm.Create(Self); With BenchForm[i] do Begin if (i = 3) then SetBounds (50,400,400,400); if (i = 4) then SetBounds (500,400,500,500); Parent := Self; // ClientHeight := 254; // ClientWidth := 392; KeyPreview := True; // Height := 400; // Width := 500; Caption := 'TestForm '+IntToStr(i); Color := clBtnFace; BorderStyle := bsDialog; // Position := poScreenCenter; // Left := 100; // Top := 100; end; end; BenchForm[3].Caption := 'Rectangular Drain'; BenchForm[4].Caption := 'Drain Making Template'; {lblColorInt := Tlabel.Create(Self); With lblColorInt do begin Parent := BenchForm[3]; Top := 50; Left := 225; Width := 200; Height := 20; Show; Caption := 'Integer Color: '; end; } btnScumColorSelect := TBitBtn.Create(Self); with btnScumColorSelect do begin OnClick := @SelectedColor; Parent := BenchForm[3]; Top := 100; Left:= 225; Width := 110; Height := 20; Kind := bkCustom; Caption := 'Scum Color'; Hint := 'Color Dialog (Some repaint problem, move the form to se the effect !!)'; ShowHint := True; Visible := True; end; btnDrainColorSelect := TBitBtn.Create(Self); with btnDrainColorSelect do begin OnClick := @SelectedColor; Parent := BenchForm[3]; Top := 150; Left:= 225; Width := 110; Height := 20; Kind := bkCustom; Caption := 'Drain Color'; Hint := 'Color Dialog (Some repaint problem, move the form to se the effect !!)'; ShowHint := True; Visible := True; end; buttond := TBitBtn.Create(Self); With buttond do begin OnMouseDown := @buttondMouseDown; Parent := BenchForm[3]; width := 110; // height := 32; left := 225; top := 200; AutoSize := True; caption := 'Make Drain'; Show; end; RectPresetCombo := TComboBox.Create(Self); with RectPresetCombo do begin Parent := BenchForm[3]; OnChange := @RectPresetComboChange; // Anchors := ComboBox1.Anchors + [akTop,akLeft]; Color := clRed; Cursor := crDefault; //Only crDefault DragCursor := crDrag; DragKind := dkDrag; DragMode := dmManual; Enabled := True; Font.Color := clBlue; Font.Height := -11; Font.Name := 'avantgarde'; //No function Font.Pitch := fpDefault; Font.Size := 10; Height := 32; Hint := 'Components'; //Don't work... Left := 225; Name := 'ComboBox1'; ParentColor := False; ParentFont := True; ParentShowHint := True; ShowHint := True; //Don't work... Sorted := False; //If true Access violation Style := csDropDown; TabOrder := 0; TabStop := False; Tag := 9; Text := 'Hello there !!'; Top := 250; Visible := True; Width := 160; end; For i := 0 to 3 do begin case i of 0 : begin RectLeftEdit := TEdit.Create(Self); WEdit := RectLeftEdit; EName := 'Left'; end; 1 : begin RectRightEdit := TEdit.Create(Self); WEdit := RectRightEdit; EName := 'Right'; end; 2 : begin RectTopEdit := TEdit.Create(Self); WEdit := RectTopEdit; EName := 'Top'; end; 3 : begin RectBottomEdit := TEdit.Create(Self); WEdit := RectBottomEdit; EName := 'Bottom'; end; end; With WEdit do begin Parent := BenchForm[3]; AutoSize := True; BorderStyle := bsSingle; Ctl3D := True; Cursor := crDefault; DragCursor := crDrag; DragMode := dmManual; Enabled := True; Font.Height := -11; Font.Name := 'avantgarde'; Font.Size := 10; Height := 21; Hint := '1'; Caption := '1'; Left := 100; Name := EName; ParentColor := False; ParentFont := True; ParentShowHint := True; ReadOnly := False; ShowHint := True; TabOrder := 0; TabStop := False; Tag := 9; Top := 10+i*50; Visible := True; Width := 40; end; LabelA[i] := TLabel.Create(Self); With LabelA[i] do begin Parent := BenchForm[3]; width := 80; left := 25; top := 12+i*50; Caption := EName; Autosize := True; Show; end; end; BenchForm[3].Show; BenchForm[4].Show; //MainMenu1.Hide; RectRoundedCheck := TCheckBox.Create(Self); with RectRoundedCheck do begin Parent := BenchForm[3]; AllowGrayed := True; Anchors := RectRoundedCheck.Anchors + [akTop, akLeft]; Caption := 'Rounded'; Checked := False; Color := clBlue; //Constraints Cursor := crDefault; //Error if not crDefault DragCursor := crDrag; DragKind := dkDrag; DragMode := dmManual; Enabled := True; Font.Color := clRed; Font.Height := -11; Font.Name := 'adventure'; Font.Pitch := fpDefault; Font.Size := 6; Height := 20; Hint := 'RadioButton1'; Left := 10; ParentColor := True; ParentFont := False; ParentShowHint := True; ShowHint := True; State := cbUnchecked; TabOrder := 10; Tag := 0; Top := 250; Visible := True; Width := 100; end; RectScumCheck := TCheckBox.Create(Self); with RectScumCheck do begin Parent := BenchForm[3]; AllowGrayed := True; Anchors := RectScumCheck.Anchors + [akTop, akLeft]; Caption := 'Scum'; Checked := False; Color := clBlue; //Constraints Cursor := crDefault; //Error if not crDefault DragCursor := crDrag; DragKind := dkDrag; DragMode := dmManual; Enabled := True; Font.Color := clRed; Font.Height := -11; Font.Name := 'adventure'; Font.Pitch := fpDefault; Font.Size := 6; Height := 20; Hint := 'RadioButton1'; Left := 10; ParentColor := True; ParentFont := False; ParentShowHint := True; ShowHint := True; State := cbUnchecked; TabOrder := 10; Tag := 0; Top := 300; Visible := True; Width := 100; end; ColorDialog1 := TColorDialog.Create(Self); AddRectPreset('none','-','', 00,45,00,36,0,999,999,false); AddRectPreset('Abyss','S','No skateboarding!!!', 15,15,10,22,0,000,000,false); AddRectPreset('Eternity','-','', 35,20,20,25,1,999,999,true); AddRectPreset('Eyes','E','', 33,20,20,25,0,020,010,false); AddRectPreset('Fortress','-','', 27,27,23,23,0,999,999,true); AddRectPreset('Hercules','-','', 45,10,18,18,0,999,999,false); AddRectPreset('Milsons','-','', 30,24,16,30,0,999,999,false); AddRectPreset('Mooney','-','', 25,25,17,22,0,999,999,false); AddRectPreset('Pill Box','S','', 09,09,26,11,0,000,000,false); AddRectPreset('Pyramid','S','I know it''s actually round!', 20,20,15,15,1,020,020,false); AddRectPreset('Silos','S','Widen the gap.', 30,30,00,00,0,050,000,false); AddRectPreset('Slide','-','', 20,20,10,35,0,999,999,true); AddRectPreset('Swoo','-','', 10,45,10,36,0,999,999,true); AddRectPreset('TarbanCk','-','', 25,25,35,15,0,999,999,false); AddRectPreset('World Drain','S','', 00,00,00,25,0,000,000,false); AddRectPreset('dTrogs Hole','E','', 27,27,33,07,1,008,008,false); // RectPresetCombo.ItemIndex:=0; END; procedure TForm1.SelectedColor(Sender : TObject); begin ColorDialog1.Execute; writeln ('picked color', ColorDialog1.Color); if (Sender = btnScumColorSelect) then SaveScumColour := ColorDialog1.Color; if (Sender = btnDrainColorSelect) then SaveCurrColour := ColorDialog1.Color; End; procedure TForm1.buttondMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin MakeRectangularDrain; BenchForm[4].Show; end; {---------- Common -----------------------------------------------------------} procedure DoNothing; begin end; function BoolToStr(B:boolean):string; begin if B then BoolToStr:='1' else BoolToStr:='0'; end; procedure TForm1.DecIfGtZero(var N,P:integer; V,O:integer); begin if N>0 then begin dec(N); P:=P+V; if P=O then begin P:=P-V; end; end; end; procedure DecIfGtZero2(var N,L,H:integer; V:integer); begin if N>0 then begin dec(N); L:=L+V; H:=H-V; if L>=H then begin L:=L-V; H:=H+V; N:=0; end; end; end; procedure Delay(MSecs: Longint); var FirstTickCount, Now: Longint; begin { Need to grab timer operation from demo code } { FirstTickCount := GetTickCount; repeat Application.ProcessMessages; { Now := GetTickCount; } until (Now - FirstTickCount >= MSecs) or (Now < FirstTickCount); } end; function Istr(I,N:integer):string; var S : string; begin Str(I, S); Istr := S; end; function Ival(S: string):integer; var I, J : integer; begin Val (S, I, J); Ival := I; end; function ImagePrefix:string; begin ImagePrefix:='DrainMaker20' +Istr(ScreenIndex,1)+'-'; end; function IstrIval(T:string; S,L:integer):string; begin IstrIval:=Istr(Ival(copy(T,S,L)),0); end; function Limit256(I:integer):integer; begin if I<0 then I:=0; if I>255 then I:=255; Limit256:=I; end; function Right(S:string; N:integer):string; var I : integer; begin I := Length(S) - N; Right := Copy(S, I, Length(S)); end; function LZ(N,L:integer):string; begin LZ:=Right('000000000'+IntToStr(N),L); end; function NullTermToStr(S:string):string; var P:integer; begin P:=pos(#0,S); if P>1 then NullTermToStr:=copy(S,1,P-1) else NullTermToStr:=''; end; function RN( rRange,rMult,rBase:integer):integer; begin RN:=Random(rRange) * rMult + rBase; end; function Red(C:integer):integer; begin Red:=C and $FF; end; function Green(C:integer):integer; begin Green:=(C and $FF00) shr 8; end; function Blue(C:integer):integer; begin Blue:=(C and $FF0000) shr 16; end; function MakeColour(R,G,B:integer):integer; begin MakeColour:=(B shl 16) + (G shl 8) + R; end; function ColourSwap(C,M:integer):integer; var B1,G1,R1:integer; begin R1:=Red(C); G1:=Green(C); B1:=Blue(C); if M=6 then M:=Random(6); case M of 1: ColourSwap:=MakeColour(G1,R1,B1); 2: ColourSwap:=MakeColour(B1,G1,R1); 3: ColourSwap:=MakeColour(R1,B1,G1); 4: ColourSwap:=MakeColour(B1,R1,G1); 5: ColourSwap:=MakeColour(G1,B1,R1); else ColourSwap:=C; end; end; function ColourAdjust(Z,R,G,B:integer):integer; var B1,G1,R1:integer; begin R1:=Limit256(Red(Z)+R); G1:=Limit256(Green(Z)+G); B1:=Limit256(Blue(Z)+B); ColourAdjust:=MakeColour(R1,G1,B1); end; {---------- Rectangular Drain ------------------------------------------------} procedure TForm1.MakeRectangularDrain; var EX,EY,I,J,SBS,SLS,SRS,STS,SXL,SXR,dx,dy:integer; begin SLS:=StrToInt(RectLeftEdit.Text); SRS:=StrToInt(RectRightEdit.Text); STS:=StrToInt(RectTopEdit.Text); SBS:=StrToInt(RectBottomEdit.Text); LeftStart:=SLS; RightStart:=SRS; TopStart:=STS; BottomStart:=SBS; ImageName:=ImagePrefix+'R'+LZ(LeftStart,2)+LZ(RightStart,2) +LZ(TopStart,2)+LZ(BottomStart,2) +BoolToStr(RectRoundedCheck.Checked) +BoolToStr(RectScumCheck.Checked) +IntToHex(SaveCurrColour,6) +IntToHex(SaveScumColour,6)+'.bmp'; { +BoolToStr(SettingsInvertImage.Checked) +IntToStr(PsychedelicizeMode) +'.bmp';} LX:=0; TY:=0; RX:=BenchForm[4].Width; BY:=BenchForm[4].Height; CurrColour:=SaveCurrColour; ScumColour:=SaveScumColour; with BenchForm[4].Canvas do begin Pen.Color:=CurrColour; Pen.Style:=psSolid; Brush.Color:=CurrColour; FillRect(Rect(0,0,RX,BY)); Brush.Color:=clBlack; FillRect(Rect(RX div 10, BY div 10, RX div 10 * 9, BY div 10 * 9)); end; repeat LeftNow:=LeftStart; TopNow:=TopStart; RightNow:=RightStart; BottomNow:=BottomStart; repeat dx := ( RX-LX ) div 5; dy := ( BY-TY ) div 5; BenchForm[4].Canvas.Brush.Color:=CurrColour; BenchForm[4].Canvas.Pen.Color:=CurrColour; with BenchForm[4].Canvas do if RectRoundedCheck.Checked then { RoundRect(LX,TY,RX,BY,(RX-LX) div 5,(BY-TY) div 5) } begin MoveTo(LX, BY-dy); LineTo(LX, TY+dy); Arc(LX, TY, dx*2,dy*2,1440,1440); MoveTo(LX+dx, TY); LineTo(RX-dx, TY); Arc(RX-2*dx, TY, dx*2, dy*2,1440,-1440); MoveTo(RX, TY+dy); LineTo(RX, BY-dy); Arc(RX-2*dx, BY-2*dy, dx*2, dy*2,0, -1440); MoveTo(RX-dx, BY); LineTo(LX+dx, BY); Arc(LX, BY-2*dy, dx*2, dy*2, -1440, -1440); end else begin MoveTo(LX,TY); LineTo(RX,TY); LineTo(RX,BY); LineTo(LX,BY); LineTo(LX,TY); end; SXL:=LX+LeftStart+20; SXR:=RX-RightStart-20; if Form1.RectScumCheck.Checked and (SXL0 then CurrColour:=ColourSwap(CurrColour,PsychedelicizeMode);} SumStart:=LeftStart+RightStart+TopStart+BottomStart; until SumStart=0; if RectRoundedCheck.Checked then with BenchForm[4].Canvas do begin { Brush.Color:=SaveCurrColour; if (SLS*STS)>0 then FloodFill(1,1,clBlack,fsSurface); if (SRS*STS)>0 then FloodFill(Width-1,1,clBlack,fsSurface); if (SRS*SBS)>0 then FloodFill(Width-1,Height-1,clBlack,fsSurface); if (SLS*SBS)>0 then FloodFill(1,Height-1,clBlack,fsSurface);} end; with RectPresetData[RectPresetCombo.ItemIndex] do if ((RX-LX)>pMinX) and ((BY-TY)>pMinY) then if pFx='E' {Eyes} then begin EX:=Random(RX-LX-8)+LX+1; EY:=BY-10; for I:=-1 to 1 do for J:=-1 to 1 do begin BenchForm[4].Canvas.Pixels[EX+I,EY+J]:=clWhite; BenchForm[4].Canvas.Pixels[EX+6+I,EY+J]:=clWhite; end; end else if pFx='S' {Stars} then begin for I:=1 to 100 do BenchForm[4].Canvas.Pixels[Random(RX-LX)+LX, Random(BY-TY)+TY]:=clWhite; end; { ShowLogoWatermark(BenchForm[4].Canvas,$6,$6,$6); RectD:=Rect(0,0,PreviewImage.Width,PreviewImage.Height); PreviewImage.StretchDraw(RectD,BenchForm[4].Canvas.Picture.Bitmap); } BenchForm[4].Show; end; {---------- Events -----------------------------------------------------------} procedure TForm1.ColourPanelClick(Sender: TObject); begin ColorDialog1.Color:=SaveCurrColour; if ColorDialog1.Execute=false then exit; with ColourPanel do begin Color:=ColorDialog1.Color; Font.Color:=ColorDialog1.Color xor $808080; SaveCurrColour:=Color; end; MakeDrainPanelClick(Sender); end; procedure TForm1.ScumPanelClick(Sender: TObject); begin ColorDialog1.Color:=SaveScumColour; if ColorDialog1.Execute=false then exit; ScumPanel.Color:=ColorDialog1.Color; SaveScumColour:=ScumPanel.Color; MakeDrainPanelClick(Sender); end; procedure TForm1.RectPresetComboChange(Sender: TObject); begin writeln ('index', RectPresetCombo.ItemIndex); if RectPresetCombo.ItemIndex<0 then exit; with RectPresetData[RectPresetCombo.ItemIndex] do begin writeln ('stuff:', pScum,pHint,pLeft); SetEdits(pHint,pLeft,pRight,pTop,pBottom,pRound,pScum); end; // MakeDrainPanelClick(Sender); end; procedure TForm1.MakeDrainPanelClick(Sender: TObject); begin { Screen.Cursor:=crHourGlass; ControlledWatermark:=(Sender=Form3.HiddenMemo); } if Sender<>LogoSheet then begin PreviewPanel.Show; PreviewImage.Show; end; { case Sender of 0: DoNothing; 1: MakeRectangularDrain; 2: MakeJunctionDrain; 3: MakePipeDrain; 4: MakeOvalDrain; 5: MakeBlend; 6: MakeWhirlpool; 7: MakeSccLogo; else DoNothing; end;} { if SenderIndex in [1..6] then if SettingsInvertImage.Checked then with Form2.FinalImage do begin Canvas.CopyMode:=cmDstInvert; RectD:=Rect(0,0,Width,Height); Canvas.CopyRect(RectD,PreviewImage.Canvas, Rect(0,0,PreviewImage.Width,PreviewImage.Height)); Canvas.CopyMode:=cmSrcCopy; RectD:=Rect(0,0,PreviewImage.Width,PreviewImage.Height); PreviewImage.Canvas.StretchDraw(RectD,Picture.Bitmap); end;} { Screen.Cursor:=crDefault; } end; {---------- Menu -------------------------------------------------------------} {procedure TForm1.FileSaveAsClick(Sender: TObject); begin if (PreviewPanel.Visible=false) or (TObject=TitleSheet) then begin ShowMessage('Error: No image to save.'); exit; end; with SavePictureDialog do if Execute then Form2.FinalImage.Picture.SaveToFile(Filename); end; } procedure TForm1.FileExitClick(Sender: TObject); begin FormClosing:=true; Application.Terminate; end; { procedure TForm1.EditCopyFinalImageClick(Sender: TObject); var W:word; D:Cardinal; P:Hpalette; begin with Form3 do if F3Mode=F3help then begin HelpMemo.CopyToClipboard; exit; end else if F3Mode=F3hidden then begin HiddenMemo.CopyToClipboard; exit; end else if TObject=RecreateSheet then begin { HiddenMemo.Clear; } { HiddenMemo.Lines.Add(RecreateBox.Text); } HiddenMemo.SelectAll; HiddenMemo.CopyToClipboard; HiddenMemo.SelLength:=0; exit; end; if (PreviewPanel.Visible=false) or (TObject=TitleSheet) then begin ShowMessage('Error: No image to copy.'); exit; end; { Form2.FinalImage.Picture.Bitmap.SaveToClipboardFormat(W,D,P); } ClipBoard.SetAsHandle(W,D); end; procedure TForm1.SetFinalImageSize(W,H:integer); begin FinalWidth:=W; FinalHeight:=H; with Form2 do begin { FinalImage.Picture:=nil; } Left:=0; Top:=0; Width:=RectWrkSpc.Right; Height:=RectWrkSpc.Bottom; FinalImage.Width:=W; FinalImage.Height:=H; HeightAspect:=Int(H) / Int(W); WatermarkDia:=Round(W * WatermarkRatio); DrawLogo(LogoImage,clBlack,SaveWaterColour,WatermarkDia,0,0); end; { Form2.Refresh; } { FinalImage.Refresh; } FinalSizeLabel.Caption:='Final Image is ' +IntToStr(W)+' x '+IntToStr(H); end; } procedure TForm1.HelpInfoClick(Sender: TObject); begin { F3Mode:=F3help; } Form3.Show; end; {---------- Form -------------------------------------------------------------} procedure TForm1.AddRectPreset(Desc,Fx,Hn:string; L,R,T,B,C,X,Y:integer; SS:boolean); begin with RectPresetCombo do begin Items.Add(Desc); with RectPresetData[Items.Count-1] do begin pFx:=Fx; pHint:=Hn; pLeft:=L; pRight:=R; pTop:=T; pBottom:=B; pRound:=C; pMinX:=X; pMinY:=Y; pScum:=SS; end; end; end; { procedure TForm1.FormCreate(Sender: TObject); var I:integer; Pars,uPars:string; begin FormLoaded:=false; FormClosing:=false; for I:=1 to ParamCount do Pars:=Pars+ParamStr(I); uPars:=UpperCase(Pars); Randomize; LoadScreenData(0,640,480,0.90,0.88); LoadScreenData(1,800,600,1.00,1.00); LoadScreenData(2,1024,768,1.17,1.17); LoadScreenData(3,1152,864,1.24,1.21); LoadScreenData(4,1210,908,1.28,1.25); LoadScreenData(5,1210,1024,1.21,1.33); LoadScreenData(6,1280,960,1.34,1.33); LoadScreenData(7,1280,1024,1.34,1.38); LoadScreenData(8,1400,1050,1.38,1.38); LoadScreenData(9,1600,1200,1.45,1.46); PsychedelicizeMode:=0; LastJunctType:=-1; LastJunctSeg:=-1; {$IFDEF SW1210} ScreenWidth:=1210; ScreenHeight:=1024; {$ELSE SW1210} {$IFDEF SW1024} ScreenWidth:=1024; ScreenHeight:=768; {$ELSE SW1024} {$IFDEF SW0848} ScreenWidth:=848; ScreenHeight:=480; {$ELSE SW0848} {$IFDEF SW0800} ScreenWidth:=800; ScreenHeight:=600; {$ELSE SW0800} {$IFDEF SW0640} ScreenWidth:=640; ScreenHeight:=480; {$ELSE SW0640} ScreenWidth:=GetSystemMetrics(SM_CXSCREEN); ScreenHeight:=GetSystemMetrics(SM_CYSCREEN); {$ENDIF SW0640} {$ENDIF SW0800} {$ENDIF SW0848} {$ENDIF SW1024} {$ENDIF SW1210} WallDir:='C:\Wallpaper'; { if not SystemParametersInfo(SPI_GETWORKAREA,0,@RectWrkSpc,0) then RectWrkSpc:=Rect(0,0,800,572); } { TObjectIndex:=0; } with SavePictureDialog do { InitialDir:=WallDir; } SaveCurrColour:=ColourPanel.Color; SaveScumColour:=ScumPanel.Color; SaveWaterColour:=clBlue; {Rect} { RectPresetCombo.Clear; } AddRectPreset('none','-','', 00,45,00,36,0,999,999,false); AddRectPreset('Abyss','S','No skateboarding!!!', 15,15,10,22,0,000,000,false); AddRectPreset('Eternity','-','', 35,20,20,25,1,999,999,true); AddRectPreset('Eyes','E','', 33,20,20,25,0,020,010,false); AddRectPreset('Fortress','-','', 27,27,23,23,0,999,999,true); AddRectPreset('Hercules','-','', 45,10,18,18,0,999,999,false); AddRectPreset('Milsons','-','', 30,24,16,30,0,999,999,false); AddRectPreset('Mooney','-','', 25,25,17,22,0,999,999,false); AddRectPreset('Pill Box','S','', 09,09,26,11,0,000,000,false); AddRectPreset('Pyramid','S','I know it''s actually round!', 20,20,15,15,1,020,020,false); AddRectPreset('Silos','S','Widen the gap.', 30,30,00,00,0,050,000,false); AddRectPreset('Slide','-','', 20,20,10,35,0,999,999,true); AddRectPreset('Swoo','-','', 10,45,10,36,0,999,999,true); AddRectPreset('TarbanCk','-','', 25,25,35,15,0,999,999,false); AddRectPreset('World Drain','S','', 00,00,00,25,0,000,000,false); AddRectPreset('dTrogs Hole','E','', 27,27,33,07,1,008,008,false); RectPresetCombo.ItemIndex:=0; {Junct} AllowDataSwap:=false; { JunctPresetCombo.Clear; } AddJunctPreset('none', 0, 000,000,000,000, 000,000,000,000, 000,000,000,000, 000,000,000,000); AddJunctPreset('Sample Horizontal', 0, 12,48,12,16, 48,12,12,16, 00,00,00,00, 00,00,00,00); AddJunctPreset('Basic Vertical', 1, 14,24,20,22, 24,14,20,22, 00,00,00,00, 00,00,00,00); AddJunctPreset('Fire Drain', 1, 13,24,38,05, 24,13,14,35, 00,00,00,00, 00,00,00,00); AddJunctPreset('Sample Horz Upper Split', 2, 09,26,12,20, 26,09,12,20, 20,20,10,22, 00,00,00,00); AddJunctPreset('Lone Straw', 2, 24,04,16,00, 04,24,16,00, 24,24,00,21, 16,16,16,16); AddJunctPreset('Sample Horz Lower Split', 3, 20,20,08,24, 08,24,10,20, 24,08,10,20, 00,00,00,00); AddJunctPreset('Sample Vert Left Split', 4, 16,16,10,21, 14,24,14,18, 24,14,16,20, 00,00,00,00); AddJunctPreset('Bridge Room w strut', 5, 14,14,12,26, 14,14,12,08, 14,14,08,26, 12,12,12,12); AddJunctPreset('Bunker', 5, 18,18,25,18, 14,14,15,00, 14,14,00,52, 12,12,12,12); AddJunctPreset('4-Way Super Link', 6, 12,28,15,15, 28,12,15,15, 18,16,06,26, 16,18,06,26); AddJunctPreset('Roof Support', 6, 28,08,15,00, 08,28,15,00, 28,10,00,23, 10,28,00,23); AddJunctPreset('Big Junction', 6, 08,08,15,00, 08,08,15,00, 14,14,00,20, 14,14,00,23); AddJunctPreset('Diffuser 1', 6, 30,10,00,08, 30,10,00,08, 10,30,08,00, 10,30,08,00); AddJunctPreset('Diffuser 2', 6, 06,08,10,22, 08,06,22,10, 06,08,10,22, 08,06,22,10); LastJunctType:=0; LastJunctSeg:=0; JunctPresetCombo.ItemIndex:=0; JunctTypeGroup.ItemIndex:=0; JunctSegGroup.ItemIndex:=0; LoadJunctBuffer; LoadJunctEdits(0,0); AllowDataSwap:=true; SaveJunctBuffer; {Pipe} { with PipeInitDiaUpDown do begin Max:=ScreenHeight; Position:=Max; Min:=100; end; with PipeLMUpDown do begin Max:=ScreenWidth-ScreenHeight; Position:=Max; Min:=0; end; with PipeTMUpDown do begin Max:=ScreenHeight; Position:=0; Min:=0; end; } end; procedure TForm1.FormShow(Sender: TObject); begin if FormLoaded then exit; ScreenSizeLabel.Caption:='Screen size is ' +IntToStr(ScreenWidth)+' x '+IntToStr(ScreenHeight); DrawLogo(TitleImage,clWhite,clBlue,150,0,0); WatermarkDia:=Round(ScreenWidth * WatermarkRatio); DrawLogo(LogoImage,clBlack,SaveWaterColour,WatermarkDia,0,0); SetFinalImageSize(ScreenWidth,ScreenHeight); WatermarkX:=FinalWidth div 2 -(WatermarkDia div 2); WatermarkY:=FinalHeight div 2 -(WatermarkDia div 2); FormResize(Sender); FormLoaded:=true; PreviewImage.Width:=PreviewPanel.Width-8; PreviewImage.Height:=PreviewPanel.Height-8; { PreviewImage.Refresh; } if (Int(PreviewImage.Width) * HeightAspect)>PreviewImage.Height then PreviewImage.Width:= round(int(PreviewImage.Height) / HeightAspect) else PreviewImage.Height:= round(int(PreviewImage.Width) * HeightAspect); CalcScreenIndex; SetFinalImageSize1.Items[ScreenIndex].Checked:=true; BufferDataConversion(1,ScreenIndex); {1=800x600} AllowDataSwap:=true; JunctTypeGroupClick(Sender); { FormResize(LabelEffect1); } end; {=============================================================================} procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin FormClosing:=true; end; } function Sgn(I:integer):Integer; begin Sgn := 0; if I >0 then Sgn := 1; if I <0 then Sgn := -1; end; function DumpColour(C:integer):string; var B,G,R:integer; begin R:=Red(C); G:=Green(C); B:=Blue(C); DumpColour:=' R='+Istr(R,0)+' G='+Istr(G,0)+' B='+Istr(B,0) +' V='+Istr(C,0)+' $'+IntToHex(C,6); end; function AddIf(B:boolean):integer; begin if B then AddIf:=1 else AddIf:=0; end; End.