Foro | | | | - Page 1 - |
| Stephan Sonneborn | Hallo zusammen,
gibt es eine Möglichkeit, ein Edit auch vertikal mittig (auch oben und unten) auszurichten, so wie es z.B. bei einer Excel-Zelle geht?
Horizontal geht so:
DEF CreateEditC(6) CONTROL("EDIT" ,@$(2),$50000001,@%(3),@%(4),@%(5),@%(6),@%(1),106, %HInstance, $0200)
|
| | | Schöne Grüße aus Wittgenstein von Stephan
Programmierumgebung:| XProfan X4 | WIN10 | AMD FX6100 3,3 GHz | 27.02.2011 ▲ |
| |
| | « Dieser Beitrag wurde als Lösung gekennzeichnet. » | | Thomas Freier | Naja, wenn der Font nicht einstellbar ist geht es ohne viel Rechnerei.
DEF GETSYSCOLOR(1) !"USER32","GetSysColor"
SET("TRUECOLOR",1)
CLS GETSYSCOLOR(15)
var hWnd&=%hwnd
Var Font1&=CreateButton(%hwnd,"Font-H = 12",400,40,100,30)
Var Font2&=CreateButton(%hwnd,"Font-H = 16",400,80,100,30)
Var Font3&=CreateButton(%hwnd,"Font-H = 22",400,120,100,30)
var Hdlg&=control("Static","",$54000106,10,50,300,80,%hwnd,5000,0)
var Edit&=control("Edit","",$50000005,0,0,0,0,Hdlg&,5000,0)
settext Edit&,"Bitte hier Text eingeben"
Declare Edi_Font&
SET_EDIT 16,32
while 1
WaitInput
case %key=2:BREAK
case @Clicked(Font1&): SET_EDIT 12,36
case @Clicked(Font2&): SET_EDIT 16,32
case @Clicked(Font3&): SET_EDIT 22,28
wend
DeleteObject edi_Font&
end
Proc SET_EDIT
Parameters x%,y%
Edi_Font& = CreateFont("Arial",x%,0,0,0,0)
SetFont Edit&,edi_Font&
SetWindowPos Edit&=0,y% - 300,x%+6;0
ENDPROC
|
| | | | | |
| | | Hallo Stephan,
M$ bietet das imho selbst nicht direkt an -
ich potuto ein "CanvasEditControl" herstellen/ anbieten das "wie auch immer geartete" Eigenschaften besitzen kann aber ich würde wahrscheinlich erst nächste Woche dazu kommen. |
| | | | |
| | Stephan Sonneborn | Hallo iF,
kein Pronlem. Schade, dass MS das nicht vorgesehen hat, Bei Statics hab ichs hinbekommen,,,
Ich hab mich mit dem Canvas-Thema noch nicht beschäftigt, Was steckt denn dahinter? |
| | | Schöne Grüße aus Wittgenstein von Stephan
Programmierumgebung:| XProfan X4 | WIN10 | AMD FX6100 3,3 GHz | 27.02.2011 ▲ |
| |
| | | | | | | |
| | E.T. | Nur so als Gedanke: Die Höhe des Edit's der verwendeten Font-Höhe anpassen (oder umgekehrt: die Höhe des Edits auslesen und die Font-Höhe anpassen) ...
War nur so ein Gedanke.... |
| | | Grüße aus Sachsen... Mario WinXP, Win7 (64 Bit),Win8(.1),Win10, Win 11, Profan 6 - X4, XPSE, und 'nen schwarzes, blinkendes Dingens, wo ich das alles reinschütte... | 28.02.2011 ▲ |
| |
| | Thomas Freier | Naja, wenn der Font nicht einstellbar ist geht es ohne viel Rechnerei.
DEF GETSYSCOLOR(1) !"USER32","GetSysColor"
SET("TRUECOLOR",1)
CLS GETSYSCOLOR(15)
var hWnd&=%hwnd
Var Font1&=CreateButton(%hwnd,"Font-H = 12",400,40,100,30)
Var Font2&=CreateButton(%hwnd,"Font-H = 16",400,80,100,30)
Var Font3&=CreateButton(%hwnd,"Font-H = 22",400,120,100,30)
var Hdlg&=control("Static","",$54000106,10,50,300,80,%hwnd,5000,0)
var Edit&=control("Edit","",$50000005,0,0,0,0,Hdlg&,5000,0)
settext Edit&,"Bitte hier Text eingeben"
Declare Edi_Font&
SET_EDIT 16,32
while 1
WaitInput
case %key=2:BREAK
case @Clicked(Font1&): SET_EDIT 12,36
case @Clicked(Font2&): SET_EDIT 16,32
case @Clicked(Font3&): SET_EDIT 22,28
wend
DeleteObject edi_Font&
end
Proc SET_EDIT
Parameters x%,y%
Edi_Font& = CreateFont("Arial",x%,0,0,0,0)
SetFont Edit&,edi_Font&
SetWindowPos Edit&=0,y% - 300,x%+6;0
ENDPROC
|
| | | | |
| | | Mal testen...
Cls
Var edit& = Create("Edit", %hWnd, "Testtest", 10, 10, 200, 30)
Var edit2& = Control("EDIT", "TestTest", $54040000, 10, 50, 200, 30, %hwnd, 2001, %hInstance, $00020000)
While 1
WaitInput
Case %key=2: BREAK
EndWhile
|
| | | | |
| | Thomas Freier | Der Text ist in beiden Fällen oben links. Habe noch eine alte Fontauswahl eingebaut, mit der von 12 bis 28 px Fonthöhe alles zu 90% mittig ist. Jedenfalls bei meinem System.
$H Windows.ph
DEF GETSYSCOLOR(1) !"USER32","GetSysColor"
Def GetTextExtentPoint32(4) !"GDI32","GetTextExtentPoint32A"
Def ReleaseDC(2) !"USER32","ReleaseDC"
Def ApiChooseFont(1) ! "COMDLG32.DLL","ChooseFontA","#","%"
SET("TRUECOLOR",1)
CLS GETSYSCOLOR(15)
var hWnd&=%hwnd
Var Font1&=CreateButton(%hwnd,"Font",400,40,100,30)
var Hdlg&=control("Static","",$54000106,10,50,300,80,%hwnd,5000,0)
var Edit&=control("Edit","",$50000005,0,0,0,0,Hdlg&,5000,0)
settext Edit&,"Bitte hier Text eingeben"
Declare Edi_Font&
var Font$="Arial"
var hoehe%=16
var Fett%=0
var Kursiv%=0
var Underline%=0
SET_EDIT
while 1
WaitInput
case %key=2:BREAK
If @Clicked(Font1&)
case fett%=1 : fett%=500
LR_Font_Wahl Font$,(hoehe%*122),Fett%, Kursiv%
SET_EDIT
EndIf
wend
DeleteObject edi_Font&
end
Proc SET_EDIT
Edi_Font& = CreateFont(Font$,hoehe%,0,Fett%,Kursiv%,Underline%)
SetFont Edit&,edi_Font&
O_GetTextExtent GetText$(edit&),1'Länge
var StringBreite& = &(0)
O_GetTextExtent GetText$(edit&),0'Höhe
var StringHoehe& = &(0)
var x!=hoehe%/10
SetWindowPos Edit&=0,22+(StringHoehe&/x!) - 300,(StringHoehe&+(x!*6));0
ENDPROC
Proc O_GetTextExtent
Parameters _t$,_w%
declare _size#,_text#,_result&,_hdc&
dim _text#,Len(_t$) + 1
dim _size#,8
String _text#,0 = _t$
_hdc& = ~GetDC(hWnd&)
GetTextExtentPoint32(_hdc&,_text#,Len(_t$),_size#)
_result& = Long(_size#,4)
Case _w% : _result& = Long(_size#,0)
ReleaseDC(hWnd&,_hdc&)
dispose _text#
dispose _size#
return _result&
EndProc
Proc LR_Font_Wahl
Parameters nFont$,nhoehe%,nFett%,nkurs%
Declare logfont#, choosefont#
dim logfont#,80'-> muss gross genug sein, da sonst der NAME gekürzt wird !
Long logfont#,0=(nhoehe%/90)'FONTHeight 1000 entspricht 10
Long logfont#,4=20'FONTWidth 1000 entspricht 10
Long logfont#,8=0'
Long logfont#,12=200'FONTOrientation
Long logfont#,16=nFett%'FONTWeight - bis 400 ist normal, alles drüber heisst fett !
String logfont#,20=@Chr$(nkurs%)'Italic
String logfont#,21=@Chr$(Underline%)'Underline
String logfont#,22=""'StrikeOut
String logfont#,23="0"'CharSet
String logfont#,24="T"'OutPrecision
String logfont#,25="T"'ClipPrecision
String logfont#,26="0"'Quality
String logfont#,27="2"'PitchAndFamily
String logfont#,28=nFont$'FaceName
Dim choosefont#,60
Long choosefont#,0 = 60'Länge der Strukturvariable
Long choosefont#,4 = %hwnd'Handle des Hauptfensters
Long choosefont#,8 = 0'Instance-Handle des Hauptfensters
Long choosefont#,12= logfont#'LogFontStruktur
Long choosefont#,16 = 0'Pointsize
Long choosefont#,20 = $00002341'Flags
Long choosefont#,24 = rgb(0,0,0)'RGB - Voreinstellung und Wert der ausgelesen wird
Long choosefont#,28 = 0'Custdata
Long choosefont#,32 = 0'Hook
long choosefont#,36= 0'Templatename
Long choosefont#,40= 0'Hinstance
long choosefont#,44= 0'Lpszstyle
Long choosefont#,48= $00000001'FONTtype
Long choosefont#,52= 8'FONTSizeMin
Long choosefont#,56= 36'FONTSizeMax
Decimals 0
apichoosefont(choosefont#)
if @Long(choosefont#,16)/10 > 0' wenn Grösse = 0 wurde abgebrochen
'Farbe auslesen
'Print @GetRValue(@long(choosefont#,24)),\
' @GetGValue(@long(choosefont#,24)),\
' @GetBValue(@long(choosefont#,24))," <- Textfarbe RGB"
'Attribute auslesen
Hoehe%=(@word(choosefont#,16)/10)
Font$=@string$(logfont#,28)
Kursiv%=@Ord(@string$(logfont#,20))
Underline%=@Ord(@string$(logfont#,21))
Fett%=@Long(logfont#,16)
if Fett% > 400
Fett%=1
else
Fett%=0
endif
endif
Dispose logfont#
Dispose choosefont#
EndProc
|
| | | | |
| | Stephan Sonneborn | Thomas Freier (28.02.11)
Naja, wenn der Font nicht einstellbar ist geht es ohne viel Rechnerei.
Hi Thomas,
funzt prima! Der Font wird nur einmal programmtechnisch eingestellt und bleibt dann unveränderlich.
Vielen Dank!!! |
| | | Schöne Grüße aus Wittgenstein von Stephan
Programmierumgebung:| XProfan X4 | WIN10 | AMD FX6100 3,3 GHz | 28.02.2011 ▲ |
| |
| | Stephan Sonneborn | Hallo zusammen,
ich die Vorlage von Thomas noch etwas ergänzt...
'************************************************************************************************
'* Vertikal zentriertes Editfeld Built: 01.03.2011 *
'* optional links, rechts oder mittig ausgerichtet (ggf. nur Zahlen erlaubt) *
'* nach einer Vorlage von Thomas Freier *
'* erweitert durch Stephan Sonneborn *
'************************************************************************************************
DEF GETSYSCOLOR(1) !"USER32","GetSysColor"
'+----------------------------------------------------------------------------------------------+
DECLARE Font&, Edit&, THeight%
DECLARE LastDlgID&
'+----------------------------------------------------------------------------------------------+
'************************************************************************************************
'* Einzel-IDs per Dialogelemete generieren *
'************************************************************************************************
PROC NewID
DECLARE ID&
'+----------------------------------------------------------------------------------------------+
LastDlgID& = LastDlgID& + 1
ID& = LastDlgID&
'+----------------------------------------------------------------------------------------------+
RETURN ID&
'+----------------------------------------------------------------------------------------------+
ENDPROC
'************************************************************************************************
'************************************************************************************************
'* Vertikal zentriertes Editfeld *
'************************************************************************************************
PROC CreateEditVert
PARAMETERS hParent&, Text$, x1%, y1%, dx%, dy%, TSize%, Alignment%, Number%
'hParent : Handle des Elterfensters
'Text$ : Vorgabetext
'x1%, y1% : linke obere Ecke des "Editfeldes"
'dx%, dy% : Dimensione des "Editfeldes"
'TSize% : Texthöhe im Editfeld
'Alignment%: 0 => links, 1 => mittig, 2 => rechts ausgerichtet
' Number% : <> 0 => nur Zahleneingabe erlaubt
DECLARE hStatic&, hEdit&
DECLARE EHeight%, Style&
'+----------------------------------------------------------------------------------------------+
EHeight% = TSize% + 6
Style& = $50000080 + Alignment%
Case Number%: Style& = Style& + $2000
hStatic& = CONTROL("Static","" ,$54001106 ,x1%,y1%,dx%,dy%,hParent&,NEWID(),0)
hEdit& = CONTROL("Edit" ,Text$, Style&, 0, 0, 0, 0,hStatic&,NewID(),0)
SETWINDOWPOS hEdit& = 0, ((dy%-TSize%)/2) - dx%, EHeight%; 0
'+----------------------------------------------------------------------------------------------+
RETURN hEdit&
'+----------------------------------------------------------------------------------------------+
ENDPROC
'************************************************************************************************
'************************************************************************************************
SET("TRUECOLOR",1)
CLS GETSYSCOLOR(15)
'+----------------------------------------------------------------------------------------------+
THeight% = 30
Font& = CREATEFONT ("Arial",THeight%,0,0,0,0)
Edit& = CreateEditVert(%HWND, "",10,50,300,80,THeight%,1, 0)'Texteingabe
'Edit& = CreateEditVert(%HWND, "",10,50,300,80,THeight%,1, 1) 'Zahleneingabe
SETFONT Edit&, Font&
SETTEXT Edit&,"Bitte hier Text eingeben"
'+----------------------------------------------------------------------------------------------+
LOCATE 1,1
PRINT "Weiter mit F1"
'+----------------------------------------------------------------------------------------------+
WHILE 1
WAITINPUT
CASE %KEY = 5: BREAK
WEND
'+----------------------------------------------------------------------------------------------+
PRINT "Text im Editfeld: ", GETTEXT$(Edit&)
PRINT "Ende mit Mausklick."
'+----------------------------------------------------------------------------------------------+
WAITINPUT
'+----------------------------------------------------------------------------------------------+
DELETEOBJECT Font&
END
'************************************************************************************************
|
| | | Schöne Grüße aus Wittgenstein von Stephan
Programmierumgebung:| XProfan X4 | WIN10 | AMD FX6100 3,3 GHz | 01.03.2011 ▲ |
| |
| | Thomas Freier | Und noch ein reduziertes Beispiel mit "Blinden Edit-Feldern", das ich verwende um "Namensschilder" auf einem Bootsplatz(hier ohne Hintergrundgrafik) anzulegen, zu editieren und zu verschieben.
DEF GetSysColor(1) !"USER32","GetSysColor"
Def APISetCursorPos(2) ! "USER32","SetCursorPos"
Def WindowFromPoint(2)!"USER32","WindowFromPoint"
Def GetCursorPos(1) !"USER32","GetCursorPos"
Declare p#,h&
Dim p#,8
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Def GetTextExtentPoint32(4) !"GDI32","GetTextExtentPoint32A"
Def ReleaseDC(2) !"USER32","ReleaseDC"
Def GetDC(1) !"USER32","GetDC"
declare x%,y%
Proc GetTextExtent
Parameters _t$,_w%
declare _size#,_text#,_result&,_hdc&
dim _text#,Len(_t$) + 1
dim _size#,8
String _text#,0 = _t$
_hdc& = GetDC(GetActiveWindow())
GetTextExtentPoint32(_hdc&,_text#,Len(_t$),_size#)
_result& = Long(_size#,4)
Case _w% : _result& = Long(_size#,0)
ReleaseDC(GetActiveWindow(),_hdc&)
dispose _text#
dispose _size#
return _result&
EndProc
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Def @Clienttoscreen(2) !"USER32","ClientToScreen"
Def @G2lx(0) @Long(C2sstrc#,0)
Def @G2ly(0) @Long(C2sstrc#,4)
Proc G2l
Parameters Hdl&
Clear C2sstrc#
@Clienttoscreen(%Hwnd,C2sstrc#)
x%=@G2lx()
y%=@G2ly()
Clear C2sstrc#
@Clienttoscreen(Hdl&,C2sstrc#)
x%=@G2lx()-x%
y%=@G2ly()-y%
Endproc
Declare C2sstrc#
Dim C2sstrc#,8
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SubClassProc
case SubClassMessage(h&, $201): PostMessage(h&, $A1, $2, 0)
Endproc
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Window 1000,600
WindowTitle "Blindes Edit-Feld, nach Doppelklick links verschiebbar, nach Rechtsklick" + \
" editierbar - Linksklick im Fenster = übernehmen, Rechtsklick im Fenster = neues Edit"
UseFont "Arial",16,0,0,0,0
CLS GETSYSCOLOR(15)
var LV_Font&=CreateFont("Arial",15,0,0,0,0)
SETDIALOGFONT LV_Font&
Declare b.obj&[],b.x%[],b.x1%[],b.y%[],b.y1%[], b.text$[],b.lage$[]
Declare b.xn%
Declare pic1&
b.xn%=1
b.x%[b.xn%]=400
b.y%[b.xn%]=320
b.text$[b.xn%]="K. Mustermann"
b.lage$[b.xn%]="S"
Boot_obj b.xn%
Subclass b.obj&[b.xn%],1
b.xn%=2
b.x%[b.xn%]=428
b.y%[b.xn%]=320
b.text$[b.xn%]="E. Wassermann"
b.lage$[b.xn%]="S"
Boot_obj b.xn%
Subclass b.obj&[b.xn%],1
b.xn%=3
b.x%[b.xn%]=200
b.y%[b.xn%]=200
b.text$[b.xn%]="K. Mustermann"
b.lage$[b.xn%]="W"
Boot_obj b.xn%
Subclass b.obj&[b.xn%],1
b.xn%=4
b.x%[b.xn%]=200
b.y%[b.xn%]=228
b.text$[b.xn%]="E. Wassermann"
b.lage$[b.xn%]="W"
Boot_obj b.xn%
Subclass b.obj&[b.xn%],1
b.xn%=4
While 1
WaitInput
Case %key=2:Break
Whileloop b.xn%
G2l b.obj&[&loop]
b.x%[&loop]=x%
b.y%[&loop]=y%
EndWhile
GetCursorPos(p#)
h&=WindowFromPoint(Long(p#,0),Long(p#,4))
if %MouseKey=2' wenn nicht verschoben werden soll: %MouseKey=1
x%=1
Whileloop b.xn%' Anzahl der Objekte
if Mouse(b.x%[&loop],b.y%[&loop] - (b.x%[&loop]+b.x1%[&loop]),(b.y%[&loop]+b.y1%[&loop]))
ShowWindow(b.obj&[&loop],0)
Element_Edit &loop' EDIT-Feld vorhandenes Objekt
Subclass b.obj&[&loop],1
x%=0
break
endif
wend
if x%=1
inc b.xn%
b.x%[b.xn%]=%MouseX
b.y%[b.xn%]=%MouseY
b.text$[b.xn%]=""
b.lage$[b.xn%]="W"
b.x1%[b.xn%]=120
Element_Edit b.xn%' EDIT-Feld neues Objekt
Subclass b.obj&[b.xn%],1
endif
SetFocus(%HWND)
endif
EndWhile
DeleteObject LV_Font&
DeleteObject pic1&
Whileloop b.xn%
Subclass b.obj&[&loop],0
EndWhile
Dispose C2sstrc#
Dispose p#
End
Proc Boot_obj
Parameters b.xi%
UseFont "Arial",(16+2),0,0,0,0
GetTextExtent b.text$[b.xi%],1'Textlänge
b.x1%[b.xi%] = &(0)+0'Länge
GetTextExtent b.text$[b.xi%],0
b.y1%[b.xi%] = &(0)+4'Höhe
If trim$(b.lage$[b.xi%]="S")'Länge+Höhe tauschen bei senkrecht
x%=b.y1%[b.xi%]
b.y1%[b.xi%]=b.x1%[b.xi%]
b.x1%[b.xi%]=x%
endif
MCls b.x1%[b.xi%], b.y1%[b.xi%] ,RGB(255,255,255)
StartPaint -1
UsePen 0, 1, @RGB(192, 192, 192)
Rectangle 0,0-b.x1%[b.xi%], b.y1%[b.xi%]
TextColor @RGB(0,0,0), -1
If trim$(b.lage$[b.xi%]="W")
Set("Orientation", 0)
UseFont "Arial",16,0,0,0,0
DrawText 2, 2, b.text$[b.xi%]
ElseIf trim$(b.lage$[b.xi%]="S")
Set("Orientation", 2700)
UseFont "Arial",(16-1),0,0,0,0
DrawText b.x1%[b.xi%]-2, 2, b.text$[b.xi%]
Endif
Endpaint
Set("Orientation", 0)
pic1&=Create("hPic",0,"&MEMBMP" )
b.obj&[b.xi%]=Control("DIALOG","",$54001100,b.x%[b.xi%], b.y%[b.xi%], b.x1%[b.xi%], b.y1%[b.xi%],%hwnd,0,%hinstance,$0)
Create("Bitmap",b.obj&[b.xi%], pic1&,0, 0)
Endproc
Proc Element_Edit
Parameters b.xi%
var edi.x%= b.x1%[b.xi%]
case b.lage$[b.xi%]="S" : edi.x%= b.y1%[b.xi%]
var Element&= CreateEdit(%hwnd,b.text$[b.xi%],b.x%[b.xi%], b.y%[b.xi%],120 , 22)
SetFont Element&,LV_Font&
var Element1&=Create("GroupBox",%hwnd,"",b.x%[b.xi%], (b.y%[b.xi%]-38),120,30)
CreateText(Element1&,"",2,10,116,18)
var hor&=Create("RadioButton",%hwnd,"",(b.x%[b.xi%]+4),(b.y%[b.xi%]-25),12,12)
var t1&=CreateText(Element1&,"0°",18,11,14,16)
var sen&=Create("RadioButton",%hwnd,"",(b.x%[b.xi%]+38),(b.y%[b.xi%]-25),12,12)
var t2&=CreateText(Element1&,"90°",56,11,22,16)
var t3&=Create("Button",Element1&,"F",90,10,18,18)
@Create("Tooltip",%hwnd,t3&,"Font wählen")
SetFont hor&,LV_Font&
SetFont t1&,LV_Font&
SetFont t2&,LV_Font&
SetFont t3&,LV_Font&
If trim$(b.lage$[b.xi%]="W")
SetCheck hor&,1
else
SetCheck sen&,1
EndIf
SendString(Element&,"+({END})")'Text Markieren und Cursor ans Ende
While 1
WaitInput
If GetFocus(%hwnd)
b.text$[b.xi%] = GetText$(Element&)
If GetCheck(hor&)
b.lage$[b.xi%]="W"
Else
b.lage$[b.xi%]="S"
EndIf
BREAK
endif
wend
DestroyWindow(Element&)
DestroyWindow(Element1&)
DestroyWindow(hor&)
DestroyWindow(sen&)
Boot_obj b.xi%' Textobjekt neu
EndProc
|
| | | | |
|
AnswerTopic-Options | 13.443 Views |
ThemeninformationenDieses Thema hat 5 subscriber: |