How to change fore color of the some items in the Listbox control in vb6.
Is there any other method than using Listview control.
This problem can be solved by using the WinAPI. The following code shows how.
Form
The form code fills the Listbox and sets up subclassing. The form is being subclassed so we can intercept messages to the Listbox. It is imperative to release the subclassing in the Unload method to prevent ugly crashes. ColorList is a method that windows will call to do the needed work using the foreground color stored in ItemData.
Option Explicit
Private Sub Form_Load()
Dim i As Integer
For i = 1 To 10
List1.AddItem "Item " & i
List1.itemData(List1.NewIndex) = IIf(i Mod 2 = 0, vbBlue, vbRed) 'store the required color
Next
PrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf ColorList)
End Sub
Private Sub Form_Unload(Cancel As Integer)
SetWindowLong hwnd, GWL_WNDPROC, PrevWndProc
End Sub
Module
The ColorList method intercepts the WM_DRAWITEM message so how the item is drawn can be overridden. Either the focus rectangle is drawn, or the foreground color specified when filling the Listbox is drawn.
Option Explicit
Public Function ColorList(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim Item As DRAWITEMSTRUCT
Dim Buffer As String * 255
Dim ItemText As String
Dim Brush As Long
If Msg = WM_DRAWITEM Then
CopyMemory Item, ByVal lParam, Len(Item)
If Item.CtlType = ODT_LISTBOX Then
'get the item
SendMessage Item.hwndItem, LB_GETTEXT, Item.itemID, ByVal Buffer
ItemText = Left(Buffer, InStr(Buffer, Chr(0)) - 1)
'draw the item
If (Item.itemState And ODS_FOCUS) Then
Brush = CreateSolidBrush(GetSysColor(COLOR_HIGHLIGHT))
FillRect Item.hdc, Item.rcItem, Brush
SetBkColor Item.hdc, GetSysColor(COLOR_HIGHLIGHT)
SetTextColor Item.hdc, GetSysColor(COLOR_HIGHLIGHTTEXT)
TextOut Item.hdc, Item.rcItem.Left, Item.rcItem.Top, ByVal ItemText, Len(ItemText)
DrawFocusRect Item.hdc, Item.rcItem
Else
Brush = CreateSolidBrush(GetSysColor(COLOR_WINDOW))
FillRect Item.hdc, Item.rcItem, Brush
SetBkColor Item.hdc, GetSysColor(COLOR_WINDOW)
SetTextColor Item.hdc, Item.itemData
TextOut Item.hdc, Item.rcItem.Left, Item.rcItem.Top, ByVal ItemText, Len(ItemText)
End If
'cleanup
DeleteObject Brush
ColorList = 0
End If
Else
ColorList = CallWindowProc(PrevWndProc, hwnd, Msg, wParam, lParam)
End If
End Function
Also in a module is all the required definitions.
Option Explicit
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Public Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
Public Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type DRAWITEMSTRUCT
CtlType As Long
CtlID As Long
itemID As Long
itemAction As Long
itemState As Long
hwndItem As Long
hdc As Long
rcItem As RECT
itemData As Long
End Type
Public Const GWL_WNDPROC = (-4)
Public Const LB_GETTEXT = &H189
Public Const WM_DRAWITEM = &H2B
Public Const COLOR_HIGHLIGHT = 13
Public Const COLOR_HIGHLIGHTTEXT = 14
Public Const COLOR_WINDOW = 5
Public Const COLOR_WINDOWTEXT = 8
Public Const ODS_FOCUS = &H10
Public Const ODT_LISTBOX = 2
Public PrevWndProc As Long
I guess you could use MSFlexGrid/MSHFlexGrid control with only 1 column and GridLines properties set to 0 - flexGridNone.
To change fore color of a single grid cell use CellForeColor property.
Related
Helper:
<Extension()>
Public Function InputRow(Of TModel, TProperty)(ByVal helper As HtmlHelper(Of TModel),
ByVal exp1 As Expression(Of Func(Of TModel, TProperty)),
ByVal exp2 As Expression(Of Func(Of TModel, TProperty)),
ByVal exp3 As Expression(Of Func(Of TModel, TProperty)),
Optional cl As CL = Nothing,
Optional split As List(Of Integer) = Nothing) As MvcHtmlString
Dim expressions As New List(Of Expression(Of Func(Of TModel, TProperty))) From {expression1, expression2, expression3}
Return InputRow(helper, expressions, cl, split)
End Function
VBHTML:
#Html.InputRow(Function(x) Model.Test, Function(y) Model.Test1, Function(z) Model.Test2)
I don't understand TModel and TProperty very well and I can't find much on it. The issue I'm having is that variable Model.Test is an nullable Interger while Model.Test1 and Model.Test2 are nullable decimals.
When I try to get the metadata of Model.Test it throws an exception.
Get Metadata:
metaData = ModelMetadata.FromLambdaExpression(exp, helper.ViewData)
Exception:
System.InvalidOperationException: 'Templates can be used only with field access, property access, single-dimension array index, or single-parameter custom indexer expressions.'
Behind the scenes it's trying to convert the Integer? to a Decimal?, but I don't know why. The Model.Test expression is:
{x => Convert(value(ASP._Page_Views_Test_vbhtml).Model.Test)}
The value wrapped in the Convert is throwing the exception, but I don't know why it's getting wrapped in a convert. If I remove exp2 and exp3 from the method parameters. The convert doesn't happen.
Side Note:
Is it wrong to pass multiple expressions to one method? If not, is there a way to pass a list of TModel, TProperty expressions to the helper. Instead of having separate variables?
Thanks in advance for any assistance.
I think the issue here is that you want to pass multiple expressions of arbitrary type with only a single generic type parameter. Because there's only one TProperty, your three expressions have to involve properties of the same type, e.g. all String or all Integer. If you want to be able to use three different types then you need three different generic type parameters:
Public Function InputRow(Of TModel, TProperty1, TProperty2, TProperty3)(
helper As HtmlHelper(Of TModel),
exp1 As Expression(Of Func(Of TModel, TProperty1)),
exp2 As Expression(Of Func(Of TModel, TProperty2)),
exp3 As Expression(Of Func(Of TModel, TProperty3)),
Optional cl As CL = Nothing,
Optional split As List(Of Integer) = Nothing) As MvcHtmlString
From f# I'm trying to call a function on a C# defined object using a member constraint. Since the c# member function take multiple arguments the f# compiler treats it as a tuple but when applying the generic member constraint I get an error that the function takes 4 arguments but I've only supplied one.
I've tried forming the tuple from the arguments or just taking the pre-tupled set of arguments but both give the same error. I think I must be defining my member constraint incorrectly but there aren't a lot of examples of member constraints with multiple arguments.
let inline wrapForDecode (buffer:DirectBuffer) (offset:int) (blockLen:uint16) (version:uint16) : ^a =
let msg = new ^a()
(^a : (member WrapForDecode : (DirectBuffer*int*int*int)->unit) msg, (buffer, offset, (int blockLen), (int version)))
msg
let inline wrapForDecode2 (args :DirectBuffer*int*int*int) : ^a =
let msg = new ^a()
(^a : (member WrapForDecode : (DirectBuffer*int*int*int)->unit) (msg, args))
msg
The original WrapForDecode member function is defined in c# like:
public void WrapForDecode(DirectBuffer buffer, int offset, int actingBlockLength, int actingVersion) {...}
When I try to call the function I get the following error for either wrapForDecode or wrapForDecode2.
The member or object constructor 'WrapForDecode' takes 4 argument(s) but is here given 1. The required signature is 'MDInstrumentDefinitionFuture27.WrapForDecode(buffer: DirectBuffer, offset: int, actingBlockLength: int, actingVersion: int) : unit'.
If you change the type of WrapForDecode's argument from (DirectBuffer*int*int*int) to DirectBuffer*int*int*int the first inline method will compile:
let inline wrapForDecode (buffer:string)
(offset:int)
(blockLen:uint16)
(version:uint16)
: ^a =
let msg = new ^a()
(^a : (member WrapForDecode : string * int * int * int -> unit)
msg,
buffer,
offset,
(int blockLen),
(int version))
msg
type foo () =
member this.WrapForDecode (a : string, b: int, c: int, d:int) =
()
let x : foo = wrapForDecode "asd" 1 2us 3us
In ordinary F# code, the two signatures would be equivalent - all methods take a single argument, and to write a function with arity > 1 it must either be curried or take a tupled argument.
However, that is not how the CLI works - in C#/VB.Net land, foo1(x : bar, y : baz) has a different signature from foo2(xy : Tuple<bar, baz>).
Normally the F# compiler automatically translates between the two styles, and so when accessing non-F# .NET code from F# you will see both methods as taking a tupled argument.
But statically-resolved member constraints are a complicated and relatively fringe feature of F#, so it appears that this automatic translation isn't or cannot be performed when invoking methods this way.
(thanks to #ildjarn for pointing out the source of this difference)
Does Rascal support function pointers or something like this to do this like Java Interfaces?
Essentially I want to extract specific (changing) logic from a common logic block as separate functions. The to be used function is passed to the common block, which then call this function. In C we can do this with function pointers or with Interfaces in Java.
First I want to know how this general concept is called in the language design world.
I checked the Rascal Function Helppage, but this provide no clarification on this aspect.
So e.g. I have:
int getValue(str input) {
.... }
int getValue2(str input){
... }
Now I want to say:
WhatDatatype? func = getValue2; // how to do this?
Now I can pass this to an another function and then:
int val = invoke_function(func,"Hello"); // how to invoke?, and pass parameters and get ret value
Tx,
Jos
This page in the tutor has an example of using higher-order functions, which are the Rascal feature closest to function pointers:
http://tutor.rascal-mpl.org/Rascal/Rascal.html#/Rascal/Concepts/Functions/Functions.html
You can define anonymous (unnamed) functions, called closures in Java; assign them to variables; pass them as arguments to functions (higher-order functions); etc. Here is an example:
rascal>myfun = int(int x) { return x + 1; };
int (int): int (int);
rascal>myfun;
int (int): int (int);
rascal>myfun(3);
int: 4
rascal>int applyIntFun(int(int) f, int x) { return f(x); }
int (int (int), int): int applyIntFun(int (int), int);
rascal>applyIntFun(myfun,10);
int: 11
The first command defines an increment function, int(int x) { return x + 1; }, and assigns this to variable myfun. The rest of the code would work the same if instead this was
int myfun(int x) { return x + 1; }
The second command just shows the type, which is a function that takes and returns int. The third command calls the function with value 3, returning 4. The fourth command then shows a function which takes a function as a parameter. This function parameter, f, will then be called with argument x. The final command just shows an example of using it.
I'm trying to hide my P/Invoke functions, like this one:
[<DllImport("kernel32.dll", SetLastError=true)>]
extern bool private CreateTimerQueueTimer(IntPtr& phNewTimer, nativeint TimerQueue, WaitOrTimerDelegate Callback, nativeint Parameter, uint32 DueTime, uint32 Period, ExecuteFlags Flags)
Strangely, though, the private gets ignored -- which is really annoying, because I want to hide all the unwieldy structs and enums associated with these functions.
I guess I could put everything in a private module, so it's not too big of a deal, but am I missing something?
This will do the job.
module a =
[<AbstractClass>]
type private NativeMethods() =
[<DllImport("kernel32.dll", EntryPoint="CreateTimerQueueTimer",
SetLastError=true)>]
static extern bool sCreateTimerQueueTimer( (* whatever *) )
static member CreateTimerQueueTimer = sCreateTimerQueueTimer
let usedInside = NativeMethods.CreateTimerQueueTimer
module b =
open a
// the next line fails to compile
let usedOutside = NativeMethods.CreateTimerQueueTimer( (* whatever *) )
Notes:
private class can be accessed only from the enclosing module, this is what you need, so just wrap the methods in a NativeMethods class;
You cannot set your extern method private since it wouldn't be accessible from the rest of module a;
extern member of a class is always private, so there's another method with same signature;
Finally, use EntryPoint to resolve naming.
I want define constant with records where one variable is class.
And receive error:
[DCC Error] usample.pas(18): E2026 Constant expression expected
Class and record declaration in Unit1:
type TParentClass = class (TObject)
function Call(s: string) : boolean;
end;
type TMyRecord = record
s: string;
c: TParentClass; //or TClass
end;
And Unit2 with Child Class and record:
type TChildClass = class (TParentClass);
procedure two;
var:
class_var: TChildClass;
const
rec_var : array[0..1] of TMyRecord = (
(s : ''; c : class_var) //Error with class_var.
);
UPD: I want to fill record with Class and in unit1 search functions in this Class. Its a team project.
UPD2:
const
class_var: TChildClass = nil;
Same error.
Because as the compiler says, you have to put a constant in there, but you defined class_var as a variable.
Change class_var to be declared as a constant, not a variable.
But this cannot actually be done:
const
class_var = TParentClass;
is not allowed.
And
const
class_var : TClass = TParentClass;
is not a real constant and you cannot use it inside another constant declaration.
In your latest update you ask why this does not compile:
const
class_var: TChildClass = nil;
rec_var: TMyRecord = (s: ''; c: class_var);
The reason that does not compile is that class_var is not a true constant. You can write it like this:
rec_var: TMyRecord = (s: ''; c: nil);
because nil is a true constant.
I'm struggling to get a handle on what you are really trying to do, but my instincts tell me that a constant is not what you need. I think you are going to need to use variables that are initialized at startup.
You cannot define a const with a field initialized to the content of a variable. The compiler needs to evaluate consts at compile time, ie when class_var does not even have a location, never mind any content.
Forget this idea. If you can, declare rec_var as a variable and load it up at runtime.