Другие компоненты

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.

}

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.

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;

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.

Code:

uses CommCtrl;

const fmt: PChar = 'hh:mm';

SendMessage(DateTimePicker1.Handle, DTM_SETFORMAT, 0, LongInt(fmt));