XProfan

Deutsch

Rainer
Hoefs

Hallo,

bin verzweifelt am Suchen von Befehlen um einen bestimmten Eintrag in einer Gridbox als den Obersten in der Box anzeigen zu lassen.

Ebenso möchte ich wissen welcher Eintrag nach dem Scrollen nun als oberster in der gridbox gezeigt wird.

Nichts was ich gefunden habe funktioniert bei mir.

Es geht dabei um folgendes:

In der GridBox werden Farben aufgelistet. Jede Zeile hat diese Felder:
Name, Nr, Rotwert, Grünwert, Blauwert.
Es werden 16 Zeilen gezeigt.

Links von der Gridbox ist vor jeder Zeile ein Feld, in dem die Farbe als Farbton gezeigt wird. Die RGB-Werte der 16 ersten Zeilen werden gelesen und die Farbfelder gezeichnet. Das funktioniert nach dem Initialisieren tadellos. Nun wird aber gescrollt, und die 16 Felder müssen neu gefärbt werden.

Dazu benötige ich eine Funktion um die aktuell zu oberst gezeigten Zeile zu markieren und deren Index zu ermitteln. Dann werden die nun angezeigten 16 Zeilen gelesen und die Felder eingefärbt.

Wenn ich mit den Pfeiltatsten Hoch und Runter oder mit BildHoch und BildRunter den Balken verschiebe, wie bekomme ich die Zeile die dann aktuell markiert ist?

Gibt es irgendwo die Möglichkeit über ein GridBoxChanged?

Vielleicht kann mir jemand helfen.

Danke im voraus!

Rainer

21.04.2015 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

« Dieser Beitrag wurde als Lösung gekennzeichnet. »

Rainer
Hoefs

Hallo,

hier das Ergebnis, welches mit Eurer Hilfe erreicht wurde.

Danke nochmals

Rainer

Kompilieren Markieren Separieren

'***********************************************************************************
 $H Messages.ph
 $H Windows.ph
 $H commctrl.ph
'***********************************************************************************
Def GetSysColor(1) !"USER32","GetSysColor"
Def CreateBitmap(5) !"GDI32","CreateBitmap"
Def SelectObject(2) !"GDI32","SelectObject"
Def Show(1) ShowWindow(@&(1), 1)
Def Hide(1) ShowWindow(@&(1), 0)
Declare R%[], G%[], B%[], Txt$[], ColNum$[], I%, Modify%
Declare Red&, Green&, Blue&, ColNum%, ColDesription$, SumColors%, GridboxString$
Declare Lv#, icolist&
Var Ende% = 0
struct Lv = Mask&,Item&,SubItem&,State&,StateMask&,Text&,TextMax&,Image&
dim Lv#,Lv
'***********************************************************************************

