?? qigpfunctions.pas
字號(hào):
{$ifdef iVCL}
NewFont : HFont;
OldFont : HFont;
FontInfo : TLogFont;
NewRect : TRect;
{$endif}
CenterPoint : TPoint;
ATextWidth : Integer;
ATextHeight : Integer;
begin
with ARect do
begin
CenterPoint := Point((Left + Right) div 2, (Top + Bottom) div 2);
ATextWidth := Canvas.TextWidth (AText);
ATextHeight := Canvas.TextHeight(AText);
end;
{$ifdef iVCL}
case Angle of
ira000 : begin
if Pos(#13, AText) <> 0 then
iDrawText(Canvas, AText, ARect, [itfHCenter, itfVCenter, itfNoClip{, itfSingleLine}])
else
iDrawText(Canvas, AText, ARect, [itfHCenter, itfVCenter, itfNoClip, itfSingleLine]);
Result := Rect(CenterPoint.X - ATextWidth div 2, CenterPoint.Y - ATextHeight div 2,
CenterPoint.X + ATextWidth div 2, CenterPoint.Y + ATextHeight div 2);
end;
ira090 : begin
GetObject(Canvas.Font.Handle, SizeOf(TLogFont), @FontInfo);
FontInfo.lfEscapement := 900;
NewFont := CreateFontIndirect(FontInfo);
try
OldFont := SelectObject(Canvas.Handle,NewFont);
NewRect := Rect(CenterPoint.X - ATextHeight div 2, CenterPoint.Y + ATextWidth div 2,
CenterPoint.X + ATextHeight div 2, CenterPoint.Y + ATextWidth div 2);
iDrawText(Canvas, AText, NewRect, [itfHLeft, itfVTop, itfNoClip, itfSingleLine]);
SelectObject(Canvas.Handle,OldFont);
finally
DeleteObject(NewFont);
end;
Result := Rect(CenterPoint.X - ATextHeight div 2, CenterPoint.Y - ATextWidth div 2,
CenterPoint.X + ATextHeight div 2, CenterPoint.Y + ATextWidth div 2);
end;
ira180 : begin
GetObject(Canvas.Font.Handle, SizeOf(TLogFont), @FontInfo);
FontInfo.lfEscapement := 1800;
NewFont := CreateFontIndirect(FontInfo);
try
OldFont := SelectObject(Canvas.Handle,NewFont);
NewRect := Rect(CenterPoint.X + ATextWidth div 2, CenterPoint.Y + ATextHeight div 2,
CenterPoint.X + ATextWidth div 2, CenterPoint.Y + ATextHeight div 2);
iDrawText(Canvas, AText, NewRect, [itfHLeft, itfVTop, itfNoClip, itfSingleLine]);
SelectObject(Canvas.Handle,OldFont);
finally
DeleteObject(NewFont);
end;
Result := Rect(CenterPoint.X - ATextWidth div 2, CenterPoint.Y - ATextHeight div 2,
CenterPoint.X + ATextWidth div 2, CenterPoint.Y + ATextHeight div 2);
end;
ira270 : begin
GetObject(Canvas.Font.Handle, SizeOf(TLogFont), @FontInfo);
FontInfo.lfEscapement := 2700;
NewFont := CreateFontIndirect(FontInfo);
try
OldFont := SelectObject(Canvas.Handle,NewFont);
NewRect := Rect(CenterPoint.X - ATextHeight div 2 + ATextHeight, CenterPoint.Y - ATextWidth div 2,
CenterPoint.X + ATextHeight div 2 + ATextHeight, CenterPoint.Y - ATextWidth div 2);
iDrawText(Canvas, AText, NewRect, [itfHLeft, itfVTop, itfNoClip, itfSingleLine]);
SelectObject(Canvas.Handle,OldFont);
finally
DeleteObject(NewFont);
end;
Result := Rect(CenterPoint.X - ATextHeight div 2, CenterPoint.Y - ATextWidth div 2,
CenterPoint.X + ATextHeight div 2, CenterPoint.Y + ATextWidth div 2);
end;
end;
{$endif}
{$IFDEF iCLX}
Canvas.Start;
try
Qt.QPainter_save(Canvas.Handle);
case Angle of
ira000 : begin
iDrawText(Canvas, AText, ARect, [itfHCenter, itfVCenter, itfNoClip, itfSingleLine]);
Result := Rect(CenterPoint.X - ATextWidth div 2, CenterPoint.Y - ATextHeight div 2,
CenterPoint.X + ATextWidth div 2, CenterPoint.Y + ATextHeight div 2);
end;
ira090 : begin
Qt.QPainter_translate(Canvas.Handle, ARect.Left, ARect.Top + (ARect.Bottom - ARect.Top) div 2 + ATextWidth div 2);
QPainter_rotate(Canvas.Handle, -90);
Canvas.TextOut(0, 0, AText);
end;
ira180 : begin
Qt.QPainter_translate(Canvas.Handle, ARect.Left + (ARect.Right - ARect.Left) div 2 + ATextWidth div 2, ARect.Top + ATextHeight);
QPainter_rotate(Canvas.Handle, -180);
Canvas.TextOut(0, 0, AText);
end;
ira270 : begin
Qt.QPainter_translate(Canvas.Handle, ARect.Left + ATextHeight, ARect.Top + (ARect.Bottom - ARect.Top) div 2 - ATextWidth div 2);
QPainter_rotate(Canvas.Handle, -270);
Canvas.TextOut(0, 0, AText);
end;
end;
finally
Qt.QPainter_restore(Canvas.Handle);
Canvas.Stop;
end;
{$ENDIF}
end;
//****************************************************************************************************************************************************
function iPointReverse(Reverse : Boolean; X, Y: Integer) : TPoint;
begin
if Reverse then
begin
Result := Point(Y, X);
end
else
begin
Result := Point(X, Y);
end;
end;
//****************************************************************************************************************************************************
function GetPropertyValueString(PropName : String; var PropString : String; AList: TStringList): Boolean;
var
x : Integer;
AName : String;
begin
Result := False;
for x := 0 to AList.Count-1 do
begin
SeparateStrings(Alist.Strings[x], '=', AName, PropString);
if UpperCase(AName) = UpperCase(PropName) then
begin
Result := True;
AList.Delete(x);
Break;
end;
end;
end;
//****************************************************************************************************************************************************
procedure SeparateStrings(AText: String; Seperator : String; var LeftString: String; var RightString: String);
var
EqualPosition: Integer;
begin
EqualPosition := AnsiPos(Seperator, AText);
if (EqualPosition <> 0) then
begin
LeftString := Trim(Copy(AText, 1, EqualPosition - 1));
RightString := Trim(Copy(AText, EqualPosition + 1, Length(AText) - EqualPosition));
end
else
begin
LeftString := '';
RightString := '';
end;
end;
//****************************************************************************************************************************************************
function GetObjectProperty(Instance: TPersistent; const PropName: string): TObject;
var
PropInfo: PPropInfo;
begin
Result := nil;
PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, PropName);
if (PropInfo <> nil) and (PropInfo^.PropType^.Kind = tkClass) then
Result := TObject(GetOrdProp(Instance, PropInfo));
end;
//****************************************************************************************************************************************************
procedure SaveObjectToStringList(Instance: TPersistent; Path: String; DataList: TStringList; IgnoreList: TStringList);
var
I : Integer;
Count : Integer;
PropInfo : PPropInfo;
PropList : PPropList;
PropName : ShortString;
PropValue : ShortString;
OutString : ShortString;
SubClass : TObject;
begin
Count := GetTypeData(Instance.ClassInfo)^.PropCount;
if Count > 0 then
begin
GetMem(PropList, Count * SizeOf(Pointer));
try
GetPropInfos(Instance.ClassInfo, PropList);
for I := 0 to Count - 1 do
begin
PropInfo := PropList^[I];
if PropInfo <> nil then
begin
if IsStoredProp(Instance, PropInfo) and Assigned(PropInfo^.SetProc) then
begin
if Trim(Path) <> '' then PropName := Path + '.' + PropInfo.Name
else PropName := PropInfo.Name;
if Assigned(IgnoreList) then if IgnoreList.IndexOf(PropName) <> -1 then Continue;
case PropInfo^.PropType^.Kind of
tkInteger, tkEnumeration, tkSet, tkChar : begin
PropValue := IntToStr (GetOrdProp (Instance, PropInfo));
OutString := PropName + ' = ' + PropValue;
DataList.Add(OutString);
end;
tkFloat : begin
PropValue := FloatToStr(GetFloatProp(Instance, PropInfo));
OutString := PropName + ' = ' + PropValue;
DataList.Add(OutString);
end;
tkString, tkLString, tkWString : begin
PropValue := GetStrProp (Instance, PropInfo);
OutString := PropName + ' = ' + PropValue;
DataList.Add(OutString);
end;
tkClass : begin
SubClass := GetObjectProperty(Instance, PropInfo.Name);
if SubClass is TPersistent then
SaveObjectToStringList(SubClass as TPersistent, PropName, DataList, IgnoreList);
end;
end;
end;
end
else Break;
end;
finally
FreeMem(PropList, Count * SizeOf(Pointer));
end;
end;
end;
//****************************************************************************************************************************************************
procedure LoadObjectFromStringList(Instance: TPersistent; Path: String; DataList: TStringList);
var
i : Integer;
Count : Integer;
PropName : String;
PropInfo : PPropInfo;
PropList : PPropList;
SubClass : TObject;
AValue : String;
Found : Boolean;
DecimalChar : String;
begin
Count := GetTypeData(Instance.ClassInfo)^.PropCount;
if Count > 0 then
begin
GetMem(PropList, Count * SizeOf(Pointer));
try
GetPropInfos(Instance.ClassInfo, PropList);
for i := 0 to Count - 1 do
begin
PropInfo := PropList^[i];
if PropInfo <> nil then
begin
if IsStoredProp(Instance, PropInfo) and Assigned(PropInfo^.SetProc) then
begin
if Trim(Path) <> '' then PropName := Path + '.' + PropInfo.Name
else PropName := PropInfo.Name;
if PropInfo^.PropType^.Kind <> tkClass then Found := GetPropertyValueString(PropName, AValue, DataList) else Found := True;
if not Found then Continue;
case PropInfo^.PropType^.Kind of
tkInteger, tkEnumeration, tkSet, tkChar : SetOrdProp (Instance, GetPropInfo(PTypeInfo(Instance.ClassInfo), PropInfo.Name), StrToInt(AValue));
tkFloat : begin
DecimalChar := Copy(FloatToStr(1.1), 2,1);
if DecimalChar = '.' then AValue := StringReplace(AValue, ',', DecimalChar, [rfIgnoreCase])
else if DecimalChar = ',' then AValue := StringReplace(AValue, '.', DecimalChar, [rfIgnoreCase]);
SetFloatProp(Instance, GetPropInfo(PTypeInfo(Instance.ClassInfo), PropInfo.Name), StrToFloat(AValue));
end;
tkString, tkLString, tkWString : SetStrProp (Instance, GetPropInfo(PTypeInfo(Instance.ClassInfo), PropInfo.Name), AValue);
tkClass : begin
SubClass := GetObjectProperty(Instance, PropInfo.Name);
if SubClass is TPersistent then
LoadObjectFromStringList(SubClass as TPersistent, PropName, DataList);
end;
end;
end;
end
else Break;
end;
finally
FreeMem(PropList, Count * SizeOf(Pointer));
end;
end;
end;
//****************************************************************************************************************************************************
function GetCustomFormOwner(AComponent: TComponent): TWinControl;
var
AControl : TComponent;
begin
Result := nil;
AControl := AComponent;
while (AControl is TComponent) do
begin
if AControl.Owner is TCustomForm then
begin
Result := AControl.Owner as TCustomForm;
Exit;
end
else if AControl.Owner is TwinControl then
begin
Result := AControl.Owner as TWinControl;
end;
AControl := AControl.Owner;
end;
end;
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -