Autor: Heinz Brill (---.dip0.t-ipconnect.de)
Datum: 16.01.20 18:05
Gesucht und gefunden 
Hatte mal vor Jahren ein Prog für Blockgrafikzeichen
gemacht.
' Blockgrafikzeichen oben mit der Maus anklicken
' und im Gitternetz ablegen.
Declare Handle imgList, htb, static, icon
Declare Int ende, buttons
WindowTitle "BlockGrafiken"
Window 800, 600
imgList = @Create("ImageList", 16, 16)
buttons = @Create("OEMList", imgList)
htb = @Create("Toolbar", %HWnd, imgList, buttons, 16, 2001, 1)
static = @Create("Static", %HWnd, 400, 200, 350, 200)
ende = 0
Gitternetz(static, 8)
WhileNot ende
WaitInput
If %MenuItem > 2000
icon = ImageList("GetIcon", imgList, %MenuItem - 2001)
' DrawIcon icon, 100, 200
EndIf
If @Mouse(400, 200 - 750, 400)
StartPaint %HWnd
DrawIcon icon, %MouseX, %MouseY
EndPaint
EndIf
Case %Key = 2 : ende = 1
EndWhile
SubProc Create.OEMList
Parameters Handle il
Declare Handle bmp
Declare Long zeichen[]
zeichen[] = 176, 177, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195,\
196, 197, 198, 199, 200, 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, 211, 212, 213, 214, 215,\
216, 217, 218, 219, 220, 221, 222, 223, 226, 227, 255
WhileLoop 0, (SizeOf(zeichen[]) - 1)
MCls 16, 16, RGB(255, 255, 255)
StartPaint -1
UseFont "Terminal", 16, 0, 0, 0, 0
TextColor RGB(0, 0, 0), RGB(255, 255, 255)
DrawText 1, 1, Chr$(zeichen[&LOOP])
EndPaint
bmp = @Create("hSizedPic", 0, "&MEMBMP", 16, 16, 1)
ImageList("Add", il, bmp)
EndWhile
DeleteObject bmp
Return @GetCount(il)
EndProc
Proc Gitternetz
Parameters Handle st, Int dif
Declare Int x, y, y1, x1, dx, dy, m, n
x = 0
y = 0
dx = @Width(st, 1)
dy = @Height(st, 1)
m = @Int(dy / dif)
n = @Int(dx / dif)
y1 = 0
StartPaint st
RectAngle x, y - dx, dy
TextColor RGB(0, 0, 0), -1
UsePen 0, 1, Rgb(0, 0, 0)
WhileLoop 1, m
Line x, y - dx, y1
Inc y, dif
Inc y1, dif
EndWhile
x = 0 : y = 0 : x1 = 0
WhileLoop 1, n
'Line x, y -
EndWhile
EndPaint
EndProc
DeleteObject imgList
End
Vielleicht kannst du damit was anfangen.
PS: Nimm doch statt einem Rectangle ein Static.
Färben müßte man das auch können. Such mal in den Foren.
So ein Fenster kann von Haus aus nur ANSI. Deshalb die Umwandlung
zum ico. Normal Zeichen, wie Buchstaben gehen jedoch.
H.Brill
XProfan X4 + FreeProfan
Nachricht bearbeitet (16.01.20 18:08)
|
|