99f838537c
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@73 8e941d3f-bd1b-0410-a28a-d453659cc2b4
117 lines
2.5 KiB
ObjectPascal
117 lines
2.5 KiB
ObjectPascal
unit RVLazIntf;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses Types, LCLType, LMessages;
|
|
|
|
type
|
|
TWMSize = TLMSize;
|
|
TWMEraseBkgnd = TLMEraseBkgnd;
|
|
TMessage = TLMessage;
|
|
TSize = Types.TSize;
|
|
TWMHScroll = TLMHScroll;
|
|
TWMVScroll = TLMVScroll;
|
|
TWMKeyDown = TLMKeyDown;
|
|
TWMGetDlgCode = TLMNoParams;
|
|
|
|
|
|
const
|
|
WM_SIZE = LM_SIZE;
|
|
WM_ERASEBKGND = LM_ERASEBKGND;
|
|
WM_HSCROLL = LM_HSCROLL;
|
|
WM_VSCROLL = LM_VSCROLL;
|
|
WM_KEYDOWN = LM_KEYDOWN;
|
|
WM_GETDLGCODE = LM_GETDLGCODE;
|
|
CM_MOUSELEAVE = $B000+20;
|
|
|
|
// todo:
|
|
// - this should go to TWidgetset.GetTextExtentExPoint
|
|
// lets keep it here by now
|
|
// - merge warning message in TWidgetset.GetTextExtentExPoint
|
|
// about
|
|
function MyGetTextExtentExPoint(DC:HDC; Str:PChar; Count,MaxWidth:Integer;
|
|
AMax: PInteger; PartialWidths:PInteger; var sz: TSize): boolean;
|
|
|
|
|
|
implementation
|
|
|
|
uses LCLIntf;
|
|
|
|
|
|
function MyGetTextExtentExPoint(DC:HDC; Str:PChar; Count,MaxWidth:Integer;
|
|
AMax: PInteger; PartialWidths:PInteger; var sz: TSize): boolean;
|
|
var
|
|
TestCount: Integer;
|
|
TestSize : TSize;
|
|
Increment: Integer;
|
|
|
|
function CalcTestSize: boolean;
|
|
begin
|
|
result := GetTextExtentPoint(DC,Str,TestCount,TestSize);
|
|
end;
|
|
|
|
procedure Report;
|
|
begin
|
|
GetTextExtentExPoint(DC, Str, Count, MaxWidth, @TestCount, nil, TestSize);
|
|
if (TestCount<>AMax^) or (TestSize.Cx<>Sz.Cx) then begin
|
|
WriteLn('------> Diferencia');
|
|
WriteLn(' AMax^=',AMax^, ' Sz.Cx=',Sz.Cx);
|
|
WriteLn('TestCount=',TestCount,' TestSize.Cx=',testSize.Cx);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
TestCount := Count;
|
|
|
|
result := CalcTestSize;
|
|
if not result then
|
|
exit;
|
|
|
|
Sz := TestSize;
|
|
AMax^ := TestCount;
|
|
|
|
if (TestSize.Cx=0) or (TestSize.cx<MaxWidth) then begin
|
|
//Report;
|
|
exit;
|
|
end;
|
|
|
|
TestCount := (MaxWidth * TestCount) div TestSize.Cx;
|
|
|
|
Result := CalcTestSize;
|
|
if not result then
|
|
exit;
|
|
|
|
AMax^ := TestCount;
|
|
|
|
if TestSize.cx<MaxWidth then Increment:=1 else
|
|
if TestSize.cx>MaxWidth then Increment:=-1
|
|
else Increment:=0;
|
|
|
|
while ((Increment>0)and(TestCount<Count)) or
|
|
((Increment<0)and(TestCount>0))
|
|
do begin
|
|
Inc(TestCount, Increment);
|
|
result := CalcTestSize;
|
|
|
|
if not Result or
|
|
((Increment>0)and(TestSize.cx>MaxWidth))
|
|
then
|
|
// no valid or old AMax was correct
|
|
break;
|
|
|
|
AMax^ := TestCount;
|
|
|
|
if ((Increment<0)and(TestSize.cx<=MaxWidth))
|
|
then
|
|
// AMax just become correct
|
|
break;
|
|
end;
|
|
//Report;
|
|
end;
|
|
|
|
|
|
end.
|
|
|