ezmiscelctrls.pas

很管用的GIS控件

begin
  FFont.Assign(Value);
  FColumn.RefreshLayout;
end;

{ TEzSymbolsListBox }

procedure TEzSymbolsListBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
begin
  If odSelected in State then
    Canvas.FillRect( Rect );
  Canvas.Font.Assign( Self.Font );
  DrawSymbol( FGrapher, Self.Canvas, Index, Rect, State, Self.AreaColor,
    FShowIndex, FShowHexa, true, FEdged);
end;

procedure TEzSymbolsListBox.Populate;
var
  I: Integer;
begin
  If not HasParent then Exit;
  Items.Clear;
  For I:= 0 to Ez_Symbols.Count-1 do
    Items.Add( '' );
end;

{ TEzLinetypeListBox }

constructor TEzLinetypeListBox.Create(AOwner: TComponent);
begin
  inherited Create(Aowner);
  FScale:= 0;
  FRepit:= 2;
end;

procedure TEzLinetypeListBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
begin
  If odSelected in State then
    Canvas.FillRect( Rect );
  Canvas.Font.Assign( Self.Font );
  DrawLinetype(FGrapher, Canvas, Index, Rect, State, clBlack, Self.AreaColor,
    FShowIndex, FScale, FRepit, FShowHexa, true, FEdged );
end;

function TEzLinetypeListBox.GetRepit: Integer;
begin
  Result:= FRepit;
end;

function TEzLinetypeListBox.GetScale: Double;
begin
  Result:=FScale;
end;

procedure TEzLinetypeListBox.Populate;
var
  I: Integer;
begin
  If Not HasParent then Exit;
  Items.Clear;
  with Items do
  begin
    Clear;
    Add('None');
    Add('Continuous');
    for I:= 2 to Succ(MAX_LINETYPES) do
      Add('');
    for I:= 0 to Ez_Linetypes.Count-1 do
      Add('');
  end;
end;

procedure TEzLinetypeListBox.SetRepit(const Value: Integer);
begin
  FRepit:=value;
end;

procedure TEzLinetypeListBox.SetScale(const Value: Double);
begin
  FScale:=value;
end;

{ TEzBrushPatternListBox }

constructor TEzBrushPatternListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FForeColor:= clBlack;
  FBackColor:=clWhite;
end;

procedure TEzBrushPatternListBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
begin
  If odSelected in State then
    Canvas.FillRect( Rect );
  Canvas.Font.Assign( Self.Font );
  DrawPattern( Canvas, Index, clBlack, clWhite, Self.AreaColor, Rect,
    FShowIndex, State, FShowHexa, True, FEdged  );
end;

function TEzBrushPatternListBox.GetBackColor: TColor;
begin
  Result:=FBackColor
end;

function TEzBrushPatternListBox.GetForeColor: TColor;
begin
  Result:=FForecolor;
end;

procedure TEzBrushPatternListBox.Populate;
var
  I: Integer;
begin
  If not HasParent then Exit;
  Items.Clear;
  Items.Add('None');
  Items.Add('Solid');
  for I:=2 to 89 do
    Items.Add('');
end;

procedure TEzBrushPatternListBox.SetBackColor(const Value: TColor);
begin
  FBackcolor:=value;
end;

procedure TEzBrushPatternListBox.SetForeColor(const Value: TColor);
begin
  FForeColor:=value;
end;

{ TEzBlocksListBox }

procedure TEzBlocksListBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
var
  Block: TEzSymbol;
  BlockIndex: Integer;
  Temp: Boolean;
  Stream: TFileStream;
begin
  If odSelected in State then
    Canvas.FillRect( Rect );
  Canvas.Font.Assign( Self.Font );
  Temp:= false;
  Block:= Nil;
  if Items.Objects[Index] <> nil then
  begin
    // retrieve the block from the list of preloaded blocks
    BlockIndex:= Longint(Items.Objects[Index]);
    Block:= TEzSymbol(Ez_Preferences.PreloadedBlocks.Objects[BlockIndex]);
  end else if FileExists( Items[Index] ) then
  begin
    // load the block from disk
    Temp:= true;
    Block:= TEzSymbol.Create(Nil);
    Stream:= TFileStream.Create(Items[Index], fmOpenRead or fmShareDenyNone);
    Try
      Block.LoadFromStream(Stream);
    Except
      Block.Free;
      Raise;
    End;
  end ;
  If Assigned( Block ) then
  begin
    DrawBlock(FGrapher, Canvas, Rect, State, Self.AreaColor, Block, true, FEdged );
    If Temp then Block.Free;
  end;
