STRCOMBO

Top  Previous  Next

(*  StellaMAP rétegcombo box D1 komponens

  Lényege: Rétegfile rétegei jelennek meg a combo box-ban ,

           a rétegnevek előtt egy kis szines négyzetben a vonal színnel

*)

 

unit Strcombo;

 

interface

 

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms,

Dialogs, stdctrls, AlmType, StMap161, StMap16w;

 

type

 

TAktRetegChange = procedure(Sender: TObject; ActReteg:byte) of object;

 

TStRetegCombo = class(TComboBox)

private

  FStellaMAPSource : TStMapW;

  FAktReteg        : byte;      {Aktuális réteg sorszáma 0..255}

  FColorVisible    : boolean;   {Szinek látszonak a combo-ban}

  FLockedVisible   : boolean;   {Zárolás látszik-e a combo-ban}

  FRetegFile       : string;    {Réteg definíciós file *.rtg}

  FOnAktRetegChange : TAktRetegChange;  {Akt.réteg váltás esemény}

  procedure SetAktReteg(Value: byte);

  procedure SetRetegFile(Value: string);

protected

  kulcs  : string;

  procedure Notification(AComponent: TComponent;

    Operation: TOperation); override;

  procedure RetegMegnyit(fnev:string);

  Function  RetegrekordKap(arec: word): TRetegrecord;

  procedure SelfDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);

  procedure Click; override;

  procedure KeyPress(var Key: Char);override;

public

  rtgStream  : TmemoryStream;

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

published

  Property StellaMAPSource : TStMapW read FStellaMAPSource write FStellaMAPSource ;

  property AktReteg: byte read FAktReteg write SetAktReteg default 9;

  Property ColorVisible : boolean read FColorVisible write FColorVisible ;

  Property LockedVisible : boolean read FLockedVisible write FLockedVisible ;

  property RetegFile: string read FRetegFile write SetRetegFile;

  property OnAktRetegChange : TAktRetegChange read FOnAktRetegChange write FOnAktRetegChange;

  property Ctl3d;

  property DropDownCount;

  property Items;

  property Enabled;

  property Hint;

  property OnClick;

  property OnKeyPress;

end;

 

procedure Register;

 

 

implementation

 

procedure Register;

begin

   RegisterComponents('StellaMAP',[TStRetegCombo]);

end;

 

constructor TStRetegCombo.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

   rtgStream    := TmemoryStream.Create;

   kulcs        := '';

   FAktreteg    := 9;

   Style        := csOwnerDrawVariable;

   Sorted       := False;

   DropDownCount:= 20;

   OnDrawItem   := SelfDrawItem;

end;

 

destructor TStRetegCombo.Destroy;

begin

   rtgStream.Free;

   inherited Destroy;

end;

 

procedure TStRetegCombo.Notification(AComponent: TComponent;

Operation: TOperation);

begin

inherited Notification(AComponent, Operation);

if (Operation = opRemove) and (AComponent = StellaMapSource)

then StellaMapSource := nil;

end;

 

procedure TStRetegCombo.SetRetegFile(Value: string);

begin

If FRetegFile<>Value then begin

   FRetegFile := Value;

   RetegMegnyit(FRetegFile);

   Text:=Items[AktReteg];

   Invalidate;

end;

end;

 

procedure TStRetegCombo.SetAktReteg(Value: byte);

begin

   FAktreteg:=Value mod 256;

   If StellaMAPSource<>nil then StellaMAPSource.cw.aktreteg:=FAktreteg;

   rrec:=RetegRekordKap(Faktreteg);

   Itemindex:=FAktReteg;

   Text:=Items[FAktReteg];

   If Assigned(FOnAktRetegChange) then FOnAktRetegChange(Self,FAktreteg);

   If kulcs<>'' then kulcs:=Inttostr(FAktreteg);

end;

 

{ Rétegfile stream megnyitása }

procedure TStRetegCombo.RetegMegnyit(fnev:string);

var f: file of Tretegrecord;

  resu: word;

  I: integer;

  s: string[1];

begin

If FileExists(fnev) then begin

     {$I-}

     AssignFile(f,fnev);

     Reset(f);

     rtgStream.Seek(0,0);

     Clear;

     For i:=0 to 255 do begin        {256 réteg van}

         Read(f,rrec);

         If IOResult<>0 then RRecNull(rrec);

         rtgStream.Write(rrec,SizeOf(rrec));

         If rrec.vedett then s:='*' else s:=' ';

         Items.Add({Format('%3d',[rrec.retegszam])}Inttostr(rrec.retegszam) + s + rrec.retegnev);

     end;

     CloseFile(f);

     If StellaMAPSource<>nil then StellaMAPSource.retegfile:=fnev;

     AktReteg:=AktReteg;

     {$I+}

end else

    RetegFile:='';

end;

 

Function TStRetegCombo.RetegrekordKap(arec: word): TRetegrecord;

begin ReadRec(rtgstream,arec,Result,SizeOf(Result));end;

 

procedure  TStRetegCombo.SelfDrawItem(Control: TWinControl; Index: Integer;

                       Rect: TRect; State: TOwnerDrawState);

Var col1,col2 : TColor;

begin

If (kulcs<>'') and (State=[odSelected,odFocused]) then Index:=strtoint(kulcs);

with Canvas do

begin

  Pen.Mode  := pmCopy;

  FillRect(Rect);

  rrec:=RetegRekordKap(Index);

  col1 := rrec.vonalszin;

  col2 := rrec.szovegszin;

  Pen.Color := clBlack;

  Brush.color := col1;

  Rectangle(Rect.Left+2,Rect.Top+2,Rect.Left+18,Rect.Bottom-2);

  Brush.color := col2;

  Rectangle(Rect.Left+18+2,Rect.Top+2,Rect.Left+18+18,Rect.Bottom-2);

  Pen.Color := clBlack;

  Brush.color := clWhite;

  Brush.Style := bsClear;

  TextOut(Rect.Left + 2 + 40, Rect.Top , Items[Index]);

  Brush.Style := bsSolid;

end;

{  inherited DrawItem( Index, Rect, State);}

end;

 

procedure TStRetegCombo.KeyPress(var Key: Char);

begin

Try

Case Key of

'0'..'9':

begin

   kulcs := kulcs + Key;

   Aktreteg := StrToInt(kulcs);

end;

#8  :  If Length(kulcs)>1 then begin

   kulcs := Copy(kulcs,1,Length(kulcs)-1);

   If kulcs<>'' then kulcs:='0';

   Aktreteg := StrToInt(kulcs)

end else Aktreteg := 0;

#13 : begin

   If kulcs<>'' then Aktreteg:=StrToInt(kulcs);

   kulcs := '';

end;

end;

except

kulcs := '';

Key := #0;

end;

inherited KeyPress(Key);

end;

 

procedure TStRetegCombo.Click;

begin

If kulcs='' then

   FAktreteg:=Itemindex

else

   FAktreteg := StrToInt(kulcs);

If Assigned(FOnAktRetegChange) then FOnAktRetegChange(Self,FAktreteg);

inherited Click;

end;

 

end.