(511)  Anmelden

Deutsch
Forum

SetTopIndex und GetTopIndex für Gridboxen

 
- Seite 1 -



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 zitierenZeilenweise zitieren
 



 
- Seite 2 -


« Dieser Beitrag wurde als Lösung gekennzeichnet. »

- Seite 2 -



Rainer
Hoefs
Hallo,

hier das Ergebnis, welches mit Eurer Hilfe erreicht wurde.

Danke nochmals

Rainer
KompilierenMarkierenSeparieren
'***********************************************************************************
 $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 zitierenZeilenweise zitieren
 




Rainer
Hoefs
Vielen Dank!

Rainer
 
22.04.2015  ▲
 




Thomas
Freier
Wenn es so reicht ok.
Soll das Icon (die Farbe) bei selectierter Zeile erhalten bleiben wird es aufwendiger. Es müßte noch die Möglichkeit geben, dass die Zeilenfarbe nicht blau wird und die Zeile nur noch einen gestrichelten Rahmen bekommt.
Oder auf das LV-Item eine Bitmap aus dem entsprechendem Icon setzen.
 
Gruß Thomas
Windows XP SP2, XProfan X2
22.04.2015  ▲
 




Rainer
Hoefs
Thomas Freier (22.04.15)
Wenn es so reicht ok.
Soll das Icon (die Farbe) bei selectierter Zeile erhalten bleiben wird es aufwendiger. Es müßte noch die Möglichkeit geben, dass die Zeilenfarbe nicht blau wird und die Zeile nur noch einen gestrichelten Rahmen bekommt.
Oder auf das LV-Item eine Bitmap aus dem entsprechendem Icon setzen.


Hallo Thomas,

ja, das mit dem Rahmen wäre gut. Habe schon gesucht bei den Messages in Comm*.ph aber nichts passendes erkannt.

Noch eine weitere Frage: In der liste wird unten immer eine Leerzeile gezeigt, die beim Anklicken zu einem Fehler führt, Wie kann man die wegbekommen, denn die "Farbe" gibt es ja nicht?

Rainer
 
23.04.2015  ▲
 




Thomas
Freier
Rainer Hoefs (04/23/15)
Thomas Freier (22.04.15)
Wenn es so reicht ok.
Soll das Icon (die Farbe) bei selectierter Zeile erhalten bleiben wird es aufwendiger. Es müßte noch die Möglichkeit geben, dass die Zeilenfarbe nicht blau wird und die Zeile nur noch einen gestrichelten Rahmen bekommt.
Oder auf das LV-Item eine Bitmap aus dem entsprechendem Icon setzen.


Hallo Thomas,

ja, das mit dem Rahmen wäre gut. Habe schon gesucht bei den Messages in Comm*.ph aber nichts passendes erkannt.

Noch eine weitere Frage: In der liste wird unten immer eine Leerzeile gezeigt, die beim Anklicken zu einem Fehler führt, Wie kann man die wegbekommen, denn die "Farbe" gibt es ja nicht?

Rainer


Zum 1. muß ich suchen. Müßte einen SetStyle H, [M,] N geben.
Zum 2. es wird Clicked(Lv&) abgefragt. Also die Gridbox. Für Aktionen besser GetCurSel(Lv&). Es wird ggf. -1 zurückgegeben und dann Fehler.
KompilierenMarkierenSeparieren
while 1

    waitinput

    If Clicked(Lv&)

        print GetCurSel(Lv&) >= 0' NUR ZUM TEST DANN LÖSCHEN

        If GetCurSel(Lv&) >= 0 OR (iskey(13) AND Getfocus(LV&))

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

        EndIf

    Endif

endwhile
 
Gruß Thomas
Windows XP SP2, XProfan X2
23.04.2015  ▲
 




Rainer
Hoefs
Danke!

Rainer
 
23.04.2015  ▲
 




Thomas
Freier
Auf die Schnelle finde ich das nicht.
Ein Beispiel, wo das Icon nicht gefärbt wird ist unter [...] 
zu finden. Ist zwar aus der Zeit vor der Gridbox, aber immer noch eine Quelle.

39 kB
Hochgeladen:23.04.2015
Ladeanzahl: 135
Herunterladen
 
Gruß Thomas
Windows XP SP2, XProfan X2
23.04.2015  ▲
 




Rainer
Hoefs
Hallo,

hier das Ergebnis, welches mit Eurer Hilfe erreicht wurde.

Danke nochmals

Rainer
KompilierenMarkierenSeparieren
'***********************************************************************************
 $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  ▲
 




E.T.
Sehr schön, nur eines gefällt nicht so recht:
Wenn eine Zeile markiert ist, wird in dieser die Farbe des linken Feldes verändert, so das die Farben links in der Box und rechts unterschiedlich aussehen. Wa im ersten Moment etwas

 
XProfan X2
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...
24.04.2015  ▲
 




Rainer
Hoefs
Hallo,

ja, das ist im Moment leider so.

Thomas Freier meinte es gäbe eine Möglichkeit bei den Style-Settings nur einen Rahmen um die Zeile zu setzen. Das wäre dann ideal.

Ich habe auch schon bei den Messages gesucht, und nichts gefunden, was man ggf. benutzen könnte. So muß ich mich im Moment eben so behelfen.

Sollte noch irgendjemanden etwas dazu einfallen, wäre ich für den Tip, wie immer, sehr dankbar.

Rainer
 
25.04.2015  ▲
 