end;

procedure TEzBlocksListBox.Populate;
var
  I: Integer;
  SR: TSearchRec;
  Found: Integer;
  Source: string;
begin
  If not HasParent then Exit;
  Items.Clear;
  Source := AddSlash(Ez_Preferences.CommonSubDir);
  Found:= FindFirst(Source + '*.edb', faAnyFile, SR );
  try
    While Found = 0 Do
    Begin
      If ( SR.Name <> '.' ) And ( SR.Name <> '..' ) Then
      Begin
        Items.Add(Source + Sr.Name);
      End;
      Found := FindNext( SR );
    End;
  finally
    SysUtils.FindClose(SR);
  end;
  for I:= 0 to Ez_Preferences.PreloadedBlocks.Count-1 do
    Items.AddObject('', Pointer(I));
end;


{ TEzFlatComboBox}

constructor TEzFlatComboBox.Create (AOwner: TComponent);
begin
  inherited;
  AutoSize := False;
  Ctl3D := False;
//  BorderStyle := bsNone;
  Height := 25;
//  RedrawBorder (0);
end;

procedure TEzFlatComboBox.CMMouseEnter (var Message: TMessage);
begin
  inherited;
  if not Focused then
  begin
    MouseInControl:=true;
    RedrawBorder (0);
  end;
end;

procedure TEzFlatComboBox.CMMouseLeave (var Message: TMessage);
begin
  inherited;
  if not Focused then
  begin
    MouseInControl:=false;
    RedrawBorder (0);
  end;
end;

procedure TEzFlatComboBox.NewAdjustHeight;
var
  DC: HDC;
  SaveFont: HFONT;
  Metrics: TTextMetric;
begin
  DC := GetDC(0);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics (DC, Metrics);
  SelectObject (DC, SaveFont);
  ReleaseDC (0, DC);
  Height := Metrics.tmHeight + 6;
end;

procedure TEzFlatComboBox.Loaded;
begin
  inherited;
  if not(csDesigning in ComponentState) then
  begin
    NewAdjustHeight;
  end;
end;

procedure TEzFlatComboBox.CMEnabledChanged (var Message: TMessage);
const
  EnableColors: array[Boolean] of TColor = (clBtnFace, clWindow);
begin
  inherited;
  Color := EnableColors[Enabled];
end;

procedure TEzFlatComboBox.CMFontChanged (var Message: TMessage);
begin
  inherited;
  if not((csDesigning in ComponentState) and (csLoading in ComponentState)) then
    NewAdjustHeight;
end;

procedure TEzFlatComboBox.WMSetFocus (var Message: TWMSetFocus);
begin
  inherited;
  if not(csDesigning in ComponentState) then
    RedrawBorder (0);
end;

procedure TEzFlatComboBox.WMKillFocus (var Message: TWMKillFocus);
begin
  inherited;
  if not(csDesigning in ComponentState) then
    RedrawBorder (0);
end;

procedure TEzFlatComboBox.WMNCPaint (var Message: TMessage);
begin
  inherited;
  RedrawBorder (Message.WParam);
end;

procedure TEzFlatComboBox.RedrawBorder (const Clip: HRGN);
var
  DC: HDC;
  R: TRect;
  BtnFaceBrush, WindowBrush: HBRUSH;
  NewClipRgn:HRGN;
