AL_GrCombo

Top  Previous  Next

unit Grcombo;

 

interface

uses {$IFDEF WIN32} Windows, {$ELSE} SysUtils, WinTypes, WinProcs, {$ENDIF}

Messages, Classes, Controls, Graphics, StdCtrls, Forms, Menus;

 

Type

 

{ TGreakComboBox }

GreakValues =

   (gvAlfa,gvBeta,gvGamma,gvDelta,gvEpszilon,gvDzeta,gvEta,gvTheta,

    iota,kappa,lambda,mu,nu,kszi,omikron,pi,

    ro,szigma,tau,upszilon,fi,khi,pszi,omega);

 

TGreakComboBox = class(TCustomComboBox)

private

   FGreakValue: string;

   FDisplayNames: Boolean;

   FGreakNames: TStrings;

   FOnChange: TNotifyEvent;

   procedure SetGreakValue(NewValue: string);

   procedure SetDisplayNames(Value: Boolean);

   procedure SetGreakNames(Value: TStrings);

   procedure GreakNamesChanged(Sender: TObject);

   procedure ResetItemHeight;

   procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;

protected

   procedure CreateWnd; override;

   procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;

   procedure Click; override;

   procedure BuildList; virtual;

   procedure DoChange; dynamic;

public

   constructor Create(AOwner: TComponent); override;

   destructor Destroy; override;

   property Text;

published

   property GreakValue: string read FGreakValue write SetGreakValue;

   property GreakNames: TStrings read FGreakNames write SetGreakNames;

   property DisplayNames: Boolean read FDisplayNames write SetDisplayNames

     default True;

   property Color;

   property Ctl3D;

   property DragMode;

   property DragCursor;

   property Enabled;

   property Font;

{$IFDEF WIN32}

{$IFNDEF VER90}

   property ImeMode;

   property ImeName;

{$ENDIF}

{$ENDIF}

   property ParentColor;

   property ParentCtl3D;

   property ParentFont;

   property ParentShowHint;

   property PopupMenu;

   property ShowHint;

   property TabOrder;

   property TabStop;

   property Visible;

   property OnChange: TNotifyEvent read FOnChange write FOnChange;

   property OnClick;

   property OnDblClick;

   property OnDragDrop;

   property OnDragOver;

   property OnDropDown;

   property OnEndDrag;

   property OnEnter;

   property OnExit;

   property OnKeyDown;

   property OnKeyPress;

   property OnKeyUp;

{$IFDEF WIN32}

   property OnStartDrag;

{$ENDIF}

end;

 

const

GreaksInList = 24;

GreakNameValues: array [0..GreaksInList - 1] of string =

   ('alfa','béta','gamma','delta','epszilon','dzéta','éta','théta',

    'ióta','kappa','lambda','mű','nű','kszí','omikron','pí',

    'ró','szigma','taú','üpszilon','fí','khí','pszí','omega');

 

procedure Register;

 

implementation

 

procedure Register;

begin

RegisterComponents('AL',[TGreakComboBox]);

end;

 

{ TGreakComboBox }

 

function GetItemHeight(Font: TFont): Integer;

var

DC: HDC;

SaveFont: HFont;

Metrics: TTextMetric;

begin

DC := GetDC(0);

try

   SaveFont := SelectObject(DC, Font.Handle);

   GetTextMetrics(DC, Metrics);

   SelectObject(DC, SaveFont);

finally

   ReleaseDC(0, DC);

end;

Result := Metrics.tmHeight + 1;

end;

 

constructor TGreakComboBox.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

Style := csOwnerDrawFixed;

FGreakValue := GreakNameValues[0];

FGreakNames := TStringList.Create;

TStringList(FGreakNames).OnChange := GreakNamesChanged;

FDisplayNames := True;

end;

 

destructor TGreakComboBox.Destroy;

begin

TStringList(FGreakNames).OnChange := nil;

FGreakNames.Free;

FGreakNames := nil;

inherited Destroy;

end;

 

procedure TGreakComboBox.CreateWnd;

begin

inherited CreateWnd;

BuildList;

SetGreakValue(FGreakValue);

end;

 

procedure TGreakComboBox.BuildList;

var

I: Integer;

GreakName: string;

begin

Clear;

