dcedits.pas

获取硬盘相关详细信息

begin
  if (Key = Char(VK_RETURN)) or (Key = Char(VK_ESCAPE)) then
   begin
    { must catch and remove this, since is actually multi-line }
    GetParentForm(Self).Perform(CM_DIALOGKEY, Byte(Key), 0);
    if Key = Char(VK_RETURN) then
     begin
      inherited KeyPress(Key);
      Key := #0;
      Exit;
     end;
   end;
  inherited KeyPress(Key);
end;

procedure TdcCustomEdit.UpdateEditRect;
var
  R: TRect;
  BtnWidth: Integer;
begin
 if not HandleAllocated then Exit;

 if FButton.Visible then
    BtnWidth := FBtnControl.Width
  else
    BtnWidth := 0;
  R := Rect(0, 0, ClientWidth - BtnWidth - 2, ClientHeight + 1);
  SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
end;

procedure TdcCustomEdit.UpdateBtnBounds;
var
  BtnRect: TRect;
  BtnWidth: Integer;
begin
  if NewStyleControls then
   begin
    if Ctl3D and (BorderStyle = bsSingle) then
      BtnRect := Bounds(Width - FBtn.Width - 4, 0,
        FBtn.Width, Height - 4)
    else
     begin
      if BorderStyle = bsSingle then
        BtnRect := Bounds(Width - FBtn.Width - 2, 2,
          FBtn.Width, Height - 4)
      else
        BtnRect := Bounds(Width - FBtn.Width, 0,
          FBtn.Width, Height);
     end;
   end
  else
    BtnRect := Bounds(Width - FBtn.Width, 0, FBtn.Width, Height);

  with BtnRect do
   begin
    if FButton.Visible then
      BtnWidth := Right - Left
    else
      BtnWidth := 0;  
    FBtnControl.SetBounds(Left, Top, BtnWidth, Bottom - Top);
   end; 
  FBtn.Height := FBtnControl.Height;

  UpdateEditRect;
end;

procedure TdcCustomEdit.UpdateBkColor;
begin
  if Enabled then inherited Color := FColor
  else inherited Color := FColorDisabled;
end;

procedure TdcCustomEdit.WndProc(var Message: TMessage);
begin
  if (Message.Msg = WM_SETCURSOR) and
     (TWMSetCursor(Message).HitTest = htBorder) then
   begin
    SetCursor(Screen.Cursors[FCursorBorder]);
    Exit;
   end;

  inherited;
end;

procedure TdcCustomEdit.ButtonClick(Sender: TObject);
begin
  if Assigned(FOnButtonClick) then
    FOnButtonClick(Self);
end;

procedure TdcCustomEdit.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then
   begin
    FAlignment := Value;
    RecreateWnd;
   end;
end;

procedure TdcCustomEdit.SetColor(Value: TColor);
begin
  if FColor <> Value then
   begin
    FColor := Value;
    UpdateBkColor;
   end;
end;

procedure TdcCustomEdit.SetColorDisabled(Value: TColor);
begin
  if FColorDisabled <> Value then
   begin
    FColorDisabled := Value;
    UpdateBkColor;
   end;
end;

procedure TdcCustomEdit.WMChar(var Message: TWMChar);
var
  I: Integer;