Jörg
Sellmeyer
Ganz brachial könntest du einfach nach deinem Mausklick in die Gridlist den Focus aufs Hauptfenster setzen:
KompilierenMarkierenSeparieren
If Clicked(ColorGridbox&) OR (iskey(13) AND Getfocus(ColorGridbox&))

    If GetCurSel(ColorGridbox&) >= 0

        GridBoxStr$ = GetString$(ColorGridbox&,GetCurSel(ColorGridbox&))
        ShowSelectedColor
        SetFocus(%hwnd)

    EndIf

    '...

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




Rainer
Hoefs
Hallo Jörg,

ist ja 'ne echte "quick & dirty"-Lösung, die aber bestens funktioniert.

Denn nach der Auswahl einer Farbe in der Liste wird ja sowieso irgendetwas damit angefangen, z.B. im Farbeditor gearbeitet, oder wenn alles im richtigen Dialog in meinem Teppich-Kolorier- und Druckprogramm integriert ist, ein Teppich koloriert, wo dann ja sofort der Focus auf anderen Bedienelementen sitzt.

Insofern eine gute und praktikable Lösung.

Danke.

Rainer

p.s.
Dennoch.... wenn jemandem noch die saubere Windows-Api-Lösung einfällt....
 
25.04.2015  ▲
 




Thomas
Freier
Es wird dann die markierte Zeile hellgrau und die Farbe ändert sich auch noch.
Alternativ mit Checkbox, dann Haken setzen und alles deselektieren.
Oder Bitmap auf das Icon der markierten Zeile.
Kleines Beispiel (Problem bleibt das Ermitteln der Item-Koordinaten ohne Litview.dll)
KompilierenMarkierenSeparieren
window 10,100-450,400
WindowTitle "Wahl nach Doppelklick links"'
 $H windows.ph
 $H messages.ph
 $H commctrl.ph
'
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'-------------------------------------------------------------

'
var IcoList&=create("ImageList",26,26)
ImageList("AddIcon",IcoList&,~LoadIcon(0,32512))
ImageList("AddIcon",IcoList&,~LoadIcon(0,32513))
ImageList("AddIcon",IcoList&,~LoadIcon(0,32514))
ImageList("AddIcon",IcoList&,~LoadIcon(0,32515))
'
var a$=";0;56;Spalte 2;0;120;Spalte 3;0;120"
var Lv&=create("gridbox",%hwnd,a$,0,10,30,400,200)
sendmessage(Lv&,~LVM_SETIMAGELIST,~LVSIL_SMALL,IcoList&)
'
a$="|Test x b|Test x c|Test x d|Test x e"

whileloop 0,5

    addstring(Lv&,translate$(a$,"x",str$(&loop)))
    LvSetIcon(Lv&,&loop,0,1)

endwhile

SubClass %hwnd, 1
UserMessages 2000
Declare x&,y&,x%,y%
Declare bi&, ba&, item&

while 1

    waitinput

    If (%umessage = 2000) AND (&ulparam > -1)

        x&= &ulparam
        y&= &uwparam
        x%=0
        y%=SendMessage(LV&,$101D, x&,0)

        Whileloop 0,x&-1,1

            x%=x%+SendMessage(LV&,$101D, &loop,0)

        EndWhile

        '########################################################################
        MCls 32,26
        StartPaint -1
        Cls
        UsePen 0,6,RGB(255,0,0)
        Rectangle 0,0 - 32,26
        EndPaint
        bi&=Create("hPic", 0,"&MEMBMP")
        DestroyWindow(ba&)
        ba&=Create("Bitmap", LV&, bi&,2, 25+(y&*27))
        '########################################################################

    EndIf

EndWhile

DeleteObject bi&
Usermessages 0
SubClass %hwnd, 0
END

SubClassProc

    If SubClassMessage(%hWnd, ~WM_NOTIFY)

        If Long(&sLParam,8)=-3

            item&=Long(&sLParam,12)

            If item&<>-1

                SendMessage(%hwnd, 2000, item&, Long(&sLParam,16))

            EndIf

        EndIf

    EndIf

EndProc



Bei mir ist die Beschriftung tlw. zu groß. Screen-1.jpg

26 kB
Hochgeladen:25.04.2015
Ladeanzahl: 55
Herunterladen
104 kB
Hochgeladen:25.04.2015
Ladeanzahl: 20
Herunterladen
 
Gruß Thomas
Windows XP SP2, XProfan X2
25.04.2015  ▲
 



◄
12

Antworten


Thementitel, max. 100 Zeichen.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Beitrag  Schrift  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Themenoptionen

Ungelesen
Abonnieren
Merkliste
Hinweise
Gäste
Löschen
Ständig
Erledigt

5.965 Betrachtungen

Unbenanntvor 0 min.
Peter Max Müller21.01.2024
RudiB.26.08.2022
Jörg Sellmeyer15.05.2018
rquindt29.04.2018
Mehr...

Themeninformationen

Dieses Thema hat 6 Teilnehmer:

Rainer Hoefs (12x)
Thomas Freier (7x)
Jörg Sellmeyer (2x)
E.T. (1x)
Peter Max Müller (1x)
H.Brill (1x)


Admins  |  AGB  |  Anwendungen  |  Autoren  |  Chat  |  Datenschutz  |  Download  |  Eingangshalle  |  Hilfe  |  Händlerportal  |  Impressum  |  Mart  |  Schnittstellen  |  SDK  |  Services  |  Spiele  |  Suche  |  Support

Ein Projekt aller XProfaner, die es gibt!


Mein XProfan
Private Nachrichten
Eigenes Ablageforum
Themen-Merkliste
Eigene Beiträge
Eigene Themen
Zwischenablage
Abmelden
 Deutsch English Français Español Italia
Übersetzungen

Datenschutz


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.

einverstandenDatenschutzerklärung
Ich möchte keinen Cookie