?? faxfield.bak
字號:
P : TPoint;
begin
P.X := X;
P.Y := Y;
P := Target.ScreenToClient(Source.ClientToScreen(P));
X := P.X;
Y := P.Y;
end;
{*** TStretchHandle *}
constructor TStretchHandle.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Canvas.Brush.Color := clBlack;
Canvas.Brush.Style := bsSolid;
SetBounds(Top, Left, ctStretchHandleSize, ctStretchHandleSize);
end;
procedure TStretchHandle.Paint;
begin
Canvas.FillRect(Rect(0, 0, Width, Height));
end;
{------------------------------ TBaseField ---------------------------------}
constructor TBaseField.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Brush.Color := clWindow;
Brush.Style := bsClear;
DragCursor := crCross;
DragMode := dmManual;
Pen.Mode := pmCopy;
Pen.Style := psDashDot;
Pen.Color := clBlack;
Pen.Width := 1;
Shape := stRectangle;
Visible := False; {Caller must make visible after setting size and position}
SetSelected(False);
end;
procedure TBaseField.bfMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Parent is TPanel then begin
{If Sender is one of the StretchHandles, convert its coordinates to our own}
if Sender is TStretchHandle then
ConvertCoords(Sender as TStretchHandle, Self, X, Y);
(Parent as TPanel).OnMouseDown(Self, Button, Shift, X, Y);
end;
end;
procedure TBaseField.bfMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Parent is TPanel then begin
{If Sender is one of the StretchHandles, convert its coordinates to our own}
if Sender is TStretchHandle then
ConvertCoords(Sender as TStretchHandle, Self, X, Y);
(Parent as TPanel).OnMouseUp(Self, Button, Shift, X, Y);
end;
end;
procedure TBaseField.bfMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if Parent is TPanel then begin
{If Sender is one of the StretchHandles, convert its coordinates to our own}
if Sender is TStretchHandle then begin
ConvertCoords(Sender as TStretchHandle, Self, X, Y);
if not (ssLeft in Shift) then
StretchMode := (Sender as TStretchHandle).HandlePosition;
end else
StretchMode := smDrag;
(Parent as TPanel).OnMouseMove(Self, Shift, X, Y);
end;
end;
procedure TBaseField.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
I : Integer;
P : TPoint;
begin
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
{Move all StretchHandles to the proper positions}
for I := Low(bfStretchHandles) to High(bfStretchHandles) do
if Assigned(bfStretchHandles[I]) then
with bfStretchHandles[I] do begin
P := GetStretchHandleCoords(HandlePosition);
SetBounds(P.X, P.Y, Width, Height);
end;
end;
procedure TBaseField.SetParent(AParent: TWinControl);
function CreateStretchHandle(WhichHandle : TStretchModes) : TStretchHandle;
var
P : TPoint;
begin
P := GetStretchHandleCoords(WhichHandle);
Result := TStretchHandle.Create(Self);
with Result do begin
HandlePosition := WhichHandle;
Parent := AParent;
Visible := Selected;
OnMouseDown := bfMouseDown;
OnMouseUp := bfMouseUp;
OnMouseMove := bfMouseMove;
SetBounds(P.X, P.Y, Width, Height);
end;
end;
const
ctStretchHandleCorners :
array[Low(TStretchHandleArray)..High(TStretchHandleArray)] of TStretchModes =
(smNW, smN, smNE, smE, smSE, smS, smSW, smW);
var
I : Integer;
begin
if AParent <> Parent then begin
inherited SetParent(AParent);
if Assigned(AParent) then begin
OnMouseDown := (AParent as TPanel).OnMouseDown;
OnMouseUp := (AParent as TPanel).OnMouseUp;
OnMouseMove := (AParent as TPanel).OnMouseMove;
{If StretchHandles already exist, destroy them}
for I := Low(bfStretchHandles) to High(bfStretchHandles) do
if Assigned(bfStretchHandles[I]) then begin
bfStretchHandles[I].Free;
bfStretchHandles[I] := nil;
end;
{Create new StretchHandles}
for I := Low(bfStretchHandles) to High(bfStretchHandles) do
bfStretchHandles[I] := CreateStretchHandle(ctStretchHandleCorners[I]);
end else begin
OnMouseDown := nil;
OnMouseUp := nil;
OnMouseMove := nil;
end;
end;
end;
procedure TBaseField.SetSelected(IsSelected : Boolean);
var
I : Integer;
begin
if IsSelected <> FSelected then begin
FSelected := IsSelected;
for I := Low(bfStretchHandles) to High(bfStretchHandles) do
with bfStretchHandles[I] do begin
Visible := FSelected;
{BringToFront to ensure that if this is a TImageField, StretchHandle
isn't partially hidden behind the image}
if FSelected then
BringToFront;
end;
Refresh;
end;
end;
function TBaseField.GetStretchHandleCoords(WhichHandle : TStretchModes) : TPoint;
{-Returns the coordinates (Left, Top) where the StretchHandle should be drawn}
var
Offset : Integer;
begin
with Result do
case WhichHandle of
smNW : begin
Offset := ctStretchHandleSize div 2;
X := Left - Offset;
Y := Top - Offset;
end;
smN : begin
Offset := ctStretchHandleSize div 2;
X := Left + (Width div 2) - Offset;
Y := Top - Offset;
end;
smNE : begin
Offset := (ctStretchHandleSize + 1) div 2;
X := Left + Width - Offset;
Offset := ctStretchHandleSize div 2;
Y := Top - Offset;
end;
smE : begin
Offset := (ctStretchHandleSize + 1) div 2;
X := Left + Width - Offset;
Offset := ctStretchHandleSize div 2;
Y := Top + (Height div 2) - Offset;
end;
smSE : begin
Offset := (ctStretchHandleSize + 1) div 2;
X := Left + Width - Offset;
Y := Top + Height - Offset;
end;
smS : begin
Offset := ctStretchHandleSize div 2;
X := Left + (Width div 2) - Offset;
Offset := (ctStretchHandleSize + 1) div 2;
Y := Top + Height - Offset;
end;
smSW : begin
Offset := ctStretchHandleSize div 2;
X := Left - Offset;
Offset := (ctStretchHandleSize + 1) div 2;
Y := Top + Height - Offset;
end;
smW : begin
Offset := ctStretchHandleSize div 2;
X := Left - Offset;
Y := Top + (Height div 2) - Offset;
end;
else begin
X := 0;
Y := 0;
end;
end;
end;
procedure TBaseField.Read(Stream : TStream);
var
FieldRec : TFieldRecord;
begin
Stream.ReadBuffer(FieldRec, SizeOf(FieldRec));
if Parent is TFaxPanel then
with (Parent as TFaxPanel), FieldRec do begin
Self.Left := HorzInchesToPixels(frLeftInches);
Self.Top := VertInchesToPixels(frTopInches);
Self.Width := HorzInchesToPixels(frWidthInches);
Self.Height := VertInchesToPixels(frHeightInches);
end;
end;
procedure TBaseField.Write(Stream : TStream);
var
FieldRec : TFieldRecord;
begin
FillChar(FieldRec, SizeOf(FieldRec), 0);
if Parent is TFaxPanel then
with (Parent as TFaxPanel), FieldRec do begin
frLeftInches := HorzPixelsToInches(Self.Left);
frTopInches := VertPixelsToInches(Self.Top);
frWidthInches := HorzPixelsToInches(Self.Width);
frHeightInches := VertPixelsToInches(Self.Height);
end;
Stream.WriteBuffer(FieldRec, SizeOf(FieldRec));
end;
{*** TTextField ***}
constructor TTextField.Create(AOwner: TComponent);
const
ctDefWidth = 200;
var
Items1:TMenuItem;
begin
inherited Create(AOwner);
Pen.Style := psClear; {Don't need the TShape border because FMemo will have a border}
FpopupMenu:=TPopupMenu.Create(self);
Items1:=TMenuItem.Create(self);
Items1.Caption:='載入文本';
Items1.OnClick:=OnLoadFromFile;
FPopupmenu.Items.Add(items1);
FMemo := TMemo.Create(Self);
FMemo.PopupMenu:=FPopupMenu;
with FMemo do begin
Ctl3D := False;
ParentCtl3D := False;
WordWrap := True;
OnMouseDown := bfMouseDown;
OnMouseUp := bfMouseUp;
OnMouseMove := bfMouseMove;
OnDblClick := MemoDblClick;
OnEnter := tfEnter;
OnExit := tfExit;
end;
FMemo.Font.Name:='宋體';
FMemo.Font.Size:=11;
SetBounds(Left, Top, ctDefWidth, Height);
end;
procedure TTextField.Draw(ACanvas : TCanvas);
procedure ReplaceTags(TagStr : string;
const ReplaceStr : string;
var TargetStr : string);
var
Posn : Integer;
TempStr : string;
begin
TagStr := UpperCase(TagStr);
repeat
TempStr := UpperCase(TargetStr);
Posn := Pos(TagStr, TempStr);
if Posn > 0 then begin
Delete(TargetStr, Posn, Length(TagStr));
Insert(ReplaceStr, TargetStr, Posn);
end;
until Posn = 0;
end;
var
I : Integer;
X, Y : Integer;
TextHeight : Integer;
S : string;
DateStr : string;
TimeStr : string;
begin
with FMemo do begin
ACanvas.Font := Font;
TextHeight := GetTextHeight;
{Format date string to use for $D replacement tag}
DateStr := DateToStr(Date);
{Format time string to use for $T replacement tag}
TimeStr := TimeToStr(Time);
Delete(TimeStr, Length(TimeStr) - 5, 4); {Strip off the seconds}
TimeStr := LowerCase(TimeStr); {Convert AM or PM to lower case}
X := Round((Parent as TFaxPanel).DrawAdjustFactor * Self.Left);
for I := 0 to Lines.Count - 1 do begin
S := Lines[I];
{Look for replaceable tags and do replacements as required}
ReplaceTags('$D', DateStr, S);
ReplaceTags('$T', TimeStr, S);
ReplaceTags('$N', IntToStr((Parent as TFaxPanel).PageCount), S);
ReplaceTags('$P', IntToStr((Parent as TFaxPanel).PageNumber), S);
ReplaceTags('$F', (Parent as TFaxPanel).Sender, S);
ReplaceTags('$R', (Parent as TFaxPanel).Recipient, S);
ReplaceTags('$S', (Parent as TFaxPanel).PageTitle, S);
ReplaceTags('$I', (Parent as TFaxPanel).StationID, S);
Y := Round((Parent as TFaxPanel).DrawAdjustFactor * (Self.Top + (I * TextHeight)));
ACanvas.TextOut(X, Y, S);
end;
end;
end;
procedure TTextField.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
if Assigned(FMemo) then
FMemo.SetBounds(ALeft, ATop, AWidth, AHeight);
end;
procedure TTextField.SetParent(AParent: TWinControl);
var
NewHeight : Integer;
begin
inherited SetParent(AParent);
if Assigned(FMemo) then begin
FMemo.Parent := AParent;
{If no text has yet been entered, get the height of one row of text for the
current font, and adjust the field height to match}
if (FMemo.Text = '') and Assigned(AParent) then begin
NewHeight := GetTextHeight + 4;
{If SnapToGrid is enabled, adjust height to fall on a grid line}
with Parent as TFaxPanel do
if SnapToGrid then
AdjustHeightToGrid(Top, NewHeight);
SetBounds(Left, Top, Width, NewHeight);
end;
if AParent is TFaxPanel then
FMemo.OnChange := (AParent as TFaxPanel).FieldChange;
end;
end;
procedure TTextField.SetFocus;
begin
FMemo.SetFocus;
end;
function TTextField.GetTextHeight : Integer;
var
Canvas : TCanvas;
TextMetric : TTextMetric;
begin
Canvas := TCanvas.Create;
try
Canvas.Handle := GetDC(FMemo.Handle);
try
Canvas.Font := FMemo.Font;
GetTextMetrics(Canvas.Handle, TextMetric);
with TextMetric do
Result := tmHeight + tmExternalLeading;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -