?? faxfield.bak
字號:
finally
ReleaseDC(FMemo.Handle, Canvas.Handle);
end;
finally
Canvas.Free;
end;
end;
procedure TTextField.MemoDblClick(Sender: TObject);
var
NewHeight : Integer;
LineCount : Integer;
FontDialog : TFontDialog;
begin
FontDialog := TFontDialog.Create(nil);
try
FontDialog.Font := FMemo.Font;
if FontDialog.Execute then begin
FMemo.Font := FontDialog.Font;
{Adjust field height to allow for the new font size}
LineCount := FMemo.Lines.Count;
if LineCount < 1 then
LineCount := 1;
NewHeight := GetTextHeight * LineCount + 4;
Constrain(NewHeight, 0, (Parent as TWinControl).Height - Top);
{If SnapToGrid is enabled, adjust height to fall on a grid line}
if (Parent as TFaxPanel).SnapToGrid then
(Parent as TFaxPanel).AdjustHeightToGrid(Top, NewHeight);
SetBounds(Left, Top, Width, NewHeight);
if FSelected then begin
(Parent as TFaxPanel).FieldPositionChange(Left, Top, Width, Height);
{Set Ruler position marks to the new coordinates}
if (Parent as TFaxPanel).Owner is TFaxDesigner then
((Parent as TFaxPanel).Owner as TFaxDesigner).SetMarkPositions(Left, Top, Width, Height);
end;
end;
if Parent is TFaxPanel then
(Parent as TFaxPanel).FieldChange(nil);
finally
FontDialog.Free;
end;
end;
procedure TTextField.OnLoadFromFile(Sender: TObject);
var
OpenDialog : TOpenDialog;
begin
OpenDialog := TOpenDialog.Create(nil);
OpenDialog.Filter:='文本文件 (*.txt)|*.TXT|所有文件(*.*)|*.*';
if OpenDialog.Execute then
begin
FMemo.WordWrap:=true;
FMemo.Lines.LoadFromFile(OpenDialog.FileName);
end;
end;
function TTextField.GetText : string;
begin
if Assigned(FMemo) then
Result := FMemo.Text
else
Result := '';
end;
type
TLocalMemo = class(TMemo);
procedure TTextField.tfEnter(Sender : TObject);
var
PF : {$IFDEF DELPHI3}TCustomForm{$ELSE}TForm{$ENDIF};
begin
if (Parent as TFaxPanel).EditMode then begin
TLocalMemo(FMemo).SetDesigning(False);
end else begin
PF := GetParentForm(FMemo);
PF.DefocusControl(FMemo, False);
TLocalMemo(FMemo).SetDesigning(True);
end;
end;
procedure TTextField.tfExit(Sender : TObject);
begin
TLocalMemo(FMemo).SetDesigning(True);
end;
procedure TTextField.Read(Stream : TStream);
var
BufSize : LongInt;
Buffer : PChar;
FontRec : TFontRecord;
begin
{Read BaseField properties}
inherited Read(Stream);
{Read the font properties and assign them to TMemo.Font}
Stream.ReadBuffer(FontRec, SizeOf(FontRec));
with FMemo.Font, FontRec do begin
{$IFDEF DELPHI3}
CharSet := TFontCharSet(frCharSet);
{$ENDIF}
Color := TColor(frColor);
Height := frHeight;
Name := frName;
Pitch := TFontPitch(frPitch);
Size := frSize;
Style := [];
if frFontBold then
Style := Style + [fsBold];
if frFontItalic then
Style := Style + [fsItalic];
if frFontUnderline then
Style := Style + [fsUnderline];
if frFontStrikeout then
Style := Style + [fsStrikeout];
end;
{Read the buffer size needed to store the text}
Stream.ReadBuffer(BufSize, SizeOf(BufSize));
{If text exists, read it into the buffer and assign it to the TMemo}
if BufSize > 1 then begin
GetMem(Buffer, BufSize);
try
FillChar(Buffer^, BufSize, 0);
Stream.ReadBuffer(Buffer^, BufSize);
FMemo.Text := StrPas(Buffer);
finally
FreeMem(Buffer, BufSize);
end;
end;
end;
procedure TTextField.Write(Stream : TStream);
var
FieldType : Byte;
BufSize : LongInt;
Buffer : PChar;
FontRec : TFontRecord;
begin
{First thing to write out is the field type}
FieldType := ftTextField;
Stream.WriteBuffer(FieldType, SizeOf(FieldType));
{Write out BaseField properties}
inherited Write(Stream);
{Initialize FontRec with the font properties and write it out}
with FMemo.Font, FontRec do begin
{$IFDEF DELPHI3}
frCharSet := Ord(CharSet);
{$ELSE}
frCharSet := 0;
{$ENDIF}
frColor := Color;
frHeight := Height;
frName := Name;
frPitch := Ord(Pitch);
frSize := Size;
frFontBold := fsBold in Style;
frFontItalic := fsItalic in Style;
frFontUnderline := fsUnderline in Style;
frFontStrikeout := fsStrikeout in Style;
end;
Stream.WriteBuffer(FontRec, SizeOf(FontRec));
{Find out how big a buffer we need, and write out the buffer size}
BufSize := FMemo.GetTextLen + 1; {Add one to allow for null character}
Stream.WriteBuffer(BufSize, SizeOf(BufSize));
{If the buffer isn't empty, get the memo text and write it out}
if BufSize > 1 then begin
GetMem(Buffer, BufSize);
try
FillChar(Buffer^, BufSize, 0);
FMemo.GetTextBuf(Buffer, BufSize);
Stream.WriteBuffer(Buffer^, BufSize);
finally
FreeMem(Buffer, BufSize);
end;
end;
end;
{------------------------------ TImageField --------------------------------}
constructor TImageField.Create(AOwner: TComponent);
const
DefWidth = 120;
DefHeight = 120;
begin
inherited Create(AOwner);
FImage := TImage.Create(Self);
with FImage do begin
Stretch := True;
OnMouseDown := bfMouseDown;
OnMouseUp := bfMouseUp;
OnMouseMove := bfMouseMove;
OnDblClick := ImageDblClick;
end;
SetBounds(Left, Top, DefWidth, DefHeight);
end;
procedure TImageField.Draw(ACanvas : TCanvas);
var
AdjustFactor : Double;
begin
if not FImage.Picture.Bitmap.Empty then begin
AdjustFactor := (Parent as TFaxPanel).DrawAdjustFactor;
ACanvas.StretchDraw(Rect(Round(Left * AdjustFactor), Round(Top * AdjustFactor),
Round((Left + Width) * AdjustFactor),
Round((Top + Height) * AdjustFactor)),
FImage.Picture.Bitmap);
end;
end;
function TImageField.GetPicture : TPicture;
begin
if Assigned(FImage) then
Result := FImage.Picture
else
Result := nil;
end;
procedure TImageField.ImageDblClick(Sender: TObject);
var
{$IFDEF DELPHI3}
PictureDialog : TOpenPictureDialog;
{$ELSE}
PictureDialog : TOpenDialog;
{$ENDIF}
I : Integer;
Ext:String;
image1:TImage;
bmp:TBitmap;
begin
{$IFDEF DELPHI3}
PictureDialog := TOpenPictureDialog.Create(nil);
{$ELSE}
PictureDialog := TOpenDialog.Create(nil);
{$ENDIF}
try
{$IFNDEF DELPHI3}
PictureDialog.Filter := 'Bitmap files|*.BMP';
{$ENDIF}
PictureDialog.Options := [ofHideReadOnly, ofFileMustExist,
ofPathMustExist, ofNoChangeDir];
if PictureDialog.Execute then begin
Ext:=Uppercase(ExtractFileExt(PictureDialog.FileName));
if (Ext='.JPG') or (Ext='.JPEG') then
begin
image1:=Timage.Create(self);
image1.picture.loadfromfile(pictureDialog.filename);
bmp:=TBitmap.create;
bmp.assign(TJPEGImage(image1.picture.Graphic));
Fimage.Picture.Bitmap:=bmp;
end
else
FImage.Picture.LoadFromFile(PictureDialog.FileName);
FImage.Visible := True;
{Bring all StretchHandles to front so they draw on top of the image}
for I := Low(bfStretchHandles) to High(bfStretchHandles) do
bfStretchHandles[I].BringToFront;
if Parent is TFaxPanel then
(Parent as TFaxPanel).FieldChange(nil);
end;
finally
PictureDialog.Free;
end;
end;
procedure TImageField.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
if Assigned(FImage) then
FImage.SetBounds(ALeft, ATop, AWidth, AHeight);
end;
procedure TImageField.SetParent(AParent: TWinControl);
begin
inherited SetParent(AParent);
if Assigned(FImage) then
FImage.Parent := AParent;
end;
type
TLocalBitmap = class(TBitmap);
procedure TImageField.Read(Stream : TStream);
var
IsEmpty : Boolean;
begin
{Read BaseField properties}
inherited Read(Stream);
{Read the IsEmpty value to determine if a bitmap exists}
Stream.ReadBuffer(IsEmpty, SizeOf(IsEmpty));
{If we have a bitmap, read it in}
if not IsEmpty then
TLocalBitmap(FImage.Picture.Bitmap).ReadData(Stream);
{ReadData is used because when using SaveToStream/LoadFromStream,
LoadFromStream assumes that the bitmap occupies the remaining data
in the stream, therefor no other items can be stored after the bitmap.
ReadData first reads in the size of the bitmap.
The WriteData/ReadData routines are protected, but the type-cast using
a local class alias allow us to access them anyway}
{FImage.Picture.Bitmap.LoadFromStream(Stream);}
end;
procedure TImageField.Write(Stream : TStream);
var
FieldType : Byte;
IsEmpty : Boolean;
begin
{First thing to write out is the field type}
FieldType := ftImageField;
Stream.WriteBuffer(FieldType, SizeOf(FieldType));
{Write out BaseField properties}
inherited Write(Stream);
{Determine whether a Bitmap is assigned and write this boolean value out}
IsEmpty := FImage.Picture.Bitmap.Empty;
Stream.WriteBuffer(IsEmpty, SizeOf(IsEmpty));
{If we have a bitmap, write it out}
if not IsEmpty then
TLocalBitmap(FImage.Picture.Bitmap).WriteData(Stream);
{WriteData is used because when using SaveToStream/LoadFromStream,
LoadFromStream assumes that the bitmap occupies the remaining data
in the stream, therefor no other items can be stored after the bitmap.
WriteData first writes out the size of the bitmap data.
The WriteData/ReadData routines are protected, but the type-cast using
a local class alias allow us to access them anyway}
{FImage.Picture.Bitmap.SaveToStream(Stream);}
end;
{*** TFaxPanel ***}
constructor TFaxPanel.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FGridSpacingX := ctGridSpacingX;
FGridSpacingY := ctGridSpacingY;
OnResize := fpResize;
OnMouseDown := fpMouseDown;
OnMouseUp := fpMouseUp;
OnMouseMove := fpMouseMove;
fpFieldList := TList.Create;
end;
destructor TFaxPanel.Destroy;
begin
{Destroy all items in fpFieldList}
DeleteAllFields;
{Now destroy the list itself}
fpFieldList.Free;
inherited Destroy;
end;
function TFaxPanel.GetFieldCount : Integer;
begin
Result := fpFieldList.Count;
end;
function TFaxPanel.GetField(Index : Integer) : TBaseField;
begin
Result := TBaseField(fpFieldList[Index]);
end;
function TFaxPanel.GetSelectedField : TBaseField;
var
I : Integer;
begin
for I := fpFieldList.Count - 1 downto 0 do begin
Result := fpFieldList[I];
if Result.Selected then
Exit;
end;
Result := nil;
end;
procedure TFaxPanel.SetEditMode(Value : Boolean);
var
I : Integer;
Field : TBaseField;
begin
if Value <> FEditMode then begin
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -