XProfan

H.Brill

GetPixel und SetPixel gibt es doch schon.
Ich gehe mal davon aus, daß mit Palettennummer%
ein Farbwert gemeint ist.
Line hat zwar keinen Farb-Parameter, aber den
kann man ganz einfach mit UsePen vorher einstellen.
Und mit UseBrush werden sogar verschiedene
Schraffuren und die Farbe per Rectangle eingestellt.

Also müßte ja alles da sein.
Und mit StartPaint...EndPaint schaltest du auf die
entsprechende Bitmap um.

Benutze XPROFAN X3 + FREEPROFAN
Wir sind die XProfaner.
Sie werden von uns assimiliert.
Widerstand ist zwecklos!
Wir werden alle ihre Funktionen und Algorithmen den unseren hinzufügen.

Was die Borg können, können wir schon lange.

03.05.2019 ▲

Rainer
Hoefs

Hallo H. Brill,

Genau diese Funktionen gehen nicht, da sie nur mit der Übergabe von RGB( ? , ? , ? )-Werten funktionieren.

Ich muß aber exakte Palettenindizies trasferimento, also aus der Palette die Nr. 249 (oder andere zwischen 0 und 255).

Das ginge naturalmente in einer binär geöffneten BMP mit binärem schreiben. Das ist aber extrem aufwändig.

trotzdem danke
Rainer

XProfan X2

03.05.2019 ▲

Kompilieren Markieren Separieren

H.Brill

Ja, was ist denn die Palettennummer%, von der
du sprichst ?
Man kann ja auch mit den Funktionen

GetRValue(N) , GetGValaue(N) und GetBValue(N)

die einzelnen Farbanteile rausziehen, sodaß man
trotzdem mit RGB() arbeiten kann :

Ich meinte etwa so :

Kompilieren Markieren Separieren

SetPixel x, y, RGB(GetRValue(Palettennummer%), GetGValue(Palettennummer%), GetBValue(Palettennummer%))

Rainer
Hoefs

Nein, so geht das nicht.

In einer 256-Farben Bitmap gibt es nach dem Testata eine Palette mit 3*256 Farbwerten wie z.B 001 092 128 per die Farbe 1
254 003 178 per Farbe 2 oder
082 182 209 per 178 und auch
001 092 128 per die Farbe 200 also gleicher Farbton wie Farbe 1 usw.

In dem Bitmap-Bereich sind dann nur die Referenzen zu der Palette gesetzt also 1 2 178 2 200 2 1 178 2 1 usw.

Alle Infos, wo welcher Bereich, Testata, Infoheader, Coreheader, Palette und Bitmap im File beginnen sind im Testata gespeichert.

Beim Auslesen in einem entsprechenden Programm wie z.B. Grafx2 oder dem uralten DPaint2 wird nur gelesen welchen Paletteneintrag der Punkt hat, also 1 2 oder 178. Dabei ist es egal welcher Farbton in RGB dahintersteht. Der Punkt hat die Referenz als Palettennummer% zu den 3 RGB-Werten in der Palette

Ich muß nun die BMP so auslesen: wenn die Palettennummer% vom Pixel(X,Y) die Nummer 2 ist dann Setpixel(X1,Y, Palettennummer%), wenn es die Nummer 178 ist dann...

Bei Profan kann man das nicht tun, denn da werden die RGB-Werte als gesamte Zahl gelesen. Beim setpixel wird dann einfach ein Punkt gesetzt der zur nächst passenden Farbe stimmt, in diesem Fall also bei Farbe 200 im Punkt würde die 1 gesetzt, da sie ja beide den gleichen Wert haben. Liegen die Farben in der Palette eng zusammen, kommt ein wirres Bild dabei raus.

Ich kopiere hier mal den LUA-Code hinein zum besseren Verständnis:

--Adds a weft-stearing-system right side to the design
--created by Rainer Hoefs - www.rh-design.eu
--This script is free for your personal use.
--Es werden folgende Linien angesetzt
--direkt neben dem Design Fb 249 Linie 1
--dann Fb 4 Linie 2
--Streifen mit benutzten Schußfarben Fb 51 - 57 Linie 3
--dann Fb 1 Linie 4
--Streifen mit benutzten Schußfarben Fb 51 - 57 Linie 5
--dann FB 0 zur Trennung Linie 6
--dann 7 Linien mit den Fb 51 - 57 je nach auftreten im Design zur Kontrolle Linien 7 - 13

run("../samples_2.4/libs/memory.lua")
dofile("../samples_2.4/libs/dawnbringer_lib.lua")
dofile("../carpetdesign/include/_language.lua")

--****************************************************

