Archivado/Componentes.Terceros.jvcl
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
b40ce04eb4
Componentes.Terceros.jvcl/official/3.32/run/JvgAskListBox.pas

993 lines
27 KiB
ObjectPascal
Raw Blame History

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: JvgAskListBox.PAS, released on 2003-01-15.
The Initial Developer of the Original Code is Andrey V. Chudin, [chudin att yandex dott ru]
Portions created by Andrey V. Chudin are Copyright (C) 2003 Andrey V. Chudin.
All Rights Reserved.
Contributor(s):
Michael Beck [mbeck att bigfoot dott com].
Rob den Braasem [rbraasem att xs4all dott nl]
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net
Description:
ListBox-based component that provides convenient interface for
realization of the different tests for users. Component is very
useful during setup and install processes.
Items captions align in one of 9 positions. Component can display
glyphs on own items and fill background with bitmap. You can set
different fonts for selected item and for other list items.
Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvgAskListBox.pas 10612 2006-05-19 19:04:09Z jfudickar $
unit JvgAskListBox;
{$I jvcl.inc}
interface
uses
{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, CommCtrl, ExtCtrls,
{$IFDEF USEJVCL}
JVCLVer,
{$ENDIF USEJVCL}
JvgTypes, JvgCommClasses;
type
TglAskLBOption = (aloAutoScroll, aloIgnoreMouse, aloShowFocus,
aloTransparentButtons, aloWordWrap);
TglAskLBOptions = set of TglAskLBOption;
TJvgAskListBox = class(TCustomListBox)
private
{$IFDEF USEJVCL}
FAboutJVCL: TJVCLAboutInfo;
{$ENDIF USEJVCL}
FAutoTransparentColor: TglAutoTransparentColor;
FWallpaper: TBitmap;
FWallpaperImage: TImage;
FWallpaperOption: TglWallpaperOption;
FNumGlyphs: Word;
FGlyphsAlign: TJvg2DAlign;
FTextAlign: TJvg2DAlign;
FCaptionsAlign: TJvg2DAlign;
FTransparentColor: TColor;
FItemStyle: TJvgAskListBoxItemStyle;
FItemSelStyle: TJvgAskListBoxItemStyle;
FGlyphs: TImageList;
FShowWallpaper: Boolean;
FShowGlyphs: Boolean;
FItemHeight: Word;
FTextAlign_: UINT;
FCaptionsAlign_: UINT;
FShowText: Boolean;
FSegment1Width: Word;
FPushedButton: array[0..1023] of Byte;
FOnButtonClicked: TNotifyEvent;
FSelectedItem: Word;
FButtons: TStringList;
FButtonWidth: Word;
FOptions: TglAskLBOptions;
WallpaperBmp: TBitmap;
TmpBitmap: TBitmap;
BtnRect: TRect;
BtnTxtRect: TRect;
MouseClickPoint: TPoint;
procedure SetAutoTransparentColor(Value: TglAutoTransparentColor);
procedure SetWallpaper(Value: TBitmap);
function GetWallpaper: TBitmap;
procedure SetWallpaperImage(Value: TImage);
procedure SetWallpaperOption(Value: TglWallpaperOption);
procedure SetNumGlyphs(Value: Word);
procedure SetGlyphs(Value: TImageList);
procedure SetItemHeight(Value: Word);
procedure SetShowText(Value: Boolean);
procedure SetTransparentColor(Value: TColor);
procedure SetSelectedItem(Value: Word);
function GetButtons: TStrings;
procedure SetButtons(Value: TStrings);
procedure SetButtonWidth(Value: Word);
procedure SetOptions(Value: TglAskLBOptions);
procedure DrawWallpaper(R: TRect);
procedure DrawGlyph(R: TRect; Index: Word; Shift: Word);
procedure SetAlign(Align: TJvg2DAlign; var Align_: UINT);
procedure ButtonClicked;
procedure RecalcHeights;
procedure SmthChanged(Sender: TObject);
procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
procedure WMSize(var Msg: TWMSize); message WM_SIZE;
procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
procedure CNMeasureItem(var Msg: TWMMeasureItem); message CN_MEASUREITEM;
protected
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure InitState(var State: TOwnerDrawState; ByteState: Byte);
public
function IsFilled: Boolean;
function CountPushedButtonsInColon(Colon: Integer): Integer;
function GetPushedButtonInLine(Index: Word): Integer;
function SetPushedButtonInLine(Index: Word; Value: Word): Boolean;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{$IFDEF USEJVCL}
property AboutJVCL: TJVCLAboutInfo read FAboutJVCL write FAboutJVCL stored False;
{$ENDIF USEJVCL}
property Align;
property BorderStyle;
property Color;
property DragCursor;
property DragMode;
property Enabled;
property IntegralHeight;
property Items;
property ParentColor;
// property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Sorted;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
// property AfterItemWasDrown;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
property AutoTransparentColor: TglAutoTransparentColor
read FAutoTransparentColor write SetAutoTransparentColor default ftcLeftBottomPixel;
property Wallpaper: TBitmap read GetWallpaper write SetWallpaper;
property WallpaperImage: TImage read FWallpaperImage write SetWallpaperImage;
property WallpaperOption: TglWallpaperOption read FWallpaperOption write
SetWallpaperOption default fwoNone;
property NumGlyphs: Word read FNumGlyphs write SetNumGlyphs default 1;
property GlyphsAlign: TJvg2DAlign read FGlyphsAlign write FGlyphsAlign;
property ItemStyle: TJvgAskListBoxItemStyle read FItemStyle write FItemStyle;
property ItemSelStyle: TJvgAskListBoxItemStyle read FItemSelStyle write FItemSelStyle;
property Glyphs: TImageList read FGlyphs write SetGlyphs;
property TextAlign: TJvg2DAlign read FTextAlign write FTextAlign;
property ItemHeight: Word read FItemHeight write SetItemHeight default 12;
property ShowText: Boolean read FShowText write SetShowText default True;
property TransparentColor: TColor read FTransparentColor write SetTransparentColor;
property OnButtonClicked: TNotifyEvent read FOnButtonClicked write FOnButtonClicked;
property SelectedItem: Word read FSelectedItem write SetSelectedItem default 0;
property Buttons: TStrings read GetButtons write SetButtons;
property ButtonWidth: Word read FButtonWidth write SetButtonWidth default 30;
property Options: TglAskLBOptions read FOptions write SetOptions;
end;
{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
UnitVersioning: TUnitVersionInfo = (
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvgAskListBox.pas $';
Revision: '$Revision: 10612 $';
Date: '$Date: 2006-05-19 21:04:09 +0200 (ven., 19 mai 2006) $';
LogPath: 'JVCL\run'
);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}
implementation
uses
{$IFDEF USEJVCL}
JvConsts, JvJCLUtils, JvResources,
{$ENDIF USEJVCL}
JvgUtils;
{$IFNDEF USEJVCL}
resourcestring
RsYes = 'yes';
RsNo = 'no';
{$ENDIF !USEJVCL}
constructor TJvgAskListBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Style := lbOwnerDrawVariable;
FGlyphsAlign := TJvg2DAlign.Create;
FTextAlign := TJvg2DAlign.Create;
FCaptionsAlign := TJvg2DAlign.Create;
FButtons := TStringList.Create;
FItemStyle := TJvgAskListBoxItemStyle.Create;
FItemSelStyle := TJvgAskListBoxItemStyle.Create;
TmpBitmap := TBitmap.Create;
FButtons.Add(RsYes);
FButtons.Add(RsNo);
FAutoTransparentColor := ftcLeftBottomPixel;
FWallpaperOption := fwoNone;
FShowWallpaper := True;
FShowGlyphs := True;
if csDesigning in ComponentState then
begin
with FItemStyle do
begin
// Style := idsRaised;
Color := clBtnFace;
BtnColor := clBtnFace;
TextStyle := fstRaised;
BtnTextStyle := fstPushed;
end;
with FItemSelStyle do
begin
// Style := idsRaised;
Color := clBtnShadow;
BtnColor := clBtnFace;
TextStyle := fstRaised;
BtnTextStyle := fstPushed;
end;
end;
NumGlyphs := 1;
FTransparentColor := clOlive;
FItemHeight := 12;
FTextAlign_ := DT_LEFT or DT_WORDBREAK or DT_VCENTER; // or DT_SINGLELINE;
FCaptionsAlign_ := DT_CENTER or DT_VCENTER or DT_SINGLELINE;
FShowText := True;
FButtonWidth := 30;
FSelectedItem := 0;
FOptions := [aloWordWrap];
FItemStyle.OnChanged := SmthChanged;
FItemSelStyle.OnChanged := SmthChanged;
FGlyphsAlign.OnChanged := SmthChanged;
FTextAlign.OnChanged := SmthChanged;
FCaptionsAlign.OnChanged := SmthChanged;
FillChar(FPushedButton, SizeOf(FPushedButton), #0);
FWallpaper := nil;
end;
destructor TJvgAskListBox.Destroy;
begin
FWallpaper.Free;
TmpBitmap.Free;
FGlyphsAlign.Free;
FTextAlign.Free;
FCaptionsAlign.Free;
FButtons.Free;
FItemStyle.Free;
FItemSelStyle.Free;
inherited Destroy;
end;
procedure TJvgAskListBox.Loaded;
begin
inherited Loaded;
RecalcHeights;
end;
procedure TJvgAskListBox.CNMeasureItem(var Msg: TWMMeasureItem);
var
R: TRect;
begin
R.Left := 3;
R.Top := 0;
R.Bottom := 0;
R.Right := FSegment1Width;
if FShowGlyphs and (FGlyphs <> nil) then
Inc(R.Left, FGlyphs.Width);
Dec(R.Right, 5);
with Msg.MeasureItemStruct^ do
begin
DrawText(Canvas, Items[itemID],
Length(Items[itemID]), R, DT_CALCRECT or DT_WORDBREAK);
itemHeight := R.Bottom - R.Top + 6;
if itemHeight < FItemHeight then
itemHeight := FItemHeight;
end;
end;
procedure TJvgAskListBox.CNDrawItem(var Msg: TWMDrawItem);
const
w = 1;
var
Index: Integer;
Rect: TRect;
State: TOwnerDrawState;
fSelected: Boolean;
Shift, OldPushedBtn, I: Integer;
Rect1: TRect;
ItemStyle: TJvgAskListBoxItemStyle;
// TS: TglTextStyle;
// TA: UINT;
procedure DrawLBItem(ItemSt: TglItemsDrawStyle; R: TRect);
begin
case ItemSt of
idsRecessed:
begin
Shift := 0;
Frame3D(Canvas, R, clBtnShadow, clBtnHighlight, 1);
end;
idsRaised:
begin
Shift := 2;
Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, 1);
end;
end;
end;
procedure DrawTextInRect(Rect: TRect; Align: Word; StrListNum: Integer);
var
FontColor: TColor;
szStr: array[0..255] of Char;
Len: Word;
TextStyle: TglTextStyle;
begin
Dec(Rect.Right, 2);
// FillMemory(@szStr,255,0);
if StrListNum = -1 then
StrPCopy(szStr, Items[Index])
else
StrPCopy(szStr, Buttons[StrListNum - 1]);
Len := StrLen(szStr);
if StrListNum = -1 then
begin
Canvas.Font := ItemStyle.Font;
TextStyle := ItemStyle.TextStyle;
end
else
begin
Canvas.Font := ItemStyle.BtnFont;
if FPushedButton[Index] = StrListNum then
TextStyle := fstNone
else
TextStyle := ItemStyle.BtnTextStyle;
end;
FontColor := Canvas.Font.Color;
SetBkMode(Canvas.Handle, TRANSPARENT);
InflateRect(Rect, -1, -1);
if StrListNum <> -1 then
Inc(Rect.Top, 2);
case TextStyle of
fstRaised:
begin
Canvas.Font.Color := clBtnHighlight;
OffsetRect(Rect, -1, -1);
DrawText(Canvas, szStr, Len, Rect, Align);
Canvas.Font.Color := clBtnShadow;
OffsetRect(Rect, 2, 2);
DrawText(Canvas, szStr, Len, Rect, Align);
Canvas.Font.Color := FontColor;
OffsetRect(Rect, -1, -1);
DrawText(Canvas, szStr, Len, Rect, Align);
end;
fstRecessed:
begin
Canvas.Font.Color := clBtnShadow;
OffsetRect(Rect, -1, -1);
DrawText(Canvas, szStr, Len, Rect, Align);
Canvas.Font.Color := clBtnHighlight;
OffsetRect(Rect, 2, 2);
DrawText(Canvas, szStr, Len, Rect, Align);
Canvas.Font.Color := FontColor;
OffsetRect(Rect, -1, -1);
DrawText(Canvas, szStr, Len, Rect, Align);
end;
fstPushed:
begin
Canvas.Font.Color := clBtnHighlight;
DrawText(Canvas, szStr, Len, Rect, Align);
OffsetRect(Rect, -1, -1);
Canvas.Font.Color := clBtnShadow;
DrawText(Canvas, szStr, Len, Rect, Align);
end;
fstShadow:
begin
Canvas.Font.Color := clBtnShadow;
OffsetRect(Rect, 2, 2);
DrawText(Canvas, szStr, Len, Rect, Align);
Canvas.Font.Color := FontColor;
OffsetRect(Rect, -2, -2);
DrawText(Canvas, szStr, Len, Rect, Align);
end;
else
begin
Canvas.Font.Color := FontColor;
DrawText(Canvas, szStr, Len, Rect, Align);
end;
end;
end;
begin
with Msg.DrawItemStruct^ do
begin
Index := itemID;
if Index = -1 then
Exit;
InitState(State, WordRec(LongRec(ItemState).Lo).Lo);
// State := TOwnerDrawState(WordRec(LongRec(ItemState).Lo).Lo);
Canvas.Handle := hDC;
Rect := rcItem;
end;
Canvas.Brush := Brush;
// if State = [odSelected,odFocused] then Exit;
Canvas.FrameRect(Rect);
Inc(Rect.Top);
Inc(Rect.Left);
fSelected := (State = [odSelected, odFocused]) or (State = [odSelected]);
if fSelected then
begin
ItemStyle := FItemSelStyle;
Shift := 2;
end
else
begin
ItemStyle := FItemStyle;
Shift := 0;
end;
Canvas.Brush.Color := ItemStyle.Color;
Rect1 := Rect;
Rect1.Right := FSegment1Width;
if IsItAFilledBitmap(WallpaperBmp) then
begin
if aloTransparentButtons in Options then
DrawWallpaper(Rect)
else
DrawWallpaper(Rect1);
end
else
Canvas.FillRect(Rect1);
//DrawLBItem( idsRecessed, Rect1 );
DrawBoxEx(Canvas.Handle, Rect1, ItemStyle.Bevel.Sides, ItemStyle.Bevel.Inner,
ItemStyle.Bevel.Outer, ItemStyle.Bevel.Bold, 0, True);
if fSelected then
begin
InflateRect(Rect1, -1, -1);
Canvas.FillRect(Rect1);
InflateRect(Rect1, 1, 1);
end;
OldPushedBtn := FPushedButton[Index];
BtnRect := Rect;
BtnRect.Left := Rect1.Right + 2;
BtnRect.Right := BtnRect.Left + FButtonWidth;
Canvas.Brush.Color := ItemStyle.BtnColor;
for I := 1 to Buttons.Count do // draw buttons
begin
if PtInRectExclusive(BtnRect, MouseClickPoint) then
begin
if I = FPushedButton[Index] then
FPushedButton[Index] := 0 //...none pushed
else
FPushedButton[Index] := I;
end;
if not (aloTransparentButtons in Options) or
(not IsItAFilledBitmap(WallpaperBmp)) then
Canvas.FillRect(BtnRect);
BtnTxtRect := BtnRect;
if FPushedButton[Index] = I then
begin
DrawLBItem(idsRecessed, BtnRect);
OffsetRect(BtnTxtRect, 1, 1);
end
else
DrawLBItem(idsRaised, BtnRect);
//...button text
if FPushedButton[Index] = I then
ItemStyle.BtnFont.Style := [fsBold]
else
ItemStyle.BtnFont.Style := [];
DrawTextInRect(BtnTxtRect, FCaptionsAlign_ or DT_SINGLELINE, I);
Inc(BtnRect.Left, FButtonWidth + 1);
Inc(BtnRect.Right, FButtonWidth + 1);
end;
MouseClickPoint.X := -1;
MouseClickPoint.Y := 0;
Rect1.Left := 3;
Rect1.Right := FSegment1Width;
Inc(Rect1.Top);
Inc(Rect.Left);
Dec(Rect1.Bottom);
Dec(Rect.Right);
if (FShowGlyphs) and (FGlyphs <> nil) and
(FGlyphs.Width > 0) and (FGlyphs.Height > 0) then
begin
DrawGlyph(Rect, Index, Shift);
Rect1.Left := Rect1.Left + FGlyphs.Width;
end;
//...text
DrawTextInRect(Rect1, FTextAlign_, -1);
with Msg.DrawItemStruct^ do
if (odFocused in State) and (aloShowFocus in Options) then
DrawFocusRect(hDC, rcItem);
FSelectedItem := Index;
if OldPushedBtn <> FPushedButton[Index] then
ButtonClicked;
Canvas.Handle := 0;
end;
procedure TJvgAskListBox.DrawWallpaper(R: TRect);
var
X, Y, SaveIndex: Integer;
UpdateRgn: HRGN;
begin
X := 0;
Y := 0;
SaveIndex := SaveDC(Canvas.Handle);
UpdateRgn := CreateRectRgn(R.Left, R.Top, R.Right, R.Bottom);
SelectClipRgn(Canvas.Handle, UpdateRgn);
case WallpaperOption of
fwoStretch:
Canvas.StretchDraw(R, WallpaperBmp);
fwoTile:
while X < R.Right - R.Left do
begin
while Y < R.Bottom - R.Top do
begin
Canvas.Draw(R.Left + X, R.Top + Y, WallpaperBmp);
Inc(Y, WallpaperBmp.Height);
end;
Inc(X, WallpaperBmp.Width);
Y := 0;
end;
else
Canvas.Draw(R.Left, R.Top, WallpaperBmp);
end;
DeleteObject(UpdateRgn);
RestoreDC(Canvas.Handle, SaveIndex);
end;
procedure TJvgAskListBox.DrawGlyph(R: TRect; Index: Word; Shift: Word);
var
I: Integer;
OldRect: TRect;
begin
if (FGlyphs = nil) or (FGlyphs.Count = 0) then
Exit;
R.Right := R.Left + FSegment1Width - 4;
OldRect := R;
Inc(R.Top);
Inc(R.Left);
case FGlyphsAlign.Horizontal of
fhaCenter:
OffsetRect(R, (R.Right - R.Left - Glyphs.Width) div 2, 0);
fhaRight:
OffsetRect(R, R.Right - R.Left - Glyphs.Width - Shift, 0);
end;
case FGlyphsAlign.Vertical of
fvaCenter:
OffsetRect(R, 0, (R.Bottom - R.Top - Glyphs.Height) div 2);
fvaBottom:
OffsetRect(R, 0, R.Bottom - R.Top - Glyphs.Height - Shift);
end;
I := -1;
if NumGlyphs = 1 then
I := 0
else
if Index < NumGlyphs then
I := Index;
if I >= 0 then
begin
FGlyphs.GetBitmap(I, TmpBitmap);
if FAutoTransparentColor = ftcUser then
CreateBitmapExt(Canvas.Handle, TmpBitmap, Rect(0, 0, 100, 100), R.Left,
R.Top, fwoNone, fdsDefault, True, FTransparentColor, clBlack)
else
CreateBitmapExt(Canvas.Handle, TmpBitmap, Rect(0, 0, 100, 100), R.Left,
R.Top, fwoNone, fdsDefault, True,
GetTransparentColor(TmpBitmap, FAutoTransparentColor), clBlack);
end;
end;
procedure TJvgAskListBox.SetAutoTransparentColor(Value: TglAutoTransparentColor);
begin
if FAutoTransparentColor = Value then
Exit;
FAutoTransparentColor := Value;
Invalidate;
end;
procedure TJvgAskListBox.SetWallpaper(Value: TBitmap);
begin
if Assigned(FWallpaper) then
FWallpaper.Free;
FWallpaper := TBitmap.Create;
FWallpaper.Assign(Value);
if (not Assigned(Value)) and Assigned(WallpaperImage) then
if Assigned(FWallpaper) then
WallpaperBmp := FWallpaper
else
if Assigned(FWallpaperImage) then
WallpaperBmp := FWallpaperImage.Picture.Bitmap
else
WallpaperBmp := nil;
if FShowWallpaper then
Invalidate;
end;
function TJvgAskListBox.GetWallpaper: TBitmap;
begin
if not Assigned(FWallpaper) then
FWallpaper := TBitmap.Create;
WallpaperBmp := FWallpaper;
Result := FWallpaper;
end;
procedure TJvgAskListBox.SetWallpaperImage(Value: TImage);
begin
FWallpaperImage := Value;
if (not IsItAFilledBitmap(FWallpaper)) and Assigned(Value) then
begin
WallpaperBmp := Value.Picture.Bitmap;
if FShowWallpaper then
Invalidate;
end;
end;
procedure TJvgAskListBox.SetWallpaperOption(Value: TglWallpaperOption);
begin
FWallpaperOption := Value;
if FShowWallpaper then
Invalidate;
end;
procedure TJvgAskListBox.SetNumGlyphs(Value: Word);
begin
if Value < 1 then
Exit;
FNumGlyphs := Value;
if FShowGlyphs then
Invalidate;
end;
{procedure TJvgAskListBox.SetItemStyle( Value: TItemsDrawStyle );
begin
if FItemStyle = Value then Exit;
FItemStyle := Value;
Invalidate;
end;
procedure TJvgAskListBox.SetSelItemStyle( Value: TItemsDrawStyle );
begin
if FSelItemStyle = Value then Exit;
FSelItemStyle := Value;
Invalidate;
end;
}
procedure TJvgAskListBox.SetGlyphs(Value: TImageList);
begin
//if (Value=nil)or(Value.Width<=0)or(Value.Height<=0) then Exit;
FGlyphs := Value;
if FShowGlyphs then
Invalidate;
end;
{procedure TJvgAskListBox.SetSelFont( Value: TFont );
begin
if Value=nil then Exit;
FSelFont.Assign( Value );
Invalidate;
end;
}
{
procedure TJvgAskListBox.SetColor(Value: TColor);
begin
if FColor = Value then Exit;
FColor := Value; Canvas.Brush.Color:=Value; Invalidate;
end;
procedure TJvgAskListBox.SetSelColor(Value: TColor);
begin
if FColor = Value then Exit;
FSelColor := Value; Canvas.Brush.Color:=Value; Invalidate;
end;
}
procedure TJvgAskListBox.SetItemHeight(Value: Word);
begin
if (Value > 6) and (FItemHeight <> Value) then
begin
FItemHeight := Value;
//inherited ItemHeight:=FItemHeight;
RecalcHeights;
end;
end;
procedure TJvgAskListBox.SetAlign(Align: TJvg2DAlign; var Align_: UINT);
begin
case Align.Horizontal of
fhaLeft:
Align_ := Align_ or DT_LEFT;
fhaCenter:
Align_ := Align_ or DT_CENTER;
else
Align_ := Align_ or DT_RIGHT;
end;
case Align.Vertical of
fvaTop:
Align_ := Align_ or DT_TOP;
fvaCenter:
Align_ := Align_ or DT_VCENTER;
else
Align_ := Align_ or DT_BOTTOM;
end;
end;
{
procedure TJvgAskListBox.SetTextStyle(Value: TglTextStyle);
begin
if FTextStyle = Value then Exit;
FTextStyle := Value; if FShowText then Invalidate;
end;
procedure TJvgAskListBox.SetButtonsTextStyle(Value: TglTextStyle);
begin
if FButtonsTextStyle = Value then Exit;
FButtonsTextStyle := Value; if FShowText then Invalidate;
end;
}
procedure TJvgAskListBox.SetShowText(Value: Boolean);
begin
if FShowText <> Value then
begin
FShowText := Value;
Invalidate;
end;
end;
procedure TJvgAskListBox.SetTransparentColor(Value: TColor);
begin
if FTransparentColor <> Value then
begin
FTransparentColor := Value;
if FShowGlyphs then
Invalidate;
end;
end;
procedure TJvgAskListBox.SetButtonWidth(Value: Word);
begin
if FButtonWidth <> Value then
begin
FButtonWidth := Value;
RecalcHeights;
end;
end;
procedure TJvgAskListBox.SetOptions(Value: TglAskLBOptions);
begin
if FOptions <> Value then
begin
FOptions := Value;
RecalcHeights;
end;
end;
function TJvgAskListBox.IsFilled: Boolean;
var
I: Word;
begin
Result := False;
for I := 0 to Items.Count - 1 do
if FPushedButton[I] = 0 then
Exit;
Result := True;
end;
function TJvgAskListBox.CountPushedButtonsInColon(Colon: Integer): Integer;
var
I: Word;
begin
Result := 0;
if Colon = 0 then
begin
for I := 0 to Items.Count - 1 do
if FPushedButton[I] <> 0 then
Inc(Result);
end
else
for I := 0 to Items.Count - 1 do
if FPushedButton[I] = Colon then
Inc(Result);
end;
procedure TJvgAskListBox.SetSelectedItem(Value: Word);
begin
if Value >= Items.Count then
Exit;
SendMessage(Handle, LB_SETCURSEL, Value, Longint(0));
end;
function TJvgAskListBox.GetButtons: TStrings;
begin
Result := FButtons;
end;
procedure TJvgAskListBox.SetButtons(Value: TStrings);
begin
if (Value <> nil) and (Value.Count <> 0) then
begin
FButtons.Assign(Value);
RecalcHeights;
Invalidate;
end;
end;
function TJvgAskListBox.GetPushedButtonInLine(Index: Word): Integer;
begin
if Index >= Items.Count then
Result := -1
else
Result := FPushedButton[Index];
end;
function TJvgAskListBox.SetPushedButtonInLine(Index: Word; Value: Word): Boolean;
var
R: TRect;
begin
if (Index < Items.Count) and (Value <= FButtons.Count) then
begin
Result := True;
if FPushedButton[Index] = Value then
Exit;
FPushedButton[Index] := Value;
SendMessage(Handle, LB_GETITEMRECT, Index, Longint(@R));
R.Left := FSegment1Width;
InvalidateRect(Handle, @R, True);
//ButtonClicked;
if (aloAutoScroll in Options) and (Value <> 0) then
SendMessage(Handle, LB_SETCURSEL, Index, Longint(0));
end
else
Result := False;
end;
procedure TJvgAskListBox.WMLButtonDown(var Msg: TWMLButtonDown);
var
R: TRect;
ItemN: Integer;
begin
inherited;
if aloIgnoreMouse in Options then
Exit;
MouseClickPoint.X := Msg.XPos;
MouseClickPoint.Y := Msg.YPos;
if Msg.XPos > Integer(FSegment1Width) then
begin
ItemN := ItemAtPos(SmallPointToPoint(Msg.Pos), True);
SendMessage(Handle, LB_GETITEMRECT, ItemN, LPARAM(@R));
Inc(R.Left, FSegment1Width);
InvalidateRect(Handle, @R, False);
//if (aloAutoScroll in Options)then SendMessage( Handle, LB_SETCURSEL, FSelectedItem+1, Longint(0));
end;
end;
procedure TJvgAskListBox.WMSize(var Msg: TWMSize);
begin
inherited;
RecalcHeights;
end;
procedure TJvgAskListBox.ButtonClicked;
begin
if Assigned(FOnButtonClicked) then
FOnButtonClicked(Self);
end;
procedure TJvgAskListBox.RecalcHeights;
var
I: Integer;
R: TRect;
begin
if Items.Count = 0 then
Exit;
SendMessage(Handle, LB_GETITEMRECT, Items.Count - 1, LPARAM(@R));
FSegment1Width := Word((R.Right - R.Left) - (FButtonWidth + 1) *
(Buttons.Count) - 1);
Items.BeginUpdate;
for I := 0 to Items.Count - 1 do
begin
Items.InsertObject(I, Items[I], Items.Objects[I]);
Items.Delete(I + 1);
end;
Items.EndUpdate;
end;
procedure TJvgAskListBox.SmthChanged(Sender: TObject);
begin
FTextAlign_ := DT_WORDBREAK;
FCaptionsAlign_ := DT_SINGLELINE;
SetAlign(FTextAlign, FTextAlign_);
SetAlign(FCaptionsAlign, FCaptionsAlign_);
FCaptionsAlign_ := DT_CENTER or DT_VCENTER or DT_SINGLELINE;
Invalidate;
end;
procedure TJvgAskListBox.InitState(var State: TOwnerDrawState; ByteState: Byte);
begin
State := [];
if ByteState and ODS_CHECKED <> 0 then
Include(State, odChecked); //TOwnerDrawState
if ByteState and ODS_COMBOBOXEDIT <> 0 then
Include(State, odComboBoxEdit);
if ByteState and ODS_DEFAULT <> 0 then
Include(State, odDefault);
if ByteState and ODS_DISABLED <> 0 then
Include(State, odDisabled);
if ByteState and ODS_FOCUS <> 0 then
Include(State, odFocused);
if ByteState and ODS_GRAYED <> 0 then
Include(State, odGrayed);
if ByteState and ODS_SELECTED <> 0 then
Include(State, odSelected);
end;
procedure TJvgAskListBox.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (AComponent = WallpaperImage) and (Operation = opRemove) then
WallpaperImage := nil;
if (AComponent = FGlyphs) and (Operation = opRemove) then
Glyphs := nil;
end;
{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
initialization
RegisterUnitVersion(HInstance, UnitVersioning);
finalization
UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}
end.
Reference in New Issue View Git Blame Copy Permalink