for I := 0 to Pred(GreaksInList) do begin

   if (I <= Pred(FGreakNames.Count)) and (FGreakNames[I] <> '') then

     GreakName := FGreakNames[I]

   else

     { delete two first characters which prefix "cl" educated }

     GreakName := '';

   Items.AddObject(GreakName, TObject(GreakValues(I)));

end;

end;

 

procedure TGreakComboBox.GreakNamesChanged(Sender: TObject);

begin

if HandleAllocated then begin

   FGreakValue := GreakValue;

   RecreateWnd;

end;

end;

 

procedure TGreakComboBox.SetGreakNames(Value: TStrings);

begin

FGreakNames.Assign(Value);

end;

 

procedure TGreakComboBox.SetDisplayNames(Value: Boolean);

begin

if DisplayNames <> Value then begin

   FDisplayNames := Value;

   Invalidate;

end;

end;

 

procedure TGreakComboBox.SetGreakValue(NewValue: string);

var

Item: Integer;

CurrentGreak: string;

begin

if (ItemIndex < 0) or (NewValue <> FGreakValue) then

   { change selected item }

   for Item := 0 to Pred(Items.Count) do begin

     CurrentGreak := TColor(Items.Objects[Item]);

     if CurrentColor = NewValue then begin

       FGreakValue := NewValue;

       if ItemIndex <> Item then ItemIndex := Item;

       DoChange;

       Break;

     end;

   end;

end;

 

procedure TGreakComboBox.DrawItem(Index: Integer; Rect: TRect;

State: TOwnerDrawState);

const

ColorWidth = 22;

var

ARect: TRect;

Text: array[0..255] of Char;

Safer: TColor;

begin

ARect := Rect;

Inc(ARect.Top, 2);

Inc(ARect.Left, 2);

Dec(ARect.Bottom, 2);

if FDisplayNames then ARect.Right := ARect.Left + ColorWidth

else Dec(ARect.Right, 3);

with Canvas do begin

   FillRect(Rect);

   Safer := Brush.Color;

   Pen.Color := clWindowText;

   Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);

   Brush.Color := TColor(Items.Objects[Index]);

   try

     InflateRect(ARect, -1, -1);

     FillRect(ARect);

   finally

     Brush.Color := Safer;

   end;

   if FDisplayNames then begin

     StrPCopy(Text, Items[Index]);

     Rect.Left := Rect.Left + ColorWidth + 6;

     DrawText(Canvas.Handle, Text, StrLen(Text), Rect, DT_SINGLELINE or

       DT_VCENTER or DT_NOPREFIX);

   end;

end;

end;

 

procedure TGreakComboBox.Click;

begin

if ItemIndex >= 0 then GreakValue := TColor(Items.Objects[ItemIndex]);

inherited Click;

end;

 

procedure TGreakComboBox.CMFontChanged(var Message: TMessage);

begin

inherited;

ResetItemHeight;

RecreateWnd;

end;

 

procedure TGreakComboBox.ResetItemHeight;

begin

ItemHeight := GetItemHeight(Font);

end;

 

procedure TGreakComboBox.DoChange;

begin

if Assigned(FOnChange) then FOnChange(Self);

end;

 

 

end.

 

{

procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;

Rect: TRect; State: TOwnerDrawState);

var

Offset: Integer;

SDC : Integer;

begin

with (Control as TComboBox).Canvas do

begin

   SDC := SaveDC((Control as TComboBox).Canvas.Handle);

   FillRect(Rect);

   Offset := 2;

   Font.Color:=clRed;

   Font.Name :='Symbol';

   TextOut(Rect.Left + Offset, Rect.Top, (Control as TComboBox).Items[Index]);

   RestoreDC((Control as TComboBox).Canvas.Handle,SDC);

   Offset := 20 + 6;

   TextOut(Rect.Left + Offset, Rect.Top, (Control as TComboBox).Items[Index]);

end;

end;

 

function Greak:TStringlist;

var i: integer;

   bi: TBitmap;

const GreakABC : string = 'abgdezhqiklmnxoprstnfcjw';

begin

Result := TStringlist.Create;

bi:= TBitmap.Create;

bi.width := 20;

bi.height := 20;

bi.Canvas.pen.Color:=clRed;

For i:=1 to Length(GreakABC) do begin

     bi.Canvas.Ellipse(0,0,10,10);

     Result.AddObject(Copy(GreakABC,i,1),bi);

end;

bi.free;

end;

 

}