if language == "DE" then
txt1="Schußsteuerungs-System rechts vom Design ansetzen"
txt2="max. Schußwechsler"
txt3="erste Farbe im Design"
txt4="max. Farben pro Shußlinie"
else
txt1="Add weftstsystem right from the design"
txt2="max. weftsystems"
txt3="first color in design"
txt4="max. colors per weftline"
end

--****************************************************

w, h = getpicturesize()

StartColor = 51
MaxColorPerWeft = 1
WeftSystems = 7

ok, WeftSystems, StartColor, MaxColorPerWeft = inputbox(
txt1,
txt2, WeftSystems, 1, 20, 7,
txt3, StartColor, 1, 255, 3,
txt4, MaxColorPerWeft, 1, 7, 2)

if ok then
-- neue Designgröße berechnen und Design entsprechend vergößern
newdesignw = w + 6 + WeftSystems
oldw = w
setpicturesize(newdesignw, h)
updatescreen()
-- Weiße Fläche mit festen Linien rechts vom Design zeichnen
drawfilledrect(oldw,0,newdesignw-1,h-1,249) -- rechts den Platz in Fb.249 anfügen
db.line(oldw + 1,0,oldw + 1,h-1,4) -- erste Linie mit Fb. 4
db.line(oldw + 3,0,oldw + 3,h-1,1) -- zweite Linie mit Fb. 1
db.line(oldw + 5,0,oldw + 5,h-1,0) -- zweite Linie mit Fb. 1
updatescreen()
-- Alle Zähler zurücksetzen
WeftColorFound = 0
SearchColor = StartColor
EndColor = StartColor + (WeftSystems - 1)
ControlLine = oldw + 6
-- Design Schuß per Schuß durchsuchen und Punkte in die Linien setzen!
for y = 0, h-1, 1 do -- die Schußlinien absuchen
for SearchColor = StartColor, EndColor , 1 do -- eine Farbe nach der anderen suchen
for x = 0, oldw - 1, 1 do -- die Fäden der Schußlinie nach und nach prüfen
c = getpicturepixel(x, y) -- Pixel einlesen
if c == SearchColor then -- wenn Farbe vom Pixel mit Suchfarbe übereinstimmt
WeftColorFound = WeftColorFound + 1 -- Zähler gefundene Farbe setzen
if WeftColorFound > MaxColorPerWeft then -- wenn mehr Farben im Schuß als erlaubt Fehlermeldung
messagebox("Mehr als "..MaxColorPerWeft.." Schußfarben gefunden!\n"..WeftColorFound.." gefunden, "..MaxColorPerWeft.." erlaubt!\nPosition: "..x.." / " ..y)
end
if WeftColorFound == 1 then
putpicturepixel(oldw + 2, y, c) -- Pixel in Steuerlinie 1 setzen
elseif WeftColorFound > 1 then
putpicturepixel(oldw + 4, y, c) -- Pixel in Steuerlinie 2 setzen
end
putpicturepixel(ControlLine, y, c) -- Kontrollpunkt setzen
updatescreen()
-- messagebox("Found SearchColor","X = "..x.."\nY = "..y.."\nSearchColor = "..SearchColor.."\nEndColor = "..EndColor.."\nControlLine = "..ControlLine.."\nWeftColorFound = "..WeftColorFound)
break
end
end
ControlLine = ControlLine + 1
end
WeftColorFound = 0
ControlLine = oldw + 6
end
updatescreen()
finalizepicture()
end;

Bitte nicht an den textilen Begriffen wie Design, Weftsystem oder Schußlinien stören. Weft und Schuß = Y-Linie

Kompilieren Markieren Separieren

H.Brill

Da gibt es bestimmt auch per XProfan einiges.
z.B.

