100分求如何实现memo垂直对齐（靠上，居中，靠下）？

[野草飞雪]

实现memo垂直对齐（靠上，居中，靠下），如同Label的属性Layout(tlTop,tlCenter,tlBottom).
请各位朋友帮忙解决！谢谢！

[fim]

procedure SetMemoLayout(AMemo : TMemo;ALayout : Integer);
var
R : TRect;
begin
R := AMemo.ClientRect;
case ALayout of
0 : ; //tlTop
1 : OffSetRect(R,0,R.Bottom div 2 - 13); //tlCenter
2 : OffSetRect(R,0,R.Bottom - 13); //tlBoottm
else
end;
SendMessage(AMemo.Handle,EM_SETRECT,0,LParam(@R));
end;

适用于memo文本只有一行的情况，多行时要自己算一下Rect,应该不算太难。

[野草飞雪]

希望高手帮忙！谢谢！

[_xyzzxy]

Memo 的 Align 属性不就可以了吗?

[野草飞雪]

to Tomiki(友树) :你好！如果是这样的话，我也不可能提问。在这里提问，一般经过较长时间考虑后没有结果。如果我真得有那么粗心的话，问题一提出，第一位帮忙的朋友早已提醒我了或者会训我一顿！

Memo 的 Align 属性是Memo相对于界面而言的！

[野草飞雪]

希望高手帮忙解决！

[sxy_9761]

我不是很明白你的意思,是不是下面这个效果

procedure TForm1.Button1Click(Sender: TObject);
var
tStyle : integer;
begin
tStyle := GetWindowLong(Memo1.Handle,GWL_STYLE);
tStyle := tStyle or ES_CENTER;
SetWindowLong(Memo1.Handle,GWL_STYLE,tStyle);
end;

[cjfden]

up

[lwk_hlj]

Edit&Memo控件的文本得对齐方式

如何使TEDIT控件中的TEXT显示在控件的中间或下面(一般在上面),

像TLABEL中的LAYOUT至为CENTER一样

var

Rct: TRect;

begin

Rct := edit1.ClientRect;

Inc(Rct.Top, 3);

sendmessage(edit1.handle, EM_SETRECT, 0, Integer(@Rct));

end;

EM_SETRECT 只对于 Multiline Edit 有效？ :-)

An application sends an EM_SETRECT message to set the formatting rectangle of a

multiline edit control.

换成 Memo 就可以了。

procedure TForm1.Button2Click(Sender: TObject);

var

Rct: TRect;

begin

SendMessage(Memo1.Handle, EM_GETRECT, 0, Integer(@Rct));

Inc(Rct.Top, 5);

SendMessage(Memo1.Handle, EM_SETRECT, 0, Integer(@Rct));

end;

那也简单, 那些语句前加一句

SetWindowLong(edit.Handle,GWL_STYLE, GetWindowLong(edit.Handle, GWL_STYLE) or ES_MULTILINE);

不过需要多写个OnKeyPress事件过滤掉输入的回车符.

最好自己继承TEdit做个有这功能的控件. 事实上很简单的.

unit JackEdit;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TKeySet = (ksReturn, ksEscape);

TKeySets = set of TKeySet;

TJackEdit = class(TEdit)

private

{ Private declarations }

FAlignment: TAlignment;

FKeys: TKeySets;

procedure SetAlignment(value: TAlignment);

protected

{ Protected declarations }

procedure CreateParams(var Params: TCreateParams); override;

procedure KeyPress(var Key: Char); override;

public

{ Public declarations }

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

published

{ Published declarations }

property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;

property Keys: TKeySets read FKeys write FKeys;

end;

　

procedure Register;

implementation

procedure TJackEdit.SetAlignment(value: TAlignment);

begin

if value <> FAlignment then

begin

FAlignment := value;

RecreateWnd;

end;

end;

procedure TJackEdit.KeyPress(var Key: Char);

begin

if ksReturn in Keys then

begin

if Key = Chr(Vk_Return) then

begin

Key := Chr(0);

(Owner as TControl).Perform(wm_NextDlgCtl,0,0);

end;

end;

if ksEscape in Keys then

begin

if Key = Chr(Vk_Escape) then

begin

Key := Chr(0);

(Owner as TControl).Perform(wm_NextDlgCtl,1,0);

end;

end;

inherited KeyPress(Key);

end;

procedure TJackEdit.CreateParams(var Params: TCreateParams);

begin

inherited CreateParams(Params);

case Alignment of

taLeftJustify : Params.Style := Params.Style or (ES_LEFT or Es_MULTILINE);

taRightJustify : Params.Style := Params.Style or (ES_RIGHT or ES_MULTILINE);

