Ver$ = "v. Beta 1.73.5"
$OPTIMIZE ON
$OPTION ICON "DxfONE!.ico"
$RESOURCE rgbASMProc AS "dxfone.bin"
$RESOURCE ICO AS "DxfONE!.ico"
$RESOURCE SKIN AS "DxfONE!.sk"
$RESOURCE SKIN1 AS "DxfONE!.sk1"
$RESOURCE INDEX AS "DxfONE!.ix"
$RESOURCE CAM AS "DxfONE!c.bmp"
$INCLUDE "DxfONE!h.inc"
DECLARE SUB Welcome
DECLARE SUB Starter
DECLARE SUB BmpLoad
DECLARE SUB OpenItemClick
DECLARE SUB SaveAsItemClick
DECLARE SUB SaveProc
DECLARE SUB NoSave
DECLARE SUB HalfTone
DECLARE SUB PreOutLine
DECLARE SUB OutLine
DECLARE SUB PreScan
DECLARE SUB Scan
DECLARE SUB ColScan
DECLARE SUB DxfHeader
DECLARE SUB LineWrite
DECLARE SUB PointWrite
DECLARE SUB _RGB
DECLARE SUB BitmapInfo
DECLARE SUB Brighten
DECLARE SUB Medium
DECLARE SUB Darken
DECLARE SUB RestoreDefault
DECLARE SUB Refresh
DECLARE SUB Undo
DECLARE SUB _Exit
CONST fmCreate = 65535
CONST fmOpenRead = 0
CONST fmOpenWrite = 1
CONST CrLf = CHR$(13)+CHR$(10)
TYPE CadPalette
Pal AS INTEGER
Red AS INTEGER
Grn AS INTEGER
Ble AS INTEGER
END TYPE
DIM Palette(255) AS CadPalette
DIM AsmPal(240*5) AS INTEGER
DIM OpenDialog AS QOPENDIALOG
DIM SaveAsDialog AS QSAVEDIALOG
DIM IniPath$ AS STRING
DIM WTIMER AS QTIMER
DIM FileCfg AS QFILESTREAM
DIM FileTmp AS QFILESTREAM
DIM FileDat AS QFILESTREAM
DIM FileSkn AS QFILESTREAM
DIM FileDXF AS QFILESTREAM
DIM VistaBMP AS QBITMAP
DIM S_Buffer AS QRECT
DIM D_Buffer AS QRECT
DIM BmpLoaded$ AS STRING
DIM BmpLoaded% AS INTEGER
DIM DxfSaving$ AS STRING
DIM DxfSaved% AS INTEGER
DIM EditTone% AS INTEGER
DIM SavedTone$ AS STRING
DIM Undo% AS INTEGER
DIM UndoImg$ AS STRING
DIM RedColor% AS INTEGER
DIM GrnColor% AS INTEGER
DIM BleColor% AS INTEGER
DIM CadColor% AS INTEGER
DIM CadColor$ AS STRING
DIM OnColor& AS INTEGER
DIM SetTone& AS INTEGER
DIM Layer$ AS STRING
DIM LastX% AS INTEGER
DIM LastY% AS INTEGER
DIM LastMax% AS INTEGER
DIM X% AS INTEGER
DIM X1% AS INTEGER
DIM Y% AS INTEGER
DIM Y1% AS INTEGER
DIM Px% AS INTEGER
DIM Py% AS INTEGER
DIM XX% AS INTEGER
DIM YY% AS INTEGER
DIM Ky% AS INTEGER
DIM CurCenter& AS INTEGER
DIM CurWidth& AS INTEGER
DIM CurHeight& AS INTEGER
DIM CurTop& AS INTEGER
DIM CurLeft& AS INTEGER
DIM StartTop& AS INTEGER
DIM StartLeft& AS INTEGER
DIM WinMov& AS INTEGER
DIM OldCfg& AS INTEGER
DIM NewCfg& AS INTEGER
DIM rgbASM AS QMEMORYSTREAM
DIM Reserved& AS INTEGER
DIM Font AS QFONT
DIM MiniFont AS QFONT
DIM Matrix(0,0) AS INTEGER
DECLARE FUNCTION CallBinProc LIB "user32" ALIAS "CallWindowProcA" _
(Proc AS LONG, A1 AS LONG, A2 AS LONG) AS LONG
rgbASM.ExtractRes (RESOURCE(rgbASMProc))
CfgReStart:
Application.Title = "DxfONE! " + Ver$ + Notice$
XX% = 158
YY% = 94
SetTone& = (128 * 3)
StartWidth& = 808 - XX%
StartHeight& = 666 - YY%
CurWidth& = StartWidth&
CurHeight& = StartHeight&
CurCenter& = 1
WinMov& = 0
NewCfg& = 4
Reserved& = 0
DxfSaved% = 0
IniPath$ = CURDIR$
Undo% = 0
Font.COLOR = &H800080
MiniFont.COLOR = &H505050
WTimer.Interval = 6000
IF FILEEXISTS("DxfONE!.cf") <> 0 THEN
FileCfg.OPEN("DxfONE!.cf", fmOpenRead)
FileCfg.READ(SetTone&)
FileCfg.READ(CurWidth&)
FileCfg.READ(CurHeight&)
FileCfg.READ(CurTop&)
FileCfg.READ(CurLeft&)
FileCfg.READ(CurCenter&)
FileCfg.READ(StartTop&)
FileCfg.READ(StartLeft&)
FileCfg.READ(Flag&)
FileCfg.READ(Flag&)
FileCfg.READ(Flag&)
FileCfg.READ(Flag&)
FileCfg.READ(Flag&)
FileCfg.READ(Flag&)
FileCfg.READ(Flag&)
FileCfg.READ(OldCfg&)
FileCfg.CLOSE
IF CurWidth& = 0 THEN CurWidth& = 808 - XX%
IF CurHeight& = 0 THEN CurHeight& = 666 - YY%
IF NewCfg& <> OldCfg& THEN
KILL "DxfONE!.cf"
Notice$ = " [set new cfg ver.]"
GOTO CfgReStart
END IF
ELSE
CurCenter& = 1
FileCfg.OPEN("DxfONE!.cf", fmCreate)
FileCfg.Write(SetTone&)
FileCfg.Write(CurWidth&)
FileCfg.Write(CurHeight&)
FileCfg.Write(CurTop&)
FileCfg.Write(CurLeft&)
FileCfg.Write(CurCenter&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(NewCfg&)
FileCfg.CLOSE
END IF
ExtractResource(Resource(4), "DxfONE!ix.TMP")
FileDat.OPEN("DxfONE!ix.TMP", fmOpenRead)
N=0
FOR I = 0 TO 239
Stringa$=FileDat.ReadLine
Palette(I).Pal = VAL(Stringa$)
AsmPal(N) = VAL(Stringa$)
N = N + 1
NEXT I
FOR I = 0 TO 239
Stringa$=FileDat.ReadLine()
Palette(I).Red = VAL(Stringa$)
AsmPal(N) = VAL(Stringa$)
N = N + 1
NEXT I
FOR I = 0 TO 239
Stringa$=FileDat.ReadLine()
Palette(I).Grn = VAL(Stringa$)
AsmPal(N) = VAL(Stringa$)
N = N + 1
NEXT I
FOR I = 0 TO 239
Stringa$=FileDat.ReadLine()
Palette(I).Ble = VAL(Stringa$)
AsmPal(N) = VAL(Stringa$)
N = N + 1
NEXT I
FileDat.CLOSE
KILL "DxfONE!ix.TMP"
DECLARE FUNCTION SetWindowLong LIB "user32" ALIAS "SetWindowLongA" _
(hWnd AS LONG, nIndex AS LONG, dwNewLong AS LONG) AS LONG
CREATE MainForm AS QFORM
CAPTION = Application.Title
IcoHandle = ICO
Width = CurWidth&
Height = CurHeight&
OnClose = _Exit
Top = CurTop&
Left = CurLeft&
OnResize = Refresh
CREATE OtherItem AS QPANEL
CAPTION = "Other"
Top = 4
Left = 748 - XX%
Height = 16
Width = 34
OnClick = OtherAbout
Visible = 1
END CREATE
CREATE Vista AS QIMAGE
Visible = 0
END CREATE
CREATE WallSkin AS QIMAGE
Height = 25
Width = 1280
BMPHandle = Skin
END CREATE
CREATE EndSkin AS QIMAGE
Height = 25
Width = 1
BMPHandle = Skin1
END CREATE
CREATE MainMenu AS QMAINMENU
CREATE FileMenu AS QMENUITEM
CAPTION = "&File"
CREATE FileOpen AS QMENUITEM
CAPTION = "&Open"
OnClick = OpenItemClick
END CREATE
CREATE FileSaveAs AS QMENUITEM
CAPTION = "Save &As..."
OnClick = SaveAsItemClick
Enabled = 0
END CREATE
CREATE ExitPrg AS QMENUITEM
CAPTION = "E&xit"
Enabled = 1
OnClick = _Exit
END CREATE
END CREATE
CREATE EditMenu AS QMENUITEM
CAPTION = "&Edit"
CREATE AboutEditItem AS QMENUITEM
CAPTION = "&About this menu"
OnClick = EditAbout
END CREATE
CREATE UndoItem AS QMENUITEM
CAPTION = "&Undo"
OnClick = Undo
Enabled = 0
END CREATE
CREATE DrawItem AS QMENUITEM
CAPTION = "&Halftone"
Enabled = 0
OnClick = HalfTone
END CREATE
CREATE Draw1Item AS QMENUITEM
CAPTION = "&Outline"
Enabled = 0
OnClick = OutLine
END CREATE
END CREATE
CREATE ParseMenu AS QMENUITEM
CAPTION = "&DXFout"
CREATE AboutParseItem AS QMENUITEM
CAPTION = "&About this menu"
OnClick = ParseAbout
END CREATE
CREATE MakeItem AS QMENUITEM
CAPTION = "&Make DXF"
Enabled = 0
CREATE MakeBWItem AS QMENUITEM
CAPTION = "&B&&W Lines && Points"
OnClick = Scan
END CREATE
CREATE MakeColItem AS QMENUITEM
CAPTION = "&Colored Solids"
OnClick = ColScan
END CREATE
END CREATE
END CREATE
CREATE OptionsMenu AS QMENUITEM
CAPTION = "&Options"
CREATE AboutOptionItem AS QMENUITEM
CAPTION = "&About this menu"
OnClick = OptionsAbout
END CREATE
CREATE SetMenu AS QMENUITEM
CAPTION = "Setting Edit &Halftone"
CREATE SetBrighten AS QMENUITEM
CAPTION = "&Brighten"
OnClick = Brighten
Checked = 0
END CREATE
CREATE SetMedium AS QMENUITEM
CAPTION = "&Medium"
OnClick = Medium
Checked = 0
END CREATE
CREATE SetDarken AS QMENUITEM
CAPTION = "&Darken"
OnClick = Darken
Checked = 0
END CREATE
END CREATE
END CREATE
CREATE ToollsMenu AS QMENUITEM
CAPTION = "&Tools"
CREATE RestoreItem AS QMENUITEM
CAPTION = "Restore &Default"
OnClick = RestoreDefault
END CREATE
END CREATE
CREATE StatusMenu AS QMENUITEM
CAPTION = "&Status"
CREATE StatusItem AS QMENUITEM
CAPTION = "&Bitmap"
OnClick = BitmapInfo
END CREATE
END CREATE
CREATE InfoMenu AS QMENUITEM
CAPTION = "&Info"
CREATE AboutItem AS QMENUITEM
CAPTION = "&About DxfONE!"
OnClick = About
END CREATE
CREATE WelcomeItem AS QMENUITEM
CAPTION = "&Welcome"
OnClick = Welcome
END CREATE
END CREATE
END CREATE
CREATE Barr AS QSTATUSBAR
SimpleText = "BMP empty."
SimplePanel = 1
END CREATE
END CREATE
CREATE WelcomeForm AS QFORM
Center
BorderStyle = 0
Width = 472
Height = 132
COLOR = &H994444
CREATE WelcomeBorder AS QPANEL
Top = 1
Left = 1
Width = 470
Height = 130
COLOR = &HEE9999
Visible = 1
CREATE WelcomeBMP AS QIMAGE
BmpHandle = CAM
Width = 160
Height = 120
Top = 5
Left = 5
OnClick = Starter
END CREATE
CREATE WelcomeICO AS QIMAGE
IcoHandle = ICO
Top = 5
Left = 170
OnClick = Starter
END CREATE
CREATE WelcomeLabel AS QLABEL
Font = Font
Font.Size = 10
Top = 90
OnClick = Starter
END CREATE
CREATE WelcomeCopy AS QLABEL
Font = MiniFont
Top = 4
OnClick = Starter
END CREATE
CREATE WelcomeDef AS QLABEL
Font = MiniFont
Top = 110
OnClick = Starter
END CREATE
OnClick = Starter
END CREATE
OnKeyPress = Starter
OnClick = Starter
END CREATE
CREATE SaveConfirm AS QFORM
BorderStyle = 6
Center
CAPTION = "Warning : Save As..."
IcoHandle = ICO
Width = 420
Height = 115
OnClose = NoSave
Visible = 0
CREATE SaveConfirmLabel AS QLABEL
Top = 15
Left = 10
END CREATE
CREATE NoButton AS QBUTTON
Width = 110
Height = 25
Top = 50
Left = 235
CAPTION = "&No, don't save."
OnClick = NoSave
END CREATE
CREATE OkButton AS QBUTTON
Width = 110
Height = 25
Top = 50
Left = 70
CAPTION = "&Ok, overwrite file."
OnClick = SaveProc
END CREATE
END CREATE
SUB MinSet (fhand AS INTEGER, gwl_hand AS INTEGER, hwnd AS INTEGER, apphand AS INTEGER)
setwindowlong(fhand, GWL_HaND, HWND)
setwindowlong(apphand, GWL_HaND, fhand)
END SUB
IF SetTone& = ( 64 * 3) THEN
SetBrighten.Checked = 1
SetTone$ = "Brighten "
END IF
IF SetTone& = (128 * 3) THEN
SetMedium.Checked = 1
SetTone$ = "Medium "
END IF
IF SetTone& = (192 * 3) THEN
SetDarken.Checked = 1
SetTone$ = "Darken "
END IF
WelcomeLabel.CAPTION = "Welcome in DxfONE! " + Ver$
WelcomeLabel.Left = 330 - (WelcomeLabel.Width / 2)
WelcomeCopy.CAPTION = "©2002-03 Free Soft Studio Arch.G.M.Seregni - Milan"
WelcomeCopy.Left = 330 - (WelcomeCopy.Width /2)
WelcomeDef.CAPTION = "Color and B&&W Bitmap translater to DXF format."
WelcomeDef.Left = 330 - (WelcomeDef.Width / 2)
WTimer.OnTimer = Starter
WelcomeForm.SHOWMODAL
SUB Welcome
WelcomeForm.Visible = 1
END SUB
SUB Starter
WTimer.Enabled = 0
WelcomeForm.Visible = 0
IF CurCenter& = 1 THEN MainForm.Center
MinSet(MainForm.Handle, -8, 0, Application.Handle)
IF LEN(COMMAND$(1)) <> 0 THEN
Vista.BMP = COMMAND$(1)
BmpLoaded$ = COMMAND$(1)
BmpLoad
END IF
MainForm.SHOWMODAL
END SUB
SUB BmpLoad
LenName% = LEN (BmpLoaded$) - 3
DxfSaving$ = MID$ (BmpLoaded$, 1, LenName%) + "DXF"
Vista.Top = 26
Vista.Left = 1
Vista.Autosize = 1
LastX% = Vista.Width - 1
LastY% = Vista.Height - 1
Barr.SimpleText = BmpLoaded$ + " loaded."
FileSaveAs.Enabled = 1
DrawItem.Enabled = 1
Draw1Item.Enabled = 1
MakeItem.Enabled = 1
Vista.Visible = 1
BmpLoaded% = 1
DxfSaved% = 0
EditTone% = 0
Vista.Repaint
END SUB
SUB OpenItemClick
OpenDialog.Filter = "*.BMP|*.BMP"
IF OpenDialog.EXECUTE THEN
Vista.BMP = OpenDialog.FileName
BmpLoaded$ = OpenDialog.FileName
BmpLoad
END IF
END SUB
SUB SaveAsItemClick
SaveAsDialog.Filter = "*.BMP|*.BMP"
SaveAsDialog.FileName = BmpLoaded$
IF SaveAsDialog.EXECUTE THEN
BmpLoaded$ = SaveAsDialog.FileName
IF FILEEXISTS(BmpLoaded$)<>1 THEN
SaveProc
ELSE
SaveConfirmLabel.CAPTION = "Replace existing " + BmpLoaded$ + "?"
SaveConfirm.Visible = 1
END IF
END IF
END SUB
SUB SaveProc
VistaBMP.Height = Vista.Height
VistaBMP.Width = Vista.Width
WITH D_Buffer
.Top = 0
.Left = 0
.Right = .Left + VistaBMP.Width
.Bottom = .Top + VistaBMP.Height
END WITH
WITH S_Buffer
.Top = 0
.Left = 0
.Right = Vista.Width
.Bottom = Vista.Height
END WITH
VistaBMP.CopyRect(D_Buffer,Vista, S_Buffer)
IF MID$(BmpLoaded$,(LEN(BmpLoaded$)-3),4)<>".BMP" AND MID$(BmpLoaded$,(LEN(BmpLoaded$)-3),4)<>".bmp" THEN
BmpLoaded$ = BmpLoaded$ + ".bmp"
END IF
VistaBMP.PixelFormat = 6
VistaBMP.SaveToFile (BmpLoaded$)
LenName% = LEN (BmpLoaded$) - 3
DxfSaving$ = MID$ (BmpLoaded$, 1, LenName%) + "DXF"
Vista.Visible = 1
BmpLoaded% = 1
DxfSaved% = 0
Barr.SimpleText = BmpLoaded$ + " saved."
SaveConfirm.Visible = 0
END SUB
SUB NoSave
SaveConfirm.Visible = 0
END SUB
SUB HalfTone
IF BmpLoaded% = 1 THEN
Vista.BMP = BmpLoaded$
Vista.Repaint
Barr.SimpleText = BmpLoaded$ + " loaded."
FOR Py% = 0 TO LastY%
CounT% = CounT% + 1
IF CounT% = 2 THEN
CounT% = 0
Vista.Repaint
END IF
FOR Px% = 0 TO LastX%
OnColor& = Vista.Pixel(Px%,Py%)
RedColor% = OnColor& SHR 16
GrnColor% = (OnColor& AND &H00FF00) SHR 8
BleColor% = OnColor& AND &H0000FF
TmpT%= Px%
IF (BleColor% + GrnColor% + RedColor%) > SetTone& THEN
WHILE Vista.Pixel(Px% + 1, Py%) = OnColor&
Px% = Px% + 1
WEND
Vista.Line(TmpT%, Py%, Px%, Py%, &HFFFFFF)
ELSE
WHILE Vista.Pixel(Px% + 1, Py%) = OnColor&
Px% = Px% + 1
WEND
Vista.Line(TmpT%, Py%, Px%, Py%, &H000000)
END IF
NEXT
Barr.SimpleText = "Scanning RGB colors of line " + STR$(Py%)
DOEVENTS
NEXT
Barr.SimpleText = "Halftone of " + BmpLoaded$ + " ready."
EditTone% = 1
UndoFile$ = BmpLoaded$
Undo% = 1
UndoItem.Enabled = 1
ELSE
Barr.SimpleText = "BMP empty. Tray Open file before Halftone."
END IF
Vista.Repaint
END SUB
SUB PreScan
CREATE WarningBW AS QFORM
Center
BorderStyle = 6
CAPTION = " B&W DXF Warning"
IcoHandle = ICO
Height = 90
Width = 600
Visible = 1
CREATE Label0BW AS QLABEL
CAPTION = "You are about to save a B&&W DXF from a possible colored bitmap."
Left = 25
Top = 15
END CREATE
CREATE Label1BW AS QLABEL
CAPTION = "If the DXF file will empty, I suggest to use HALFTONE command and to try again."
Left = 25
Top = 30
END CREATE
END CREATE
END SUB
SUB Scan
IF EditTone% = 0 THEN PreScan
DxfHeader
Layer$ = "D135LINES"
LastMax% = LastX% + LastY%
DIM Matrix(LastMax%, LastMaX%) AS INTEGER
FOR Py% = 0 TO LastMax%
Y%=0
Ky% = 0
Barr.SimpleText = "Parsing " + DxfSaving$ + " --> Scanning 135 deg. line " + STR$(Py%)
Pix% = 0
Init% = 0
Endy% = 0
FOR Px% = 0 TO LastX%
DOEVENTS
IF Vista.Pixel(Px%, Py% - Ky%) = &H010101 THEN Vista.PSET (Px%, Py% - Ky%, 0)
OnColor& = Vista.Pixel(Px%, Py% - Ky%)
IF OnColor& <> 0 AND Pix% = 0 THEN GOTO Endd
IF OnColor& = 0 AND Pix% = 0 THEN
X% = Px%
Y% = LastY% - (Py% - Ky%)
Pix% = 1
Init% = Py% - Ky%
GOTO Endd
END IF
IF Pix% = 1 AND (Py% - Ky%) = 0 AND OnColor& = &H000000 THEN
X1% = Px%
Y1% = LastY% - (Py% - Ky%)
Endy% = (Py% - Ky%)
IF X1% - X% > 2 THEN
Vista.Line (X%, Init%, X1%, Endy%, &HFFFFFF )
LineWrite
Matrix(X%, Y% ) = 1
Matrix(X1%, Y1%) = 1
END IF
EXIT FOR
END IF
IF OnColor& = &H000000 AND Pix% = 1 THEN GOTO Endd
IF OnColor& <> &H000000 AND Pix% = 1 THEN
X1% = Px% - 1
Y1% = LastY% - (Py% - Ky%) - 1
Endy% = (Py% - Ky%)
IF X1% - X% > 2 THEN
Vista.Line (X%, Init%, X1%, Endy% + 1, &HFFFFFF)
LineWrite
Matrix(X%, Y% ) = 1
Matrix(X1%, Y1%) = 1
END IF
Pix% = 0
END IF
Vista.Repaint
Endd:
IF Py% - Ky% = 0 THEN EXIT FOR
Ky% = Ky% + 1
NEXT
Pix% = 0
Ky%=0
Vista.Repaint
NEXT
Layer$ = "VLINES"
FOR Px% = 0 TO LastX%
Barr.SimpleText = "Parsing " + DxfSaving$ + " --> Scanning vertical line " + STR$(Px%)
DOEVENTS
Pix% = 0
X% = Px%
X1% = Px%
FOR Py% = 0 TO LastY%
OnColor& = Vista.Pixel (Px%, Py%)
IF OnColor& <> &H000000 AND Pix% = 0 THEN GOTO Endy
IF OnColor& = &H000000 AND Pix% = 0 THEN
Y% = LastY% - Py%
Init% = Py%
Pix% = 1
GOTO Endy
END IF
IF OnColor& = &H000000 AND Pix% = 1 AND Py% = LastY% THEN
Y1% = LastY% - Py%
Endy% = Py%
IF Y% - Y1% > 1 THEN
FOR puntoY% = Init% TO Endy%
IF Vista.Pixel(X% - 1, puntoY%) > &H010101 AND Vista.Pixel(X% + 1, puntoY%) > &H010101 THEN
Vista.Pset (X%, puntoY%, &HFFFFFF)
ELSE
IF Vista.Pixel(X% - 1, puntoY%) > &H010101 AND X% = LastX% THEN
Vista.Pset (X%, puntoY%, &HFFFFFF)
ELSEIF Vista.Pixel(X% + 1, puntoY%) > &H010101 AND X% = 0 THEN
Vista.Pset (X%, puntoY%, &HFFFFFF)
ELSE
Vista.Pset (X%, puntoY%, &H010101)
END IF
END IF
NEXT
IF Matrix(X%, Y% + 1) = 1 THEN Y% = Y% + 1
IF Matrix(X1%,Y1% - 1) = 1 THEN Y1% = Y1% - 1
LineWrite
END IF
Pix% = 0
EXIT FOR
END IF
IF OnColor& = &H000000 AND Pix% = 1 THEN GOTO Endy
IF OnColor& <> &H000000 AND Pix% = 1 THEN
Y1% = LastY% - (Py% - 1)
Endy% = Py%-1
IF Y% - Y1% > 1 THEN
FOR puntoY% = Init% TO Endy%
IF Vista.Pixel(X% - 1, puntoY%) > &H010101 AND Vista.Pixel(X% + 1, puntoY%) > &H010101 THEN
Vista.Pset (X%, puntoY%, &HFFFFFF)
ELSE
IF Vista.Pixel(X% - 1, puntoY%) > &H010101 AND X% = LastX% THEN
Vista.Pset (X%, puntoY%, &HFFFFFF)
ELSEIF Vista.Pixel(X% + 1, puntoY%) > &H010101 AND X% = 0 THEN
Vista.Pset (X%, puntoY%, &HFFFFFF)
ELSE
Vista.Pset (X%, puntoY%, &H010101)
END IF
END IF
NEXT
IF Matrix(X%, Y% + 1) = 1 THEN Y% = Y% + 1
IF Matrix(X1%,Y1% - 1) = 1 THEN Y1% = Y1% - 1
LineWrite
END IF
Pix% = 0
END IF
Pix% = 0
Endy:
NEXT
Vista.Repaint
NEXT
Layer$ = "HLINES"
FOR Py% = 0 TO LastY%
DOEVENTS
Barr.SimpleText = "Parsing " + DxfSaving$ + " --> Scanning horizontal line " + STR$(Py%)
Pix% = 0
Y% = LastY% - Py%
Y1% = LastY% - Py%
FOR Px% = 0 TO LastX%
IF Vista.Pixel(Px%, Py%) = &H010101 THEN Vista.Pset (Px%, Py%, &H000000)
OnColor& = Vista.Pixel(Px%, Py%)
IF OnColor& <> &H000000 AND Pix% = 0 THEN GOTO Endx
IF OnColor& = &H000000 AND Pix% = 0 THEN
X% = Px%
Pix% = 1
Init% = Py%
GOTO Endx
END IF
IF OnColor& = &H000000 AND Pix% = 1 AND Px% = LastX% THEN
X1% = Px%
IF X1% - X% > 1 THEN
FOR PuntoX% = X% TO X1%
Vista.Pset (PuntoX%, Init%, &HFFFFFF)
NEXT
IF Matrix(X% - 1, Y%) = 1 THEN X% = X% - 1
IF Matrix(X1% + 1, Y%) = 1 THEN X1% = X1% + 1
LineWrite
Pix% = 0
EXIT FOR
END IF
END IF
IF OnColor& = &H000000 AND Pix% = 1 THEN GOTO Endx
IF OnColor& <> &H000000 AND Pix% = 1 THEN
X1% = Px% - 1
IF X1% - X% > 1 THEN
FOR PuntoX% = X% TO X1%
Vista.Pset (PuntoX%, Init%, &HFFFFFF)
NEXT
IF Matrix(X% - 1, Y%) = 1 THEN X% = X% - 1
IF Matrix(X1% + 1, Y%) = 1 THEN X1% = X1% + 1
LineWrite
END IF
Pix% = 0
END IF
Pix% = 0
Endx:
NEXT
Vista.Repaint
NEXT
Layer$ = "POINTS"
FOR Px% = 0 TO LastX%
Barr.SimpleText = "Parsing " + DxfSaving$ + " --> Scanning single points in line " + STR$(Px%)
DOEVENTS
FOR Py% = LastY% TO 0 STEP -1
OnColor& = Vista.Pixel(Px%, Py%)
IF OnColor& = &H000000 THEN
X% = Px%
Y% = LastY% - Py%
Endy% = Py%
Vista.Pset (X%, Endy%, &HFFFFFF)
PointWrite
END IF
NEXT
Vista.Repaint
NEXT
FileDxf.WriteStr("ENDSEC"+CrLf+"0"+CrLf+"EOF"+CrLf,16)
FileDXF.CLOSE
Barr.SimpleText = DxfSaving$ + " done."
DxfSaved% = 1
Vista.BMP = BmpLoaded$
IF EditTone% = 1 THEN
EditTone% = 0
SavedTone$ = SetTone$
END IF
Vista.Repaint
END SUB
SUB ColScan
DxfHeader
FileTmp.OPEN("DxfONE!.tmp", fmCreate)
Layer$ = "SOLIDCOLOR"
Py% = 0
VerLoop:
Barr.SimpleText = "Parsing " + DxfSaving$ + " --> Scanning colors pixel-line " + STR$(Py%)
Px% = 0
HorLoop:
OldT% = Px%
_RGB
X$ = STR$(OldT%)
X1$ = STR$(Px% + 1)
Y$ = STR$(Vista.Height - Py%)
IF OldT% = 0 THEN sequel$ = "start" ELSE sequel$ = "cont"
IF MemC% <> CadColor% THEN sequel$ = "start"
FileTmp.WriteLine(sequel$)
FileTmp.WriteLine(X$)
FileTmp.WriteLine(Y$)
FileTmp.WriteLine(X1$)
FileTmp.WriteLine(STR$(CadColor%))
MemC% = CadColor%
Px% = Px% + 1
IF Px% < Vista.Width THEN GOTO HorLoop
Py% = Py% + 1
IF Py% < Vista.Height THEN GOTO VerLoop
FOR n% = 1 TO 10
FileTmp.WriteLine("eof")
NEXT n%
FileTmp.CLOSE
FileTmp.OPEN("DxfONE!.tmp", fmOpenRead)
Opened& = 0
DO
Cicla:
Info$ = FileTmp.ReadLine()
IF Info$ = "start" THEN
IF Opened& = 1 THEN
GOTO CloseOpenSolid
ELSE
GOTO OpenSolid
END IF
END IF
IF Info$ = "cont" THEN GOTO CrosSolid
IF Info$ = "eof" THEN EXIT DO
OpenSolid:
X$ = FileTmp.ReadLine()
Y$ = FileTmp.ReadLine()
X1$ = FileTmp.ReadLine()
CadColor$ = FileTmp.ReadLine()
FileDxf.WriteStr("SOLID"+CrLf+"8"+CrLf,10)
FileDxf.WriteLine(Layer$)
FileDxf.WriteStr("62"+CrLf,4)
FileDxf.WriteLine(CadColor$)
FileDxf.WriteStr("10"+CrLf,4)
FileDxf.WriteLine(X$)
FileDxf.WriteStr("20"+CrLf,4)
FileDxf.WriteLine(Y$)
FileDxf.WriteStr("30"+CrLf+"0"+CrLf+"11"+CrLf,11)
FileDxf.WriteLine(X$)
FileDxf.WriteStr("21"+CrLf,4)
FileDxf.WriteLine(STR$((VAL(Y$))- 1))
FileDxf.WriteStr("31"+CrLf+"0"+CrLf,7)
MemY$ = Y$
MemX$ = X$
MemX1$ = X1$
Opened& = 1
GOTO cicla
CloseOpenSolid:
X$ = FileTmp.ReadLine()
Y$ = FileTmp.ReadLine()
X1$ = FileTmp.ReadLine()
CadColor$ = FileTmp.ReadLine()
FileDxf.WriteLine("12")
IF MemY$<>Y$ THEN
FileDxf.WriteLine (STR$(Vista.Width))
ELSE
FileDxf.WriteLine(X$)
END IF
FileDxf.WriteStr("22"+CrLf,4)
FileDxf.WriteLine(MemY$)
FileDxf.WriteStr("32"+CrLf+"0"+CrLf+"13"+CrLf,11)
IF MemY$<>Y$ THEN
FileDxf.WriteLine(STR$(Vista.Width))
ELSE
FileDxf.WriteLine(X$)
END IF
FileDxf.WriteStr("23"+CrLf,4)
FileDxf.WriteLine(STR$((VAL (MemY$)) - 1))
FileDxf.WriteStr("33"+CrLf+"0"+CrLf+"0"+CrLf+"SOLID"+CrLf+"8"+CrLf,20)
FileDxf.WriteLine(Layer$)
FileDxf.WriteStr("62"+CrLf,4)
FileDxf.WriteLine(CadColor$)
FileDxf.WriteStr("10"+CrLf,4)
FileDxf.WriteLine(X$)
IF X$ = "0" THEN Barr.SimpleText = "Solid Join " + DxfSaving$ + " --> line " + Y$
FileDxf.WriteStr("20"+CrLf,4)
FileDxf.WriteLine(Y$)
FileDxf.WriteStr("30"+CrLf+"0"+CrLf+"11"+CrLf,11)
FileDxf.WriteLine(X$)
FileDxf.WriteStr("21"+CrLf,4)
FileDxf.WriteLine(STR$((VAL (Y$)) - 1))
FileDxf.WriteStr("31"+CrLf+"0"+CrLf,7)
DOEVENTS
MemY$ = Y$
MemX$ = X$
MemX1$ = X1$
GOTO cicla
CrosSolid:
X$ = FileTmp.ReadLine()
Y$ = FileTmp.ReadLine()
X1$ = FileTmp.ReadLine()
CadColor$ = FileTmp.ReadLine()
LOOP
FileDxf.WriteStr("12"+CrLf,4)
FileDxf.WriteLine(X1$)
FileDxf.WriteStr("22"+CrLf,4)
FileDxf.WriteLine(MemY$)
FileDxf.WriteStr("32"+CrLf+"0"+CrLf+"13"+CrLf,11)
FileDxf.WriteLine(X1$)
FileDxf.WriteStr("23"+CrLf,4)
FileDxf.WriteLine(STR$((VAL(MemY$)) - 1))
FileDxf.WriteStr("33"+CrLf+"0"+CrLf+"0"+CrLf+"ENDSEC"+CrLf+"0"+CrLf+"EOF"+CrLf,26)
FileDXF.CLOSE
FileTmp.CLOSE
KILL "DxfONE!.tmp"
Barr.SimpleText = "Colored " + DxfSaving$ + " done."
DxfSaved% = 2
END SUB
SUB DxfHeader
FileDxf.OPEN(DxfSaving$, fmCreate)
FileDxf.WriteStr("999"+CrLf+"[Written by DxfONE!(c)Arch.G.Seregni]"+CrLf,44)
FileDxf.WriteStr("0"+CrLf+"SECTION"+CrLf+"2"+CrLf+"ENTITIES"+CrLf+"0"+CrLf,28)
END SUB
SUB LineWrite
FileDxf.WriteStr("LINE"+CrLf+"8"+CrLf,9)
FileDxf.WriteLine(Layer$)
FileDxf.WriteStr("10"+CrLf,4)
FileDxf.WriteLine(STR$(X%))
FileDxf.WriteStr("20"+CrLf,4)
FileDxf.WriteLine(STR$(Y%))
FileDxf.WriteStr("30"+CrLf+"0"+CrLf+"11"+CrLf,11)
FileDxf.WriteLine(STR$(X1%))
FileDxf.WriteStr("21"+CrLf,4)
FileDxf.WriteLine(STR$(Y1%))
FileDxf.WriteStr("31"+CrLf+"0"+CrLf+"0"+CrLf,10)
END SUB
SUB PointWrite
FileDxf.WriteStr("POINT"+CrLf+"8"+CrLf,10)
FileDxf.WriteLine(Layer$)
FileDxf.WriteStr("10"+CrLf,4)
FileDxf.WriteLine(STR$(X%))
FileDxf.WriteStr("20"+CrLf,4)
FileDxf.WriteLine(STR$(Y%))
FileDxf.WriteStr("30"+CrLf+"0"+CrLf+"0"+CrLf,10)
END SUB
SUB _RGB
IF Vista.Pixel(Px%,Py%) = &H000000 THEN
CadColor% = 0
GOTO Skip
END IF
RedColor% = Vista.Pixel(Px%,Py%) AND &H0000FF
GrnColor% = (Vista.Pixel(Px%,Py%) AND &H00FF00) SHR 8
BleColor% = Vista.Pixel(Px%,Py%) SHR 16
IF RedColor% > 228 AND GrnColor% > 228 AND BleColor% > 228 THEN
CadColor% = 255
GOTO Skip
END IF
IF (ABS(GrnColor%-BleColor%))<18 AND (ABS(RedColor%-GrnColor%)<18) AND (ABS(BleColor%-RedColor%))<18 THEN
CadColor% = (((BleColor% + GrnColor% + RedColor%) \3) \42.5) + 250
GOTO Skip
END IF
OldDiff% = 769
IF RedColor% < 10 AND GrnColor% < 10 THEN
i% = 4
My1Loop:
Diff% = ABS(BleColor%-Palette(i%).Ble)
IF Diff% < OldDiff% THEN
CadColor% = Palette(i%).Pal
OldDiff% = Diff%
END IF
i% = i% - 1
IF i% > -1 THEN GOTO My1Loop
GOTO Skip
END IF
IF RedColor% < 10 THEN
i% = 44
My2Loop:
Diff% = ABS(GrnColor%-Palette(i%).Grn) + ABS(BleColor%-Palette(i%).Ble)
IF Diff% < OldDiff% THEN
CadColor% = Palette(i%).Pal
OldDiff% = Diff%
END IF
i% = i% - 1
IF i% <> 4 THEN GOTO My2Loop
GOTO Skip
END IF
Diff% = CallBinProc(rgbASM.Pointer, VARPTR(AsmPal(0)), Vista.Pixel(Px%,Py%))
DOEVENTS
CadColor% = Palette(Diff%).Pal
Skip:
WHILE Vista.Pixel(Px% + 1 ,Py%) = Vista.Pixel(Px%,Py%)
Px% = Px% + 1
WEND
END SUB
SUB PreOutLine
CREATE WarningBW AS QFORM
Center
BorderStyle = 6
CAPTION = " OUTLINE Warning"
IcoHandle = ICO
Height = 90
Width = 600
Visible = 1
CREATE Label0BW AS QLABEL
CAPTION = "Only really black bitmap area will stored outlining."
Left = 25
Top = 15
END CREATE
CREATE Label1BW AS QLABEL
CAPTION = "If the bitmap is colored I suggest to use HALFTONE command and to try again."
Left = 25
Top = 30
END CREATE
END CREATE
END SUB
SUB OutLine
Undo% = 2
VistaBMP.Height = Vista.Height
VistaBMP.Width = Vista.Width
WITH D_Buffer
.Top = 0
.Left = 0
.Right = .Left + VistaBMP.Width
.Bottom = .Top + VistaBMP.Height
END WITH
WITH S_Buffer
.Top = 0
.Left = 0
.Right = Vista.Width
.Bottom = Vista.Height
END WITH
VistaBMP.CopyRect(D_Buffer,Vista, S_Buffer)
VistaBMP.PixelFormat = 6
VistaBMP.SaveToFile (IniPath$+"\DXF1TMP2.BMP")
IF EditTone% = 0 THEN PreOutLine
FOR Px% = 0 TO LastX%
Vista.Repaint
DOEVENTS
Barr.SimpleText = "Scanning " + BmpLoaded$ + ": vertical line " + STR$(Px%)
FOR Py% = 0 TO LastY%
IF Vista.Pixel(Px%, Py%) <> 0 THEN Vista.Pset(Px%, Py%, &HFF0000)
IF Vista.Pixel(Px%,Py%-1)<2 AND Vista.Pixel(Px%,Py%+1)<2 AND Vista.Pixel(Px%-1,Py%)<2 AND Vista.Pixel(Px%+ 1,Py%)<2 THEN
Vista.Pset(Px%, Py%, &H000001)
END IF
NEXT
NEXT
FOR Px% = 0 TO LastX%
Barr.SimpleText = "Cleaning " + BmpLoaded$ + ": vertical line " + STR$(Px%)
Vista.Repaint
DOEVENTS
FOR Py% = 0 TO LastY%
IF Vista.Pixel(Px%, Py%) <> 0 THEN
IF Vista.Pixel(Px%,Py%-1)<>0 OR Vista.Pixel(Px%,Py%+1)<>0 OR Vista.Pixel(Px%+1,Py%)<>0 OR Vista.Pixel(Px%-1,Py%)<>0 THEN
Vista.Pset(Px%, Py%, &HFFFFFF)
ELSE
Vista.Pset(Px%, Py%, 0)
END IF
END IF
NEXT
NEXT
Barr.SimpleText = "Outline of " + BmpLoaded$ + " ready."
UndoItem.Enabled = 1
END SUB
SUB Brighten
SetTone& = (64 * 3)
SetBrighten.Checked = 1
SetMedium.Checked = 0
SetDarken.Checked = 0
SetTone$ = "Brighten "
END SUB
SUB Medium
SetTone& = (128 * 3)
SetBrighten.Checked = 0
SetMedium.Checked = 1
SetDarken.Checked = 0
SetTone$ = "Medium "
END SUB
SUB Darken
SetTone& = (192 * 3)
SetBrighten.Checked = 0
SetMedium.Checked = 0
SetDarken.Checked = 1
SetTone$ = "Darken "
END SUB
SUB BitmapInfo
CREATE BitmapInfoForm AS QFORM
BorderStyle = 6
CAPTION = " Bitmap Info"
IcoHandle = ICO
ClientWidth = 400
Visible = 0
Enabled = 1
Center
CREATE BitmapInfo0Label AS QLABEL
Left = 5
Top = 4
END CREATE
CREATE BitmapInfo1Label AS QLABEL
CAPTION = "Bitmap Dim --> " + STR$(Vista.Width) + " x " + STR$(Vista.Height) + " pxl."
Left = 50
Top = 24
END CREATE
CREATE BitmapInfo2Label AS QLABEL
Left = 50
Top = 38
END CREATE
CREATE BitmapInfo3Label AS QLABEL
Left = 50
Top = 52
END CREATE
END CREATE
IF BmpLoaded$ = "" THEN
BitmapInfo0Label.CAPTION = "No bitmap loaded."
BitmapInfoForm.ClientHeight = 20
BitmapInfo1Label.Visible = 0
BitmapInfo2Label.Visible = 0
ELSE
BitmapInfo0Label.CAPTION = BmpLoaded$ + " loaded."
BitmapInfo2Label.CAPTION = "Current halftone selected to " + SetTone$
BitmapInfo1Label.Visible = 1
BitmapInfo2Label.Visible = 1
IF DxfSaved% = 0 THEN
BitmapInfo3Label.Visible = 1
BitmapInfo3Label.CAPTION = "DXF file unsaved " + "."
BitmapInfoForm.ClientHeight = 72
END IF
IF DxfSaved% = 1 THEN
BitmapInfo3Label.Visible = 1
BitmapInfo3Label.CAPTION = "B&&W " + SavedTone$ + "file saved in " + DxfSaving$ + "."
BitmapInfoForm.ClientHeight = 72
END IF
IF DxfSaved% = 2 THEN
BitmapInfo3Label.Visible = 1
BitmapInfo3Label.CAPTION = "COLORED file saved in " + DxfSaving$ + "."
BitmapInfoForm.ClientHeight = 72
END IF
END IF
BitmapInfoForm.SHOWMODAL
END SUB
SUB _Exit
FileCfg.OPEN(IniPath$+"\DxfONE!.cf", fmOpenWrite)
FileCfg.Write(SetTone&)
CurWidth& = MainForm.Width
CurHeight& = MainForm.Height
FileCfg.Write(CurWidth&)
FileCfg.Write(CurHeight&)
CurTop& = MainForm.Top
CurLeft& = MainForm.Left
FileCfg.Write(CurTop&)
FileCfg.Write(CurLeft&)
FileCfg.Write(CurCenter&)
FileCfg.Write(StartTop&)
FileCfg.Write(StartLeft&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(NewCfg&)
FileCfg.CLOSE
IF FILEEXISTS(IniPath$+"\DXF1TMP2.BMP")=1 THEN KILL IniPath$+"\DXF1TMP2.BMP"
MainForm.CLOSE
Application.Terminate
END SUB
SUB RestoreDefault
SetTone& = (128 * 3)
SetTone$ = "Medium "
SetBrighten.Checked = 0
SetMedium.Checked = 1
SetDarken.Checked = 0
CurWidth& = 808 - XX%
CurHeight& = 666 - YY%
MainForm.Top = StartTop&
MainForm.Left = StartLeft&
MainForm.Width = CurWidth&
MainForm.Height = CurHeight&
MainForm.Repaint
FileCfg.OPEN(IniPath$+"\DxfONE!.cf", fmOpenWrite)
FileCfg.Write(SetTone&)
FileCfg.Write(CurWidth&)
FileCfg.Write(CurHeight&)
FileCfg.Write(StartTop&)
FileCfg.Write(StartLeft&)
FileCfg.Write(CurCenter&)
FileCfg.Write(StartTop&)
FileCfg.Write(StartLeft&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(NewCfg&)
FileCfg.CLOSE
END SUB
SUB Refresh
OtherItem.Left = MainForm.Width - 60
WallSkin.Width = MainForm.Width - 8
EndSkin.Left = MainForm.Width - 9
WinMov& = MainForm.Top + MainForm.Left
IF CurCenter& = 1 THEN
IF MainForm.Width <> (808 - XX%) OR MainForm.Height <> (666 - YY%) OR WinMov& <> 0 THEN
CurCenter& = 0
StartTop& = MainForm.Top
StartLeft& = MainForm.Left
FileCfg.OPEN(IniPath$+"\DxfONE!.cf", fmOpenWrite)
FileCfg.Write(SetTone&)
FileCfg.Write(CurWidth&)
FileCfg.Write(CurHeight&)
FileCfg.Write(CurTop&)
FileCfg.Write(CurLeft&)
FileCfg.Write(CurCenter&)
FileCfg.Write(StartTop&)
FileCfg.Write(StartLeft&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(Reserved&)
FileCfg.Write(NewCfg&)
FileCfg.CLOSE
END IF
END IF
END SUB
SUB Undo
IF UNDO% = 1 THEN
Vista.BMP = BmpLoaded$
Barr.SimpleText = BmpLoaded$ + " restored."
EditTone% = 0
UndoFile$ = ""
Undo% = 0
UndoItem.Enabled = 0
Vista.Repaint
ELSEIF UNDO% = 2 THEN
Vista.BMP = IniPath$+"\DXF1TMP2.BMP"
KILL IniPath$+"\DXF1TMP2.BMP"
Barr.SimpleText = "Status of " + BmpLoaded$ + " restored."
UndoFile$ = ""
Undo% = 0
UndoItem.Enabled = 0
Vista.Repaint
END IF
END SUB
|
|
搜索
论坛
Home
回顶部
g.yi.org Hits:0 Last modified:2013-06-21 16:37:53
