I have not done any GUI stuff yet with FreeBASIC but it is on my to do list. Visual designers are used by many folk but I have always preferred to hand craft my own forms.
Some years ago Gary Beene at the PowerBASIC forum decided to develop a screen ruler called gbRuler. I and Pierre Bellisle got involved. Pierre, who is now a member of the FreeBASIC forums as well, wrote some great calibration code. The scale units are Pixels, Centimetres, Inches, 10th, 16th, 12th, Twips and Picas. I was a fan of dialog units and it took some persuading to get dialog units added. When finished I reckoned that there was more to do and asked Gary if he was OK with my going it alone. He was. My main interest was in a GUI ruler so I ripped all scale units out except pixels and dialog units. The dialog units were based upon the system font. That was extended to be configurable so that measurements could be based upon the dialog units used by a target form. The accelerator table was increased quite a bit. I designed a measuring cursor for extra precision and its colour is the complement of the background it rests upon. The result was GUIRuler.
I use little tricks in the source code like adding h1 to x co-ordinates and v1 to y co-ordinates. If I have a group of controls using h1 and v1 then a change in them will see the whole group move after the next compilation. A gui ruler comes into own in this environment. I am not anti visual designers but being a hobbyist I don't have any deadlines to meet.
I had a Help page detailing accelerator keys but since no-one here, probably, saw gbRuler or GUIRuler being developed then a more informative Help file was required so I extended the Help page to a Help file.
The ruler's colour scheme, background and foreground, may be configured. The ruler font may be configured. The ruler can be resized in two dimensions. We can call the Windows magnify application from GUIRuler.
It is not an installed application - just unzip the zipped folder and you are ready to go. Just execute GUIRuler.exe and right click on it for the Help file. I will not 'rattle on' any further - the Help file says it all - I hope. <smile>
This is what the default ruler looks like:
GUIRuler.zip
GUIRuler
-
- Posts: 4292
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
-
- Posts: 56
- Joined: Dec 11, 2016 17:22
Re: GUIRuler
Nice job... :-)
Pierre
Pierre
-
- Posts: 4292
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: GUIRuler
Thanks Pierre. You got my cheque then? Oops!
Re: GUIRuler
Here is a clear plastic one.
Click on the central box to toggle active/static.
Mouse wheel sets an angle.
Pressing the wheel resets it.
Right click or esc ends.
(As per usual, the 64 bit compiler is poor for graphics, so much better with the 32 bit one)
(For fun only!)
Click on the central box to toggle active/static.
Mouse wheel sets an angle.
Pressing the wheel resets it.
Right click or esc ends.
(As per usual, the 64 bit compiler is poor for graphics, so much better with the 32 bit one)
(For fun only!)
Code: Select all
Type pt
As Long x,y
End Type
Declare Function _getmouse Alias "GetCursorPos" (Byval As Any Pointer) As Long
declare function noconsole alias "FreeConsole" as long
#define resetwheel(w,fl) fl=w
#define wheel(w,f) w-f
noconsole
Sub rotate(im As Any Ptr,angle As long,shiftx As long=0,shifty As long=0,ctr As pt)
#define InRange() resultx>=0 And resultx<ddx And resulty>=0 And resulty<ddy And _
x+shiftx>=0 And x+shiftx<xres And y+shifty>=0 And y+shifty<yres
Dim As Integer pitch,pitchs,xres,yres
Dim As Any Ptr row
Dim As Ulong Ptr pixel,pixels
Dim As Integer ddx,ddy,resultx,resulty
Imageinfo im,ddx,ddy,,pitch,row
Screeninfo xres,yres,,,pitchS
Dim As Any Ptr rowS=Screenptr
Dim As long centreX=ddx\2,centreY=ddy\2
ctr.x=centrex+shiftx
ctr.y=centrey+shifty
Dim As Single sx=Sin(angle*.0174533)
Dim As Single cx=Cos(angle*.0174533)
Dim As long mx=Iif(ddx>=ddy,ddx,ddy)
Var fx=Sqr(2)/2
Dim As Ulong empty = Rgb(200,100,0)
For y As long=centrey-fx*mx To centrey+ fx*mx Step 1
Var sxcy=Sx*(y-centrey),cxcy=Cx*(y-centrey)
For x As long=centrex-mx*fx To centrex+mx*fx Step 1
resultx=(Cx*(x-centrex)-Sxcy) +centrex:resulty=(Sx*(x-centrex)+Cxcy) +centrey
If InRange() Then
pixel=row+pitch*((resultY))+((resultX)) Shl 2
If *pixel <> empty Then
pixels=rowS+pitchS*(y+shifty)+(x+shiftx) Shl 2
*pixels=*pixel
End If
End If
Next x
Next y
End Sub
Function shortline(fp As pt,p As pt,length As Long) As pt
Dim As Single diffx=p.x-fp.x,diffy=p.y-fp.y
Dim As Single L=Sqr(diffx*diffx+diffy*diffy)
Return Type(fp.x+length*diffx/L,fp.y+length*diffy/L)
End Function
Dim As Integer xres,yres
Screeninfo xres,yres
Screenres xres,yres,32,,&h10 Or &h20 'no frame and on top
Screencontrol 100,0,0
Color ,Rgb(255,0,255)
Width xres\8,yres\16
Dim As Long diag=Sqr(xres^2+yres^2)
xres=100*(diag\100)
Dim As Any Ptr im=Imagecreate(xres,yres/10,Rgb(200,100,0))
Dim As Byte flag
'draw the graduations
For n As Long=0 To xres Step 10
Dim As Long L
If n Mod 100=0 Then L=25:flag=1 Else L=5:flag=0
If n Mod 50=0 Andalso flag =0 Then L=15
Dim As pt s= shortline(Type(n,0),Type(xres,0),0)
Dim As pt s2=shortline(s,Type(s.x,s.y+100),L)
Line im,(s.x,s.y)-(s2.x,s2.y),Rgb(0,0,0)
Dim As Long o=4*Len(Str(n))
If flag Then Draw String im,(s2.x-o,s2.y+5),Str(n),Rgb(0,0,0):Draw String im,(s2.x-o,s2.y+35),Str(n),Rgb(0,0,0)
s= shortline(Type(n,yres/10),Type(xres,yres/10 ),0)
s2=shortline(s,Type(s.x,s.y-100),L)
Line im,(s.x,s.y)-(s2.x,s2.y),Rgb(0,0,0)
Next
Line im,(0,0)-(xres-1,yres/10-1),Rgb(0,0,0),b
Dim As Long __,mb,mw,wflag=2,bflag,rflag
Dim As pt m
Dim As Long ang
Dim As Long xshift,yshift
Dim As pt ctr
Dim As String msg
Do
_getmouse(@m)
Getmouse __,__,mw,mb
If mb=2 Then exit do
If mb=4 Then resetwheel(mw,rflag)
mw=wheel(mw,rflag)
If mb =1 And bflag=0 Then wflag=-wflag:bflag=0
If wflag=-2 Then xshift=ctr.x-xres/2:yshift=ctr.y-yres/20:msg="Static" Else xshift=m.x-xres/2:yshift=m.y-yres/20:msg="Active"
Line im,(xres/2-40,yres/20-5-3)-(xres/2+40,yres/20+10-3),Rgb(0,0,200),bf
Draw String im,(xres/2-20,yres/20-8 ),msg,Rgb(0,200,0)
If mw<>-1 and msg= "Active" Then ang=mw
Screenlock
Cls
rotate(im,ang,xshift,yshift,ctr)
Screenunlock
Sleep 1,1
bflag=mb
Loop Until Inkey=Chr(27)
imagedestroy im
-
- Posts: 4292
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: GUIRuler
Dim As Long __
That is neat!
That is neat!