taCenter : Params.Style := Params.Style or (ES_CENTER or Es_MULTILINE);

end;

end;

constructor TJackEdit.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

FAlignment := taLeftJustify;

end;

destructor TJackEdit.Destroy;

begin

inherited Destroy;

end;

procedure Register;

begin

RegisterComponents('Jack', [TJackEdit]);

end;

end.

[野草飞雪]

to lwk_hlj(阿凯(为双星努力)) :
你好！谢谢你粘贴！但是粘贴之前最好自己先浏览一遍！

[野草飞雪]

to lijinghe1(副乡长) :你好！
恕我菜鸟，不清楚此算法，能否帮忙一下，具体给出计算矩形区域的算法（含源码）！谢谢！

[gegangqiao]

如果复杂一点可以先计算MEMO的宽度再计算对应行字符的长度再在前面加上空格和删除空格

[cherrylin]

难道真没有人可以解决这个问题吗?我也很希望得到解决答案啊!
高手帮忙啊!

[野草飞雪]

up!

[lijinghe1]

to lijinghe1(副乡长) :你好！这个方法很早就试过，效果不理想，有时根本不行！
------------------------------------------

这种方法方法效果好与不好，关键在于计算矩形区域的算法。在borland新闻组讨论过这个问题，一位TeamB成员声称没有别的方法。

[SuanAddMiao]

就用Lable算了。

[zswangII]

//根据fim的方案修改～～

