Procedure PrintFixON (F: Tform);
//Alle Ableitungen von Tcustomcombobox (Tcombobox, TIB_Combobox) drucken nicht bei form.print oder form.getimage
//Style temporär von csdropdown auf csdropdownlist umstellen; mit der PrintFixOFF wieder zurück
VAR I :Integer;
Imag : Timage;
Begin
For I:=0
to f.ComponentCount-1
do
Begin
if F.Components[i]
is TComboBox
then
begin
with TComboBox( F.Components[i])
do
begin
items.add(text);
// make sure the current item is in the list
style:=csDropDownList;
// do the magic
itemindex:=items.count-1;
end;
end;
if F.Components[i]
is TIB_ComboBox
then
begin
with TIB_ComboBox( F.Components[i])
do
begin
items.add(text);
// make sure the current item is in the list
style:=csDropDownList;
// do the magic
itemindex:=items.count-1;
end;
end;
end;
// jetzt die Richedits checken und Images drüber legen
For I:=0
to f.ComponentCount-1
do
Begin
if f.components[i]
is TCustomRichedit
then
with Tcustomrichedit(f.components[i])
do
Begin
Imag:=TImage.create(f);
Imag.
name:='
FIXImage'+InttoStr(I);
Imag.top:=top;
imag.left:=left;
imag.height:=height;
imag.width:=width;
imag.Parent:=Parent;
RichEditToCanvas(Tcustomrichedit(f.components[i]), Imag.Canvas, f.PixelsPerInch);
Imag.Refresh;
visible:=false;
end;
end;
application.ProcessMessages;
end;
procedure RichEditToCanvas(RichEdit: TCustomRichEdit; Canvas: TCanvas; PixelsPerInch: Integer);
var
ImageCanvas: TCanvas;
fmt: TFormatRange;
begin
ImageCanvas := Canvas;
with fmt
do
begin
hdc:= ImageCanvas.Handle;
hdcTarget:= hdc;
// rect needs to be specified in twips (1/1440 inch) as unit
rc:= Rect(0, 0,
ImageCanvas.ClipRect.Right * 1440
div PixelsPerInch,
ImageCanvas.ClipRect.Bottom * 1440
div PixelsPerInch
);
rcPage:= rc;
chrg.cpMin := 0;
chrg.cpMax := RichEdit.GetTextLen;
end;
SetBkMode(ImageCanvas.Handle, TRANSPARENT);
RichEdit.Perform(EM_FORMATRANGE, 1, Integer(@fmt));
// next call frees some cached data
RichEdit.Perform(EM_FORMATRANGE, 0, 0);
end;
Procedure PrintFixOff (F: Tform);
VAR I :Integer;
Begin
For I:=0
to f.ComponentCount-1
do
Begin
if f.Components[i]
is TComboBox
then
begin
with TComboBox(F.Components[i])
do
begin
style:=csDropDown;
text:=items[items.count-1];
items.delete(items.count-1);
end;
end;
if f.Components[i]
is TIB_ComboBox
then
begin
with TIB_ComboBox(F.Components[i])
do
begin
style:=csDropDown;
text:=items[items.count-1];
items.delete(items.count-1);
end;
end;
end;
//jetzt die Images löschen und die Richedits wieder sichtbar machen
For I:=f.ComponentCount-1
downto 0
do
Begin
if f.components[i]
is TCustomRichedit
then
Tcustomrichedit(f.components[i]).visible:=true
else if f.components[i]
is TImage
then
with Timage(f.components[i])
do
Begin
if copy(
name,1,8)='
FIXImage'
then free;
end;
end;
application.ProcessMessages;
end;