begin
  DC := GetWindowDC(Handle);
  try
    { Use update region }
    if (Clip <> 0) and (Clip <> 1) then begin
      GetWindowRect (Handle, R);
      if SelectClipRgn(DC, Clip) = ERROR then begin
        NewClipRgn := CreateRectRgnIndirect(R);
        SelectClipRgn (DC, NewClipRgn);
        DeleteObject (NewClipRgn);
      end;
      OffsetClipRgn (DC, -R.Left, -R.Top);
    end;
    GetWindowRect (Handle, R);
    OffsetRect (R, -R.Left, -R.Top);
    BtnFaceBrush := GetSysColorBrush(COLOR_BTNFACE);
    WindowBrush := GetSysColorBrush(COLOR_WINDOW);
    if ((csDesigning in ComponentState) and Enabled) or
       (not(csDesigning in ComponentState) and
        (Focused or (MouseInControl))) then begin
      DrawEdge (DC, R,BDR_SUNKENOUTER, BF_RECT or BF_ADJUST);
      with R do begin
        FillRect (DC, Rect(Left, Top, Left+1, Bottom-1), BtnFaceBrush);
        FillRect (DC, Rect(Left, Top, Right-1, Top+1), BtnFaceBrush);
      end;
      DrawEdge (DC, R, BDR_SUNKENINNER, BF_BOTTOMRIGHT);
      InflateRect (R, -1, -1);
      FrameRect (DC, R, WindowBrush);
    end
    else begin
      FrameRect (DC, R, BtnFaceBrush);
      InflateRect (R, -1, -1);
      FrameRect (DC, R, BtnFaceBrush);
      InflateRect (R, -1, -1);
      FrameRect (DC, R, WindowBrush);
    end;
  finally
    ReleaseDC (Handle, DC);
  end;
end;

procedure TEzFlatComboBox.WMPaint(var Message: TMessage);
begin
  inherited;
  RedrawBorder(0);
end;

procedure TEzFlatComboBox.CMExit(var Message: TCMExit);
begin
  MouseInControl:=false;
  RedrawBorder(0);
end;

procedure TEzFlatComboBox.DblClick;
begin
  inherited DblClick;
  If Items.Count = 0 then Exit;
  If ItemIndex < Items.Count-1 then
    Itemindex:= ItemIndex + 1
  Else
    ItemIndex:= 0;
end;

type
  TCustomListBoxHack = class(TCustomListBox);

function TEzFlatComboBox.GetAbout: TEzAbout;
begin
  Result:= SEz_GisVersion;
end;

procedure TEzFlatComboBox.SetAbout(const Value: TEzAbout);
begin
end;

{ TEzDropDownList }
constructor TEzDropDownList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FList:= CreateListBox;
  with FList do
  begin
    Parent := Self.FPanel;
    ParentFont := True;
    OnClick := SLClick;
    OnLoseFocus := SLLoseFocus;
    OnKeyPress := SLKeyPress;
    Visible := True;
    Align := alClient;
    BorderStyle:= bsNone;
  end;
  FList.Populate;
end;

destructor TEzDropDownList.Destroy;
begin
  if Assigned(FList) then
    with FList do
    begin
      OnClick := NIL;
      OnKeyPress := NIL;
    end;
  inherited;
end;

procedure TEzDropDownList.DoCancel;
begin
  if Assigned(OnCancel) then
    OnCancel(Self)
  else
    Release;
end;

procedure TEzDropDownList.DoClick;
begin
  if Assigned(OnClick) then
    OnClick(Self);
  Release;
end;

function TEzDropDownList.GetColumns: Integer;
begin
  Result:= TCustomListBoxHack(FList).Columns;
end;

function TEzDropDownList.GetItemIndex: Integer;
begin
  Result:= FList.ItemIndex;
end;

procedure TEzDropDownList.Loaded;
begin
  inherited;
  If FList.Items.Count = 0 then FList.Populate;
end;

procedure TEzDropDownList.SetColumns(const Value: Integer);
begin
  TCustomListBoxHack(FList).Columns:= Value;
end;

procedure TEzDropDownList.SetFocus;
begin
  if FList.CanFocus then
    FList.SetFocus
  else
    inherited;
end;

procedure TEzDropDownList.SetItemIndex(Value: Integer);
begin
  FList.ItemIndex:= Value;
end;

procedure TEzDropDownList.SLClick(Sender: TObject);
begin
  DoClick;