procedure SetMemoLayout(AMemo: TMemo; ALayout: Integer);
var
vRect: TRect;
vCanvas: TControlCanvas;
vHeight: Integer;
vLineCount: Integer;
begin
if AMemo.Lines.Count <= 0 then
vLineCount := 1
else vLineCount := AMemo.Lines.Count +
Ord(Pos(#13#10#0#0, AMemo.Lines.Text + #0#0) > 0);

vCanvas := TControlCanvas.Create;
try
vCanvas.Control := AMemo;
vCanvas.Font.Assign(AMemo.Font);
vHeight := vLineCount * vCanvas.TextHeight('|');
finally
vCanvas.Free;
end;

vRect := AMemo.ClientRect;
case ALayout of
0: ; //tlTop
1: vRect.Top := (AMemo.ClientHeight - vHeight) div 2; //tlCenter
2: vRect.Top := AMemo.ClientHeight - vHeight; //tlBoottm
else
end;
vRect.Bottom := vRect.Top + vHeight + 10;
if (vRect.Top < AMemo.ClientRect.Top) or
(vRect.Bottom > AMemo.ClientRect.Bottom) then
vRect := AMemo.ClientRect;
AMemo.Perform(EM_SETRECT, 0, Integer(@vRect));
end; { SetMemoLayout }

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
SetMemoLayout(Memo3, RadioGroup1.ItemIndex);
end;

procedure TForm1.Memo3Change(Sender: TObject);
begin
SetMemoLayout(TMemo(Sender), RadioGroup1.ItemIndex);
end;

[yinran]

这个问题有点棘手，考虑考虑！

[cherrylin]

以下是我自已在透明的TMemo中的TextLayou属性,可以实现靠上靠下居中功能,但是就是在设置TextLayout属性时候Memo却无法透明了,这里人多,哪位高手帮我看一下啊?
unit UsrMemo;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls;

type
TCtrl = class(TWinControl);

TTextLayout = (tlTop, tlCenter, tlBottom);

TUsrMemo = class(TMemo)
private
FTransparent: Boolean; //透明
FPainting: Boolean;
FModiFlag:Boolean;
FCanvas:TCanvas;
FTextLayout:TTextLayout; //靠上靠下居中
procedure SetTransparent(Value: Boolean);
procedure SetModiFlag(Value:Boolean);
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
procedure CNCtlColorEdit(var Message: TWMCtlColorEdit); message CN_CTLCOLOREDIT;
procedure CNCtlColorStatic(var Message: TWMCtlColorStatic); message CN_CTLCOLORSTATIC;
procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMMove(var Message: TWMMove); message WM_MOVE;
function GetTextLayout: TTextLayout;
procedure SetTextLayout(Value: TTextLayout);
procedure DrawText;
protected
procedure RepaintWindow;
procedure Change; override;
procedure SetParent(AParent: TWinControl); override;
function GetMemoText: string; virtual; //得到内容
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas: TCanvas read FCanvas;
published
property Transparent: Boolean read FTransparent write SetTransparent default false;
property ModiFlag:Boolean read FModiFlag write SetModiFlag default False;
property TextLayout: TTextLayout read GetTextLayout write SetTextLayout default tlTop;
end;

procedure Register;
implementation

const
BorderRec: array[TBorderStyle] of Integer = (1, -1);

procedure Register;
begin
RegisterComponents('EU', [TUsrMemo]);
end;

function GetScreenClient(Control: TControl): TPoint;
var
p: TPoint;
begin
p := Control.ClientOrigin;
ScreenToClient(Control.Parent.Handle, p);
Result := p;
end;

constructor TUsrMemo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FTransparent := False;
FPainting := false;
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
end;

destructor TUsrMemo.Destroy;
begin
inherited Destroy;
end;

procedure TUsrMemo.SetTransparent(Value: Boolean);
begin
if FTransparent <> Value then
begin
FTransparent := Value;
Invalidate;
end;
end;

procedure TUsrMemo.SetModiFlag(Value:Boolean);
begin
if FModiFlag <> Value then
begin
FModiFlag :=Value;
Invalidate;
end;
end;

procedure TUsrMemo.WMEraseBkGnd(var Message: TWMEraseBkGnd);
var
DC: hDC;
i: integer;
p: TPoint;
begin
if FTransparent then
begin
if Assigned(Parent) then
begin
DC := Message.DC;
i := SaveDC(DC);
p := GetScreenClient(self);
p.x := -p.x;
p.y := -p.y;
MoveWindowOrg(DC, p.x, p.y);
SendMessage(Parent.Handle, $0014, DC, 0);
TCtrl(Parent).PaintControls(DC, nil);
RestoreDC(DC, i);
end;
end
else
inherited;
end;

procedure TUsrMemo.WMPaint(var Message: TWMPaint);
begin
inherited;
if FTransparent then
if not FPainting then
RepaintWindow;
end;

procedure TUsrMemo.WMNCPaint(var Message: TMessage);
begin
inherited;
end;

procedure TUsrMemo.CNCtlColorEdit(var Message: TWMCtlColorEdit);
begin
inherited;
if FTransparent then
SetBkMode(Message.ChildDC, 1);
end;

procedure TUsrMemo.CNCtlColorStatic(var Message: TWMCtlColorStatic);
begin
inherited;
if FTransparent then
SetBkMode(Message.ChildDC, 1);
end;
procedure TUsrMemo.CMParentColorChanged(var Message: TMessage);
begin
inherited;
if FTransparent then
Invalidate;
end;

procedure TUsrMemo.WMSize(var Message: TWMSize);
begin
inherited;
Invalidate;
end;

procedure TUsrMemo.WMMove(var Message: TWMMove);
begin
inherited;
Invalidate;
end;

procedure TUsrMemo.RepaintWindow;
var
DC: hDC;
TmpBitmap, Bitmap: hBitmap;
begin
if FTransparent then
begin
FPainting := true;
HideCaret(Handle);
DC := CreateCompatibleDC(GetDC(Handle));
TmpBitmap := CreateCompatibleBitmap(GetDC(Handle), Succ(ClientWidth), Succ(ClientHeight));
Bitmap := SelectObject(DC, TmpBitmap);
PaintTo(DC, 0, 0);
BitBlt(GetDC(Handle), BorderRec[BorderStyle], BorderRec[BorderStyle], ClientWidth, ClientHeight, DC, 1, 1,
SRCCOPY);
SelectObject(DC, Bitmap);
DeleteDC(DC);
ReleaseDC(Handle, GetDC(Handle));
DeleteObject(TmpBitmap);
ShowCaret(Handle);
FPainting := false;
end;
end;

procedure TUsrMemo.Change;
begin
RepaintWindow;
inherited Change;
end;

procedure TUsrMemo.SetParent(AParent: TWinControl);
begin
inherited SetParent(AParent);
end;

function TUsrMemo.GetTextLayout: TTextLayout;
begin
Result := FTextLayout;
end;

procedure TUsrMemo.SetTextLayout(Value:TTextLayout); //Layout属性
begin
FTextLayout:=Value;
DrawText;
end;

function TUsrMemo.GetMemoText: string;
begin
Result :=Trim(Text);
end;

procedure TUsrMemo.DrawText; //垂直对齐
var
Rct: TRect;
YOffset:integer;
Text:string;
begin
Text :=GetMemoText;
case FTextLayout of
tlTop: YOffset := 0;
tlCenter: YOffset := (ClientHeight - Canvas.TextHeight(Text)) div 2 + 1;
tlBottom: YOffset := ClientHeight - Canvas.TextHeight(Text);
else
YOffset := 0;
end;
Rct:=Rect(0,0,ClientWidth,ClientHeight);
Canvas.TextRect(Rct,0,YOffset,Text);
end;

end.

[野草飞雪]

自己顶！

[野草飞雪]

再顶！