begin
  if FValidateChars and (Char(Message.CharCode) <> #8) then
   begin
    I := Length(FValidChars);
    if I <> 0 then
     for I := 1 to I do
      if FValidChars[I] = Char(Message.CharCode) then inherited
   end
  else inherited;
end;

procedure TdcCustomEdit.WMSize(var Message: TWMSize);

  function GetTextHeight: Integer;
  var
    DC: HDC;
    SaveFont: HFont;
    SysMetrics, Metrics: TTextMetric;
  begin
    DC := GetDC(0);
    try
      GetTextMetrics(DC, SysMetrics);
       SaveFont := SelectObject(DC, Font.Handle);
      GetTextMetrics(DC, Metrics);
      SelectObject(DC, SaveFont);
    finally
      ReleaseDC(0, DC);
    end;
    if SysMetrics.tmHeight < Metrics.tmHeight then
      Result := SysMetrics.tmHeight
    else
      Result := Metrics.tmHeight;
  end;

var
  MinHeight: Integer;
begin
  inherited;
  if not (csLoading in ComponentState) then
   begin
    MinHeight := GetTextHeight + GetSystemMetrics(SM_CYBORDER) * 4 + 1;
    if Height < MinHeight then
     begin
      Height := MinHeight;
      Exit;
     end;
   end;  

  UpdateBtnBounds;
end;

procedure TdcCustomEdit.CMCtl3DChanged(var Message: TMessage);
begin
  inherited;
  UpdateBtnBounds;
end;

procedure TdcCustomEdit.CMEnter(var Message: TCMEnter);
begin
  if FAutoSelect and not (csLButtonDown in ControlState) then SelectAll
  else Invalidate;
  inherited;
end;

procedure TdcCustomEdit.CMExit(var Message: TCMExit);
begin
  inherited;
  Invalidate;
end;

procedure TdcCustomEdit.CMEnableChanged(var Message: TMessage);
begin
  inherited;
  FBtn.Enabled := Enabled;
  UpdateBkColor;    
end;

procedure TdcCustomEdit.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;

procedure TdcCustomEdit.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;


{ TdcFileEdit }
constructor TdcFileEdit.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FOpenDialog := TOpenDialog.Create(Self);
  FSaveDialog := TSaveDialog.Create(Self);
{$IFDEF D3}
  FOpenPictureDialog := TOpenPictureDialog.Create(Self);
  FSavePictureDialog := TSavePictureDialog.Create(Self);
{$ENDIF}

  with FOpenDialog do
   begin
    FDlgFilter := 'All files (*.*)|*.*';
    FDlgOptions := Options;
   end;

  try
    FBtn.Glyph.Handle := LoadBitmap(hInstance, 'DC_FILEOPEN');
  except
  end;
  FButton.Visible := True;
end;

destructor TdcFileEdit.Destroy;
begin
{$IFDEF D3}
  FSavePictureDialog.Free;
  FOpenPictureDialog.Free;
{$ENDIF}
  FSaveDialog.Free;
  FOpenDialog.Free;
  inherited Destroy;
end;

procedure TdcFileEdit.ButtonClick(Sender: TObject);
var
  Res: Boolean;
begin
  inherited ButtonClick(Sender);
  Res := False;
  case FDlgType of
    dtOpen: with FOpenDialog do
             begin
              DefaultExt := FDlgDefaultExt;
              Filter := FDlgFilter;
              Title := FDlgTitle;
              Options := FDlgOptions;
              Filename := Text;
              Res := Execute;
              if Res then
               Text := Filename;
             end;
    dtSave: with FSaveDialog do
             begin
              DefaultExt := FDlgDefaultExt;
              Filter := FDlgFilter;
              Title := FDlgTitle;
              Options := FDlgOptions;
              Filename := Text;
              Res := Execute;
              if Res then
               Text := Filename;
             end;
{$IFDEF D3}
    dtOpenPicture: with FOpenPictureDialog do
                    begin
                     DefaultExt := FDlgDefaultExt;
                     Filter := FDlgFilter;
                     Title := FDlgTitle;
                     Options := FDlgOptions;
                     Filename := Text;
                     Res := Execute;
                     if Res then
                      Text := Filename;
                    end;
    dtSavePicture: with FSavePictureDialog do
                    begin
                     DefaultExt := FDlgDefaultExt;
                     Filter := FDlgFilter;
                     Title := FDlgTitle;
                     Options := FDlgOptions;
                     Filename := Text;
                     Res := Execute;
                     if Res then
                      Text := Filename;
                    end;
{$ENDIF}                    
   end;
  if Res then
   begin
    if Assigned(FOnDlgOk) then FOnDlgOk(Self);
    SetFocus;
    SendMessage(Handle, EM_SETSEl, Length(Text), Length(Text));
   end
  else
   if Assigned(FOnDlgCancel) then FOnDlgCancel(Self);
end;


{$IFDEF D3}
{ TdcFolderEdit }
constructor TdcFolderEdit.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FBrowseDialog := TdcBrowseDialog.Create(Self);

  with FBrowseDialog do
   begin
    FDlgOptions := Options;
    FDlgSpecialLocation := SpecialLocation;
    FDlgStatusText := StatusText;
    FDlgTitle := Title;
   end;

  FNewFolder := TdcNewFolderBtn.Create;

  try
    FBtn.Glyph.Handle := LoadBitmap(hInstance, 'DC_FOLDERBROWSE');
  except
  end;
  FButton.Visible := True;
end;

destructor TdcFolderEdit.Destroy;
begin
  FNewFolder.Free;
  FBrowseDialog.Free;
  inherited Destroy;
end;

procedure TdcFolderEdit.ButtonClick(Sender: TObject);
begin
  inherited ButtonClick(Sender);
  with FBrowseDialog do
   begin
    Options := FDlgOptions;
    SpecialLocation := FDlgSpecialLocation;
    StatusText := FDlgStatusText;
    Title := FDlgTitle;

    NewFolder.Caption := FNewFolder.Caption;
    NewFolder.Prompt := FNewFolder.Prompt;    
    NewFolder.Visible := FNewFolder.Visible;

    Folder := Text;
    if Execute then
     begin
      Text := Folder;
      if Assigned(FOnDlgOk) then FOnDlgOk(Self);
      SetFocus;
      SendMessage(Handle, EM_SETSEl, Length(Text), Length(Text));
     end
    else
     if Assigned(FOnDlgCancel) then FOnDlgCancel(Self);
   end;
end;
{$ENDIF}

end.