Ako vo Visual Delphi pridelit k dajakej hodnote obrazok ???
Mam na mysli listbox . V listboxe napisem napr. cislo 1000 a objavy sa mi dakde obrazok co je ku tomuto cislu pridelene . Ako to urobit ???
Printable View
Ako vo Visual Delphi pridelit k dajakej hodnote obrazok ???
Mam na mysli listbox . V listboxe napisem napr. cislo 1000 a objavy sa mi dakde obrazok co je ku tomuto cislu pridelene . Ako to urobit ???
Nikto nevie poradit ???
To se tezko radi, kdyz je dotaz tak neurcity. Jak jsou ty obrazky velke a kolik jich tak asi je ?
Resit to lze samozrejme mnoha zpusoby - zalezi taky na tom, kde ty obrazky budes mit ulozene - jako soubory na disku, v resources, v databazi nebo treba v TImageListu.
Obrazky budu ulozene v Image Listu a program ich bude brat odtial .
Obrazok je asi 1000 . Ked napisem do listboxu dajaku hodnotu a dam enter tak aby mi to hodilo ten obrazek kterej je ku nemu prideleny .
Cize ked dam napr. cislo 50 tak aby sa mi ukazal obrazok co je prideleny na cislo 50 .
Len neviem prist na to ze k dajakej hodnote ako pridelit obrazok :(
Musis si urobit obsluhu udalosti OnChange toho listboxu. Tam naprogramujes nakopirovanie bitmapy do Image (ten image si tam naklikaj).
OK thx skusim a uvidim co sa mi podarilo :)
:( Kde ten OnChange toho listboxu prestne najdem ??? Neviem sa tam dajak doklikat :(
Pozeram na to - fakt to nema OnChange ;D Takze asi OnClick.
No fakt si neviem poradit hoci som cital aj Help :(
Pls dakt popiste mi postup ako sa to ma robit lebo som total lama :oops:
Fakt nikto nevie ???
PLS help
Pokud chces pouze nastrkat obrazky do listboxu pak můzes:
1/ podivat se na ondraw demo (imagelist ma i vlastni kreslici prikazy)
nebo
2/ najit hotovou komponentu (a jsou takovych mraky treba tady http://www.torry.net/enhancedlistandcomboboxes.htm)
nebo
3/ pouzit listview (umi vic nez listbox)
nebo
4/ zvolit nejakou alternativu ulozeni (treba PicClip z RxLib, je vlastne obdobou imagelistu)
nebo
5/ zkusit neco podobneho tomuto viz
Kód://=========================================================================
// EnhComboBox, ImgComboBox Components for Delphi 4
// Author: Norbert ADAMKO
// e-mail: norris@frdsa.utc.sk
// Copyright 1999
//=========================================================================
unit EnhCBox;
interface
uses Windows, Messages, Classes, Forms, Controls, Graphics, StdCtrls,
ImgList;
type
TEnhComboState = set of (csButtonPressed, csMousePressed);
TCustomEnhComboBox = class(TCustomComboBox)
private
FOldColor: TColor;
FOldParentColor: boolean;
FButtonWidth: integer;
FEditState: TEnhComboState;
FMouseInControl: boolean;
FAlwaysShowBorder: boolean;
FAutoDropDownWidth: boolean;
FAutoHorizontalScroll: boolean;
FButtonStaysPushed: boolean;
FDropDownWidth: integer;
FExtendedInterface: boolean;
FFlat: boolean;
FHorizontalExtent: integer;
FShowBorderWhenInactive: boolean;
FToolTip: boolean;
FOnCloseUp: TNotifyEvent;
procedure SetFlat(const Value: boolean);
function GetDropDownWidth: integer;
procedure SetDropDownWidth(const Value: integer);
function GetHorizExtent: integer;
procedure SetHorizExtent(const Value: integer);
function GetExUI: boolean;
procedure SetExUI(const Value: boolean);
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
procedure WMLButtonDown(var Message: TWMMouse); message WM_LBUTTONDOWN;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure TrackButtonPressed(X, Y: integer);
function InsideCombo(X,Y: integer): boolean;
function NeedDraw3DBorder: boolean;
procedure DrawButton(DC: HDC);
procedure DrawButtonBorder(DC: HDC);
procedure DrawControlBorder(DC: HDC);
procedure DrawBorders;
procedure SetAutoDropDownWidth(const Value: boolean);
procedure SetAutoHorizontalScroll(const Value: boolean);
procedure SetAlwaysShowBorder(const Value: boolean);
protected
procedure DoCloseUp; dynamic;
function ItemSize(paDC: hDC; paIndex: Integer; paInEdit: boolean): TSize; virtual;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure DestroyWnd; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
procedure DropDown;override;
property AlwaysShowBorder: boolean read FAlwaysShowBorder write SetAlwaysShowBorder default false;
property AutoDropDownWidth: boolean read FAutoDropDownWidth write SetAutoDropDownWidth default false;
property AutoHorizontalScroll: boolean read FAutoHorizontalScroll write SetAutoHorizontalScroll default false;
property ButtonStaysPushed: boolean read FButtonStaysPushed
write FButtonStaysPushed default false;
property DropDownWidth: integer read GetDropDownWidth write SetDropDownWidth;
property ExtendedInterface: boolean read GetExUI write SetExUI default false;
property Flat: boolean read FFlat write SetFlat default true;
property HorizontalExtent: integer read GetHorizExtent write SetHorizExtent;
property ShowBorderWhenInactive: boolean read FShowBorderWhenInactive
write FShowBorderWhenInactive default false;
property ToolTip: boolean read FToolTip write FToolTip default false;
property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
public
constructor Create(AOwner: TComponent); override;
end;
TEnhComboBox = class(TCustomEnhComboBox)
published
property Style; //Must be first
property Flat;
property AlwaysShowBorder;
{$IFDEF VER120}
property Anchors;
property AutoDropDownWidth;
property AutoHorizontalScroll;
property BiDiMode;
property ButtonStaysPushed;
property Constraints;
{$ENDIF}
property Color;
property Ctl3D;
property DragCursor;
{$IFDEF VER120}
property DragKind;
{$ENDIF}
property DragMode;
property DropDownCount;
property DropDownWidth;
property Enabled;
property ExtendedInterface;
property Font;
{$IFNDEF VER90}
property ImeMode;
property ImeName;
{$ENDIF}
property ItemHeight;
property Items;
property HorizontalExtent;
property MaxLength;
{$IFDEF VER120}
property ParentBiDiMode;
{$ENDIF}
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowBorderWhenInactive;
property ShowHint;
property Sorted;
property TabOrder;
property TabStop;
property Text;
property Tooltip;
property Visible;
property OnChange;
property OnCloseUp;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
property OnDropDown;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
property OnStartDrag;
{$IFDEF VER120}
property OnEndDock;
property OnStartDock;
{$ENDIF}
end;
//---TImgComboBox-----------------------------------------------------------
TEnhComboItem = class
private
Indent: byte;
ImageIndex: integer;
SelectedIndex: integer;
OverlayIndex: integer;
constructor Create;
end;
TCustomImgComboBox = class(TCustomEnhComboBox)
private
FChangeLink: TChangeLink;
FInEdit: boolean;
FImages: TCustomImageList;
FIndent: byte;
FEnhItems: TList;
procedure CBAddString(var Message: TMessage); message CB_ADDSTRING;
procedure CBInsertString(var Message: TMessage); message CB_INSERTSTRING;
procedure CBDeleteString(var Message: TMessage); message CB_DELETESTRING;
procedure CBResetContent(var Message: TMessage); message CB_RESETCONTENT;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
protected
function ItemSize(paDC: hDC; paIndex: integer; paInEdit: boolean): TSize; override;
procedure SetImages(Value: TCustomImageList);
function GetImageIndex(Index: Integer): integer;
procedure SetImageIndex(Index: Integer; const Value: integer);
function GetSelectedIndex(Index: Integer): integer;
procedure SetSelectedIndex(Index: Integer; const Value: integer);
function GetOverlayIndex(Index: integer): integer;
procedure SetOverlayIndex(Index: integer; const Value: integer);
function GetIndentLevel(Index: Integer): byte;
procedure SetIndentLevel(Index: Integer; const Value: byte);
procedure SetIndent(const Value: byte);
procedure SetStyle(Value: TComboBoxStyle);override;
procedure DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState); override;
procedure ImageListChange(Sender: TObject);
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
property Images: TCustomImageList read FImages write SetImages;
property Indent: byte read FIndent write SetIndent default 8;
property IndentLevel[Index: integer]: byte read GetIndentLevel write SetIndentLevel;
property ImageIndex[Index: integer]: integer read GetImageIndex write SetImageIndex;
property SelectedIndex[Index: integer]: integer read GetSelectedIndex write SetSelectedIndex;
property OverlayIndex[Index: integer]: integer read GetOverlayIndex write SetOverlayIndex;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function AddItem(paCaption: string; paData: pointer = nil;
paImage: integer = -1; paIndent: byte = 0;
paSelectedImage: integer = -1; paOverlayImage: integer = -1): integer;
procedure InsertItem(paIndex: integer; paCaption: string; paData: pointer = nil;
paImage: integer = -1; paIndent: byte = 0;
paSelectedImage: integer = -1; paOverlayImage: integer = -1);
end;
TImgComboBox = class(TCustomImgComboBox)
published
property Style;
property Flat;
property AlwaysShowBorder;
{$IFDEF VER120}
property Anchors;
property AutoDropDownWidth;
property AutoHorizontalScroll;
property BiDiMode;
property ButtonStaysPushed;
property Constraints;
{$ENDIF}
property Color;
property Ctl3D;
property DragCursor;
{$IFDEF VER120}
property DragKind;
{$ENDIF}
property DragMode;
property DropDownCount;
property DropDownWidth;
property Enabled;
property ExtendedInterface;
property Font;
property Images;
{$IFNDEF VER90}
property ImeMode;
property ImeName;
{$ENDIF}
property ItemHeight;
property Items;
property HorizontalExtent;
property MaxLength;
{$IFDEF VER120}
property ParentBiDiMode;
{$ENDIF}
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowBorderWhenInactive;
property ShowHint;
property Sorted;
property TabOrder;
property TabStop;
property Text;
property Tooltip;
property Visible;
property OnChange;
property OnCloseUp;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
property OnDropDown;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
property OnStartDrag;
{$IFDEF VER120}
property OnEndDock;
property OnStartDock;
{$ENDIF}
public
property ImageIndex;
property IndentLevel;
property OverlayIndex;
property SelectedIndex;
end;
THackImageList = class(TCustomImageList);
procedure Register;
implementation
uses SysUtils, CommCtrl, Consts;
//---TCustomEnhComboBox----------------------------------------------------
constructor TCustomEnhComboBox.Create(AOwner: TComponent);
begin
inherited;
FAlwaysShowBorder := false;
FAutoDropDownWidth := false;
FAutoHorizontalScroll := false;
FButtonWidth := GetSystemMetrics(SM_CXVSCROLL) + 1;
FFlat := true;
FButtonStaysPushed := false;
FShowBorderWhenInactive := false;
FOldColor := Color;
FOldParentColor := ParentColor;
FToolTip := false;
end;
procedure TCustomEnhComboBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
Style := Style or WS_HSCROLL;
end;
procedure TCustomEnhComboBox.CreateWnd;
begin
inherited CreateWnd;
DropDownWidth := FDropDownWidth;
ExtendedInterface := FExtendedInterface;
HorizontalExtent := FHorizontalExtent;
end;
procedure TCustomEnhComboBox.DestroyWnd;
begin
FDropDownWidth := DropDownWidth;
FHorizontalExtent := HorizontalExtent;
FExtendedInterface := ExtendedInterface;
inherited DestroyWnd;
end;
//---Property Access Methods-------------------------------------------------
procedure TCustomEnhComboBox.SetFlat(const Value: boolean);
begin
if Value <> FFlat then
begin
FFlat := Value;
Ctl3D := not Value;
Invalidate;
end;
end;
procedure TCustomEnhComboBox.SetDropDownWidth(const Value: integer);
begin
if DroppedDown then DroppedDown := false;
Perform(CB_SETDROPPEDWIDTH, Value, 0);
end;
function TCustomEnhComboBox.GetDropDownWidth: integer;
begin
Result := Perform(CB_GETDROPPEDWIDTH, 0, 0);
if Result<Width then Result := Width;
FDropDownWidth := Result;
end;
procedure TCustomEnhComboBox.SetHorizExtent(const Value: integer);
begin
if DroppedDown then DroppedDown := false;
Perform(CB_SETHORIZONTALEXTENT, Value, 0);
FHorizontalExtent := HorizontalExtent;
end;
function TCustomEnhComboBox.GetHorizExtent: integer;
begin
Result := Perform(CB_GETHORIZONTALEXTENT, 0, 0);
end;
function TCustomEnhComboBox.GetExUI: boolean;
begin
Result := boolean(Perform(CB_GETEXTENDEDUI, 0, 0));
end;
procedure TCustomEnhComboBox.SetExUI(const Value: boolean);
begin
Perform(CB_SETEXTENDEDUI, integer(Value), 0);
FExtendedInterface := ExtendedInterface;
end;
procedure TCustomEnhComboBox.SetAutoDropDownWidth(const Value: boolean);
begin
FAutoDropDownWidth := Value;
if FAutoDropDownWidth then FAutoHorizontalScroll := false;
end;
procedure TCustomEnhComboBox.SetAutoHorizontalScroll(const Value: boolean);
begin
FAutoHorizontalScroll := Value;
if FAutoHorizontalScroll then FAutoDropDownWidth := false;
end;
procedure TCustomEnhComboBox.SetAlwaysShowBorder(const Value: boolean);
begin
if FAlwaysShowBorder <> Value then
begin
FAlwaysShowBorder := Value;
Invalidate;
end;
end;
//--- Message Handlers-------------------------------------------------------
procedure TCustomEnhComboBox.DoCloseUp;
begin
if Assigned(FOnCloseUp) then FOnCloseUp(Self);
end;
procedure TCustomEnhComboBox.DropDown;
var DC: HDC;
OldFont: HFONT;
Size: TSize;
MaxLen, i: integer;
begin
inherited;
if FAutoHorizontalScroll or FAutoDropDownWidth then
begin
DC := CreateCompatibleDC(0);
OldFont := SelectObject(DC, Font.Handle);
MaxLen := 0;
try
for i:=0 to Items.Count-1 do
begin
Size := ItemSize(DC, i, false);
if Size.cx>MaxLen then MaxLen := Size.cx;
end;
finally
SelectObject(DC, OldFont);
DeleteDC(DC);
end;
if FAutoDropDownWidth then
if Items.Count>DropDownCount then
DropDownWidth := MaxLen + GetSystemMetrics(SM_CXVSCROLL) + 8
else
DropDownWidth := MaxLen + 8;
if FAutoHorizontalScroll then HorizontalExtent := MaxLen + 8;
end;
end;
procedure TCustomEnhComboBox.CMEnter(var Message: TCMEnter);
begin
inherited;
if not (csDesigning in ComponentState) then DrawBorders;
end;
procedure TCustomEnhComboBox.CMExit(var Message: TCMExit);
begin
inherited;
if not (csDesigning in ComponentState) then
begin
FMouseInControl := false;
DrawBorders;
end;
end;
procedure TCustomEnhComboBox.CMEnabledChanged(var Msg: TMessage);
begin
inherited;
if FFlat then
if Enabled then
begin
Color := FOldColor;
ParentColor := FOldParentColor;
end
else
begin
FOldParentColor := ParentColor;
FOldColor := Color;
ParentColor := True;
end;
end;
procedure TCustomEnhComboBox.WMLButtonDown(var Message: TWMMouse);
begin
//Uncapture the mouse - ComboBox is focused now
//Mouse was captured when entering ComboBox
//We should set the csButtonPressed here - before Delphi drops down the combo
//This makes the button look like it is being pushed down
MouseCapture := false;
if (Style>csDropDown) then
Include(FEditState, csButtonPressed) //Button should go down even when clicked in edit control
else
TrackButtonPressed(Message.Pos.X, Message.Pos.Y);
inherited;
end;
procedure TCustomEnhComboBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: integer);
begin
if DroppedDown then
begin
MouseCapture := true;
Include(FEditState, csMousePressed);
end;
inherited;
end;
procedure TCustomEnhComboBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: integer);
begin
MouseCapture := false;
if not FButtonStaysPushed then
begin
Exclude(FEditState, csMousePressed);
TrackButtonPressed(-1, -1);
end;
inherited;
end;
procedure TCustomEnhComboBox.MouseMove(Shift: TShiftState; X, Y: integer);
begin
//Repaint button if the mouse is captured and is positioned over the button
if FFlat then
begin
if csMousePressed in FEditState then TrackButtonPressed(X, Y);
if Enabled then
begin
//Leaving ComboBox
if MouseCapture and not(InsideCombo(X, Y))then
begin
FMouseInControl := false;
DrawBorders;
//if mouse button is not pressed inside combo, then uncapture
if not (csMousePressed in FEditState) then
MouseCapture := false;
Exit;
end;
//Entering ComboBox
if not MouseCapture and InsideCombo(X, Y) then
begin
if FToolTip then
begin
//Should we show the hint window?
if ItemSize(0, ItemIndex, true).cx>Width-FButtonWidth then
begin
Hint := Items[ItemIndex];
end
else
Hint := '';
end;
FMouseInControl := true;
Exclude(FEditState, csMousePressed);
Exclude(FEditState, csButtonPressed);
DrawBorders;
MouseCapture := true;
end;
end;
end;
inherited;
end;
procedure TCustomEnhComboBox.CNCommand(var Message: TWMCommand);
begin
case Message.NotifyCode of
CBN_CLOSEUP:
begin
Exclude(FEditState, csButtonPressed);
TrackButtonPressed(-1, -1);
DoCloseUp;
end;
CBN_KILLFOCUS:
begin
if not FShowBorderWhenInactive then DrawBorders;
end;
CBN_SETFOCUS:
begin
if not FShowBorderWhenInactive then DrawBorders;
end;
end;
inherited;
end;
procedure TCustomEnhComboBox.WMPaint(var Message: TWMPaint);
var DC: HDC;
PS: TPaintStruct;
HelpRect: TRect;
begin
if (not FFlat) then
inherited
else
begin
if Message.DC=0 then DC := BeginPaint(Handle, PS)
else DC := Message.DC;
try
if Style<>csSimple then
begin
//Clip the region - do not let windows paint in border and button areas
GetWindowRect(Handle, HelpRect);
OffsetRect(HelpRect, -HelpRect.Left, -HelpRect.Top);
InflateRect(HelpRect, -2, -2);
Dec(HelpRect.Right, FButtonWidth-1);
IntersectClipRect(DC, HelpRect.Left, HelpRect.Top, HelpRect.Right, HelpRect.Bottom);
end;
//Paint Windows Control
PaintWindow(DC);
finally
if Message.DC=0 then EndPaint(Handle, PS);
end;
//Make Combo look flat
DrawBorders;
end;
end;
//---Help Routines----------------------------------------------------------
function TCustomEnhComboBox.ItemSize(paDC: hDC; paIndex: integer; paInEdit: boolean): TSize;
var DC: HDC;
OldFont: HFONT;
begin
if paIndex=-1 then
begin
Result.cx := 0;
Result.cy := 0;
end
else
begin
if paDC=0 then
begin
DC := CreateCompatibleDC(0);
OldFont := SelectObject(DC, Font.Handle);
end
else
begin
DC := paDC;
OldFont := 0;
end;
try
GetTextExtentPoint32(DC, PChar(Items[paIndex]), Length(Items[paIndex]), Result);
finally
if paDC=0 then
begin
SelectObject(DC, OldFont);
DeleteDC(DC);
end;
end;
end;
end;
function TCustomEnhComboBox.NeedDraw3DBorder: boolean;
begin
if csDesigning in ComponentState then
Result := Enabled
else
Result := FAlwaysShowBorder or
((FMouseInControl or (Screen.ActiveControl = Self)) and
(ShowBorderWhenInactive or Application.Active));
end;
procedure TCustomEnhComboBox.TrackButtonPressed(X, Y: integer);
var HelpRect: TRect;
Pressed: boolean;
begin
SetRect(HelpRect, ClientWidth - FButtonWidth, 0, ClientWidth, ClientHeight);
Pressed := csButtonPressed in FEditState;
if PtInRect(HelpRect, Point(X, Y)) or (Pressed and FButtonStaysPushed) then
begin
Include(FEditState, csButtonPressed);
if not Pressed then DrawBorders; //Paint only if state was changed
end
else
begin
Exclude(FEditState, csButtonPressed);
if Pressed or FButtonStaysPushed then DrawBorders;
end;
end;
//Check if the mouse is in ComboBox area
function TCustomEnhComboBox.InsideCombo(X, Y: integer): boolean;
begin
Result := PtInRect(Rect(0, 0, Width, Height), Point(X, Y));
end;
//---Drawing Methods--------------------------------------------------------
procedure TCustomEnhComboBox.DrawButton(DC: HDC);
var HelpRect: TRect;
begin
GetWindowRect(Handle, HelpRect);
OffsetRect(HelpRect, -HelpRect.Left, -HelpRect.Top);
Inc(HelpRect.Left, ClientWidth - FButtonWidth);
//Make the button appear pushed
if csButtonPressed in FEditState then
DrawFrameControl(DC, HelpRect, DFC_SCROLL, DFCS_SCROLLCOMBOBOX or DFCS_FLAT or DFCS_PUSHED)
else
DrawFrameControl(DC, HelpRect, DFC_SCROLL, DFCS_SCROLLCOMBOBOX or DFCS_FLAT);
ExcludeClipRect(DC, ClientWidth - FButtonWidth - 1, 0, ClientWidth, ClientHeight);
end;
procedure TCustomEnhComboBox.DrawButtonBorder(DC: HDC);
var HelpRect, HelpRect2: TRect;
BtnFaceBrush: HBRUSH;
begin
GetWindowRect(Handle, HelpRect);
OffsetRect(HelpRect, -HelpRect.Left, -HelpRect.Top);
Inc(HelpRect.Left, ClientWidth - FButtonWidth - 2);
InflateRect(HelpRect, -2, -2);
if NeedDraw3DBorder then
begin
BtnFaceBrush := CreateSolidBrush(GetSysColor(COLOR_BTNFACE));
try
//Clear the line to the left of the button
HelpRect2 := HelpRect;
with HelpRect2 do
begin
Right := Left;
Dec(Left);
FillRect(DC, HelpRect2, Brush.Handle);
end;
//Draw single line to the left of the button (clBtnFace)
//There should be better way how to do this
HelpRect2 := HelpRect;
with HelpRect2 do
begin
Right := Left + 1;
FillRect(DC, HelpRect2, BtnFaceBrush);
end;
Inc(HelpRect.Left, 1);
//Draw Button Edge
if csButtonPressed in FEditState then
begin
DrawEdge(DC, HelpRect, BDR_SUNKENOUTER, BF_RECT or BF_MIDDLE);
end
else
begin
DrawEdge(DC, HelpRect, BDR_RAISEDINNER, BF_RECT or BF_MIDDLE);
end;
finally
DeleteObject(BtnFaceBrush);
end;
end
else
begin
BtnFaceBrush := CreateSolidBrush(GetSysColor(COLOR_BTNFACE));
try
//Clear the line to the left of the button
InflateRect(HelpRect, -1, -1);
HelpRect2 := HelpRect;
with HelpRect2 do
begin
Right := Left + 2;
Dec(Left, 2);
FillRect(DC, HelpRect2, Brush.Handle);
end;
//Gray out the region
Inc(HelpRect.Left, 1);
FillRect(DC, HelpRect, BtnFaceBrush);
finally
DeleteObject(BtnFaceBrush);
end;
end;
//ExcludeClipRect(DC, HelpRect.Left, HelpRect.Top, HelpRect.Right, HelpRect.Bottom);
//Clip the borders, so we can paint the button with arrow
IntersectClipRect(DC, HelpRect.Left + 2, HelpRect.Top + 1,
HelpRect.Right - 1, HelpRect.Bottom - 1);
DrawButton(DC);
end;
procedure TCustomEnhComboBox.DrawControlBorder(DC: HDC);
var HelpRect: TRect;
BtnFaceBrush, WindowBrush: HBRUSH;
begin
BtnFaceBrush := CreateSolidBrush(GetSysColor(COLOR_BTNFACE));
WindowBrush := CreateSolidBrush(GetSysColor(COLOR_WINDOW));
try
GetWindowRect(Handle, HelpRect);
OffsetRect(HelpRect, -HelpRect.Left, -HelpRect.Top);
if NeedDraw3DBorder then
begin
DrawEdge(DC, HelpRect, BDR_SUNKENOUTER, BF_RECT or BF_ADJUST);
FrameRect(DC, HelpRect, BtnFaceBrush);
InflateRect(HelpRect, -1, -1);
FrameRect(DC, HelpRect, WindowBrush);
end
else
begin
FrameRect(DC, HelpRect, BtnFaceBrush);
InflateRect(HelpRect, -1, -1);
FrameRect(DC, HelpRect, BtnFaceBrush);
InflateRect(HelpRect, -1, -1);
FrameRect(DC, HelpRect, WindowBrush);
end;
finally
DeleteObject(WindowBrush);
DeleteObject(BtnFaceBrush);
end;
end;
procedure TCustomEnhComboBox.DrawBorders;
var DC: HDC;
begin
if (FFlat) and (Style <> csSimple) then
begin
DC := GetWindowDC(Handle);
try
DrawControlBorder(DC);
DrawButtonBorder(DC);
finally
ReleaseDC(Handle, DC);
end;
end;
end;
//---TEnhComboItem-----------------------------------------------------------
constructor TEnhComboItem.Create;
begin
ImageIndex := -1;
SelectedIndex := -1;
OverlayIndex := -1;
end;
//---TCustomImgComboBox-----------------------------------------------------
constructor TCustomImgComboBox.Create(AOwner: TComponent);
begin
inherited;
FIndent := 8;
ItemHeight := 16;
Style := csOwnerDrawFixed;
FEnhItems := TList.Create;
FChangeLink := TChangeLink.Create;
FChangeLink.OnChange := ImageListChange;
end;
destructor TCustomImgComboBox.Destroy;
var i: integer;
begin
for i:=0 to FEnhItems.Count-1 do
tEnhComboItem(FEnhItems[i]).Free;
FEnhItems.Free;
FChangeLink.Free;
inherited;
end;
//---Message Handlers------------------------------------------------------
procedure TCustomImgComboBox.CNDrawItem(var Message: TWMDrawItem);
var State: TOwnerDrawState;
begin
with Message.DrawItemStruct^ do
begin
State := TOwnerDrawState(byte(LongRec(itemState).Lo));
FInEdit := (ODS_COMBOBOXEDIT and itemState)>0;
Canvas.Handle := hDC;
Canvas.Font := Font;
Canvas.Brush := Brush;
Canvas.FillRect(rcItem);
if (Integer(itemID) >= 0) and (odSelected in State) then
begin
Canvas.Brush.Color := clHighlight;
Canvas.Font.Color := clHighlightText
end;
if Integer(itemID) >= 0 then
DrawItem(itemID, rcItem, State)
else
Canvas.FillRect(rcItem);
Canvas.Handle := 0;
end;
end;
procedure TCustomImgComboBox.CBAddString(var Message: TMessage);
begin
inherited;
FEnhItems.Insert(Message.Result, TEnhComboItem.Create);
end;
procedure TCustomImgComboBox.CBInsertString(var Message: TMessage);
begin
inherited;
FEnhItems.Insert(Message.Result, TEnhComboItem.Create);
end;
procedure TCustomImgComboBox.CBDeleteString(var Message: TMessage);
begin
TEnhComboItem(FEnhItems[Message.wParam]).Free;
FEnhItems.Delete(Message.wParam);
inherited;
end;
procedure TCustomImgComboBox.CBResetContent(var Message: TMessage);
var i: integer;
begin
for i:=0 to FEnhItems.Count-1 do TEnhComboItem(FEnhItems[i]).Free;
FEnhItems.Clear;
inherited;
end;
//---Property Access Methods-------------------------------------------------
function TCustomImgComboBox.GetImageIndex(Index: Integer): integer;
begin
Result := TEnhComboItem(FEnhItems[Index]).ImageIndex;
end;
procedure TCustomImgComboBox.SetImageIndex(Index: Integer;
const Value: Integer);
begin
if TEnhComboItem(FEnhItems[Index]).ImageIndex <> Value then
begin
TEnhComboItem(FEnhItems[Index]).ImageIndex := Value;
Invalidate;
end;
end;
function TCustomImgComboBox.GetSelectedIndex(Index: Integer): integer;
begin
Result := TEnhComboItem(FEnhItems[Index]).SelectedIndex;
end;
procedure TCustomImgComboBox.SetSelectedIndex(Index: Integer;
const Value: Integer);
begin
if TEnhComboItem(FEnhItems[Index]).SelectedIndex <> Value then
begin
TEnhComboItem(FEnhItems[Index]).SelectedIndex := Value;
Invalidate;
end;
end;
function TCustomImgComboBox.GetOverlayIndex(Index: integer): integer;
begin
Result := TEnhComboItem(FEnhItems[Index]).OverlayIndex;
end;
procedure TCustomImgComboBox.SetOverlayIndex(Index: integer;
const Value: integer);
begin
if TEnhComboItem(FEnhItems[Index]).OverlayIndex <> Value then
begin
TEnhComboItem(FEnhItems[Index]).OverlayIndex := Value;
Invalidate;
end;
end;
function TCustomImgComboBox.GetIndentLevel(Index: Integer): byte;
begin
Result := TEnhComboItem(FEnhItems[Index]).Indent;
end;
procedure TCustomImgComboBox.SetIndentLevel(Index: Integer;
const Value: byte);
begin
if TEnhComboItem(FEnhItems[Index]).Indent <> Value then
begin
TEnhComboItem(FEnhItems[Index]).Indent := Value;
if DroppedDown then Invalidate;
end;
end;
procedure TCustomImgComboBox.SetIndent(const Value: byte);
begin
if FIndent <> Value then
begin
FIndent := Value;
if DroppedDown then Invalidate;
end;
end;
procedure TCustomImgComboBox.SetImages(Value: TCustomImageList);
begin
if Images <> nil then Images.UnRegisterChanges(FChangeLink);
FImages := Value;
if Images <> nil then
begin
Images.RegisterChanges(FChangeLink);
Images.FreeNotification(Self);
ItemHeight := Images.Height;
end;
RecreateWnd;
end;
procedure TCustomImgComboBox.SetStyle(Value: TComboBoxStyle);
begin
if Value = csOwnerDrawFixed then
inherited SetStyle(Value);
end;
//---Other Methods----------------------------------------------------------
function TCustomImgComboBox.ItemSize(paDC: hDC; paIndex: Integer; paInEdit: boolean): TSize;
begin
Result := inherited ItemSize(paDC, paIndex, paInEdit);
if FImages<>nil then
Result.cx := Result.cx + FImages.Width;
if not paInEdit then
Result.cx := Result.cx + IndentLevel[paIndex]*Indent + 6;
end;
procedure TCustomImgComboBox.DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
const
DrawingStyles: array[TDrawingStyle] of integer = (ILD_FOCUS,
ILD_SELECTED, ILD_NORMAL, ILD_TRANSPARENT);
ImageTypes: array[TImageType] of integer = (0, ILD_MASK);
var DC: HDC;
OldFont: HFONT;
Size: TSize;
OldBlendColor: TColor;
DrawStyle: TDrawingStyle;
HelpRight, OldRight, HelpImageIndex, HelpOverlayIndex: integer;
begin
TControlCanvas(Canvas).UpdateTextFlags;
if Assigned(OnDrawItem) then
OnDrawItem(Self, Index, Rect, State)
else
begin
DC := CreateCompatibleDC(0);
OldFont := SelectObject(DC, Font.Handle);
try
GetTextExtentPoint32(DC, PChar(Items[Index]), Length(Items[Index]), Size);
finally
SelectObject(DC, OldFont);
DeleteDC(DC);
end;
OldRight := Rect.Right;
if not FInEdit then OffsetRect(Rect, FIndent*IndentLevel[Index], 0);
if FImages<>nil then
with FImages do
begin
OldBlendColor := BlendColor;
if odFocused in State then
begin
BlendColor := clHighlight;
DrawStyle := dsSelected;
HelpImageIndex := Self.SelectedIndex[Index];
end
else
begin
DrawStyle := dsTransparent;
HelpImageIndex := Self.ImageIndex[Index];
end;
if OverlayIndex[Index]=-1 then
begin
THackImageList(FImages).DoDraw(HelpImageIndex, Canvas,
Rect.Left + 2, Rect.Top,
DrawingStyles[DrawStyle] or ImageTypes[FImages.ImageType], Enabled);
end
else
begin
HelpOverlayIndex := IndexToOverlayMask(OverlayIndex[Index] + 1);
THackImageList(FImages).DoDraw(HelpImageIndex, Canvas,
Rect.Left + 2, Rect.Top,
DrawingStyles[DrawStyle] or ImageTypes[FImages.ImageType] or
ILD_OVERLAYMASK and HelpOverlayIndex, Enabled);
end;
BlendColor := OldBlendColor;
Rect.Left := Rect.Left + FImages.Width + 4;
end;
with Rect do
begin
HelpRight := Left + Size.cx + 4;
if OldRight>HelpRight then Right := HelpRight
else Right := OldRight;
end;
if Enabled then
//Needed only in ListBox
Canvas.FillRect(Rect)
else
begin
//Canvas.DoDraw changes this when drawing disabled images!!!
//Another Borland's bug?
Canvas.Brush.Color := Color;
Canvas.Font.Color := clBtnShadow;
end;
Canvas.TextOut(Rect.Left + 2, Rect.Top + 1, Items[Index]);
if odFocused in State then Canvas.DrawFocusRect(Rect);
end;
end;
procedure TCustomImgComboBox.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
begin
if AComponent = FImages then FImages := nil;
end;
end;
procedure TCustomImgComboBox.ImageListChange(Sender: TObject);
begin
if Sender = FImages then SetImages(FImages);
end;
function TCustomImgComboBox.AddItem(paCaption: string; paData: pointer;
paImage: Integer; paIndent: byte;
paSelectedImage: integer; paOverlayImage: integer): integer;
begin
Result := Items.AddObject(paCaption, paData);
with TEnhComboItem(FEnhItems[Result]) do
begin
ImageIndex := paImage;
Indent := paIndent;
if paSelectedImage<>-1 then SelectedIndex := paSelectedImage
else SelectedIndex := paImage;
end;
end;
procedure TCustomImgComboBox.InsertItem(paIndex: integer; paCaption: string;
paData: pointer; paImage: Integer; paIndent: byte;
paSelectedImage: integer; paOverlayImage: integer);
begin
Items.InsertObject(paIndex, paCaption, paData);
with TEnhComboItem(FEnhItems[paIndex]) do
begin
ImageIndex := paImage;
Indent := paIndent;
if paSelectedImage<>-1 then SelectedIndex := paSelectedImage
else SelectedIndex := paImage;
end;
end;
//---Register Procedure------------------------------------------------------
procedure Register;
begin
RegisterComponents('Additional', [TEnhComboBox, TImgComboBox]);
end;
end.