Другие компоненты
Обычный HeaderControl с дополнительной возможностью отображения стрелок
- Подробности
- Родительская категория: VCL
- Категория: Другие компоненты
Для правки данного глюка необходимо изменить следующую процедуру в исходном коде данного компонента:
- Подробности
- Родительская категория: VCL
- Категория: Другие компоненты
Code: |
uses CommCtrl;
procedure TForm1.DateTimePicker1DropDown(Sender: TObject); var wnd: HWND; Style: Integer; begin wnd := DateTime_GetMonthCal(DateTimePicker1.Handle); if wnd <> 0 then begin Style := GetWindowLong(wnd, GWL_STYLE); SetWindowLong(wnd, GWL_STYLE, Style or MCS_NOTODAY or MCS_NOTODAYCIRCLE); end; end;
{ The calendar will still highlite the current day but the circle and the today display at the bottom are gone. } |
- Подробности
- Родительская категория: VCL
- Категория: Другие компоненты
Code: |
unit Unit1;
{©Drkb v.3}
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Readhtml, FramView, FramBrwz, HtmlView;
type TForm1 = class(TForm) FrameBrowser1: TFrameBrowser; procedure FormCreate(Sender: TObject); procedure FrameBrowser1GetPostRequest(Sender: TObject; IsGet: Boolean; const URL, Query: String; Reload: Boolean; var NewURL: String; var DocType: ThtmlFileType; var Stream: TMemoryStream); procedure FrameBrowser1ImageRequest(Sender: TObject; const SRC: String; var Stream: TMemoryStream); public BaseDir: string; end;
var Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject); begin BaseDir := 'F:\Download\'; FrameBrowser1.LoadURL('file://F:\Download\index.htm'); end;
procedure TForm1.FrameBrowser1GetPostRequest(Sender: TObject; IsGet: Boolean; const URL, Query: String; Reload: Boolean; var NewURL: String; var DocType: ThtmlFileType; var Stream: TMemoryStream); var S, sType: string; F: TFileStream; P: Integer; begin S := StringReplace(URL, '|', ':', [rfReplaceAll]);
P := Pos(':', S) + 2; sType := Copy(S, 1, P);
Stream := TMemoryStream.Create;
if AnsiLowerCase(sType) = 'file://' then begin S := StringReplace(Copy(S, P + 1, MaxInt), '/', '\', [rfReplaceAll]);
F := TFileStream.Create(S, fmOpenRead); try Stream.CopyFrom(F, F.Size); finally F.Free; end; end; end;
procedure TForm1.FrameBrowser1ImageRequest(Sender: TObject; const SRC: String; var Stream: TMemoryStream); begin {} end;
end. |
- Подробности
- Родительская категория: VCL
- Категория: Другие компоненты
Вот пример HotSpot-компонента, основанного на TPanel (небольшая переделка). Управляя событиями MouseDown и MouseUp можно получить эффект резинового контура.
- Подробности
- Родительская категория: VCL
- Категория: Другие компоненты
Code: |
with ChartFX do begin Visible := false; { Устанавливаем режим ввода значений } { 1 - количество серий (в нашем случае 1), 3 - количество значений } OpenData [COD_VALUES] := MakeLong (1,3); { Hомер текущей серии } ThisSerie := 0; { Value [i] - значение с индексом i } { Legend [i] - комментарий к этому значению } Value [0] := a; Legend [0] := 'Значение переменной A'; Value [1] := b; Legend [1] := 'Значение переменной B'; Value [2] := c; Legend [2] := 'Значение переменной C'; { Закрываем режим } CloseData [COD_VALUES] := 0; { Ширина поля с комментариями на экране (в пикселах) } LegendWidth := 150; Visible := true; end; end; |
- Подробности
- Родительская категория: VCL
- Категория: Другие компоненты
Code: |
unit Unit1; {©Drkb v.3} interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type TForm1 = class(TForm) Label1: TLabel; procedure FormCreate(Sender: TObject); end;
var Form1: TForm1;
implementation
uses Types;
{$R *.dfm}
type TPathLabel = class(TLabel) private FHintWindow: THintWindow; procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW; procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED; procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; protected procedure Paint; override; public constructor Create(AOwner: TComponent); override; end;
{ TPathLabel }
procedure TPathLabel.CMHintShow(var Message: TMessage); var P: TPoint; R: TRect; begin Message.Result := 1; end;
procedure TPathLabel.CMMouseEnter(var Message: TMessage); var P: TPoint; R: TRect; W: Integer; begin W := Canvas.TextWidth(Caption); if W > ClientWidth then begin P := ClientToScreen(Point(0, 0)); R := ClientRect; R := Rect(P.X, P.Y, P.X + W + 5, P.Y + ClientHeight);
FHintWindow.ActivateHint(R, Caption); Message.Result := 1; end;
inherited; end;
procedure TPathLabel.CMMouseLeave(var Message: TMessage); begin FHintWindow.ReleaseHandle;
inherited; end;
procedure TPathLabel.CMTextChanged(var Message: TMessage); begin if Canvas.TextWidth(Caption) > ClientWidth then begin ShowHint := True; Hint := Caption; end else begin ShowHint := False; Hint := ''; end;
inherited; end;
constructor TPathLabel.Create(AOwner: TComponent); begin inherited Create(AOwner);
AutoSize := False; FHintWindow := THintWindow.Create(Self); FHintWindow.Color := Application.HintColor; end;
procedure TPathLabel.Paint; var R: TRect; begin R := ClientRect; if Transparent then Canvas.Brush.Style := bsClear else begin Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := Color; end; DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_PATH_ELLIPSIS); end;
procedure TForm1.FormCreate(Sender: TObject); var R: TRect; begin R := Label1.BoundsRect; Inc(R.Top, 50); Inc(R.Bottom, 50); with TPathLabel.Create(Self) do begin Parent := Self; Color := clLime; BoundsRect := R; Caption := Label1.Caption; end; end;
end. |
- Подробности
- Родительская категория: VCL
- Категория: Другие компоненты
Microsoft ® Internet Explorer представляет элемент управления IP-адрес, новый элемент управления похож на элемент управления редактирования, что позволяет пользователю ввести
числовой адрес в сети Интернет-протокола (IP). Этот формат состоит из четырех трехзначных полей. Каждое поле обрабатывается индивидуально; номера полей основываются на нулях и
перейдите слева направо.
- Подробности
- Родительская категория: VCL
- Категория: Другие компоненты
Фрэйм - это чтото-типа TForm только его можна размещать в любом окне программы.
Надо создать его File -> New -> Frame. Появится окошко. Растянуть на форме этот TFrameБ выбрать из списка нужный и работать как с обычной формой. Все просто.
- Подробности
- Родительская категория: VCL
- Категория: Другие компоненты
Code: |
uses CommCtrl;
const fmt: PChar = 'hh:mm';
SendMessage(DateTimePicker1.Handle, DTM_SETFORMAT, 0, LongInt(fmt)); |
- Подробности
- Родительская категория: VCL
- Категория: Другие компоненты