'########################################
'Farbpalette aus Bitmaps auslesen
'########################################
'########################################
'Andrea Miethe Mai 2002
'########################################
SetTrueColor 1
Declare Info#,RGBQuad_1Bit#,RGBQuad_4Bit#,RGBQuad_8Bit#
Declare Dateiname$,Colors&,x%,Col&,B%,H%
Dim Info#,200'nimmt die BitmapInfos auf
Dateiname$ = @LOADFILE$("Bitmap laden :","*.BMP")
Assign #1,Dateiname$
OpenRW #1
@BlockRead(#1,Info#,0,200)'BitmapInfos einlesen
Case Word(Info#,28) = 1  : Colors& = 2
Case Word(Info#,28) = 4  : Colors& = 16
Case Word(Info#,28) = 8  : Colors& = 256
window %maxx+1,0-640,480
cls RGB(192,192,192)
UsePen 0,0,RGB(255,255,255)

If Word(Info#,0) <> 19778

    Print "Kein Bitmap"

Endif

If Word(Info#,28) > 8

    Print "Kein Palettenbild"

Endif

If Colors& = 2

    Dim RGBQuad_1Bit#,8'  2 Farben-Palette
    Seek #1,54'hier beginnt die Palette
    @BlockRead(#1,RGBQuad_1Bit#,0,8)'BitmapInfos einlesen
    h% = 0

    Whilenot x% = 8

        Col& = RGB(byte(RGBQuad_1Bit#,x%+2),byte(RGBQuad_1Bit#,x%+1),byte(RGBQuad_1Bit#,x%))
        Usebrush 1,Col&
        Rectangle b%,h% - b%+20,h%+20
        add x%,4
        add B%,20

        if b% > 300

            add h%,20
            b% = 0

        endif

    EndWhile

Elseif Colors& = 16

    Dim RGBQuad_4Bit#,64' 16 Farben-Palette
    Seek #1,54'hier beginnt die Palette
    @BlockRead(#1,RGBQuad_4Bit#,0,64)'BitmapInfos einlesen
    h% = 0

    Whilenot x% = 64

        Col& = RGB(byte(RGBQuad_4Bit#,x%+2),byte(RGBQuad_4Bit#,x%+1),byte(RGBQuad_4Bit#,x%))
        Usebrush 1,Col&
        Rectangle b%,h% - b%+20,h%+20
        add x%,4
        add B%,20

        if b% > 300

            add h%,20
            b% = 0

        endif

    EndWhile

Elseif Colors& = 256

    Dim RGBQuad_8Bit#,1024'256 Farben-Palette
    Seek #1,54'hier beginnt die Palette
    @BlockRead(#1,RGBQuad_8Bit#,0,1024)'BitmapInfos einlesen
    h% = 0

    Whilenot x% = 1024

        Col& = RGB(byte(RGBQuad_8Bit#,x%+2),byte(RGBQuad_8Bit#,x%+1),byte(RGBQuad_8Bit#,x%))
        Usebrush 1,Col&
        Rectangle b%,h% - b%+20,h%+20
        add x%,4
        add B%,20

        if b% > 300

            add h%,20
            b% = 0

        endif

    EndWhile

Endif

CloseRW #1
setwindowpos %hwnd = 0,0-640,480
Waitinput
Dispose RGBQuad_1Bit#
Dispose RGBQuad_4Bit#
Dispose RGBQuad_8Bit#
Dispose Info#
end

Rainer
Hoefs

Hallo H. Brill,

vielen Dank per den Tip. Ja, das kenne ich, habe es 1998 auch schon in einem Programm so ähnlich corsa.

Ich hoffte allerdings, es auf unkompliziertere Art und Weise lösen zu können, als circa das binäre Lesen und Schreiben der Bitmap.

Aber da muß ich wohl mal meine Uralt-Routinen aktivieren und leider mit entsprechendem, Aufwand ändern.

Hat Andreas, der ja wirklich spitze war, auch eine Routine per das Auslesen der Bitmap (also Bildteil) geschrieben? Und wenn ja, wo kann man die auffinden?

Danke
Rainer

XProfan X2

H.Brill

Den Code hatte ich von : [...]

Was das Auslesen der Bitmap betrifft, wirst du wohl
selber ran müssen. Sowas ist ja auch sehr selten
gefragt. Hier habe ich noch eine Erläuterung von
Frank Abbing :

Mal sehen, ob ich es noch hinbekommen. Also, das Bmp-Format mit den Offsets:

0 immer "BM" (2)
2 Länge der File (4)
6 =0 (4)
10 Offset des ersten Grafikbytes (4)
14 =40 (4)
18 Breite des Bilds (4)
22 Höhe des Bilds (4)
26 ...unwichtig...

Zuerst LongInt Offset 10 auslesen. Hier fangen die Grafikdaten an.
Pro Pixel werden 3 Bytes necessario immer in der Reihenfolge Blau - Grün - Rot.
Nach jeder Zeile wird die Pixelfolge mit Nullbytes auf eine durch 4 teilbare Anzahl ergänzt.
Die Pixel des Bilds sind von links unten nach rechts oben angeordnet.

Ich denke, daß man das Auslesen des Bildteils recht einfach hinbekommt.

Kommt dann naturalmente darauf an, was man alles so an Funktionen braucht.

PS: Die ProSpeed.dll bietet eine Funktion, die die Nutzdaten einer
Bilddatei in ein Byte-Array speichert. Kannst du dir evtl. auch mal
ansehen.

H.Brill

Hier habe ich noch etwas mehr Infos gefunden : [...]

Die Profbmp.dll
Vor allem in der beigefügten Textdatei profbmp.txt
stehen interessante Infos.