Proc LvSetIcon

    Lv#.Item&=&(2)
    Lv#.SubItem&=&(3)
    Lv#.Mask&=~LVIF_IMAGE
    Lv#.Image&=%(4)
    sendmessage(&(1),~LVM_SETITEM,0,Lv#)

EndProc

'***********************************************************************************

Proc DrawRGBEdit

    StartPaint %hwnd
    UsePen 0,2, Rgb(102,102,102)
    UseBrush 1, Rgb(255, 0,0)
    Rectangle 262,510,362,545
    UsePen 0,2, Rgb(102,102,102)
    UseBrush 1, Rgb(0, 255,0)
    Rectangle 382,510,482,545
    UsePen 0,2, Rgb(102,102,102)
    UseBrush 1, Rgb(0, 0, 255)
    Rectangle 504,510,604,545
    EndPaint

EndProc

'***********************************************************************************

Proc DrawEmptySelection

    StartPaint %hwnd
    UsePen 0,3, Rgb(127,127,127)
    UseBrush 1, Rgb(255, 255, 255)
    Rectangle 526,32,610,378
    UsePen 5,0, Rgb(127, 127, 127)
    UseBrush 1, Rgb(127, 127, 127)
    Rectangle 528,149,609,378
    UsePen 5,0, Rgb(0, 0, 0)
    UseBrush 1, Rgb(0, 0, 0)
    Rectangle 528,264,609,378
    EndPaint

EndProc

'***********************************************************************************

Proc GetDetailsfromString

    ColNum% = Val(Mid$(GridBoxStr$, 2, 6))
    ColDesription$ = Mid$(GridBoxStr$, Len(GridBoxStr$)-51, 40)
    Red& = Int(Val(Mid$(GridBoxStr$, Len(GridBoxStr$)-10, 3)))
    Green& = Int(Val(Mid$(GridBoxStr$, Len(GridBoxStr$)-6,3)))
    Blue& = Int(Val(Right$(GridBoxStr$, 3)))

EndProc

'***********************************************************************************

Proc ShowSelectedColor

    GetDetailsfromString
    StartPaint %hwnd
    UsePen 5,3, Rgb(0,0,0)
    UseBrush 1, Rgb(Red&, Green&, Blue&)
    Rectangle 540,44,598,368
    EndPaint
    SetSelectedColor

EndProc

'***********************************************************************************

Proc CreateNewColorList

    Beep
    Assign #1,"C:\ColorList.Dat"
    ReWrite #1
    I% = 0

    WhileNot I% = 256

        R%[I%] = Rnd(256)
        G%[I%] = Rnd(256)
        B%[I%] = Rnd(256)
        ColNum$[I%] = Format$("000000",I%)
        Txt$[I%] = ColNum$[I%]+"|"+ColNum$[I%]+"|"+MkStr$("Bemerkung-",4)+"|"+Format$("000",R%[I%])+"|"+Format$("000",G%[I%])+"|"+Format$("000",B%[I%])
        Print #1, Txt$[I%]
        Inc I%

    EndWhile

    Close #1
    Clear R%[], G%[], B%[]

EndProc

'***********************************************************************************

Proc ReadTheColorList

    Var RT$ = ""
    Clear ColNum$[], Txt$[], R%[], G%[], B%[]
    Assign #1,"C:\ColorList.Dat"
    Reset #1
    I% = 0

    WhileNot Eof(#1)

        Input #1, RT$
        ColNum$[I%] = Val(Mid$(RT$, 2, 6))
        Txt$[I%] = Mid$(RT$, Len(RT$)-51, 40)
        R%[I%] = Int(Val(Mid$(RT$, Len(RT$)-10, 3)))
        G%[I%] = Int(Val(Mid$(RT$, Len(RT$)-6,3)))
        B%[I%] = Int(Val(Right$(RT$, 3)))
        addstring(ColorGridbox&, RT$)
        Inc I%
        SumColors% = I%
        RT$ = ""

    EndWhile

    Close #1

EndProc

'***********************************************************************************

Proc MakeColorBitmaps

    Parameters R%, G%, B%
    Declare x&, y&
    x& = CreateBitmap(94,20,1,1,0)
    MCls 94,20
    StartPaint -1
    Cls
    UsePen 0,1,RGB(1,0,0)
    UseBrush 1, Rgb(R%, G%, B%)
    Rectangle 0,0 - 94,20
    y& = SelectObject(%hdc,x&)
    ImageList("Add", icolist&, y&, 0)
    EndPaint

EndProc

'***********************************************************************************

Proc MakeColorFields

    icolist& = Create("ImageList", 94,20,33,0)
    sendmessage(ColorGridbox&,~LVM_SETIMAGELIST,~LVSIL_SMALL,IcoList&)
    I% = 0

    WhileNot I% = SumColors%

        MakeColorBitmaps R%[I%], G%[I%], B%[I%]
        LvSetIcon(ColorGridbox&,I%,0,I%)
        Inc I%

    EndWhile

EndProc

'***********************************************************************************

Proc ShowColorEditor

    Parameters Status%

    If Status% = 1

        EnableWindow ColorEditor&, 0
        EnableWindow Ende&, 0
        SetWindowPos %hwnd = %winleft, %wintop - Width(%hwnd,1), Height(%hwnd,1) + 160

    Else

        EnableWindow ColorEditor&, 1
        EnableWindow Ende&, 1
        Case (Modify% = 1) : Modify% = 0
        EnableWindow ModifyEd&, 1
        SetWindowPos %hwnd = %winleft, %wintop - Width(%hwnd,1), Height(%hwnd,1) - 160

    EndIf

EndProc

'***********************************************************************************

Proc SetSelectedColor

    GetDetailsfromString
    SetText ColNumEd&, Str$(ColNum%)
    SetText ColNameEd&, ColDesription$
    SetText RedEd&, Str$(Red&)
    SetText GreenEd&, Str$(Green&)
    SetText BlueEd&, Str$(Blue&)

EndProc

'***********************************************************************************

Proc ClearTheFields

    SetText ColNumEd&, ""
    SetText ColNameEd&, ""
    SetText RedEd&, ""
    SetText GreenEd&, ""
    SetText BlueEd&, ""

EndProc

'***********************************************************************************

Proc ShowMeColor

    Parameters Col%
    Declare Found%
    SetFocus(ColorGridbox&)
    Found% = SelectString(ColorGridbox&,Col%,"")
    GridBoxStr$ = GetString$(ColorGridbox&,GetCurSel(ColorGridbox&))
    ShowSelectedColor

EndProc

'***********************************************************************************

Proc SaveTheColor

    Declare Question$
    Var ColNum$ = MkStr$("0",(6 - Len(GetText$(ColNumEd&)))) + GetText$(ColNumEd&)
    Var ColDesription$ = GetText$(ColNameEd&) + Space$(40 - (Len(GetText$(ColNameEd&))))
    Var Red$ = MkStr$("0",(3 - Len(GetText$(RedEd&)))) + GetText$(RedEd&)
    Var Green$ = MkStr$("0",(3 - Len(GetText$(GreenEd&)))) + GetText$(GreenEd&)
    Var Blue$ = MkStr$("0",(3 - Len(GetText$(BlueEd&)))) + GetText$(BlueEd&)
    Var SaveString$ = ColNum$+"|"+ColNum$+"|"+ColDesription$+"|"+Red$+"|"+Green$+"|"+Blue$
    Var Position% = GetCurSel(ColorGridbox&)

    If Modify% = 1

        If Messagebox("Wollen Sie die Farbe mit der Nummer: "+GetText$(ColNumEd&)+" wirklich ändern?","ACHTUNG!",292) = 6

            DeleteString(ColorGridbox&,Position%)
            InsertString(ColorGridbox&,Position%,SaveString$)
            UpdateGridBox
            ModifyColor 0
            SelectString(ColorGridbox&,Position%,"")
            GridBoxStr$ = GetString$(ColorGridbox&,GetCurSel(ColorGridbox&))
            ShowSelectedColor

        EndIf

    Else

        If SelectString(ColorGridbox&,-1,GetText$(ColNumEd&))

            If MessageBox("Die Farbe mit der Nummer: "+GetText$(ColNumEd&)+" existiert bereits\rWollen Sie diese Farbe wirklich Speichern?","Doppelte Farbnummer",292) = 6

                AddString(ColorGridbox&,SaveString$)
                UpdateGridBox
                ModifyColor 0
                SelectString(ColorGridbox&,GetCount(ColorGridbox&)-1,"")
                GridBoxStr$ = GetString$(ColorGridbox&,GetCurSel(ColorGridbox&))
                ShowSelectedColor

            EndIf

        EndIf

    EndIf

EndProc

'***********************************************************************************

Proc SearchOneColor

    Var SearchColor$ = Input$("Bitte zu suchende Farbnummer mit max. 6 Zahlen eingeben:","Farbe suchen","123456")

    If SelectString(ColorGridbox&,-1,SearchColor$)

        GridBoxStr$ = GetString$(ColorGridbox&,GetCurSel(ColorGridbox&))
        ShowSelectedColor

    Else

        MessageBox("Keine Farbe mit der Nummer: "+SearchColor$+" gefunden!","Fehler bei der Suche",48)

    EndIf

EndProc

'***********************************************************************************

Proc DeleteTheColor

    Var OK% = Messagebox("Wollen Sie die Farbe mit der Nummer: "+GetText$(ColNumEd&)+" wirklich löschen?","ACHTUNG!",292)

    If OK% = 6

        DeleteString(ColorGridbox&,GetCurSel(ColorGridbox&))
        UpdateGridBox
        SelectString(ColorGridbox&,0,"")
        GridBoxStr$ = GetString$(ColorGridbox&,GetCurSel(ColorGridbox&))
        ShowSelectedColor

    EndIf

EndProc

'***********************************************************************************

Proc UpdateModifiedColor

    StartPaint %hwnd
    UsePen 5,3, Rgb(0,0,0)
    UseBrush 1, Rgb(Val(GetText$(RedEd&)), Val(GetText$(GreenEd&)), Val(GetText$(BlueEd&)))
    Rectangle 540,44,598,368
    EndPaint

EndProc

'***********************************************************************************

Proc ModifyColor

    Parameters Mode%

    If Mode% = 1

        EnableWindow ModifyEd&, 0
        Modify% = 1
        GridBoxStr$ = GetString$(ColorGridbox&,GetCurSel(ColorGridbox&))

    Else

        EnableWindow ModifyEd&, 1
        Modify% = 0

    EndIf

EndProc

'***********************************************************************************

Proc UpdateGridBox

    Hide(ColorGridbox&)
    ReWriteColorDataFile
    ClearList ColorGridbox&
    ReadTheColorList
    MakeColorFields
    Show(ColorGridbox&)

EndProc

'***********************************************************************************

Proc ReWriteColorDataFile

    Var ColorEntries% = GetCount(ColorGridbox&)
    Assign #2,"C:\ColorList.Dat"
    ReWrite #2
    I% = 0

    WhileNot I% = ColorEntries%

        Print #2, GetString$(ColorGridbox&, I%)
        Inc I%

    EndWhile

    Close #2

EndProc

'***********************************************************************************
'** Hauptschleife
'***********************************************************************************
cls GetSysColor(15)
WindowStyle 10 | 512 | 2048
WindowTitle "Arbeitsfenster"
Window ((%maxX-644)/2), 100 - 644,500
Set("Truecolor",1)
var Spalten$ = "Farbe;0;98;WollfarbNr.;1;80;Bemerkung;0;298;R;1;40;G;1;40;B;1;40"
var ColorGridbox& = create("Gridbox",%hwnd,Spalten$,0,10,10,500,380)
Var GridBoxStr$ = ""
Var GrBx& = Create("GroupBox",%hwnd,"Auswahl",518,10,100,382)
Var Ende& = Create("Button",%hwnd,"&Ende", 10,400,100,30)
Var ColorEditor& = Create("Button",%hwnd,"&Farbeditor", 515,400,100,30)
'**** Beginn Farbeditor ************************************************************
Var GrBxEd& = create("Groupbox", %hwnd, "Farbeditor", 1, 455, 626,12)
Create("Text",%hwnd,"Farbnummer:",20,477,90,24) : Var ColNumEd& = Create("Edit", %hwnd, "12346", 110,475,50,24)
Create("Text",%hwnd,"Farbname:",180,477,80,24) : Var ColNameEd& = Create("Edit", %hwnd, "12346", 260,475,345,24)
DrawRGBEdit
Create("Text",%hwnd,"Farbwerte für Rot - Grün - Blau:",50,517,200,24)
Var RedEd& = Create("SpinEdit",%hwnd, "0;0;255",280,515,60,24)
Var GreenEd& = Create("SpinEdit",%hwnd, "0;0;255",402,515,60,24)
Var BlueEd& = Create("SpinEdit",%hwnd, "0;0;255",524,515,60,24)
Var EndeEd& = Create("Button",%hwnd,"Beenden", 10,555,70,30)
Var ClearEd& = Create("Button",%hwnd,"Felder leeren", 96,555,100,30)
Var SearchEd& = Create("Button",%hwnd,"Farbe suchen", 212,555,100,30)
Var DeleteEd& = Create("Button",%hwnd,"Farbe löschen", 313,555,100,30)
Var ModifyEd& = Create("Button",%hwnd,"Farbe ändern", 414,555,100,30)
Var SaveEd& = Create("Button",%hwnd,"Farbe sichern", 515,555,100,30)
'**** Ende Farbeditor **************************************************************
ShowWindow(ColorGridbox&,0)
DrawEmptySelection
CaseNot FileExists("C:\ColorList.Dat") : CreateNewColorList
ReadTheColorList
MakeColorFields
ShowMeColor 0
ShowWindow(ColorGridbox&,1)

WhileNot Ende%

    waitinput

    If Clicked(ColorGridbox&) OR (iskey(13) AND Getfocus(ColorGridbox&))

        If GetCurSel(ColorGridbox&) >= 0

            GridBoxStr$ = GetString$(ColorGridbox&,GetCurSel(ColorGridbox&))
            ShowSelectedColor

        EndIf

    ElseIf Clicked(ColorEditor&)

        ShowColorEditor 1

    ElseIf Clicked(ModifyEd&)

        ModifyColor 1

    ElseIf Clicked(RedEd&)

        UpdateModifiedColor

    ElseIf Clicked(GreenEd&)

        UpdateModifiedColor

    ElseIf Clicked(BlueEd&)

        UpdateModifiedColor

    ElseIf Clicked(SearchEd&)

        SearchOneColor

    ElseIf Clicked(ClearEd&)

        ClearTheFields

    ElseIf Clicked(SaveEd&)

        SaveTheColor

    ElseIf Clicked(DeleteEd&)

        DeleteTheColor

    ElseIf Clicked(EndeEd&)

        ShowColorEditor 0

    ElseIf Clicked(Ende&)

        DeleteObject icolist&
        End

    EndIf

EndWhile

'***********************************************************************************

24.04.2015 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

H.Brill

Wie man den Balken setzt, findest du hier im Forum
Ansätze :
Kompilieren Markieren Separieren

Declare Handle Grid
Declare Int ende, pos
WindowTitle "Ende auch mit ESC !"
Window 800, 600
Grid = @Create("Gridbox", %HWnd, "Name;0;120;Nummer;0;100;R;0;40;G;0;40;B;0;40", 0, 10, 80, 350, 200)
ende = 0
Werte()
pos = SetCurSel(Grid, 0)

WhileNot ende

    WaitInput
    Case %Key = 2  : ende = 1
    Case %Key = 27 : ende = 1

EndWhile

Proc Werte

    AddString(Grid, "Rot|100|255|0|0")
    AddString(Grid, "Grün|200|0|255|0")
    AddString(Grid, "Blau|300|0|0|255")

EndProc

Proc SetCurSel

    Parameters Handle&,Reihe%
    Return Selectstring(Handle&,reihe% -1, GetText$(Handle&,reihe%,0))

EndProc

End

Zum anderen :
Was möchtest du denn genau haben ?
Soll der ausgewählte Eintrag immer oben im Grid stehen ?
Da könnte man das Grid auch SubClassen (siehe SubClassing
in der Hilfe). Mit den geeigneten Messages (LVM_...) in der
commctrl.ph dürfte das eine oder andere zu lösen sein.

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.

21.04.2015 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Peter
Max
Müller

Vielleicht folgendes:

$H COMMCTRL.PH

l.Top = Sendmessage(l.Listview, (~LVM_GETTOPINDEX), 0, 0)

XProfan X3, X4ß, Win 10.1

21.04.2015 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Rainer
Hoefs

Hallo zusammen,

also in einem Dialog ist eine GridBox.

In dieser sind z.B. 100 Zeilen mit Informationen über Farben wie:

Name der Farbe "Dunkelgrün",
Nummer der Farbe "4512"
RotWert "45"
GrünWert "112"
BlauWert "76"

Wenn der Dialog gezeigt wird, wird die Gridbox gefüllt, durch einlesen der Liste aus einem File. Danach wird der erste Eintrag in der gridbox gewählt und markiert. Der hat den Index 0!
Nun werden aus den 16 sichtbaren Zeilen (0-15) die RGB-Werte gelesen und neben den 16 sichtbaren Zeilen der Gridbox werden mit der entsprechenden Farbe kleine Boxen gezeichnet, sodaß man den Farbton der Farbe in der entsprechenden Zeile sieht.

Weiterhin ist darunter ein größeres Farbfeld, in dem die aktuell gewählte Farbe gezeigt wird, beim Init = Zeile 1 mit Index 0.

Das funktioniert einwandfrei.

Doch nun will ich die Liste nach unten oder oben scrollen, egal ob mit dem Mausrad, dem Scrollbalken oder der Tastatur.

Scrolle ich eine Zeile nach unten dann ist die oberste nicht mehr Index 0 sondern z.B. 1 oder 9 oder .... und die Farbflecken links daneben sollen mitscrollen, was bedeutet, die 16 Zeilen die jetzt nach dem Scrollen gezeigt werden müssen neu gelesen werden und die Farbboxen müssen neu gezeichnet werden.

Dazu benötige ich aber nach einer solchen Scrollaction eben den Index der in der Gridbox zu oberst gezeigten Zeile. Diese muß nicht selektiert und highlighted sein. Es reicht wenn ich den Index dieser Zeile weiß. Mache ich es über einen Klick in die Scrollbar so verschiebt es sich ja um 16 Zeilen. Nach jeder dieser Aktionen ob rauf oder runter benötige ich eben den Index der zu oberst gezeigten Zeile.

Und das bekomme ich nicht hin.

Idealer wäre noch, wenn das erste linkeste Feld in der Gridboxzeile mit der Farbe eingefärbt werden könnte die sich aus den drei Feldern RGB ergibt.

Ich hoffe es ist jetzt verständlicher.

Rainer

21.04.2015 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Rainer
Hoefs

Kompilieren Markieren Separieren

 $H COMMCTRL.PH
Declare Handle Grid
Declare Int ende, pos
WindowTitle "Ende auch mit ESC !"
Window 800, 600
Grid = @Create("Gridbox", %HWnd, "Name;0;120;Nummer;0;100;R;0;40;G;0;40;B;0;40", 0, 10, 80, 350, 200)
ende = 0
Werte()
pos = SetCurSel(Grid, 0)

WhileNot ende

    WaitInput
    Case %Key = 2  : ende = 1
    Case %Key = 27 : ende = 1
    WindowTitle  GetString$(Grid,Sendmessage(Grid, (~LVM_GETTOPINDEX), 0, 0))

EndWhile

Proc Werte

    AddString(Grid, "Rot|100|255|0|0")
    AddString(Grid, "Grün|200|0|255|0")
    AddString(Grid, "Blau|300|0|0|255")
    AddString(Grid, "Rot|100|255|0|0")
    AddString(Grid, "Grün|200|0|255|0")
    AddString(Grid, "Blau|300|0|0|255")
    AddString(Grid, "Rot|100|255|0|0")
    AddString(Grid, "Grün|200|0|255|0")
    AddString(Grid, "Blau|300|0|0|255")
    AddString(Grid, "Rot|100|255|0|0")
    AddString(Grid, "Grün|200|0|255|0")
    AddString(Grid, "Blau|300|0|0|255")
    AddString(Grid, "Rot|100|255|0|0")
    AddString(Grid, "Grün|200|0|255|0")
    AddString(Grid, "Blau|300|0|0|255")
    AddString(Grid, "Rot|100|255|0|0")
    AddString(Grid, "Grün|200|0|255|0")
    AddString(Grid, "Blau|300|0|0|255")
    AddString(Grid, "Rot|100|255|0|0")
    AddString(Grid, "Grün|200|0|255|0")
    AddString(Grid, "Blau|300|0|0|255")

EndProc

Proc SetCurSel

    Parameters Handle&,Reihe%
    Return Selectstring(Handle&,reihe% -1, GetText$(Handle&,reihe%,0))

EndProc

End

Das funktioniert zumindest beim Klick auf den Scrollbar und die pfeile

21.04.2015 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Thomas
Freier

Idealer wäre noch, wenn das erste linkeste Feld in der Gridboxzeile mit der Farbe eingefärbt werden könnte die sich aus den drei Feldern RGB ergibt.

Möglich ist, 1.Spalte leer, aber mit Icon oder Icon + Text. Das entsprechende Icon-Farbquadrat(-rechteck) selbst erstellen und setzen.

Gruß Thomas
Windows XP SP2, XProfan X2

21.04.2015 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Rainer
Hoefs

Hallo,

hört sich ja gut an. Wo finde ich die Infos wie man ein Icon einfügt? Kann das auch ein breiteres Rechteck sein oder nur ein Quadrat?

Das bedeutet auch, das jeder String zuerst nach dem Addstring gelesen werden muß, dann das Icon erstellen und einfügen.

Das macht man dann wohl gleich für alle Zeilen?

Denke nur immer die 16 Zeilen updaten wird schneller sein?

Danke soweit.

Rainer

FreeProfan

21.04.2015 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Thomas
Freier

Alle Zeilenwerte kommen ja irgendwo her, wenn der Zeileninhalt fürs Grid erstellt wird: "Grün|200|0|255|0", dann "|Grün|200|0|255|0". Jetzt das Icon mit den Farbwerten erzeugen für die "ImageList".
Ein altes Beispiel mit nur einem Icon. Vielleicht zeigt es den Weg.
Kompilieren Markieren Separieren

'
 $H Messages.ph
 $H Windows.ph
 $H commctrl.ph
'
Def GetSysColor(1) !"USER32","GetSysColor"
Def CreateBitmap(5) !"GDI32","CreateBitmap"
Def SelectObject(2) !"GDI32","SelectObject"
declare Lv#
struct Lv=Mask&,Item&,SubItem&,State&,StateMask&,Text&,TextMax&,Image&
dim Lv#,Lv
'

proc LvSetIcon'---------------------------------------------LvSetIcon

    Lv#.Item&=&(2)
    Lv#.SubItem&=&(3)
    Lv#.Mask&=~LVIF_IMAGE
    Lv#.Image&=%(4)
    sendmessage(&(1),~LVM_SETITEM,0,Lv#)

endproc'-------------------------------------------------------------

Proc Verlauf

    Parameters color1&, color2& , c%
    Declare x&, y&
    Declare StepR!, StepG!, StepB!
    StepR!  = (GetRValue(color1&) - GetRValue(color2&)) /  20
    StepG!  = (GetGValue(color1&) - GetGValue(color2&)) / 20
    StepB!  = (GetBValue(color1&) - GetBValue(color2&)) / 20
    x&=CreateBitmap(c%,20,1,1,0)
    MCls 222,20
    StartPaint -1
    Cls

    WhileLoop 0,(20 - 1)

        UsePen 0,1,RGB(Int(StepR! * &loop + GetRValue(color2&)), \
        Int(StepG! * &loop + GetGValue(color2&)), \
        Int(StepB! * &loop + GetBValue(color2&)))
        Line 0, &loop - (c%*2),&loop

    EndWhile

    y&=SelectObject(%hdc,x&)
    ImageList("Add", icolist&,y&,0)
    EndPaint

EndProc

var icolist&=Create("ImageList", 222,20,33,0)
' 1.Balken einfach
'  c%= 40 '%
'  x&=CreateBitmap(122,20,1,1,0)
'  MCls 222,20
'  StartPaint -1
'  Cls
'  UsePen 2,2,RGB(0,0,255)
'  UseBrush 1,RGB(0,0,255)
'  Rectangle 0,0 - c%*2,20
'  y&=SelectObject(%hdc,x&)
'  ImageList("Add", icolist&,y&,0)
'  EndPaint
' 2.Balken mit Verlauf

WhileLoop 0,100,1

    Verlauf RGB(0,0,255),  RGB(255,255,255), &Loop' &Loop= %

EndWhile

'----------------------------------------------------------------
cls GetSysColor(15)
var a$=" ;;2;Land;0;120;Leute;1;120;% anteilig;0;220"
var Lv&=create("Gridbox",%hwnd,a$,0,10,30,500,200)
sendmessage(Lv&,~LVM_SETIMAGELIST,~LVSIL_SMALL,IcoList&)
sendmessage(Lv&,~LVM_SETEXTENDEDLISTVIEWSTYLE,0,~LVS_EX_SUBITEMIMAGES | ~LVS_EX_GRIDLINES )
addstring(Lv&," |Hamburg|2.067555|")
addstring(Lv&," |Bremen|867555|")
addstring(Lv&," |Schleswig-Holstein|1.867555|")
LvSetIcon(Lv&,0,3,40)' 40=% ,--Aufruf: LvSetIcon(Handle&,Zeile%,Spalte%,Icon%)
LvSetIcon(Lv&,1,3,24)
LvSetIcon(Lv&,2,3,36)

while 1

    waitinput

endwhile

Dieses ist vielleicht besser.
Kompilieren Markieren Separieren

'
 $H Messages.ph
 $H Windows.ph
 $H commctrl.ph
'
Def GetSysColor(1) !"USER32","GetSysColor"
Def CreateBitmap(5) !"GDI32","CreateBitmap"
Def SelectObject(2) !"GDI32","SelectObject"
declare Lv#
struct Lv=Mask&,Item&,SubItem&,State&,StateMask&,Text&,TextMax&,Image&
dim Lv#,Lv
'

proc LvSetIcon'---------------------------------------------LvSetIcon

    Lv#.Item&=&(2)
    Lv#.SubItem&=&(3)
    Lv#.Mask&=~LVIF_IMAGE
    Lv#.Image&=%(4)
    sendmessage(&(1),~LVM_SETITEM,0,Lv#)

endproc'-------------------------------------------------------------

cls GetSysColor(15)
var icolist&=Create("ImageList", 200,20,33,0)

Proc MERKER

    Parameters t$,R%,S%,T%
    Declare x&,y&
    x&=CreateBitmap(122,20,1,1,0)
    MCls 222,20
    StartPaint -1
    Cls
    UseFont "Arial",16,0,0,0,0
    UsePen 2,2,RGB(R%,S%,T%)
    UseBrush 1,RGB(R%,S%,T%)
    Rectangle 0,0 - 120,20
    TextColor RGB(255,255,255),-1
    DrawText 4,2, t$
    y&=SelectObject(%hdc,x&)
    ImageList("Add", icolist&,y&,0)
    EndPaint

Endproc

Var f1& = @Create("Font","Arial",16,0,0,0,0)
var a$=" ;;2;Land;0;120;Menge;1;120"
var Lv&=create("Gridbox",%hwnd,a$,0,10,30,500,200)
SetFont LV&,F1&
sendmessage(Lv&,~LVM_SETIMAGELIST,~LVSIL_SMALL,IcoList&)
sendmessage(Lv&,~LVM_SETEXTENDEDLISTVIEWSTYLE,0,~LVS_EX_SUBITEMIMAGES | ~LVS_EX_GRIDLINES )
addstring(Lv&," |Hamburg|2555")
addstring(Lv&," |Bremen|555")
addstring(Lv&," |Schleswig-Holstein|7555")
' zweite Zeile mit Hinweis, Wert aus Item oder STRING für addstring holen, hier Vorgabe
MERKER "2555",255,0,0
MERKER "555",0,0,255
MERKER "7555",123,123,0
LvSetIcon(Lv&,0,2,0)
LvSetIcon(Lv&,1,2,1)
LvSetIcon(Lv&,2,2,2)

while 1

    waitinput

endwhile

Gruß Thomas
Windows XP SP2, XProfan X2

21.04.2015 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Rainer
Hoefs

Hallo

vielen Dank für Eure Hilfe, aber ich benötige noch einen Tip:

Hier ist jetzt der von mir geänderte Code:

'
Kompilieren Markieren Separieren

 $H Messages.ph
 $H Windows.ph
 $H commctrl.ph
'
Def GetSysColor(1) !"USER32","GetSysColor"
Def CreateBitmap(5) !"GDI32","CreateBitmap"
Def SelectObject(2) !"GDI32","SelectObject"
Declare R%[], G%[], B%[], Txt$[], ColNum$[], I%
Declare Lv#
struct Lv=Mask&,Item&,SubItem&,State&,StateMask&,Text&,TextMax&,Image&
dim Lv#,Lv

proc LvSetIcon'---------------------------------------------LvSetIcon

    Lv#.Item&=&(2)
    Lv#.SubItem&=&(3)
    Lv#.Mask&=~LVIF_IMAGE
    Lv#.Image&=%(4)
    sendmessage(&(1),~LVM_SETITEM,0,Lv#)

endproc'-------------------------------------------------------------

Proc MakeColors

    I% = 0
    Randomize

    WhileNot I% = 256

        R%[I%] = Rnd(256)
        G%[I%] = Rnd(256)
        B%[I%] = Rnd(256)
        ColNum$[I%] = Format$("000000",I%)
        Inc I%

    EndWhile

EndProc

Proc AddTheStrings

    I% = 0

    WhileNot I% = SizeOf(ColNum$[])

        Txt$[I%] = "|"+ColNum$[I%]+"|Bemerkung "+Format$("000",I%)+"|"+Format$("000",R%[I%])+"|"+Format$("000",G%[I%])+"|"+Format$("000",B%[I%])
        addstring(Lv&, Txt$[I%] )
        Inc I%

    EndWhile

EndProc

Proc MakeColorBitmaps

    Parameters t$, R%, G%, B%
    Declare x&, y&
    x& = CreateBitmap(122,20,1,1,0)
    MCls 122,20
    StartPaint -1
    Cls
    UseFont "Arial",16,0,1,1,0
    UsePen 0,1,RGB(1,0,0)
    UseBrush 1,RGB(R%,G%,B%)
    Rectangle 0,0 - 120,20
    y& = SelectObject(%hdc,x&)
    ImageList("Add", icolist&, y&, 0)
    EndPaint

EndProc

Proc MakeColorFields

    I% = 0

    WhileNot I% = SizeOf(ColNum$[])

        MakeColorBitmaps ColNum$[I%], R%[I%], G%[I%], B%[I%]
        LvSetIcon(Lv&,I%,1,I%)
        Inc I%

    EndWhile

EndProc

cls GetSysColor(15)
Set("Truecolor",1)
var icolist& = Create("ImageList", 122,20,33,0)
Var f1& = Create("Font","Arial",16,0,0,0,0)
Var f2& = Create("Font","Arial",16,0,1,1,1)
var a$ = " ;0;0;Wollfarbe;1;180;Bemerkung;0;120;R;1;40;G;1;40;B;1;40"
var Lv& = create("Gridbox",%hwnd,a$,0,10,10,500,385)
SetFont LV&,F1&
sendmessage(Lv&,~LVM_SETIMAGELIST,~LVSIL_SMALL,IcoList&)
sendmessage(Lv&,~LVM_SETEXTENDEDLISTVIEWSTYLE,0,~LVS_EX_SUBITEMIMAGES | ~LVS_EX_GRIDLINES )
MakeColors
AddTheStrings
MakeColorFields

while 1

    waitinput

    If Clicked(Lv&)

        MessageBox("Clicked","OK",48)

    EndIf

endwhile

End

Im Moment habe ich keine highlighted Auswahl. Wie bekomme ich die wieder in die Gridbox?

Rainer

22.04.2015 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Jörg
Sellmeyer

[OFFTOPIC]Bitte den Code jeweils in Codetags einbinden. Geht ganz simpel über das Menü über dem Beitragstext: Code markieren, Pfeil anklicken, "Quelltext" anklicken, fertig.[/OFFTOPIC]

Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

22.04.2015 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Rainer
Hoefs

Hallo,

danke, wieder was gelernt.

Habe am Code noch etwas geänderet. So soll die GridBox aussehen.

Aber die Tastaturbedienung funktioniert nicht, und es wird auch nicht die aktuelle Zeile hervorgehoben.

Falls da einer der Profis noch etwas weiß??? Danke

Rainer
Kompilieren Markieren Separieren

'
 $H Messages.ph
 $H Windows.ph
 $H commctrl.ph
'
Def GetSysColor(1) !"USER32","GetSysColor"
Def CreateBitmap(5) !"GDI32","CreateBitmap"
Def SelectObject(2) !"GDI32","SelectObject"
Declare R%[], G%[], B%[], Txt$[], ColNum$[], I%
Declare Lv#
struct Lv=Mask&,Item&,SubItem&,State&,StateMask&,Text&,TextMax&,Image&
dim Lv#,Lv

proc LvSetIcon'---------------------------------------------LvSetIcon

    Lv#.Item&=&(2)
    Lv#.SubItem&=&(3)
    Lv#.Mask&=~LVIF_IMAGE
    Lv#.Image&=%(4)
    sendmessage(&(1),~LVM_SETITEM,0,Lv#)

endproc'-------------------------------------------------------------

Proc DrawEmptySelection

    StartPaint %hwnd
    UsePen 0,3, Rgb(127,127,127)
    UseBrush 1, Rgb(255, 255, 255)
    Rectangle 526,32,610,378
    UsePen 5,0, Rgb(127, 127, 127)
    UseBrush 1, Rgb(127, 127, 127)
    Rectangle 528,149,609,378
    UsePen 5,0, Rgb(0, 0, 0)
    UseBrush 1, Rgb(0, 0, 0)
    Rectangle 528,264,609,378
    EndPaint

EndProc

Proc ShowSelectedColor

    Parameters SelectedString$
    StartPaint %hwnd
    Var Red& = Int(Val(Mid$(SelectedString$, Len(SelectedString$)-10, 3)))
    Var Green& = Int(Val(Mid$(SelectedString$, Len(SelectedString$)-6,3)))
    Var Blue& = Int(Val(Right$(selectedString$, 3)))
    UsePen 5,3, Rgb(0,0,0)
    UseBrush 1, Rgb(Red&, Green&, Blue&)
    Rectangle 540,44,598,368
    EndPaint

EndProc

Proc MakeColors

    I% = 0
    Randomize

    WhileNot I% = 256

        R%[I%] = Rnd(256)
        G%[I%] = Rnd(256)
        B%[I%] = Rnd(256)
        ColNum$[I%] = Format$("000000",I%)
        Inc I%

    EndWhile

EndProc

Proc AddTheStrings

    I% = 0

    WhileNot I% = SizeOf(ColNum$[])

        Txt$[I%] = "|"+ColNum$[I%]+"|"+MkStr$("Bemerkung-",4)+"|"+Format$("000",R%[I%])+"|"+Format$("000",G%[I%])+"|"+Format$("000",B%[I%])
        addstring(Lv&, Txt$[I%] )
        Inc I%

    EndWhile

EndProc

Proc MakeColorBitmaps

    Parameters R%, G%, B%
    Declare x&, y&
    x& = CreateBitmap(122,20,1,1,0)
    MCls 122,20
    StartPaint -1
    Cls
    UsePen 0,1,RGB(1,0,0)
    UseBrush 1, Rgb(R%, G%, B%)
    Rectangle 0,0 - 120,20
    y& = SelectObject(%hdc,x&)
    ImageList("Add", icolist&, y&, 0)
    EndPaint

EndProc

Proc MakeColorFields

    I% = 0

    WhileNot I% = SizeOf(ColNum$[])

        MakeColorBitmaps R%[I%], G%[I%], B%[I%]
        LvSetIcon(Lv&,I%,1,I%)
        Inc I%

    EndWhile

EndProc

cls GetSysColor(15)
Set("Truecolor",1)
var icolist& = Create("ImageList", 122,20,33,0)
Var f1& = Create("Font","Arial",16,0,0,0,0)
Var f2& = Create("Font","Arial",16,0,1,1,1)
var a$ = " ;0;0;Wollfarbe;1;180;Bemerkung;0;298;R;1;40;G;1;40;B;1;40"
var Lv& = create("Gridbox",%hwnd,a$,0,10,10,500,380)
Var GrBx& = Create("GroupBox",%hwnd,"Auswahl",518,10,100,382)
Var GridBoxStr$ = ""
ShowWindow(Lv&,0)
SetFont LV&,F1&
sendmessage(Lv&,~LVM_SETIMAGELIST,~LVSIL_SMALL,IcoList&)
sendmessage(Lv&,~LVM_SETEXTENDEDLISTVIEWSTYLE,0,~LVS_EX_SUBITEMIMAGES + ~LVS_EX_GRIDLINES )
DrawEmptySelection
MakeColors
AddTheStrings
MakeColorFields
ShowWindow(Lv&,1)
SelectString(Lv&,-1,"")

while 1

    waitinput

    If Clicked(Lv&)

        GridBoxStr$ = GetString$(Lv&,GetCurSel(Lv&))
        ShowSelectedColor GridBoxstr$

    EndIf

endwhile

FreeProfan

22.04.2015 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Thomas
Freier

Sollte jetzt gehen. Hatte Fehlermeldung beim Gridklick bekommen. Icongröße und setzen angepasst. Eine Zeile (gelöscht). Tastaturwahl geht.
Kompilieren Markieren Separieren

'
 $H Messages.ph
 $H Windows.ph
 $H commctrl.ph
'
Def GetSysColor(1) !"USER32","GetSysColor"
Def CreateBitmap(5) !"GDI32","CreateBitmap"
Def SelectObject(2) !"GDI32","SelectObject"
Declare R%[], G%[], B%[], Txt$[], ColNum$[], I%
Declare Lv#
struct Lv=Mask&,Item&,SubItem&,State&,StateMask&,Text&,TextMax&,Image&
dim Lv#,Lv

proc LvSetIcon'---------------------------------------------LvSetIcon

    Lv#.Item&=&(2)
    Lv#.SubItem&=&(3)
    Lv#.Mask&=~LVIF_IMAGE
    Lv#.Image&=%(4)
    sendmessage(&(1),~LVM_SETITEM,0,Lv#)

endproc'-------------------------------------------------------------

Proc DrawEmptySelection

    StartPaint %hwnd
    UsePen 0,3, Rgb(127,127,127)
    UseBrush 1, Rgb(255, 255, 255)
    Rectangle 526,32,610,378
    UsePen 5,0, Rgb(127, 127, 127)
    UseBrush 1, Rgb(127, 127, 127)
    Rectangle 528,149,609,378
    UsePen 5,0, Rgb(0, 0, 0)
    UseBrush 1, Rgb(0, 0, 0)
    Rectangle 528,264,609,378
    EndPaint

EndProc

Proc ShowSelectedColor

    Parameters SelectedString$
    StartPaint %hwnd
    Var Red& = Int(Val(Mid$(SelectedString$, Len(SelectedString$)-10, 3)))
    Var Green& = Int(Val(Mid$(SelectedString$, Len(SelectedString$)-6,3)))
    Var Blue& = Int(Val(Right$(selectedString$, 3)))
    UsePen 5,3, Rgb(0,0,0)
    UseBrush 1, Rgb(Red&, Green&, Blue&)
    Rectangle 540,44,598,368
    EndPaint

EndProc

Proc MakeColors

    I% = 0
    Randomize

    WhileNot I% = 256

        R%[I%] = Rnd(256)
        G%[I%] = Rnd(256)
        B%[I%] = Rnd(256)
        ColNum$[I%] = Format$("000000",I%)
        Inc I%

    EndWhile

EndProc

Proc AddTheStrings

    I% = 0

    WhileNot I% = SizeOf(ColNum$[])

        Txt$[I%] = "|"+ColNum$[I%]+"|"+MkStr$("Bemerkung-",4)+"|"+Format$("000",R%[I%])+"|"+Format$("000",G%[I%])+"|"+Format$("000",B%[I%])
        addstring(Lv&, Txt$[I%] )
        Inc I%

    EndWhile

EndProc

Proc MakeColorBitmaps

    Parameters R%, G%, B%
    Declare x&, y&
    x& = CreateBitmap(72,20,1,1,0)
    MCls 72,20
    StartPaint -1
    Cls
    UsePen 0,1,RGB(1,0,0)
    UseBrush 1, Rgb(R%, G%, B%)
    Rectangle 0,0 - 72,20
    y& = SelectObject(%hdc,x&)
    ImageList("Add", icolist&, y&, 0)
    EndPaint

EndProc

Proc MakeColorFields

    I% = 0

    WhileNot I% = SizeOf(ColNum$[])

        MakeColorBitmaps R%[I%], G%[I%], B%[I%]
        LvSetIcon(Lv&,I%,0,I%)
        Inc I%

    EndWhile

EndProc

cls GetSysColor(15)
Set("Truecolor",1)
var icolist& = Create("ImageList", 72,20,33,0)
Var f1& = Create("Font","Arial",16,0,0,0,0)
Var f2& = Create("Font","Arial",16,0,1,1,1)
var a$ = " ;0;82;Wollfarbe;1;80;Bemerkung;0;298;R;1;40;G;1;40;B;1;40"
var Lv& = create("Gridbox",%hwnd,a$,0,10,10,500,380)
Var GrBx& = Create("GroupBox",%hwnd,"Auswahl",518,10,100,382)
Var GridBoxStr$ = ""
ShowWindow(Lv&,0)
SetFont LV&,F1&
sendmessage(Lv&,~LVM_SETIMAGELIST,~LVSIL_SMALL,IcoList&)
'############################################################## LOESCHEN ###################
'sendmessage(Lv&,~LVM_SETEXTENDEDLISTVIEWSTYLE,0,~LVS_EX_SUBITEMIMAGES + ~LVS_EX_GRIDLINES )
'###########################################################################################
DrawEmptySelection
MakeColors
AddTheStrings
MakeColorFields
ShowWindow(Lv&,1)
SelectString(Lv&,-1,"")

while 1

    waitinput

    If Clicked(Lv&) OR (iskey(13) AND Getfocus(LV&))

        GridBoxStr$ = GetString$(Lv&,GetCurSel(Lv&))
        ShowSelectedColor GridBoxstr$

    EndIf

endwhile